Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-50

[gnu-emacs] / lisp / textmodes / sgml-mode.el

diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 58aec14b48bc3c8c1703c7a5499e06ba04410e2b..584056bf30b636066b09e11c1132f4628f5899e3 100644 (file)
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1,6 +1,6 @@
 ;;; sgml-mode.el --- SGML- and HTML-editing modes
 
 ;;; sgml-mode.el --- SGML- and HTML-editing modes
 

-;; Copyright (C) 1992,95,96,98,2001,2002  Free Software Foundation, Inc.
+;; Copyright (C) 1992,95,96,98,2001,2002, 2003  Free Software Foundation, Inc.

 
 ;; Author: James Clark <jjc@jclark.com>
 ;; Maintainer: FSF
 
 ;; Author: James Clark <jjc@jclark.com>
 ;; Maintainer: FSF


@@ -111,8 +111,6 @@ This takes effect when first loading the `sgml-mode' library.")
         (define-key map "\"" 'sgml-name-self))
       (when (memq ?' sgml-specials)
         (define-key map "'" 'sgml-name-self)))
         (define-key map "\"" 'sgml-name-self))
       (when (memq ?' sgml-specials)
         (define-key map "'" 'sgml-name-self)))

-    (define-key map (vector (make-char 'latin-iso8859-1))
-      'sgml-maybe-name-self)

     (let ((c 127)
          (map (nth 1 map)))
       (while (< (setq c (1+ c)) 256)
     (let ((c 127)
          (map (nth 1 map)))
       (while (< (setq c (1+ c)) 256)


@@ -208,7 +206,7 @@ This takes effect when first loading the `sgml-mode' library.")
   (let ((table (make-char-table 'sgml-table))
        (i 32)
        elt)
   (let ((table (make-char-table 'sgml-table))
        (i 32)
        elt)

-    (while (< i 256)
+    (while (< i 128)

       (setq elt (aref sgml-char-names i))
       (if elt (aset table (make-char 'latin-iso8859-1 i) elt))
       (setq i (1+ i)))
       (setq elt (aref sgml-char-names i))
       (if elt (aset table (make-char 'latin-iso8859-1 i) elt))
       (setq i (1+ i)))


@@ -239,6 +237,7 @@ separated by a space."
   :type '(choice (const nil) integer)
   :group 'sgml)
 
   :type '(choice (const nil) integer)
   :group 'sgml)
 

+(defconst sgml-namespace-re "[_[:alpha:]][-_.[:alnum:]]*")

 (defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*")
 (defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)"))
 (defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*")
 (defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*")
 (defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)"))
 (defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*")


@@ -246,13 +245,24 @@ separated by a space."
   "Regular expression that matches a non-empty start tag.
 Any terminating `>' or `/' is not matched.")
 
   "Regular expression that matches a non-empty start tag.
 Any terminating `>' or `/' is not matched.")
 

+(defface sgml-namespace-face
+  '((t (:inherit font-lock-builtin-face)))
+  "`sgml-mode' face used to highlight the namespace part of identifiers.")
+(defvar sgml-namespace-face 'sgml-namespace-face)

 
 ;; internal
 (defconst sgml-font-lock-keywords-1
   `((,(concat "<\\([!?]" sgml-name-re "\\)") 1 font-lock-keyword-face)
 
 ;; internal
 (defconst sgml-font-lock-keywords-1
   `((,(concat "<\\([!?]" sgml-name-re "\\)") 1 font-lock-keyword-face)

-    (,(concat "<\\(/?" sgml-name-re"\\)") 1 font-lock-function-name-face)
+    ;; We could use the simpler "\\(" sgml-namespace-re ":\\)?" instead,
+    ;; but it would cause a bit more backtracking in the re-matcher.
+    (,(concat "</?\\(" sgml-namespace-re "\\)\\(?::\\(" sgml-name-re "\\)\\)?")
+     (1 (if (match-end 2) sgml-namespace-face font-lock-function-name-face))
+     (2 font-lock-function-name-face nil t))

     ;; FIXME: this doesn't cover the variables using a default value.
     ;; FIXME: this doesn't cover the variables using a default value.

-    (,(concat "\\(" sgml-name-re "\\)=[\"']") 1 font-lock-variable-name-face)
+    (,(concat "\\(" sgml-namespace-re "\\)\\(?::\\("
+             sgml-name-re "\\)\\)?=[\"']")
+     (1 (if (match-end 2) sgml-namespace-face font-lock-variable-name-face))
+     (2 font-lock-variable-name-face nil t))

     (,(concat "[&%]" sgml-name-re ";?") . font-lock-variable-name-face)))
 
 (defconst sgml-font-lock-keywords-2
     (,(concat "[&%]" sgml-name-re ";?") . font-lock-variable-name-face)))
 
 (defconst sgml-font-lock-keywords-2


@@ -263,7 +273,7 @@ Any terminating `>' or `/' is not matched.")
                      (regexp-opt (mapcar 'car sgml-tag-face-alist) t)
                      "\\([ \t][^>]*\\)?>\\([^<]+\\)</\\1>")
              '(3 (cdr (assoc (downcase (match-string 1))
                      (regexp-opt (mapcar 'car sgml-tag-face-alist) t)
                      "\\([ \t][^>]*\\)?>\\([^<]+\\)</\\1>")
              '(3 (cdr (assoc (downcase (match-string 1))

-                             sgml-tag-face-alist))))))))
+                             sgml-tag-face-alist)) prepend))))))

 
 ;; for font-lock, but must be defvar'ed after
 ;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above
 
 ;; for font-lock, but must be defvar'ed after
 ;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above


@@ -356,8 +366,8 @@ Otherwise, it is set to be buffer-local when the file has
              (looking-at "\\s-*<\\?xml")
              (when (re-search-forward
                     (eval-when-compile
              (looking-at "\\s-*<\\?xml")
              (when (re-search-forward
                     (eval-when-compile

-                      (mapconcat 'identity
-                                 '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"
+                (mapconcat 'identity
+                           '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"

                                    "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
                                  "\\s-+"))
                     nil t)
                                    "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
                                  "\\s-+"))
                     nil t)


@@ -446,6 +456,11 @@ Do \\[describe-key] on the following bindings to discover what they do.
        (concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
               sgml-name-re "\\)")))
 
        (concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
               sgml-name-re "\\)")))
 

+;; Some programs (such as Glade 2) generate XML which has
+;; -*- mode: xml -*-.
+;;;###autoload
+(defalias 'xml-mode 'sgml-mode)
+

 (defun sgml-comment-indent ()
   (if (looking-at "--") comment-column 0))
 
 (defun sgml-comment-indent ()
   (if (looking-at "--") comment-column 0))
 


@@ -520,21 +535,23 @@ encoded keyboard operation."
   (delete-backward-char 1)
   (insert char)
   (undo-boundary)
   (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'."
 
 (defun sgml-name-self ()
   "Insert a symbolic character name according to `sgml-char-names'."


@@ -565,6 +582,8 @@ This only works for Latin-1 input."
 ;; inserted literally, one should obtain it as the return value of a
 ;; function, e.g. (identity "str").
 
 ;; 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'.
 (define-skeleton sgml-tag
   "Prompt for a tag and insert it, optionally with attributes.
 Completion and configuration are done according to `sgml-tag-alist'.


@@ -572,7 +591,12 @@ If you like tags and attributes in uppercase do \\[set-variable]
 skeleton-transformation RET upcase RET, or put this in your `.emacs':
   (setq sgml-transformation 'upcase)"
   (funcall (or skeleton-transformation 'identity)
 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)) ?>
   ?< str |
   (("") -1 '(undo-boundary) (identity "&lt;")) |       ; see comment above
   `(("") '(setq v2 (sgml-attributes ,str t)) ?>


@@ -682,50 +706,61 @@ With prefix argument, only self insert."
   "Skip to beginning of tag or matching opening tag if present.
 With prefix argument ARG, repeat this ARG times."
   (interactive "p")
   "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>]+\\)")
        ;; end tag, skip any nested pairs
        (let ((case-fold-search t)
   (while (>= arg 1)
     (search-backward "<" nil t)
     (if (looking-at "</\\([^ \n\t>]+\\)")
        ;; end tag, skip any nested pairs
        (let ((case-fold-search t)

-             (re (concat "</?" (regexp-quote (match-string 1)))))
+             (re (concat "</?" (regexp-quote (match-string 1))
+                         ;; Ignore empty tags like <foo/>.
+                         "\\([^>]*[^/>]\\)?>")))

          (while (and (re-search-backward re nil t)
                      (eq (char-after (1+ (point))) ?/))
            (forward-char 1)
            (sgml-skip-tag-backward 1))))
     (setq arg (1- arg))))
 
          (while (and (re-search-backward re nil t)
                      (eq (char-after (1+ (point))) ?/))
            (forward-char 1)
            (sgml-skip-tag-backward 1))))
     (setq arg (1- arg))))
 

-(defun sgml-skip-tag-forward (arg &optional return)
+(defun sgml-skip-tag-forward (arg)

   "Skip to end of tag or matching closing tag if present.
 With prefix argument ARG, repeat this ARG times.
 Return t iff after a closing tag."
   (interactive "p")
   "Skip to end of tag or matching closing tag if present.
 With prefix argument ARG, repeat this ARG times.
 Return t iff after a closing tag."
   (interactive "p")

-  (setq 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))))
-             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))) ?/)))
-                     (not (up-list -1))
-                     (sgml-skip-tag-forward 1))
-           (setq close nil))
-         (if close
-             (up-list 1)
-           (goto-char point)
-           (setq return)))
-      (forward-list 1))
-    (setq arg (1- arg)))
-  return)
+  ;; 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))
+    (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)
 
 (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")
   "Delete tag on or after cursor, and matching closing or opening tag.
 With prefix argument ARG, repeat this ARG times."
   (interactive "p")


@@ -759,13 +794,16 @@ With prefix argument ARG, repeat this ARG times."
              (goto-char close)
              (kill-sexp 1))
          (setq open (point))
              (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)
        (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))))
 
 \f
     (setq arg (1- arg))))
 
 \f


@@ -773,7 +811,6 @@ With prefix argument ARG, repeat this ARG times."
 (or (get 'sgml-tag 'invisible)
     (setplist 'sgml-tag
              (append '(invisible t
 (or (get 'sgml-tag 'invisible)
     (setplist 'sgml-tag
              (append '(invisible t

-                       intangible t

                        point-entered sgml-point-entered
                        rear-nonsticky t
                        read-only t)
                        point-entered sgml-point-entered
                        rear-nonsticky t
                        read-only t)


@@ -938,20 +975,51 @@ See `sgml-tag-alist' for info about attribute rules."
       (insert ?\"))))
 
 (defun sgml-quote (start end &optional unquotep)
       (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
 
 \f
 ;; Parsing


@@ -971,13 +1039,19 @@ With prefix argument, unquote the region."
     (and (>= start (point-min))
          (equal str (buffer-substring-no-properties start (point))))))
 
     (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)
   "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 (re-search-backward "[<>]" limit 'move)

         (error "No tag found"))
         (error "No tag found"))

+    (when (eq (char-after) ?<)
+      ;; Oops!! Looks like we were not in a textual context after all!.
+      ;; Let's try to recover.
+      (with-syntax-table sgml-tag-syntax-table
+       (forward-sexp)
+       (forward-char -1)))

     (setq tag-end (1+ (point)))
     (cond
      ((sgml-looking-back-at "--")   ; comment
     (setq tag-end (1+ (point)))
     (cond
      ((sgml-looking-back-at "--")   ; comment


@@ -1013,15 +1087,17 @@ Leave point at the beginning of the tag."
     (goto-char tag-start)
     (sgml-make-tag tag-type tag-start tag-end name)))
 
     (goto-char tag-start)
     (sgml-make-tag tag-type tag-start tag-end name)))
 

-(defun sgml-get-context (&optional full)
+(defun sgml-get-context (&optional until)

   "Determine the context of the current position.
   "Determine the context of the current position.

-If FULL is `empty', return even if the context is empty (i.e.
+By default, parse until we find a start-tag as the first thing on a line.
+If UNTIL is `empty', return even if the context is empty (i.e.

 we just skipped over some element and got to a beginning of line).
 we just skipped over some element and got to a beginning of line).

-If FULL is non-nil, parse back to the beginning of the buffer, otherwise
-parse until we find a start-tag as the first thing on a line.

 
 The context is a list of tag-info structures.  The last one is the tag
 
 The context is a list of tag-info structures.  The last one is the tag

-immediately enclosing the current position."
+immediately enclosing the current position.
+
+Point is assumed to be outside of any tag.  If we discover that it's
+not the case, the first tag returned is the one inside which we are."

   (let ((here (point))
        (ignore nil)
        (context nil)
   (let ((here (point))
        (ignore nil)
        (context nil)


@@ -1032,22 +1108,27 @@ immediately enclosing the current position."
     ;;   enclosing start-tags we'll have to ignore.
     (skip-chars-backward " \t\n")      ; Make sure we're not at indentation.
     (while
     ;;   enclosing start-tags we'll have to ignore.
     (skip-chars-backward " \t\n")      ; Make sure we're not at indentation.
     (while

-       (and (or ignore
-                 (not (if full (eq full 'empty) context))
+       (and (not (eq until 'now))
+            (or ignore
+                (not (if until (eq until 'empty) context))

                 (not (sgml-at-indentation-p))
                 (and context
                      (/= (point) (sgml-tag-start (car context)))
                 (not (sgml-at-indentation-p))
                 (and context
                      (/= (point) (sgml-tag-start (car context)))

-                      (sgml-unclosed-tag-p (sgml-tag-name (car context)))))
+                     (sgml-unclosed-tag-p (sgml-tag-name (car context)))))

             (setq tag-info (ignore-errors (sgml-parse-tag-backward))))
             (setq tag-info (ignore-errors (sgml-parse-tag-backward))))

-      
+

       ;; This tag may enclose things we thought were tags.  If so,
       ;; discard them.
       (while (and context
                   (> (sgml-tag-end tag-info)
                      (sgml-tag-end (car context))))
         (setq context (cdr context)))
       ;; This tag may enclose things we thought were tags.  If so,
       ;; discard them.
       (while (and context
                   (> (sgml-tag-end tag-info)
                      (sgml-tag-end (car context))))
         (setq context (cdr context)))

-           
+

       (cond
       (cond

+       ((> (sgml-tag-end tag-info) here)
+       ;; Oops!!  Looks like we were not outside of any tag, after all.
+       (push tag-info context)
+       (setq until 'now))

 
        ;; start-tag
        ((eq (sgml-tag-type tag-info) 'open)
 
        ;; start-tag
        ((eq (sgml-tag-type tag-info) 'open)


@@ -1067,9 +1148,18 @@ immediately enclosing the current position."
         (t
          ;; The open and close tags don't match.
          (if (not sgml-xml-mode)
         (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))
              (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))))))
 
            (message "Unmatched tags <%s> and </%s>"
                     (sgml-tag-name tag-info) (pop ignore))))))
 


@@ -1088,13 +1178,21 @@ 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*"
 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
 
 (defun sgml-close-tag ()
 
 \f
 ;; Editing shortcuts
 
 (defun sgml-close-tag ()

-  "Insert an 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 " -->"))
   (interactive)
   (case (car (sgml-lexical-context))
     (comment   (insert " -->"))


@@ -1121,99 +1219,113 @@ If FULL is non-nil, parse back to the beginning of the buffer."
   (and (not sgml-xml-mode)
        (member-ignore-case tag-name sgml-unclosed-tags)))
 
   (and (not sgml-xml-mode)
        (member-ignore-case tag-name sgml-unclosed-tags)))
 

-(defun sgml-calculate-indent ()
-  "Calculate the column to which this line should be indented."
-  (let ((lcon (sgml-lexical-context)))
-
-    ;; Indent comment-start markers inside <!-- just like comment-end markers.
-    (if (and (eq (car lcon) 'tag)
-            (looking-at "--")
-            (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
-       (setq lcon (cons 'comment (+ (cdr lcon) 2))))
-
-    (case (car lcon)
-
-      (string
+(defun sgml-calculate-indent (&optional lcon)
+  "Calculate the column to which this line should be indented.
+LCON is the lexical context, if any."
+  (unless lcon (setq lcon (sgml-lexical-context)))
+
+  ;; Indent comment-start markers inside <!-- just like comment-end markers.
+  (if (and (eq (car lcon) 'tag)
+          (looking-at "--")
+          (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
+      (setq lcon (cons 'comment (+ (cdr lcon) 2))))
+
+  (case (car lcon)
+
+    (string
+     ;; Go back to previous non-empty line.
+     (while (and (> (point) (cdr lcon))
+                (zerop (forward-line -1))
+                (looking-at "[ \t]*$")))
+     (if (> (point) (cdr lcon))
+        ;; Previous line is inside the string.
+        (current-indentation)
+       (goto-char (cdr lcon))
+       (1+ (current-column))))
+
+    (comment
+     (let ((mark (looking-at "--")))

        ;; Go back to previous non-empty line.
        (while (and (> (point) (cdr lcon))
                   (zerop (forward-line -1))
        ;; Go back to previous non-empty line.
        (while (and (> (point) (cdr lcon))
                   (zerop (forward-line -1))

-                  (looking-at "[ \t]*$")))
+                  (or (looking-at "[ \t]*$")
+                      (if mark (not (looking-at "[ \t]*--"))))))

        (if (> (point) (cdr lcon))
        (if (> (point) (cdr lcon))

-          ;; Previous line is inside the string.
-          (current-indentation)
+          ;; Previous line is inside the comment.
+          (skip-chars-forward " \t")

         (goto-char (cdr lcon))
         (goto-char (cdr lcon))

-        (1+ (current-column))))
-
-      (comment
-       (let ((mark (looking-at "--")))
-        ;; Go back to previous non-empty line.
-        (while (and (> (point) (cdr lcon))
-                    (zerop (forward-line -1))
-                    (or (looking-at "[ \t]*$")
-                        (if mark (not (looking-at "[ \t]*--"))))))
-        (if (> (point) (cdr lcon))
-            ;; Previous line is inside the comment.
-            (skip-chars-forward " \t")
-          (goto-char (cdr lcon)))
-        (when (and (not mark) (looking-at "--"))
-          (forward-char 2) (skip-chars-forward " \t"))
-        (current-column)))
-
-      (cdata
-       (current-column))
-
-      (tag
+        ;; Skip `<!' to get to the `--' with which we want to align.
+        (search-forward "--")
+        (goto-char (match-beginning 0)))
+       (when (and (not mark) (looking-at "--"))
+        (forward-char 2) (skip-chars-forward " \t"))
+       (current-column)))
+
+    ;; We don't know how to indent it.  Let's be honest about it.
+    (cdata nil)
+
+    (tag
+     (goto-char (1+ (cdr lcon)))
+     (skip-chars-forward "^ \t\n")     ;Skip tag name.
+     (skip-chars-forward " \t")
+     (if (not (eolp))
+        (current-column)
+       ;; This is the first attribute: indent.

        (goto-char (1+ (cdr lcon)))
        (goto-char (1+ (cdr lcon)))

-       (skip-chars-forward "^ \t\n")   ;Skip tag name.
-       (skip-chars-forward " \t")
-       (if (not (eolp))
-          (current-column)
-        ;; This is the first attribute: indent.
-        (goto-char (1+ (cdr lcon)))
-        (+ (current-column) sgml-basic-offset)))
-
-      (text
-       (while (looking-at "</")
-        (forward-sexp 1)
-        (skip-chars-forward " \t"))
-       (let* ((here (point))
-             (unclosed (and ;; (not sgml-xml-mode)
-                            (looking-at sgml-tag-name-re)
-                            (member-ignore-case (match-string 1)
-                                                sgml-unclosed-tags)
-                            (match-string 1)))
-             (context
-              ;; If possible, align on the previous non-empty text line.
-              ;; Otherwise, do a more serious parsing to find the
-              ;; tag(s) relative to which we should be indenting.
-              (if (and (not unclosed) (skip-chars-backward " \t")
-                       (< (skip-chars-backward " \t\n") 0)
-                       (back-to-indentation)
-                       (> (point) (cdr lcon)))
-                  nil
-                (goto-char here)
-                (nreverse (sgml-get-context (if unclosed nil 'empty)))))
-             (there (point)))
-        ;; Ignore previous unclosed start-tag in context.
-        (while (and context unclosed
-                    (eq t (compare-strings
-                           (sgml-tag-name (car context)) nil nil
-                           unclosed nil nil t)))
-          (setq context (cdr context)))
-        ;; Indent to reflect nesting.
-        (if (and context
-                 (goto-char (sgml-tag-end (car context)))
-                 (skip-chars-forward " \t\n")
-                 (< (point) here) (sgml-at-indentation-p))
-            (current-column)
-          (goto-char there)
-          (+ (current-column)
-             (* sgml-basic-offset (length context))))))
-      
-      (otherwise
-       (error "Unrecognised context %s" (car lcon)))
-
-      )))
+       (+ (current-column) sgml-basic-offset)))
+
+    (text
+     (while (looking-at "</")
+       (forward-sexp 1)
+       (skip-chars-forward " \t"))
+     (let* ((here (point))
+           (unclosed (and ;; (not sgml-xml-mode)
+                      (looking-at sgml-tag-name-re)
+                      (member-ignore-case (match-string 1)
+                                          sgml-unclosed-tags)
+                      (match-string 1)))
+           (context
+            ;; If possible, align on the previous non-empty text line.
+            ;; Otherwise, do a more serious parsing to find the
+            ;; tag(s) relative to which we should be indenting.
+            (if (and (not unclosed) (skip-chars-backward " \t")
+                     (< (skip-chars-backward " \t\n") 0)
+                     (back-to-indentation)
+                     (> (point) (cdr lcon)))
+                nil
+              (goto-char here)
+              (nreverse (sgml-get-context (if unclosed nil 'empty)))))
+           (there (point)))
+       ;; Ignore previous unclosed start-tag in context.
+       (while (and context unclosed
+                  (eq t (compare-strings
+                         (sgml-tag-name (car context)) nil nil
+                         unclosed nil nil t)))
+        (setq context (cdr context)))
+       ;; Indent to reflect nesting.
+       (cond
+       ;; If we were not in a text context after all, let's try again.
+       ((and context (> (sgml-tag-end (car context)) here))
+        (goto-char here)
+        (sgml-calculate-indent
+         (cons (if (memq (sgml-tag-type (car context)) '(comment cdata))
+                   (sgml-tag-type (car context)) 'tag)
+               (sgml-tag-start (car context)))))
+       ;; Align on the first element after the nearest open-tag, if any.
+       ((and context
+             (goto-char (sgml-tag-end (car context)))
+             (skip-chars-forward " \t\n")
+             (< (point) here) (sgml-at-indentation-p))
+        (current-column))
+       (t
+        (goto-char there)
+        (+ (current-column)
+           (* sgml-basic-offset (length context)))))))
+
+    (otherwise
+     (error "Unrecognised context %s" (car lcon)))
+
+    ))

 
 (defun sgml-indent-line ()
   "Indent the current line as SGML."
 
 (defun sgml-indent-line ()
   "Indent the current line as SGML."


@@ -1224,9 +1336,11 @@ If FULL is non-nil, parse back to the beginning of the buffer."
            (back-to-indentation)
            (if (>= (point) savep) (setq savep nil))
            (sgml-calculate-indent))))
            (back-to-indentation)
            (if (>= (point) savep) (setq savep nil))
            (sgml-calculate-indent))))

-    (if savep
-       (save-excursion (indent-line-to indent-col))
-      (indent-line-to indent-col))))
+    (if (null indent-col)
+       'noindent
+      (if savep
+         (save-excursion (indent-line-to indent-col))
+       (indent-line-to indent-col)))))

 
 (defun sgml-guess-indent ()
   "Guess an appropriate value for `sgml-basic-offset'.
 
 (defun sgml-guess-indent ()
   "Guess an appropriate value for `sgml-basic-offset'.


@@ -1235,10 +1349,10 @@ Add this to `sgml-mode-hook' for convenience."
   (interactive)
   (save-excursion
     (goto-char (point-min))
   (interactive)
   (save-excursion
     (goto-char (point-min))

-    (if (re-search-forward "^\\([ \t]+\\)<" 100 'noerror)
+    (if (re-search-forward "^\\([ \t]+\\)<" 500 'noerror)

         (progn
           (set (make-local-variable 'sgml-basic-offset)
         (progn
           (set (make-local-variable 'sgml-basic-offset)

-               (length (match-string 1)))
+               (1- (current-column)))

           (message "Guessed sgml-basic-offset = %d"
                    sgml-basic-offset)
           ))))
           (message "Guessed sgml-basic-offset = %d"
                    sgml-basic-offset)
           ))))


@@ -1690,7 +1804,7 @@ The second `match-string' matches extra tags and is ignored.
 The third `match-string' will be the used in the menu.")
 
 (defun html-imenu-index ()
 The third `match-string' will be the used in the menu.")
 
 (defun html-imenu-index ()

-  "Return an table of contents for an HTML buffer for use with Imenu."
+  "Return a table of contents for an HTML buffer for use with Imenu."

   (let (toc-index)
     (save-excursion
       (goto-char (point-min))
   (let (toc-index)
     (save-excursion
       (goto-char (point-min))


@@ -1704,19 +1818,15 @@ The third `match-string' will be the used in the menu.")
                    toc-index))))
     (nreverse toc-index)))
 
                    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'."
   "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
+  :group 'sgml
+  (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)))

 
 \f
 (define-skeleton html-href-anchor
 
 \f
 (define-skeleton html-href-anchor


@@ -1842,4 +1952,5 @@ Can be used as a value for `html-mode-hook'."
 
 (provide 'sgml-mode)
 
 
 (provide 'sgml-mode)
 

+;;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401

 ;;; sgml-mode.el ends here
 ;;; sgml-mode.el ends here