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 (lambda ()
 763                                                     (completing-read
 764                                                      "Attribute: "
 765                                                      alist))))))
 766             (if (string= "" attribute)
 767                 (setq i 0)
 768               (sgml-value (assoc (downcase attribute) alist))
 769               (setq i (1- i))))
 770           (if (eq (preceding-char) ?\s)
 771               (delete-char -1)))
 772         car)))
 773
 774 (defun sgml-auto-attributes (arg)
 775   "Self insert the character typed; at top level of tag, prompt for attributes.
 776 With prefix argument, only self insert."
 777   (interactive "*P")
 778   (let ((point (point))
 779         tag)
 780     (if (or arg
 781             (not sgml-tag-alist)        ; no message when nothing configured
 782             (symbolp (setq tag (save-excursion (sgml-beginning-of-tag t))))
 783             (eq (aref tag 0) ?/))
 784         (self-insert-command (prefix-numeric-value arg))
 785       (sgml-attributes tag)
 786       (setq last-command-event ?\s)
 787       (or (> (point) point)
 788           (self-insert-command 1)))))
 789
 790 (defun sgml-tag-help (&optional tag)
 791   "Display description of tag TAG.  If TAG is omitted, use the tag at point."
 792   (interactive
 793    (list (let ((def (save-excursion
 794                       (if (eq (following-char) ?<) (forward-char))
 795                       (sgml-beginning-of-tag))))
 796            (completing-read (if def
 797                                 (format "Tag (default %s): " def)
 798                               "Tag: ")
 799                             sgml-tag-alist nil nil nil
 800                             'sgml-tag-history def))))
 801   (or (and tag (> (length tag) 0))
 802       (save-excursion
 803         (if (eq (following-char) ?<)
 804             (forward-char))
 805         (setq tag (sgml-beginning-of-tag))))
 806   (or (stringp tag)
 807       (error "No tag selected"))
 808   (setq tag (downcase tag))
 809   (message "%s"
 810            (or (cdr (assoc (downcase tag) sgml-tag-help))
 811                (and (eq (aref tag 0) ?/)
 812                     (cdr (assoc (downcase (substring tag 1)) sgml-tag-help)))
 813                "No description available")))
 814
 815 (defun sgml-maybe-end-tag (&optional arg)
 816   "Name self unless in position to end a tag or a prefix ARG is given."
 817   (interactive "P")
 818   (if (or arg (eq (car (sgml-lexical-context)) 'tag))
 819       (self-insert-command (prefix-numeric-value arg))
 820     (sgml-name-self)))
 821
 822 (defun sgml-skip-tag-backward (arg)
 823   "Skip to beginning of tag or matching opening tag if present.
 824 With prefix argument ARG, repeat this ARG times.
 825 Return non-nil if we skipped over matched tags."
 826   (interactive "p")
 827   ;; FIXME: use sgml-get-context or something similar.
 828   (let ((return t))
 829     (while (>= arg 1)
 830       (search-backward "<" nil t)
 831       (if (looking-at "</\\([^ \n\t>]+\\)")
 832           ;; end tag, skip any nested pairs
 833           (let ((case-fold-search t)
 834                 (re (concat "</?" (regexp-quote (match-string 1))
 835                             ;; Ignore empty tags like <foo/>.
 836                             "\\([^>]*[^/>]\\)?>")))
 837             (while (and (re-search-backward re nil t)
 838                         (eq (char-after (1+ (point))) ?/))
 839               (forward-char 1)
 840               (sgml-skip-tag-backward 1)))
 841         (setq return nil))
 842       (setq arg (1- arg)))
 843     return))
 844
 845 (defvar sgml-electric-tag-pair-overlays nil)
 846 (defvar sgml-electric-tag-pair-timer nil)
 847
 848 (defun sgml-electric-tag-pair-before-change-function (_beg end)
 849   (condition-case err
 850   (save-excursion
 851     (goto-char end)
 852     (skip-chars-backward "[:alnum:]-_.:")
 853     (if (and ;; (<= (point) beg) ; This poses problems for downcase-word.
 854              (or (eq (char-before) ?<)
 855                  (and (eq (char-before) ?/)
 856                       (eq (char-before (1- (point))) ?<)))
 857              (null (get-char-property (point) 'text-clones)))
 858         (let* ((endp (eq (char-before) ?/))
 859                (cl-start (point))
 860                (cl-end (progn (skip-chars-forward "[:alnum:]-_.:") (point)))
 861                (match
 862                 (if endp
 863                     (when (sgml-skip-tag-backward 1) (forward-char 1) t)
 864                   (with-syntax-table sgml-tag-syntax-table
 865                     (up-list -1)
 866                     (when (sgml-skip-tag-forward 1)
 867                       (backward-sexp 1)
 868                       (forward-char 2)
 869                       t))))
 870                (clones (get-char-property (point) 'text-clones)))
 871           (when (and match
 872                      (/= cl-end cl-start)
 873                      (equal (buffer-substring cl-start cl-end)
 874                             (buffer-substring (point)
 875                                               (save-excursion
 876                                                 (skip-chars-forward "[:alnum:]-_.:")
 877                                                 (point))))
 878                      (or (not endp) (eq (char-after cl-end) ?>)))
 879             (when clones
 880               (message "sgml-electric-tag-pair-before-change-function: deleting old OLs")
 881               (mapc 'delete-overlay clones))
 882             (message "sgml-electric-tag-pair-before-change-function: new clone")
 883             (text-clone-create cl-start cl-end 'spread "[[:alnum:]-_.:]+")
 884             (setq sgml-electric-tag-pair-overlays
 885                   (append (get-char-property (point) 'text-clones)
 886                           sgml-electric-tag-pair-overlays))))))
 887   (scan-error nil)
 888   (error (message "Error in sgml-electric-pair-mode: %s" err))))
 889
 890 (defun sgml-electric-tag-pair-flush-overlays ()
 891   (while sgml-electric-tag-pair-overlays
 892     (delete-overlay (pop sgml-electric-tag-pair-overlays))))
 893
 894 (define-minor-mode sgml-electric-tag-pair-mode
 895   "Toggle SGML Electric Tag Pair mode.
 896 With a prefix argument ARG, enable the mode if ARG is positive,
 897 and disable it otherwise.  If called from Lisp, enable the mode
 898 if ARG is omitted or nil.
 899
 900 SGML Electric Tag Pair mode is a buffer-local minor mode for use
 901 with `sgml-mode' and related major modes.  When enabled, editing
 902 an opening markup tag automatically updates the closing tag."
 903   :lighter "/e"
 904   (if sgml-electric-tag-pair-mode
 905       (progn
 906         (add-hook 'before-change-functions
 907                   'sgml-electric-tag-pair-before-change-function
 908                   nil t)
 909         (unless sgml-electric-tag-pair-timer
 910           (setq sgml-electric-tag-pair-timer
 911                 (run-with-idle-timer 5 'repeat 'sgml-electric-tag-pair-flush-overlays))))
 912     (remove-hook 'before-change-functions
 913                  'sgml-electric-tag-pair-before-change-function
 914                  t)
 915     ;; We leave the timer running for other buffers.
 916     ))
 917
 918
 919 (defun sgml-skip-tag-forward (arg)
 920   "Skip to end of tag or matching closing tag if present.
 921 With prefix argument ARG, repeat this ARG times.
 922 Return t if after a closing tag."
 923   (interactive "p")
 924   ;; FIXME: Use sgml-get-context or something similar.
 925   ;; It currently might jump to an unrelated </P> if the <P>
 926   ;; we're skipping has no matching </P>.
 927   (let ((return t))
 928     (with-syntax-table sgml-tag-syntax-table
 929       (while (>= arg 1)
 930         (skip-chars-forward "^<>")
 931         (if (eq (following-char) ?>)
 932             (up-list -1))
 933         (if (looking-at "<\\([^/ \n\t>]+\\)\\([^>]*[^/>]\\)?>")
 934             ;; start tag, skip any nested same pairs _and_ closing tag
 935             (let ((case-fold-search t)
 936                   (re (concat "</?" (regexp-quote (match-string 1))
 937                               ;; Ignore empty tags like <foo/>.
 938                               "\\([^>]*[^/>]\\)?>"))
 939                   point close)
 940               (forward-list 1)
 941               (setq point (point))
 942               ;; FIXME: This re-search-forward will mistakenly match
 943               ;; tag-like text inside attributes.
 944               (while (and (re-search-forward re nil t)
 945                           (not (setq close
 946                                      (eq (char-after (1+ (match-beginning 0))) ?/)))
 947                           (goto-char (match-beginning 0))
 948                           (sgml-skip-tag-forward 1))
 949                 (setq close nil))
 950               (unless close
 951                 (goto-char point)
 952                 (setq return nil)))
 953           (forward-list 1))
 954         (setq arg (1- arg)))
 955       return)))
 956
 957 (defsubst sgml-looking-back-at (str)
 958   "Return t if the test before point matches STR."
 959   (let ((start (- (point) (length str))))
 960     (and (>= start (point-min))
 961          (equal str (buffer-substring-no-properties start (point))))))
 962
 963 (defun sgml-delete-tag (arg)
 964   ;; FIXME: Should be called sgml-kill-tag or should not touch the kill-ring.
 965   "Delete tag on or after cursor, and matching closing or opening tag.
 966 With prefix argument ARG, repeat this ARG times."
 967   (interactive "p")
 968   (while (>= arg 1)
 969     (save-excursion
 970       (let* (close open)
 971         (if (looking-at "[ \t\n]*<")
 972             ;; just before tag
 973             (if (eq (char-after (match-end 0)) ?/)
 974                 ;; closing tag
 975                 (progn
 976                   (setq close (point))
 977                   (goto-char (match-end 0))))
 978           ;; on tag?
 979           (or (save-excursion (setq close (sgml-beginning-of-tag)
 980                                     close (and (stringp close)
 981                                                (eq (aref close 0) ?/)
 982                                                (point))))
 983               ;; not on closing tag
 984               (let ((point (point)))
 985                 (sgml-skip-tag-backward 1)
 986                 (if (or (not (eq (following-char) ?<))
 987                         (save-excursion
 988                           (forward-list 1)
 989                           (<= (point) point)))
 990                     (error "Not on or before tag")))))
 991         (if close
 992             (progn
 993               (sgml-skip-tag-backward 1)
 994               (setq open (point))
 995               (goto-char close)
 996               (kill-sexp 1))
 997           (setq open (point))
 998           (when (and (sgml-skip-tag-forward 1)
 999                      (not (sgml-looking-back-at "/>")))
1000             (kill-sexp -1)))
1001         ;; Delete any resulting empty line.  If we didn't kill-sexp,
1002         ;; this *should* do nothing, because we're right after the tag.
1003         (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?"))
1004             (delete-region (match-beginning 0) (match-end 0)))
1005         (goto-char open)
1006         (kill-sexp 1)
1007         (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?"))
1008             (delete-region (match-beginning 0) (match-end 0)))))
1009     (setq arg (1- arg))))
1010
1011 \f
1012 ;; Put read-only last to enable setting this even when read-only enabled.
1013 (or (get 'sgml-tag 'invisible)
1014     (setplist 'sgml-tag
1015               (append '(invisible t
1016                         cursor-sensor-functions (sgml-cursor-sensor)
1017                         rear-nonsticky t
1018                         read-only t)
1019                       (symbol-plist 'sgml-tag))))
1020
1021 (defun sgml-tags-invisible (arg)
1022   "Toggle visibility of existing tags."
1023   (interactive "P")
1024   (let ((inhibit-read-only t)
1025         string)
1026     (with-silent-modifications
1027       (save-excursion
1028         (goto-char (point-min))
1029         (if (setq-local sgml-tags-invisible
1030                         (if arg
1031                             (>= (prefix-numeric-value arg) 0)
1032                           (not sgml-tags-invisible)))
1033             (while (re-search-forward sgml-tag-name-re nil t)
1034               (setq string
1035                     (cdr (assq (intern-soft (downcase (match-string 1)))
1036                                sgml-display-text)))
1037               (goto-char (match-beginning 0))
1038               (and (stringp string)
1039                    (not (overlays-at (point)))
1040                    (let ((ol (make-overlay (point) (match-beginning 1))))
1041                      (overlay-put ol 'before-string string)
1042                      (overlay-put ol 'sgml-tag t)))
1043               (put-text-property (point)
1044                                  (progn (forward-list) (point))
1045                                  'category 'sgml-tag))
1046           (let ((pos (point-min)))
1047             (while (< (setq pos (next-overlay-change pos)) (point-max))
1048               (dolist (ol (overlays-at pos))
1049                 (if (overlay-get ol 'sgml-tag)
1050                     (delete-overlay ol)))))
1051           (remove-text-properties (point-min) (point-max) '(category nil)))))
1052     (cursor-sensor-mode (if sgml-tags-invisible 1 -1))
1053     (run-hooks 'sgml-tags-invisible-hook)
1054     (message "")))
1055
1056 (defun sgml-cursor-sensor (window x dir)
1057   ;; Show preceding or following hidden tag, depending of cursor direction (and
1058   ;; `dir' is not the direction in this sense).
1059   (when (eq dir 'entered)
1060     (ignore-errors
1061       (let* ((y (window-point window))
1062              (otherend
1063               (save-excursion
1064                 (goto-char y)
1065                 (cond
1066                  ((and (eq (char-before) ?>)
1067                        (or (not (eq (char-after) ?<))
1068                            (> x y)))
1069                   (backward-sexp))
1070                  ((eq (char-after y) ?<)
1071                   (forward-sexp)))
1072                 (point))))
1073         (message "Invisible tag: %s"
1074                  ;; Strip properties, otherwise, the text is invisible.
1075                  (buffer-substring-no-properties
1076                   y otherend))))))
1077
1078 \f
1079 (defun sgml-validate (command)
1080   "Validate an SGML document.
1081 Runs COMMAND, a shell command, in a separate process asynchronously
1082 with output going to the buffer `*compilation*'.
1083 You can then use the command \\[next-error] to find the next error message
1084 and move to the line in the SGML document that caused it."
1085   (interactive
1086    (list (read-string "Validate command: "
1087                       (or sgml-saved-validate-command
1088                           (concat sgml-validate-command
1089                                   " "
1090                                   (shell-quote-argument
1091                                    (let ((name (buffer-file-name)))
1092                                      (and name
1093                                           (file-name-nondirectory name)))))))))
1094   (setq sgml-saved-validate-command command)
1095   (save-some-buffers (not compilation-ask-about-save) nil)
1096   (compilation-start command))
1097
1098 (defsubst sgml-at-indentation-p ()
1099   "Return true if point is at the first non-whitespace character on the line."
1100   (save-excursion
1101     (skip-chars-backward " \t")
1102     (bolp)))
1103
1104 (defun sgml-lexical-context (&optional limit)
1105   "Return the lexical context at point as (TYPE . START).
1106 START is the location of the start of the lexical element.
1107 TYPE is one of `string', `comment', `tag', `cdata', `pi', or `text'.
1108
1109 Optional argument LIMIT is the position to start parsing from.
1110 If nil, start from a preceding tag at indentation."
1111   (save-excursion
1112     (let ((pos (point))
1113           text-start state)
1114       (if limit
1115           (goto-char limit)
1116         ;; Skip tags backwards until we find one at indentation
1117         (while (and (ignore-errors (sgml-parse-tag-backward))
1118                     (not (sgml-at-indentation-p)))))
1119       (with-syntax-table sgml-tag-syntax-table
1120         (while (< (point) pos)
1121           ;; When entering this loop we're inside text.
1122           (setq text-start (point))
1123           (skip-chars-forward "^<" pos)
1124           (setq state
1125                 (cond
1126                  ((= (point) pos)
1127                   ;; We got to the end without seeing a tag.
1128                   nil)
1129                  ((looking-at "<!\\[[A-Z]+\\[")
1130                   ;; We've found a CDATA section or similar.
1131                   (let ((cdata-start (point)))
1132                     (unless (search-forward "]]>" pos 'move)
1133                       (list 0 nil nil 'cdata nil nil nil nil cdata-start))))
1134                  ((looking-at comment-start-skip)
1135                   ;; parse-partial-sexp doesn't handle <!-- comments -->,
1136                   ;; or only if ?- is in sgml-specials, so match explicitly
1137                   (let ((start (point)))
1138                     (unless (re-search-forward comment-end-skip pos 'move)
1139                       (list 0 nil nil nil t nil nil nil start))))
1140                  ((and sgml-xml-mode (looking-at "<\\?"))
1141                   ;; Processing Instructions.
1142                   ;; In SGML, it's basically a normal tag of the form
1143                   ;; <?NAME ...> but in XML, it takes the form <? ... ?>.
1144                   (let ((pi-start (point)))
1145                     (unless (search-forward "?>" pos 'move)
1146                       (list 0 nil nil 'pi nil nil nil nil pi-start))))
1147                  (t
1148                   ;; We've reached a tag.  Parse it.
1149                   ;; FIXME: Handle net-enabling start-tags
1150                   (parse-partial-sexp (point) pos 0))))))
1151       (cond
1152        ((memq (nth 3 state) '(cdata pi)) (cons (nth 3 state) (nth 8 state)))
1153        ((nth 3 state) (cons 'string (nth 8 state)))
1154        ((nth 4 state) (cons 'comment (nth 8 state)))
1155        ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))
1156        (t (cons 'text text-start))))))
1157
1158 (defun sgml-beginning-of-tag (&optional only-immediate)
1159   "Skip to beginning of tag and return its name.
1160 If this can't be done, return nil."
1161   (let ((context (sgml-lexical-context)))
1162     (if (eq (car context) 'tag)
1163         (progn
1164           (goto-char (cdr context))
1165           (when (looking-at sgml-tag-name-re)
1166             (match-string-no-properties 1)))
1167       (if only-immediate nil
1168         (when (not (eq (car context) 'text))
1169           (goto-char (cdr context))
1170           (sgml-beginning-of-tag t))))))
1171
1172 (defun sgml-value (alist)
1173   "Interactively insert value taken from attribute-rule ALIST.
1174 See `sgml-tag-alist' for info about attribute rules."
1175   (setq alist (cdr alist))
1176   (if (stringp (car alist))
1177       (insert "=\"" (car alist) ?\")
1178     (if (and (eq (car alist) t) (not sgml-xml-mode))
1179         (when (cdr alist)
1180           (insert "=\"")
1181           (setq alist (skeleton-read (lambda ()
1182                                        (completing-read
1183                                         "Value: " (cdr alist)))))
1184           (if (string< "" alist)
1185               (insert alist ?\")
1186             (delete-char -2)))
1187       (insert "=\"")
1188       (if (cdr alist)
1189           (insert (skeleton-read (lambda ()
1190                                    (completing-read "Value: " alist))))
1191         (when (null alist)
1192           (insert (skeleton-read '(read-string "Value: ")))))
1193       (insert ?\"))))
1194
1195 (defun sgml-quote (start end &optional unquotep)
1196   "Quote SGML text in region START ... END.
1197 Only &, < and > are quoted, the rest is left untouched.
1198 With prefix argument UNQUOTEP, unquote the region."
1199   (interactive "r\nP")
1200   (save-restriction
1201     (narrow-to-region start end)
1202     (goto-char (point-min))
1203     (if unquotep
1204         ;; FIXME: We should unquote other named character references as well.
1205         (while (re-search-forward
1206                 "\\(&\\(amp\\|\\(l\\|\\(g\\)\\)t\\)\\)[][<>&;\n\t \"%!'(),/=?]"
1207                 nil t)
1208           (replace-match (if (match-end 4) ">" (if (match-end 3) "<" "&")) t t
1209                          nil (if (eq (char-before (match-end 0)) ?\;) 0 1)))
1210       (while (re-search-forward "[&<>]" nil t)
1211         (replace-match (cdr (assq (char-before) '((?& . "&amp;")
1212                                                   (?< . "&lt;")
1213                                                   (?> . "&gt;"))))
1214                        t t)))))
1215
1216 (defun sgml-pretty-print (beg end)
1217   "Simple-minded pretty printer for SGML.
1218 Re-indents the code and inserts newlines between BEG and END.
1219 You might want to turn on `auto-fill-mode' to get better results."
1220   ;; TODO:
1221   ;; - insert newline between some start-tag and text.
1222   ;; - don't insert newline in front of some end-tags.
1223   (interactive "r")
1224   (save-excursion
1225     (if (< beg end)
1226         (goto-char beg)
1227       (goto-char end)
1228       (setq end beg)
1229       (setq beg (point)))
1230     ;; Don't use narrowing because it screws up auto-indent.
1231     (setq end (copy-marker end t))
1232     (with-syntax-table sgml-tag-syntax-table
1233       (while (re-search-forward "<" end t)
1234         (goto-char (match-beginning 0))
1235         (unless (or ;;(looking-at "</")
1236                     (progn (skip-chars-backward " \t") (bolp)))
1237           (reindent-then-newline-and-indent))
1238         (forward-sexp 1)))
1239     ;; (indent-region beg end)
1240     ))
1241
1242 \f
1243 ;; Parsing
1244
1245 (cl-defstruct (sgml-tag
1246             (:constructor sgml-make-tag (type start end name)))
1247   type start end name)
1248
1249 (defsubst sgml-parse-tag-name ()
1250   "Skip past a tag-name, and return the name."
1251   (buffer-substring-no-properties
1252    (point) (progn (skip-syntax-forward "w_") (point))))
1253
1254 (defun sgml-tag-text-p (start end)
1255   "Return non-nil if text between START and END is a tag.
1256 Checks among other things that the tag does not contain spurious
1257 unquoted < or > chars inside, which would indicate that it
1258 really isn't a tag after all."
1259   (save-excursion
1260     (with-syntax-table sgml-tag-syntax-table
1261       (let ((pps (parse-partial-sexp start end 2)))
1262         (and (= (nth 0 pps) 0))))))
1263
1264 (defun sgml-parse-tag-backward (&optional limit)
1265   "Parse an SGML tag backward, and return information about the tag.
1266 Assume that parsing starts from within a textual context.
1267 Leave point at the beginning of the tag."
1268   (catch 'found
1269     (let (tag-type tag-start tag-end name)
1270       (or (re-search-backward "[<>]" limit 'move)
1271           (error "No tag found"))
1272       (when (eq (char-after) ?<)
1273         ;; Oops!! Looks like we were not in a textual context after all!.
1274         ;; Let's try to recover.
1275         ;; Remember the tag-start so we don't need to look for it later.
1276         ;; This is not just an optimization but also makes sure we don't get
1277         ;; stuck in infloops in cases where "looking back for <" would not go
1278         ;; back far enough.
1279         (setq tag-start (point))
1280         (with-syntax-table sgml-tag-syntax-table
1281           (let ((pos (point)))
1282             (condition-case nil
1283                 ;; FIXME: This does not correctly skip over PI an CDATA tags.
1284                 (forward-sexp)
1285               (scan-error
1286                ;; This < seems to be just a spurious one, let's ignore it.
1287                (goto-char pos)
1288                (throw 'found (sgml-parse-tag-backward limit))))
1289             ;; Check it is really a tag, without any extra < or > inside.
1290             (unless (sgml-tag-text-p pos (point))
1291               (goto-char pos)
1292               (throw 'found (sgml-parse-tag-backward limit)))
1293             (forward-char -1))))
1294       (setq tag-end (1+ (point)))
1295       (cond
1296        ((sgml-looking-back-at "--")     ; comment
1297         (setq tag-type 'comment
1298               tag-start (or tag-start (search-backward "<!--" nil t))))
1299        ((sgml-looking-back-at "]]")     ; cdata
1300         (setq tag-type 'cdata
1301               tag-start (or tag-start
1302                             (re-search-backward "<!\\[[A-Z]+\\[" nil t))))
1303        ((sgml-looking-back-at "?")      ; XML processing-instruction
1304         (setq tag-type 'pi
1305               ;; IIUC: SGML processing instructions take the form <?foo ...>
1306               ;; i.e. a "normal" tag, handled below.  In XML this is changed
1307               ;; to <?foo ... ?> where "..." can contain < and > and even <?
1308               ;; but not ?>.  This means that when parsing backward, there's
1309               ;; no easy way to make sure that we find the real beginning of
1310               ;; the PI.
1311               tag-start (or tag-start (search-backward "<?" nil t))))
1312        (t
1313         (unless tag-start
1314           (setq tag-start
1315                 (with-syntax-table sgml-tag-syntax-table
1316                   (goto-char tag-end)
1317                   (condition-case nil
1318                       (backward-sexp)
1319                     (scan-error
1320                      ;; This > isn't really the end of a tag. Skip it.
1321                      (goto-char (1- tag-end))
1322                      (throw 'found (sgml-parse-tag-backward limit))))
1323                   (point))))
1324         (goto-char (1+ tag-start))
1325         (pcase (char-after)
1326           (?! (setq tag-type 'decl))    ; declaration
1327           (?? (setq tag-type 'pi))      ; processing-instruction
1328           (?% (setq tag-type 'jsp))     ; JSP tags
1329           (?/                           ; close-tag
1330            (forward-char 1)
1331            (setq tag-type 'close
1332                  name (sgml-parse-tag-name)))
1333           (_                            ; open or empty tag
1334            (setq tag-type 'open
1335                  name (sgml-parse-tag-name))
1336            (if (or (eq ?/ (char-before (- tag-end 1)))
1337                    (sgml-empty-tag-p name))
1338                (setq tag-type 'empty))))))
1339       (goto-char tag-start)
1340       (sgml-make-tag tag-type tag-start tag-end name))))
1341
1342 (defun sgml-get-context (&optional until)
1343   "Determine the context of the current position.
1344 By default, parse until we find a start-tag as the first thing on a line.
1345 If UNTIL is `empty', return even if the context is empty (i.e.
1346 we just skipped over some element and got to a beginning of line).
1347
1348 The context is a list of tag-info structures.  The last one is the tag
1349 immediately enclosing the current position.
1350
1351 Point is assumed to be outside of any tag.  If we discover that it's
1352 not the case, the first tag returned is the one inside which we are."
1353   (let ((here (point))
1354         (stack nil)
1355         (ignore nil)
1356         (context nil)
1357         tag-info)
1358     ;; CONTEXT keeps track of the tag-stack
1359     ;; STACK keeps track of the end tags we've seen (and thus the start-tags
1360     ;;   we'll have to ignore) when skipping over matching open..close pairs.
1361     ;; IGNORE is a list of tags that can be ignored because they have been
1362     ;;   closed implicitly.
1363     (skip-chars-backward " \t\n")      ; Make sure we're not at indentation.
1364     (while
1365         (and (not (eq until 'now))
1366              (or stack
1367                  (not (if until (eq until 'empty) context))
1368                  (not (sgml-at-indentation-p))
1369                  (and context
1370                       (/= (point) (sgml-tag-start (car context)))
1371                       (sgml-unclosed-tag-p (sgml-tag-name (car context)))))
1372              (setq tag-info (ignore-errors (sgml-parse-tag-backward))))
1373
1374       ;; This tag may enclose things we thought were tags.  If so,
1375       ;; discard them.
1376       (while (and context
1377                   (> (sgml-tag-end tag-info)
1378                      (sgml-tag-end (car context))))
1379         (setq context (cdr context)))
1380
1381       (cond
1382        ((> (sgml-tag-end tag-info) here)
1383         ;; Oops!!  Looks like we were not outside of any tag, after all.
1384         (push tag-info context)
1385         (setq until 'now))
1386
1387        ;; start-tag
1388        ((eq (sgml-tag-type tag-info) 'open)
1389         (cond
1390          ((null stack)
1391           (if (assoc-string (sgml-tag-name tag-info) ignore t)
1392               ;; There was an implicit end-tag.
1393               nil
1394             (push tag-info context)
1395             ;; We're changing context so the tags implicitly closed inside
1396             ;; the previous context aren't implicitly closed here any more.
1397             ;; [ Well, actually it depends, but we don't have the info about
1398             ;; when it doesn't and when it does.   --Stef ]
1399             (setq ignore nil)))
1400          ((eq t (compare-strings (sgml-tag-name tag-info) nil nil
1401                                  (car stack) nil nil t))
1402           (setq stack (cdr stack)))
1403          (t
1404           ;; The open and close tags don't match.
1405           (if (not sgml-xml-mode)
1406               (unless (sgml-unclosed-tag-p (sgml-tag-name tag-info))
1407                 (message "Unclosed tag <%s>" (sgml-tag-name tag-info))
1408                 (let ((tmp stack))
1409                   ;; We could just assume that the tag is simply not closed
1410                   ;; but it's a bad assumption when tags *are* closed but
1411                   ;; not properly nested.
1412                   (while (and (cdr tmp)
1413                               (not (eq t (compare-strings
1414                                           (sgml-tag-name tag-info) nil nil
1415                                           (cadr tmp) nil nil t))))
1416                     (setq tmp (cdr tmp)))
1417                   (if (cdr tmp) (setcdr tmp (cddr tmp)))))
1418             (message "Unmatched tags <%s> and </%s>"
1419                      (sgml-tag-name tag-info) (pop stack)))))
1420
1421         (if (and (null stack) (sgml-unclosed-tag-p (sgml-tag-name tag-info)))
1422             ;; This is a top-level open of an implicitly closed tag, so any
1423             ;; occurrence of such an open tag at the same level can be ignored
1424             ;; because it's been implicitly closed.
1425             (push (sgml-tag-name tag-info) ignore)))
1426
1427        ;; end-tag
1428        ((eq (sgml-tag-type tag-info) 'close)
1429         (if (sgml-empty-tag-p (sgml-tag-name tag-info))
1430             (message "Spurious </%s>: empty tag" (sgml-tag-name tag-info))
1431           (push (sgml-tag-name tag-info) stack)))
1432        ))
1433
1434     ;; return context
1435     context))
1436
1437 (defun sgml-show-context (&optional full)
1438   "Display the current context.
1439 If FULL is non-nil, parse back to the beginning of the buffer."
1440   (interactive "P")
1441   (with-output-to-temp-buffer "*XML Context*"
1442     (save-excursion
1443       (let ((context (sgml-get-context)))
1444         (when full
1445           (let ((more nil))
1446             (while (setq more (sgml-get-context))
1447               (setq context (nconc more context)))))
1448         (pp context)))))
1449
1450 \f
1451 ;; Editing shortcuts
1452
1453 (defun sgml-close-tag ()
1454   "Close current element.
1455 Depending on context, inserts a matching close-tag, or closes
1456 the current start-tag or the current comment or the current cdata, ..."
1457   (interactive)
1458   (pcase (car (sgml-lexical-context))
1459     (`comment   (insert " -->"))
1460     (`cdata     (insert "]]>"))
1461     (`pi        (insert " ?>"))
1462     (`jsp       (insert " %>"))
1463     (`tag       (insert " />"))
1464     (`text
1465      (let ((context (save-excursion (sgml-get-context))))
1466        (if context
1467            (progn
1468              (insert "</" (sgml-tag-name (car (last context))) ">")
1469              (indent-according-to-mode)))))
1470     (_
1471      (error "Nothing to close"))))
1472
1473 (defun sgml-empty-tag-p (tag-name)
1474   "Return non-nil if TAG-NAME is an implicitly empty tag."
1475   (and (not sgml-xml-mode)
1476        (assoc-string tag-name sgml-empty-tags 'ignore-case)))
1477
1478 (defun sgml-unclosed-tag-p (tag-name)
1479   "Return non-nil if TAG-NAME is a tag for which an end-tag is optional."
1480   (and (not sgml-xml-mode)
1481        (assoc-string tag-name sgml-unclosed-tags 'ignore-case)))
1482
1483
1484 (defun sgml-calculate-indent (&optional lcon)
1485   "Calculate the column to which this line should be indented.
1486 LCON is the lexical context, if any."
1487   (unless lcon (setq lcon (sgml-lexical-context)))
1488
1489   ;; Indent comment-start markers inside <!-- just like comment-end markers.
1490   (if (and (eq (car lcon) 'tag)
1491            (looking-at "--")
1492            (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
1493       (setq lcon (cons 'comment (+ (cdr lcon) 2))))
1494
1495   (pcase (car lcon)
1496
1497     (`string
1498      ;; Go back to previous non-empty line.
1499      (while (and (> (point) (cdr lcon))
1500                  (zerop (forward-line -1))
1501                  (looking-at "[ \t]*$")))
1502      (if (> (point) (cdr lcon))
1503          ;; Previous line is inside the string.
1504          (current-indentation)
1505        (goto-char (cdr lcon))
1506        (1+ (current-column))))
1507
1508     (`comment
1509      (let ((mark (looking-at "--")))
1510        ;; Go back to previous non-empty line.
1511        (while (and (> (point) (cdr lcon))
1512                    (zerop (forward-line -1))
1513                    (or (looking-at "[ \t]*$")
1514                        (if mark (not (looking-at "[ \t]*--"))))))
1515        (if (> (point) (cdr lcon))
1516            ;; Previous line is inside the comment.
1517            (skip-chars-forward " \t")
1518          (goto-char (cdr lcon))
1519          ;; Skip `<!' to get to the `--' with which we want to align.
1520          (search-forward "--")
1521          (goto-char (match-beginning 0)))
1522        (when (and (not mark) (looking-at "--"))
1523          (forward-char 2) (skip-chars-forward " \t"))
1524        (current-column)))
1525
1526     ;; We don't know how to indent it.  Let's be honest about it.
1527     (`cdata nil)
1528     ;; We don't know how to indent it.  Let's be honest about it.
1529     (`pi nil)
1530
1531     (`tag
1532      (goto-char (+ (cdr lcon) sgml-attribute-offset))
1533      (skip-chars-forward "^ \t\n")      ;Skip tag name.
1534      (skip-chars-forward " \t")
1535      (if (not (eolp))
1536          (current-column)
1537        ;; This is the first attribute: indent.
1538        (goto-char (+ (cdr lcon) sgml-attribute-offset))
1539        (+ (current-column) sgml-basic-offset)))
1540
1541     (`text
1542      (while (looking-at "</")
1543        (forward-sexp 1)
1544        (skip-chars-forward " \t"))
1545      (let* ((here (point))
1546             (unclosed (and ;; (not sgml-xml-mode)
1547                        (looking-at sgml-tag-name-re)
1548                        (assoc-string (match-string 1)
1549                                      sgml-unclosed-tags 'ignore-case)
1550                        (match-string 1)))
1551             (context
1552              ;; If possible, align on the previous non-empty text line.
1553              ;; Otherwise, do a more serious parsing to find the
1554              ;; tag(s) relative to which we should be indenting.
1555              (if (and (not unclosed) (skip-chars-backward " \t")
1556                       (< (skip-chars-backward " \t\n") 0)
1557                       (back-to-indentation)
1558                       (> (point) (cdr lcon)))
1559                  nil
1560                (goto-char here)
1561                (nreverse (sgml-get-context (if unclosed nil 'empty)))))
1562             (there (point)))
1563        ;; Ignore previous unclosed start-tag in context.
1564        (while (and context unclosed
1565                    (eq t (compare-strings
1566                           (sgml-tag-name (car context)) nil nil
1567                           unclosed nil nil t)))
1568          (setq context (cdr context)))
1569        ;; Indent to reflect nesting.
1570        (cond
1571         ;; If we were not in a text context after all, let's try again.
1572         ((and context (> (sgml-tag-end (car context)) here))
1573          (goto-char here)
1574          (sgml-calculate-indent
1575           (cons (if (memq (sgml-tag-type (car context)) '(comment cdata))
1576                     (sgml-tag-type (car context)) 'tag)
1577                 (sgml-tag-start (car context)))))
1578         ;; Align on the first element after the nearest open-tag, if any.
1579         ((and context
1580               (goto-char (sgml-tag-end (car context)))
1581               (skip-chars-forward " \t\n")
1582               (< (point) here) (sgml-at-indentation-p))
1583          (current-column))
1584         ;; ;; If the parsing failed, try to recover.
1585         ;; ((and (null context) (bobp)
1586         ;;      (not (eq (char-after here) ?<)))
1587         ;;  (goto-char here)
1588         ;;  (if (and (looking-at "--[ \t\n]*>")
1589         ;;          (re-search-backward "<!--" nil t))
1590         ;;      ;; No wonder parsing failed: we're in a comment.
1591         ;;      (sgml-calculate-indent (prog2 (goto-char (match-end 0))
1592         ;;                                (sgml-lexical-context)
1593         ;;                              (goto-char here)))
1594         ;;    ;; We have no clue what's going on, let's be honest about it.
1595         ;;    nil))
1596         ;; Otherwise, just follow the rules.
1597         (t
1598          (goto-char there)
1599          (+ (current-column)
1600             (* sgml-basic-offset (length context)))))))
1601
1602     (_
1603      (error "Unrecognized context %s" (car lcon)))
1604
1605     ))
1606
1607 (defun sgml-indent-line ()
1608   "Indent the current line as SGML."
1609   (interactive)
1610   (let* ((savep (point))
1611          (indent-col
1612           (save-excursion
1613             (back-to-indentation)
1614             (if (>= (point) savep) (setq savep nil))
1615             (sgml-calculate-indent))))
1616     (if (null indent-col)
1617         'noindent
1618       (if savep
1619           (save-excursion (indent-line-to indent-col))
1620         (indent-line-to indent-col)))))
1621
1622 (defun sgml-guess-indent ()
1623   "Guess an appropriate value for `sgml-basic-offset'.
1624 Base the guessed indentation level on the first indented tag in the buffer.
1625 Add this to `sgml-mode-hook' for convenience."
1626   (interactive)
1627   (save-excursion
1628     (goto-char (point-min))
1629     (if (re-search-forward "^\\([ \t]+\\)<" 500 'noerror)
1630         (progn
1631           (setq-local sgml-basic-offset (1- (current-column)))
1632           (message "Guessed sgml-basic-offset = %d"
1633                    sgml-basic-offset)
1634           ))))
1635
1636 (defun sgml-parse-dtd ()
1637   "Simplistic parse of the current buffer as a DTD.
1638 Currently just returns (EMPTY-TAGS UNCLOSED-TAGS)."
1639   (goto-char (point-min))
1640   (let ((empty nil)
1641         (unclosed nil))
1642     (while (re-search-forward "<!ELEMENT[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+[-O][ \t\n]+\\([-O]\\)[ \t\n]+\\([^ \t\n]+\\)" nil t)
1643       (cond
1644        ((string= (match-string 3) "EMPTY")
1645         (push (match-string-no-properties 1) empty))
1646        ((string= (match-string 2) "O")
1647         (push (match-string-no-properties 1) unclosed))))
1648     (setq empty (sort (mapcar 'downcase empty) 'string<))
1649     (setq unclosed (sort (mapcar 'downcase unclosed) 'string<))
1650     (list empty unclosed)))
1651
1652 ;;; HTML mode
1653
1654 (defcustom html-mode-hook nil
1655   "Hook run by command `html-mode'.
1656 `text-mode-hook' and `sgml-mode-hook' are run first."
1657   :group 'sgml
1658   :type 'hook
1659   :options '(html-autoview-mode))
1660
1661 (defvar html-quick-keys sgml-quick-keys
1662   "Use C-c X combinations for quick insertion of frequent tags when non-nil.
1663 This defaults to `sgml-quick-keys'.
1664 This takes effect when first loading the library.")
1665
1666 (defvar html-mode-map
1667   (let ((map (make-sparse-keymap))
1668         (menu-map (make-sparse-keymap "HTML")))
1669     (set-keymap-parent map  sgml-mode-map)
1670     (define-key map "\C-c6" 'html-headline-6)
1671     (define-key map "\C-c5" 'html-headline-5)
1672     (define-key map "\C-c4" 'html-headline-4)
1673     (define-key map "\C-c3" 'html-headline-3)
1674     (define-key map "\C-c2" 'html-headline-2)
1675     (define-key map "\C-c1" 'html-headline-1)
1676     (define-key map "\C-c\r" 'html-paragraph)
1677     (define-key map "\C-c\n" 'html-line)
1678     (define-key map "\C-c\C-c-" 'html-horizontal-rule)
1679     (define-key map "\C-c\C-co" 'html-ordered-list)
1680     (define-key map "\C-c\C-cu" 'html-unordered-list)
1681     (define-key map "\C-c\C-cr" 'html-radio-buttons)
1682     (define-key map "\C-c\C-cc" 'html-checkboxes)
1683     (define-key map "\C-c\C-cl" 'html-list-item)
1684     (define-key map "\C-c\C-ch" 'html-href-anchor)
1685     (define-key map "\C-c\C-cn" 'html-name-anchor)
1686     (define-key map "\C-c\C-ci" 'html-image)
1687     (when html-quick-keys
1688       (define-key map "\C-c-" 'html-horizontal-rule)
1689       (define-key map "\C-co" 'html-ordered-list)
1690       (define-key map "\C-cu" 'html-unordered-list)
1691       (define-key map "\C-cr" 'html-radio-buttons)
1692       (define-key map "\C-cc" 'html-checkboxes)
1693       (define-key map "\C-cl" 'html-list-item)
1694       (define-key map "\C-ch" 'html-href-anchor)
1695       (define-key map "\C-cn" 'html-name-anchor)
1696       (define-key map "\C-ci" 'html-image))
1697     (define-key map "\C-c\C-s" 'html-autoview-mode)
1698     (define-key map "\C-c\C-v" 'browse-url-of-buffer)
1699     (define-key map [menu-bar html] (cons "HTML" menu-map))
1700     (define-key menu-map [html-autoview-mode]
1701       '("Toggle Autoviewing" . html-autoview-mode))
1702     (define-key menu-map [browse-url-of-buffer]
1703       '("View Buffer Contents" . browse-url-of-buffer))
1704     (define-key menu-map [nil] '("--"))
1705     ;;(define-key menu-map "6" '("Heading 6" . html-headline-6))
1706     ;;(define-key menu-map "5" '("Heading 5" . html-headline-5))
1707     ;;(define-key menu-map "4" '("Heading 4" . html-headline-4))
1708     (define-key menu-map "3" '("Heading 3" . html-headline-3))
1709     (define-key menu-map "2" '("Heading 2" . html-headline-2))
1710     (define-key menu-map "1" '("Heading 1" . html-headline-1))
1711     (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons))
1712     (define-key menu-map "c" '("Checkboxes" . html-checkboxes))
1713     (define-key menu-map "l" '("List Item" . html-list-item))
1714     (define-key menu-map "u" '("Unordered List" . html-unordered-list))
1715     (define-key menu-map "o" '("Ordered List" . html-ordered-list))
1716     (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule))
1717     (define-key menu-map "\n" '("Line Break" . html-line))
1718     (define-key menu-map "\r" '("Paragraph" . html-paragraph))
1719     (define-key menu-map "i" '("Image" . html-image))
1720     (define-key menu-map "h" '("Href Anchor" . html-href-anchor))
1721     (define-key menu-map "n" '("Name Anchor" . html-name-anchor))
1722     map)
1723   "Keymap for commands for use in HTML mode.")
1724
1725 (defvar html-face-tag-alist
1726   '((bold . "b")
1727     (italic . "i")
1728     (underline . "u")
1729     (mode-line . "rev"))
1730   "Value of `sgml-face-tag-alist' for HTML mode.")
1731
1732 (defvar html-tag-face-alist
1733   '(("b" . bold)
1734     ("big" . bold)
1735     ("blink" . highlight)
1736     ("cite" . italic)
1737     ("em" . italic)
1738     ("h1" bold underline)
1739     ("h2" bold-italic underline)
1740     ("h3" italic underline)
1741     ("h4" . underline)
1742     ("h5" . underline)
1743     ("h6" . underline)
1744     ("i" . italic)
1745     ("rev"  . mode-line)
1746     ("s" . underline)
1747     ("small" . default)
1748     ("strong" . bold)
1749     ("title" bold underline)
1750     ("tt" . default)
1751     ("u" . underline)
1752     ("var" . italic))
1753   "Value of `sgml-tag-face-alist' for HTML mode.")
1754
1755 (defvar html-display-text
1756   '((img . "[/]")
1757     (hr . "----------")
1758     (li . "o "))
1759   "Value of `sgml-display-text' for HTML mode.")
1760
1761 \f
1762 ;; should code exactly HTML 3 here when that is finished
1763 (defvar html-tag-alist
1764   (let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7")))
1765          (1-9 `(,@1-7 ("8") ("9")))
1766          (align '(("align" ("left") ("center") ("right"))))
1767          (valign '(("top") ("middle") ("bottom") ("baseline")))
1768          (rel '(("next") ("previous") ("parent") ("subdocument") ("made")))
1769          (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:")
1770                  ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:")
1771                  ("wais:") ("/cgi-bin/")))
1772          (name '("name"))
1773          (link `(,href
1774                  ("rel" ,@rel)
1775                  ("rev" ,@rel)
1776                  ("title")))
1777          (list '((nil \n ("List item: " "<li>" str
1778                           (if sgml-xml-mode "</li>") \n))))
1779          (cell `(t
1780                  ,@align
1781                  ("valign" ,@valign)
1782                  ("colspan" ,@1-9)
1783                  ("rowspan" ,@1-9)
1784                  ("nowrap" t))))
1785     ;; put ,-expressions first, else byte-compile chokes (as of V19.29)
1786     ;; and like this it's more efficient anyway
1787     `(("a" ,name ,@link)
1788       ("base" t ,@href)
1789       ("dir" ,@list)
1790       ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)
1791       ("form" (\n _ \n "<input type=\"submit\" value=\"\""
1792                (if sgml-xml-mode " />" ">"))
1793        ("action" ,@(cdr href)) ("method" ("get") ("post")))
1794       ("h1" ,@align)
1795       ("h2" ,@align)
1796       ("h3" ,@align)
1797       ("h4" ,@align)
1798       ("h5" ,@align)
1799       ("h6" ,@align)
1800       ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align)
1801       ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom"))
1802        ("src") ("alt") ("width" "1") ("height" "1")
1803        ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t))
1804       ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name
1805        ("type" ("text") ("password") ("checkbox") ("radio")
1806         ("submit") ("reset"))
1807        ("value"))
1808       ("link" t ,@link)
1809       ("menu" ,@list)
1810       ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1")))
1811       ("p" t ,@align)
1812       ("select" (nil \n
1813                      ("Text: "
1814                       "<option>" str (if sgml-xml-mode "</option>") \n))
1815        ,name ("size" ,@1-9) ("multiple" t))
1816       ("table" (nil \n
1817                     ((completing-read "Cell kind: " '(("td") ("th"))
1818                                       nil t "t")
1819                      "<tr><" str ?> _
1820                      (if sgml-xml-mode (concat "<" str "></tr>")) \n))
1821        ("border" t ,@1-9) ("width" "10") ("cellpadding"))
1822       ("td" ,@cell)
1823       ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
1824       ("th" ,@cell)
1825       ("ul" ,@list ("type" ("disc") ("circle") ("square")))
1826
1827       ,@sgml-tag-alist
1828
1829       ("abbrev")
1830       ("acronym")
1831       ("address")
1832       ("array" (nil \n
1833                     ("Item: " "<item>" str (if sgml-xml-mode "</item>") \n))
1834        "align")
1835       ("article" \n)
1836       ("aside" \n)
1837       ("au")
1838       ("b")
1839       ("big")
1840       ("blink")
1841       ("blockquote" \n)
1842       ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#")
1843        ("link" "#") ("alink" "#") ("vlink" "#"))
1844       ("box" (nil _ "<over>" _ (if sgml-xml-mode "</over>")))
1845       ("br" t ("clear" ("left") ("right")))
1846       ("caption" ("valign" ("top") ("bottom")))
1847       ("center" \n)
1848       ("cite")
1849       ("code" \n)
1850       ("dd" ,(not sgml-xml-mode))
1851       ("del")
1852       ("dfn")
1853       ("div")
1854       ("dl" (nil \n
1855                  ( "Term: "
1856                    "<dt>" str (if sgml-xml-mode "</dt>")
1857                    "<dd>" _ (if sgml-xml-mode "</dd>") \n)))
1858       ("dt" (t _ (if sgml-xml-mode "</dt>")
1859              "<dd>" (if sgml-xml-mode "</dd>") \n))
1860       ("em")
1861       ("fn" "id" "fn")  ;; Footnotes were deprecated in HTML 3.2
1862       ("footer" \n)
1863       ("head" \n)
1864       ("header" \n)
1865       ("hgroup" \n)
1866       ("html" (\n
1867                "<head>\n"
1868                "<title>" (setq str (read-input "Title: ")) "</title>\n"
1869                "</head>\n"
1870                "<body>\n<h1>" str "</h1>\n" _
1871                "\n<address>\n<a href=\"mailto:"
1872                user-mail-address
1873                "\">" (user-full-name) "</a>\n</address>\n"
1874                "</body>"
1875                 ))
1876       ("i")
1877       ("ins")
1878       ("isindex" t ("action") ("prompt"))
1879       ("kbd")
1880       ("lang")
1881       ("li" ,(not sgml-xml-mode))
1882       ("math" \n)
1883       ("nav" \n)
1884       ("nobr")
1885       ("option" t ("value") ("label") ("selected" t))
1886       ("over" t)
1887       ("person") ;; Tag for person's name tag deprecated in HTML 3.2
1888       ("pre" \n)
1889       ("q")
1890       ("rev")
1891       ("s")
1892       ("samp")
1893       ("section" \n)
1894       ("small")
1895       ("span" nil
1896         ("class"
1897          ("builtin")
1898          ("comment")
1899          ("constant")
1900          ("function-name")
1901          ("keyword")
1902          ("string")
1903          ("type")
1904          ("variable-name")
1905          ("warning")))
1906       ("strong")
1907       ("sub")
1908       ("sup")
1909       ("title")
1910       ("tr" t)
1911       ("tt")
1912       ("u")
1913       ("var")
1914       ("wbr" t)))
1915   "Value of `sgml-tag-alist' for HTML mode.")
1916
1917 (defvar html-tag-help
1918   `(,@sgml-tag-help
1919     ("a" . "Anchor of point or link elsewhere")
1920     ("abbrev" . "Abbreviation")
1921     ("acronym" . "Acronym")
1922     ("address" . "Formatted mail address")
1923     ("array" . "Math array")
1924     ("article" . "An independent part of document or site")
1925     ("aside" . "Secondary content related to surrounding content (e.g. page or article)")
1926     ("au" . "Author")
1927     ("b" . "Bold face")
1928     ("base" . "Base address for URLs")
1929     ("big" . "Font size")
1930     ("blink" . "Blinking text")
1931     ("blockquote" . "Indented quotation")
1932     ("body" . "Document body")
1933     ("box" . "Math fraction")
1934     ("br" . "Line break")
1935     ("caption" . "Table caption")
1936     ("center" . "Centered text")
1937     ("changed" . "Change bars")
1938     ("cite" . "Citation of a document")
1939     ("code" . "Formatted source code")
1940     ("dd" . "Definition of term")
1941     ("del" . "Deleted text")
1942     ("dfn" . "Defining instance of a term")
1943     ("dir" . "Directory list (obsolete)")
1944     ("div" . "Generic block-level container")
1945     ("dl" . "Definition list")
1946     ("dt" . "Term to be defined")
1947     ("em" . "Emphasized")
1948     ("embed" . "Embedded data in foreign format")
1949     ("fig" . "Figure")
1950     ("figa" . "Figure anchor")
1951     ("figd" . "Figure description")
1952     ("figt" . "Figure text")
1953     ("fn" . "Footnote")  ;; No one supports special footnote rendering.
1954     ("font" . "Font size")
1955     ("footer" . "Footer of a section")
1956     ("form" . "Form with input fields")
1957     ("group" . "Document grouping")
1958     ("h1" . "Most important section headline")
1959     ("h2" . "Important section headline")
1960     ("h3" . "Section headline")
1961     ("h4" . "Minor section headline")
1962     ("h5" . "Unimportant section headline")
1963     ("h6" . "Least important section headline")
1964     ("head" . "Document header")
1965     ("header" . "Header of a section")
1966     ("hgroup" . "Group of headings - h1-h6 elements")
1967     ("hr" . "Horizontal rule")
1968     ("html" . "HTML Document")
1969     ("i" . "Italic face")
1970     ("img" . "Graphic image")
1971     ("input" . "Form input field")
1972     ("ins" . "Inserted text")
1973     ("isindex" . "Input field for index search")
1974     ("kbd" . "Keyboard example face")
1975     ("lang" . "Natural language")
1976     ("li" . "List item")
1977     ("link" . "Link relationship")
1978     ("math" . "Math formula")
1979     ("menu" . "List of commands")
1980     ("mh" . "Form mail header")
1981     ("nav" . "Group of navigational links")
1982     ("nextid" . "Allocate new id")
1983     ("nobr" . "Text without line break")
1984     ("ol" . "Ordered list")
1985     ("option" . "Selection list item")
1986     ("over" . "Math fraction rule")
1987     ("p" . "Paragraph start")
1988     ("panel" . "Floating panel")
1989     ("person" . "Person's name")
1990     ("pre" . "Preformatted fixed width text")
1991     ("q" . "Quotation")
1992     ("rev" . "Reverse video")
1993     ("s" . "Strikeout")
1994     ("samp" . "Sample text")
1995     ("section" . "Section of a document")
1996     ("select" . "Selection list")
1997     ("small" . "Font size")
1998     ("sp" . "Nobreak space")
1999     ("span" . "Generic inline container")
2000     ("strong" . "Standout text")
2001     ("sub" . "Subscript")
2002     ("sup" . "Superscript")
2003     ("table" . "Table with rows and columns")
2004     ("tb" . "Table vertical break")
2005     ("td" . "Table data cell")
2006     ("textarea" . "Form multiline edit area")
2007     ("th" . "Table header cell")
2008     ("title" . "Document title")
2009     ("tr" . "Table row separator")
2010     ("tt" . "Typewriter face")
2011     ("u" . "Underlined text")
2012     ("ul" . "Unordered list")
2013     ("var" . "Math variable face")
2014     ("wbr" . "Enable <br> within <nobr>"))
2015   "Value of variable `sgml-tag-help' for HTML mode.")
2016
2017 (defvar outline-regexp)
2018 (defvar outline-heading-end-regexp)
2019 (defvar outline-level)
2020
2021 (defun html-current-defun-name ()
2022   "Return the name of the last HTML title or heading, or nil."
2023   (save-excursion
2024     (if (re-search-backward
2025          (concat
2026           "<[ \t\r\n]*"
2027           "\\(?:[hH][0-6]\\|title\\|TITLE\\|Title\\)"
2028           "[^>]*>"
2029           "[ \t\r\n]*"
2030           "\\([^<\r\n]*[^ <\t\r\n]+\\)")
2031          nil t)
2032         (match-string-no-properties 1))))
2033
2034 \f
2035 ;;;###autoload
2036 (define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML")
2037   "Major mode based on SGML mode for editing HTML documents.
2038 This allows inserting skeleton constructs used in hypertext documents with
2039 completion.  See below for an introduction to HTML.  Use
2040 \\[browse-url-of-buffer] to see how this comes out.  See also `sgml-mode' on
2041 which this is based.
2042
2043 Do \\[describe-variable] html- SPC and \\[describe-variable] sgml- SPC to see available variables.
2044
2045 To write fairly well formatted pages you only need to know few things.  Most
2046 browsers have a function to read the source code of the page being seen, so
2047 you can imitate various tricks.  Here's a very short HTML primer which you
2048 can also view with a browser to see what happens:
2049
2050 <title>A Title Describing Contents</title> should be on every page.  Pages can
2051 have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
2052 <hr> Parts can be separated with horizontal rules.
2053
2054 <p>Paragraphs only need an opening tag.  Line breaks and multiple spaces are
2055 ignored unless the text is <pre>preformatted.</pre>  Text can be marked as
2056 <b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-o or
2057 Edit/Text Properties/Face commands.
2058
2059 Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
2060 to them with <a href=\"#SOMENAME\">see also somename</a>.  In the same way <a
2061 href=\"URL\">see also URL</a> where URL is a filename relative to current
2062 directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'.
2063
2064 Images in many formats can be inlined with <img src=\"URL\">.
2065
2066 If you mainly create your own documents, `sgml-specials' might be
2067 interesting.  But note that some HTML 2 browsers can't handle `&apos;'.
2068 To work around that, do:
2069    (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
2070
2071 \\{html-mode-map}"
2072   (setq-local sgml-display-text html-display-text)
2073   (setq-local sgml-tag-face-alist html-tag-face-alist)
2074   (setq-local sgml-tag-alist html-tag-alist)
2075   (setq-local sgml-face-tag-alist html-face-tag-alist)
2076   (setq-local sgml-tag-help html-tag-help)
2077   (setq-local outline-regexp "^.*<[Hh][1-6]\\>")
2078   (setq-local outline-heading-end-regexp "</[Hh][1-6]>")
2079   (setq-local outline-level
2080               (lambda () (char-before (match-end 0))))
2081   (setq-local add-log-current-defun-function #'html-current-defun-name)
2082   (setq-local sentence-end-base "[.?!][]\"'”)}]*\\(<[^>]*>\\)*")
2083
2084   (setq imenu-create-index-function 'html-imenu-index)
2085
2086   (setq-local sgml-empty-tags
2087               ;; From HTML-4.01's loose.dtd, parsed with
2088               ;; `sgml-parse-dtd', plus manual addition of "wbr".
2089               '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input"
2090                 "isindex" "link" "meta" "param" "wbr"))
2091   (setq-local sgml-unclosed-tags
2092               ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'.
2093               '("body" "colgroup" "dd" "dt" "head" "html" "li" "option"
2094                 "p" "tbody" "td" "tfoot" "th" "thead" "tr"))
2095   ;; It's for the user to decide if it defeats it or not  -stef
2096   ;; (make-local-variable 'imenu-sort-function)
2097   ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
2098   )
2099
2100 (defvar html-imenu-regexp
2101   "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
2102   "A regular expression matching a head line to be added to the menu.
2103 The first `match-string' should be a number from 1-9.
2104 The second `match-string' matches extra tags and is ignored.
2105 The third `match-string' will be the used in the menu.")
2106
2107 (defun html-imenu-index ()
2108   "Return a table of contents for an HTML buffer for use with Imenu."
2109   (let (toc-index)
2110     (save-excursion
2111       (goto-char (point-min))
2112       (while (re-search-forward html-imenu-regexp nil t)
2113         (setq toc-index
2114               (cons (cons (concat (make-string
2115                                    (* 2 (1- (string-to-number (match-string 1))))
2116                                    ?\s)
2117                                   (match-string 3))
2118                           (line-beginning-position))
2119                     toc-index))))
2120     (nreverse toc-index)))
2121
2122 (define-minor-mode html-autoview-mode
2123   "Toggle viewing of HTML files on save (HTML Autoview mode).
2124 With a prefix argument ARG, enable HTML Autoview mode if ARG is
2125 positive, and disable it otherwise.  If called from Lisp, enable
2126 the mode if ARG is omitted or nil.
2127
2128 HTML Autoview mode is a buffer-local minor mode for use with
2129 `html-mode'.  If enabled, saving the file automatically runs
2130 `browse-url-of-buffer' to view it."
2131   nil nil nil
2132   :group 'sgml
2133   (if html-autoview-mode
2134       (add-hook 'after-save-hook 'browse-url-of-buffer nil t)
2135     (remove-hook 'after-save-hook 'browse-url-of-buffer t)))
2136
2137 \f
2138 (define-skeleton html-href-anchor
2139   "HTML anchor tag with href attribute."
2140   "URL: "
2141   ;; '(setq input "http:")
2142   "<a href=\"" str "\">" _ "</a>")
2143
2144 (define-skeleton html-name-anchor
2145   "HTML anchor tag with name attribute."
2146   "Name: "
2147   "<a name=\"" str "\""
2148   (if sgml-xml-mode (concat " id=\"" str "\""))
2149   ">" _ "</a>")
2150
2151 (define-skeleton html-headline-1
2152   "HTML level 1 headline tags."
2153   nil
2154   "<h1>" _ "</h1>")
2155
2156 (define-skeleton html-headline-2
2157   "HTML level 2 headline tags."
2158   nil
2159   "<h2>" _ "</h2>")
2160
2161 (define-skeleton html-headline-3
2162   "HTML level 3 headline tags."
2163   nil
2164   "<h3>" _ "</h3>")
2165
2166 (define-skeleton html-headline-4
2167   "HTML level 4 headline tags."
2168   nil
2169   "<h4>" _ "</h4>")
2170
2171 (define-skeleton html-headline-5
2172   "HTML level 5 headline tags."
2173   nil
2174   "<h5>" _ "</h5>")
2175
2176 (define-skeleton html-headline-6
2177   "HTML level 6 headline tags."
2178   nil
2179   "<h6>" _ "</h6>")
2180
2181 (define-skeleton html-horizontal-rule
2182   "HTML horizontal rule tag."
2183   nil
2184   (if sgml-xml-mode "<hr />" "<hr>") \n)
2185
2186 (define-skeleton html-image
2187   "HTML image tag."
2188   "Image URL: "
2189   "<img src=\"" str "\" alt=\"" _ "\""
2190   (if sgml-xml-mode " />" ">"))
2191
2192 (define-skeleton html-line
2193   "HTML line break tag."
2194   nil
2195   (if sgml-xml-mode "<br />" "<br>") \n)
2196
2197 (define-skeleton html-ordered-list
2198   "HTML ordered list tags."
2199   nil
2200   "<ol>" \n
2201   "<li>" _ (if sgml-xml-mode "</li>") \n
2202   "</ol>")
2203
2204 (define-skeleton html-unordered-list
2205   "HTML unordered list tags."
2206   nil
2207   "<ul>" \n
2208   "<li>" _ (if sgml-xml-mode "</li>") \n
2209   "</ul>")
2210
2211 (define-skeleton html-list-item
2212   "HTML list item tag."
2213   nil
2214   (if (bolp) nil '\n)
2215   "<li>" _ (if sgml-xml-mode "</li>"))
2216
2217 (define-skeleton html-paragraph
2218   "HTML paragraph tag."
2219   nil
2220   (if (bolp) nil ?\n)
2221   "<p>" _ (if sgml-xml-mode "</p>"))
2222
2223 (define-skeleton html-checkboxes
2224   "Group of connected checkbox inputs."
2225   nil
2226   '(setq v1 nil
2227          v2 nil)
2228   ("Value: "
2229    "<input type=\"" (identity "checkbox") ; see comment above about identity
2230    "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
2231    "\" value=\"" str ?\"
2232    (when (y-or-n-p "Set \"checked\" attribute? ")
2233      (funcall skeleton-transformation-function
2234               (if sgml-xml-mode " checked=\"checked\"" " checked")))
2235    (if sgml-xml-mode " />" ">")
2236    (skeleton-read "Text: " (capitalize str))
2237    (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
2238                        (funcall skeleton-transformation-function
2239                                 (if sgml-xml-mode "<br />" "<br>"))
2240                      "")))
2241    \n))
2242
2243 (define-skeleton html-radio-buttons
2244   "Group of connected radio button inputs."
2245   nil
2246   '(setq v1 nil
2247          v2 (cons nil nil))
2248   ("Value: "
2249    "<input type=\"" (identity "radio") ; see comment above about identity
2250    "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
2251    "\" value=\"" str ?\"
2252    (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
2253      (funcall skeleton-transformation-function
2254               (if sgml-xml-mode " checked=\"checked\"" " checked")))
2255    (if sgml-xml-mode " />" ">")
2256    (skeleton-read "Text: " (capitalize str))
2257    (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
2258                                (funcall skeleton-transformation-function
2259                                         (if sgml-xml-mode "<br />" "<br>"))
2260                              "")))
2261    \n))
2262
2263 (define-skeleton html-navigational-links
2264   "Group of navigational links."
2265   nil
2266   "<nav>" \n
2267   "<ul>" \n
2268   "<li><a href=\"" (skeleton-read "URL: " "#") "\">"
2269   (skeleton-read "Title: ") "</a>"
2270   (if sgml-xml-mode (if sgml-xml-mode "</li>")) \n
2271   "</ul>" \n
2272   "</nav>")
2273
2274 (define-skeleton html-html5-template
2275   "Initial HTML5 template"
2276   nil
2277   "<!DOCTYPE html>" \n
2278   "<html lang=\"en\">" \n
2279   "<head>" \n
2280   "<meta charset=\"utf-8\">" \n
2281   "<meta http-equiv=\"X-UA-Compatible\" content=\"IE=edge\">" \n
2282   "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">" \n
2283   "<title>" (skeleton-read "Page Title: ") "</title>" \n
2284   "</head>" \n
2285   "<body>" \n
2286   "<div id=\"app\"></div>" \n
2287   "</body>" \n
2288   "</html>")
2289
2290 (provide 'sgml-mode)
2291
2292 ;;; sgml-mode.el ends here