/[emacs]/emacs/lisp/textmodes/sgml-mode.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/sgml-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.68 by monnier, Thu Mar 28 16:06:38 2002 UTC revision 1.69 by monnier, Fri Mar 29 19:38:22 2002 UTC
# Line 41  Line 41 
41    "SGML editing mode"    "SGML editing mode"
42    :group 'languages)    :group 'languages)
43    
44    (defcustom sgml-basic-offset 2
45      "*Specifies the basic indentation level for `sgml-indent-line'."
46      :type 'integer
47      :group 'sgml)
48    
49  (defcustom sgml-transformation 'identity  (defcustom sgml-transformation 'identity
50    "*Default value for `skeleton-transformation' (which see) in SGML mode."    "*Default value for `skeleton-transformation' (which see) in SGML mode."
51    :type 'function    :type 'function
# Line 237  separated by a space." Line 242  separated by a space."
242    :type '(choice (const nil) integer)    :type '(choice (const nil) integer)
243    :group 'sgml)    :group 'sgml)
244    
245  (defconst sgml-tag-name-re "<\\([!/?]?[[:alpha:]][-_.:[:alnum:]]*\\)")  (defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*")
246  (defconst sgml-start-tag-regex  (defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)"))
247    "<[[:alpha:]]\\([-_.:[:alnum:]= \n\t]\\|\"[^\"]*\"\\|'[^']*'\\)*"  (defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*")
248    (defconst sgml-start-tag-regex (concat "<" sgml-name-re sgml-attrs-re)
249    "Regular expression that matches a non-empty start tag.    "Regular expression that matches a non-empty start tag.
250  Any terminating `>' or `/' is not matched.")  Any terminating `>' or `/' is not matched.")
251    
252    
253  ;; internal  ;; internal
254  (defconst sgml-font-lock-keywords-1  (defconst sgml-font-lock-keywords-1
255    '(("<\\([!?][[:alpha:]][-_.:[:alnum:]]*\\)" 1 font-lock-keyword-face)    `((,(concat "<\\([!?]" sgml-name-re "\\)") 1 font-lock-keyword-face)
256      ("<\\(/?[[:alpha:]][-_.:[:alnum:]]*\\)" 1 font-lock-function-name-face)      (,(concat "<\\(/?" sgml-name-re"\\)") 1 font-lock-function-name-face)
257      ;; FIXME: this doesn't cover the variables using a default value.      ;; FIXME: this doesn't cover the variables using a default value.
258      ("\\([[:alpha:]][-_.:[:alnum:]]*\\)=[\"']" 1 font-lock-variable-name-face)      (,(concat "\\(" sgml-name-re "\\)=[\"']") 1 font-lock-variable-name-face)
259      ("[&%][[:alpha:]][-_.:[:alnum:]]*;?" . font-lock-variable-name-face)))      (,(concat "[&%]" sgml-name-re ";?") . font-lock-variable-name-face)))
260    
261  (defconst sgml-font-lock-keywords-2  (defconst sgml-font-lock-keywords-2
262    (append    (append
# Line 344  Otherwise, it is set to be buffer-local Line 350  Otherwise, it is set to be buffer-local
350  (defvar sgml-empty-tags nil  (defvar sgml-empty-tags nil
351    "List of tags whose !ELEMENT definition says EMPTY.")    "List of tags whose !ELEMENT definition says EMPTY.")
352    
353    (defvar sgml-unclosed-tags nil
354      "List of tags whose !ELEMENT definition says the end-tag is optional.")
355    
356  (defun sgml-xml-guess ()  (defun sgml-xml-guess ()
357    "Guess whether the current buffer is XML."    "Guess whether the current buffer is XML."
358    (save-excursion    (save-excursion
# Line 396  Do \\[describe-key] on the following bin Line 405  Do \\[describe-key] on the following bin
405    ;; A start or end tag by itself on a line separates a paragraph.    ;; A start or end tag by itself on a line separates a paragraph.
406    ;; This is desirable because SGML discards a newline that appears    ;; This is desirable because SGML discards a newline that appears
407    ;; immediately after a start tag or immediately before an end tag.    ;; immediately after a start tag or immediately before an end tag.
408    (set (make-local-variable 'paragraph-separate) "[ \t]*$\\|\    (set (make-local-variable 'paragraph-start) (concat "[ \t]*$\\|\
409  \[ \t]*</?\\([[:alpha:]]\\([-_.:[:alnum:]= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$")  \[ \t]*</?\\(" sgml-name-re sgml-attrs-re "\\)?>"))
410    (set (make-local-variable 'paragraph-start) "[ \t]*$\\|\    (set (make-local-variable 'paragraph-separate)
411  \[ \t]*</?\\([[:alpha:]]\\([-_.:[:alnum:]= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>")         (concat paragraph-start "$"))
412    (set (make-local-variable 'adaptive-fill-regexp) "[ \t]*")    (set (make-local-variable 'adaptive-fill-regexp) "[ \t]*")
413    (set (make-local-variable 'comment-start) "<!-- ")    (set (make-local-variable 'comment-start) "<!-- ")
414    (set (make-local-variable 'comment-end) " -->")    (set (make-local-variable 'comment-end) " -->")
# Line 430  Do \\[describe-key] on the following bin Line 439  Do \\[describe-key] on the following bin
439    (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")    (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
440    ;; This definition probably is not useful in derived modes.    ;; This definition probably is not useful in derived modes.
441    (set (make-local-variable 'imenu-generic-expression)    (set (make-local-variable 'imenu-generic-expression)
442         "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\([[:alpha:]][-_.:[:alnum:]]*\\)"))         (concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
443                   sgml-name-re "\\)")))
444    
445    
446  (defun sgml-comment-indent ()  (defun sgml-comment-indent ()
# Line 846  If non-nil LIMIT is a nearby position be Line 856  If non-nil LIMIT is a nearby position be
856    (save-excursion    (save-excursion
857      (let ((pos (point))      (let ((pos (point))
858            (state nil))            (state nil))
859        ;; Hopefully this regexp will match something that's not inside        (if limit (goto-char limit)
860        ;; a tag and also hopefully the match is nearby.          ;; Hopefully this regexp will match something that's not inside
861        (when (or (and limit (goto-char limit))          ;; a tag and also hopefully the match is nearby.
862                  (re-search-backward "^[ \t]*<" nil t))          (re-search-backward "^[ \t]*<[_:[:alpha:]/%!?#]" nil 'move))
863          (with-syntax-table sgml-tag-syntax-table        (with-syntax-table sgml-tag-syntax-table
864            (while (< (point) pos)          (while (< (point) pos)
865              ;; When entering this loop we're inside text.            ;; When entering this loop we're inside text.
866              (skip-chars-forward "^<" pos)            (skip-chars-forward "^<" pos)
867              ;; We skipped text and reached a tag.  Parse it.            ;; We skipped text and reached a tag.  Parse it.
868              ;; FIXME: this does not handle CDATA and funny stuff yet.            ;; FIXME: this does not handle CDATA and funny stuff yet.
869              (setq state (parse-partial-sexp (point) pos 0)))            (setq state (parse-partial-sexp (point) pos 0)))
870            (cond          (cond
871             ((nth 3 state) (cons 'string (nth 8 state)))           ((nth 3 state) (cons 'string (nth 8 state)))
872             ((nth 4 state) (cons 'comment (nth 8 state)))           ((nth 4 state) (cons 'comment (nth 8 state)))
873             ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))           ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))
874             (t nil)))))))           (t nil))))))
875    
876  (defun sgml-beginning-of-tag (&optional top-level)  (defun sgml-beginning-of-tag (&optional top-level)
877    "Skip to beginning of tag and return its name.    "Skip to beginning of tag and return its name.
# Line 965  With prefix argument, unquote the region Line 975  With prefix argument, unquote the region
975         (let ((context (xml-lite-get-context)))         (let ((context (xml-lite-get-context)))
976           (cond           (cond
977            ((null context) 0)            ; no context            ((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))  
978            (t            (t
979             (let ((here (point)))             (let ((here (point)))
980               (goto-char (xml-lite-tag-end (car context)))               (goto-char (xml-lite-tag-end (car context)))
981               (skip-chars-forward " \t\n")               (skip-chars-forward " \t\n")
982               (if (< (point) here)               (if (and (< (point) here) (xml-lite-at-indentation-p))
983                   (current-column)                   (current-column)
984                 (goto-char (xml-lite-tag-start (car context)))                 (goto-char (xml-lite-tag-start (car context)))
985                 (+ (current-column) sgml-basic-offset))))))))))                 (+ (current-column)
986                      (* sgml-basic-offset (length context))))))))))))
987    
988  (defun sgml-indent-line ()  (defun sgml-indent-line ()
989    "Indent the current line as SGML."    "Indent the current line as SGML."
# Line 984  With prefix argument, unquote the region Line 991  With prefix argument, unquote the region
991    (let* ((savep (point))    (let* ((savep (point))
992           (indent-col           (indent-col
993            (save-excursion            (save-excursion
994              (beginning-of-line)              (back-to-indentation)
             (skip-chars-forward " \t")  
995              (if (>= (point) savep) (setq savep nil))              (if (>= (point) savep) (setq savep nil))
             ;; calculate basic indent  
996              (sgml-calculate-indent))))              (sgml-calculate-indent))))
997      (if savep      (if savep
998          (save-excursion (indent-line-to indent-col))          (save-excursion (indent-line-to indent-col))
999        (indent-line-to indent-col))))        (indent-line-to indent-col))))
1000    
1001    (defun sgml-parse-dtd ()
1002      "Simplistic parse of the current buffer as a DTD.
1003    Currently just returns (EMPTY-TAGS UNCLOSED-TAGS)."
1004      (goto-char (point-min))
1005      (let ((empty nil)
1006            (unclosed nil))
1007        (while (re-search-forward "<!ELEMENT[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+[-O][ \t\n]+\\([-O]\\)[ \t\n]+\\([^ \t\n]+\\)" nil t)
1008          (cond
1009           ((string= (match-string 3) "EMPTY")
1010            (push (match-string-no-properties 1) empty))
1011           ((string= (match-string 2) "O")
1012            (push (match-string-no-properties 1) unclosed))))
1013        (setq empty (sort (mapcar 'downcase empty) 'string<))
1014        (setq unclosed (sort (mapcar 'downcase unclosed) 'string<))
1015        (list empty unclosed)))
1016    
1017  ;;; HTML mode  ;;; HTML mode
1018    
1019  (defcustom html-mode-hook nil  (defcustom html-mode-hook nil
# Line 1404  To work around that, do: Line 1425  To work around that, do:
1425    (setq imenu-create-index-function 'html-imenu-index)    (setq imenu-create-index-function 'html-imenu-index)
1426    (when sgml-xml-mode (setq mode-name "XHTML"))    (when sgml-xml-mode (setq mode-name "XHTML"))
1427    (set (make-local-variable 'sgml-empty-tags)    (set (make-local-variable 'sgml-empty-tags)
1428         '("br" "hr" "img" "input" "area" "link" "param" "col"         ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd',
1429           "base" "meta" "basefont" "frame" "isindex" "wbr"))         ;; plus manual addition of "wbr".
1430           '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input"
1431             "isindex" "link" "meta" "param" "wbr"))
1432      (set (make-local-variable 'sgml-unclosed-tags)
1433           ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'.
1434           '("body" "colgroup" "dd" "dt" "head" "html" "li" "option"
1435             "p" "tbody" "td" "tfoot" "th" "thead" "tr"))
1436    ;; It's for the user to decide if it defeats it or not  -stef    ;; It's for the user to decide if it defeats it or not  -stef
1437    ;; (make-local-variable 'imenu-sort-function)    ;; (make-local-variable 'imenu-sort-function)
1438    ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose    ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose

Legend:
Removed from v.1.68  
changed lines
  Added in v.1.69

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26