X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/73b0cd50031a714347109169ceb8bacae338612a..51721edc6ba92f9c7cb6a2daab45bb538a696f3d:/lisp/textmodes/sgml-mode.el

diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 8f06e029d4..d2f1307b6c 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1,9 +1,10 @@
 ;;; sgml-mode.el --- SGML- and HTML-editing modes -*- coding: utf-8 -*-
 
-;; Copyright (C) 1992, 1995-1996, 1998, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1995-1996, 1998, 2001-2014 Free Software
+;; Foundation, Inc.
 
 ;; Author: James Clark <jjc@jclark.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Adapted-By: ESR, Daniel Pfeiffer <occitan@esperanto.org>,
 ;;             F.Potorti@cnuce.cnr.it
 ;; Keywords: wp, hypermedia, comm, languages
@@ -33,8 +34,7 @@
 
 (eval-when-compile
   (require 'skeleton)
-  (require 'outline)
-  (require 'cl))
+  (require 'cl-lib))
 
 (defgroup sgml nil
   "SGML editing mode."
@@ -46,9 +46,26 @@
   :type 'integer
   :group 'sgml)
 
+(defcustom sgml-xml-mode nil
+  "When non-nil, tag insertion functions will be XML-compliant.
+It is set to be buffer-local when the file has
+a DOCTYPE or an XML declaration."
+  :type 'boolean
+  :version "22.1"
+  :group 'sgml)
+
 (defcustom sgml-transformation-function 'identity
   "Default value for `skeleton-transformation-function' in SGML mode."
   :type 'function
+  :initialize 'custom-initialize-default
+  :set (lambda (sym val)
+         (set-default sym val)
+         (mapc (lambda (buff)
+                 (with-current-buffer buff
+                   (and (derived-mode-p 'sgml-mode)
+                        (not sgml-xml-mode)
+                        (setq skeleton-transformation-function val))))
+               (buffer-list)))
   :group 'sgml)
 
 (put 'sgml-transformation-function 'variable-interactive
@@ -61,7 +78,7 @@
   :group 'sgml
   :type 'hook)
 
-;; As long as Emacs' syntax can't be complemented with predicates to context
+;; As long as Emacs's syntax can't be complemented with predicates to context
 ;; sensitively confirm the syntax of characters, we have to live with this
 ;; kludgy kind of tradeoff.
 (defvar sgml-specials '(?\")
@@ -291,12 +308,12 @@ Any terminating `>' or `/' is not matched.")
 ;; for font-lock, but must be defvar'ed after
 ;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above
 (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
-  "*Rules for highlighting SGML code.  See also `sgml-tag-face-alist'.")
+  "Rules for highlighting SGML code.  See also `sgml-tag-face-alist'.")
 
 (defconst sgml-syntax-propertize-function
   (syntax-propertize-rules
-  ;; Use the `b' style of comments to avoid interference with the -- ... --
-  ;; comments recognized when `sgml-specials' includes ?-.
+   ;; Use the `b' style of comments to avoid interference with the -- ... --
+   ;; comments recognized when `sgml-specials' includes ?-.
   ;; FIXME: beware of <!--> blabla <!--> !!
    ("\\(<\\)!--" (1 "< b"))
     ("--[ \t\n]*\\(>\\)" (1 "> b"))
@@ -305,7 +322,7 @@ Any terminating `>' or `/' is not matched.")
     ;; going to change, so as not to need to flush the data we just computed.
     ("\"" (0 (if (prog1 (zerop (car (syntax-ppss (match-beginning 0))))
                    (goto-char (match-end 0)))
-                 "."))))
+           (string-to-syntax ".")))))
   "Syntactic keywords for `sgml-mode'.")
 
 ;; internal
@@ -364,14 +381,6 @@ an optional alist of possible values."
 		       (string :tag "Description")))
   :group 'sgml)
 
-(defcustom sgml-xml-mode nil
-  "When non-nil, tag insertion functions will be XML-compliant.
-It is set to be buffer-local when the file has
-a DOCTYPE or an XML declaration."
-  :type 'boolean
-  :version "22.1"
-  :group 'sgml)
-
 (defvar sgml-empty-tags nil
   "List of tags whose !ELEMENT definition says EMPTY.")
 
@@ -426,7 +435,12 @@ a DOCTYPE or an XML declaration."
 		  (format-mode-line mode-name))))))
 
 (defun sgml-fill-nobreak ()
-  ;; Don't break between a tag name and its first argument.
+  "Don't break between a tag name and its first argument.
+This function is designed for use in `fill-nobreak-predicate'.
+
+    <a href=\"some://where\" type=\"text/plain\">
+      ^                   ^
+      | no break here     | but still allowed here"
   (save-excursion
     (skip-chars-backward " \t")
     (and (not (zerop (skip-syntax-backward "w_")))
@@ -445,7 +459,7 @@ 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-function 'upcase)
-in your `.emacs' file.
+in your init file.
 
 Use \\[sgml-validate] to validate your document with an SGML parser.
 
@@ -458,47 +472,39 @@ Do \\[describe-key] on the following bindings to discover what they do.
   ;; 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]*$\\|\
+  (setq-local 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]*")
+  (setq-local paragraph-separate (concat paragraph-start "$"))
+  (setq-local adaptive-fill-regexp "[ \t]*")
   (add-hook 'fill-nobreak-predicate 'sgml-fill-nobreak nil t)
-  (set (make-local-variable 'indent-line-function) 'sgml-indent-line)
-  (set (make-local-variable 'comment-start) "<!-- ")
-  (set (make-local-variable 'comment-end) " -->")
-  (set (make-local-variable 'comment-indent-function) 'sgml-comment-indent)
-  (set (make-local-variable 'comment-line-break-function)
-       'sgml-comment-indent-new-line)
-  (set (make-local-variable 'skeleton-further-elements)
-       '((completion-ignore-case t)))
-  (set (make-local-variable 'skeleton-end-hook)
-       (lambda ()
-         (or (eolp)
-             (not (or (eq v2 '\n) (eq (car-safe v2) '\n)))
-             (newline-and-indent))))
-  (set (make-local-variable 'font-lock-defaults)
-       '((sgml-font-lock-keywords
-          sgml-font-lock-keywords-1
-          sgml-font-lock-keywords-2)
-         nil t))
-  (set (make-local-variable 'syntax-propertize-function)
-       sgml-syntax-propertize-function)
-  (set (make-local-variable 'facemenu-add-face-function)
-       'sgml-mode-facemenu-add-face-function)
-  (set (make-local-variable 'sgml-xml-mode) (sgml-xml-guess))
-  (if sgml-xml-mode
-      ()
-    (set (make-local-variable 'skeleton-transformation-function)
-         sgml-transformation-function))
+  (setq-local indent-line-function 'sgml-indent-line)
+  (setq-local comment-start "<!-- ")
+  (setq-local comment-end " -->")
+  (setq-local comment-indent-function 'sgml-comment-indent)
+  (setq-local comment-line-break-function 'sgml-comment-indent-new-line)
+  (setq-local skeleton-further-elements '((completion-ignore-case t)))
+  (setq-local skeleton-end-hook
+	      (lambda ()
+		(or (eolp)
+		    (not (or (eq v2 '\n) (eq (car-safe v2) '\n)))
+		    (newline-and-indent))))
+  (setq font-lock-defaults '((sgml-font-lock-keywords
+			      sgml-font-lock-keywords-1
+			      sgml-font-lock-keywords-2)
+			     nil t))
+  (setq-local syntax-propertize-function sgml-syntax-propertize-function)
+  (setq-local facemenu-add-face-function 'sgml-mode-facemenu-add-face-function)
+  (setq-local sgml-xml-mode (sgml-xml-guess))
+  (unless sgml-xml-mode
+    (setq-local skeleton-transformation-function sgml-transformation-function))
   ;; This will allow existing comments within declarations to be
   ;; recognized.
   ;; I can't find a clear description of SGML/XML comments, but it seems that
   ;; the only reliable ones are <!-- ... --> although it's not clear what
   ;; "..." can contain.  It used to accept -- ... -- as well, but that was
   ;; apparently a mistake.
-  (set (make-local-variable 'comment-start-skip) "<!--[ \t]*")
-  (set (make-local-variable 'comment-end-skip) "[ \t]*--[ \t\n]*>")
+  (setq-local comment-start-skip "<!--[ \t]*")
+  (setq-local comment-end-skip "[ \t]*--[ \t\n]*>")
   ;; This definition has an HTML leaning but probably fits well for other modes.
   (setq imenu-generic-expression
 	`((nil
@@ -638,10 +644,8 @@ This only works for Latin-1 input."
 (define-skeleton sgml-tag
   "Prompt for a tag and insert it, optionally with attributes.
 Completion and configuration are done according to `sgml-tag-alist'.
-If you like tags and attributes in uppercase do \\[set-variable]
-`skeleton-transformation-function' RET `upcase' RET, or put this
-in your `.emacs':
-  (setq sgml-transformation-function 'upcase)"
+If you like tags and attributes in uppercase, customize
+`sgml-transformation-function' to 'upcase."
   (funcall (or skeleton-transformation-function 'identity)
            (setq sgml-tag-last
 		 (completing-read
@@ -666,13 +670,13 @@ in your `.emacs':
       (if (eq v2 t) (setq v2 nil))
       ;; We use `identity' to prevent skeleton from passing
       ;; `str' through `skeleton-transformation-function' a second time.
-      '(("") v2 _ v2 "</" (identity ',str) ?>))
+      '(("") v2 _ v2 "</" (identity ',str) ?> >))
      ((eq (car v2) t)
       (cons '("") (cdr v2)))
      (t
       (append '(("") (car v2))
 	      (cdr v2)
-	      '(resume: (car v2) _ "</" (identity ',str) ?>))))))
+	      '(resume: (car v2) _ "</" (identity ',str) ?> >))))))
 
 (autoload 'skeleton-read "skeleton")
 
@@ -835,7 +839,14 @@ Return non-nil if we skipped over matched tags."
     (delete-overlay (pop sgml-electric-tag-pair-overlays))))
 
 (define-minor-mode sgml-electric-tag-pair-mode
-  "Automatically update the closing tag when editing the opening one."
+  "Toggle SGML Electric Tag Pair mode.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise.  If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
+SGML Electric Tag Pair mode is a buffer-local minor mode for use
+with `sgml-mode' and related major modes.  When enabled, editing
+an opening markup tag automatically updates the closing tag."
   :lighter "/e"
   (if sgml-electric-tag-pair-mode
       (progn
@@ -970,10 +981,10 @@ With prefix argument ARG, repeat this ARG times."
     (unwind-protect
 	(save-excursion
 	  (goto-char (point-min))
-	  (if (set (make-local-variable 'sgml-tags-invisible)
-		   (if arg
-		       (>= (prefix-numeric-value arg) 0)
-		     (not sgml-tags-invisible)))
+	  (if (setq-local sgml-tags-invisible
+			  (if arg
+			      (>= (prefix-numeric-value arg) 0)
+			    (not sgml-tags-invisible)))
 	      (while (re-search-forward sgml-tag-name-re nil t)
 		(setq string
 		      (cdr (assq (intern-soft (downcase (match-string 1)))
@@ -1179,7 +1190,7 @@ You might want to turn on `auto-fill-mode' to get better results."
 
 ;; Parsing
 
-(defstruct (sgml-tag
+(cl-defstruct (sgml-tag
             (:constructor sgml-make-tag (type start end name)))
   type start end name)
 
@@ -1259,7 +1270,7 @@ Leave point at the beginning of the tag."
                      (throw 'found (sgml-parse-tag-backward limit))))
                   (point))))
 	(goto-char (1+ tag-start))
-	(case (char-after)
+	(pcase (char-after)
 	  (?! (setq tag-type 'decl))    ; declaration
 	  (?? (setq tag-type 'pi))      ; processing-instruction
 	  (?% (setq tag-type 'jsp))	; JSP tags
@@ -1267,7 +1278,7 @@ Leave point at the beginning of the tag."
 	   (forward-char 1)
 	   (setq tag-type 'close
 		 name (sgml-parse-tag-name)))
-	  (t				; open or empty tag
+	  (_				; open or empty tag
 	   (setq tag-type 'open
 		 name (sgml-parse-tag-name))
 	   (if (or (eq ?/ (char-before (- tag-end 1)))
@@ -1392,19 +1403,19 @@ If FULL is non-nil, parse back to the beginning of the buffer."
 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 " -->"))
-    (cdata 	(insert "]]>"))
-    (pi 	(insert " ?>"))
-    (jsp 	(insert " %>"))
-    (tag 	(insert " />"))
-    (text
+  (pcase (car (sgml-lexical-context))
+    (`comment 	(insert " -->"))
+    (`cdata 	(insert "]]>"))
+    (`pi 	(insert " ?>"))
+    (`jsp 	(insert " %>"))
+    (`tag 	(insert " />"))
+    (`text
      (let ((context (save-excursion (sgml-get-context))))
        (if context
            (progn
              (insert "</" (sgml-tag-name (car (last context))) ">")
              (indent-according-to-mode)))))
-    (otherwise
+    (_
      (error "Nothing to close"))))
 
 (defun sgml-empty-tag-p (tag-name)
@@ -1429,9 +1440,9 @@ LCON is the lexical context, if any."
 	   (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
       (setq lcon (cons 'comment (+ (cdr lcon) 2))))
 
-  (case (car lcon)
+  (pcase (car lcon)
 
-    (string
+    (`string
      ;; Go back to previous non-empty line.
      (while (and (> (point) (cdr lcon))
 		 (zerop (forward-line -1))
@@ -1442,7 +1453,7 @@ LCON is the lexical context, if any."
        (goto-char (cdr lcon))
        (1+ (current-column))))
 
-    (comment
+    (`comment
      (let ((mark (looking-at "--")))
        ;; Go back to previous non-empty line.
        (while (and (> (point) (cdr lcon))
@@ -1461,11 +1472,11 @@ LCON is the lexical context, if any."
        (current-column)))
 
     ;; We don't know how to indent it.  Let's be honest about it.
-    (cdata nil)
+    (`cdata nil)
     ;; We don't know how to indent it.  Let's be honest about it.
-    (pi nil)
+    (`pi nil)
 
-    (tag
+    (`tag
      (goto-char (1+ (cdr lcon)))
      (skip-chars-forward "^ \t\n")	;Skip tag name.
      (skip-chars-forward " \t")
@@ -1475,7 +1486,7 @@ LCON is the lexical context, if any."
        (goto-char (1+ (cdr lcon)))
        (+ (current-column) sgml-basic-offset)))
 
-    (text
+    (`text
      (while (looking-at "</")
        (forward-sexp 1)
        (skip-chars-forward " \t"))
@@ -1523,7 +1534,7 @@ LCON is the lexical context, if any."
 	 (+ (current-column)
 	    (* sgml-basic-offset (length context)))))))
 
-    (otherwise
+    (_
      (error "Unrecognized context %s" (car lcon)))
 
     ))
@@ -1545,15 +1556,14 @@ LCON is the lexical context, if any."
 
 (defun sgml-guess-indent ()
   "Guess an appropriate value for `sgml-basic-offset'.
-Base the guessed identation level on the first indented tag in the buffer.
+Base the guessed indentation level on the first indented tag in the buffer.
 Add this to `sgml-mode-hook' for convenience."
   (interactive)
   (save-excursion
     (goto-char (point-min))
     (if (re-search-forward "^\\([ \t]+\\)<" 500 'noerror)
         (progn
-          (set (make-local-variable 'sgml-basic-offset)
-               (1- (current-column)))
+          (setq-local sgml-basic-offset (1- (current-column)))
           (message "Guessed sgml-basic-offset = %d"
                    sgml-basic-offset)
           ))))
@@ -1651,7 +1661,7 @@ This takes effect when first loading the library.")
   '((bold . "b")
     (italic . "i")
     (underline . "u")
-    (modeline . "rev"))
+    (mode-line . "rev"))
   "Value of `sgml-face-tag-alist' for HTML mode.")
 
 (defvar html-tag-face-alist
@@ -1667,7 +1677,7 @@ This takes effect when first loading the library.")
     ("h5" . underline)
     ("h6" . underline)
     ("i" . italic)
-    ("rev"  . modeline)
+    ("rev"  . mode-line)
     ("s" . underline)
     ("small" . default)
     ("strong" . bold)
@@ -1830,7 +1840,7 @@ This takes effect when first loading the library.")
       ("u")
       ("var")
       ("wbr" t)))
-  "*Value of `sgml-tag-alist' for HTML mode.")
+  "Value of `sgml-tag-alist' for HTML mode.")
 
 (defvar html-tag-help
   `(,@sgml-tag-help
@@ -1859,7 +1869,7 @@ This takes effect when first loading the library.")
     ("dir" . "Directory list (obsolete)")
     ("div" . "Generic block-level container")
     ("dl" . "Definition list")
-    ("dt" . "Term to be definined")
+    ("dt" . "Term to be defined")
     ("em" . "Emphasized")
     ("embed" . "Embedded data in foreign format")
     ("fig" . "Figure")
@@ -1884,7 +1894,7 @@ This takes effect when first loading the library.")
     ("input" . "Form input field")
     ("ins" . "Inserted text")
     ("isindex" . "Input field for index search")
-    ("kbd" . "Keybard example face")
+    ("kbd" . "Keyboard example face")
     ("lang" . "Natural language")
     ("li" . "List item")
     ("link" . "Link relationship")
@@ -1923,7 +1933,24 @@ This takes effect when first loading the library.")
     ("ul" . "Unordered list")
     ("var" . "Math variable face")
     ("wbr" . "Enable <br> within <nobr>"))
-  "*Value of `sgml-tag-help' for HTML mode.")
+  "Value of variable `sgml-tag-help' for HTML mode.")
+
+(defvar outline-regexp)
+(defvar outline-heading-end-regexp)
+(defvar outline-level)
+
+(defun html-current-defun-name ()
+  "Return the name of the last HTML title or heading, or nil."
+  (save-excursion
+    (if (re-search-backward
+	 (concat
+	  "<[ \t\r\n]*"
+	  "\\(?:[hH][0-6]\\|title\\|TITLE\\|Title\\)"
+	  "[^>]*>"
+	  "[ \t\r\n]*"
+	  "\\([^<\r\n]*[^ <\t\r\n]+\\)")
+	 nil t)
+	(match-string-no-properties 1))))
 
 
 ;;;###autoload
@@ -1963,33 +1990,29 @@ To work around that, do:
    (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
 
 \\{html-mode-map}"
-  (set (make-local-variable 'sgml-display-text) html-display-text)
-  (set (make-local-variable 'sgml-tag-face-alist) html-tag-face-alist)
-  (make-local-variable 'sgml-tag-alist)
-  (make-local-variable 'sgml-face-tag-alist)
-  (make-local-variable 'sgml-tag-help)
-  (make-local-variable 'outline-regexp)
-  (make-local-variable 'outline-heading-end-regexp)
-  (make-local-variable 'outline-level)
-  (make-local-variable 'sentence-end-base)
-  (setq sentence-end-base "[.?!][]\"'”)}]*\\(<[^>]*>\\)*"
-	sgml-tag-alist html-tag-alist
-	sgml-face-tag-alist html-face-tag-alist
-	sgml-tag-help html-tag-help
-	outline-regexp "^.*<[Hh][1-6]\\>"
-	outline-heading-end-regexp "</[Hh][1-6]>"
-	outline-level (lambda ()
-			(char-before (match-end 0))))
+  (setq-local sgml-display-text html-display-text)
+  (setq-local sgml-tag-face-alist html-tag-face-alist)
+  (setq-local sgml-tag-alist html-tag-alist)
+  (setq-local sgml-face-tag-alist html-face-tag-alist)
+  (setq-local sgml-tag-help html-tag-help)
+  (setq-local outline-regexp "^.*<[Hh][1-6]\\>")
+  (setq-local outline-heading-end-regexp "</[Hh][1-6]>")
+  (setq-local outline-level
+	      (lambda () (char-before (match-end 0))))
+  (setq-local add-log-current-defun-function #'html-current-defun-name)
+  (setq-local sentence-end-base "[.?!][]\"'”)}]*\\(<[^>]*>\\)*")
+
   (setq imenu-create-index-function 'html-imenu-index)
-  (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"))
+
+  (setq-local 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"))
+  (setq-local 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
@@ -1997,7 +2020,7 @@ To work around that, do:
 
 (defvar html-imenu-regexp
   "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
-  "*A regular expression matching a head line to be added to the menu.
+  "A regular expression matching a head line to be added to the menu.
 The first `match-string' should be a number from 1-9.
 The second `match-string' matches extra tags and is ignored.
 The third `match-string' will be the used in the menu.")
@@ -2018,9 +2041,14 @@ The third `match-string' will be the used in the menu.")
     (nreverse toc-index)))
 
 (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 viewing of HTML files on save (HTML Autoview mode).
+With a prefix argument ARG, enable HTML Autoview mode if ARG is
+positive, and disable it otherwise.  If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+HTML Autoview mode is a buffer-local minor mode for use with
+`html-mode'.  If enabled, saving the file automatically runs
+`browse-url-of-buffer' to view it."
   nil nil nil
   :group 'sgml
   (if html-autoview-mode