(sgml-make-syntax-table): New fun.

(sgml-mode-syntax-table): Use it.
(sgml-tag-syntax-table, sgml-tag-name-re): New const.
(sgml-tags-invisible): Use it.
(sgml-lexical-context): New fun.
(sgml-maybe-end-tag, sgml-beginning-of-tag): Use it.
(sgml-quote): Accept \n as entity reference terminator.
(sgml-calculate-indent, sgml-indent-line): New funs.

1 files changed, 150 insertions, 40 deletions

diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index ad5df701171..415d69eb800 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -132,19 +132,31 @@ This takes effect when first loading the `sgml-mode' library.")
   "Keymap for SGML mode.  See also `sgml-specials'.")
 
 
-(defvar sgml-mode-syntax-table
-  (let ((table (copy-syntax-table text-mode-syntax-table)))
+(defun sgml-make-syntax-table (specials)
+  (let ((table (make-syntax-table text-mode-syntax-table)))
     (modify-syntax-entry ?< "(>" table)
     (modify-syntax-entry ?> ")<" table)
-    (if (memq ?- sgml-specials)
+    (modify-syntax-entry ?: "_" table)
+    (modify-syntax-entry ?_ "_" table)
+    (modify-syntax-entry ?. "_" table)
+    (if (memq ?- specials)
         (modify-syntax-entry ?- "_ 1234" table))
-    (if (memq ?\" sgml-specials)
+    (if (memq ?\" specials)
         (modify-syntax-entry ?\" "\"\"" table))
-    (if (memq ?' sgml-specials)
+    (if (memq ?' specials)
         (modify-syntax-entry ?\' "\"'" table))
-    table)
+    table))
+
+(defvar sgml-mode-syntax-table (sgml-make-syntax-table sgml-specials)
   "Syntax table used in SGML mode.  See also `sgml-specials'.")
 
+(defconst sgml-tag-syntax-table
+  (let ((table (sgml-make-syntax-table '(?- ?\" ?\'))))
+    (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/))
+      (modify-syntax-entry char "." table))
+    table)
+  "Syntax table used to parse SGML tags.")
+
 
 (defcustom sgml-name-8bit-mode nil
   "*When non-nil, insert non-ASCII characters as named entities."
@@ -225,6 +237,7 @@ separated by a space."
   :type '(choice (const nil) integer)
   :group 'sgml)
 
+(defconst sgml-tag-name-re "<\\([!/?]?[[:alpha:]][-_.:[:alnum:]]*\\)")
 (defconst sgml-start-tag-regex
   "<[[:alpha:]]\\([-_.:[:alnum:]= \n\t]\\|\"[^\"]*\"\\|'[^']*'\\)*"
   "Regular expression that matches a non-empty start tag.
@@ -235,7 +248,7 @@ Any terminating `>' or `/' is not matched.")
 (defconst sgml-font-lock-keywords-1
   '(("<\\([!?][[:alpha:]][-_.:[:alnum:]]*\\)" 1 font-lock-keyword-face)
     ("<\\(/?[[:alpha:]][-_.:[:alnum:]]*\\)" 1 font-lock-function-name-face)
-    ;; FIXME: this doesn't cover the variable using a default value.
+    ;; FIXME: this doesn't cover the variables using a default value.
     ("\\([[:alpha:]][-_.:[:alnum:]]*\\)=[\"']" 1 font-lock-variable-name-face)
     ("[&%][[:alpha:]][-_.:[:alnum:]]*;?" . font-lock-variable-name-face)))
 
@@ -634,20 +647,12 @@ With prefix argument, only self insert."
                "No description available")))
 
 
-(defun sgml-maybe-end-tag ()
-  "Name self unless in position to end a tag."
-  (interactive)
-  (or (condition-case nil
-          (save-excursion (up-list -1))
-        (error
-         (sgml-name-self)
-         t))
-      (condition-case nil
-          (progn
-            (save-excursion (up-list 1))
-            (sgml-name-self))
-        (error (self-insert-command 1)))))
-
+(defun sgml-maybe-end-tag (&optional arg)
+  "Name self unless in position to end a tag or a prefix ARG is given."
+  (interactive "P")
+  (if (or arg (eq (car (sgml-lexical-context)) 'tag))
+      (self-insert-command (prefix-numeric-value arg))
+    (sgml-name-self)))
 
 (defun sgml-skip-tag-backward (arg)
   "Skip to beginning of tag or matching opening tag if present.
@@ -769,8 +774,7 @@ With prefix argument ARG, repeat this ARG times."
                    (if arg
                        (>= (prefix-numeric-value arg) 0)
                      (not sgml-tags-invisible)))
-              (while (re-search-forward "<\\([!/?]?[[:alpha:]][-_.:[:alnum:]]*\\)"
-                                        nil t)
+              (while (re-search-forward sgml-tag-name-re nil t)
                 (setq string
                       (cdr (assq (intern-soft (downcase (match-string 1)))
                                  sgml-display-text)))
@@ -829,24 +833,49 @@ and move to the line in the SGML document that caused it."
   (compile-internal command "No more errors"))
 
 
+(defun sgml-lexical-context (&optional limit)
+  "Return the lexical context at point as (TYPE . START).
+START is the location of the start of the lexical element.
+TYPE is one of `string', `comment', `tag', `cdata', ....
+Return nil if we are inside text (i.e. outside of any kind of tag).
+
+If non-nil LIMIT is a nearby position before point outside of any tag."
+  ;; As usual, it's difficult to get a reliable answer without parsing the
+  ;; whole buffer.  We'll assume that a tag at indentation is outside of
+  ;; any string or tag or comment or ...
+  (save-excursion
+    (let ((pos (point))
+          (state nil))
+      ;; Hopefully this regexp will match something that's not inside
+      ;; a tag and also hopefully the match is nearby.
+      (when (or (and limit (goto-char limit))
+                (re-search-backward "^[ \t]*<" nil t))
+        (with-syntax-table sgml-tag-syntax-table
+          (while (< (point) pos)
+            ;; When entering this loop we're inside text.
+            (skip-chars-forward "^<" pos)
+            ;; We skipped text and reached a tag.  Parse it.
+            ;; FIXME: this does not handle CDATA and funny stuff yet.
+            (setq state (parse-partial-sexp (point) pos 0)))
+          (cond
+           ((nth 3 state) (cons 'string (nth 8 state)))
+           ((nth 4 state) (cons 'comment (nth 8 state)))
+           ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))
+           (t nil)))))))
+
 (defun sgml-beginning-of-tag (&optional top-level)
   "Skip to beginning of tag and return its name.
-If this can't be done, return t."
-  (or (if top-level
-          (condition-case nil
-              (up-list -1)
-            (error t))
-        (>= (point)
-            (if (search-backward "<" nil t)
-                (save-excursion
-                  (forward-list)
-                  (point))
-              0)))
-      (if (looking-at "<[!/?]?[[:alpha:]][-_.:[:alnum:]]*")
-          (buffer-substring-no-properties
-           (1+ (point))
-           (match-end 0))
-        t)))
+If this can't be done, return nil."
+  (let ((context (sgml-lexical-context)))
+    (if (eq (car context) 'tag)
+        (progn
+          (goto-char (cdr context))
+          (when (looking-at sgml-tag-name-re)
+            (match-string-no-properties 1)))
+      (if top-level nil
+        (when context
+          (goto-char (cdr context))
+          (sgml-beginning-of-tag t))))))
 
 (defun sgml-value (alist)
   "Interactively insert value taken from attributerule ALIST.
@@ -875,7 +904,7 @@ With prefix argument, unquote the region."
     (goto-char end)
     (setq end start))
   (if unquotep
-      (while (re-search-forward "&\\(amp\\|\\(l\\|\\(g\\)\\)t\\);" end t)
+      (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;")
@@ -883,6 +912,87 @@ With prefix argument, unquote the region."
                                                 (?> . "&gt;"))))))))
 
 
+(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
+       ;; 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))
+                     (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)))
+
+      (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)))
+         (+ (current-column) sgml-basic-offset)))
+
+      (t
+       (while (looking-at "</")
+         (forward-sexp 1)
+         (skip-chars-forward " \t"))
+       (let ((context (xml-lite-get-context)))
+         (cond
+          ((null context) 0)            ; no context
+          ;; Align closing tag with the opening one.
+          ;; ((and (eq (length context) 1) (looking-at "</"))
+          ;;  (goto-char (xml-lite-tag-start (car context)))
+          ;;  (current-column))
+          (t
+           (let ((here (point)))
+             (goto-char (xml-lite-tag-end (car context)))
+             (skip-chars-forward " \t\n")
+             (if (< (point) here)
+                 (current-column)
+               (goto-char (xml-lite-tag-start (car context)))
+               (+ (current-column) sgml-basic-offset))))))))))
+
+(defun sgml-indent-line ()
+  "Indent the current line as SGML."
+  (interactive)
+  (let* ((savep (point))
+         (indent-col
+          (save-excursion
+            (beginning-of-line)
+            (skip-chars-forward " \t")
+            (if (>= (point) savep) (setq savep nil))
+            ;; calculate basic indent
+            (sgml-calculate-indent))))
+    (if savep
+        (save-excursion (indent-line-to indent-col))
+      (indent-line-to indent-col))))
+
 ;;; HTML mode
 
 (defcustom html-mode-hook nil