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