changeset 48262:1ef1bf10c03c

(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.

--- a/lisp/textmodes/sgml-mode.el	Tue Nov 12 08:11:30 2002 +0000
+++ b/lisp/textmodes/sgml-mode.el	Tue Nov 12 16:46:19 2002 +0000
@@ -524,21 +524,23 @@
   (delete-backward-char 1)
   (insert char)
   (undo-boundary)
-  (delete-backward-char 1)
-  (cond
-   ((< char 256)
-    (insert ?&
-	    (or (aref sgml-char-names char)
-		(format "#%d" char))
-	    ?\;))
-   ((aref sgml-char-names-table char)
-    (insert ?& (aref sgml-char-names-table char) ?\;))
-   ((let ((c (encode-char char 'ucs)))
-      (when c
-	(insert (format "&#%d;" c))
-	t)))
-   (t					; should be an error?  -- fx
-    (insert char))))
+  (sgml-namify-char))
+
+(defun sgml-namify-char ()
+  "Change the char before point into its `&name;' equivalent.
+Uses `sgml-char-names'."
+  (interactive)
+  (let* ((char (char-before))
+	 (name
+	  (cond
+	   ((null char) (error "No char before point"))
+	   ((< char 256) (or (aref sgml-char-names char) char))
+	   ((aref sgml-char-names-table char))
+	   ((encode-char char 'ucs)))))
+    (if (not name)
+	(error "Don't know the name of `%c'" char)
+      (delete-backward-char 1)
+      (insert (format (if (numberp name) "&#%d;" "&%s;") name)))))
 
 (defun sgml-name-self ()
   "Insert a symbolic character name according to `sgml-char-names'."
@@ -569,6 +571,8 @@
 ;; inserted literally, one should obtain it as the return value of a
 ;; function, e.g. (identity "str").
 
+(defvar sgml-tag-last nil)
+(defvar sgml-tag-history nil)
 (define-skeleton sgml-tag
   "Prompt for a tag and insert it, optionally with attributes.
 Completion and configuration are done according to `sgml-tag-alist'.
@@ -576,7 +580,12 @@
 skeleton-transformation RET upcase RET, or put this in your `.emacs':
   (setq sgml-transformation 'upcase)"
   (funcall (or skeleton-transformation 'identity)
-           (completing-read "Tag: " sgml-tag-alist))
+           (setq sgml-tag-last
+		 (completing-read
+		  (if (> (length sgml-tag-last) 0)
+		      (format "Tag (default %s): " sgml-tag-last)
+		    "Tag: ")
+		  sgml-tag-alist nil nil nil 'sgml-tag-history sgml-tag-last)))
   ?< str |
   (("") -1 '(undo-boundary) (identity "&lt;")) |	; see comment above
   `(("") '(setq v2 (sgml-attributes ,str t)) ?>
@@ -686,6 +695,7 @@
   "Skip to beginning of tag or matching opening tag if present.
 With prefix argument ARG, repeat this ARG times."
   (interactive "p")
+  ;; FIXME: use sgml-get-context or something similar.
   (while (>= arg 1)
     (search-backward "<" nil t)
     (if (looking-at "</\\([^ \n\t>]+\\)")
@@ -705,34 +715,41 @@
 With prefix argument ARG, repeat this ARG times.
 Return t iff after a closing tag."
   (interactive "p")
+  ;; FIXME: Use sgml-get-context or something similar.
+  ;; It currently might jump to an unrelated </P> if the <P>
+  ;; we're skipping has no matching </P>.
   (let ((return t))
-    (while (>= arg 1)
-      (skip-chars-forward "^<>")
-      (if (eq (following-char) ?>)
-	  (up-list -1))
-      (if (looking-at "<\\([^/ \n\t>]+\\)\\([^>]*[^/>]\\)?>")
-	  ;; start tag, skip any nested same pairs _and_ closing tag
-	  (let ((case-fold-search t)
-		(re (concat "</?" (regexp-quote (match-string 1))
-			    ;; Ignore empty tags like <foo/>.
-			    "\\([^>]*[^/>]\\)?>"))
-		point close)
-	    (forward-list 1)
-	    (setq point (point))
-	    (while (and (re-search-forward re nil t)
-			(not (setq close
-				   (eq (char-after (1+ (match-beginning 0))) ?/)))
-			(goto-char (match-beginning 0))
-			(sgml-skip-tag-forward 1))
-	      (setq close nil))
-	    (unless close
-	      (goto-char point)
-	      (setq return nil)))
-	(forward-list 1))
-      (setq arg (1- arg)))
-    return))
+    (with-syntax-table sgml-tag-syntax-table
+      (while (>= arg 1)
+	(skip-chars-forward "^<>")
+	(if (eq (following-char) ?>)
+	    (up-list -1))
+	(if (looking-at "<\\([^/ \n\t>]+\\)\\([^>]*[^/>]\\)?>")
+	    ;; start tag, skip any nested same pairs _and_ closing tag
+	    (let ((case-fold-search t)
+		  (re (concat "</?" (regexp-quote (match-string 1))
+			      ;; Ignore empty tags like <foo/>.
+			      "\\([^>]*[^/>]\\)?>"))
+		  point close)
+	      (forward-list 1)
+	      (setq point (point))
+	      ;; FIXME: This re-search-forward will mistakenly match
+	      ;; tag-like text inside attributes.
+	      (while (and (re-search-forward re nil t)
+			  (not (setq close
+				     (eq (char-after (1+ (match-beginning 0))) ?/)))
+			  (goto-char (match-beginning 0))
+			  (sgml-skip-tag-forward 1))
+		(setq close nil))
+	      (unless close
+		(goto-char point)
+		(setq return nil)))
+	  (forward-list 1))
+	(setq arg (1- arg)))
+      return)))
 
 (defun sgml-delete-tag (arg)
+  ;; FIXME: Should be called sgml-kill-tag or should not touch the kill-ring.
   "Delete tag on or after cursor, and matching closing or opening tag.
 With prefix argument ARG, repeat this ARG times."
   (interactive "p")
@@ -766,13 +783,16 @@
 	      (goto-char close)
 	      (kill-sexp 1))
 	  (setq open (point))
-	  (sgml-skip-tag-forward 1)
-	  (backward-list)
-	  (forward-char)
-	  (if (eq (aref (sgml-beginning-of-tag) 0) ?/)
-	      (kill-sexp 1)))
+	  (when (sgml-skip-tag-forward 1)
+	    (kill-sexp -1)))
+	;; Delete any resulting empty line.  If we didn't kill-sexp,
+	;; this *should* do nothing, because we're right after the tag.
+	(if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?"))
+	    (delete-region (match-beginning 0) (match-end 0)))
 	(goto-char open)
-	(kill-sexp 1)))
+	(kill-sexp 1)
+	(if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?"))
+	    (delete-region (match-beginning 0) (match-end 0)))))
     (setq arg (1- arg))))
 
 
@@ -780,7 +800,6 @@
 (or (get 'sgml-tag 'invisible)
     (setplist 'sgml-tag
 	      (append '(invisible t
-			intangible t
 			point-entered sgml-point-entered
 			rear-nonsticky t
 			read-only t)
@@ -1009,12 +1028,12 @@
     (and (>= start (point-min))
          (equal str (buffer-substring-no-properties start (point))))))
 
-(defun sgml-parse-tag-backward ()
+(defun sgml-parse-tag-backward (&optional limit)
   "Parse an SGML tag backward, and return information about the tag.
 Assume that parsing starts from within a textual context.
 Leave point at the beginning of the tag."
   (let (tag-type tag-start tag-end name)
-    (or (search-backward ">" nil 'move)
+    (or (search-backward ">" limit 'move)
         (error "No tag found"))
     (setq tag-end (1+ (point)))
     (cond
@@ -1147,7 +1166,9 @@
 ;; Editing shortcuts
 
 (defun sgml-close-tag ()
-  "Insert a close-tag for the current element."
+  "Close current element.
+Depending on context, inserts a matching close-tag, or closes
+the current start-tag or the current comment or the current cdata, ..."
   (interactive)
   (case (car (sgml-lexical-context))
     (comment 	(insert " -->"))
@@ -1757,19 +1778,14 @@
 		    toc-index))))
     (nreverse toc-index)))
 
-(defun html-autoview-mode (&optional arg)
+(define-minor-mode html-autoview-mode
   "Toggle automatic viewing via `browse-url-of-buffer' upon saving buffer.
 With positive prefix ARG always turns viewing on, with negative ARG always off.
 Can be used as a value for `html-mode-hook'."
-  (interactive "P")
-  (if (setq arg (if arg
-		    (< (prefix-numeric-value arg) 0)
-		  (and (boundp 'after-save-hook)
-		       (memq 'browse-url-of-buffer after-save-hook))))
-      (setq after-save-hook (delq 'browse-url-of-buffer after-save-hook))
-    (add-hook 'after-save-hook 'browse-url-of-buffer nil t))
-  (message "Autoviewing turned %s."
-	   (if arg "off" "on")))
+  nil nil nil
+  (if html-autoview-mode
+      (add-hook 'after-save-hook 'browse-url-of-buffer nil t)
+    (remove-hook 'after-save-hook 'browse-url-of-buffer t)))
 
 
 (define-skeleton html-href-anchor