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

   1 ;;; sgml-mode.el --- SGML- and HTML-editing modes
   2
   3 ;; Copyright (C) 1992,95,96,98,2001,2002  Free Software Foundation, Inc.
   4
   5 ;; Author: James Clark <jjc@jclark.com>
   6 ;; Maintainer: FSF
   7 ;; Adapted-By: ESR, Daniel Pfeiffer <occitan@esperanto.org>,
   8 ;;             F.Potorti@cnuce.cnr.it
   9 ;; Keywords: wp, hypermedia, comm, languages
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; Configurable major mode for editing document in the SGML standard general
  31 ;; markup language.  As an example contains a mode for editing the derived
  32 ;; HTML hypertext markup language.
  33
  34 ;;; Code:
  35
  36 (eval-when-compile
  37   (require 'skeleton)
  38   (require 'outline))
  39
  40 (defgroup sgml nil
  41   "SGML editing mode"
  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-transformation 'identity
  50   "*Default value for `skeleton-transformation' (which see) in SGML mode."
  51   :type 'function
  52   :group 'sgml)
  53
  54 (put 'sgml-transformation 'variable-interactive
  55      "aTransformation function: ")
  56
  57 (defcustom sgml-mode-hook nil
  58   "Hook run by command `sgml-mode'.
  59 `text-mode-hook' is run first."
  60   :group 'sgml
  61   :type 'hook)
  62
  63 ;; As long as Emacs' syntax can't be complemented with predicates to context
  64 ;; sensitively confirm the syntax of characters, we have to live with this
  65 ;; kludgy kind of tradeoff.
  66 (defvar sgml-specials '(?\")
  67   "List of characters that have a special meaning for SGML mode.
  68 This list is used when first loading the `sgml-mode' library.
  69 The supported characters and potential disadvantages are:
  70
  71   ?\\\" Makes \" in text start a string.
  72   ?'    Makes ' in text start a string.
  73   ?-    Makes -- in text start a comment.
  74
  75 When only one of ?\\\" or ?' are included, \"'\" or '\"', as can be found in
  76 DTDs, start a string.  To partially avoid this problem this also makes these
  77 self insert as named entities depending on `sgml-quick-keys'.
  78
  79 Including ?- has the problem of affecting dashes that have nothing to do
  80 with comments, so we normally turn it off.")
  81
  82 (defvar sgml-quick-keys nil
  83   "Use <, >, &, SPC and `sgml-specials' keys \"electrically\" when non-nil.
  84 This takes effect when first loading the `sgml-mode' library.")
  85
  86
  87 (defvar sgml-mode-map
  88   (let ((map (make-keymap))     ;`sparse' doesn't allow binding to charsets.
  89         (menu-map (make-sparse-keymap "SGML")))
  90     (define-key map "\C-c\C-i" 'sgml-tags-invisible)
  91     (define-key map "/" 'sgml-slash)
  92     (define-key map "\C-c\C-n" 'sgml-name-char)
  93     (define-key map "\C-c\C-t" 'sgml-tag)
  94     (define-key map "\C-c\C-a" 'sgml-attributes)
  95     (define-key map "\C-c\C-b" 'sgml-skip-tag-backward)
  96     (define-key map [?\C-c left] 'sgml-skip-tag-backward)
  97     (define-key map "\C-c\C-f" 'sgml-skip-tag-forward)
  98     (define-key map [?\C-c right] 'sgml-skip-tag-forward)
  99     (define-key map "\C-c\C-d" 'sgml-delete-tag)
 100     (define-key map "\C-c\^?" 'sgml-delete-tag)
 101     (define-key map "\C-c?" 'sgml-tag-help)
 102     (define-key map "\C-c8" 'sgml-name-8bit-mode)
 103     (define-key map "\C-c\C-v" 'sgml-validate)
 104     (when sgml-quick-keys
 105       (define-key map "&" 'sgml-name-char)
 106       (define-key map "<" 'sgml-tag)
 107       (define-key map " " 'sgml-auto-attributes)
 108       (define-key map ">" 'sgml-maybe-end-tag)
 109       (when (memq ?\" sgml-specials)
 110         (define-key map "\"" 'sgml-name-self))
 111       (when (memq ?' sgml-specials)
 112         (define-key map "'" 'sgml-name-self)))
 113     (define-key map (vector (make-char 'latin-iso8859-1))
 114       'sgml-maybe-name-self)
 115     (let ((c 127)
 116           (map (nth 1 map)))
 117       (while (< (setq c (1+ c)) 256)
 118         (aset map c 'sgml-maybe-name-self)))
 119     (define-key map [menu-bar sgml] (cons "SGML" menu-map))
 120     (define-key menu-map [sgml-validate] '("Validate" . sgml-validate))
 121     (define-key menu-map [sgml-name-8bit-mode]
 122       '("Toggle 8 Bit Insertion" . sgml-name-8bit-mode))
 123     (define-key menu-map [sgml-tags-invisible]
 124       '("Toggle Tag Visibility" . sgml-tags-invisible))
 125     (define-key menu-map [sgml-tag-help]
 126       '("Describe Tag" . sgml-tag-help))
 127     (define-key menu-map [sgml-delete-tag]
 128       '("Delete Tag" . sgml-delete-tag))
 129     (define-key menu-map [sgml-skip-tag-forward]
 130       '("Forward Tag" . sgml-skip-tag-forward))
 131     (define-key menu-map [sgml-skip-tag-backward]
 132       '("Backward Tag" . sgml-skip-tag-backward))
 133     (define-key menu-map [sgml-attributes]
 134       '("Insert Attributes" . sgml-attributes))
 135     (define-key menu-map [sgml-tag] '("Insert Tag" . sgml-tag))
 136     map)
 137   "Keymap for SGML mode.  See also `sgml-specials'.")
 138
 139
 140 (defun sgml-make-syntax-table (specials)
 141   (let ((table (make-syntax-table text-mode-syntax-table)))
 142     (modify-syntax-entry ?< "(>" table)
 143     (modify-syntax-entry ?> ")<" table)
 144     (modify-syntax-entry ?: "_" table)
 145     (modify-syntax-entry ?_ "_" table)
 146     (modify-syntax-entry ?. "_" table)
 147     (if (memq ?- specials)
 148         (modify-syntax-entry ?- "_ 1234" table))
 149     (if (memq ?\" specials)
 150         (modify-syntax-entry ?\" "\"\"" table))
 151     (if (memq ?' specials)
 152         (modify-syntax-entry ?\' "\"'" table))
 153     table))
 154
 155 (defvar sgml-mode-syntax-table (sgml-make-syntax-table sgml-specials)
 156   "Syntax table used in SGML mode.  See also `sgml-specials'.")
 157
 158 (defconst sgml-tag-syntax-table
 159   (let ((table (sgml-make-syntax-table '(?- ?\" ?\'))))
 160     (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/))
 161       (modify-syntax-entry char "." table))
 162     table)
 163   "Syntax table used to parse SGML tags.")
 164
 165
 166 (defcustom sgml-name-8bit-mode nil
 167   "*When non-nil, insert non-ASCII characters as named entities."
 168   :type 'boolean
 169   :group 'sgml)
 170
 171 (defvar sgml-char-names
 172   [nil nil nil nil nil nil nil nil
 173    nil nil nil nil nil nil nil nil
 174    nil nil nil nil nil nil nil nil
 175    nil nil nil nil nil nil nil nil
 176    "nbsp" "excl" "quot" "num" "dollar" "percnt" "amp" "apos"
 177    "lpar" "rpar" "ast" "plus" "comma" "hyphen" "period" "sol"
 178    nil nil nil nil nil nil nil nil
 179    nil nil "colon" "semi" "lt" "eq" "gt" "quest"
 180    "commat" nil nil nil nil nil nil nil
 181    nil nil nil nil nil nil nil nil
 182    nil nil nil nil nil nil nil nil
 183    nil nil nil "lsqb" nil "rsqb" "uarr" "lowbar"
 184    "lsquo" nil nil nil nil nil nil nil
 185    nil nil nil nil nil nil nil nil
 186    nil nil nil nil nil nil nil nil
 187    nil nil nil "lcub" "verbar" "rcub" "tilde" nil
 188    nil nil nil nil nil nil nil nil
 189    nil nil nil nil nil nil nil nil
 190    nil nil nil nil nil nil nil nil
 191    nil nil nil nil nil nil nil nil
 192    "nbsp" "iexcl" "cent" "pound" "curren" "yen" "brvbar" "sect"
 193    "uml" "copy" "ordf" "laquo" "not" "shy" "reg" "macr"
 194    "ring" "plusmn" "sup2" "sup3" "acute" "micro" "para" "middot"
 195    "cedil" "sup1" "ordm" "raquo" "frac14" "frac12" "frac34" "iquest"
 196    "Agrave" "Aacute" "Acirc" "Atilde" "Auml" "Aring" "AElig" "Ccedil"
 197    "Egrave" "Eacute" "Ecirc" "Euml" "Igrave" "Iacute" "Icirc" "Iuml"
 198    "ETH" "Ntilde" "Ograve" "Oacute" "Ocirc" "Otilde" "Ouml" nil
 199    "Oslash" "Ugrave" "Uacute" "Ucirc" "Uuml" "Yacute" "THORN" "szlig"
 200    "agrave" "aacute" "acirc" "atilde" "auml" "aring" "aelig" "ccedil"
 201    "egrave" "eacute" "ecirc" "euml" "igrave" "iacute" "icirc" "iuml"
 202    "eth" "ntilde" "ograve" "oacute" "ocirc" "otilde" "ouml" "divide"
 203    "oslash" "ugrave" "uacute" "ucirc" "uuml" "yacute" "thorn" "yuml"]
 204   "Vector of symbolic character names without `&' and `;'.")
 205
 206 (put 'sgml-table 'char-table-extra-slots 0)
 207
 208 (defvar sgml-char-names-table
 209   (let ((table (make-char-table 'sgml-table))
 210         (i 32)
 211         elt)
 212     (while (< i 256)
 213       (setq elt (aref sgml-char-names i))
 214       (if elt (aset table (make-char 'latin-iso8859-1 i) elt))
 215       (setq i (1+ i)))
 216     table)
 217   "A table for mapping non-ASCII characters into SGML entity names.
 218 Currently, only Latin-1 characters are supported.")
 219
 220
 221 ;; nsgmls is a free SGML parser in the SP suite available from
 222 ;; ftp.jclark.com and otherwise packaged for GNU systems.
 223 ;; Its error messages can be parsed by next-error.
 224 ;; The -s option suppresses output.
 225
 226 (defcustom sgml-validate-command "nsgmls -s" ; replaced old `sgmls'
 227   "*The command to validate an SGML document.
 228 The file name of current buffer file name will be appended to this,
 229 separated by a space."
 230   :type 'string
 231   :version "21.1"
 232   :group 'sgml)
 233
 234 (defvar sgml-saved-validate-command nil
 235   "The command last used to validate in this buffer.")
 236
 237
 238 ;; I doubt that null end tags are used much for large elements,
 239 ;; so use a small distance here.
 240 (defcustom sgml-slash-distance 1000
 241   "*If non-nil, is the maximum distance to search for matching `/'."
 242   :type '(choice (const nil) integer)
 243   :group 'sgml)
 244
 245 (defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*")
 246 (defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)"))
 247 (defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*")
 248 (defconst sgml-start-tag-regex (concat "<" sgml-name-re sgml-attrs-re)
 249   "Regular expression that matches a non-empty start tag.
 250 Any terminating `>' or `/' is not matched.")
 251
 252
 253 ;; internal
 254 (defconst sgml-font-lock-keywords-1
 255   `((,(concat "<\\([!?]" sgml-name-re "\\)") 1 font-lock-keyword-face)
 256     (,(concat "<\\(/?" sgml-name-re"\\)") 1 font-lock-function-name-face)
 257     ;; FIXME: this doesn't cover the variables using a default value.
 258     (,(concat "\\(" sgml-name-re "\\)=[\"']") 1 font-lock-variable-name-face)
 259     (,(concat "[&%]" sgml-name-re ";?") . font-lock-variable-name-face)))
 260
 261 (defconst sgml-font-lock-keywords-2
 262   (append
 263    sgml-font-lock-keywords-1
 264    '((eval
 265       . (cons (concat "<"
 266                       (regexp-opt (mapcar 'car sgml-tag-face-alist) t)
 267                       "\\([ \t][^>]*\\)?>\\([^<]+\\)</\\1>")
 268               '(3 (cdr (assoc (downcase (match-string 1))
 269                               sgml-tag-face-alist))))))))
 270
 271 ;; for font-lock, but must be defvar'ed after
 272 ;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above
 273 (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
 274   "*Rules for highlighting SGML code.  See also `sgml-tag-face-alist'.")
 275
 276 (defvar sgml-font-lock-syntactic-keywords
 277   ;; Use the `b' style of comments to avoid interference with the -- ... --
 278   ;; comments recognized when `sgml-specials' includes ?-.
 279   ;; FIXME: beware of <!--> blabla <!--> !!
 280   '(("\\(<\\)!--" (1 "< b"))
 281     ("--[ \t\n]*\\(>\\)" (1 "> b")))
 282   "Syntactic keywords for `sgml-mode'.")
 283
 284 ;; internal
 285 (defvar sgml-face-tag-alist ()
 286   "Alist of face and tag name for facemenu.")
 287
 288 (defvar sgml-tag-face-alist ()
 289   "Tag names and face or list of faces to fontify with when invisible.
 290 When `font-lock-maximum-decoration' is 1 this is always used for fontifying.
 291 When more these are fontified together with `sgml-font-lock-keywords'.")
 292
 293
 294 (defvar sgml-display-text ()
 295   "Tag names as lowercase symbols, and display string when invisible.")
 296
 297 ;; internal
 298 (defvar sgml-tags-invisible nil)
 299
 300
 301 (defcustom sgml-tag-alist
 302   '(("![" ("ignore" t) ("include" t))
 303     ("!attlist")
 304     ("!doctype")
 305     ("!element")
 306     ("!entity"))
 307   "*Alist of tag names for completing read and insertion rules.
 308 This alist is made up as
 309
 310   ((\"tag\" . TAGRULE)
 311    ...)
 312
 313 TAGRULE is a list of optionally `t' (no endtag) or `\\n' (separate endtag by
 314 newlines) or a skeleton with `nil', `t' or `\\n' in place of the interactor
 315 followed by an ATTRIBUTERULE (for an always present attribute) or an
 316 attribute alist.
 317
 318 The attribute alist is made up as
 319
 320   ((\"attribute\" . ATTRIBUTERULE)
 321    ...)
 322
 323 ATTRIBUTERULE is a list of optionally `t' (no value when no input) followed by
 324 an optional alist of possible values."
 325   :type '(repeat (cons (string :tag "Tag Name")
 326                        (repeat :tag "Tag Rule" sexp)))
 327   :group 'sgml)
 328
 329 (defcustom sgml-tag-help
 330   '(("!" . "Empty declaration for comment")
 331     ("![" . "Embed declarations with parser directive")
 332     ("!attlist" . "Tag attributes declaration")
 333     ("!doctype" . "Document type (DTD) declaration")
 334     ("!element" . "Tag declaration")
 335     ("!entity" . "Entity (macro) declaration"))
 336   "*Alist of tag name and short description."
 337   :type '(repeat (cons (string :tag "Tag Name")
 338                        (string :tag "Description")))
 339   :group 'sgml)
 340
 341 (defcustom sgml-xml-mode nil
 342   "*When non-nil, tag insertion functions will be XML-compliant.
 343 If this variable is customized, the custom value is used always.
 344 Otherwise, it is set to be buffer-local when the file has
 345  a DOCTYPE or an XML declaration."
 346   :type 'boolean
 347   :version "21.2"
 348   :group 'sgml)
 349
 350 (defvar sgml-empty-tags nil
 351   "List of tags whose !ELEMENT definition says EMPTY.")
 352
 353 (defvar sgml-unclosed-tags nil
 354   "List of tags whose !ELEMENT definition says the end-tag is optional.")
 355
 356 (defun sgml-xml-guess ()
 357   "Guess whether the current buffer is XML."
 358   (save-excursion
 359     (goto-char (point-min))
 360     (when (or (string= "xml" (file-name-extension (or buffer-file-name "")))
 361               (looking-at "\\s-*<\\?xml")
 362               (when (re-search-forward
 363                      (eval-when-compile
 364                        (mapconcat 'identity
 365                                   '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"
 366                                     "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
 367                                   "\\s-+"))
 368                      nil t)
 369                 (string-match "X\\(HT\\)?ML" (match-string 3))))
 370       (set (make-local-variable 'sgml-xml-mode) t))))
 371
 372 (defvar v2)                             ; free for skeleton
 373
 374 (defun sgml-mode-facemenu-add-face-function (face end)
 375   (if (setq face (cdr (assq face sgml-face-tag-alist)))
 376       (progn
 377         (setq face (funcall skeleton-transformation face))
 378         (setq facemenu-end-add-face (concat "</" face ">"))
 379         (concat "<" face ">"))
 380     (error "Face not configured for %s mode" mode-name)))
 381
 382
 383 ;;;###autoload
 384 (define-derived-mode sgml-mode text-mode "SGML"
 385   "Major mode for editing SGML documents.
 386 Makes > match <.
 387 Keys <, &, SPC within <>, \" and ' can be electric depending on
 388 `sgml-quick-keys'.
 389
 390 An argument of N to a tag-inserting command means to wrap it around
 391 the next N words.  In Transient Mark mode, when the mark is active,
 392 N defaults to -1, which means to wrap it around the current region.
 393
 394 If you like upcased tags, put (setq sgml-transformation 'upcase) in
 395 your `.emacs' file.
 396
 397 Use \\[sgml-validate] to validate your document with an SGML parser.
 398
 399 Do \\[describe-variable] sgml- SPC to see available variables.
 400 Do \\[describe-key] on the following bindings to discover what they do.
 401 \\{sgml-mode-map}"
 402   (make-local-variable 'sgml-saved-validate-command)
 403   (make-local-variable 'facemenu-end-add-face)
 404   ;;(make-local-variable 'facemenu-remove-face-function)
 405   ;; A start or end tag by itself on a line separates a paragraph.
 406   ;; This is desirable because SGML discards a newline that appears
 407   ;; immediately after a start tag or immediately before an end tag.
 408   (set (make-local-variable 'paragraph-start) (concat "[ \t]*$\\|\
 409 \[ \t]*</?\\(" sgml-name-re sgml-attrs-re "\\)?>"))
 410   (set (make-local-variable 'paragraph-separate)
 411        (concat paragraph-start "$"))
 412   (set (make-local-variable 'adaptive-fill-regexp) "[ \t]*")
 413   (set (make-local-variable 'comment-start) "<!-- ")
 414   (set (make-local-variable 'comment-end) " -->")
 415   (set (make-local-variable 'comment-indent-function) 'sgml-comment-indent)
 416   (set (make-local-variable 'skeleton-further-elements)
 417        '((completion-ignore-case t)))
 418   (set (make-local-variable 'skeleton-end-hook)
 419        (lambda ()
 420          (or (eolp)
 421              (not (or (eq v2 '\n) (eq (car-safe v2) '\n)))
 422              (newline-and-indent))))
 423   (set (make-local-variable 'font-lock-defaults)
 424        '((sgml-font-lock-keywords
 425           sgml-font-lock-keywords-1
 426           sgml-font-lock-keywords-2)
 427          nil t nil nil
 428          (font-lock-syntactic-keywords
 429           . sgml-font-lock-syntactic-keywords)))
 430   (set (make-local-variable 'facemenu-add-face-function)
 431        'sgml-mode-facemenu-add-face-function)
 432   (sgml-xml-guess)
 433   (if sgml-xml-mode
 434       (setq mode-name "XML")
 435     (set (make-local-variable 'skeleton-transformation) sgml-transformation))
 436   ;; This will allow existing comments within declarations to be
 437   ;; recognized.
 438   (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
 439   (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
 440   ;; This definition probably is not useful in derived modes.
 441   (set (make-local-variable 'imenu-generic-expression)
 442        (concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
 443                sgml-name-re "\\)")))
 444
 445
 446 (defun sgml-comment-indent ()
 447   (if (looking-at "--") comment-column 0))
 448
 449
 450
 451 (defun sgml-slash (arg)
 452   "Insert `/' and display any previous matching `/'.
 453 Two `/'s are treated as matching if the first `/' ends a net-enabling
 454 start tag, and the second `/' is the corresponding null end tag."
 455   (interactive "p")
 456   (insert-char ?/ arg)
 457   (if (> arg 0)
 458       (let ((oldpos (point))
 459             (blinkpos)
 460             (level 0))
 461         (save-excursion
 462           (save-restriction
 463             (if sgml-slash-distance
 464                 (narrow-to-region (max (point-min)
 465                                        (- (point) sgml-slash-distance))
 466                                   oldpos))
 467             (if (and (re-search-backward sgml-start-tag-regex (point-min) t)
 468                      (eq (match-end 0) (1- oldpos)))
 469                 ()
 470               (goto-char (1- oldpos))
 471               (while (and (not blinkpos)
 472                           (search-backward "/" (point-min) t))
 473                 (let ((tagend (save-excursion
 474                                 (if (re-search-backward sgml-start-tag-regex
 475                                                         (point-min) t)
 476                                     (match-end 0)
 477                                   nil))))
 478                   (if (eq tagend (point))
 479                       (if (eq level 0)
 480                           (setq blinkpos (point))
 481                         (setq level (1- level)))
 482                     (setq level (1+ level)))))))
 483           (when blinkpos
 484             (goto-char blinkpos)
 485             (if (pos-visible-in-window-p)
 486                 (sit-for 1)
 487               (message "Matches %s"
 488                        (buffer-substring (line-beginning-position)
 489                                          (1+ blinkpos)))))))))
 490
 491
 492 ;; Why doesn't this use the iso-cvt table or, preferably, generate the
 493 ;; inverse of the extensive table in the SGML Quail input method?  -- fx
 494 ;; I guess that's moot since it only works with Latin-1 anyhow.
 495 (defun sgml-name-char (&optional char)
 496   "Insert a symbolic character name according to `sgml-char-names'.
 497 Non-ASCII chars may be inserted either with the meta key, as in M-SPC for
 498 no-break space or M-- for a soft hyphen; or via an input method or
 499 encoded keyboard operation."
 500   (interactive "*")
 501   (insert ?&)
 502   (or char
 503       (setq char (read-quoted-char "Enter char or octal number")))
 504   (delete-backward-char 1)
 505   (insert char)
 506   (undo-boundary)
 507   (delete-backward-char 1)
 508   (cond
 509    ((< char 256)
 510     (insert ?&
 511             (or (aref sgml-char-names char)
 512                 (format "#%d" char))
 513             ?\;))
 514    ((aref sgml-char-names-table char)
 515     (insert ?& (aref sgml-char-names-table char) ?\;))
 516    ((let ((c (encode-char char 'ucs)))
 517       (when c
 518         (insert (format "&#%d;" c))
 519         t)))
 520    (t                                   ; should be an error?  -- fx
 521     (insert char))))
 522
 523 (defun sgml-name-self ()
 524   "Insert a symbolic character name according to `sgml-char-names'."
 525   (interactive "*")
 526   (sgml-name-char last-command-char))
 527
 528 (defun sgml-maybe-name-self ()
 529   "Insert a symbolic character name according to `sgml-char-names'."
 530   (interactive "*")
 531   (if sgml-name-8bit-mode
 532       (let ((mc last-command-char))
 533         (if (< mc 256)
 534             (setq mc (unibyte-char-to-multibyte mc)))
 535         (or mc (setq mc last-command-char))
 536         (sgml-name-char mc))
 537     (self-insert-command 1)))
 538
 539 (defun sgml-name-8bit-mode ()
 540   "Toggle whether to insert named entities instead of non-ASCII characters.
 541 This only works for Latin-1 input."
 542   (interactive)
 543   (setq sgml-name-8bit-mode (not sgml-name-8bit-mode))
 544   (message "sgml name entity mode is now %s"
 545            (if sgml-name-8bit-mode "ON" "OFF")))
 546
 547 ;; When an element of a skeleton is a string "str", it is passed
 548 ;; through skeleton-transformation and inserted.  If "str" is to be
 549 ;; inserted literally, one should obtain it as the return value of a
 550 ;; function, e.g. (identity "str").
 551
 552 (define-skeleton sgml-tag
 553   "Prompt for a tag and insert it, optionally with attributes.
 554 Completion and configuration are done according to `sgml-tag-alist'.
 555 If you like tags and attributes in uppercase do \\[set-variable]
 556 skeleton-transformation RET upcase RET, or put this in your `.emacs':
 557   (setq sgml-transformation 'upcase)"
 558   (funcall skeleton-transformation
 559            (completing-read "Tag: " sgml-tag-alist))
 560   ?< str |
 561   (("") -1 '(undo-boundary) (identity "&lt;")) |        ; see comment above
 562   `(("") '(setq v2 (sgml-attributes ,str t)) ?>
 563     (cond
 564      ((string= "![" ,str)
 565       (backward-char)
 566       '(("") " [ " _ " ]]"))
 567      ((and (eq v2 t) sgml-xml-mode (member ,str sgml-empty-tags))
 568       '(("") -1 "/>"))
 569      ((or (and (eq v2 t) (not sgml-xml-mode)) (string-match "^[/!?]" ,str))
 570       nil)
 571      ((symbolp v2)
 572       ;; Make sure we don't fall into an infinite loop.
 573       ;; For xhtml's `tr' tag, we should maybe use \n instead.
 574       (if (eq v2 t) (setq v2 nil))
 575       ;; We use `identity' to prevent skeleton from passing
 576       ;; `str' through skeleton-transformation a second time.
 577       '(("") v2 _ v2 "</" (identity ',str) ?>))
 578      ((eq (car v2) t)
 579       (cons '("") (cdr v2)))
 580      (t
 581       (append '(("") (car v2))
 582               (cdr v2)
 583               '(resume: (car v2) _ "</" (identity ',str) ?>))))))
 584
 585 (autoload 'skeleton-read "skeleton")
 586
 587 (defun sgml-attributes (tag &optional quiet)
 588   "When at top level of a tag, interactively insert attributes.
 589
 590 Completion and configuration of TAG are done according to `sgml-tag-alist'.
 591 If QUIET, do not print a message when there are no attributes for TAG."
 592   (interactive (list (save-excursion (sgml-beginning-of-tag t))))
 593   (or (stringp tag) (error "Wrong context for adding attribute"))
 594   (if tag
 595       (let ((completion-ignore-case t)
 596             (alist (cdr (assoc (downcase tag) sgml-tag-alist)))
 597             car attribute i)
 598         (if (or (symbolp (car alist))
 599                 (symbolp (car (car alist))))
 600             (setq car (car alist)
 601                   alist (cdr alist)))
 602         (or quiet
 603             (message "No attributes configured."))
 604         (if (stringp (car alist))
 605             (progn
 606               (insert (if (eq (preceding-char) ? ) "" ? )
 607                       (funcall skeleton-transformation (car alist)))
 608               (sgml-value alist))
 609           (setq i (length alist))
 610           (while (> i 0)
 611             (insert ? )
 612             (insert (funcall skeleton-transformation
 613                              (setq attribute
 614                                    (skeleton-read '(completing-read
 615                                                     "Attribute: "
 616                                                     alist)))))
 617             (if (string= "" attribute)
 618                 (setq i 0)
 619               (sgml-value (assoc (downcase attribute) alist))
 620               (setq i (1- i))))
 621           (if (eq (preceding-char) ? )
 622               (delete-backward-char 1)))
 623         car)))
 624
 625 (defun sgml-auto-attributes (arg)
 626   "Self insert the character typed; at top level of tag, prompt for attributes.
 627 With prefix argument, only self insert."
 628   (interactive "*P")
 629   (let ((point (point))
 630         tag)
 631     (if (or arg
 632             (not sgml-tag-alist)        ; no message when nothing configured
 633             (symbolp (setq tag (save-excursion (sgml-beginning-of-tag t))))
 634             (eq (aref tag 0) ?/))
 635         (self-insert-command (prefix-numeric-value arg))
 636       (sgml-attributes tag)
 637       (setq last-command-char ? )
 638       (or (> (point) point)
 639           (self-insert-command 1)))))
 640
 641
 642 (defun sgml-tag-help (&optional tag)
 643   "Display description of tag TAG.  If TAG is omitted, use the tag at point."
 644   (interactive)
 645   (or tag
 646       (save-excursion
 647         (if (eq (following-char) ?<)
 648             (forward-char))
 649         (setq tag (sgml-beginning-of-tag))))
 650   (or (stringp tag)
 651       (error "No tag selected"))
 652   (setq tag (downcase tag))
 653   (message "%s"
 654            (or (cdr (assoc (downcase tag) sgml-tag-help))
 655                (and (eq (aref tag 0) ?/)
 656                     (cdr (assoc (downcase (substring tag 1)) sgml-tag-help)))
 657                "No description available")))
 658
 659
 660 (defun sgml-maybe-end-tag (&optional arg)
 661   "Name self unless in position to end a tag or a prefix ARG is given."
 662   (interactive "P")
 663   (if (or arg (eq (car (sgml-lexical-context)) 'tag))
 664       (self-insert-command (prefix-numeric-value arg))
 665     (sgml-name-self)))
 666
 667 (defun sgml-skip-tag-backward (arg)
 668   "Skip to beginning of tag or matching opening tag if present.
 669 With prefix argument ARG, repeat this ARG times."
 670   (interactive "p")
 671   (while (>= arg 1)
 672     (search-backward "<" nil t)
 673     (if (looking-at "</\\([^ \n\t>]+\\)")
 674         ;; end tag, skip any nested pairs
 675         (let ((case-fold-search t)
 676               (re (concat "</?" (regexp-quote (match-string 1)))))
 677           (while (and (re-search-backward re nil t)
 678                       (eq (char-after (1+ (point))) ?/))
 679             (forward-char 1)
 680             (sgml-skip-tag-backward 1))))
 681     (setq arg (1- arg))))
 682
 683 (defun sgml-skip-tag-forward (arg &optional return)
 684   "Skip to end of tag or matching closing tag if present.
 685 With prefix argument ARG, repeat this ARG times.
 686 Return t iff after a closing tag."
 687   (interactive "p")
 688   (setq return t)
 689   (while (>= arg 1)
 690     (skip-chars-forward "^<>")
 691     (if (eq (following-char) ?>)
 692         (up-list -1))
 693     (if (looking-at "<\\([^/ \n\t>]+\\)")
 694         ;; start tag, skip any nested same pairs _and_ closing tag
 695         (let ((case-fold-search t)
 696               (re (concat "</?" (regexp-quote (match-string 1))))
 697               point close)
 698           (forward-list 1)
 699           (setq point (point))
 700           (while (and (re-search-forward re nil t)
 701                       (not (setq close
 702                                  (eq (char-after (1+ (match-beginning 0))) ?/)))
 703                       (not (up-list -1))
 704                       (sgml-skip-tag-forward 1))
 705             (setq close nil))
 706           (if close
 707               (up-list 1)
 708             (goto-char point)
 709             (setq return)))
 710       (forward-list 1))
 711     (setq arg (1- arg)))
 712   return)
 713
 714 (defun sgml-delete-tag (arg)
 715   "Delete tag on or after cursor, and matching closing or opening tag.
 716 With prefix argument ARG, repeat this ARG times."
 717   (interactive "p")
 718   (while (>= arg 1)
 719     (save-excursion
 720       (let* (close open)
 721         (if (looking-at "[ \t\n]*<")
 722             ;; just before tag
 723             (if (eq (char-after (match-end 0)) ?/)
 724                 ;; closing tag
 725                 (progn
 726                   (setq close (point))
 727                   (goto-char (match-end 0))))
 728           ;; on tag?
 729           (or (save-excursion (setq close (sgml-beginning-of-tag)
 730                                     close (and (stringp close)
 731                                                (eq (aref close 0) ?/)
 732                                                (point))))
 733               ;; not on closing tag
 734               (let ((point (point)))
 735                 (sgml-skip-tag-backward 1)
 736                 (if (or (not (eq (following-char) ?<))
 737                         (save-excursion
 738                           (forward-list 1)
 739                           (<= (point) point)))
 740                     (error "Not on or before tag")))))
 741         (if close
 742             (progn
 743               (sgml-skip-tag-backward 1)
 744               (setq open (point))
 745               (goto-char close)
 746               (kill-sexp 1))
 747           (setq open (point))
 748           (sgml-skip-tag-forward 1)
 749           (backward-list)
 750           (forward-char)
 751           (if (eq (aref (sgml-beginning-of-tag) 0) ?/)
 752               (kill-sexp 1)))
 753         (goto-char open)
 754         (kill-sexp 1)))
 755     (setq arg (1- arg))))
 756 \f
 757 ;; Put read-only last to enable setting this even when read-only enabled.
 758 (or (get 'sgml-tag 'invisible)
 759     (setplist 'sgml-tag
 760               (append '(invisible t
 761                         intangible t
 762                         point-entered sgml-point-entered
 763                         rear-nonsticky t
 764                         read-only t)
 765                       (symbol-plist 'sgml-tag))))
 766
 767 (defun sgml-tags-invisible (arg)
 768   "Toggle visibility of existing tags."
 769   (interactive "P")
 770   (let ((modified (buffer-modified-p))
 771         (inhibit-read-only t)
 772         (inhibit-modification-hooks t)
 773         ;; Avoid spurious the `file-locked' checks.
 774         (buffer-file-name nil)
 775         ;; This is needed in case font lock gets called,
 776         ;; since it moves point and might call sgml-point-entered.
 777         ;; How could it get called?  -stef
 778         (inhibit-point-motion-hooks t)
 779         string)
 780     (unwind-protect
 781         (save-excursion
 782           (goto-char (point-min))
 783           (if (set (make-local-variable 'sgml-tags-invisible)
 784                    (if arg
 785                        (>= (prefix-numeric-value arg) 0)
 786                      (not sgml-tags-invisible)))
 787               (while (re-search-forward sgml-tag-name-re nil t)
 788                 (setq string
 789                       (cdr (assq (intern-soft (downcase (match-string 1)))
 790                                  sgml-display-text)))
 791                 (goto-char (match-beginning 0))
 792                 (and (stringp string)
 793                      (not (overlays-at (point)))
 794                      (let ((ol (make-overlay (point) (match-beginning 1))))
 795                        (overlay-put ol 'before-string string)
 796                        (overlay-put ol 'sgml-tag t)))
 797                 (put-text-property (point)
 798                                    (progn (forward-list) (point))
 799                                    'category 'sgml-tag))
 800             (let ((pos (point-min)))
 801               (while (< (setq pos (next-overlay-change pos)) (point-max))
 802                 (dolist (ol (overlays-at pos))
 803                   (if (overlay-get ol 'sgml-tag)
 804                       (delete-overlay ol)))))
 805             (remove-text-properties (point-min) (point-max) '(category nil))))
 806       (restore-buffer-modified-p modified))
 807     (run-hooks 'sgml-tags-invisible-hook)
 808     (message "")))
 809
 810 (defun sgml-point-entered (x y)
 811   ;; Show preceding or following hidden tag, depending of cursor direction.
 812   (let ((inhibit-point-motion-hooks t))
 813     (save-excursion
 814       (message "Invisible tag: %s"
 815                ;; Strip properties, otherwise, the text is invisible.
 816                (buffer-substring-no-properties
 817                 (point)
 818                 (if (or (and (> x y)
 819                              (not (eq (following-char) ?<)))
 820                         (and (< x y)
 821                              (eq (preceding-char) ?>)))
 822                     (backward-list)
 823                   (forward-list)))))))
 824 \f
 825 (autoload 'compile-internal "compile")
 826
 827 (defun sgml-validate (command)
 828   "Validate an SGML document.
 829 Runs COMMAND, a shell command, in a separate process asynchronously
 830 with output going to the buffer `*compilation*'.
 831 You can then use the command \\[next-error] to find the next error message
 832 and move to the line in the SGML document that caused it."
 833   (interactive
 834    (list (read-string "Validate command: "
 835                       (or sgml-saved-validate-command
 836                           (concat sgml-validate-command
 837                                   " "
 838                                   (let ((name (buffer-file-name)))
 839                                     (and name
 840                                          (file-name-nondirectory name))))))))
 841   (setq sgml-saved-validate-command command)
 842   (save-some-buffers (not compilation-ask-about-save) nil)
 843   (compile-internal command "No more errors"))
 844
 845
 846 (defun sgml-lexical-context (&optional limit)
 847   "Return the lexical context at point as (TYPE . START).
 848 START is the location of the start of the lexical element.
 849 TYPE is one of `string', `comment', `tag', `cdata', ....
 850 Return nil if we are inside text (i.e. outside of any kind of tag).
 851
 852 If non-nil LIMIT is a nearby position before point outside of any tag."
 853   ;; As usual, it's difficult to get a reliable answer without parsing the
 854   ;; whole buffer.  We'll assume that a tag at indentation is outside of
 855   ;; any string or tag or comment or ...
 856   (save-excursion
 857     (let ((pos (point))
 858           (state nil))
 859       (if limit (goto-char limit)
 860         ;; Hopefully this regexp will match something that's not inside
 861         ;; a tag and also hopefully the match is nearby.
 862         (re-search-backward "^[ \t]*<[_:[:alpha:]/%!?#]" nil 'move))
 863       (with-syntax-table sgml-tag-syntax-table
 864         (while (< (point) pos)
 865           ;; When entering this loop we're inside text.
 866           (skip-chars-forward "^<" pos)
 867           ;; We skipped text and reached a tag.  Parse it.
 868           ;; FIXME: this does not handle CDATA and funny stuff yet.
 869           (setq state (parse-partial-sexp (point) pos 0)))
 870         (cond
 871          ((nth 3 state) (cons 'string (nth 8 state)))
 872          ((nth 4 state) (cons 'comment (nth 8 state)))
 873          ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))
 874          (t nil))))))
 875
 876 (defun sgml-beginning-of-tag (&optional top-level)
 877   "Skip to beginning of tag and return its name.
 878 If this can't be done, return nil."
 879   (let ((context (sgml-lexical-context)))
 880     (if (eq (car context) 'tag)
 881         (progn
 882           (goto-char (cdr context))
 883           (when (looking-at sgml-tag-name-re)
 884             (match-string-no-properties 1)))
 885       (if top-level nil
 886         (when context
 887           (goto-char (cdr context))
 888           (sgml-beginning-of-tag t))))))
 889
 890 (defun sgml-value (alist)
 891   "Interactively insert value taken from attributerule ALIST.
 892 See `sgml-tag-alist' for info about attribute rules."
 893   (setq alist (cdr alist))
 894   (if (stringp (car alist))
 895       (insert "=\"" (car alist) ?\")
 896     (if (and (eq (car alist) t) (not sgml-xml-mode))
 897         (when (cdr alist)
 898           (insert "=\"")
 899           (setq alist (skeleton-read '(completing-read "Value: " (cdr alist))))
 900           (if (string< "" alist)
 901               (insert alist ?\")
 902             (delete-backward-char 2)))
 903       (insert "=\"")
 904       (when alist
 905         (insert (skeleton-read '(completing-read "Value: " alist))))
 906       (insert ?\"))))
 907
 908 (defun sgml-quote (start end &optional unquotep)
 909   "Quote SGML text in region.
 910 With prefix argument, unquote the region."
 911   (interactive "r\np")
 912   (if (< start end)
 913       (goto-char start)
 914     (goto-char end)
 915     (setq end start))
 916   (if unquotep
 917       (while (re-search-forward "&\\(amp\\|\\(l\\|\\(g\\)\\)t\\)[;\n]" end t)
 918         (replace-match (if (match-end 3) ">" (if (match-end 2) "<" "&"))))
 919     (while (re-search-forward "[&<>]" end t)
 920       (replace-match (cdr (assq (char-before) '((?& . "&amp;")
 921                                                 (?< . "&lt;")
 922                                                 (?> . "&gt;"))))))))
 923 \f
 924
 925 (defun sgml-calculate-indent ()
 926   "Calculate the column to which this line should be indented."
 927   (let ((lcon (sgml-lexical-context)))
 928     ;; Indent comment-start markers inside <!-- just like comment-end markers.
 929     (if (and (eq (car lcon) 'tag)
 930              (looking-at "--")
 931              (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
 932         (setq lcon (cons 'comment (+ (cdr lcon) 2))))
 933
 934     (case (car lcon)
 935       (string
 936        ;; Go back to previous non-empty line.
 937        (while (and (> (point) (cdr lcon))
 938                    (zerop (forward-line -1))
 939                    (looking-at "[ \t]*$")))
 940        (if (> (point) (cdr lcon))
 941            ;; Previous line is inside the string.
 942            (current-indentation)
 943          (goto-char (cdr lcon))
 944          (1+ (current-column))))
 945
 946       (comment
 947        (let ((mark (looking-at "--")))
 948          ;; Go back to previous non-empty line.
 949          (while (and (> (point) (cdr lcon))
 950                      (zerop (forward-line -1))
 951                      (or (looking-at "[ \t]*$")
 952                          (if mark (not (looking-at "[ \t]*--"))))))
 953          (if (> (point) (cdr lcon))
 954              ;; Previous line is inside the comment.
 955              (skip-chars-forward " \t")
 956            (goto-char (cdr lcon)))
 957          (when (and (not mark) (looking-at "--"))
 958            (forward-char 2) (skip-chars-forward " \t"))
 959          (current-column)))
 960
 961       (tag
 962        (goto-char (1+ (cdr lcon)))
 963        (skip-chars-forward "^ \t\n")    ;Skip tag name.
 964        (skip-chars-forward " \t")
 965        (if (not (eolp))
 966            (current-column)
 967          ;; This is the first attribute: indent.
 968          (goto-char (1+ (cdr lcon)))
 969          (+ (current-column) sgml-basic-offset)))
 970
 971       (t
 972        (while (looking-at "</")
 973          (forward-sexp 1)
 974          (skip-chars-forward " \t"))
 975        (let ((context (xml-lite-get-context)))
 976          (cond
 977           ((null context) 0)            ; no context
 978           (t
 979            (let ((here (point)))
 980              (goto-char (xml-lite-tag-end (car context)))
 981              (skip-chars-forward " \t\n")
 982              (if (and (< (point) here) (xml-lite-at-indentation-p))
 983                  (current-column)
 984                (goto-char (xml-lite-tag-start (car context)))
 985                (+ (current-column)
 986                   (* sgml-basic-offset (length context))))))))))))
 987
 988 (defun sgml-indent-line ()
 989   "Indent the current line as SGML."
 990   (interactive)
 991   (let* ((savep (point))
 992          (indent-col
 993           (save-excursion
 994             (back-to-indentation)
 995             (if (>= (point) savep) (setq savep nil))
 996             (sgml-calculate-indent))))
 997     (if savep
 998         (save-excursion (indent-line-to indent-col))
 999       (indent-line-to indent-col))))
1000
1001 (defun sgml-parse-dtd ()
1002   "Simplistic parse of the current buffer as a DTD.
1003 Currently just returns (EMPTY-TAGS UNCLOSED-TAGS)."
1004   (goto-char (point-min))
1005   (let ((empty nil)
1006         (unclosed nil))
1007     (while (re-search-forward "<!ELEMENT[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+[-O][ \t\n]+\\([-O]\\)[ \t\n]+\\([^ \t\n]+\\)" nil t)
1008       (cond
1009        ((string= (match-string 3) "EMPTY")
1010         (push (match-string-no-properties 1) empty))
1011        ((string= (match-string 2) "O")
1012         (push (match-string-no-properties 1) unclosed))))
1013     (setq empty (sort (mapcar 'downcase empty) 'string<))
1014     (setq unclosed (sort (mapcar 'downcase unclosed) 'string<))
1015     (list empty unclosed)))
1016
1017 ;;; HTML mode
1018
1019 (defcustom html-mode-hook nil
1020   "Hook run by command `html-mode'.
1021 `text-mode-hook' and `sgml-mode-hook' are run first."
1022   :group 'sgml
1023   :type 'hook
1024   :options '(html-autoview-mode))
1025
1026 (defvar html-quick-keys sgml-quick-keys
1027   "Use C-c X combinations for quick insertion of frequent tags when non-nil.
1028 This defaults to `sgml-quick-keys'.
1029 This takes effect when first loading the library.")
1030
1031 (defvar html-mode-map
1032   (let ((map (make-sparse-keymap))
1033         (menu-map (make-sparse-keymap "HTML")))
1034     (set-keymap-parent map  sgml-mode-map)
1035     (define-key map "\C-c6" 'html-headline-6)
1036     (define-key map "\C-c5" 'html-headline-5)
1037     (define-key map "\C-c4" 'html-headline-4)
1038     (define-key map "\C-c3" 'html-headline-3)
1039     (define-key map "\C-c2" 'html-headline-2)
1040     (define-key map "\C-c1" 'html-headline-1)
1041     (define-key map "\C-c\r" 'html-paragraph)
1042     (define-key map "\C-c\n" 'html-line)
1043     (define-key map "\C-c\C-c-" 'html-horizontal-rule)
1044     (define-key map "\C-c\C-co" 'html-ordered-list)
1045     (define-key map "\C-c\C-cu" 'html-unordered-list)
1046     (define-key map "\C-c\C-cr" 'html-radio-buttons)
1047     (define-key map "\C-c\C-cc" 'html-checkboxes)
1048     (define-key map "\C-c\C-cl" 'html-list-item)
1049     (define-key map "\C-c\C-ch" 'html-href-anchor)
1050     (define-key map "\C-c\C-cn" 'html-name-anchor)
1051     (define-key map "\C-c\C-ci" 'html-image)
1052     (when html-quick-keys
1053       (define-key map "\C-c-" 'html-horizontal-rule)
1054       (define-key map "\C-co" 'html-ordered-list)
1055       (define-key map "\C-cu" 'html-unordered-list)
1056       (define-key map "\C-cr" 'html-radio-buttons)
1057       (define-key map "\C-cc" 'html-checkboxes)
1058       (define-key map "\C-cl" 'html-list-item)
1059       (define-key map "\C-ch" 'html-href-anchor)
1060       (define-key map "\C-cn" 'html-name-anchor)
1061       (define-key map "\C-ci" 'html-image))
1062     (define-key map "\C-c\C-s" 'html-autoview-mode)
1063     (define-key map "\C-c\C-v" 'browse-url-of-buffer)
1064     (define-key map [menu-bar html] (cons "HTML" menu-map))
1065     (define-key menu-map [html-autoview-mode]
1066       '("Toggle Autoviewing" . html-autoview-mode))
1067     (define-key menu-map [browse-url-of-buffer]
1068       '("View Buffer Contents" . browse-url-of-buffer))
1069     (define-key menu-map [nil] '("--"))
1070     ;;(define-key menu-map "6" '("Heading 6" . html-headline-6))
1071     ;;(define-key menu-map "5" '("Heading 5" . html-headline-5))
1072     ;;(define-key menu-map "4" '("Heading 4" . html-headline-4))
1073     (define-key menu-map "3" '("Heading 3" . html-headline-3))
1074     (define-key menu-map "2" '("Heading 2" . html-headline-2))
1075     (define-key menu-map "1" '("Heading 1" . html-headline-1))
1076     (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons))
1077     (define-key menu-map "c" '("Checkboxes" . html-checkboxes))
1078     (define-key menu-map "l" '("List Item" . html-list-item))
1079     (define-key menu-map "u" '("Unordered List" . html-unordered-list))
1080     (define-key menu-map "o" '("Ordered List" . html-ordered-list))
1081     (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule))
1082     (define-key menu-map "\n" '("Line Break" . html-line))
1083     (define-key menu-map "\r" '("Paragraph" . html-paragraph))
1084     (define-key menu-map "i" '("Image" . html-image))
1085     (define-key menu-map "h" '("Href Anchor" . html-href-anchor))
1086     (define-key menu-map "n" '("Name Anchor" . html-name-anchor))
1087     map)
1088   "Keymap for commands for use in HTML mode.")
1089
1090
1091 (defvar html-face-tag-alist
1092   '((bold . "b")
1093     (italic . "i")
1094     (underline . "u")
1095     (modeline . "rev"))
1096   "Value of `sgml-face-tag-alist' for HTML mode.")
1097
1098 (defvar html-tag-face-alist
1099   '(("b" . bold)
1100     ("big" . bold)
1101     ("blink" . highlight)
1102     ("cite" . italic)
1103     ("em" . italic)
1104     ("h1" bold underline)
1105     ("h2" bold-italic underline)
1106     ("h3" italic underline)
1107     ("h4" . underline)
1108     ("h5" . underline)
1109     ("h6" . underline)
1110     ("i" . italic)
1111     ("rev"  . modeline)
1112     ("s" . underline)
1113     ("small" . default)
1114     ("strong" . bold)
1115     ("title" bold underline)
1116     ("tt" . default)
1117     ("u" . underline)
1118     ("var" . italic))
1119   "Value of `sgml-tag-face-alist' for HTML mode.")
1120
1121
1122 (defvar html-display-text
1123   '((img . "[/]")
1124     (hr . "----------")
1125     (li . "o "))
1126   "Value of `sgml-display-text' for HTML mode.")
1127 \f
1128
1129 ;; should code exactly HTML 3 here when that is finished
1130 (defvar html-tag-alist
1131   (let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7")))
1132          (1-9 `(,@1-7 ("8") ("9")))
1133          (align '(("align" ("left") ("center") ("right"))))
1134          (valign '(("top") ("middle") ("bottom") ("baseline")))
1135          (rel '(("next") ("previous") ("parent") ("subdocument") ("made")))
1136          (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:")
1137                  ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:")
1138                  ("wais:") ("/cgi-bin/")))
1139          (name '("name"))
1140          (link `(,href
1141                  ("rel" ,@rel)
1142                  ("rev" ,@rel)
1143                  ("title")))
1144          (list '((nil \n ("List item: " "<li>" str
1145                           (if sgml-xml-mode "</li>") \n))))
1146          (cell `(t
1147                  ,@align
1148                  ("valign" ,@valign)
1149                  ("colspan" ,@1-9)
1150                  ("rowspan" ,@1-9)
1151                  ("nowrap" t))))
1152     ;; put ,-expressions first, else byte-compile chokes (as of V19.29)
1153     ;; and like this it's more efficient anyway
1154     `(("a" ,name ,@link)
1155       ("base" t ,@href)
1156       ("dir" ,@list)
1157       ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)
1158       ("form" (\n _ \n "<input type=\"submit\" value=\"\""
1159                (if sgml-xml-mode "/>" ">"))
1160        ("action" ,@(cdr href)) ("method" ("get") ("post")))
1161       ("h1" ,@align)
1162       ("h2" ,@align)
1163       ("h3" ,@align)
1164       ("h4" ,@align)
1165       ("h5" ,@align)
1166       ("h6" ,@align)
1167       ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align)
1168       ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom"))
1169        ("src") ("alt") ("width" "1") ("height" "1")
1170        ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t))
1171       ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name
1172        ("type" ("text") ("password") ("checkbox") ("radio")
1173         ("submit") ("reset"))
1174        ("value"))
1175       ("link" t ,@link)
1176       ("menu" ,@list)
1177       ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1")))
1178       ("p" t ,@align)
1179       ("select" (nil \n
1180                      ("Text: "
1181                       "<option>" str (if sgml-xml-mode "</option>") \n))
1182        ,name ("size" ,@1-9) ("multiple" t))
1183       ("table" (nil \n
1184                     ((completing-read "Cell kind: " '(("td") ("th"))
1185                                       nil t "t")
1186                      "<tr><" str ?> _
1187                      (if sgml-xml-mode (concat "<" str "></tr>")) \n))
1188        ("border" t ,@1-9) ("width" "10") ("cellpadding"))
1189       ("td" ,@cell)
1190       ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
1191       ("th" ,@cell)
1192       ("ul" ,@list ("type" ("disc") ("circle") ("square")))
1193
1194       ,@sgml-tag-alist
1195
1196       ("abbrev")
1197       ("acronym")
1198       ("address")
1199       ("array" (nil \n
1200                     ("Item: " "<item>" str (if sgml-xml-mode "</item>") \n))
1201        "align")
1202       ("au")
1203       ("b")
1204       ("big")
1205       ("blink")
1206       ("blockquote" \n)
1207       ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#")
1208        ("link" "#") ("alink" "#") ("vlink" "#"))
1209       ("box" (nil _ "<over>" _ (if sgml-xml-mode "</over>")))
1210       ("br" t ("clear" ("left") ("right")))
1211       ("caption" ("valign" ("top") ("bottom")))
1212       ("center" \n)
1213       ("cite")
1214       ("code" \n)
1215       ("dd" ,(not sgml-xml-mode))
1216       ("del")
1217       ("dfn")
1218       ("div")
1219       ("dl" (nil \n
1220                  ( "Term: "
1221                    "<dt>" str (if sgml-xml-mode "</dt>")
1222                    "<dd>" _ (if sgml-xml-mode "</dd>") \n)))
1223       ("dt" (t _ (if sgml-xml-mode "</dt>")
1224              "<dd>" (if sgml-xml-mode "</dd>") \n))
1225       ("em")
1226       ;("fn" "id" "fn")  ; ???
1227       ("head" \n)
1228       ("html" (\n
1229                "<head>\n"
1230                "<title>" (setq str (read-input "Title: ")) "</title>\n"
1231                "</head>\n"
1232                "<body>\n<h1>" str "</h1>\n" _
1233                "\n<address>\n<a href=\"mailto:"
1234                user-mail-address
1235                "\">" (user-full-name) "</a>\n</address>\n"
1236                "</body>"
1237                 ))
1238       ("i")
1239       ("ins")
1240       ("isindex" t ("action") ("prompt"))
1241       ("kbd")
1242       ("lang")
1243       ("li" ,(not sgml-xml-mode))
1244       ("math" \n)
1245       ("nobr")
1246       ("option" t ("value") ("label") ("selected" t))
1247       ("over" t)
1248       ("person")
1249       ("pre" \n)
1250       ("q")
1251       ("rev")
1252       ("s")
1253       ("samp")
1254       ("small")
1255       ("span" nil
1256         ("class"
1257          ("builtin")
1258          ("comment")
1259          ("constant")
1260          ("function-name")
1261          ("keyword")
1262          ("string")
1263          ("type")
1264          ("variable-name")
1265          ("warning")))
1266       ("strong")
1267       ("sub")
1268       ("sup")
1269       ("title")
1270       ("tr" t)
1271       ("tt")
1272       ("u")
1273       ("var")
1274       ("wbr" t)))
1275   "*Value of `sgml-tag-alist' for HTML mode.")
1276
1277 (defvar html-tag-help
1278   `(,@sgml-tag-help
1279     ("a" . "Anchor of point or link elsewhere")
1280     ("abbrev" . "?")
1281     ("acronym" . "?")
1282     ("address" . "Formatted mail address")
1283     ("array" . "Math array")
1284     ("au" . "?")
1285     ("b" . "Bold face")
1286     ("base" . "Base address for URLs")
1287     ("big" . "Font size")
1288     ("blink" . "Blinking text")
1289     ("blockquote" . "Indented quotation")
1290     ("body" . "Document body")
1291     ("box" . "Math fraction")
1292     ("br" . "Line break")
1293     ("caption" . "Table caption")
1294     ("center" . "Centered text")
1295     ("changed" . "Change bars")
1296     ("cite" . "Citation of a document")
1297     ("code" . "Formatted source code")
1298     ("dd" . "Definition of term")
1299     ("del" . "?")
1300     ("dfn" . "?")
1301     ("dir" . "Directory list (obsolete)")
1302     ("dl" . "Definition list")
1303     ("dt" . "Term to be definined")
1304     ("em" . "Emphasised")
1305     ("embed" . "Embedded data in foreign format")
1306     ("fig" . "Figure")
1307     ("figa" . "Figure anchor")
1308     ("figd" . "Figure description")
1309     ("figt" . "Figure text")
1310     ;("fn" . "?")  ; ???
1311     ("font" . "Font size")
1312     ("form" . "Form with input fields")
1313     ("group" . "Document grouping")
1314     ("h1" . "Most important section headline")
1315     ("h2" . "Important section headline")
1316     ("h3" . "Section headline")
1317     ("h4" . "Minor section headline")
1318     ("h5" . "Unimportant section headline")
1319     ("h6" . "Least important section headline")
1320     ("head" . "Document header")
1321     ("hr" . "Horizontal rule")
1322     ("html" . "HTML Document")
1323     ("i" . "Italic face")
1324     ("img" . "Graphic image")
1325     ("input" . "Form input field")
1326     ("ins" . "?")
1327     ("isindex" . "Input field for index search")
1328     ("kbd" . "Keybard example face")
1329     ("lang" . "Natural language")
1330     ("li" . "List item")
1331     ("link" . "Link relationship")
1332     ("math" . "Math formula")
1333     ("menu" . "Menu list (obsolete)")
1334     ("mh" . "Form mail header")
1335     ("nextid" . "Allocate new id")
1336     ("nobr" . "Text without line break")
1337     ("ol" . "Ordered list")
1338     ("option" . "Selection list item")
1339     ("over" . "Math fraction rule")
1340     ("p" . "Paragraph start")
1341     ("panel" . "Floating panel")
1342     ("person" . "?")
1343     ("pre" . "Preformatted fixed width text")
1344     ("q" . "?")
1345     ("rev" . "Reverse video")
1346     ("s" . "?")
1347     ("samp" . "Sample text")
1348     ("select" . "Selection list")
1349     ("small" . "Font size")
1350     ("sp" . "Nobreak space")
1351     ("strong" . "Standout text")
1352     ("sub" . "Subscript")
1353     ("sup" . "Superscript")
1354     ("table" . "Table with rows and columns")
1355     ("tb" . "Table vertical break")
1356     ("td" . "Table data cell")
1357     ("textarea" . "Form multiline edit area")
1358     ("th" . "Table header cell")
1359     ("title" . "Document title")
1360     ("tr" . "Table row separator")
1361     ("tt" . "Typewriter face")
1362     ("u" . "Underlined text")
1363     ("ul" . "Unordered list")
1364     ("var" . "Math variable face")
1365     ("wbr" . "Enable <br> within <nobr>"))
1366 "*Value of `sgml-tag-help' for HTML mode.")
1367 \f
1368 ;;;###autoload
1369 (define-derived-mode html-mode sgml-mode "HTML"
1370   "Major mode based on SGML mode for editing HTML documents.
1371 This allows inserting skeleton constructs used in hypertext documents with
1372 completion.  See below for an introduction to HTML.  Use
1373 \\[browse-url-of-buffer] to see how this comes out.  See also `sgml-mode' on
1374 which this is based.
1375
1376 Do \\[describe-variable] html- SPC and \\[describe-variable] sgml- SPC to see available variables.
1377
1378 To write fairly well formatted pages you only need to know few things.  Most
1379 browsers have a function to read the source code of the page being seen, so
1380 you can imitate various tricks.  Here's a very short HTML primer which you
1381 can also view with a browser to see what happens:
1382
1383 <title>A Title Describing Contents</title> should be on every page.  Pages can
1384 have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
1385 <hr> Parts can be separated with horizontal rules.
1386
1387 <p>Paragraphs only need an opening tag.  Line breaks and multiple spaces are
1388 ignored unless the text is <pre>preformatted.</pre>  Text can be marked as
1389 <b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal  M-g  or
1390 Edit/Text Properties/Face commands.
1391
1392 Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
1393 to them with <a href=\"#SOMENAME\">see also somename</a>.  In the same way <a
1394 href=\"URL\">see also URL</a> where URL is a filename relative to current
1395 directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'.
1396
1397 Images in many formats can be inlined with <img src=\"URL\">.
1398
1399 If you mainly create your own documents, `sgml-specials' might be
1400 interesting.  But note that some HTML 2 browsers can't handle `&apos;'.
1401 To work around that, do:
1402    (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
1403
1404 \\{html-mode-map}"
1405   (set (make-local-variable 'sgml-display-text) html-display-text)
1406   (set (make-local-variable 'sgml-tag-face-alist) html-tag-face-alist)
1407   (make-local-variable 'sgml-tag-alist)
1408   (make-local-variable 'sgml-face-tag-alist)
1409   (make-local-variable 'sgml-tag-help)
1410   (make-local-variable 'outline-regexp)
1411   (make-local-variable 'outline-heading-end-regexp)
1412   (make-local-variable 'outline-level)
1413   (make-local-variable 'sentence-end)
1414   (setq sentence-end
1415         (if sentence-end-double-space
1416             "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\| $\\|\t\\|  \\)[ \t\n]*"
1417           "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\|[ \t]\\)[ \t\n]*"))
1418   (setq sgml-tag-alist html-tag-alist
1419         sgml-face-tag-alist html-face-tag-alist
1420         sgml-tag-help html-tag-help
1421         outline-regexp "^.*<[Hh][1-6]\\>"
1422         outline-heading-end-regexp "</[Hh][1-6]>"
1423         outline-level (lambda ()
1424                         (char-before (match-end 0))))
1425   (setq imenu-create-index-function 'html-imenu-index)
1426   (when sgml-xml-mode (setq mode-name "XHTML"))
1427   (set (make-local-variable 'sgml-empty-tags)
1428        ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd',
1429        ;; plus manual addition of "wbr".
1430        '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input"
1431          "isindex" "link" "meta" "param" "wbr"))
1432   (set (make-local-variable 'sgml-unclosed-tags)
1433        ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'.
1434        '("body" "colgroup" "dd" "dt" "head" "html" "li" "option"
1435          "p" "tbody" "td" "tfoot" "th" "thead" "tr"))
1436   ;; It's for the user to decide if it defeats it or not  -stef
1437   ;; (make-local-variable 'imenu-sort-function)
1438   ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
1439   )
1440 \f
1441 (defvar html-imenu-regexp
1442   "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
1443   "*A regular expression matching a head line to be added to the menu.
1444 The first `match-string' should be a number from 1-9.
1445 The second `match-string' matches extra tags and is ignored.
1446 The third `match-string' will be the used in the menu.")
1447
1448 (defun html-imenu-index ()
1449   "Return an table of contents for an HTML buffer for use with Imenu."
1450   (let (toc-index)
1451     (save-excursion
1452       (goto-char (point-min))
1453       (while (re-search-forward html-imenu-regexp nil t)
1454         (setq toc-index
1455               (cons (cons (concat (make-string
1456                                    (* 2 (1- (string-to-number (match-string 1))))
1457                                    ?\ )
1458                                   (match-string 3))
1459                           (line-beginning-position))
1460                     toc-index))))
1461     (nreverse toc-index)))
1462
1463 (defun html-autoview-mode (&optional arg)
1464   "Toggle automatic viewing via `browse-url-of-buffer' upon saving buffer.
1465 With positive prefix ARG always turns viewing on, with negative ARG always off.
1466 Can be used as a value for `html-mode-hook'."
1467   (interactive "P")
1468   (if (setq arg (if arg
1469                     (< (prefix-numeric-value arg) 0)
1470                   (and (boundp 'after-save-hook)
1471                        (memq 'browse-url-of-buffer after-save-hook))))
1472       (setq after-save-hook (delq 'browse-url-of-buffer after-save-hook))
1473     (add-hook 'after-save-hook 'browse-url-of-buffer nil t))
1474   (message "Autoviewing turned %s."
1475            (if arg "off" "on")))
1476 \f
1477 (define-skeleton html-href-anchor
1478   "HTML anchor tag with href attribute."
1479   "URL: "
1480   '(setq input "http:")
1481   "<a href=\"" str "\">" _ "</a>")
1482
1483 (define-skeleton html-name-anchor
1484   "HTML anchor tag with name attribute."
1485   "Name: "
1486   "<a name=\"" str "\">" _ "</a>")
1487
1488 (define-skeleton html-headline-1
1489   "HTML level 1 headline tags."
1490   nil
1491   "<h1>" _ "</h1>")
1492
1493 (define-skeleton html-headline-2
1494   "HTML level 2 headline tags."
1495   nil
1496   "<h2>" _ "</h2>")
1497
1498 (define-skeleton html-headline-3
1499   "HTML level 3 headline tags."
1500   nil
1501   "<h3>" _ "</h3>")
1502
1503 (define-skeleton html-headline-4
1504   "HTML level 4 headline tags."
1505   nil
1506   "<h4>" _ "</h4>")
1507
1508 (define-skeleton html-headline-5
1509   "HTML level 5 headline tags."
1510   nil
1511   "<h5>" _ "</h5>")
1512
1513 (define-skeleton html-headline-6
1514   "HTML level 6 headline tags."
1515   nil
1516   "<h6>" _ "</h6>")
1517
1518 (define-skeleton html-horizontal-rule
1519   "HTML horizontal rule tag."
1520   nil
1521   (if sgml-xml-mode "<hr/>" "<hr>") \n)
1522
1523 (define-skeleton html-image
1524   "HTML image tag."
1525   nil
1526   "<img src=\"" _ "\""
1527   (if sgml-xml-mode "/>" ">"))
1528
1529 (define-skeleton html-line
1530   "HTML line break tag."
1531   nil
1532   (if sgml-xml-mode "<br/>" "<br>") \n)
1533
1534 (define-skeleton html-ordered-list
1535   "HTML ordered list tags."
1536   nil
1537   "<ol>" \n
1538   "<li>" _ (if sgml-xml-mode "</li>") \n
1539   "</ol>")
1540
1541 (define-skeleton html-unordered-list
1542   "HTML unordered list tags."
1543   nil
1544   "<ul>" \n
1545   "<li>" _ (if sgml-xml-mode "</li>") \n
1546   "</ul>")
1547
1548 (define-skeleton html-list-item
1549   "HTML list item tag."
1550   nil
1551   (if (bolp) nil '\n)
1552   "<li>" _ (if sgml-xml-mode "</li>"))
1553
1554 (define-skeleton html-paragraph
1555   "HTML paragraph tag."
1556   nil
1557   (if (bolp) nil ?\n)
1558   \n "<p>" _ (if sgml-xml-mode "</p>"))
1559
1560 (define-skeleton html-checkboxes
1561   "Group of connected checkbox inputs."
1562   nil
1563   '(setq v1 nil
1564          v2 nil)
1565   ("Value: "
1566    "<input type=\"" (identity "checkbox") ; see comment above about identity
1567    "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
1568    "\" value=\"" str ?\"
1569    (when (y-or-n-p "Set \"checked\" attribute? ")
1570      (funcall skeleton-transformation " checked"))
1571    (if sgml-xml-mode "/>" ">")
1572    (skeleton-read "Text: " (capitalize str))
1573    (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
1574                        (funcall skeleton-transformation
1575                                 (if sgml-xml-mode "<br/>" "<br>"))
1576                      "")))
1577    \n))
1578
1579 (define-skeleton html-radio-buttons
1580   "Group of connected radio button inputs."
1581   nil
1582   '(setq v1 nil
1583          v2 (cons nil nil))
1584   ("Value: "
1585    "<input type=\"" (identity "radio") ; see comment above about identity
1586    "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
1587    "\" value=\"" str ?\"
1588    (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
1589      (funcall skeleton-transformation " checked"))
1590    (if sgml-xml-mode "/>" ">")
1591    (skeleton-read "Text: " (capitalize str))
1592    (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
1593                                (funcall skeleton-transformation
1594                                         (if sgml-xml-mode "<br/>" "<br>"))
1595                              "")))
1596    \n))
1597
1598 (provide 'sgml-mode)
1599
1600 ;;; sgml-mode.el ends here