lisp/textmodes/sgml-mode.el

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