lisp/textmodes/sgml-mode.el

   1 ;;; sgml-mode.el --- SGML- and HTML-editing modes
   2
   3 ;; Copyright (C) 1992, 1995, 1996, 1998, 2001, 2002, 2003, 2004
   4 ;;           Free Software Foundation, Inc.
   5
   6 ;; Author: James Clark <jjc@jclark.com>
   7 ;; Maintainer: FSF
   8 ;; Adapted-By: ESR, Daniel Pfeiffer <occitan@esperanto.org>,
   9 ;;             F.Potorti@cnuce.cnr.it
  10 ;; Keywords: wp, hypermedia, comm, languages
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; Configurable major mode for editing document in the SGML standard general
  32 ;; markup language.  As an example contains a mode for editing the derived
  33 ;; HTML hypertext markup language.
  34
  35 ;;; Code:
  36
  37 (eval-when-compile
  38   (require 'skeleton)
  39   (require 'outline)
  40   (require 'cl))
  41
  42 (defgroup sgml nil
  43   "SGML editing mode"
  44   :group 'languages)
  45
  46 (defcustom sgml-basic-offset 2
  47   "*Specifies the basic indentation level for `sgml-indent-line'."
  48   :type 'integer
  49   :group 'sgml)
  50
  51 (defcustom sgml-transformation 'identity
  52   "*Default value for `skeleton-transformation' (which see) in SGML mode."
  53   :type 'function
  54   :group 'sgml)
  55
  56 (put 'sgml-transformation 'variable-interactive
  57      "aTransformation function: ")
  58
  59 (defcustom sgml-mode-hook nil
  60   "Hook run by command `sgml-mode'.
  61 `text-mode-hook' is run first."
  62   :group 'sgml
  63   :type 'hook)
  64
  65 ;; As long as Emacs' syntax can't be complemented with predicates to context
  66 ;; sensitively confirm the syntax of characters, we have to live with this
  67 ;; kludgy kind of tradeoff.
  68 (defvar sgml-specials '(?\")
  69   "List of characters that have a special meaning for SGML mode.
  70 This list is used when first loading the `sgml-mode' library.
  71 The supported characters and potential disadvantages are:
  72
  73   ?\\\" Makes \" in text start a string.
  74   ?'    Makes ' in text start a string.
  75   ?-    Makes -- in text start a comment.
  76
  77 When only one of ?\\\" or ?' are included, \"'\" or '\"', as can be found in
  78 DTDs, start a string.  To partially avoid this problem this also makes these
  79 self insert as named entities depending on `sgml-quick-keys'.
  80
  81 Including ?- has the problem of affecting dashes that have nothing to do
  82 with comments, so we normally turn it off.")
  83
  84 (defvar sgml-quick-keys nil
  85   "Use <, >, &, /, SPC and `sgml-specials' keys \"electrically\" when non-nil.
  86 This takes effect when first loading the `sgml-mode' library.")
  87
  88 (defvar sgml-mode-map
  89   (let ((map (make-keymap))     ;`sparse' doesn't allow binding to charsets.
  90         (menu-map (make-sparse-keymap "SGML")))
  91     (define-key map "\C-c\C-i" 'sgml-tags-invisible)
  92     (define-key map "/" 'sgml-slash)
  93     (define-key map "\C-c\C-n" 'sgml-name-char)
  94     (define-key map "\C-c\C-t" 'sgml-tag)
  95     (define-key map "\C-c\C-a" 'sgml-attributes)
  96     (define-key map "\C-c\C-b" 'sgml-skip-tag-backward)
  97     (define-key map [?\C-c left] 'sgml-skip-tag-backward)
  98     (define-key map "\C-c\C-f" 'sgml-skip-tag-forward)
  99     (define-key map [?\C-c right] 'sgml-skip-tag-forward)
 100     (define-key map "\C-c\C-d" 'sgml-delete-tag)
 101     (define-key map "\C-c\^?" 'sgml-delete-tag)
 102     (define-key map "\C-c?" 'sgml-tag-help)
 103     (define-key map "\C-c/" 'sgml-close-tag)
 104     (define-key map "\C-c8" 'sgml-name-8bit-mode)
 105     (define-key map "\C-c\C-v" 'sgml-validate)
 106     (when sgml-quick-keys
 107       (define-key map "&" 'sgml-name-char)
 108       (define-key map "<" 'sgml-tag)
 109       (define-key map " " 'sgml-auto-attributes)
 110       (define-key map ">" 'sgml-maybe-end-tag)
 111       (when (memq ?\" sgml-specials)
 112         (define-key map "\"" 'sgml-name-self))
 113       (when (memq ?' sgml-specials)
 114         (define-key map "'" 'sgml-name-self)))
 115     (define-key map (vector (make-char 'latin-iso8859-1))
 116       'sgml-maybe-name-self)
 117     (let ((c 127)
 118           (map (nth 1 map)))
 119       (while (< (setq c (1+ c)) 256)
 120         (aset map c 'sgml-maybe-name-self)))
 121     (define-key map [menu-bar sgml] (cons "SGML" menu-map))
 122     (define-key menu-map [sgml-validate] '("Validate" . sgml-validate))
 123     (define-key menu-map [sgml-name-8bit-mode]
 124       '("Toggle 8 Bit Insertion" . sgml-name-8bit-mode))
 125     (define-key menu-map [sgml-tags-invisible]
 126       '("Toggle Tag Visibility" . sgml-tags-invisible))
 127     (define-key menu-map [sgml-tag-help]
 128       '("Describe Tag" . sgml-tag-help))
 129     (define-key menu-map [sgml-delete-tag]
 130       '("Delete Tag" . sgml-delete-tag))
 131     (define-key menu-map [sgml-skip-tag-forward]
 132       '("Forward Tag" . sgml-skip-tag-forward))
 133     (define-key menu-map [sgml-skip-tag-backward]
 134       '("Backward Tag" . sgml-skip-tag-backward))
 135     (define-key menu-map [sgml-attributes]
 136       '("Insert Attributes" . sgml-attributes))
 137     (define-key menu-map [sgml-tag] '("Insert Tag" . sgml-tag))
 138     map)
 139   "Keymap for SGML mode.  See also `sgml-specials'.")
 140
 141 (defun sgml-make-syntax-table (specials)
 142   (let ((table (make-syntax-table text-mode-syntax-table)))
 143     (modify-syntax-entry ?< "(>" table)
 144     (modify-syntax-entry ?> ")<" table)
 145     (modify-syntax-entry ?: "_" table)
 146     (modify-syntax-entry ?_ "_" table)
 147     (modify-syntax-entry ?. "_" table)
 148     (if (memq ?- specials)
 149         (modify-syntax-entry ?- "_ 1234" table))
 150     (if (memq ?\" specials)
 151         (modify-syntax-entry ?\" "\"\"" table))
 152     (if (memq ?' specials)
 153         (modify-syntax-entry ?\' "\"'" table))
 154     table))
 155
 156 (defvar sgml-mode-syntax-table (sgml-make-syntax-table sgml-specials)
 157   "Syntax table used in SGML mode.  See also `sgml-specials'.")
 158
 159 (defconst sgml-tag-syntax-table
 160   (let ((table (sgml-make-syntax-table '(?- ?\" ?\'))))
 161     (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/))
 162       (modify-syntax-entry char "." table))
 163     table)
 164   "Syntax table used to parse SGML tags.")
 165
 166 (defcustom sgml-name-8bit-mode nil
 167   "*When non-nil, insert non-ASCII characters as named entities."
 168   :type 'boolean
 169   :group 'sgml)
 170
 171 (defvar sgml-char-names
 172   [nil nil nil nil nil nil nil nil
 173    nil nil nil nil nil nil nil nil
 174    nil nil nil nil nil nil nil nil
 175    nil nil nil nil nil nil nil nil
 176    "nbsp" "excl" "quot" "num" "dollar" "percnt" "amp" "apos"
 177    "lpar" "rpar" "ast" "plus" "comma" "hyphen" "period" "sol"
 178    nil nil nil nil nil nil nil nil
 179    nil nil "colon" "semi" "lt" "eq" "gt" "quest"
 180    "commat" nil nil nil nil nil nil nil
 181    nil nil nil nil nil nil nil nil
 182    nil nil nil nil nil nil nil nil
 183    nil nil nil "lsqb" nil "rsqb" "uarr" "lowbar"
 184    "lsquo" nil nil nil nil nil nil nil
 185    nil nil nil nil nil nil nil nil
 186    nil nil nil nil nil nil nil nil
 187    nil nil nil "lcub" "verbar" "rcub" "tilde" nil
 188    nil nil nil nil nil nil nil nil
 189    nil nil nil nil nil nil nil nil
 190    nil nil nil nil nil nil nil nil
 191    nil nil nil nil nil nil nil nil
 192    "nbsp" "iexcl" "cent" "pound" "curren" "yen" "brvbar" "sect"
 193    "uml" "copy" "ordf" "laquo" "not" "shy" "reg" "macr"
 194    "ring" "plusmn" "sup2" "sup3" "acute" "micro" "para" "middot"
 195    "cedil" "sup1" "ordm" "raquo" "frac14" "frac12" "frac34" "iquest"
 196    "Agrave" "Aacute" "Acirc" "Atilde" "Auml" "Aring" "AElig" "Ccedil"
 197    "Egrave" "Eacute" "Ecirc" "Euml" "Igrave" "Iacute" "Icirc" "Iuml"
 198    "ETH" "Ntilde" "Ograve" "Oacute" "Ocirc" "Otilde" "Ouml" nil
 199    "Oslash" "Ugrave" "Uacute" "Ucirc" "Uuml" "Yacute" "THORN" "szlig"
 200    "agrave" "aacute" "acirc" "atilde" "auml" "aring" "aelig" "ccedil"
 201    "egrave" "eacute" "ecirc" "euml" "igrave" "iacute" "icirc" "iuml"
 202    "eth" "ntilde" "ograve" "oacute" "ocirc" "otilde" "ouml" "divide"
 203    "oslash" "ugrave" "uacute" "ucirc" "uuml" "yacute" "thorn" "yuml"]
 204   "Vector of symbolic character names without `&' and `;'.")
 205
 206 (put 'sgml-table 'char-table-extra-slots 0)
 207
 208 (defvar sgml-char-names-table
 209   (let ((table (make-char-table 'sgml-table))
 210         (i 32)
 211         elt)
 212     (while (< i 256)
 213       (setq elt (aref sgml-char-names i))
 214       (if elt (aset table (make-char 'latin-iso8859-1 i) elt))
 215       (setq i (1+ i)))
 216     table)
 217   "A table for mapping non-ASCII characters into SGML entity names.
 218 Currently, only Latin-1 characters are supported.")
 219
 220 ;; nsgmls is a free SGML parser in the SP suite available from
 221 ;; ftp.jclark.com and otherwise packaged for GNU systems.
 222 ;; Its error messages can be parsed by next-error.
 223 ;; The -s option suppresses output.
 224
 225 (defcustom sgml-validate-command "nsgmls -s" ; replaced old `sgmls'
 226   "*The command to validate an SGML document.
 227 The file name of current buffer file name will be appended to this,
 228 separated by a space."
 229   :type 'string
 230   :version "21.1"
 231   :group 'sgml)
 232
 233 (defvar sgml-saved-validate-command nil
 234   "The command last used to validate in this buffer.")
 235
 236 ;; I doubt that null end tags are used much for large elements,
 237 ;; so use a small distance here.
 238 (defcustom sgml-slash-distance 1000
 239   "*If non-nil, is the maximum distance to search for matching `/'."
 240   :type '(choice (const nil) integer)
 241   :group 'sgml)
 242
 243 (defconst sgml-namespace-re "[_[:alpha:]][-_.[:alnum:]]*")
 244 (defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*")
 245 (defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)"))
 246 (defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*")
 247 (defconst sgml-start-tag-regex (concat "<" sgml-name-re sgml-attrs-re)
 248   "Regular expression that matches a non-empty start tag.
 249 Any terminating `>' or `/' is not matched.")
 250
 251 (defface sgml-namespace-face
 252   '((t (:inherit font-lock-builtin-face)))
 253   "`sgml-mode' face used to highlight the namespace part of identifiers.")
 254 (defvar sgml-namespace-face 'sgml-namespace-face)
 255
 256 ;; internal
 257 (defconst sgml-font-lock-keywords-1
 258   `((,(concat "<\\([!?]" sgml-name-re "\\)") 1 font-lock-keyword-face)
 259     ;; We could use the simpler "\\(" sgml-namespace-re ":\\)?" instead,
 260     ;; but it would cause a bit more backtracking in the re-matcher.
 261     (,(concat "</?\\(" sgml-namespace-re "\\)\\(?::\\(" sgml-name-re "\\)\\)?")
 262      (1 (if (match-end 2) sgml-namespace-face font-lock-function-name-face))
 263      (2 font-lock-function-name-face nil t))
 264     ;; FIXME: this doesn't cover the variables using a default value.
 265     (,(concat "\\(" sgml-namespace-re "\\)\\(?::\\("
 266               sgml-name-re "\\)\\)?=[\"']")
 267      (1 (if (match-end 2) sgml-namespace-face font-lock-variable-name-face))
 268      (2 font-lock-variable-name-face nil t))
 269     (,(concat "[&%]" sgml-name-re ";?") . font-lock-variable-name-face)))
 270
 271 (defconst sgml-font-lock-keywords-2
 272   (append
 273    sgml-font-lock-keywords-1
 274    '((eval
 275       . (cons (concat "<"
 276                       (regexp-opt (mapcar 'car sgml-tag-face-alist) t)
 277                       "\\([ \t][^>]*\\)?>\\([^<]+\\)</\\1>")
 278               '(3 (cdr (assoc (downcase (match-string 1))
 279                               sgml-tag-face-alist)) prepend))))))
 280
 281 ;; for font-lock, but must be defvar'ed after
 282 ;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above
 283 (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
 284   "*Rules for highlighting SGML code.  See also `sgml-tag-face-alist'.")
 285
 286 (defvar sgml-font-lock-syntactic-keywords
 287   ;; Use the `b' style of comments to avoid interference with the -- ... --
 288   ;; comments recognized when `sgml-specials' includes ?-.
 289   ;; FIXME: beware of <!--> blabla <!--> !!
 290   '(("\\(<\\)!--" (1 "< b"))
 291     ("--[ \t\n]*\\(>\\)" (1 "> b")))
 292   "Syntactic keywords for `sgml-mode'.")
 293
 294 ;; internal
 295 (defvar sgml-face-tag-alist ()
 296   "Alist of face and tag name for facemenu.")
 297
 298 (defvar sgml-tag-face-alist ()
 299   "Tag names and face or list of faces to fontify with when invisible.
 300 When `font-lock-maximum-decoration' is 1 this is always used for fontifying.
 301 When more these are fontified together with `sgml-font-lock-keywords'.")
 302
 303 (defvar sgml-display-text ()
 304   "Tag names as lowercase symbols, and display string when invisible.")
 305
 306 ;; internal
 307 (defvar sgml-tags-invisible nil)
 308
 309 (defcustom sgml-tag-alist
 310   '(("![" ("ignore" t) ("include" t))
 311     ("!attlist")
 312     ("!doctype")
 313     ("!element")
 314     ("!entity"))
 315   "*Alist of tag names for completing read and insertion rules.
 316 This alist is made up as
 317
 318   ((\"tag\" . TAGRULE)
 319    ...)
 320
 321 TAGRULE is a list of optionally t (no endtag) or `\\n' (separate endtag by
 322 newlines) or a skeleton with nil, t or `\\n' in place of the interactor
 323 followed by an ATTRIBUTERULE (for an always present attribute) or an
 324 attribute alist.
 325
 326 The attribute alist is made up as
 327
 328   ((\"attribute\" . ATTRIBUTERULE)
 329    ...)
 330
 331 ATTRIBUTERULE is a list of optionally t (no value when no input) followed by
 332 an optional alist of possible values."
 333   :type '(repeat (cons (string :tag "Tag Name")
 334                        (repeat :tag "Tag Rule" sexp)))
 335   :group 'sgml)
 336
 337 (defcustom sgml-tag-help
 338   '(("!" . "Empty declaration for comment")
 339     ("![" . "Embed declarations with parser directive")
 340     ("!attlist" . "Tag attributes declaration")
 341     ("!doctype" . "Document type (DTD) declaration")
 342     ("!element" . "Tag declaration")
 343     ("!entity" . "Entity (macro) declaration"))
 344   "*Alist of tag name and short description."
 345   :type '(repeat (cons (string :tag "Tag Name")
 346                        (string :tag "Description")))
 347   :group 'sgml)
 348
 349 (defcustom sgml-xml-mode nil
 350   "*When non-nil, tag insertion functions will be XML-compliant.
 351 If this variable is customized, the custom value is used always.
 352 Otherwise, it is set to be buffer-local when the file has
 353  a DOCTYPE or an XML declaration."
 354   :type 'boolean
 355   :version "21.4"
 356   :group 'sgml)
 357
 358 (defvar sgml-empty-tags nil
 359   "List of tags whose !ELEMENT definition says EMPTY.")
 360
 361 (defvar sgml-unclosed-tags nil
 362   "List of tags whose !ELEMENT definition says the end-tag is optional.")
 363
 364 (defun sgml-xml-guess ()
 365   "Guess whether the current buffer is XML."
 366   (save-excursion
 367     (goto-char (point-min))
 368     (when (or (string= "xml" (file-name-extension (or buffer-file-name "")))
 369               (looking-at "\\s-*<\\?xml")
 370               (when (re-search-forward
 371                      (eval-when-compile
 372                  (mapconcat 'identity
 373                             '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"
 374                                     "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
 375                                   "\\s-+"))
 376                      nil t)
 377                 (string-match "X\\(HT\\)?ML" (match-string 3))))
 378       (set (make-local-variable 'sgml-xml-mode) t))))
 379
 380 (defvar v2)                             ; free for skeleton
 381
 382 (defun sgml-comment-indent-new-line (&optional soft)
 383   (let ((comment-start "-- ")
 384         (comment-start-skip "\\(<!\\)?--[ \t]*")
 385         (comment-end " --")
 386         (comment-style 'plain))
 387     (comment-indent-new-line soft)))
 388
 389 (defun sgml-mode-facemenu-add-face-function (face end)
 390   (if (setq face (cdr (assq face sgml-face-tag-alist)))
 391       (progn
 392         (setq face (funcall skeleton-transformation face))
 393         (setq facemenu-end-add-face (concat "</" face ">"))
 394         (concat "<" face ">"))
 395     (error "Face not configured for %s mode" mode-name)))
 396
 397 ;;;###autoload
 398 (define-derived-mode sgml-mode text-mode "SGML"
 399   "Major mode for editing SGML documents.
 400 Makes > match <.
 401 Keys <, &, SPC within <>, \", / and ' can be electric depending on
 402 `sgml-quick-keys'.
 403
 404 An argument of N to a tag-inserting command means to wrap it around
 405 the next N words.  In Transient Mark mode, when the mark is active,
 406 N defaults to -1, which means to wrap it around the current region.
 407
 408 If you like upcased tags, put (setq sgml-transformation 'upcase) in
 409 your `.emacs' file.
 410
 411 Use \\[sgml-validate] to validate your document with an SGML parser.
 412
 413 Do \\[describe-variable] sgml- SPC to see available variables.
 414 Do \\[describe-key] on the following bindings to discover what they do.
 415 \\{sgml-mode-map}"
 416   (make-local-variable 'sgml-saved-validate-command)
 417   (make-local-variable 'facemenu-end-add-face)
 418   ;;(make-local-variable 'facemenu-remove-face-function)
 419   ;; A start or end tag by itself on a line separates a paragraph.
 420   ;; This is desirable because SGML discards a newline that appears
 421   ;; immediately after a start tag or immediately before an end tag.
 422   (set (make-local-variable 'paragraph-start) (concat "[ \t]*$\\|\
 423 \[ \t]*</?\\(" sgml-name-re sgml-attrs-re "\\)?>"))
 424   (set (make-local-variable 'paragraph-separate)
 425        (concat paragraph-start "$"))
 426   (set (make-local-variable 'adaptive-fill-regexp) "[ \t]*")
 427   (set (make-local-variable 'indent-line-function) 'sgml-indent-line)
 428   (set (make-local-variable 'comment-start) "<!-- ")
 429   (set (make-local-variable 'comment-end) " -->")
 430   (set (make-local-variable 'comment-indent-function) 'sgml-comment-indent)
 431   (set (make-local-variable 'comment-line-break-function)
 432        'sgml-comment-indent-new-line)
 433   (set (make-local-variable 'skeleton-further-elements)
 434        '((completion-ignore-case t)))
 435   (set (make-local-variable 'skeleton-end-hook)
 436        (lambda ()
 437          (or (eolp)
 438              (not (or (eq v2 '\n) (eq (car-safe v2) '\n)))
 439              (newline-and-indent))))
 440   (set (make-local-variable 'font-lock-defaults)
 441        '((sgml-font-lock-keywords
 442           sgml-font-lock-keywords-1
 443           sgml-font-lock-keywords-2)
 444          nil t nil nil
 445          (font-lock-syntactic-keywords
 446           . sgml-font-lock-syntactic-keywords)))
 447   (set (make-local-variable 'facemenu-add-face-function)
 448        'sgml-mode-facemenu-add-face-function)
 449   (sgml-xml-guess)
 450   (if sgml-xml-mode
 451       (setq mode-name "XML")
 452     (set (make-local-variable 'skeleton-transformation) sgml-transformation))
 453   ;; This will allow existing comments within declarations to be
 454   ;; recognized.
 455   (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
 456   (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
 457   ;; This definition has an HTML leaning but probably fits well for other modes.
 458   (setq imenu-generic-expression
 459         `((nil
 460            ,(concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
 461                     sgml-name-re "\\)")
 462            2)
 463           ("Id"
 464            ,(concat "<[^>]+[ \t\n]+[Ii][Dd]=\\(['\"]"
 465                     (if sgml-xml-mode "" "?")
 466                     "\\)\\(" sgml-name-re "\\)\\1")
 467            2)
 468           ("Name"
 469            ,(concat "<[^>]+[ \t\n]+[Nn][Aa][Mm][Ee]=\\(['\"]"
 470                     (if sgml-xml-mode "" "?")
 471                     "\\)\\(" sgml-name-re "\\)\\1")
 472            2))))
 473
 474 ;; Some programs (such as Glade 2) generate XML which has
 475 ;; -*- mode: xml -*-.
 476 ;;;###autoload
 477 (defalias 'xml-mode 'sgml-mode)
 478
 479 (defun sgml-comment-indent ()
 480   (if (looking-at "--") comment-column 0))
 481
 482 (defun sgml-slash (arg)
 483   "Insert ARG slash characters.
 484 Behaves electrically if `sgml-quick-keys' is non-nil."
 485   (interactive "p")
 486   (cond
 487    ((not (and (eq (char-before) ?<) (= arg 1)))
 488     (sgml-slash-matching arg))
 489    ((eq sgml-quick-keys 'indent)
 490     (insert-char ?/ 1)
 491     (indent-according-to-mode))
 492    ((eq sgml-quick-keys 'close)
 493     (delete-backward-char 1)
 494     (sgml-close-tag))
 495    (t
 496     (sgml-slash-matching arg))))
 497
 498 (defun sgml-slash-matching (arg)
 499   "Insert `/' and display any previous matching `/'.
 500 Two `/'s are treated as matching if the first `/' ends a net-enabling
 501 start tag, and the second `/' is the corresponding null end tag."
 502   (interactive "p")
 503   (insert-char ?/ arg)
 504   (if (> arg 0)
 505       (let ((oldpos (point))
 506             (blinkpos)
 507             (level 0))
 508         (save-excursion
 509           (save-restriction
 510             (if sgml-slash-distance
 511                 (narrow-to-region (max (point-min)
 512                                        (- (point) sgml-slash-distance))
 513                                   oldpos))
 514             (if (and (re-search-backward sgml-start-tag-regex (point-min) t)
 515                      (eq (match-end 0) (1- oldpos)))
 516                 ()
 517               (goto-char (1- oldpos))
 518               (while (and (not blinkpos)
 519                           (search-backward "/" (point-min) t))
 520                 (let ((tagend (save-excursion
 521                                 (if (re-search-backward sgml-start-tag-regex
 522                                                         (point-min) t)
 523                                     (match-end 0)
 524                                   nil))))
 525                   (if (eq tagend (point))
 526                       (if (eq level 0)
 527                           (setq blinkpos (point))
 528                         (setq level (1- level)))
 529                     (setq level (1+ level)))))))
 530           (when blinkpos
 531             (goto-char blinkpos)
 532             (if (pos-visible-in-window-p)
 533                 (sit-for 1)
 534               (message "Matches %s"
 535                        (buffer-substring (line-beginning-position)
 536                                          (1+ blinkpos)))))))))
 537
 538 ;; Why doesn't this use the iso-cvt table or, preferably, generate the
 539 ;; inverse of the extensive table in the SGML Quail input method?  -- fx
 540 ;; I guess that's moot since it only works with Latin-1 anyhow.
 541 (defun sgml-name-char (&optional char)
 542   "Insert a symbolic character name according to `sgml-char-names'.
 543 Non-ASCII chars may be inserted either with the meta key, as in M-SPC for
 544 no-break space or M-- for a soft hyphen; or via an input method or
 545 encoded keyboard operation."
 546   (interactive "*")
 547   (insert ?&)
 548   (or char
 549       (setq char (read-quoted-char "Enter char or octal number")))
 550   (delete-backward-char 1)
 551   (insert char)
 552   (undo-boundary)
 553   (sgml-namify-char))
 554
 555 (defun sgml-namify-char ()
 556   "Change the char before point into its `&name;' equivalent.
 557 Uses `sgml-char-names'."
 558   (interactive)
 559   (let* ((char (char-before))
 560          (name
 561           (cond
 562            ((null char) (error "No char before point"))
 563            ((< char 256) (or (aref sgml-char-names char) char))
 564            ((aref sgml-char-names-table char))
 565            ((encode-char char 'ucs)))))
 566     (if (not name)
 567         (error "Don't know the name of `%c'" char)
 568       (delete-backward-char 1)
 569       (insert (format (if (numberp name) "&#%d;" "&%s;") name)))))
 570
 571 (defun sgml-name-self ()
 572   "Insert a symbolic character name according to `sgml-char-names'."
 573   (interactive "*")
 574   (sgml-name-char last-command-char))
 575
 576 (defun sgml-maybe-name-self ()
 577   "Insert a symbolic character name according to `sgml-char-names'."
 578   (interactive "*")
 579   (if sgml-name-8bit-mode
 580       (let ((mc last-command-char))
 581         (if (< mc 256)
 582             (setq mc (unibyte-char-to-multibyte mc)))
 583         (or mc (setq mc last-command-char))
 584         (sgml-name-char mc))
 585     (self-insert-command 1)))
 586
 587 (defun sgml-name-8bit-mode ()
 588   "Toggle whether to insert named entities instead of non-ASCII characters.
 589 This only works for Latin-1 input."
 590   (interactive)
 591   (setq sgml-name-8bit-mode (not sgml-name-8bit-mode))
 592   (message "sgml name entity mode is now %s"
 593            (if sgml-name-8bit-mode "ON" "OFF")))
 594
 595 ;; When an element of a skeleton is a string "str", it is passed
 596 ;; through skeleton-transformation and inserted.  If "str" is to be
 597 ;; inserted literally, one should obtain it as the return value of a
 598 ;; function, e.g. (identity "str").
 599
 600 (defvar sgml-tag-last nil)
 601 (defvar sgml-tag-history nil)
 602 (define-skeleton sgml-tag
 603   "Prompt for a tag and insert it, optionally with attributes.
 604 Completion and configuration are done according to `sgml-tag-alist'.
 605 If you like tags and attributes in uppercase do \\[set-variable]
 606 skeleton-transformation RET upcase RET, or put this in your `.emacs':
 607   (setq sgml-transformation 'upcase)"
 608   (funcall (or skeleton-transformation 'identity)
 609            (setq sgml-tag-last
 610                  (completing-read
 611                   (if (> (length sgml-tag-last) 0)
 612                       (format "Tag (default %s): " sgml-tag-last)
 613                     "Tag: ")
 614                   sgml-tag-alist nil nil nil 'sgml-tag-history sgml-tag-last)))
 615   ?< str |
 616   (("") -1 '(undo-boundary) (identity "&lt;")) |        ; see comment above
 617   `(("") '(setq v2 (sgml-attributes ,str t)) ?>
 618     (cond
 619      ((string= "![" ,str)
 620       (backward-char)
 621       '(("") " [ " _ " ]]"))
 622      ((and (eq v2 t) sgml-xml-mode (member ,str sgml-empty-tags))
 623       '(("") -1 "/>"))
 624      ((or (and (eq v2 t) (not sgml-xml-mode)) (string-match "^[/!?]" ,str))
 625       nil)
 626      ((symbolp v2)
 627       ;; Make sure we don't fall into an infinite loop.
 628       ;; For xhtml's `tr' tag, we should maybe use \n instead.
 629       (if (eq v2 t) (setq v2 nil))
 630       ;; We use `identity' to prevent skeleton from passing
 631       ;; `str' through skeleton-transformation a second time.
 632       '(("") v2 _ v2 "</" (identity ',str) ?>))
 633      ((eq (car v2) t)
 634       (cons '("") (cdr v2)))
 635      (t
 636       (append '(("") (car v2))
 637               (cdr v2)
 638               '(resume: (car v2) _ "</" (identity ',str) ?>))))))
 639
 640 (autoload 'skeleton-read "skeleton")
 641
 642 (defun sgml-attributes (tag &optional quiet)
 643   "When at top level of a tag, interactively insert attributes.
 644
 645 Completion and configuration of TAG are done according to `sgml-tag-alist'.
 646 If QUIET, do not print a message when there are no attributes for TAG."
 647   (interactive (list (save-excursion (sgml-beginning-of-tag t))))
 648   (or (stringp tag) (error "Wrong context for adding attribute"))
 649   (if tag
 650       (let ((completion-ignore-case t)
 651             (alist (cdr (assoc (downcase tag) sgml-tag-alist)))
 652             car attribute i)
 653         (if (or (symbolp (car alist))
 654                 (symbolp (car (car alist))))
 655             (setq car (car alist)
 656                   alist (cdr alist)))
 657         (or quiet
 658             (message "No attributes configured."))
 659         (if (stringp (car alist))
 660             (progn
 661               (insert (if (eq (preceding-char) ? ) "" ? )
 662                       (funcall skeleton-transformation (car alist)))
 663               (sgml-value alist))
 664           (setq i (length alist))
 665           (while (> i 0)
 666             (insert ? )
 667             (insert (funcall skeleton-transformation
 668                              (setq attribute
 669                                    (skeleton-read '(completing-read
 670                                                     "Attribute: "
 671                                                     alist)))))
 672             (if (string= "" attribute)
 673                 (setq i 0)
 674               (sgml-value (assoc (downcase attribute) alist))
 675               (setq i (1- i))))
 676           (if (eq (preceding-char) ? )
 677               (delete-backward-char 1)))
 678         car)))
 679
 680 (defun sgml-auto-attributes (arg)
 681   "Self insert the character typed; at top level of tag, prompt for attributes.
 682 With prefix argument, only self insert."
 683   (interactive "*P")
 684   (let ((point (point))
 685         tag)
 686     (if (or arg
 687             (not sgml-tag-alist)        ; no message when nothing configured
 688             (symbolp (setq tag (save-excursion (sgml-beginning-of-tag t))))
 689             (eq (aref tag 0) ?/))
 690         (self-insert-command (prefix-numeric-value arg))
 691       (sgml-attributes tag)
 692       (setq last-command-char ? )
 693       (or (> (point) point)
 694           (self-insert-command 1)))))
 695
 696 (defun sgml-tag-help (&optional tag)
 697   "Display description of tag TAG.  If TAG is omitted, use the tag at point."
 698   (interactive)
 699   (or tag
 700       (save-excursion
 701         (if (eq (following-char) ?<)
 702             (forward-char))
 703         (setq tag (sgml-beginning-of-tag))))
 704   (or (stringp tag)
 705       (error "No tag selected"))
 706   (setq tag (downcase tag))
 707   (message "%s"
 708            (or (cdr (assoc (downcase tag) sgml-tag-help))
 709                (and (eq (aref tag 0) ?/)
 710                     (cdr (assoc (downcase (substring tag 1)) sgml-tag-help)))
 711                "No description available")))
 712
 713 (defun sgml-maybe-end-tag (&optional arg)
 714   "Name self unless in position to end a tag or a prefix ARG is given."
 715   (interactive "P")
 716   (if (or arg (eq (car (sgml-lexical-context)) 'tag))
 717       (self-insert-command (prefix-numeric-value arg))
 718     (sgml-name-self)))
 719
 720 (defun sgml-skip-tag-backward (arg)
 721   "Skip to beginning of tag or matching opening tag if present.
 722 With prefix argument ARG, repeat this ARG times."
 723   (interactive "p")
 724   ;; FIXME: use sgml-get-context or something similar.
 725   (while (>= arg 1)
 726     (search-backward "<" nil t)
 727     (if (looking-at "</\\([^ \n\t>]+\\)")
 728         ;; end tag, skip any nested pairs
 729         (let ((case-fold-search t)
 730               (re (concat "</?" (regexp-quote (match-string 1))
 731                           ;; Ignore empty tags like <foo/>.
 732                           "\\([^>]*[^/>]\\)?>")))
 733           (while (and (re-search-backward re nil t)
 734                       (eq (char-after (1+ (point))) ?/))
 735             (forward-char 1)
 736             (sgml-skip-tag-backward 1))))
 737     (setq arg (1- arg))))
 738
 739 (defun sgml-skip-tag-forward (arg)
 740   "Skip to end of tag or matching closing tag if present.
 741 With prefix argument ARG, repeat this ARG times.
 742 Return t iff after a closing tag."
 743   (interactive "p")
 744   ;; FIXME: Use sgml-get-context or something similar.
 745   ;; It currently might jump to an unrelated </P> if the <P>
 746   ;; we're skipping has no matching </P>.
 747   (let ((return t))
 748     (with-syntax-table sgml-tag-syntax-table
 749       (while (>= arg 1)
 750         (skip-chars-forward "^<>")
 751         (if (eq (following-char) ?>)
 752             (up-list -1))
 753         (if (looking-at "<\\([^/ \n\t>]+\\)\\([^>]*[^/>]\\)?>")
 754             ;; start tag, skip any nested same pairs _and_ closing tag
 755             (let ((case-fold-search t)
 756                   (re (concat "</?" (regexp-quote (match-string 1))
 757                               ;; Ignore empty tags like <foo/>.
 758                               "\\([^>]*[^/>]\\)?>"))
 759                   point close)
 760               (forward-list 1)
 761               (setq point (point))
 762               ;; FIXME: This re-search-forward will mistakenly match
 763               ;; tag-like text inside attributes.
 764               (while (and (re-search-forward re nil t)
 765                           (not (setq close
 766                                      (eq (char-after (1+ (match-beginning 0))) ?/)))
 767                           (goto-char (match-beginning 0))
 768                           (sgml-skip-tag-forward 1))
 769                 (setq close nil))
 770               (unless close
 771                 (goto-char point)
 772                 (setq return nil)))
 773           (forward-list 1))
 774         (setq arg (1- arg)))
 775       return)))
 776
 777 (defun sgml-delete-tag (arg)
 778   ;; FIXME: Should be called sgml-kill-tag or should not touch the kill-ring.
 779   "Delete tag on or after cursor, and matching closing or opening tag.
 780 With prefix argument ARG, repeat this ARG times."
 781   (interactive "p")
 782   (while (>= arg 1)
 783     (save-excursion
 784       (let* (close open)
 785         (if (looking-at "[ \t\n]*<")
 786             ;; just before tag
 787             (if (eq (char-after (match-end 0)) ?/)
 788                 ;; closing tag
 789                 (progn
 790                   (setq close (point))
 791                   (goto-char (match-end 0))))
 792           ;; on tag?
 793           (or (save-excursion (setq close (sgml-beginning-of-tag)
 794                                     close (and (stringp close)
 795                                                (eq (aref close 0) ?/)
 796                                                (point))))
 797               ;; not on closing tag
 798               (let ((point (point)))
 799                 (sgml-skip-tag-backward 1)
 800                 (if (or (not (eq (following-char) ?<))
 801                         (save-excursion
 802                           (forward-list 1)
 803                           (<= (point) point)))
 804                     (error "Not on or before tag")))))
 805         (if close
 806             (progn
 807               (sgml-skip-tag-backward 1)
 808               (setq open (point))
 809               (goto-char close)
 810               (kill-sexp 1))
 811           (setq open (point))
 812           (when (sgml-skip-tag-forward 1)
 813             (kill-sexp -1)))
 814         ;; Delete any resulting empty line.  If we didn't kill-sexp,
 815         ;; this *should* do nothing, because we're right after the tag.
 816         (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?"))
 817             (delete-region (match-beginning 0) (match-end 0)))
 818         (goto-char open)
 819         (kill-sexp 1)
 820         (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?"))
 821             (delete-region (match-beginning 0) (match-end 0)))))
 822     (setq arg (1- arg))))
 823
 824 \f
 825 ;; Put read-only last to enable setting this even when read-only enabled.
 826 (or (get 'sgml-tag 'invisible)
 827     (setplist 'sgml-tag
 828               (append '(invisible t
 829                         point-entered sgml-point-entered
 830                         rear-nonsticky t
 831                         read-only t)
 832                       (symbol-plist 'sgml-tag))))
 833
 834 (defun sgml-tags-invisible (arg)
 835   "Toggle visibility of existing tags."
 836   (interactive "P")
 837   (let ((modified (buffer-modified-p))
 838         (inhibit-read-only t)
 839         (inhibit-modification-hooks t)
 840         ;; Avoid spurious the `file-locked' checks.
 841         (buffer-file-name nil)
 842         ;; This is needed in case font lock gets called,
 843         ;; since it moves point and might call sgml-point-entered.
 844         ;; How could it get called?  -stef
 845         (inhibit-point-motion-hooks t)
 846         string)
 847     (unwind-protect
 848         (save-excursion
 849           (goto-char (point-min))
 850           (if (set (make-local-variable 'sgml-tags-invisible)
 851                    (if arg
 852                        (>= (prefix-numeric-value arg) 0)
 853                      (not sgml-tags-invisible)))
 854               (while (re-search-forward sgml-tag-name-re nil t)
 855                 (setq string
 856                       (cdr (assq (intern-soft (downcase (match-string 1)))
 857                                  sgml-display-text)))
 858                 (goto-char (match-beginning 0))
 859                 (and (stringp string)
 860                      (not (overlays-at (point)))
 861                      (let ((ol (make-overlay (point) (match-beginning 1))))
 862                        (overlay-put ol 'before-string string)
 863                        (overlay-put ol 'sgml-tag t)))
 864                 (put-text-property (point)
 865                                    (progn (forward-list) (point))
 866                                    'category 'sgml-tag))
 867             (let ((pos (point-min)))
 868               (while (< (setq pos (next-overlay-change pos)) (point-max))
 869                 (dolist (ol (overlays-at pos))
 870                   (if (overlay-get ol 'sgml-tag)
 871                       (delete-overlay ol)))))
 872             (remove-text-properties (point-min) (point-max) '(category nil))))
 873       (restore-buffer-modified-p modified))
 874     (run-hooks 'sgml-tags-invisible-hook)
 875     (message "")))
 876
 877 (defun sgml-point-entered (x y)
 878   ;; Show preceding or following hidden tag, depending of cursor direction.
 879   (let ((inhibit-point-motion-hooks t))
 880     (save-excursion
 881       (message "Invisible tag: %s"
 882                ;; Strip properties, otherwise, the text is invisible.
 883                (buffer-substring-no-properties
 884                 (point)
 885                 (if (or (and (> x y)
 886                              (not (eq (following-char) ?<)))
 887                         (and (< x y)
 888                              (eq (preceding-char) ?>)))
 889                     (backward-list)
 890                   (forward-list)))))))
 891
 892 \f
 893 (autoload 'compile-internal "compile")
 894
 895 (defun sgml-validate (command)
 896   "Validate an SGML document.
 897 Runs COMMAND, a shell command, in a separate process asynchronously
 898 with output going to the buffer `*compilation*'.
 899 You can then use the command \\[next-error] to find the next error message
 900 and move to the line in the SGML document that caused it."
 901   (interactive
 902    (list (read-string "Validate command: "
 903                       (or sgml-saved-validate-command
 904                           (concat sgml-validate-command
 905                                   " "
 906                                   (let ((name (buffer-file-name)))
 907                                     (and name
 908                                          (file-name-nondirectory name))))))))
 909   (setq sgml-saved-validate-command command)
 910   (save-some-buffers (not compilation-ask-about-save) nil)
 911   (compile-internal command "No more errors"))
 912
 913 (defsubst sgml-at-indentation-p ()
 914   "Return true if point is at the first non-whitespace character on the line."
 915   (save-excursion
 916     (skip-chars-backward " \t")
 917     (bolp)))
 918
 919 (defun sgml-lexical-context (&optional limit)
 920   "Return the lexical context at point as (TYPE . START).
 921 START is the location of the start of the lexical element.
 922 TYPE is one of `string', `comment', `tag', `cdata', or `text'.
 923
 924 Optional argument LIMIT is the position to start parsing from.
 925 If nil, start from a preceding tag at indentation."
 926   (save-excursion
 927     (let ((pos (point))
 928           text-start state)
 929       (if limit
 930           (goto-char limit)
 931         ;; Skip tags backwards until we find one at indentation
 932         (while (and (ignore-errors (sgml-parse-tag-backward))
 933                     (not (sgml-at-indentation-p)))))
 934       (with-syntax-table sgml-tag-syntax-table
 935         (while (< (point) pos)
 936           ;; When entering this loop we're inside text.
 937           (setq text-start (point))
 938           (skip-chars-forward "^<" pos)
 939           (setq state
 940                 (cond
 941                  ((= (point) pos)
 942                   ;; We got to the end without seeing a tag.
 943                   nil)
 944                  ((looking-at "<!\\[[A-Z]+\\[")
 945                   ;; We've found a CDATA section or similar.
 946                   (let ((cdata-start (point)))
 947                     (unless (search-forward "]]>" pos 'move)
 948                       (list 0 nil nil 'cdata nil nil nil nil cdata-start))))
 949                  (t
 950                   ;; We've reached a tag.  Parse it.
 951                   ;; FIXME: Handle net-enabling start-tags
 952                   (parse-partial-sexp (point) pos 0))))))
 953       (cond
 954        ((eq (nth 3 state) 'cdata) (cons 'cdata (nth 8 state)))
 955        ((nth 3 state) (cons 'string (nth 8 state)))
 956        ((nth 4 state) (cons 'comment (nth 8 state)))
 957        ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))
 958        (t (cons 'text text-start))))))
 959
 960 (defun sgml-beginning-of-tag (&optional top-level)
 961   "Skip to beginning of tag and return its name.
 962 If this can't be done, return nil."
 963   (let ((context (sgml-lexical-context)))
 964     (if (eq (car context) 'tag)
 965         (progn
 966           (goto-char (cdr context))
 967           (when (looking-at sgml-tag-name-re)
 968             (match-string-no-properties 1)))
 969       (if top-level nil
 970         (when (not (eq (car context) 'text))
 971           (goto-char (cdr context))
 972           (sgml-beginning-of-tag t))))))
 973
 974 (defun sgml-value (alist)
 975   "Interactively insert value taken from attribute-rule ALIST.
 976 See `sgml-tag-alist' for info about attribute rules."
 977   (setq alist (cdr alist))
 978   (if (stringp (car alist))
 979       (insert "=\"" (car alist) ?\")
 980     (if (and (eq (car alist) t) (not sgml-xml-mode))
 981         (when (cdr alist)
 982           (insert "=\"")
 983           (setq alist (skeleton-read '(completing-read "Value: " (cdr alist))))
 984           (if (string< "" alist)
 985               (insert alist ?\")
 986             (delete-backward-char 2)))
 987       (insert "=\"")
 988       (when alist
 989         (insert (skeleton-read '(completing-read "Value: " alist))))
 990       (insert ?\"))))
 991
 992 (defun sgml-quote (start end &optional unquotep)
 993   "Quote SGML text in region START ... END.
 994 Only &, < and > are quoted, the rest is left untouched.
 995 With prefix argument UNQUOTEP, unquote the region."
 996   (interactive "r\nP")
 997   (save-restriction
 998     (narrow-to-region start end)
 999     (goto-char (point-min))
1000     (if unquotep
1001         ;; FIXME: We should unquote other named character references as well.
1002         (while (re-search-forward
1003                 "\\(&\\(amp\\|\\(l\\|\\(g\\)\\)t\\)\\)[][<>&;\n\t \"%!'(),/=?]"
1004                 nil t)
1005           (replace-match (if (match-end 4) ">" (if (match-end 3) "<" "&")) t t
1006                          nil (if (eq (char-before (match-end 0)) ?\;) 0 1)))
1007       (while (re-search-forward "[&<>]" nil t)
1008         (replace-match (cdr (assq (char-before) '((?& . "&amp;")
1009                                                   (?< . "&lt;")
1010                                                   (?> . "&gt;"))))
1011                        t t)))))
1012
1013 (defun sgml-pretty-print (beg end)
1014   "Simple-minded pretty printer for SGML.
1015 Re-indents the code and inserts newlines between BEG and END.
1016 You might want to turn on `auto-fill-mode' to get better results."
1017   ;; TODO:
1018   ;; - insert newline between some start-tag and text.
1019   ;; - don't insert newline in front of some end-tags.
1020   (interactive "r")
1021   (save-excursion
1022     (if (< beg end)
1023         (goto-char beg)
1024       (goto-char end)
1025       (setq end beg)
1026       (setq beg (point)))
1027     ;; Don't use narrowing because it screws up auto-indent.
1028     (setq end (copy-marker end t))
1029     (with-syntax-table sgml-tag-syntax-table
1030       (while (re-search-forward "<" end t)
1031         (goto-char (match-beginning 0))
1032         (unless (or ;;(looking-at "</")
1033                     (progn (skip-chars-backward " \t") (bolp)))
1034           (reindent-then-newline-and-indent))
1035         (forward-sexp 1)))
1036     ;; (indent-region beg end)
1037     ))
1038
1039 \f
1040 ;; Parsing
1041
1042 (defstruct (sgml-tag
1043             (:constructor sgml-make-tag (type start end name)))
1044   type start end name)
1045
1046 (defsubst sgml-parse-tag-name ()
1047   "Skip past a tag-name, and return the name."
1048   (buffer-substring-no-properties
1049    (point) (progn (skip-syntax-forward "w_") (point))))
1050
1051 (defsubst sgml-looking-back-at (str)
1052   "Return t if the test before point matches STR."
1053   (let ((start (- (point) (length str))))
1054     (and (>= start (point-min))
1055          (equal str (buffer-substring-no-properties start (point))))))
1056
1057 (defun sgml-tag-text-p (start end)
1058   "Return non-nil if text between START and END is a tag.
1059 Checks among other things that the tag does not contain spurious
1060 unquoted < or > chars inside, which would indicate that it
1061 really isn't a tag after all."
1062   (save-excursion
1063     (with-syntax-table sgml-tag-syntax-table
1064       (let ((pps (parse-partial-sexp start end 2)))
1065         (and (= (nth 0 pps) 0))))))
1066
1067 (defun sgml-parse-tag-backward (&optional limit)
1068   "Parse an SGML tag backward, and return information about the tag.
1069 Assume that parsing starts from within a textual context.
1070 Leave point at the beginning of the tag."
1071   (catch 'found
1072     (let (tag-type tag-start tag-end name)
1073       (or (re-search-backward "[<>]" limit 'move)
1074           (error "No tag found"))
1075       (when (eq (char-after) ?<)
1076         ;; Oops!! Looks like we were not in a textual context after all!.
1077         ;; Let's try to recover.
1078         (with-syntax-table sgml-tag-syntax-table
1079           (let ((pos (point)))
1080             (condition-case nil
1081                 (forward-sexp)
1082               (scan-error
1083                ;; This < seems to be just a spurious one, let's ignore it.
1084                (goto-char pos)
1085                (throw 'found (sgml-parse-tag-backward limit))))
1086             ;; Check it is really a tag, without any extra < or > inside.
1087             (unless (sgml-tag-text-p pos (point))
1088               (goto-char pos)
1089               (throw 'found (sgml-parse-tag-backward limit)))
1090             (forward-char -1))))
1091       (setq tag-end (1+ (point)))
1092       (cond
1093        ((sgml-looking-back-at "--")     ; comment
1094         (setq tag-type 'comment
1095               tag-start (search-backward "<!--" nil t)))
1096        ((sgml-looking-back-at "]]")     ; cdata
1097         (setq tag-type 'cdata
1098               tag-start (re-search-backward "<!\\[[A-Z]+\\[" nil t)))
1099        (t
1100         (setq tag-start
1101               (with-syntax-table sgml-tag-syntax-table
1102                 (goto-char tag-end)
1103                 (condition-case nil
1104                     (backward-sexp)
1105                   (scan-error
1106                    ;; This > isn't really the end of a tag. Skip it.
1107                    (goto-char (1- tag-end))
1108                    (throw 'found (sgml-parse-tag-backward limit))))
1109                 (point)))
1110         (goto-char (1+ tag-start))
1111         (case (char-after)
1112           (?!                           ; declaration
1113            (setq tag-type 'decl))
1114           (??                           ; processing-instruction
1115            (setq tag-type 'pi))
1116           (?/                           ; close-tag
1117            (forward-char 1)
1118            (setq tag-type 'close
1119                  name (sgml-parse-tag-name)))
1120           (?%                           ; JSP tags
1121            (setq tag-type 'jsp))
1122           (t                            ; open or empty tag
1123            (setq tag-type 'open
1124                  name (sgml-parse-tag-name))
1125            (if (or (eq ?/ (char-before (- tag-end 1)))
1126                    (sgml-empty-tag-p name))
1127                (setq tag-type 'empty))))))
1128       (goto-char tag-start)
1129       (sgml-make-tag tag-type tag-start tag-end name))))
1130
1131 (defun sgml-get-context (&optional until)
1132   "Determine the context of the current position.
1133 By default, parse until we find a start-tag as the first thing on a line.
1134 If UNTIL is `empty', return even if the context is empty (i.e.
1135 we just skipped over some element and got to a beginning of line).
1136
1137 The context is a list of tag-info structures.  The last one is the tag
1138 immediately enclosing the current position.
1139
1140 Point is assumed to be outside of any tag.  If we discover that it's
1141 not the case, the first tag returned is the one inside which we are."
1142   (let ((here (point))
1143         (ignore nil)
1144         (context nil)
1145         tag-info)
1146     ;; CONTEXT keeps track of the tag-stack
1147     ;; IGNORE keeps track of the nesting level of point relative to the
1148     ;;   first (outermost) tag on the context.  This is the list of
1149     ;;   enclosing start-tags we'll have to ignore.
1150     (skip-chars-backward " \t\n")      ; Make sure we're not at indentation.
1151     (while
1152         (and (not (eq until 'now))
1153              (or ignore
1154                  (not (if until (eq until 'empty) context))
1155                  (not (sgml-at-indentation-p))
1156                  (and context
1157                       (/= (point) (sgml-tag-start (car context)))
1158                       (sgml-unclosed-tag-p (sgml-tag-name (car context)))))
1159              (setq tag-info (ignore-errors (sgml-parse-tag-backward))))
1160
1161       ;; This tag may enclose things we thought were tags.  If so,
1162       ;; discard them.
1163       (while (and context
1164                   (> (sgml-tag-end tag-info)
1165                      (sgml-tag-end (car context))))
1166         (setq context (cdr context)))
1167
1168       (cond
1169        ((> (sgml-tag-end tag-info) here)
1170         ;; Oops!!  Looks like we were not outside of any tag, after all.
1171         (push tag-info context)
1172         (setq until 'now))
1173
1174        ;; start-tag
1175        ((eq (sgml-tag-type tag-info) 'open)
1176         (cond
1177          ((null ignore)
1178           (if (and context
1179                    (sgml-unclosed-tag-p (sgml-tag-name tag-info))
1180                    (eq t (compare-strings
1181                           (sgml-tag-name tag-info) nil nil
1182                           (sgml-tag-name (car context)) nil nil t)))
1183               ;; There was an implicit end-tag.
1184               nil
1185             (push tag-info context)))
1186          ((eq t (compare-strings (sgml-tag-name tag-info) nil nil
1187                                  (car ignore) nil nil t))
1188           (setq ignore (cdr ignore)))
1189          (t
1190           ;; The open and close tags don't match.
1191           (if (not sgml-xml-mode)
1192               (unless (sgml-unclosed-tag-p (sgml-tag-name tag-info))
1193                 (message "Unclosed tag <%s>" (sgml-tag-name tag-info))
1194                 (let ((tmp ignore))
1195                   ;; We could just assume that the tag is simply not closed
1196                   ;; but it's a bad assumption when tags *are* closed but
1197                   ;; not properly nested.
1198                   (while (and (cdr tmp)
1199                               (not (eq t (compare-strings
1200                                           (sgml-tag-name tag-info) nil nil
1201                                           (cadr tmp) nil nil t))))
1202                     (setq tmp (cdr tmp)))
1203                   (if (cdr tmp) (setcdr tmp (cddr tmp)))))
1204             (message "Unmatched tags <%s> and </%s>"
1205                      (sgml-tag-name tag-info) (pop ignore))))))
1206
1207        ;; end-tag
1208        ((eq (sgml-tag-type tag-info) 'close)
1209         (if (sgml-empty-tag-p (sgml-tag-name tag-info))
1210             (message "Spurious </%s>: empty tag" (sgml-tag-name tag-info))
1211           (push (sgml-tag-name tag-info) ignore)))
1212        ))
1213
1214     ;; return context
1215     context))
1216
1217 (defun sgml-show-context (&optional full)
1218   "Display the current context.
1219 If FULL is non-nil, parse back to the beginning of the buffer."
1220   (interactive "P")
1221   (with-output-to-temp-buffer "*XML Context*"
1222     (save-excursion
1223       (let ((context (sgml-get-context)))
1224         (when full
1225           (let ((more nil))
1226             (while (setq more (sgml-get-context))
1227               (setq context (nconc more context)))))
1228         (pp context)))))
1229
1230 \f
1231 ;; Editing shortcuts
1232
1233 (defun sgml-close-tag ()
1234   "Close current element.
1235 Depending on context, inserts a matching close-tag, or closes
1236 the current start-tag or the current comment or the current cdata, ..."
1237   (interactive)
1238   (case (car (sgml-lexical-context))
1239     (comment    (insert " -->"))
1240     (cdata      (insert "]]>"))
1241     (pi         (insert " ?>"))
1242     (jsp        (insert " %>"))
1243     (tag        (insert " />"))
1244     (text
1245      (let ((context (save-excursion (sgml-get-context))))
1246        (if context
1247            (progn
1248              (insert "</" (sgml-tag-name (car (last context))) ">")
1249              (indent-according-to-mode)))))
1250     (otherwise
1251      (error "Nothing to close"))))
1252
1253 (defun sgml-empty-tag-p (tag-name)
1254   "Return non-nil if TAG-NAME is an implicitly empty tag."
1255   (and (not sgml-xml-mode)
1256        (member-ignore-case tag-name sgml-empty-tags)))
1257
1258 (defun sgml-unclosed-tag-p (tag-name)
1259   "Return non-nil if TAG-NAME is a tag for which an end-tag is optional."
1260   (and (not sgml-xml-mode)
1261        (member-ignore-case tag-name sgml-unclosed-tags)))
1262
1263 (defun sgml-calculate-indent (&optional lcon)
1264   "Calculate the column to which this line should be indented.
1265 LCON is the lexical context, if any."
1266   (unless lcon (setq lcon (sgml-lexical-context)))
1267
1268   ;; Indent comment-start markers inside <!-- just like comment-end markers.
1269   (if (and (eq (car lcon) 'tag)
1270            (looking-at "--")
1271            (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
1272       (setq lcon (cons 'comment (+ (cdr lcon) 2))))
1273
1274   (case (car lcon)
1275
1276     (string
1277      ;; Go back to previous non-empty line.
1278      (while (and (> (point) (cdr lcon))
1279                  (zerop (forward-line -1))
1280                  (looking-at "[ \t]*$")))
1281      (if (> (point) (cdr lcon))
1282          ;; Previous line is inside the string.
1283          (current-indentation)
1284        (goto-char (cdr lcon))
1285        (1+ (current-column))))
1286
1287     (comment
1288      (let ((mark (looking-at "--")))
1289        ;; Go back to previous non-empty line.
1290        (while (and (> (point) (cdr lcon))
1291                    (zerop (forward-line -1))
1292                    (or (looking-at "[ \t]*$")
1293                        (if mark (not (looking-at "[ \t]*--"))))))
1294        (if (> (point) (cdr lcon))
1295            ;; Previous line is inside the comment.
1296            (skip-chars-forward " \t")
1297          (goto-char (cdr lcon))
1298          ;; Skip `<!' to get to the `--' with which we want to align.
1299          (search-forward "--")
1300          (goto-char (match-beginning 0)))
1301        (when (and (not mark) (looking-at "--"))
1302          (forward-char 2) (skip-chars-forward " \t"))
1303        (current-column)))
1304
1305     ;; We don't know how to indent it.  Let's be honest about it.
1306     (cdata nil)
1307
1308     (tag
1309      (goto-char (1+ (cdr lcon)))
1310      (skip-chars-forward "^ \t\n")      ;Skip tag name.
1311      (skip-chars-forward " \t")
1312      (if (not (eolp))
1313          (current-column)
1314        ;; This is the first attribute: indent.
1315        (goto-char (1+ (cdr lcon)))
1316        (+ (current-column) sgml-basic-offset)))
1317
1318     (text
1319      (while (looking-at "</")
1320        (forward-sexp 1)
1321        (skip-chars-forward " \t"))
1322      (let* ((here (point))
1323             (unclosed (and ;; (not sgml-xml-mode)
1324                        (looking-at sgml-tag-name-re)
1325                        (member-ignore-case (match-string 1)
1326                                            sgml-unclosed-tags)
1327                        (match-string 1)))
1328             (context
1329              ;; If possible, align on the previous non-empty text line.
1330              ;; Otherwise, do a more serious parsing to find the
1331              ;; tag(s) relative to which we should be indenting.
1332              (if (and (not unclosed) (skip-chars-backward " \t")
1333                       (< (skip-chars-backward " \t\n") 0)
1334                       (back-to-indentation)
1335                       (> (point) (cdr lcon)))
1336                  nil
1337                (goto-char here)
1338                (nreverse (sgml-get-context (if unclosed nil 'empty)))))
1339             (there (point)))
1340        ;; Ignore previous unclosed start-tag in context.
1341        (while (and context unclosed
1342                    (eq t (compare-strings
1343                           (sgml-tag-name (car context)) nil nil
1344                           unclosed nil nil t)))
1345          (setq context (cdr context)))
1346        ;; Indent to reflect nesting.
1347        (cond
1348         ;; If we were not in a text context after all, let's try again.
1349         ((and context (> (sgml-tag-end (car context)) here))
1350          (goto-char here)
1351          (sgml-calculate-indent
1352           (cons (if (memq (sgml-tag-type (car context)) '(comment cdata))
1353                     (sgml-tag-type (car context)) 'tag)
1354                 (sgml-tag-start (car context)))))
1355         ;; Align on the first element after the nearest open-tag, if any.
1356         ((and context
1357               (goto-char (sgml-tag-end (car context)))
1358               (skip-chars-forward " \t\n")
1359               (< (point) here) (sgml-at-indentation-p))
1360          (current-column))
1361         (t
1362          (goto-char there)
1363          (+ (current-column)
1364             (* sgml-basic-offset (length context)))))))
1365
1366     (otherwise
1367      (error "Unrecognised context %s" (car lcon)))
1368
1369     ))
1370
1371 (defun sgml-indent-line ()
1372   "Indent the current line as SGML."
1373   (interactive)
1374   (let* ((savep (point))
1375          (indent-col
1376           (save-excursion
1377             (back-to-indentation)
1378             (if (>= (point) savep) (setq savep nil))
1379             (sgml-calculate-indent))))
1380     (if (null indent-col)
1381         'noindent
1382       (if savep
1383           (save-excursion (indent-line-to indent-col))
1384         (indent-line-to indent-col)))))
1385
1386 (defun sgml-guess-indent ()
1387   "Guess an appropriate value for `sgml-basic-offset'.
1388 Base the guessed identation level on the first indented tag in the buffer.
1389 Add this to `sgml-mode-hook' for convenience."
1390   (interactive)
1391   (save-excursion
1392     (goto-char (point-min))
1393     (if (re-search-forward "^\\([ \t]+\\)<" 500 'noerror)
1394         (progn
1395           (set (make-local-variable 'sgml-basic-offset)
1396                (1- (current-column)))
1397           (message "Guessed sgml-basic-offset = %d"
1398                    sgml-basic-offset)
1399           ))))
1400
1401 (defun sgml-parse-dtd ()
1402   "Simplistic parse of the current buffer as a DTD.
1403 Currently just returns (EMPTY-TAGS UNCLOSED-TAGS)."
1404   (goto-char (point-min))
1405   (let ((empty nil)
1406         (unclosed nil))
1407     (while (re-search-forward "<!ELEMENT[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+[-O][ \t\n]+\\([-O]\\)[ \t\n]+\\([^ \t\n]+\\)" nil t)
1408       (cond
1409        ((string= (match-string 3) "EMPTY")
1410         (push (match-string-no-properties 1) empty))
1411        ((string= (match-string 2) "O")
1412         (push (match-string-no-properties 1) unclosed))))
1413     (setq empty (sort (mapcar 'downcase empty) 'string<))
1414     (setq unclosed (sort (mapcar 'downcase unclosed) 'string<))
1415     (list empty unclosed)))
1416
1417 ;;; HTML mode
1418
1419 (defcustom html-mode-hook nil
1420   "Hook run by command `html-mode'.
1421 `text-mode-hook' and `sgml-mode-hook' are run first."
1422   :group 'sgml
1423   :type 'hook
1424   :options '(html-autoview-mode))
1425
1426 (defvar html-quick-keys sgml-quick-keys
1427   "Use C-c X combinations for quick insertion of frequent tags when non-nil.
1428 This defaults to `sgml-quick-keys'.
1429 This takes effect when first loading the library.")
1430
1431 (defvar html-mode-map
1432   (let ((map (make-sparse-keymap))
1433         (menu-map (make-sparse-keymap "HTML")))
1434     (set-keymap-parent map  sgml-mode-map)
1435     (define-key map "\C-c6" 'html-headline-6)
1436     (define-key map "\C-c5" 'html-headline-5)
1437     (define-key map "\C-c4" 'html-headline-4)
1438     (define-key map "\C-c3" 'html-headline-3)
1439     (define-key map "\C-c2" 'html-headline-2)
1440     (define-key map "\C-c1" 'html-headline-1)
1441     (define-key map "\C-c\r" 'html-paragraph)
1442     (define-key map "\C-c\n" 'html-line)
1443     (define-key map "\C-c\C-c-" 'html-horizontal-rule)
1444     (define-key map "\C-c\C-co" 'html-ordered-list)
1445     (define-key map "\C-c\C-cu" 'html-unordered-list)
1446     (define-key map "\C-c\C-cr" 'html-radio-buttons)
1447     (define-key map "\C-c\C-cc" 'html-checkboxes)
1448     (define-key map "\C-c\C-cl" 'html-list-item)
1449     (define-key map "\C-c\C-ch" 'html-href-anchor)
1450     (define-key map "\C-c\C-cn" 'html-name-anchor)
1451     (define-key map "\C-c\C-ci" 'html-image)
1452     (when html-quick-keys
1453       (define-key map "\C-c-" 'html-horizontal-rule)
1454       (define-key map "\C-co" 'html-ordered-list)
1455       (define-key map "\C-cu" 'html-unordered-list)
1456       (define-key map "\C-cr" 'html-radio-buttons)
1457       (define-key map "\C-cc" 'html-checkboxes)
1458       (define-key map "\C-cl" 'html-list-item)
1459       (define-key map "\C-ch" 'html-href-anchor)
1460       (define-key map "\C-cn" 'html-name-anchor)
1461       (define-key map "\C-ci" 'html-image))
1462     (define-key map "\C-c\C-s" 'html-autoview-mode)
1463     (define-key map "\C-c\C-v" 'browse-url-of-buffer)
1464     (define-key map [menu-bar html] (cons "HTML" menu-map))
1465     (define-key menu-map [html-autoview-mode]
1466       '("Toggle Autoviewing" . html-autoview-mode))
1467     (define-key menu-map [browse-url-of-buffer]
1468       '("View Buffer Contents" . browse-url-of-buffer))
1469     (define-key menu-map [nil] '("--"))
1470     ;;(define-key menu-map "6" '("Heading 6" . html-headline-6))
1471     ;;(define-key menu-map "5" '("Heading 5" . html-headline-5))
1472     ;;(define-key menu-map "4" '("Heading 4" . html-headline-4))
1473     (define-key menu-map "3" '("Heading 3" . html-headline-3))
1474     (define-key menu-map "2" '("Heading 2" . html-headline-2))
1475     (define-key menu-map "1" '("Heading 1" . html-headline-1))
1476     (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons))
1477     (define-key menu-map "c" '("Checkboxes" . html-checkboxes))
1478     (define-key menu-map "l" '("List Item" . html-list-item))
1479     (define-key menu-map "u" '("Unordered List" . html-unordered-list))
1480     (define-key menu-map "o" '("Ordered List" . html-ordered-list))
1481     (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule))
1482     (define-key menu-map "\n" '("Line Break" . html-line))
1483     (define-key menu-map "\r" '("Paragraph" . html-paragraph))
1484     (define-key menu-map "i" '("Image" . html-image))
1485     (define-key menu-map "h" '("Href Anchor" . html-href-anchor))
1486     (define-key menu-map "n" '("Name Anchor" . html-name-anchor))
1487     map)
1488   "Keymap for commands for use in HTML mode.")
1489
1490 (defvar html-face-tag-alist
1491   '((bold . "b")
1492     (italic . "i")
1493     (underline . "u")
1494     (modeline . "rev"))
1495   "Value of `sgml-face-tag-alist' for HTML mode.")
1496
1497 (defvar html-tag-face-alist
1498   '(("b" . bold)
1499     ("big" . bold)
1500     ("blink" . highlight)
1501     ("cite" . italic)
1502     ("em" . italic)
1503     ("h1" bold underline)
1504     ("h2" bold-italic underline)
1505     ("h3" italic underline)
1506     ("h4" . underline)
1507     ("h5" . underline)
1508     ("h6" . underline)
1509     ("i" . italic)
1510     ("rev"  . modeline)
1511     ("s" . underline)
1512     ("small" . default)
1513     ("strong" . bold)
1514     ("title" bold underline)
1515     ("tt" . default)
1516     ("u" . underline)
1517     ("var" . italic))
1518   "Value of `sgml-tag-face-alist' for HTML mode.")
1519
1520 (defvar html-display-text
1521   '((img . "[/]")
1522     (hr . "----------")
1523     (li . "o "))
1524   "Value of `sgml-display-text' for HTML mode.")
1525
1526 \f
1527 ;; should code exactly HTML 3 here when that is finished
1528 (defvar html-tag-alist
1529   (let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7")))
1530          (1-9 `(,@1-7 ("8") ("9")))
1531          (align '(("align" ("left") ("center") ("right"))))
1532          (valign '(("top") ("middle") ("bottom") ("baseline")))
1533          (rel '(("next") ("previous") ("parent") ("subdocument") ("made")))
1534          (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:")
1535                  ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:")
1536                  ("wais:") ("/cgi-bin/")))
1537          (name '("name"))
1538          (link `(,href
1539                  ("rel" ,@rel)
1540                  ("rev" ,@rel)
1541                  ("title")))
1542          (list '((nil \n ("List item: " "<li>" str
1543                           (if sgml-xml-mode "</li>") \n))))
1544          (cell `(t
1545                  ,@align
1546                  ("valign" ,@valign)
1547                  ("colspan" ,@1-9)
1548                  ("rowspan" ,@1-9)
1549                  ("nowrap" t))))
1550     ;; put ,-expressions first, else byte-compile chokes (as of V19.29)
1551     ;; and like this it's more efficient anyway
1552     `(("a" ,name ,@link)
1553       ("base" t ,@href)
1554       ("dir" ,@list)
1555       ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)
1556       ("form" (\n _ \n "<input type=\"submit\" value=\"\""
1557                (if sgml-xml-mode "/>" ">"))
1558        ("action" ,@(cdr href)) ("method" ("get") ("post")))
1559       ("h1" ,@align)
1560       ("h2" ,@align)
1561       ("h3" ,@align)
1562       ("h4" ,@align)
1563       ("h5" ,@align)
1564       ("h6" ,@align)
1565       ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align)
1566       ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom"))
1567        ("src") ("alt") ("width" "1") ("height" "1")
1568        ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t))
1569       ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name
1570        ("type" ("text") ("password") ("checkbox") ("radio")
1571         ("submit") ("reset"))
1572        ("value"))
1573       ("link" t ,@link)
1574       ("menu" ,@list)
1575       ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1")))
1576       ("p" t ,@align)
1577       ("select" (nil \n
1578                      ("Text: "
1579                       "<option>" str (if sgml-xml-mode "</option>") \n))
1580        ,name ("size" ,@1-9) ("multiple" t))
1581       ("table" (nil \n
1582                     ((completing-read "Cell kind: " '(("td") ("th"))
1583                                       nil t "t")
1584                      "<tr><" str ?> _
1585                      (if sgml-xml-mode (concat "<" str "></tr>")) \n))
1586        ("border" t ,@1-9) ("width" "10") ("cellpadding"))
1587       ("td" ,@cell)
1588       ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
1589       ("th" ,@cell)
1590       ("ul" ,@list ("type" ("disc") ("circle") ("square")))
1591
1592       ,@sgml-tag-alist
1593
1594       ("abbrev")
1595       ("acronym")
1596       ("address")
1597       ("array" (nil \n
1598                     ("Item: " "<item>" str (if sgml-xml-mode "</item>") \n))
1599        "align")
1600       ("au")
1601       ("b")
1602       ("big")
1603       ("blink")
1604       ("blockquote" \n)
1605       ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#")
1606        ("link" "#") ("alink" "#") ("vlink" "#"))
1607       ("box" (nil _ "<over>" _ (if sgml-xml-mode "</over>")))
1608       ("br" t ("clear" ("left") ("right")))
1609       ("caption" ("valign" ("top") ("bottom")))
1610       ("center" \n)
1611       ("cite")
1612       ("code" \n)
1613       ("dd" ,(not sgml-xml-mode))
1614       ("del")
1615       ("dfn")
1616       ("div")
1617       ("dl" (nil \n
1618                  ( "Term: "
1619                    "<dt>" str (if sgml-xml-mode "</dt>")
1620                    "<dd>" _ (if sgml-xml-mode "</dd>") \n)))
1621       ("dt" (t _ (if sgml-xml-mode "</dt>")
1622              "<dd>" (if sgml-xml-mode "</dd>") \n))
1623       ("em")
1624       ;("fn" "id" "fn")  ; ???
1625       ("head" \n)
1626       ("html" (\n
1627                "<head>\n"
1628                "<title>" (setq str (read-input "Title: ")) "</title>\n"
1629                "</head>\n"
1630                "<body>\n<h1>" str "</h1>\n" _
1631                "\n<address>\n<a href=\"mailto:"
1632                user-mail-address
1633                "\">" (user-full-name) "</a>\n</address>\n"
1634                "</body>"
1635                 ))
1636       ("i")
1637       ("ins")
1638       ("isindex" t ("action") ("prompt"))
1639       ("kbd")
1640       ("lang")
1641       ("li" ,(not sgml-xml-mode))
1642       ("math" \n)
1643       ("nobr")
1644       ("option" t ("value") ("label") ("selected" t))
1645       ("over" t)
1646       ("person")
1647       ("pre" \n)
1648       ("q")
1649       ("rev")
1650       ("s")
1651       ("samp")
1652       ("small")
1653       ("span" nil
1654         ("class"
1655          ("builtin")
1656          ("comment")
1657          ("constant")
1658          ("function-name")
1659          ("keyword")
1660          ("string")
1661          ("type")
1662          ("variable-name")
1663          ("warning")))
1664       ("strong")
1665       ("sub")
1666       ("sup")
1667       ("title")
1668       ("tr" t)
1669       ("tt")
1670       ("u")
1671       ("var")
1672       ("wbr" t)))
1673   "*Value of `sgml-tag-alist' for HTML mode.")
1674
1675 (defvar html-tag-help
1676   `(,@sgml-tag-help
1677     ("a" . "Anchor of point or link elsewhere")
1678     ("abbrev" . "?")
1679     ("acronym" . "?")
1680     ("address" . "Formatted mail address")
1681     ("array" . "Math array")
1682     ("au" . "?")
1683     ("b" . "Bold face")
1684     ("base" . "Base address for URLs")
1685     ("big" . "Font size")
1686     ("blink" . "Blinking text")
1687     ("blockquote" . "Indented quotation")
1688     ("body" . "Document body")
1689     ("box" . "Math fraction")
1690     ("br" . "Line break")
1691     ("caption" . "Table caption")
1692     ("center" . "Centered text")
1693     ("changed" . "Change bars")
1694     ("cite" . "Citation of a document")
1695     ("code" . "Formatted source code")
1696     ("dd" . "Definition of term")
1697     ("del" . "?")
1698     ("dfn" . "?")
1699     ("dir" . "Directory list (obsolete)")
1700     ("dl" . "Definition list")
1701     ("dt" . "Term to be definined")
1702     ("em" . "Emphasised")
1703     ("embed" . "Embedded data in foreign format")
1704     ("fig" . "Figure")
1705     ("figa" . "Figure anchor")
1706     ("figd" . "Figure description")
1707     ("figt" . "Figure text")
1708     ;("fn" . "?")  ; ???
1709     ("font" . "Font size")
1710     ("form" . "Form with input fields")
1711     ("group" . "Document grouping")
1712     ("h1" . "Most important section headline")
1713     ("h2" . "Important section headline")
1714     ("h3" . "Section headline")
1715     ("h4" . "Minor section headline")
1716     ("h5" . "Unimportant section headline")
1717     ("h6" . "Least important section headline")
1718     ("head" . "Document header")
1719     ("hr" . "Horizontal rule")
1720     ("html" . "HTML Document")
1721     ("i" . "Italic face")
1722     ("img" . "Graphic image")
1723     ("input" . "Form input field")
1724     ("ins" . "?")
1725     ("isindex" . "Input field for index search")
1726     ("kbd" . "Keybard example face")
1727     ("lang" . "Natural language")
1728     ("li" . "List item")
1729     ("link" . "Link relationship")
1730     ("math" . "Math formula")
1731     ("menu" . "Menu list (obsolete)")
1732     ("mh" . "Form mail header")
1733     ("nextid" . "Allocate new id")
1734     ("nobr" . "Text without line break")
1735     ("ol" . "Ordered list")
1736     ("option" . "Selection list item")
1737     ("over" . "Math fraction rule")
1738     ("p" . "Paragraph start")
1739     ("panel" . "Floating panel")
1740     ("person" . "?")
1741     ("pre" . "Preformatted fixed width text")
1742     ("q" . "?")
1743     ("rev" . "Reverse video")
1744     ("s" . "?")
1745     ("samp" . "Sample text")
1746     ("select" . "Selection list")
1747     ("small" . "Font size")
1748     ("sp" . "Nobreak space")
1749     ("strong" . "Standout text")
1750     ("sub" . "Subscript")
1751     ("sup" . "Superscript")
1752     ("table" . "Table with rows and columns")
1753     ("tb" . "Table vertical break")
1754     ("td" . "Table data cell")
1755     ("textarea" . "Form multiline edit area")
1756     ("th" . "Table header cell")
1757     ("title" . "Document title")
1758     ("tr" . "Table row separator")
1759     ("tt" . "Typewriter face")
1760     ("u" . "Underlined text")
1761     ("ul" . "Unordered list")
1762     ("var" . "Math variable face")
1763     ("wbr" . "Enable <br> within <nobr>"))
1764 "*Value of `sgml-tag-help' for HTML mode.")
1765
1766 \f
1767 ;;;###autoload
1768 (define-derived-mode html-mode sgml-mode "HTML"
1769   "Major mode based on SGML mode for editing HTML documents.
1770 This allows inserting skeleton constructs used in hypertext documents with
1771 completion.  See below for an introduction to HTML.  Use
1772 \\[browse-url-of-buffer] to see how this comes out.  See also `sgml-mode' on
1773 which this is based.
1774
1775 Do \\[describe-variable] html- SPC and \\[describe-variable] sgml- SPC to see available variables.
1776
1777 To write fairly well formatted pages you only need to know few things.  Most
1778 browsers have a function to read the source code of the page being seen, so
1779 you can imitate various tricks.  Here's a very short HTML primer which you
1780 can also view with a browser to see what happens:
1781
1782 <title>A Title Describing Contents</title> should be on every page.  Pages can
1783 have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
1784 <hr> Parts can be separated with horizontal rules.
1785
1786 <p>Paragraphs only need an opening tag.  Line breaks and multiple spaces are
1787 ignored unless the text is <pre>preformatted.</pre>  Text can be marked as
1788 <b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal  M-g  or
1789 Edit/Text Properties/Face commands.
1790
1791 Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
1792 to them with <a href=\"#SOMENAME\">see also somename</a>.  In the same way <a
1793 href=\"URL\">see also URL</a> where URL is a filename relative to current
1794 directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'.
1795
1796 Images in many formats can be inlined with <img src=\"URL\">.
1797
1798 If you mainly create your own documents, `sgml-specials' might be
1799 interesting.  But note that some HTML 2 browsers can't handle `&apos;'.
1800 To work around that, do:
1801    (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
1802
1803 \\{html-mode-map}"
1804   (set (make-local-variable 'sgml-display-text) html-display-text)
1805   (set (make-local-variable 'sgml-tag-face-alist) html-tag-face-alist)
1806   (make-local-variable 'sgml-tag-alist)
1807   (make-local-variable 'sgml-face-tag-alist)
1808   (make-local-variable 'sgml-tag-help)
1809   (make-local-variable 'outline-regexp)
1810   (make-local-variable 'outline-heading-end-regexp)
1811   (make-local-variable 'outline-level)
1812   (make-local-variable 'sentence-end)
1813   (setq sentence-end
1814         (if sentence-end-double-space
1815             "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\| $\\|\t\\|  \\)[ \t\n]*"
1816           "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\|[ \t]\\)[ \t\n]*"))
1817   (setq sgml-tag-alist html-tag-alist
1818         sgml-face-tag-alist html-face-tag-alist
1819         sgml-tag-help html-tag-help
1820         outline-regexp "^.*<[Hh][1-6]\\>"
1821         outline-heading-end-regexp "</[Hh][1-6]>"
1822         outline-level (lambda ()
1823                         (char-before (match-end 0))))
1824   (setq imenu-create-index-function 'html-imenu-index)
1825   (when sgml-xml-mode (setq mode-name "XHTML"))
1826   (set (make-local-variable 'sgml-empty-tags)
1827        ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd',
1828        ;; plus manual addition of "wbr".
1829        '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input"
1830          "isindex" "link" "meta" "param" "wbr"))
1831   (set (make-local-variable 'sgml-unclosed-tags)
1832        ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'.
1833        '("body" "colgroup" "dd" "dt" "head" "html" "li" "option"
1834          "p" "tbody" "td" "tfoot" "th" "thead" "tr"))
1835   ;; It's for the user to decide if it defeats it or not  -stef
1836   ;; (make-local-variable 'imenu-sort-function)
1837   ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
1838   )
1839
1840 (defvar html-imenu-regexp
1841   "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
1842   "*A regular expression matching a head line to be added to the menu.
1843 The first `match-string' should be a number from 1-9.
1844 The second `match-string' matches extra tags and is ignored.
1845 The third `match-string' will be the used in the menu.")
1846
1847 (defun html-imenu-index ()
1848   "Return a table of contents for an HTML buffer for use with Imenu."
1849   (let (toc-index)
1850     (save-excursion
1851       (goto-char (point-min))
1852       (while (re-search-forward html-imenu-regexp nil t)
1853         (setq toc-index
1854               (cons (cons (concat (make-string
1855                                    (* 2 (1- (string-to-number (match-string 1))))
1856                                    ?\ )
1857                                   (match-string 3))
1858                           (line-beginning-position))
1859                     toc-index))))
1860     (nreverse toc-index)))
1861
1862 (define-minor-mode html-autoview-mode
1863   "Toggle automatic viewing via `browse-url-of-buffer' upon saving buffer.
1864 With positive prefix ARG always turns viewing on, with negative ARG always off.
1865 Can be used as a value for `html-mode-hook'."
1866   nil nil nil
1867   :group 'sgml
1868   (if html-autoview-mode
1869       (add-hook 'after-save-hook 'browse-url-of-buffer nil t)
1870     (remove-hook 'after-save-hook 'browse-url-of-buffer t)))
1871
1872 \f
1873 (define-skeleton html-href-anchor
1874   "HTML anchor tag with href attribute."
1875   "URL: "
1876   '(setq input "http:")
1877   "<a href=\"" str "\">" _ "</a>")
1878
1879 (define-skeleton html-name-anchor
1880   "HTML anchor tag with name attribute."
1881   "Name: "
1882   "<a name=\"" str "\">" _ "</a>")
1883
1884 (define-skeleton html-headline-1
1885   "HTML level 1 headline tags."
1886   nil
1887   "<h1>" _ "</h1>")
1888
1889 (define-skeleton html-headline-2
1890   "HTML level 2 headline tags."
1891   nil
1892   "<h2>" _ "</h2>")
1893
1894 (define-skeleton html-headline-3
1895   "HTML level 3 headline tags."
1896   nil
1897   "<h3>" _ "</h3>")
1898
1899 (define-skeleton html-headline-4
1900   "HTML level 4 headline tags."
1901   nil
1902   "<h4>" _ "</h4>")
1903
1904 (define-skeleton html-headline-5
1905   "HTML level 5 headline tags."
1906   nil
1907   "<h5>" _ "</h5>")
1908
1909 (define-skeleton html-headline-6
1910   "HTML level 6 headline tags."
1911   nil
1912   "<h6>" _ "</h6>")
1913
1914 (define-skeleton html-horizontal-rule
1915   "HTML horizontal rule tag."
1916   nil
1917   (if sgml-xml-mode "<hr/>" "<hr>") \n)
1918
1919 (define-skeleton html-image
1920   "HTML image tag."
1921   nil
1922   "<img src=\"" _ "\""
1923   (if sgml-xml-mode "/>" ">"))
1924
1925 (define-skeleton html-line
1926   "HTML line break tag."
1927   nil
1928   (if sgml-xml-mode "<br/>" "<br>") \n)
1929
1930 (define-skeleton html-ordered-list
1931   "HTML ordered list tags."
1932   nil
1933   "<ol>" \n
1934   "<li>" _ (if sgml-xml-mode "</li>") \n
1935   "</ol>")
1936
1937 (define-skeleton html-unordered-list
1938   "HTML unordered list tags."
1939   nil
1940   "<ul>" \n
1941   "<li>" _ (if sgml-xml-mode "</li>") \n
1942   "</ul>")
1943
1944 (define-skeleton html-list-item
1945   "HTML list item tag."
1946   nil
1947   (if (bolp) nil '\n)
1948   "<li>" _ (if sgml-xml-mode "</li>"))
1949
1950 (define-skeleton html-paragraph
1951   "HTML paragraph tag."
1952   nil
1953   (if (bolp) nil ?\n)
1954   \n "<p>" _ (if sgml-xml-mode "</p>"))
1955
1956 (define-skeleton html-checkboxes
1957   "Group of connected checkbox inputs."
1958   nil
1959   '(setq v1 nil
1960          v2 nil)
1961   ("Value: "
1962    "<input type=\"" (identity "checkbox") ; see comment above about identity
1963    "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
1964    "\" value=\"" str ?\"
1965    (when (y-or-n-p "Set \"checked\" attribute? ")
1966      (funcall skeleton-transformation " checked"))
1967    (if sgml-xml-mode "/>" ">")
1968    (skeleton-read "Text: " (capitalize str))
1969    (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
1970                        (funcall skeleton-transformation
1971                                 (if sgml-xml-mode "<br/>" "<br>"))
1972                      "")))
1973    \n))
1974
1975 (define-skeleton html-radio-buttons
1976   "Group of connected radio button inputs."
1977   nil
1978   '(setq v1 nil
1979          v2 (cons nil nil))
1980   ("Value: "
1981    "<input type=\"" (identity "radio") ; see comment above about identity
1982    "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
1983    "\" value=\"" str ?\"
1984    (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
1985      (funcall skeleton-transformation " checked"))
1986    (if sgml-xml-mode "/>" ">")
1987    (skeleton-read "Text: " (capitalize str))
1988    (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
1989                                (funcall skeleton-transformation
1990                                         (if sgml-xml-mode "<br/>" "<br>"))
1991                              "")))
1992    \n))
1993
1994 (provide 'sgml-mode)
1995
1996 ;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401
1997 ;;; sgml-mode.el ends here