/[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.66 by monnier, Mon Mar 4 02:14:06 2002 UTC revision 1.67 by monnier, Sun Mar 17 23:55:15 2002 UTC
# Line 319  an optional alist of possible values." Line 319  an optional alist of possible values."
319                         (string :tag "Description")))                         (string :tag "Description")))
320    :group 'sgml)    :group 'sgml)
321    
322  (defcustom sgml-xml nil  (defcustom sgml-xml-mode nil
323    "*When non-nil, tag insertion functions will be XML-compliant.    "*When non-nil, tag insertion functions will be XML-compliant.
324  If this variable is customized, the custom value is used always.  If this variable is customized, the custom value is used always.
325  Otherwise, it is set to be buffer-local when the file has  Otherwise, it is set to be buffer-local when the file has
# Line 335  Otherwise, it is set to be buffer-local Line 335  Otherwise, it is set to be buffer-local
335    "Guess whether the current buffer is XML."    "Guess whether the current buffer is XML."
336    (save-excursion    (save-excursion
337      (goto-char (point-min))      (goto-char (point-min))
338      (cond ((or (string= "xml" (file-name-extension (or buffer-file-name "")))      (when (or (string= "xml" (file-name-extension (or buffer-file-name "")))
339                 (looking-at "\\s-*<\\?xml"))                (looking-at "\\s-*<\\?xml")
340             (set (make-local-variable 'sgml-xml) t))                (when (re-search-forward
341            ((re-search-forward                       (eval-when-compile
342              (eval-when-compile                         (mapconcat 'identity
343               (mapconcat 'identity                                    '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"
344                          '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"                                      "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
345                            "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")                                    "\\s-+"))
346                          "\\s-+"))                       nil t)
347              nil t)                  (string-match "X\\(HT\\)?ML" (match-string 3))))
348             (let ((name (match-string 1))        (set (make-local-variable 'sgml-xml-mode) t))))
                  (pub (match-string 2))  
                  (id (match-string 3))  
                  (url (match-string 4)))  
              (cond ((string= name "html")  
                     (set (make-local-variable 'sgml-xml)  
                          (not (null (string-match "XHTML" id)))))  
                    ((string-match "XML" id)  
                     (set (make-local-variable 'sgml-xml) t))))))))  
349    
350  (defvar v2)                             ; free for skeleton  (defvar v2)                             ; free for skeleton
351    
352  (defun sgml-mode-common ()  (defun sgml-mode-facemenu-add-face-function (face end)
353    "Common code for setting up `sgml-mode' and derived modes."    (if (setq face (cdr (assq face sgml-face-tag-alist)))
354          (progn
355            (setq face (funcall skeleton-transformation face))
356            (setq facemenu-end-add-face (concat "</" face ">"))
357            (concat "<" face ">"))
358        (error "Face not configured for %s mode" mode-name)))
359    
360    
361    ;;;###autoload
362    (define-derived-mode sgml-mode text-mode "SGML"
363      "Major mode for editing SGML documents.
364    Makes > match <.
365    Keys <, &, SPC within <>, \" and ' can be electric depending on
366    `sgml-quick-keys'.
367    
368    An argument of N to a tag-inserting command means to wrap it around
369    the next N words.  In Transient Mark mode, when the mark is active,
370    N defaults to -1, which means to wrap it around the current region.
371    
372    If you like upcased tags, put (setq sgml-transformation 'upcase) in
373    your `.emacs' file.
374    
375    Use \\[sgml-validate] to validate your document with an SGML parser.
376    
377    Do \\[describe-variable] sgml- SPC to see available variables.
378    Do \\[describe-key] on the following bindings to discover what they do.
379    \\{sgml-mode-map}"
380    (make-local-variable 'sgml-saved-validate-command)    (make-local-variable 'sgml-saved-validate-command)
381    (make-local-variable 'facemenu-end-add-face)    (make-local-variable 'facemenu-end-add-face)
382    ;;(make-local-variable 'facemenu-remove-face-function)    ;;(make-local-variable 'facemenu-remove-face-function)
   (set (make-local-variable 'indent-line-function) 'indent-relative-maybe)  
383    ;; 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.
384    ;; This is desirable because SGML discards a newline that appears    ;; This is desirable because SGML discards a newline that appears
385    ;; immediately after a start tag or immediately before an end tag.    ;; immediately after a start tag or immediately before an end tag.
# Line 374  Otherwise, it is set to be buffer-local Line 391  Otherwise, it is set to be buffer-local
391    (set (make-local-variable 'comment-start) "<!-- ")    (set (make-local-variable 'comment-start) "<!-- ")
392    (set (make-local-variable 'comment-end) " -->")    (set (make-local-variable 'comment-end) " -->")
393    (set (make-local-variable 'comment-indent-function) 'sgml-comment-indent)    (set (make-local-variable 'comment-indent-function) 'sgml-comment-indent)
   (set (make-local-variable 'skeleton-transformation) sgml-transformation)  
394    (set (make-local-variable 'skeleton-further-elements)    (set (make-local-variable 'skeleton-further-elements)
395         '((completion-ignore-case t)))         '((completion-ignore-case t)))
396    (set (make-local-variable 'skeleton-end-hook)    (set (make-local-variable 'skeleton-end-hook)
# Line 391  Otherwise, it is set to be buffer-local Line 407  Otherwise, it is set to be buffer-local
407            . sgml-font-lock-syntactic-keywords)))            . sgml-font-lock-syntactic-keywords)))
408    (set (make-local-variable 'facemenu-add-face-function)    (set (make-local-variable 'facemenu-add-face-function)
409         'sgml-mode-facemenu-add-face-function)         'sgml-mode-facemenu-add-face-function)
410    ;; `sgml-xml' not customized -- guess    (sgml-xml-guess)
411    (unless (get 'sgml-xml 'saved-value) (sgml-xml-guess))    (if sgml-xml-mode
412          (setq mode-name "XML")
413        (set (make-local-variable 'skeleton-transformation) sgml-transformation))
414    ;; This will allow existing comments within declarations to be    ;; This will allow existing comments within declarations to be
415    ;; recognized.    ;; recognized.
416    (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")    (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
417    (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?"))    (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
418      ;; This definition probably is not useful in derived modes.
   
 (defun sgml-mode-facemenu-add-face-function (face end)  
   (if (setq face (cdr (assq face sgml-face-tag-alist)))  
       (progn  
         (setq face (funcall skeleton-transformation face))  
         (setq facemenu-end-add-face (concat "</" face ">"))  
         (concat "<" face ">"))  
     (error "Face not configured for %s mode" mode-name)))  
   
   
 ;;;###autoload  
 (define-derived-mode sgml-mode text-mode "SGML"  
   "Major mode for editing SGML documents.  
 Makes > match <.  Makes / blink matching /.  
 Keys <, &, SPC within <>, \" and ' can be electric depending on  
 `sgml-quick-keys'.  
   
 An argument of N to a tag-inserting command means to wrap it around  
 the next N words.  In Transient Mark mode, when the mark is active,  
 N defaults to -1, which means to wrap it around the current region.  
   
 If you like upcased tags, put (setq sgml-transformation 'upcase) in  
 your `.emacs' file.  
   
 Use \\[sgml-validate] to validate your document with an SGML parser.  
   
 Do \\[describe-variable] sgml- SPC to see available variables.  
 Do \\[describe-key] on the following bindings to discover what they do.  
 \\{sgml-mode-map}"  
   (sgml-mode-common)  
   (when sgml-xml (setq mode-name "XML"))  
   ;; Set `imenu-generic-expression' here, rather than in `sgml-mode-common',  
   ;; because this definition probably is not useful in HTML mode.  
419    (set (make-local-variable 'imenu-generic-expression)    (set (make-local-variable 'imenu-generic-expression)
420         "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\([[:alpha:]][-_.:[:alnum:]]*\\)"))         "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\([[:alpha:]][-_.:[:alnum:]]*\\)"))
421    
# Line 556  skeleton-transformation RET upcase RET, Line 541  skeleton-transformation RET upcase RET,
541       ((string= "![" ,str)       ((string= "![" ,str)
542        (backward-char)        (backward-char)
543        '(("") " [ " _ " ]]"))        '(("") " [ " _ " ]]"))
544       ((and (eq v2 t) sgml-xml (member ,str sgml-empty-tags))       ((and (eq v2 t) sgml-xml-mode (member ,str sgml-empty-tags))
545        '(("") -1 "/>"))        '(("") -1 "/>"))
546       ((or (and (eq v2 t) (not sgml-xml)) (string-match "^[/!?]" ,str))       ((or (and (eq v2 t) (not sgml-xml-mode)) (string-match "^[/!?]" ,str))
547        nil)        nil)
548       ((symbolp v2)       ((symbolp v2)
549        ;; Make sure we don't fall into an infinite loop.        ;; Make sure we don't fall into an infinite loop.
# Line 869  See `sgml-tag-alist' for info about attr Line 854  See `sgml-tag-alist' for info about attr
854    (setq alist (cdr alist))    (setq alist (cdr alist))
855    (if (stringp (car alist))    (if (stringp (car alist))
856        (insert "=\"" (car alist) ?\")        (insert "=\"" (car alist) ?\")
857      (if (and (eq (car alist) t) (not sgml-xml))      (if (and (eq (car alist) t) (not sgml-xml-mode))
858          (when (cdr alist)          (when (cdr alist)
859            (insert "=\"")            (insert "=\"")
860            (setq alist (skeleton-read '(completing-read "Value: " (cdr alist))))            (setq alist (skeleton-read '(completing-read "Value: " (cdr alist))))
# Line 1026  This takes effect when first loading the Line 1011  This takes effect when first loading the
1011                   ("rev" ,@rel)                   ("rev" ,@rel)
1012                   ("title")))                   ("title")))
1013           (list '((nil \n ("List item: " "<li>" str           (list '((nil \n ("List item: " "<li>" str
1014                            (if sgml-xml "</li>") \n))))                            (if sgml-xml-mode "</li>") \n))))
1015           (cell `(t           (cell `(t
1016                   ,@align                   ,@align
1017                   ("valign" ,@valign)                   ("valign" ,@valign)
# Line 1040  This takes effect when first loading the Line 1025  This takes effect when first loading the
1025        ("dir" ,@list)        ("dir" ,@list)
1026        ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)        ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)
1027        ("form" (\n _ \n "<input type=\"submit\" value=\"\""        ("form" (\n _ \n "<input type=\"submit\" value=\"\""
1028                 (if sgml-xml "/>" ">"))                 (if sgml-xml-mode "/>" ">"))
1029         ("action" ,@(cdr href)) ("method" ("get") ("post")))         ("action" ,@(cdr href)) ("method" ("get") ("post")))
1030        ("h1" ,@align)        ("h1" ,@align)
1031        ("h2" ,@align)        ("h2" ,@align)
# Line 1062  This takes effect when first loading the Line 1047  This takes effect when first loading the
1047        ("p" t ,@align)        ("p" t ,@align)
1048        ("select" (nil \n        ("select" (nil \n
1049                       ("Text: "                       ("Text: "
1050                        "<option>" str (if sgml-xml "</option>") \n))                        "<option>" str (if sgml-xml-mode "</option>") \n))
1051         ,name ("size" ,@1-9) ("multiple" t))         ,name ("size" ,@1-9) ("multiple" t))
1052        ("table" (nil \n        ("table" (nil \n
1053                      ((completing-read "Cell kind: " '(("td") ("th"))                      ((completing-read "Cell kind: " '(("td") ("th"))
1054                                        nil t "t")                                        nil t "t")
1055                       "<tr><" str ?> _                       "<tr><" str ?> _
1056                       (if sgml-xml (concat "<" str "></tr>")) \n))                       (if sgml-xml-mode (concat "<" str "></tr>")) \n))
1057         ("border" t ,@1-9) ("width" "10") ("cellpadding"))         ("border" t ,@1-9) ("width" "10") ("cellpadding"))
1058        ("td" ,@cell)        ("td" ,@cell)
1059        ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))        ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
# Line 1081  This takes effect when first loading the Line 1066  This takes effect when first loading the
1066        ("acronym")        ("acronym")
1067        ("address")        ("address")
1068        ("array" (nil \n        ("array" (nil \n
1069                      ("Item: " "<item>" str (if sgml-xml "</item>") \n))                      ("Item: " "<item>" str (if sgml-xml-mode "</item>") \n))
1070         "align")         "align")
1071        ("au")        ("au")
1072        ("b")        ("b")
# Line 1090  This takes effect when first loading the Line 1075  This takes effect when first loading the
1075        ("blockquote" \n)        ("blockquote" \n)
1076        ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#")        ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#")
1077         ("link" "#") ("alink" "#") ("vlink" "#"))         ("link" "#") ("alink" "#") ("vlink" "#"))
1078        ("box" (nil _ "<over>" _ (if sgml-xml "</over>")))        ("box" (nil _ "<over>" _ (if sgml-xml-mode "</over>")))
1079        ("br" t ("clear" ("left") ("right")))        ("br" t ("clear" ("left") ("right")))
1080        ("caption" ("valign" ("top") ("bottom")))        ("caption" ("valign" ("top") ("bottom")))
1081        ("center" \n)        ("center" \n)
1082        ("cite")        ("cite")
1083        ("code" \n)        ("code" \n)
1084        ("dd" ,(not sgml-xml))        ("dd" ,(not sgml-xml-mode))
1085        ("del")        ("del")
1086        ("dfn")        ("dfn")
1087        ("div")        ("div")
1088        ("dl" (nil \n        ("dl" (nil \n
1089                   ( "Term: "                   ( "Term: "
1090                     "<dt>" str (if sgml-xml "</dt>")                     "<dt>" str (if sgml-xml-mode "</dt>")
1091                     "<dd>" _ (if sgml-xml "</dd>") \n)))                     "<dd>" _ (if sgml-xml-mode "</dd>") \n)))
1092        ("dt" (t _ (if sgml-xml "</dt>")        ("dt" (t _ (if sgml-xml-mode "</dt>")
1093               "<dd>" (if sgml-xml "</dd>") \n))               "<dd>" (if sgml-xml-mode "</dd>") \n))
1094        ("em")        ("em")
1095        ;("fn" "id" "fn")  ; ???        ;("fn" "id" "fn")  ; ???
1096        ("head" \n)        ("head" \n)
# Line 1124  This takes effect when first loading the Line 1109  This takes effect when first loading the
1109        ("isindex" t ("action") ("prompt"))        ("isindex" t ("action") ("prompt"))
1110        ("kbd")        ("kbd")
1111        ("lang")        ("lang")
1112        ("li" ,(not sgml-xml))        ("li" ,(not sgml-xml-mode))
1113        ("math" \n)        ("math" \n)
1114        ("nobr")        ("nobr")
1115        ("option" t ("value") ("label") ("selected" t))        ("option" t ("value") ("label") ("selected" t))
# Line 1307  To work around that, do: Line 1292  To work around that, do:
1292          outline-level (lambda ()          outline-level (lambda ()
1293                          (char-before (match-end 0))))                          (char-before (match-end 0))))
1294    (setq imenu-create-index-function 'html-imenu-index)    (setq imenu-create-index-function 'html-imenu-index)
1295    (when sgml-xml (setq mode-name "XHTML"))    (when sgml-xml-mode (setq mode-name "XHTML"))
1296    (set (make-local-variable 'sgml-empty-tags)    (set (make-local-variable 'sgml-empty-tags)
1297         '("br" "hr" "img" "input" "area" "link" "param" "col"         '("br" "hr" "img" "input" "area" "link" "param" "col"
1298           "base" "meta" "basefont" "frame" "isindex" "wbr"))           "base" "meta" "basefont" "frame" "isindex" "wbr"))
# Line 1396  Can be used as a value for `html-mode-ho Line 1381  Can be used as a value for `html-mode-ho
1381  (define-skeleton html-horizontal-rule  (define-skeleton html-horizontal-rule
1382    "HTML horizontal rule tag."    "HTML horizontal rule tag."
1383    nil    nil
1384    (if sgml-xml "<hr/>" "<hr>") \n)    (if sgml-xml-mode "<hr/>" "<hr>") \n)
1385    
1386  (define-skeleton html-image  (define-skeleton html-image
1387    "HTML image tag."    "HTML image tag."
1388    nil    nil
1389    "<img src=\"" _ "\""    "<img src=\"" _ "\""
1390    (if sgml-xml "/>" ">"))    (if sgml-xml-mode "/>" ">"))
1391    
1392  (define-skeleton html-line  (define-skeleton html-line
1393    "HTML line break tag."    "HTML line break tag."
1394    nil    nil
1395    (if sgml-xml "<br/>" "<br>") \n)    (if sgml-xml-mode "<br/>" "<br>") \n)
1396    
1397  (define-skeleton html-ordered-list  (define-skeleton html-ordered-list
1398    "HTML ordered list tags."    "HTML ordered list tags."
1399    nil    nil
1400    "<ol>" \n    "<ol>" \n
1401    "<li>" _ (if sgml-xml "</li>") \n    "<li>" _ (if sgml-xml-mode "</li>") \n
1402    "</ol>")    "</ol>")
1403    
1404  (define-skeleton html-unordered-list  (define-skeleton html-unordered-list
1405    "HTML unordered list tags."    "HTML unordered list tags."
1406    nil    nil
1407    "<ul>" \n    "<ul>" \n
1408    "<li>" _ (if sgml-xml "</li>") \n    "<li>" _ (if sgml-xml-mode "</li>") \n
1409    "</ul>")    "</ul>")
1410    
1411  (define-skeleton html-list-item  (define-skeleton html-list-item
1412    "HTML list item tag."    "HTML list item tag."
1413    nil    nil
1414    (if (bolp) nil '\n)    (if (bolp) nil '\n)
1415    "<li>" _ (if sgml-xml "</li>"))    "<li>" _ (if sgml-xml-mode "</li>"))
1416    
1417  (define-skeleton html-paragraph  (define-skeleton html-paragraph
1418    "HTML paragraph tag."    "HTML paragraph tag."
1419    nil    nil
1420    (if (bolp) nil ?\n)    (if (bolp) nil ?\n)
1421    \n "<p>" _ (if sgml-xml "</p>"))    \n "<p>" _ (if sgml-xml-mode "</p>"))
1422    
1423  (define-skeleton html-checkboxes  (define-skeleton html-checkboxes
1424    "Group of connected checkbox inputs."    "Group of connected checkbox inputs."
# Line 1446  Can be used as a value for `html-mode-ho Line 1431  Can be used as a value for `html-mode-ho
1431     "\" value=\"" str ?\"     "\" value=\"" str ?\"
1432     (when (y-or-n-p "Set \"checked\" attribute? ")     (when (y-or-n-p "Set \"checked\" attribute? ")
1433       (funcall skeleton-transformation " checked"))       (funcall skeleton-transformation " checked"))
1434     (if sgml-xml "/>" ">")     (if sgml-xml-mode "/>" ">")
1435     (skeleton-read "Text: " (capitalize str))     (skeleton-read "Text: " (capitalize str))
1436     (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")     (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
1437                         (funcall skeleton-transformation                         (funcall skeleton-transformation
1438                                  (if sgml-xml "<br/>" "<br>"))                                  (if sgml-xml-mode "<br/>" "<br>"))
1439                       "")))                       "")))
1440     \n))     \n))
1441    
# Line 1465  Can be used as a value for `html-mode-ho Line 1450  Can be used as a value for `html-mode-ho
1450     "\" value=\"" str ?\"     "\" value=\"" str ?\"
1451     (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))     (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
1452       (funcall skeleton-transformation " checked"))       (funcall skeleton-transformation " checked"))
1453     (if sgml-xml "/>" ">")     (if sgml-xml-mode "/>" ">")
1454     (skeleton-read "Text: " (capitalize str))     (skeleton-read "Text: " (capitalize str))
1455     (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")     (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
1456                                 (funcall skeleton-transformation                                 (funcall skeleton-transformation
1457                                          (if sgml-xml "<br/>" "<br>"))                                          (if sgml-xml-mode "<br/>" "<br>"))
1458                               "")))                               "")))
1459     \n))     \n))
1460    

Legend:
Removed from v.1.66  
changed lines
  Added in v.1.67

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