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