(sgml-quote): Use narrowing. Improve the regexp used when unquoting.

(sgml-pretty-print): New function.
(sgml-get-context): Better handling of improperly nested tags.
(sgml-show-context): Don't use the FULL arg of sgml-get-context.

diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 28eea74f9f3d21f6f115b38a2c1aaeb8ea4e39f5..bad9dcc4a34c5166fb2b4c78de9dc178d81394c9 100644 (file)
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -942,20 +942,51 @@ See `sgml-tag-alist' for info about attribute rules."
       (insert ?\"))))
 
 (defun sgml-quote (start end &optional unquotep)
-  "Quote SGML text in region.
-With prefix argument, unquote the region."
-  (interactive "r\np")
-  (if (< start end)
-      (goto-char start)
-    (goto-char end)
-    (setq end start))
-  (if unquotep
-      (while (re-search-forward "&\\(amp\\|\\(l\\|\\(g\\)\\)t\\)[;\n]" end t)
-       (replace-match (if (match-end 3) ">" (if (match-end 2) "<" "&"))))
-    (while (re-search-forward "[&<>]" end t)
-      (replace-match (cdr (assq (char-before) '((?& . "&amp;")
-                                               (?< . "&lt;")
-                                               (?> . "&gt;"))))))))
+  "Quote SGML text in region START ... END.
+Only &, < and > are quoted, the rest is left untouched.
+With prefix argument UNQUOTEP, unquote the region."
+  (interactive "r\nP")
+  (save-restriction
+    (narrow-to-region start end)
+    (goto-char (point-min))
+    (if unquotep
+       ;; FIXME: We should unquote other named character references as well.
+       (while (re-search-forward
+               "\\(&\\(amp\\|\\(l\\|\\(g\\)\\)t\\)\\)[][<>&;\n\t \"%!'(),/=?]"
+               nil t)
+         (replace-match (if (match-end 4) ">" (if (match-end 3) "<" "&")) t t
+                        nil (if (eq (char-before (match-end 0)) ?\;) 0 1)))
+      (while (re-search-forward "[&<>]" nil t)
+       (replace-match (cdr (assq (char-before) '((?& . "&amp;")
+                                                 (?< . "&lt;")
+                                                 (?> . "&gt;"))))
+                      t t)))))
+
+(defun sgml-pretty-print (beg end)
+  "Simple-minded pretty printer for SGML.
+Re-indents the code and inserts newlines between BEG and END.
+You might want to turn on `auto-fill-mode' to get better results."
+  ;; TODO:
+  ;; - insert newline between some start-tag and text.
+  ;; - don't insert newline in front of some end-tags.
+  (interactive "r")
+  (save-excursion
+    (if (< beg end)
+       (goto-char beg)
+      (goto-char end)
+      (setq end beg)
+      (setq beg (point)))
+    ;; Don't use narrowing because it screws up auto-indent.
+    (setq end (copy-marker end t))
+    (with-syntax-table sgml-tag-syntax-table
+      (while (re-search-forward "<" end t)
+       (goto-char (match-beginning 0))
+       (unless (or ;;(looking-at "</")
+                   (progn (skip-chars-backward " \t") (bolp)))
+         (reindent-then-newline-and-indent))
+       (forward-sexp 1)))
+    ;; (indent-region beg end)
+    ))
 
 \f
 ;; Parsing
@@ -1050,7 +1081,7 @@ immediately enclosing the current position."
                   (> (sgml-tag-end tag-info)
                      (sgml-tag-end (car context))))
         (setq context (cdr context)))
-           
+      
       (cond
 
        ;; start-tag
@@ -1071,9 +1102,18 @@ immediately enclosing the current position."
         (t
          ;; The open and close tags don't match.
          (if (not sgml-xml-mode)
-             ;; Assume the open tag is simply not closed.
              (unless (sgml-unclosed-tag-p (sgml-tag-name tag-info))
-               (message "Unclosed tag <%s>" (sgml-tag-name tag-info)))
+               (message "Unclosed tag <%s>" (sgml-tag-name tag-info))
+               (let ((tmp ignore))
+                 ;; We could just assume that the tag is simply not closed
+                 ;; but it's a bad assumption when tags *are* closed but
+                 ;; not properly nested.
+                 (while (and (cdr tmp)
+                             (not (eq t (compare-strings
+                                         (sgml-tag-name tag-info) nil nil
+                                         (cadr tmp) nil nil t))))
+                   (setq tmp (cdr tmp)))
+                 (if (cdr tmp) (setcdr tmp (cddr tmp)))))
            (message "Unmatched tags <%s> and </%s>"
                     (sgml-tag-name tag-info) (pop ignore))))))
 
@@ -1092,7 +1132,13 @@ immediately enclosing the current position."
 If FULL is non-nil, parse back to the beginning of the buffer."
   (interactive "P")
   (with-output-to-temp-buffer "*XML Context*"
-    (pp (save-excursion (sgml-get-context full)))))
+    (save-excursion
+      (let ((context (sgml-get-context)))
+       (when full
+         (let ((more nil))
+           (while (setq more (sgml-get-context))
+             (setq context (nconc more context)))))
+       (pp context)))))
 
 \f
 ;; Editing shortcuts