code.delx.au - gnu-emacs/blob - lisp/textmodes/sgml-mode.el

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