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 ;;;###autoload
 464 (defalias 'xml-mode 'sgml-mode)
 465
 466 (defun sgml-comment-indent ()
 467   (if (looking-at "--") comment-column 0))
 468
 469 (defun sgml-slash (arg)
 470   "Insert ARG slash characters.
 471 Behaves electrically if `sgml-quick-keys' is non-nil."
 472   (interactive "p")
 473   (cond
 474    ((not (and (eq (char-before) ?<) (= arg 1)))
 475     (sgml-slash-matching arg))
 476    ((eq sgml-quick-keys 'indent)
 477     (insert-char ?/ 1)
 478     (indent-according-to-mode))
 479    ((eq sgml-quick-keys 'close)
 480     (delete-backward-char 1)
 481     (sgml-close-tag))
 482    (t
 483     (sgml-slash-matching arg))))
 484
 485 (defun sgml-slash-matching (arg)
 486   "Insert `/' and display any previous matching `/'.
 487 Two `/'s are treated as matching if the first `/' ends a net-enabling
 488 start tag, and the second `/' is the corresponding null end tag."
 489   (interactive "p")
 490   (insert-char ?/ arg)
 491   (if (> arg 0)
 492       (let ((oldpos (point))
 493             (blinkpos)
 494             (level 0))
 495         (save-excursion
 496           (save-restriction
 497             (if sgml-slash-distance
 498                 (narrow-to-region (max (point-min)
 499                                        (- (point) sgml-slash-distance))
 500                                   oldpos))
 501             (if (and (re-search-backward sgml-start-tag-regex (point-min) t)
 502                      (eq (match-end 0) (1- oldpos)))
 503                 ()
 504               (goto-char (1- oldpos))
 505               (while (and (not blinkpos)
 506                           (search-backward "/" (point-min) t))
 507                 (let ((tagend (save-excursion
 508                                 (if (re-search-backward sgml-start-tag-regex
 509                                                         (point-min) t)
 510                                     (match-end 0)
 511                                   nil))))
 512                   (if (eq tagend (point))
 513                       (if (eq level 0)
 514                           (setq blinkpos (point))
 515                         (setq level (1- level)))
 516                     (setq level (1+ level)))))))
 517           (when blinkpos
 518             (goto-char blinkpos)
 519             (if (pos-visible-in-window-p)
 520                 (sit-for 1)
 521               (message "Matches %s"
 522                        (buffer-substring (line-beginning-position)
 523                                          (1+ blinkpos)))))))))
 524
 525 ;; Why doesn't this use the iso-cvt table or, preferably, generate the
 526 ;; inverse of the extensive table in the SGML Quail input method?  -- fx
 527 ;; I guess that's moot since it only works with Latin-1 anyhow.
 528 (defun sgml-name-char (&optional char)
 529   "Insert a symbolic character name according to `sgml-char-names'.
 530 Non-ASCII chars may be inserted either with the meta key, as in M-SPC for
 531 no-break space or M-- for a soft hyphen; or via an input method or
 532 encoded keyboard operation."
 533   (interactive "*")
 534   (insert ?&)
 535   (or char
 536       (setq char (read-quoted-char "Enter char or octal number")))
 537   (delete-backward-char 1)
 538   (insert char)
 539   (undo-boundary)
 540   (sgml-namify-char))
 541
 542 (defun sgml-namify-char ()
 543   "Change the char before point into its `&name;' equivalent.
 544 Uses `sgml-char-names'."
 545   (interactive)
 546   (let* ((char (char-before))
 547          (name
 548           (cond
 549            ((null char) (error "No char before point"))
 550            ((< char 256) (or (aref sgml-char-names char) char))
 551            ((aref sgml-char-names-table char))
 552            ((encode-char char 'ucs)))))
 553     (if (not name)
 554         (error "Don't know the name of `%c'" char)
 555       (delete-backward-char 1)
 556       (insert (format (if (numberp name) "&#%d;" "&%s;") name)))))
 557
 558 (defun sgml-name-self ()
 559   "Insert a symbolic character name according to `sgml-char-names'."
 560   (interactive "*")
 561   (sgml-name-char last-command-char))
 562
 563 (defun sgml-maybe-name-self ()
 564   "Insert a symbolic character name according to `sgml-char-names'."
 565   (interactive "*")
 566   (if sgml-name-8bit-mode
 567       (let ((mc last-command-char))
 568         (if (< mc 256)
 569             (setq mc (unibyte-char-to-multibyte mc)))
 570         (or mc (setq mc last-command-char))
 571         (sgml-name-char mc))
 572     (self-insert-command 1)))
 573
 574 (defun sgml-name-8bit-mode ()
 575   "Toggle whether to insert named entities instead of non-ASCII characters.
 576 This only works for Latin-1 input."
 577   (interactive)
 578   (setq sgml-name-8bit-mode (not sgml-name-8bit-mode))
 579   (message "sgml name entity mode is now %s"
 580            (if sgml-name-8bit-mode "ON" "OFF")))
 581
 582 ;; When an element of a skeleton is a string "str", it is passed
 583 ;; through skeleton-transformation and inserted.  If "str" is to be
 584 ;; inserted literally, one should obtain it as the return value of a
 585 ;; function, e.g. (identity "str").
 586
 587 (defvar sgml-tag-last nil)
 588 (defvar sgml-tag-history nil)
 589 (define-skeleton sgml-tag
 590   "Prompt for a tag and insert it, optionally with attributes.
 591 Completion and configuration are done according to `sgml-tag-alist'.
 592 If you like tags and attributes in uppercase do \\[set-variable]
 593 skeleton-transformation RET upcase RET, or put this in your `.emacs':
 594   (setq sgml-transformation 'upcase)"
 595   (funcall (or skeleton-transformation 'identity)
 596            (setq sgml-tag-last
 597                  (completing-read
 598                   (if (> (length sgml-tag-last) 0)
 599                       (format "Tag (default %s): " sgml-tag-last)
 600                     "Tag: ")
 601                   sgml-tag-alist nil nil nil 'sgml-tag-history sgml-tag-last)))
 602   ?< str |
 603   (("") -1 '(undo-boundary) (identity "&lt;")) |        ; see comment above
 604   `(("") '(setq v2 (sgml-attributes ,str t)) ?>
 605     (cond
 606      ((string= "![" ,str)
 607       (backward-char)
 608       '(("") " [ " _ " ]]"))
 609      ((and (eq v2 t) sgml-xml-mode (member ,str sgml-empty-tags))
 610       '(("") -1 "/>"))
 611      ((or (and (eq v2 t) (not sgml-xml-mode)) (string-match "^[/!?]" ,str))
 612       nil)
 613      ((symbolp v2)
 614       ;; Make sure we don't fall into an infinite loop.
 615       ;; For xhtml's `tr' tag, we should maybe use \n instead.
 616       (if (eq v2 t) (setq v2 nil))
 617       ;; We use `identity' to prevent skeleton from passing
 618       ;; `str' through skeleton-transformation a second time.
 619       '(("") v2 _ v2 "</" (identity ',str) ?>))
 620      ((eq (car v2) t)
 621       (cons '("") (cdr v2)))
 622      (t
 623       (append '(("") (car v2))
 624               (cdr v2)
 625               '(resume: (car v2) _ "</" (identity ',str) ?>))))))
 626
 627 (autoload 'skeleton-read "skeleton")
 628
 629 (defun sgml-attributes (tag &optional quiet)
 630   "When at top level of a tag, interactively insert attributes.
 631
 632 Completion and configuration of TAG are done according to `sgml-tag-alist'.
 633 If QUIET, do not print a message when there are no attributes for TAG."
 634   (interactive (list (save-excursion (sgml-beginning-of-tag t))))
 635   (or (stringp tag) (error "Wrong context for adding attribute"))
 636   (if tag
 637       (let ((completion-ignore-case t)
 638             (alist (cdr (assoc (downcase tag) sgml-tag-alist)))
 639             car attribute i)
 640         (if (or (symbolp (car alist))
 641                 (symbolp (car (car alist))))
 642             (setq car (car alist)
 643                   alist (cdr alist)))
 644         (or quiet
 645             (message "No attributes configured."))
 646         (if (stringp (car alist))
 647             (progn
 648               (insert (if (eq (preceding-char) ? ) "" ? )
 649                       (funcall skeleton-transformation (car alist)))
 650               (sgml-value alist))
 651           (setq i (length alist))
 652           (while (> i 0)
 653             (insert ? )
 654             (insert (funcall skeleton-transformation
 655                              (setq attribute
 656                                    (skeleton-read '(completing-read
 657                                                     "Attribute: "
 658                                                     alist)))))
 659             (if (string= "" attribute)
 660                 (setq i 0)
 661               (sgml-value (assoc (downcase attribute) alist))
 662               (setq i (1- i))))
 663           (if (eq (preceding-char) ? )
 664               (delete-backward-char 1)))
 665         car)))
 666
 667 (defun sgml-auto-attributes (arg)
 668   "Self insert the character typed; at top level of tag, prompt for attributes.
 669 With prefix argument, only self insert."
 670   (interactive "*P")
 671   (let ((point (point))
 672         tag)
 673     (if (or arg
 674             (not sgml-tag-alist)        ; no message when nothing configured
 675             (symbolp (setq tag (save-excursion (sgml-beginning-of-tag t))))
 676             (eq (aref tag 0) ?/))
 677         (self-insert-command (prefix-numeric-value arg))
 678       (sgml-attributes tag)
 679       (setq last-command-char ? )
 680       (or (> (point) point)
 681           (self-insert-command 1)))))
 682
 683 (defun sgml-tag-help (&optional tag)
 684   "Display description of tag TAG.  If TAG is omitted, use the tag at point."
 685   (interactive)
 686   (or tag
 687       (save-excursion
 688         (if (eq (following-char) ?<)
 689             (forward-char))
 690         (setq tag (sgml-beginning-of-tag))))
 691   (or (stringp tag)
 692       (error "No tag selected"))
 693   (setq tag (downcase tag))
 694   (message "%s"
 695            (or (cdr (assoc (downcase tag) sgml-tag-help))
 696                (and (eq (aref tag 0) ?/)
 697                     (cdr (assoc (downcase (substring tag 1)) sgml-tag-help)))
 698                "No description available")))
 699
 700 (defun sgml-maybe-end-tag (&optional arg)
 701   "Name self unless in position to end a tag or a prefix ARG is given."
 702   (interactive "P")
 703   (if (or arg (eq (car (sgml-lexical-context)) 'tag))
 704       (self-insert-command (prefix-numeric-value arg))
 705     (sgml-name-self)))
 706
 707 (defun sgml-skip-tag-backward (arg)
 708   "Skip to beginning of tag or matching opening tag if present.
 709 With prefix argument ARG, repeat this ARG times."
 710   (interactive "p")
 711   ;; FIXME: use sgml-get-context or something similar.
 712   (while (>= arg 1)
 713     (search-backward "<" nil t)
 714     (if (looking-at "</\\([^ \n\t>]+\\)")
 715         ;; end tag, skip any nested pairs
 716         (let ((case-fold-search t)
 717               (re (concat "</?" (regexp-quote (match-string 1))
 718                           ;; Ignore empty tags like <foo/>.
 719                           "\\([^>]*[^/>]\\)?>")))
 720           (while (and (re-search-backward re nil t)
 721                       (eq (char-after (1+ (point))) ?/))
 722             (forward-char 1)
 723             (sgml-skip-tag-backward 1))))
 724     (setq arg (1- arg))))
 725
 726 (defun sgml-skip-tag-forward (arg)
 727   "Skip to end of tag or matching closing tag if present.
 728 With prefix argument ARG, repeat this ARG times.
 729 Return t iff after a closing tag."
 730   (interactive "p")
 731   ;; FIXME: Use sgml-get-context or something similar.
 732   ;; It currently might jump to an unrelated </P> if the <P>
 733   ;; we're skipping has no matching </P>.
 734   (let ((return t))
 735     (with-syntax-table sgml-tag-syntax-table
 736       (while (>= arg 1)
 737         (skip-chars-forward "^<>")
 738         (if (eq (following-char) ?>)
 739             (up-list -1))
 740         (if (looking-at "<\\([^/ \n\t>]+\\)\\([^>]*[^/>]\\)?>")
 741             ;; start tag, skip any nested same pairs _and_ closing tag
 742             (let ((case-fold-search t)
 743                   (re (concat "</?" (regexp-quote (match-string 1))
 744                               ;; Ignore empty tags like <foo/>.
 745                               "\\([^>]*[^/>]\\)?>"))
 746                   point close)
 747               (forward-list 1)
 748               (setq point (point))
 749               ;; FIXME: This re-search-forward will mistakenly match
 750               ;; tag-like text inside attributes.
 751               (while (and (re-search-forward re nil t)
 752                           (not (setq close
 753                                      (eq (char-after (1+ (match-beginning 0))) ?/)))
 754                           (goto-char (match-beginning 0))
 755                           (sgml-skip-tag-forward 1))
 756                 (setq close nil))
 757               (unless close
 758                 (goto-char point)
 759                 (setq return nil)))
 760           (forward-list 1))
 761         (setq arg (1- arg)))
 762       return)))
 763
 764 (defun sgml-delete-tag (arg)
 765   ;; FIXME: Should be called sgml-kill-tag or should not touch the kill-ring.
 766   "Delete tag on or after cursor, and matching closing or opening tag.
 767 With prefix argument ARG, repeat this ARG times."
 768   (interactive "p")
 769   (while (>= arg 1)
 770     (save-excursion
 771       (let* (close open)
 772         (if (looking-at "[ \t\n]*<")
 773             ;; just before tag
 774             (if (eq (char-after (match-end 0)) ?/)
 775                 ;; closing tag
 776                 (progn
 777                   (setq close (point))
 778                   (goto-char (match-end 0))))
 779           ;; on tag?
 780           (or (save-excursion (setq close (sgml-beginning-of-tag)
 781                                     close (and (stringp close)
 782                                                (eq (aref close 0) ?/)
 783                                                (point))))
 784               ;; not on closing tag
 785               (let ((point (point)))
 786                 (sgml-skip-tag-backward 1)
 787                 (if (or (not (eq (following-char) ?<))
 788                         (save-excursion
 789                           (forward-list 1)
 790                           (<= (point) point)))
 791                     (error "Not on or before tag")))))
 792         (if close
 793             (progn
 794               (sgml-skip-tag-backward 1)
 795               (setq open (point))
 796               (goto-char close)
 797               (kill-sexp 1))
 798           (setq open (point))
 799           (when (sgml-skip-tag-forward 1)
 800             (kill-sexp -1)))
 801         ;; Delete any resulting empty line.  If we didn't kill-sexp,
 802         ;; this *should* do nothing, because we're right after the tag.
 803         (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?"))
 804             (delete-region (match-beginning 0) (match-end 0)))
 805         (goto-char open)
 806         (kill-sexp 1)
 807         (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?"))
 808             (delete-region (match-beginning 0) (match-end 0)))))
 809     (setq arg (1- arg))))
 810
 811 \f
 812 ;; Put read-only last to enable setting this even when read-only enabled.
 813 (or (get 'sgml-tag 'invisible)
 814     (setplist 'sgml-tag
 815               (append '(invisible t
 816                         point-entered sgml-point-entered
 817                         rear-nonsticky t
 818                         read-only t)
 819                       (symbol-plist 'sgml-tag))))
 820
 821 (defun sgml-tags-invisible (arg)
 822   "Toggle visibility of existing tags."
 823   (interactive "P")
 824   (let ((modified (buffer-modified-p))
 825         (inhibit-read-only t)
 826         (inhibit-modification-hooks t)
 827         ;; Avoid spurious the `file-locked' checks.
 828         (buffer-file-name nil)
 829         ;; This is needed in case font lock gets called,
 830         ;; since it moves point and might call sgml-point-entered.
 831         ;; How could it get called?  -stef
 832         (inhibit-point-motion-hooks t)
 833         string)
 834     (unwind-protect
 835         (save-excursion
 836           (goto-char (point-min))
 837           (if (set (make-local-variable 'sgml-tags-invisible)
 838                    (if arg
 839                        (>= (prefix-numeric-value arg) 0)
 840                      (not sgml-tags-invisible)))
 841               (while (re-search-forward sgml-tag-name-re nil t)
 842                 (setq string
 843                       (cdr (assq (intern-soft (downcase (match-string 1)))
 844                                  sgml-display-text)))
 845                 (goto-char (match-beginning 0))
 846                 (and (stringp string)
 847                      (not (overlays-at (point)))
 848                      (let ((ol (make-overlay (point) (match-beginning 1))))
 849                        (overlay-put ol 'before-string string)
 850                        (overlay-put ol 'sgml-tag t)))
 851                 (put-text-property (point)
 852                                    (progn (forward-list) (point))
 853                                    'category 'sgml-tag))
 854             (let ((pos (point-min)))
 855               (while (< (setq pos (next-overlay-change pos)) (point-max))
 856                 (dolist (ol (overlays-at pos))
 857                   (if (overlay-get ol 'sgml-tag)
 858                       (delete-overlay ol)))))
 859             (remove-text-properties (point-min) (point-max) '(category nil))))
 860       (restore-buffer-modified-p modified))
 861     (run-hooks 'sgml-tags-invisible-hook)
 862     (message "")))
 863
 864 (defun sgml-point-entered (x y)
 865   ;; Show preceding or following hidden tag, depending of cursor direction.
 866   (let ((inhibit-point-motion-hooks t))
 867     (save-excursion
 868       (message "Invisible tag: %s"
 869                ;; Strip properties, otherwise, the text is invisible.
 870                (buffer-substring-no-properties
 871                 (point)
 872                 (if (or (and (> x y)
 873                              (not (eq (following-char) ?<)))
 874                         (and (< x y)
 875                              (eq (preceding-char) ?>)))
 876                     (backward-list)
 877                   (forward-list)))))))
 878
 879 \f
 880 (autoload 'compile-internal "compile")
 881
 882 (defun sgml-validate (command)
 883   "Validate an SGML document.
 884 Runs COMMAND, a shell command, in a separate process asynchronously
 885 with output going to the buffer `*compilation*'.
 886 You can then use the command \\[next-error] to find the next error message
 887 and move to the line in the SGML document that caused it."
 888   (interactive
 889    (list (read-string "Validate command: "
 890                       (or sgml-saved-validate-command
 891                           (concat sgml-validate-command
 892                                   " "
 893                                   (let ((name (buffer-file-name)))
 894                                     (and name
 895                                          (file-name-nondirectory name))))))))
 896   (setq sgml-saved-validate-command command)
 897   (save-some-buffers (not compilation-ask-about-save) nil)
 898   (compile-internal command "No more errors"))
 899
 900 (defsubst sgml-at-indentation-p ()
 901   "Return true if point is at the first non-whitespace character on the line."
 902   (save-excursion
 903     (skip-chars-backward " \t")
 904     (bolp)))
 905
 906 (defun sgml-lexical-context (&optional limit)
 907   "Return the lexical context at point as (TYPE . START).
 908 START is the location of the start of the lexical element.
 909 TYPE is one of `string', `comment', `tag', `cdata', or `text'.
 910
 911 Optional argument LIMIT is the position to start parsing from.
 912 If nil, start from a preceding tag at indentation."
 913   (save-excursion
 914     (let ((pos (point))
 915           text-start state)
 916       (if limit
 917           (goto-char limit)
 918         ;; Skip tags backwards until we find one at indentation
 919         (while (and (ignore-errors (sgml-parse-tag-backward))
 920                     (not (sgml-at-indentation-p)))))
 921       (with-syntax-table sgml-tag-syntax-table
 922         (while (< (point) pos)
 923           ;; When entering this loop we're inside text.
 924           (setq text-start (point))
 925           (skip-chars-forward "^<" pos)
 926           (setq state
 927                 (cond
 928                  ((= (point) pos)
 929                   ;; We got to the end without seeing a tag.
 930                   nil)
 931                  ((looking-at "<!\\[[A-Z]+\\[")
 932                   ;; We've found a CDATA section or similar.
 933                   (let ((cdata-start (point)))
 934                     (unless (search-forward "]]>" pos 'move)
 935                       (list 0 nil nil 'cdata nil nil nil nil cdata-start))))
 936                  (t
 937                   ;; We've reached a tag.  Parse it.
 938                   ;; FIXME: Handle net-enabling start-tags
 939                   (parse-partial-sexp (point) pos 0))))))
 940       (cond
 941        ((eq (nth 3 state) 'cdata) (cons 'cdata (nth 8 state)))
 942        ((nth 3 state) (cons 'string (nth 8 state)))
 943        ((nth 4 state) (cons 'comment (nth 8 state)))
 944        ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))
 945        (t (cons 'text text-start))))))
 946
 947 (defun sgml-beginning-of-tag (&optional top-level)
 948   "Skip to beginning of tag and return its name.
 949 If this can't be done, return nil."
 950   (let ((context (sgml-lexical-context)))
 951     (if (eq (car context) 'tag)
 952         (progn
 953           (goto-char (cdr context))
 954           (when (looking-at sgml-tag-name-re)
 955             (match-string-no-properties 1)))
 956       (if top-level nil
 957         (when (not (eq (car context) 'text))
 958           (goto-char (cdr context))
 959           (sgml-beginning-of-tag t))))))
 960
 961 (defun sgml-value (alist)
 962   "Interactively insert value taken from attribute-rule ALIST.
 963 See `sgml-tag-alist' for info about attribute rules."
 964   (setq alist (cdr alist))
 965   (if (stringp (car alist))
 966       (insert "=\"" (car alist) ?\")
 967     (if (and (eq (car alist) t) (not sgml-xml-mode))
 968         (when (cdr alist)
 969           (insert "=\"")
 970           (setq alist (skeleton-read '(completing-read "Value: " (cdr alist))))
 971           (if (string< "" alist)
 972               (insert alist ?\")
 973             (delete-backward-char 2)))
 974       (insert "=\"")
 975       (when alist
 976         (insert (skeleton-read '(completing-read "Value: " alist))))
 977       (insert ?\"))))
 978
 979 (defun sgml-quote (start end &optional unquotep)
 980   "Quote SGML text in region START ... END.
 981 Only &, < and > are quoted, the rest is left untouched.
 982 With prefix argument UNQUOTEP, unquote the region."
 983   (interactive "r\nP")
 984   (save-restriction
 985     (narrow-to-region start end)
 986     (goto-char (point-min))
 987     (if unquotep
 988         ;; FIXME: We should unquote other named character references as well.
 989         (while (re-search-forward
 990                 "\\(&\\(amp\\|\\(l\\|\\(g\\)\\)t\\)\\)[][<>&;\n\t \"%!'(),/=?]"
 991                 nil t)
 992           (replace-match (if (match-end 4) ">" (if (match-end 3) "<" "&")) t t
 993                          nil (if (eq (char-before (match-end 0)) ?\;) 0 1)))
 994       (while (re-search-forward "[&<>]" nil t)
 995         (replace-match (cdr (assq (char-before) '((?& . "&amp;")
 996                                                   (?< . "&lt;")
 997                                                   (?> . "&gt;"))))
 998                        t t)))))
 999
1000 (defun sgml-pretty-print (beg end)
1001   "Simple-minded pretty printer for SGML.
1002 Re-indents the code and inserts newlines between BEG and END.
1003 You might want to turn on `auto-fill-mode' to get better results."
1004   ;; TODO:
1005   ;; - insert newline between some start-tag and text.
1006   ;; - don't insert newline in front of some end-tags.
1007   (interactive "r")
1008   (save-excursion
1009     (if (< beg end)
1010         (goto-char beg)
1011       (goto-char end)
1012       (setq end beg)
1013       (setq beg (point)))
1014     ;; Don't use narrowing because it screws up auto-indent.
1015     (setq end (copy-marker end t))
1016     (with-syntax-table sgml-tag-syntax-table
1017       (while (re-search-forward "<" end t)
1018         (goto-char (match-beginning 0))
1019         (unless (or ;;(looking-at "</")
1020                     (progn (skip-chars-backward " \t") (bolp)))
1021           (reindent-then-newline-and-indent))
1022         (forward-sexp 1)))
1023     ;; (indent-region beg end)
1024     ))
1025
1026 \f
1027 ;; Parsing
1028
1029 (defstruct (sgml-tag
1030             (:constructor sgml-make-tag (type start end name)))
1031   type start end name)
1032
1033 (defsubst sgml-parse-tag-name ()
1034   "Skip past a tag-name, and return the name."
1035   (buffer-substring-no-properties
1036    (point) (progn (skip-syntax-forward "w_") (point))))
1037
1038 (defsubst sgml-looking-back-at (str)
1039   "Return t if the test before point matches STR."
1040   (let ((start (- (point) (length str))))
1041     (and (>= start (point-min))
1042          (equal str (buffer-substring-no-properties start (point))))))
1043
1044 (defun sgml-parse-tag-backward (&optional limit)
1045   "Parse an SGML tag backward, and return information about the tag.
1046 Assume that parsing starts from within a textual context.
1047 Leave point at the beginning of the tag."
1048   (let (tag-type tag-start tag-end name)
1049     (or (re-search-backward "[<>]" limit 'move)
1050         (error "No tag found"))
1051     (when (eq (char-after) ?<)
1052       ;; Oops!! Looks like we were not in a textual context after all!.
1053       ;; Let's try to recover.
1054       (with-syntax-table sgml-tag-syntax-table
1055         (forward-sexp)
1056         (forward-char -1)))
1057     (setq tag-end (1+ (point)))
1058     (cond
1059      ((sgml-looking-back-at "--")   ; comment
1060       (setq tag-type 'comment
1061             tag-start (search-backward "<!--" nil t)))
1062      ((sgml-looking-back-at "]]")   ; cdata
1063       (setq tag-type 'cdata
1064             tag-start (re-search-backward "<!\\[[A-Z]+\\[" nil t)))
1065      (t
1066       (setq tag-start
1067             (with-syntax-table sgml-tag-syntax-table
1068               (goto-char tag-end)
1069               (backward-sexp)
1070               (point)))
1071       (goto-char (1+ tag-start))
1072       (case (char-after)
1073         (?!                             ; declaration
1074          (setq tag-type 'decl))
1075         (??                             ; processing-instruction
1076          (setq tag-type 'pi))
1077         (?/                             ; close-tag
1078          (forward-char 1)
1079          (setq tag-type 'close
1080                name (sgml-parse-tag-name)))
1081         (?%                             ; JSP tags
1082          (setq tag-type 'jsp))
1083         (t                              ; open or empty tag
1084          (setq tag-type 'open
1085                name (sgml-parse-tag-name))
1086          (if (or (eq ?/ (char-before (- tag-end 1)))
1087                  (sgml-empty-tag-p name))
1088              (setq tag-type 'empty))))))
1089     (goto-char tag-start)
1090     (sgml-make-tag tag-type tag-start tag-end name)))
1091
1092 (defun sgml-get-context (&optional until)
1093   "Determine the context of the current position.
1094 By default, parse until we find a start-tag as the first thing on a line.
1095 If UNTIL is `empty', return even if the context is empty (i.e.
1096 we just skipped over some element and got to a beginning of line).
1097
1098 The context is a list of tag-info structures.  The last one is the tag
1099 immediately enclosing the current position.
1100
1101 Point is assumed to be outside of any tag.  If we discover that it's
1102 not the case, the first tag returned is the one inside which we are."
1103   (let ((here (point))
1104         (ignore nil)
1105         (context nil)
1106         tag-info)
1107     ;; CONTEXT keeps track of the tag-stack
1108     ;; IGNORE keeps track of the nesting level of point relative to the
1109     ;;   first (outermost) tag on the context.  This is the list of
1110     ;;   enclosing start-tags we'll have to ignore.
1111     (skip-chars-backward " \t\n")      ; Make sure we're not at indentation.
1112     (while
1113         (and (not (eq until 'now))
1114              (or ignore
1115                  (not (if until (eq until 'empty) context))
1116                  (not (sgml-at-indentation-p))
1117                  (and context
1118                       (/= (point) (sgml-tag-start (car context)))
1119                       (sgml-unclosed-tag-p (sgml-tag-name (car context)))))
1120              (setq tag-info (ignore-errors (sgml-parse-tag-backward))))
1121
1122       ;; This tag may enclose things we thought were tags.  If so,
1123       ;; discard them.
1124       (while (and context
1125                   (> (sgml-tag-end tag-info)
1126                      (sgml-tag-end (car context))))
1127         (setq context (cdr context)))
1128
1129       (cond
1130        ((> (sgml-tag-end tag-info) here)
1131         ;; Oops!!  Looks like we were not outside of any tag, after all.
1132         (push tag-info context)
1133         (setq until 'now))
1134
1135        ;; start-tag
1136        ((eq (sgml-tag-type tag-info) 'open)
1137         (cond
1138          ((null ignore)
1139           (if (and context
1140                    (sgml-unclosed-tag-p (sgml-tag-name tag-info))
1141                    (eq t (compare-strings
1142                           (sgml-tag-name tag-info) nil nil
1143                           (sgml-tag-name (car context)) nil nil t)))
1144               ;; There was an implicit end-tag.
1145               nil
1146             (push tag-info context)))
1147          ((eq t (compare-strings (sgml-tag-name tag-info) nil nil
1148                                  (car ignore) nil nil t))
1149           (setq ignore (cdr ignore)))
1150          (t
1151           ;; The open and close tags don't match.
1152           (if (not sgml-xml-mode)
1153               (unless (sgml-unclosed-tag-p (sgml-tag-name tag-info))
1154                 (message "Unclosed tag <%s>" (sgml-tag-name tag-info))
1155                 (let ((tmp ignore))
1156                   ;; We could just assume that the tag is simply not closed
1157                   ;; but it's a bad assumption when tags *are* closed but
1158                   ;; not properly nested.
1159                   (while (and (cdr tmp)
1160                               (not (eq t (compare-strings
1161                                           (sgml-tag-name tag-info) nil nil
1162                                           (cadr tmp) nil nil t))))
1163                     (setq tmp (cdr tmp)))
1164                   (if (cdr tmp) (setcdr tmp (cddr tmp)))))
1165             (message "Unmatched tags <%s> and </%s>"
1166                      (sgml-tag-name tag-info) (pop ignore))))))
1167
1168        ;; end-tag
1169        ((eq (sgml-tag-type tag-info) 'close)
1170         (if (sgml-empty-tag-p (sgml-tag-name tag-info))
1171             (message "Spurious </%s>: empty tag" (sgml-tag-name tag-info))
1172           (push (sgml-tag-name tag-info) ignore)))
1173        ))
1174
1175     ;; return context
1176     context))
1177
1178 (defun sgml-show-context (&optional full)
1179   "Display the current context.
1180 If FULL is non-nil, parse back to the beginning of the buffer."
1181   (interactive "P")
1182   (with-output-to-temp-buffer "*XML Context*"
1183     (save-excursion
1184       (let ((context (sgml-get-context)))
1185         (when full
1186           (let ((more nil))
1187             (while (setq more (sgml-get-context))
1188               (setq context (nconc more context)))))
1189         (pp context)))))
1190
1191 \f
1192 ;; Editing shortcuts
1193
1194 (defun sgml-close-tag ()
1195   "Close current element.
1196 Depending on context, inserts a matching close-tag, or closes
1197 the current start-tag or the current comment or the current cdata, ..."
1198   (interactive)
1199   (case (car (sgml-lexical-context))
1200     (comment    (insert " -->"))
1201     (cdata      (insert "]]>"))
1202     (pi         (insert " ?>"))
1203     (jsp        (insert " %>"))
1204     (tag        (insert " />"))
1205     (text
1206      (let ((context (save-excursion (sgml-get-context))))
1207        (if context
1208            (progn
1209              (insert "</" (sgml-tag-name (car (last context))) ">")
1210              (indent-according-to-mode)))))
1211     (otherwise
1212      (error "Nothing to close"))))
1213
1214 (defun sgml-empty-tag-p (tag-name)
1215   "Return non-nil if TAG-NAME is an implicitly empty tag."
1216   (and (not sgml-xml-mode)
1217        (member-ignore-case tag-name sgml-empty-tags)))
1218
1219 (defun sgml-unclosed-tag-p (tag-name)
1220   "Return non-nil if TAG-NAME is a tag for which an end-tag is optional."
1221   (and (not sgml-xml-mode)
1222        (member-ignore-case tag-name sgml-unclosed-tags)))
1223
1224 (defun sgml-calculate-indent (&optional lcon)
1225   "Calculate the column to which this line should be indented.
1226 LCON is the lexical context, if any."
1227   (unless lcon (setq lcon (sgml-lexical-context)))
1228
1229   ;; Indent comment-start markers inside <!-- just like comment-end markers.
1230   (if (and (eq (car lcon) 'tag)
1231            (looking-at "--")
1232            (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
1233       (setq lcon (cons 'comment (+ (cdr lcon) 2))))
1234
1235   (case (car lcon)
1236
1237     (string
1238      ;; Go back to previous non-empty line.
1239      (while (and (> (point) (cdr lcon))
1240                  (zerop (forward-line -1))
1241                  (looking-at "[ \t]*$")))
1242      (if (> (point) (cdr lcon))
1243          ;; Previous line is inside the string.
1244          (current-indentation)
1245        (goto-char (cdr lcon))
1246        (1+ (current-column))))
1247
1248     (comment
1249      (let ((mark (looking-at "--")))
1250        ;; Go back to previous non-empty line.
1251        (while (and (> (point) (cdr lcon))
1252                    (zerop (forward-line -1))
1253                    (or (looking-at "[ \t]*$")
1254                        (if mark (not (looking-at "[ \t]*--"))))))
1255        (if (> (point) (cdr lcon))
1256            ;; Previous line is inside the comment.
1257            (skip-chars-forward " \t")
1258          (goto-char (cdr lcon))
1259          ;; Skip `<!' to get to the `--' with which we want to align.
1260          (search-forward "--")
1261          (goto-char (match-beginning 0)))
1262        (when (and (not mark) (looking-at "--"))
1263          (forward-char 2) (skip-chars-forward " \t"))
1264        (current-column)))
1265
1266     ;; We don't know how to indent it.  Let's be honest about it.
1267     (cdata nil)
1268
1269     (tag
1270      (goto-char (1+ (cdr lcon)))
1271      (skip-chars-forward "^ \t\n")      ;Skip tag name.
1272      (skip-chars-forward " \t")
1273      (if (not (eolp))
1274          (current-column)
1275        ;; This is the first attribute: indent.
1276        (goto-char (1+ (cdr lcon)))
1277        (+ (current-column) sgml-basic-offset)))
1278
1279     (text
1280      (while (looking-at "</")
1281        (forward-sexp 1)
1282        (skip-chars-forward " \t"))
1283      (let* ((here (point))
1284             (unclosed (and ;; (not sgml-xml-mode)
1285                        (looking-at sgml-tag-name-re)
1286                        (member-ignore-case (match-string 1)
1287                                            sgml-unclosed-tags)
1288                        (match-string 1)))
1289             (context
1290              ;; If possible, align on the previous non-empty text line.
1291              ;; Otherwise, do a more serious parsing to find the
1292              ;; tag(s) relative to which we should be indenting.
1293              (if (and (not unclosed) (skip-chars-backward " \t")
1294                       (< (skip-chars-backward " \t\n") 0)
1295                       (back-to-indentation)
1296                       (> (point) (cdr lcon)))
1297                  nil
1298                (goto-char here)
1299                (nreverse (sgml-get-context (if unclosed nil 'empty)))))
1300             (there (point)))
1301        ;; Ignore previous unclosed start-tag in context.
1302        (while (and context unclosed
1303                    (eq t (compare-strings
1304                           (sgml-tag-name (car context)) nil nil
1305                           unclosed nil nil t)))
1306          (setq context (cdr context)))
1307        ;; Indent to reflect nesting.
1308        (cond
1309         ;; If we were not in a text context after all, let's try again.
1310         ((and context (> (sgml-tag-end (car context)) here))
1311          (goto-char here)
1312          (sgml-calculate-indent
1313           (cons (if (memq (sgml-tag-type (car context)) '(comment cdata))
1314                     (sgml-tag-type (car context)) 'tag)
1315                 (sgml-tag-start (car context)))))
1316         ;; Align on the first element after the nearest open-tag, if any.
1317         ((and context
1318               (goto-char (sgml-tag-end (car context)))
1319               (skip-chars-forward " \t\n")
1320               (< (point) here) (sgml-at-indentation-p))
1321          (current-column))
1322         (t
1323          (goto-char there)
1324          (+ (current-column)
1325             (* sgml-basic-offset (length context)))))))
1326
1327     (otherwise
1328      (error "Unrecognised context %s" (car lcon)))
1329
1330     ))
1331
1332 (defun sgml-indent-line ()
1333   "Indent the current line as SGML."
1334   (interactive)
1335   (let* ((savep (point))
1336          (indent-col
1337           (save-excursion
1338             (back-to-indentation)
1339             (if (>= (point) savep) (setq savep nil))
1340             (sgml-calculate-indent))))
1341     (if (null indent-col)
1342         'noindent
1343       (if savep
1344           (save-excursion (indent-line-to indent-col))
1345         (indent-line-to indent-col)))))
1346
1347 (defun sgml-guess-indent ()
1348   "Guess an appropriate value for `sgml-basic-offset'.
1349 Base the guessed identation level on the first indented tag in the buffer.
1350 Add this to `sgml-mode-hook' for convenience."
1351   (interactive)
1352   (save-excursion
1353     (goto-char (point-min))
1354     (if (re-search-forward "^\\([ \t]+\\)<" 500 'noerror)
1355         (progn
1356           (set (make-local-variable 'sgml-basic-offset)
1357                (1- (current-column)))
1358           (message "Guessed sgml-basic-offset = %d"
1359                    sgml-basic-offset)
1360           ))))
1361
1362 (defun sgml-parse-dtd ()
1363   "Simplistic parse of the current buffer as a DTD.
1364 Currently just returns (EMPTY-TAGS UNCLOSED-TAGS)."
1365   (goto-char (point-min))
1366   (let ((empty nil)
1367         (unclosed nil))
1368     (while (re-search-forward "<!ELEMENT[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+[-O][ \t\n]+\\([-O]\\)[ \t\n]+\\([^ \t\n]+\\)" nil t)
1369       (cond
1370        ((string= (match-string 3) "EMPTY")
1371         (push (match-string-no-properties 1) empty))
1372        ((string= (match-string 2) "O")
1373         (push (match-string-no-properties 1) unclosed))))
1374     (setq empty (sort (mapcar 'downcase empty) 'string<))
1375     (setq unclosed (sort (mapcar 'downcase unclosed) 'string<))
1376     (list empty unclosed)))
1377
1378 ;;; HTML mode
1379
1380 (defcustom html-mode-hook nil
1381   "Hook run by command `html-mode'.
1382 `text-mode-hook' and `sgml-mode-hook' are run first."
1383   :group 'sgml
1384   :type 'hook
1385   :options '(html-autoview-mode))
1386
1387 (defvar html-quick-keys sgml-quick-keys
1388   "Use C-c X combinations for quick insertion of frequent tags when non-nil.
1389 This defaults to `sgml-quick-keys'.
1390 This takes effect when first loading the library.")
1391
1392 (defvar html-mode-map
1393   (let ((map (make-sparse-keymap))
1394         (menu-map (make-sparse-keymap "HTML")))
1395     (set-keymap-parent map  sgml-mode-map)
1396     (define-key map "\C-c6" 'html-headline-6)
1397     (define-key map "\C-c5" 'html-headline-5)
1398     (define-key map "\C-c4" 'html-headline-4)
1399     (define-key map "\C-c3" 'html-headline-3)
1400     (define-key map "\C-c2" 'html-headline-2)
1401     (define-key map "\C-c1" 'html-headline-1)
1402     (define-key map "\C-c\r" 'html-paragraph)
1403     (define-key map "\C-c\n" 'html-line)
1404     (define-key map "\C-c\C-c-" 'html-horizontal-rule)
1405     (define-key map "\C-c\C-co" 'html-ordered-list)
1406     (define-key map "\C-c\C-cu" 'html-unordered-list)
1407     (define-key map "\C-c\C-cr" 'html-radio-buttons)
1408     (define-key map "\C-c\C-cc" 'html-checkboxes)
1409     (define-key map "\C-c\C-cl" 'html-list-item)
1410     (define-key map "\C-c\C-ch" 'html-href-anchor)
1411     (define-key map "\C-c\C-cn" 'html-name-anchor)
1412     (define-key map "\C-c\C-ci" 'html-image)
1413     (when html-quick-keys
1414       (define-key map "\C-c-" 'html-horizontal-rule)
1415       (define-key map "\C-co" 'html-ordered-list)
1416       (define-key map "\C-cu" 'html-unordered-list)
1417       (define-key map "\C-cr" 'html-radio-buttons)
1418       (define-key map "\C-cc" 'html-checkboxes)
1419       (define-key map "\C-cl" 'html-list-item)
1420       (define-key map "\C-ch" 'html-href-anchor)
1421       (define-key map "\C-cn" 'html-name-anchor)
1422       (define-key map "\C-ci" 'html-image))
1423     (define-key map "\C-c\C-s" 'html-autoview-mode)
1424     (define-key map "\C-c\C-v" 'browse-url-of-buffer)
1425     (define-key map [menu-bar html] (cons "HTML" menu-map))
1426     (define-key menu-map [html-autoview-mode]
1427       '("Toggle Autoviewing" . html-autoview-mode))
1428     (define-key menu-map [browse-url-of-buffer]
1429       '("View Buffer Contents" . browse-url-of-buffer))
1430     (define-key menu-map [nil] '("--"))
1431     ;;(define-key menu-map "6" '("Heading 6" . html-headline-6))
1432     ;;(define-key menu-map "5" '("Heading 5" . html-headline-5))
1433     ;;(define-key menu-map "4" '("Heading 4" . html-headline-4))
1434     (define-key menu-map "3" '("Heading 3" . html-headline-3))
1435     (define-key menu-map "2" '("Heading 2" . html-headline-2))
1436     (define-key menu-map "1" '("Heading 1" . html-headline-1))
1437     (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons))
1438     (define-key menu-map "c" '("Checkboxes" . html-checkboxes))
1439     (define-key menu-map "l" '("List Item" . html-list-item))
1440     (define-key menu-map "u" '("Unordered List" . html-unordered-list))
1441     (define-key menu-map "o" '("Ordered List" . html-ordered-list))
1442     (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule))
1443     (define-key menu-map "\n" '("Line Break" . html-line))
1444     (define-key menu-map "\r" '("Paragraph" . html-paragraph))
1445     (define-key menu-map "i" '("Image" . html-image))
1446     (define-key menu-map "h" '("Href Anchor" . html-href-anchor))
1447     (define-key menu-map "n" '("Name Anchor" . html-name-anchor))
1448     map)
1449   "Keymap for commands for use in HTML mode.")
1450
1451 (defvar html-face-tag-alist
1452   '((bold . "b")
1453     (italic . "i")
1454     (underline . "u")
1455     (modeline . "rev"))
1456   "Value of `sgml-face-tag-alist' for HTML mode.")
1457
1458 (defvar html-tag-face-alist
1459   '(("b" . bold)
1460     ("big" . bold)
1461     ("blink" . highlight)
1462     ("cite" . italic)
1463     ("em" . italic)
1464     ("h1" bold underline)
1465     ("h2" bold-italic underline)
1466     ("h3" italic underline)
1467     ("h4" . underline)
1468     ("h5" . underline)
1469     ("h6" . underline)
1470     ("i" . italic)
1471     ("rev"  . modeline)
1472     ("s" . underline)
1473     ("small" . default)
1474     ("strong" . bold)
1475     ("title" bold underline)
1476     ("tt" . default)
1477     ("u" . underline)
1478     ("var" . italic))
1479   "Value of `sgml-tag-face-alist' for HTML mode.")
1480
1481 (defvar html-display-text
1482   '((img . "[/]")
1483     (hr . "----------")
1484     (li . "o "))
1485   "Value of `sgml-display-text' for HTML mode.")
1486
1487 \f
1488 ;; should code exactly HTML 3 here when that is finished
1489 (defvar html-tag-alist
1490   (let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7")))
1491          (1-9 `(,@1-7 ("8") ("9")))
1492          (align '(("align" ("left") ("center") ("right"))))
1493          (valign '(("top") ("middle") ("bottom") ("baseline")))
1494          (rel '(("next") ("previous") ("parent") ("subdocument") ("made")))
1495          (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:")
1496                  ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:")
1497                  ("wais:") ("/cgi-bin/")))
1498          (name '("name"))
1499          (link `(,href
1500                  ("rel" ,@rel)
1501                  ("rev" ,@rel)
1502                  ("title")))
1503          (list '((nil \n ("List item: " "<li>" str
1504                           (if sgml-xml-mode "</li>") \n))))
1505          (cell `(t
1506                  ,@align
1507                  ("valign" ,@valign)
1508                  ("colspan" ,@1-9)
1509                  ("rowspan" ,@1-9)
1510                  ("nowrap" t))))
1511     ;; put ,-expressions first, else byte-compile chokes (as of V19.29)
1512     ;; and like this it's more efficient anyway
1513     `(("a" ,name ,@link)
1514       ("base" t ,@href)
1515       ("dir" ,@list)
1516       ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)
1517       ("form" (\n _ \n "<input type=\"submit\" value=\"\""
1518                (if sgml-xml-mode "/>" ">"))
1519        ("action" ,@(cdr href)) ("method" ("get") ("post")))
1520       ("h1" ,@align)
1521       ("h2" ,@align)
1522       ("h3" ,@align)
1523       ("h4" ,@align)
1524       ("h5" ,@align)
1525       ("h6" ,@align)
1526       ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align)
1527       ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom"))
1528        ("src") ("alt") ("width" "1") ("height" "1")
1529        ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t))
1530       ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name
1531        ("type" ("text") ("password") ("checkbox") ("radio")
1532         ("submit") ("reset"))
1533        ("value"))
1534       ("link" t ,@link)
1535       ("menu" ,@list)
1536       ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1")))
1537       ("p" t ,@align)
1538       ("select" (nil \n
1539                      ("Text: "
1540                       "<option>" str (if sgml-xml-mode "</option>") \n))
1541        ,name ("size" ,@1-9) ("multiple" t))
1542       ("table" (nil \n
1543                     ((completing-read "Cell kind: " '(("td") ("th"))
1544                                       nil t "t")
1545                      "<tr><" str ?> _
1546                      (if sgml-xml-mode (concat "<" str "></tr>")) \n))
1547        ("border" t ,@1-9) ("width" "10") ("cellpadding"))
1548       ("td" ,@cell)
1549       ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
1550       ("th" ,@cell)
1551       ("ul" ,@list ("type" ("disc") ("circle") ("square")))
1552
1553       ,@sgml-tag-alist
1554
1555       ("abbrev")
1556       ("acronym")
1557       ("address")
1558       ("array" (nil \n
1559                     ("Item: " "<item>" str (if sgml-xml-mode "</item>") \n))
1560        "align")
1561       ("au")
1562       ("b")
1563       ("big")
1564       ("blink")
1565       ("blockquote" \n)
1566       ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#")
1567        ("link" "#") ("alink" "#") ("vlink" "#"))
1568       ("box" (nil _ "<over>" _ (if sgml-xml-mode "</over>")))
1569       ("br" t ("clear" ("left") ("right")))
1570       ("caption" ("valign" ("top") ("bottom")))
1571       ("center" \n)
1572       ("cite")
1573       ("code" \n)
1574       ("dd" ,(not sgml-xml-mode))
1575       ("del")
1576       ("dfn")
1577       ("div")
1578       ("dl" (nil \n
1579                  ( "Term: "
1580                    "<dt>" str (if sgml-xml-mode "</dt>")
1581                    "<dd>" _ (if sgml-xml-mode "</dd>") \n)))
1582       ("dt" (t _ (if sgml-xml-mode "</dt>")
1583              "<dd>" (if sgml-xml-mode "</dd>") \n))
1584       ("em")
1585       ;("fn" "id" "fn")  ; ???
1586       ("head" \n)
1587       ("html" (\n
1588                "<head>\n"
1589                "<title>" (setq str (read-input "Title: ")) "</title>\n"
1590                "</head>\n"
1591                "<body>\n<h1>" str "</h1>\n" _
1592                "\n<address>\n<a href=\"mailto:"
1593                user-mail-address
1594                "\">" (user-full-name) "</a>\n</address>\n"
1595                "</body>"
1596                 ))
1597       ("i")
1598       ("ins")
1599       ("isindex" t ("action") ("prompt"))
1600       ("kbd")
1601       ("lang")
1602       ("li" ,(not sgml-xml-mode))
1603       ("math" \n)
1604       ("nobr")
1605       ("option" t ("value") ("label") ("selected" t))
1606       ("over" t)
1607       ("person")
1608       ("pre" \n)
1609       ("q")
1610       ("rev")
1611       ("s")
1612       ("samp")
1613       ("small")
1614       ("span" nil
1615         ("class"
1616          ("builtin")
1617          ("comment")
1618          ("constant")
1619          ("function-name")
1620          ("keyword")
1621          ("string")
1622          ("type")
1623          ("variable-name")
1624          ("warning")))
1625       ("strong")
1626       ("sub")
1627       ("sup")
1628       ("title")
1629       ("tr" t)
1630       ("tt")
1631       ("u")
1632       ("var")
1633       ("wbr" t)))
1634   "*Value of `sgml-tag-alist' for HTML mode.")
1635
1636 (defvar html-tag-help
1637   `(,@sgml-tag-help
1638     ("a" . "Anchor of point or link elsewhere")
1639     ("abbrev" . "?")
1640     ("acronym" . "?")
1641     ("address" . "Formatted mail address")
1642     ("array" . "Math array")
1643     ("au" . "?")
1644     ("b" . "Bold face")
1645     ("base" . "Base address for URLs")
1646     ("big" . "Font size")
1647     ("blink" . "Blinking text")
1648     ("blockquote" . "Indented quotation")
1649     ("body" . "Document body")
1650     ("box" . "Math fraction")
1651     ("br" . "Line break")
1652     ("caption" . "Table caption")
1653     ("center" . "Centered text")
1654     ("changed" . "Change bars")
1655     ("cite" . "Citation of a document")
1656     ("code" . "Formatted source code")
1657     ("dd" . "Definition of term")
1658     ("del" . "?")
1659     ("dfn" . "?")
1660     ("dir" . "Directory list (obsolete)")
1661     ("dl" . "Definition list")
1662     ("dt" . "Term to be definined")
1663     ("em" . "Emphasised")
1664     ("embed" . "Embedded data in foreign format")
1665     ("fig" . "Figure")
1666     ("figa" . "Figure anchor")
1667     ("figd" . "Figure description")
1668     ("figt" . "Figure text")
1669     ;("fn" . "?")  ; ???
1670     ("font" . "Font size")
1671     ("form" . "Form with input fields")
1672     ("group" . "Document grouping")
1673     ("h1" . "Most important section headline")
1674     ("h2" . "Important section headline")
1675     ("h3" . "Section headline")
1676     ("h4" . "Minor section headline")
1677     ("h5" . "Unimportant section headline")
1678     ("h6" . "Least important section headline")
1679     ("head" . "Document header")
1680     ("hr" . "Horizontal rule")
1681     ("html" . "HTML Document")
1682     ("i" . "Italic face")
1683     ("img" . "Graphic image")
1684     ("input" . "Form input field")
1685     ("ins" . "?")
1686     ("isindex" . "Input field for index search")
1687     ("kbd" . "Keybard example face")
1688     ("lang" . "Natural language")
1689     ("li" . "List item")
1690     ("link" . "Link relationship")
1691     ("math" . "Math formula")
1692     ("menu" . "Menu list (obsolete)")
1693     ("mh" . "Form mail header")
1694     ("nextid" . "Allocate new id")
1695     ("nobr" . "Text without line break")
1696     ("ol" . "Ordered list")
1697     ("option" . "Selection list item")
1698     ("over" . "Math fraction rule")
1699     ("p" . "Paragraph start")
1700     ("panel" . "Floating panel")
1701     ("person" . "?")
1702     ("pre" . "Preformatted fixed width text")
1703     ("q" . "?")
1704     ("rev" . "Reverse video")
1705     ("s" . "?")
1706     ("samp" . "Sample text")
1707     ("select" . "Selection list")
1708     ("small" . "Font size")
1709     ("sp" . "Nobreak space")
1710     ("strong" . "Standout text")
1711     ("sub" . "Subscript")
1712     ("sup" . "Superscript")
1713     ("table" . "Table with rows and columns")
1714     ("tb" . "Table vertical break")
1715     ("td" . "Table data cell")
1716     ("textarea" . "Form multiline edit area")
1717     ("th" . "Table header cell")
1718     ("title" . "Document title")
1719     ("tr" . "Table row separator")
1720     ("tt" . "Typewriter face")
1721     ("u" . "Underlined text")
1722     ("ul" . "Unordered list")
1723     ("var" . "Math variable face")
1724     ("wbr" . "Enable <br> within <nobr>"))
1725 "*Value of `sgml-tag-help' for HTML mode.")
1726
1727 \f
1728 ;;;###autoload
1729 (define-derived-mode html-mode sgml-mode "HTML"
1730   "Major mode based on SGML mode for editing HTML documents.
1731 This allows inserting skeleton constructs used in hypertext documents with
1732 completion.  See below for an introduction to HTML.  Use
1733 \\[browse-url-of-buffer] to see how this comes out.  See also `sgml-mode' on
1734 which this is based.
1735
1736 Do \\[describe-variable] html- SPC and \\[describe-variable] sgml- SPC to see available variables.
1737
1738 To write fairly well formatted pages you only need to know few things.  Most
1739 browsers have a function to read the source code of the page being seen, so
1740 you can imitate various tricks.  Here's a very short HTML primer which you
1741 can also view with a browser to see what happens:
1742
1743 <title>A Title Describing Contents</title> should be on every page.  Pages can
1744 have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
1745 <hr> Parts can be separated with horizontal rules.
1746
1747 <p>Paragraphs only need an opening tag.  Line breaks and multiple spaces are
1748 ignored unless the text is <pre>preformatted.</pre>  Text can be marked as
1749 <b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal  M-g  or
1750 Edit/Text Properties/Face commands.
1751
1752 Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
1753 to them with <a href=\"#SOMENAME\">see also somename</a>.  In the same way <a
1754 href=\"URL\">see also URL</a> where URL is a filename relative to current
1755 directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'.
1756
1757 Images in many formats can be inlined with <img src=\"URL\">.
1758
1759 If you mainly create your own documents, `sgml-specials' might be
1760 interesting.  But note that some HTML 2 browsers can't handle `&apos;'.
1761 To work around that, do:
1762    (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
1763
1764 \\{html-mode-map}"
1765   (set (make-local-variable 'sgml-display-text) html-display-text)
1766   (set (make-local-variable 'sgml-tag-face-alist) html-tag-face-alist)
1767   (make-local-variable 'sgml-tag-alist)
1768   (make-local-variable 'sgml-face-tag-alist)
1769   (make-local-variable 'sgml-tag-help)
1770   (make-local-variable 'outline-regexp)
1771   (make-local-variable 'outline-heading-end-regexp)
1772   (make-local-variable 'outline-level)
1773   (make-local-variable 'sentence-end)
1774   (setq sentence-end
1775         (if sentence-end-double-space
1776             "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\| $\\|\t\\|  \\)[ \t\n]*"
1777           "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\|[ \t]\\)[ \t\n]*"))
1778   (setq sgml-tag-alist html-tag-alist
1779         sgml-face-tag-alist html-face-tag-alist
1780         sgml-tag-help html-tag-help
1781         outline-regexp "^.*<[Hh][1-6]\\>"
1782         outline-heading-end-regexp "</[Hh][1-6]>"
1783         outline-level (lambda ()
1784                         (char-before (match-end 0))))
1785   (setq imenu-create-index-function 'html-imenu-index)
1786   (when sgml-xml-mode (setq mode-name "XHTML"))
1787   (set (make-local-variable 'sgml-empty-tags)
1788        ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd',
1789        ;; plus manual addition of "wbr".
1790        '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input"
1791          "isindex" "link" "meta" "param" "wbr"))
1792   (set (make-local-variable 'sgml-unclosed-tags)
1793        ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'.
1794        '("body" "colgroup" "dd" "dt" "head" "html" "li" "option"
1795          "p" "tbody" "td" "tfoot" "th" "thead" "tr"))
1796   ;; It's for the user to decide if it defeats it or not  -stef
1797   ;; (make-local-variable 'imenu-sort-function)
1798   ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
1799   )
1800
1801 (defvar html-imenu-regexp
1802   "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
1803   "*A regular expression matching a head line to be added to the menu.
1804 The first `match-string' should be a number from 1-9.
1805 The second `match-string' matches extra tags and is ignored.
1806 The third `match-string' will be the used in the menu.")
1807
1808 (defun html-imenu-index ()
1809   "Return a table of contents for an HTML buffer for use with Imenu."
1810   (let (toc-index)
1811     (save-excursion
1812       (goto-char (point-min))
1813       (while (re-search-forward html-imenu-regexp nil t)
1814         (setq toc-index
1815               (cons (cons (concat (make-string
1816                                    (* 2 (1- (string-to-number (match-string 1))))
1817                                    ?\ )
1818                                   (match-string 3))
1819                           (line-beginning-position))
1820                     toc-index))))
1821     (nreverse toc-index)))
1822
1823 (define-minor-mode html-autoview-mode
1824   "Toggle automatic viewing via `browse-url-of-buffer' upon saving buffer.
1825 With positive prefix ARG always turns viewing on, with negative ARG always off.
1826 Can be used as a value for `html-mode-hook'."
1827   nil nil nil
1828   :group 'sgml
1829   (if html-autoview-mode
1830       (add-hook 'after-save-hook 'browse-url-of-buffer nil t)
1831     (remove-hook 'after-save-hook 'browse-url-of-buffer t)))
1832
1833 \f
1834 (define-skeleton html-href-anchor
1835   "HTML anchor tag with href attribute."
1836   "URL: "
1837   '(setq input "http:")
1838   "<a href=\"" str "\">" _ "</a>")
1839
1840 (define-skeleton html-name-anchor
1841   "HTML anchor tag with name attribute."
1842   "Name: "
1843   "<a name=\"" str "\">" _ "</a>")
1844
1845 (define-skeleton html-headline-1
1846   "HTML level 1 headline tags."
1847   nil
1848   "<h1>" _ "</h1>")
1849
1850 (define-skeleton html-headline-2
1851   "HTML level 2 headline tags."
1852   nil
1853   "<h2>" _ "</h2>")
1854
1855 (define-skeleton html-headline-3
1856   "HTML level 3 headline tags."
1857   nil
1858   "<h3>" _ "</h3>")
1859
1860 (define-skeleton html-headline-4
1861   "HTML level 4 headline tags."
1862   nil
1863   "<h4>" _ "</h4>")
1864
1865 (define-skeleton html-headline-5
1866   "HTML level 5 headline tags."
1867   nil
1868   "<h5>" _ "</h5>")
1869
1870 (define-skeleton html-headline-6
1871   "HTML level 6 headline tags."
1872   nil
1873   "<h6>" _ "</h6>")
1874
1875 (define-skeleton html-horizontal-rule
1876   "HTML horizontal rule tag."
1877   nil
1878   (if sgml-xml-mode "<hr/>" "<hr>") \n)
1879
1880 (define-skeleton html-image
1881   "HTML image tag."
1882   nil
1883   "<img src=\"" _ "\""
1884   (if sgml-xml-mode "/>" ">"))
1885
1886 (define-skeleton html-line
1887   "HTML line break tag."
1888   nil
1889   (if sgml-xml-mode "<br/>" "<br>") \n)
1890
1891 (define-skeleton html-ordered-list
1892   "HTML ordered list tags."
1893   nil
1894   "<ol>" \n
1895   "<li>" _ (if sgml-xml-mode "</li>") \n
1896   "</ol>")
1897
1898 (define-skeleton html-unordered-list
1899   "HTML unordered list tags."
1900   nil
1901   "<ul>" \n
1902   "<li>" _ (if sgml-xml-mode "</li>") \n
1903   "</ul>")
1904
1905 (define-skeleton html-list-item
1906   "HTML list item tag."
1907   nil
1908   (if (bolp) nil '\n)
1909   "<li>" _ (if sgml-xml-mode "</li>"))
1910
1911 (define-skeleton html-paragraph
1912   "HTML paragraph tag."
1913   nil
1914   (if (bolp) nil ?\n)
1915   \n "<p>" _ (if sgml-xml-mode "</p>"))
1916
1917 (define-skeleton html-checkboxes
1918   "Group of connected checkbox inputs."
1919   nil
1920   '(setq v1 nil
1921          v2 nil)
1922   ("Value: "
1923    "<input type=\"" (identity "checkbox") ; see comment above about identity
1924    "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
1925    "\" value=\"" str ?\"
1926    (when (y-or-n-p "Set \"checked\" attribute? ")
1927      (funcall skeleton-transformation " checked"))
1928    (if sgml-xml-mode "/>" ">")
1929    (skeleton-read "Text: " (capitalize str))
1930    (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
1931                        (funcall skeleton-transformation
1932                                 (if sgml-xml-mode "<br/>" "<br>"))
1933                      "")))
1934    \n))
1935
1936 (define-skeleton html-radio-buttons
1937   "Group of connected radio button inputs."
1938   nil
1939   '(setq v1 nil
1940          v2 (cons nil nil))
1941   ("Value: "
1942    "<input type=\"" (identity "radio") ; see comment above about identity
1943    "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
1944    "\" value=\"" str ?\"
1945    (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
1946      (funcall skeleton-transformation " checked"))
1947    (if sgml-xml-mode "/>" ">")
1948    (skeleton-read "Text: " (capitalize str))
1949    (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
1950                                (funcall skeleton-transformation
1951                                         (if sgml-xml-mode "<br/>" "<br>"))
1952                              "")))
1953    \n))
1954
1955 (provide 'sgml-mode)
1956
1957 ;;; sgml-mode.el ends here