[Emacs-diffs] Changes to emacs/lisp/textmodes/sgml-mode.el

[Stefan Monnier]

Index: emacs/lisp/textmodes/sgml-mode.el
diff -c emacs/lisp/textmodes/sgml-mode.el:1.68 
emacs/lisp/textmodes/sgml-mode.el:1.69
*** emacs/lisp/textmodes/sgml-mode.el:1.68      Thu Mar 28 11:06:38 2002
--- emacs/lisp/textmodes/sgml-mode.el   Fri Mar 29 14:38:22 2002
***************
*** 41,46 ****
--- 41,51 ----
    "SGML editing mode"
    :group 'languages)
  
+ (defcustom sgml-basic-offset 2
+   "*Specifies the basic indentation level for `sgml-indent-line'."
+   :type 'integer
+   :group 'sgml)
+ 
  (defcustom sgml-transformation 'identity
    "*Default value for `skeleton-transformation' (which see) in SGML mode."
    :type 'function
***************
*** 237,256 ****
    :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.
  Any terminating `>' or `/' is not matched.")
  
  
  ;; internal
  (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 variables using a default value.
!     ("\\([[:alpha:]][-_.:[:alnum:]]*\\)=[\"']" 1 font-lock-variable-name-face)
!     ("[&%][[:alpha:]][-_.:[:alnum:]]*;?" . font-lock-variable-name-face)))
  
  (defconst sgml-font-lock-keywords-2
    (append
--- 242,262 ----
    :type '(choice (const nil) integer)
    :group 'sgml)
  
! (defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*")
! (defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)"))
! (defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*")
! (defconst sgml-start-tag-regex (concat "<" sgml-name-re sgml-attrs-re)
    "Regular expression that matches a non-empty start tag.
  Any terminating `>' or `/' is not matched.")
  
  
  ;; 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)
      ;; FIXME: this doesn't cover the variables using a default value.
!     (,(concat "\\(" sgml-name-re "\\)=[\"']") 1 font-lock-variable-name-face)
!     (,(concat "[&%]" sgml-name-re ";?") . font-lock-variable-name-face)))
  
  (defconst sgml-font-lock-keywords-2
    (append
***************
*** 344,349 ****
--- 350,358 ----
  (defvar sgml-empty-tags nil
    "List of tags whose !ELEMENT definition says EMPTY.")
  
+ (defvar sgml-unclosed-tags nil
+   "List of tags whose !ELEMENT definition says the end-tag is optional.")
+ 
  (defun sgml-xml-guess ()
    "Guess whether the current buffer is XML."
    (save-excursion
***************
*** 396,405 ****
    ;; A start or end tag by itself on a line separates a paragraph.
    ;; This is desirable because SGML discards a newline that appears
    ;; immediately after a start tag or immediately before an end tag.
!   (set (make-local-variable 'paragraph-separate) "[ \t]*$\\|\
! \[ \t]*</?\\([[:alpha:]]\\([-_.:[:alnum:]= 
\t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$")
!   (set (make-local-variable 'paragraph-start) "[ \t]*$\\|\
! \[ \t]*</?\\([[:alpha:]]\\([-_.:[:alnum:]= 
\t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>")
    (set (make-local-variable 'adaptive-fill-regexp) "[ \t]*")
    (set (make-local-variable 'comment-start) "<!-- ")
    (set (make-local-variable 'comment-end) " -->")
--- 405,414 ----
    ;; A start or end tag by itself on a line separates a paragraph.
    ;; This is desirable because SGML discards a newline that appears
    ;; immediately after a start tag or immediately before an end tag.
!   (set (make-local-variable 'paragraph-start) (concat "[ \t]*$\\|\
! \[ \t]*</?\\(" sgml-name-re sgml-attrs-re "\\)?>"))
!   (set (make-local-variable 'paragraph-separate)
!        (concat paragraph-start "$"))
    (set (make-local-variable 'adaptive-fill-regexp) "[ \t]*")
    (set (make-local-variable 'comment-start) "<!-- ")
    (set (make-local-variable 'comment-end) " -->")
***************
*** 430,436 ****
    (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
    ;; This definition probably is not useful in derived modes.
    (set (make-local-variable 'imenu-generic-expression)
!        "<!\\(element\\|entity\\)[ \t\n]+%?[ 
\t\n]*\\([[:alpha:]][-_.:[:alnum:]]*\\)"))
  
  
  (defun sgml-comment-indent ()
--- 439,446 ----
    (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
    ;; This definition probably is not useful in derived modes.
    (set (make-local-variable 'imenu-generic-expression)
!        (concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
!              sgml-name-re "\\)")))
  
  
  (defun sgml-comment-indent ()
***************
*** 846,867 ****
    (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.
--- 856,877 ----
    (save-excursion
      (let ((pos (point))
          (state nil))
!       (if limit (goto-char limit)
!       ;; Hopefully this regexp will match something that's not inside
!       ;; a tag and also hopefully the match is nearby.
!       (re-search-backward "^[ \t]*<[_:[:alpha:]/%!?#]" nil 'move))
!       (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.
***************
*** 965,982 ****
         (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."
--- 975,989 ----
         (let ((context (xml-lite-get-context)))
         (cond
          ((null context) 0)            ; no context
          (t
           (let ((here (point)))
             (goto-char (xml-lite-tag-end (car context)))
             (skip-chars-forward " \t\n")
!            (if (and (< (point) here) (xml-lite-at-indentation-p))
                 (current-column)
               (goto-char (xml-lite-tag-start (car context)))
!              (+ (current-column)
!                 (* sgml-basic-offset (length context))))))))))))
  
  (defun sgml-indent-line ()
    "Indent the current line as SGML."
***************
*** 984,998 ****
    (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
--- 991,1019 ----
    (let* ((savep (point))
         (indent-col
          (save-excursion
!           (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))))
  
+ (defun sgml-parse-dtd ()
+   "Simplistic parse of the current buffer as a DTD.
+ Currently just returns (EMPTY-TAGS UNCLOSED-TAGS)."
+   (goto-char (point-min))
+   (let ((empty nil)
+       (unclosed nil))
+     (while (re-search-forward "<!ELEMENT[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+[-O][ 
\t\n]+\\([-O]\\)[ \t\n]+\\([^ \t\n]+\\)" nil t)
+       (cond
+        ((string= (match-string 3) "EMPTY")
+       (push (match-string-no-properties 1) empty))
+        ((string= (match-string 2) "O")
+       (push (match-string-no-properties 1) unclosed))))
+     (setq empty (sort (mapcar 'downcase empty) 'string<))
+     (setq unclosed (sort (mapcar 'downcase unclosed) 'string<))
+     (list empty unclosed)))
+ 
  ;;; HTML mode
  
  (defcustom html-mode-hook nil
***************
*** 1404,1411 ****
    (setq imenu-create-index-function 'html-imenu-index)
    (when sgml-xml-mode (setq mode-name "XHTML"))
    (set (make-local-variable 'sgml-empty-tags)
!        '("br" "hr" "img" "input" "area" "link" "param" "col"
!        "base" "meta" "basefont" "frame" "isindex" "wbr"))
    ;; It's for the user to decide if it defeats it or not  -stef
    ;; (make-local-variable 'imenu-sort-function)
    ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
--- 1425,1438 ----
    (setq imenu-create-index-function 'html-imenu-index)
    (when sgml-xml-mode (setq mode-name "XHTML"))
    (set (make-local-variable 'sgml-empty-tags)
!        ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd',
!        ;; plus manual addition of "wbr".
!        '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input"
!        "isindex" "link" "meta" "param" "wbr"))
!   (set (make-local-variable 'sgml-unclosed-tags)
!        ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'.
!        '("body" "colgroup" "dd" "dt" "head" "html" "li" "option"
!        "p" "tbody" "td" "tfoot" "th" "thead" "tr"))
    ;; It's for the user to decide if it defeats it or not  -stef
    ;; (make-local-variable 'imenu-sort-function)
    ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose