X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/c73bd236f75b742ad4642ec94798987ae6e3e1e8..2ef3c1449c876f7c9fb327e90c59b6f4df4e4df0:/lisp/textmodes/sgml-mode.el

diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 181234e429..6cd4121bd1 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1,7 +1,7 @@
-;;; sgml-mode.el --- SGML- and HTML-editing modes -*- coding: iso-2022-7bit -*-
+;;; sgml-mode.el --- SGML- and HTML-editing modes -*- coding: utf-8 -*-
 
 ;; Copyright (C) 1992, 1995, 1996, 1998, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: James Clark <jjc@jclark.com>
 ;; Maintainer: FSF
@@ -11,10 +11,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -22,9 +22,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -103,6 +101,11 @@ This takes effect when first loading the `sgml-mode' library.")
     (define-key map "\C-c\^?" 'sgml-delete-tag)
     (define-key map "\C-c?" 'sgml-tag-help)
     (define-key map "\C-c/" 'sgml-close-tag)
+
+    ;; Redundant keybindings, for consistency with TeX mode.
+    (define-key map "\C-c\C-o" 'sgml-tag)
+    (define-key map "\C-c\C-e" 'sgml-close-tag)
+
     (define-key map "\C-c8" 'sgml-name-8bit-mode)
     (define-key map "\C-c\C-v" 'sgml-validate)
     (when sgml-quick-keys
@@ -157,9 +160,12 @@ This takes effect when first loading the `sgml-mode' library.")
   "Syntax table used in SGML mode.  See also `sgml-specials'.")
 
 (defconst sgml-tag-syntax-table
-  (let ((table (sgml-make-syntax-table '(?- ?\" ?\'))))
+  (let ((table (sgml-make-syntax-table sgml-specials)))
     (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/))
       (modify-syntax-entry char "." table))
+    (unless (memq ?' sgml-specials)
+      ;; Avoid that skipping a tag backwards skips any "'" prefixing it.
+      (modify-syntax-entry ?' "w" table))
     table)
   "Syntax table used to parse SGML tags.")
 
@@ -292,7 +298,13 @@ Any terminating `>' or `/' is not matched.")
   ;; comments recognized when `sgml-specials' includes ?-.
   ;; FIXME: beware of <!--> blabla <!--> !!
   '(("\\(<\\)!--" (1 "< b"))
-    ("--[ \t\n]*\\(>\\)" (1 "> b")))
+    ("--[ \t\n]*\\(>\\)" (1 "> b"))
+    ;; Double quotes outside of tags should not introduce strings.
+    ;; Be careful to call `syntax-ppss' on a position before the one we're
+    ;; 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)))
+                 "."))))
   "Syntactic keywords for `sgml-mode'.")
 
 ;; internal
@@ -390,12 +402,24 @@ a DOCTYPE or an XML declaration."
     (comment-indent-new-line soft)))
 
 (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-function face))
-	(setq facemenu-end-add-face (concat "</" face ">"))
-	(concat "<" face ">"))
-    (error "Face not configured for %s mode" mode-name)))
+  (let ((tag-face (cdr (assq face sgml-face-tag-alist))))
+    (cond (tag-face
+	   (setq tag-face (funcall skeleton-transformation-function tag-face))
+	   (setq facemenu-end-add-face (concat "</" tag-face ">"))
+	   (concat "<" tag-face ">"))
+	  ((and (consp face)
+		(consp (car face))
+		(null  (cdr face))
+		(memq (caar face) '(:foreground :background)))
+	   (setq facemenu-end-add-face "</span>")
+	   (format "<span style=\"%s:%s\">"
+		   (if (eq (caar face) :foreground)
+		       "color"
+		     "background-color")
+		   (cadr (car face))))
+	  (t
+	   (error "Face not configured for %s mode"
+		  (format-mode-line mode-name))))))
 
 (defun sgml-fill-nobreak ()
   ;; Don't break between a tag name and its first argument.
@@ -465,8 +489,12 @@ Do \\[describe-key] on the following bindings to discover what they do.
          sgml-transformation-function))
   ;; This will allow existing comments within declarations to be
   ;; recognized.
-  (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
-  (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
+  ;; 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]*>")
   ;; This definition has an HTML leaning but probably fits well for other modes.
   (setq imenu-generic-expression
 	`((nil
@@ -484,11 +512,6 @@ Do \\[describe-key] on the following bindings to discover what they do.
 		    "\\)\\(" sgml-name-re "\\)\\1")
 	   2))))
 
-;; Some programs (such as Glade 2) generate XML which has
-;; -*- mode: xml -*-.
-;;;###autoload
-(defalias 'xml-mode 'sgml-mode)
-
 (defun sgml-comment-indent ()
   (if (looking-at "--") comment-column 0))
 
@@ -584,17 +607,13 @@ Uses `sgml-char-names'."
 (defun sgml-name-self ()
   "Insert a symbolic character name according to `sgml-char-names'."
   (interactive "*")
-  (sgml-name-char last-command-char))
+  (sgml-name-char last-command-event))
 
 (defun sgml-maybe-name-self ()
   "Insert a symbolic character name according to `sgml-char-names'."
   (interactive "*")
   (if sgml-name-8bit-mode
-      (let ((mc last-command-char))
-	(if (< mc 256)
-	    (setq mc (unibyte-char-to-multibyte mc)))
-	(or mc (setq mc last-command-char))
-	(sgml-name-char mc))
+      (sgml-name-char last-command-event)
     (self-insert-command 1)))
 
 (defun sgml-name-8bit-mode ()
@@ -703,14 +722,22 @@ With prefix argument, only self insert."
 	    (eq (aref tag 0) ?/))
 	(self-insert-command (prefix-numeric-value arg))
       (sgml-attributes tag)
-      (setq last-command-char ?\s)
+      (setq last-command-event ?\s)
       (or (> (point) point)
 	  (self-insert-command 1)))))
 
 (defun sgml-tag-help (&optional tag)
   "Display description of tag TAG.  If TAG is omitted, use the tag at point."
-  (interactive)
-  (or tag
+  (interactive
+   (list (let ((def (save-excursion
+		      (if (eq (following-char) ?<) (forward-char))
+		      (sgml-beginning-of-tag))))
+	   (completing-read (if def
+				(format "Tag (default %s): " def)
+			      "Tag: ")
+			    sgml-tag-alist nil nil nil
+			    'sgml-tag-history def))))
+  (or (and tag (> (length tag) 0))
       (save-excursion
 	(if (eq (following-char) ?<)
 	    (forward-char))
@@ -859,6 +886,12 @@ Return t if after a closing tag."
 	(setq arg (1- arg)))
       return)))
 
+(defsubst sgml-looking-back-at (str)
+  "Return t if the test before point matches STR."
+  (let ((start (- (point) (length str))))
+    (and (>= start (point-min))
+         (equal str (buffer-substring-no-properties start (point))))))
+
 (defun sgml-delete-tag (arg)
   ;; FIXME: Should be called sgml-kill-tag or should not touch the kill-ring.
   "Delete tag on or after cursor, and matching closing or opening tag.
@@ -895,7 +928,7 @@ With prefix argument ARG, repeat this ARG times."
 	      (kill-sexp 1))
 	  (setq open (point))
 	  (when (and (sgml-skip-tag-forward 1)
-		     (not (looking-back "/>")))
+		     (not (sgml-looking-back-at "/>")))
 	    (kill-sexp -1)))
 	;; Delete any resulting empty line.  If we didn't kill-sexp,
 	;; this *should* do nothing, because we're right after the tag.
@@ -1034,6 +1067,12 @@ If nil, start from a preceding tag at indentation."
                   (let ((cdata-start (point)))
                     (unless (search-forward "]]>" pos 'move)
                       (list 0 nil nil 'cdata nil nil nil nil cdata-start))))
+		 ((looking-at comment-start-skip)
+		  ;; parse-partial-sexp doesn't handle <!-- comments -->,
+		  ;; or only if ?- is in sgml-specials, so match explicitly
+		  (let ((start (point)))
+		    (unless (re-search-forward comment-end-skip pos 'move)
+		      (list 0 nil nil nil t nil nil nil start))))
                  ((and sgml-xml-mode (looking-at "<\\?"))
                   ;; Processing Instructions.
                   ;; In SGML, it's basically a normal tag of the form
@@ -1145,12 +1184,6 @@ You might want to turn on `auto-fill-mode' to get better results."
   (buffer-substring-no-properties
    (point) (progn (skip-syntax-forward "w_") (point))))
 
-(defsubst sgml-looking-back-at (str)
-  "Return t if the test before point matches STR."
-  (let ((start (- (point) (length str))))
-    (and (>= start (point-min))
-         (equal str (buffer-substring-no-properties start (point))))))
-
 (defun sgml-tag-text-p (start end)
   "Return non-nil if text between START and END is a tag.
 Checks among other things that the tag does not contain spurious
@@ -1744,7 +1777,7 @@ This takes effect when first loading the library.")
       ("dt" (t _ (if sgml-xml-mode "</dt>")
              "<dd>" (if sgml-xml-mode "</dd>") \n))
       ("em")
-      ;("fn" "id" "fn")  ; ???
+      ("fn" "id" "fn")  ;; Footnotes were deprecated in HTML 3.2
       ("head" \n)
       ("html" (\n
 	       "<head>\n"
@@ -1766,7 +1799,7 @@ This takes effect when first loading the library.")
       ("nobr")
       ("option" t ("value") ("label") ("selected" t))
       ("over" t)
-      ("person")
+      ("person") ;; Tag for person's name tag deprecated in HTML 3.2
       ("pre" \n)
       ("q")
       ("rev")
@@ -1798,11 +1831,11 @@ This takes effect when first loading the library.")
 (defvar html-tag-help
   `(,@sgml-tag-help
     ("a" . "Anchor of point or link elsewhere")
-    ("abbrev" . "?")
-    ("acronym" . "?")
+    ("abbrev" . "Abbreviation")
+    ("acronym" . "Acronym")
     ("address" . "Formatted mail address")
     ("array" . "Math array")
-    ("au" . "?")
+    ("au" . "Author")
     ("b" . "Bold face")
     ("base" . "Base address for URLs")
     ("big" . "Font size")
@@ -1817,9 +1850,10 @@ This takes effect when first loading the library.")
     ("cite" . "Citation of a document")
     ("code" . "Formatted source code")
     ("dd" . "Definition of term")
-    ("del" . "?")
-    ("dfn" . "?")
+    ("del" . "Deleted text")
+    ("dfn" . "Defining instance of a term")
     ("dir" . "Directory list (obsolete)")
+    ("div" . "Generic block-level container")
     ("dl" . "Definition list")
     ("dt" . "Term to be definined")
     ("em" . "Emphasized")
@@ -1828,7 +1862,7 @@ This takes effect when first loading the library.")
     ("figa" . "Figure anchor")
     ("figd" . "Figure description")
     ("figt" . "Figure text")
-    ;("fn" . "?")  ; ???
+    ("fn" . "Footnote")  ;; No one supports special footnote rendering.
     ("font" . "Font size")
     ("form" . "Form with input fields")
     ("group" . "Document grouping")
@@ -1844,7 +1878,7 @@ This takes effect when first loading the library.")
     ("i" . "Italic face")
     ("img" . "Graphic image")
     ("input" . "Form input field")
-    ("ins" . "?")
+    ("ins" . "Inserted text")
     ("isindex" . "Input field for index search")
     ("kbd" . "Keybard example face")
     ("lang" . "Natural language")
@@ -1860,15 +1894,16 @@ This takes effect when first loading the library.")
     ("over" . "Math fraction rule")
     ("p" . "Paragraph start")
     ("panel" . "Floating panel")
-    ("person" . "?")
+    ("person" . "Person's name")
     ("pre" . "Preformatted fixed width text")
-    ("q" . "?")
+    ("q" . "Quotation")
     ("rev" . "Reverse video")
-    ("s" . "?")
+    ("s" . "Strikeout")
     ("samp" . "Sample text")
     ("select" . "Selection list")
     ("small" . "Font size")
     ("sp" . "Nobreak space")
+    ("span" . "Generic inline container")
     ("strong" . "Standout text")
     ("sub" . "Subscript")
     ("sup" . "Superscript")
@@ -1933,7 +1968,7 @@ To work around that, do:
   (make-local-variable 'outline-heading-end-regexp)
   (make-local-variable 'outline-level)
   (make-local-variable 'sentence-end-base)
-  (setq sentence-end-base "[.?!][]\"'$B!I$,1r}(B)}]*\\(<[^>]*>\\)*"
+  (setq sentence-end-base "[.?!][]\"'”)}]*\\(<[^>]*>\\)*"
 	sgml-tag-alist html-tag-alist
 	sgml-face-tag-alist html-face-tag-alist
 	sgml-tag-help html-tag-help