lisp/textmodes/sgml-mode.el

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