lisp/textmodes/sgml-mode.el

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