lisp/textmodes/sgml-mode.el

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