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