diff options
| author | Stefan Monnier | 2002-11-12 16:46:19 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2002-11-12 16:46:19 +0000 |
| commit | 4e7a42d2f501c6883a2d5e0801325db5e4d39a6e (patch) | |
| tree | 834c174053964d72b30966042626c9ae184f5536 /lisp/textmodes | |
| parent | 88510b17578698315409f7b184891ff39f8fe40c (diff) | |
| download | emacs-4e7a42d2f501c6883a2d5e0801325db5e4d39a6e.tar.gz emacs-4e7a42d2f501c6883a2d5e0801325db5e4d39a6e.zip | |
(sgml-namify-char): New cmd.
(sgml-name-char): Use it.
(sgml-tag-last, sgml-tag-history): New vars.
(sgml-tag): Use them.
(sgml-skip-tag-forward): Use sgml-tag-syntax-table.
(sgml-delete-tag): Remove resulting empty lines.
(sgml-tag): Don't make intangible.
(sgml-parse-tag-backward): Add limit argument.
(html-autoview-mode): Use define-minor-mode.
Diffstat (limited to 'lisp/textmodes')
| -rw-r--r-- | lisp/textmodes/sgml-mode.el | 138 |
1 files changed, 77 insertions, 61 deletions
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 569f182367b..6db4407c7c3 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el | |||
| @@ -524,21 +524,23 @@ encoded keyboard operation." | |||
| 524 | (delete-backward-char 1) | 524 | (delete-backward-char 1) |
| 525 | (insert char) | 525 | (insert char) |
| 526 | (undo-boundary) | 526 | (undo-boundary) |
| 527 | (delete-backward-char 1) | 527 | (sgml-namify-char)) |
| 528 | (cond | 528 | |
| 529 | ((< char 256) | 529 | (defun sgml-namify-char () |
| 530 | (insert ?& | 530 | "Change the char before point into its `&name;' equivalent. |
| 531 | (or (aref sgml-char-names char) | 531 | Uses `sgml-char-names'." |
| 532 | (format "#%d" char)) | 532 | (interactive) |
| 533 | ?\;)) | 533 | (let* ((char (char-before)) |
| 534 | ((aref sgml-char-names-table char) | 534 | (name |
| 535 | (insert ?& (aref sgml-char-names-table char) ?\;)) | 535 | (cond |
| 536 | ((let ((c (encode-char char 'ucs))) | 536 | ((null char) (error "No char before point")) |
| 537 | (when c | 537 | ((< char 256) (or (aref sgml-char-names char) char)) |
| 538 | (insert (format "&#%d;" c)) | 538 | ((aref sgml-char-names-table char)) |
| 539 | t))) | 539 | ((encode-char char 'ucs))))) |
| 540 | (t ; should be an error? -- fx | 540 | (if (not name) |
| 541 | (insert char)))) | 541 | (error "Don't know the name of `%c'" char) |
| 542 | (delete-backward-char 1) | ||
| 543 | (insert (format (if (numberp name) "&#%d;" "&%s;") name))))) | ||
| 542 | 544 | ||
| 543 | (defun sgml-name-self () | 545 | (defun sgml-name-self () |
| 544 | "Insert a symbolic character name according to `sgml-char-names'." | 546 | "Insert a symbolic character name according to `sgml-char-names'." |
| @@ -569,6 +571,8 @@ This only works for Latin-1 input." | |||
| 569 | ;; inserted literally, one should obtain it as the return value of a | 571 | ;; inserted literally, one should obtain it as the return value of a |
| 570 | ;; function, e.g. (identity "str"). | 572 | ;; function, e.g. (identity "str"). |
| 571 | 573 | ||
| 574 | (defvar sgml-tag-last nil) | ||
| 575 | (defvar sgml-tag-history nil) | ||
| 572 | (define-skeleton sgml-tag | 576 | (define-skeleton sgml-tag |
| 573 | "Prompt for a tag and insert it, optionally with attributes. | 577 | "Prompt for a tag and insert it, optionally with attributes. |
| 574 | Completion and configuration are done according to `sgml-tag-alist'. | 578 | Completion and configuration are done according to `sgml-tag-alist'. |
| @@ -576,7 +580,12 @@ If you like tags and attributes in uppercase do \\[set-variable] | |||
| 576 | skeleton-transformation RET upcase RET, or put this in your `.emacs': | 580 | skeleton-transformation RET upcase RET, or put this in your `.emacs': |
| 577 | (setq sgml-transformation 'upcase)" | 581 | (setq sgml-transformation 'upcase)" |
| 578 | (funcall (or skeleton-transformation 'identity) | 582 | (funcall (or skeleton-transformation 'identity) |
| 579 | (completing-read "Tag: " sgml-tag-alist)) | 583 | (setq sgml-tag-last |
| 584 | (completing-read | ||
| 585 | (if (> (length sgml-tag-last) 0) | ||
| 586 | (format "Tag (default %s): " sgml-tag-last) | ||
| 587 | "Tag: ") | ||
| 588 | sgml-tag-alist nil nil nil 'sgml-tag-history sgml-tag-last))) | ||
| 580 | ?< str | | 589 | ?< str | |
| 581 | (("") -1 '(undo-boundary) (identity "<")) | ; see comment above | 590 | (("") -1 '(undo-boundary) (identity "<")) | ; see comment above |
| 582 | `(("") '(setq v2 (sgml-attributes ,str t)) ?> | 591 | `(("") '(setq v2 (sgml-attributes ,str t)) ?> |
| @@ -686,6 +695,7 @@ With prefix argument, only self insert." | |||
| 686 | "Skip to beginning of tag or matching opening tag if present. | 695 | "Skip to beginning of tag or matching opening tag if present. |
| 687 | With prefix argument ARG, repeat this ARG times." | 696 | With prefix argument ARG, repeat this ARG times." |
| 688 | (interactive "p") | 697 | (interactive "p") |
| 698 | ;; FIXME: use sgml-get-context or something similar. | ||
| 689 | (while (>= arg 1) | 699 | (while (>= arg 1) |
| 690 | (search-backward "<" nil t) | 700 | (search-backward "<" nil t) |
| 691 | (if (looking-at "</\\([^ \n\t>]+\\)") | 701 | (if (looking-at "</\\([^ \n\t>]+\\)") |
| @@ -705,34 +715,41 @@ With prefix argument ARG, repeat this ARG times." | |||
| 705 | With prefix argument ARG, repeat this ARG times. | 715 | With prefix argument ARG, repeat this ARG times. |
| 706 | Return t iff after a closing tag." | 716 | Return t iff after a closing tag." |
| 707 | (interactive "p") | 717 | (interactive "p") |
| 718 | ;; FIXME: Use sgml-get-context or something similar. | ||
| 719 | ;; It currently might jump to an unrelated </P> if the <P> | ||
| 720 | ;; we're skipping has no matching </P>. | ||
| 708 | (let ((return t)) | 721 | (let ((return t)) |
| 709 | (while (>= arg 1) | 722 | (with-syntax-table sgml-tag-syntax-table |
| 710 | (skip-chars-forward "^<>") | 723 | (while (>= arg 1) |
| 711 | (if (eq (following-char) ?>) | 724 | (skip-chars-forward "^<>") |
| 712 | (up-list -1)) | 725 | (if (eq (following-char) ?>) |
| 713 | (if (looking-at "<\\([^/ \n\t>]+\\)\\([^>]*[^/>]\\)?>") | 726 | (up-list -1)) |
| 714 | ;; start tag, skip any nested same pairs _and_ closing tag | 727 | (if (looking-at "<\\([^/ \n\t>]+\\)\\([^>]*[^/>]\\)?>") |
| 715 | (let ((case-fold-search t) | 728 | ;; start tag, skip any nested same pairs _and_ closing tag |
| 716 | (re (concat "</?" (regexp-quote (match-string 1)) | 729 | (let ((case-fold-search t) |
| 717 | ;; Ignore empty tags like <foo/>. | 730 | (re (concat "</?" (regexp-quote (match-string 1)) |
| 718 | "\\([^>]*[^/>]\\)?>")) | 731 | ;; Ignore empty tags like <foo/>. |
| 719 | point close) | 732 | "\\([^>]*[^/>]\\)?>")) |
| 720 | (forward-list 1) | 733 | point close) |
| 721 | (setq point (point)) | 734 | (forward-list 1) |
| 722 | (while (and (re-search-forward re nil t) | 735 | (setq point (point)) |
| 723 | (not (setq close | 736 | ;; FIXME: This re-search-forward will mistakenly match |
| 724 | (eq (char-after (1+ (match-beginning 0))) ?/))) | 737 | ;; tag-like text inside attributes. |
| 725 | (goto-char (match-beginning 0)) | 738 | (while (and (re-search-forward re nil t) |
| 726 | (sgml-skip-tag-forward 1)) | 739 | (not (setq close |
| 727 | (setq close nil)) | 740 | (eq (char-after (1+ (match-beginning 0))) ?/))) |
| 728 | (unless close | 741 | (goto-char (match-beginning 0)) |
| 729 | (goto-char point) | 742 | (sgml-skip-tag-forward 1)) |
| 730 | (setq return nil))) | 743 | (setq close nil)) |
| 731 | (forward-list 1)) | 744 | (unless close |
| 732 | (setq arg (1- arg))) | 745 | (goto-char point) |
| 733 | return)) | 746 | (setq return nil))) |
| 747 | (forward-list 1)) | ||
| 748 | (setq arg (1- arg))) | ||
| 749 | return))) | ||
| 734 | 750 | ||
| 735 | (defun sgml-delete-tag (arg) | 751 | (defun sgml-delete-tag (arg) |
| 752 | ;; FIXME: Should be called sgml-kill-tag or should not touch the kill-ring. | ||
| 736 | "Delete tag on or after cursor, and matching closing or opening tag. | 753 | "Delete tag on or after cursor, and matching closing or opening tag. |
| 737 | With prefix argument ARG, repeat this ARG times." | 754 | With prefix argument ARG, repeat this ARG times." |
| 738 | (interactive "p") | 755 | (interactive "p") |
| @@ -766,13 +783,16 @@ With prefix argument ARG, repeat this ARG times." | |||
| 766 | (goto-char close) | 783 | (goto-char close) |
| 767 | (kill-sexp 1)) | 784 | (kill-sexp 1)) |
| 768 | (setq open (point)) | 785 | (setq open (point)) |
| 769 | (sgml-skip-tag-forward 1) | 786 | (when (sgml-skip-tag-forward 1) |
| 770 | (backward-list) | 787 | (kill-sexp -1))) |
| 771 | (forward-char) | 788 | ;; Delete any resulting empty line. If we didn't kill-sexp, |
| 772 | (if (eq (aref (sgml-beginning-of-tag) 0) ?/) | 789 | ;; this *should* do nothing, because we're right after the tag. |
| 773 | (kill-sexp 1))) | 790 | (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?")) |
| 791 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 774 | (goto-char open) | 792 | (goto-char open) |
| 775 | (kill-sexp 1))) | 793 | (kill-sexp 1) |
| 794 | (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?")) | ||
| 795 | (delete-region (match-beginning 0) (match-end 0))))) | ||
| 776 | (setq arg (1- arg)))) | 796 | (setq arg (1- arg)))) |
| 777 | 797 | ||
| 778 | 798 | ||
| @@ -780,7 +800,6 @@ With prefix argument ARG, repeat this ARG times." | |||
| 780 | (or (get 'sgml-tag 'invisible) | 800 | (or (get 'sgml-tag 'invisible) |
| 781 | (setplist 'sgml-tag | 801 | (setplist 'sgml-tag |
| 782 | (append '(invisible t | 802 | (append '(invisible t |
| 783 | intangible t | ||
| 784 | point-entered sgml-point-entered | 803 | point-entered sgml-point-entered |
| 785 | rear-nonsticky t | 804 | rear-nonsticky t |
| 786 | read-only t) | 805 | read-only t) |
| @@ -1009,12 +1028,12 @@ You might want to turn on `auto-fill-mode' to get better results." | |||
| 1009 | (and (>= start (point-min)) | 1028 | (and (>= start (point-min)) |
| 1010 | (equal str (buffer-substring-no-properties start (point)))))) | 1029 | (equal str (buffer-substring-no-properties start (point)))))) |
| 1011 | 1030 | ||
| 1012 | (defun sgml-parse-tag-backward () | 1031 | (defun sgml-parse-tag-backward (&optional limit) |
| 1013 | "Parse an SGML tag backward, and return information about the tag. | 1032 | "Parse an SGML tag backward, and return information about the tag. |
| 1014 | Assume that parsing starts from within a textual context. | 1033 | Assume that parsing starts from within a textual context. |
| 1015 | Leave point at the beginning of the tag." | 1034 | Leave point at the beginning of the tag." |
| 1016 | (let (tag-type tag-start tag-end name) | 1035 | (let (tag-type tag-start tag-end name) |
| 1017 | (or (search-backward ">" nil 'move) | 1036 | (or (search-backward ">" limit 'move) |
| 1018 | (error "No tag found")) | 1037 | (error "No tag found")) |
| 1019 | (setq tag-end (1+ (point))) | 1038 | (setq tag-end (1+ (point))) |
| 1020 | (cond | 1039 | (cond |
| @@ -1147,7 +1166,9 @@ If FULL is non-nil, parse back to the beginning of the buffer." | |||
| 1147 | ;; Editing shortcuts | 1166 | ;; Editing shortcuts |
| 1148 | 1167 | ||
| 1149 | (defun sgml-close-tag () | 1168 | (defun sgml-close-tag () |
| 1150 | "Insert a close-tag for the current element." | 1169 | "Close current element. |
| 1170 | Depending on context, inserts a matching close-tag, or closes | ||
| 1171 | the current start-tag or the current comment or the current cdata, ..." | ||
| 1151 | (interactive) | 1172 | (interactive) |
| 1152 | (case (car (sgml-lexical-context)) | 1173 | (case (car (sgml-lexical-context)) |
| 1153 | (comment (insert " -->")) | 1174 | (comment (insert " -->")) |
| @@ -1757,19 +1778,14 @@ The third `match-string' will be the used in the menu.") | |||
| 1757 | toc-index)))) | 1778 | toc-index)))) |
| 1758 | (nreverse toc-index))) | 1779 | (nreverse toc-index))) |
| 1759 | 1780 | ||
| 1760 | (defun html-autoview-mode (&optional arg) | 1781 | (define-minor-mode html-autoview-mode |
| 1761 | "Toggle automatic viewing via `browse-url-of-buffer' upon saving buffer. | 1782 | "Toggle automatic viewing via `browse-url-of-buffer' upon saving buffer. |
| 1762 | With positive prefix ARG always turns viewing on, with negative ARG always off. | 1783 | With positive prefix ARG always turns viewing on, with negative ARG always off. |
| 1763 | Can be used as a value for `html-mode-hook'." | 1784 | Can be used as a value for `html-mode-hook'." |
| 1764 | (interactive "P") | 1785 | nil nil nil |
| 1765 | (if (setq arg (if arg | 1786 | (if html-autoview-mode |
| 1766 | (< (prefix-numeric-value arg) 0) | 1787 | (add-hook 'after-save-hook 'browse-url-of-buffer nil t) |
| 1767 | (and (boundp 'after-save-hook) | 1788 | (remove-hook 'after-save-hook 'browse-url-of-buffer t))) |
| 1768 | (memq 'browse-url-of-buffer after-save-hook)))) | ||
| 1769 | (setq after-save-hook (delq 'browse-url-of-buffer after-save-hook)) | ||
| 1770 | (add-hook 'after-save-hook 'browse-url-of-buffer nil t)) | ||
| 1771 | (message "Autoviewing turned %s." | ||
| 1772 | (if arg "off" "on"))) | ||
| 1773 | 1789 | ||
| 1774 | 1790 | ||
| 1775 | (define-skeleton html-href-anchor | 1791 | (define-skeleton html-href-anchor |