(fill-region-as-paragraph): Fix the test for any
[bpt/emacs.git] / lisp / textmodes / sgml-mode.el
CommitLineData
1caf38eb 1;;; sgml-mode.el --- SGML- and HTML-editing modes
72c0ae01 2
1caf38eb 3;; Copyright (C) 1992, 1995, 1996 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>")
306 3 (cdr (assoc (match-string 1) ',sgml-tag-face-alist)))))))
307 (setq indent-line-function 'indent-relative-maybe
308 ;; A start or end tag by itself on a line separates a paragraph.
309 ;; This is desirable because SGML discards a newline that appears
310 ;; immediately after a start tag or immediately before an end tag.
6c455d5c
RS
311 paragraph-separate "[ \t]*$\\|\
312\[ \t]*</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$"
313 paragraph-start "[ \t]*$\\|\
314\[ \t]*</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$"
315 adaptive-fill-regexp "[ \t]*"
1caf38eb
RS
316 comment-start "<!-- "
317 comment-end " -->"
318 comment-indent-function 'sgml-comment-indent
319 ;; This will allow existing comments within declarations to be
320 ;; recognized.
321 comment-start-skip "--[ \t]*"
a391b179 322 skeleton-transformation sgml-transformation
1caf38eb
RS
323 skeleton-further-elements '((completion-ignore-case t))
324 skeleton-end-hook (lambda ()
325 (or (eolp)
326 (not (or (eq v2 '\n)
327 (eq (car-safe v2) '\n)))
328 (newline-and-indent)))
329 sgml-font-lock-keywords-1 (cdr (assq 1 sgml-tag-face-alist))
330 font-lock-defaults '((sgml-font-lock-keywords
331 sgml-font-lock-keywords-1)
332 nil
333 t)
6811a757 334 facemenu-add-face-function 'sgml-mode-facemenu-add-face-function)
1caf38eb
RS
335 (while sgml-display-text
336 (put (car (car sgml-display-text)) 'before-string
337 (cdr (car sgml-display-text)))
338 (setq sgml-display-text (cdr sgml-display-text)))
72c0ae01
ER
339 (run-hooks 'text-mode-hook 'sgml-mode-hook))
340
1caf38eb 341
6811a757
RS
342(defun sgml-mode-facemenu-add-face-function (face end)
343 (if (setq face (cdr (assq face sgml-face-tag-alist)))
344 (progn
345 (setq face (funcall skeleton-transformation face))
346 (setq facemenu-end-add-face (concat "</" face ">"))
347 (concat "<" face ">"))
348 (error "Face not configured for %s mode." mode-name)))
349
350
1caf38eb
RS
351;;;###autoload
352(defun sgml-mode (&optional function)
353 "Major mode for editing SGML documents.
354Makes > match <. Makes / blink matching /.
fcc3195e
RS
355Keys <, &, SPC within <>, \" and ' can be electric depending on
356`sgml-quick-keys'.
1caf38eb 357
f788776c
RS
358An argument of N to a tag-inserting command means to wrap it around
359the next N words. In Transient Mark mode, when the mark is active,
360N defaults to -1, which means to wrap it around the current region.
a391b179 361
d10447ba 362If you like upcased tags, put (setq sgml-transformation 'upcase) in
f788776c 363your `.emacs' file.
1caf38eb
RS
364
365Use \\[sgml-validate] to validate your document with an SGML parser.
a391b179
RS
366
367Do \\[describe-variable] sgml- SPC to see available variables.
368Do \\[describe-key] on the following bindings to discover what they do.
1caf38eb
RS
369\\{sgml-mode-map}"
370 (interactive)
371 (sgml-mode-common sgml-tag-face-alist sgml-display-text)
ec79b93a
KH
372 ;; Set imenu-generic-expression here, rather than in sgml-mode-common,
373 ;; because this definition probably is not useful in HTML mode.
374 (make-local-variable 'imenu-generic-expression)
375 (setq imenu-generic-expression
376 "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\([A-Za-z][-A-Za-z.0-9]*\\)")
1caf38eb
RS
377 (use-local-map sgml-mode-map)
378 (setq mode-name "SGML"
379 major-mode 'sgml-mode))
380
381
382
72c0ae01
ER
383(defun sgml-comment-indent ()
384 (if (and (looking-at "--")
1caf38eb 385 (not (and (eq (preceding-char) ?!)
72c0ae01
ER
386 (eq (char-after (- (point) 2)) ?<))))
387 (progn
388 (skip-chars-backward " \t")
389 (max comment-column (1+ (current-column))))
390 0))
391
72c0ae01 392
72c0ae01
ER
393
394(defun sgml-slash (arg)
f788776c
RS
395 "Insert `/' and display any previous matching `/'.
396Two `/'s are treated as matching if the first `/' ends a net-enabling
397start tag, and the second `/' is the corresponding null end tag."
72c0ae01
ER
398 (interactive "p")
399 (insert-char ?/ arg)
400 (if (> arg 0)
401 (let ((oldpos (point))
402 (blinkpos)
403 (level 0))
404 (save-excursion
405 (save-restriction
406 (if sgml-slash-distance
407 (narrow-to-region (max (point-min)
408 (- (point) sgml-slash-distance))
409 oldpos))
410 (if (and (re-search-backward sgml-start-tag-regex (point-min) t)
411 (eq (match-end 0) (1- oldpos)))
412 ()
413 (goto-char (1- oldpos))
414 (while (and (not blinkpos)
415 (search-backward "/" (point-min) t))
416 (let ((tagend (save-excursion
417 (if (re-search-backward sgml-start-tag-regex
418 (point-min) t)
419 (match-end 0)
420 nil))))
421 (if (eq tagend (point))
422 (if (eq level 0)
423 (setq blinkpos (point))
424 (setq level (1- level)))
425 (setq level (1+ level)))))))
426 (if blinkpos
427 (progn
428 (goto-char blinkpos)
429 (if (pos-visible-in-window-p)
430 (sit-for 1)
431 (message "Matches %s"
432 (buffer-substring (progn
433 (beginning-of-line)
434 (point))
435 (1+ blinkpos))))))))))
436
1caf38eb
RS
437
438(defun sgml-name-char (&optional char)
439 "Insert a symbolic character name according to `sgml-char-names'.
4408 bit chars may be inserted with the meta key as in M-SPC for no break space,
441or M-- for a soft hyphen."
442 (interactive "*")
443 (insert ?&)
444 (or char
9b0ffdac 445 (setq char (read-quoted-char "Enter char or octal number")))
1caf38eb
RS
446 (delete-backward-char 1)
447 (insert char)
448 (undo-boundary)
449 (delete-backward-char 1)
450 (insert ?&
451 (or (aref sgml-char-names char)
452 (format "#%d" char))
453 ?\;))
454
455
456(defun sgml-name-self ()
457 "Insert a symbolic character name according to `sgml-char-names'."
458 (interactive "*")
459 (sgml-name-char last-command-char))
460
461
462(defun sgml-maybe-name-self ()
463 "Insert a symbolic character name according to `sgml-char-names'."
464 (interactive "*")
465 (if sgml-name-8bit-mode
466 (sgml-name-char last-command-char)
467 (self-insert-command 1)))
468
469
470(defun sgml-name-8bit-mode ()
471 "Toggle insertion of 8 bit characters."
472 (interactive)
d10447ba
RS
473 (setq sgml-name-8bit-mode (not sgml-name-8bit-mode))
474 (message "sgml name 8 bit mode is now %"
475 (if sgml-name-8bit-mode "ON" "OFF")))
1caf38eb
RS
476
477
f788776c
RS
478;; When an element of a skeleton is a string "str", it is passed
479;; through skeleton-transformation and inserted. If "str" is to be
480;; inserted literally, one should obtain it as the return value of a
481;; function, e.g. (identity "str").
1caf38eb
RS
482
483(define-skeleton sgml-tag
f788776c
RS
484 "Prompt for a tag and insert it, optionally with attributes.
485Completion and configuration are done according to `sgml-tag-alist'.
d10447ba 486If you like tags and attributes in uppercase do \\[set-variable]
f788776c
RS
487skeleton-transformation RET upcase RET, or put this in your `.emacs':
488 (setq sgml-transformation 'upcase)"
1caf38eb
RS
489 (funcall skeleton-transformation
490 (completing-read "Tag: " sgml-tag-alist))
491 ?< (setq v1 (eval str)) |
d10447ba 492 (("") -1 '(undo-boundary) (identity "&lt;")) | ; see comment above
1caf38eb 493 (("") '(setq v2 (sgml-attributes v1 t)) ?>
fcc3195e
RS
494 (if (string= "![" v1)
495 (prog1 '(("") " [ " _ " ]]")
496 (backward-char))
497 (if (or (eq v2 t)
498 (string-match "^[/!?]" v1))
499 ()
500 (if (symbolp v2)
501 '(("") v2 _ v2 "</" v1 ?>)
502 (if (eq (car v2) t)
503 (cons '("") (cdr v2))
504 (append '(("") (car v2))
505 (cdr v2)
506 '(resume: (car v2) _ "</" v1 ?>))))))))
1caf38eb
RS
507
508(autoload 'skeleton-read "skeleton")
509
d10447ba 510(defun sgml-attributes (tag &optional quiet)
f788776c 511 "When at top level of a tag, interactively insert attributes.
d10447ba 512
f788776c
RS
513Completion and configuration of TAG are done according to `sgml-tag-alist'.
514If QUIET, do not print a message when there are no attributes for TAG."
1caf38eb 515 (interactive (list (save-excursion (sgml-beginning-of-tag t))))
d10447ba
RS
516 (or (stringp tag) (error "Wrong context for adding attribute"))
517 (if tag
1caf38eb 518 (let ((completion-ignore-case t)
d10447ba 519 (alist (cdr (assoc (downcase tag) sgml-tag-alist)))
1caf38eb 520 car attribute i)
1caf38eb
RS
521 (if (or (symbolp (car alist))
522 (symbolp (car (car alist))))
523 (setq car (car alist)
524 alist (cdr alist)))
525 (or quiet
526 (message "No attributes configured."))
527 (if (stringp (car alist))
528 (progn
d10447ba
RS
529 (insert (if (eq (preceding-char) ? ) "" ? )
530 (funcall skeleton-transformation (car alist)))
1caf38eb
RS
531 (sgml-value alist))
532 (setq i (length alist))
533 (while (> i 0)
534 (insert ? )
535 (insert (funcall skeleton-transformation
536 (setq attribute
537 (skeleton-read '(completing-read
d10447ba 538 "Attribute: "
1caf38eb
RS
539 alist)))))
540 (if (string= "" attribute)
541 (setq i 0)
542 (sgml-value (assoc attribute alist))
543 (setq i (1- i))))
544 (if (eq (preceding-char) ? )
545 (delete-backward-char 1)))
546 car)))
547
548(defun sgml-auto-attributes (arg)
f788776c
RS
549 "Self insert the character typed; at top level of tag, prompt for attributes.
550With prefix argument, only self insert."
1caf38eb
RS
551 (interactive "*P")
552 (let ((point (point))
553 tag)
554 (if (or arg
1caf38eb
RS
555 (not sgml-tag-alist) ; no message when nothing configured
556 (symbolp (setq tag (save-excursion (sgml-beginning-of-tag t))))
557 (eq (aref tag 0) ?/))
558 (self-insert-command (prefix-numeric-value arg))
559 (sgml-attributes tag)
560 (setq last-command-char ? )
561 (or (> (point) point)
562 (self-insert-command 1)))))
563
564
565(defun sgml-tag-help (&optional tag)
f788776c 566 "Display description of tag TAG. If TAG is omitted, use the tag at point."
1caf38eb
RS
567 (interactive)
568 (or tag
569 (save-excursion
570 (if (eq (following-char) ?<)
571 (forward-char))
572 (setq tag (sgml-beginning-of-tag))))
573 (or (stringp tag)
574 (error "No tag selected"))
575 (setq tag (downcase tag))
f68f40e0
KH
576 (message "%s"
577 (or (cdr (assoc tag sgml-tag-help))
1caf38eb
RS
578 (and (eq (aref tag 0) ?/)
579 (cdr (assoc (substring tag 1) sgml-tag-help)))
580 "No description available")))
581
582
583(defun sgml-maybe-end-tag ()
584 "Name self unless in position to end a tag."
585 (interactive)
586 (or (condition-case nil
587 (save-excursion (up-list -1))
588 (error
589 (sgml-name-self)
590 t))
591 (condition-case nil
592 (progn
593 (save-excursion (up-list 1))
594 (sgml-name-self))
595 (error (self-insert-command 1)))))
596
597
598(defun sgml-skip-tag-backward (arg)
599 "Skip to beginning of tag or matching opening tag if present.
f788776c 600With prefix argument ARG, repeat this ARG times."
1caf38eb
RS
601 (interactive "p")
602 (while (>= arg 1)
603 (search-backward "<" nil t)
604 (if (looking-at "</\\([^ \n\t>]+\\)")
605 ;; end tag, skip any nested pairs
606 (let ((case-fold-search t)
607 (re (concat "</?" (regexp-quote (match-string 1)))))
608 (while (and (re-search-backward re nil t)
609 (eq (char-after (1+ (point))) ?/))
610 (forward-char 1)
611 (sgml-skip-tag-backward 1))))
612 (setq arg (1- arg))))
613
614(defun sgml-skip-tag-forward (arg &optional return)
615 "Skip to end of tag or matching closing tag if present.
f788776c 616With prefix argument ARG, repeat this ARG times.
1caf38eb
RS
617Return t iff after a closing tag."
618 (interactive "p")
619 (setq return t)
620 (while (>= arg 1)
621 (skip-chars-forward "^<>")
622 (if (eq (following-char) ?>)
623 (up-list -1))
624 (if (looking-at "<\\([^/ \n\t>]+\\)")
625 ;; start tag, skip any nested same pairs _and_ closing tag
626 (let ((case-fold-search t)
627 (re (concat "</?" (regexp-quote (match-string 1))))
628 point close)
629 (forward-list 1)
630 (setq point (point))
631 (while (and (re-search-forward re nil t)
632 (not (setq close
633 (eq (char-after (1+ (match-beginning 0))) ?/)))
634 (not (up-list -1))
635 (sgml-skip-tag-forward 1))
636 (setq close nil))
637 (if close
638 (up-list 1)
639 (goto-char point)
640 (setq return)))
641 (forward-list 1))
642 (setq arg (1- arg)))
643 return)
644
645(defun sgml-delete-tag (arg)
646 "Delete tag on or after cursor, and matching closing or opening tag.
f788776c 647With prefix argument ARG, repeat this ARG times."
1caf38eb
RS
648 (interactive "p")
649 (while (>= arg 1)
650 (save-excursion
651 (let* (close open)
fcc3195e 652 (if (looking-at "[ \t\n]*<")
1caf38eb
RS
653 ;; just before tag
654 (if (eq (char-after (match-end 0)) ?/)
655 ;; closing tag
656 (progn
657 (setq close (point))
658 (goto-char (match-end 0))))
659 ;; on tag?
660 (or (save-excursion (setq close (sgml-beginning-of-tag)
661 close (and (stringp close)
662 (eq (aref close 0) ?/)
663 (point))))
664 ;; not on closing tag
665 (let ((point (point)))
666 (sgml-skip-tag-backward 1)
667 (if (or (not (eq (following-char) ?<))
668 (save-excursion
669 (forward-list 1)
670 (<= (point) point)))
671 (error "Not on or before tag")))))
672 (if close
673 (progn
674 (sgml-skip-tag-backward 1)
675 (setq open (point))
676 (goto-char close)
677 (kill-sexp 1))
678 (setq open (point))
679 (sgml-skip-tag-forward 1)
680 (backward-list)
681 (forward-char)
682 (if (eq (aref (sgml-beginning-of-tag) 0) ?/)
683 (kill-sexp 1)))
684 (goto-char open)
685 (kill-sexp 1)))
686 (setq arg (1- arg))))
a391b179
RS
687\f
688;; Put read-only last to enable setting this even when read-only enabled.
689(or (get 'sgml-tag 'invisible)
690 (setplist 'sgml-tag
691 (append '(invisible t
692 intangible t
693 point-entered sgml-point-entered
694 rear-nonsticky t
695 read-only t)
696 (symbol-plist 'sgml-tag))))
1caf38eb
RS
697
698(defun sgml-tags-invisible (arg)
699 "Toggle visibility of existing tags."
700 (interactive "P")
701 (let ((modified (buffer-modified-p))
702 (inhibit-read-only t)
a391b179
RS
703 ;; This is needed in case font lock gets called,
704 ;; since it moves point and might call sgml-point-entered.
705 (inhibit-point-motion-hooks t)
1caf38eb
RS
706 symbol)
707 (save-excursion
a391b179 708 (goto-char (point-min))
1caf38eb
RS
709 (if (setq sgml-tags-invisible
710 (if arg
711 (>= (prefix-numeric-value arg) 0)
712 (not sgml-tags-invisible)))
713 (while (re-search-forward "<\\([!/?A-Za-z][-A-Za-z0-9]*\\)"
714 nil t)
715 (setq symbol (intern-soft (downcase (match-string 1))))
716 (goto-char (match-beginning 0))
717 (and (get symbol 'before-string)
718 (not (overlays-at (point)))
719 (overlay-put (make-overlay (point)
720 (match-beginning 1))
721 'category symbol))
a391b179
RS
722 (put-text-property (point)
723 (progn (forward-list) (point))
1caf38eb 724 'category 'sgml-tag))
a391b179
RS
725 (let ((pos (point)))
726 (while (< (setq pos (next-overlay-change pos)) (point-max))
727 (delete-overlay (car (overlays-at pos)))))
1caf38eb
RS
728 (remove-text-properties (point-min) (point-max)
729 '(category sgml-tag intangible t))))
730 (set-buffer-modified-p modified)
731 (run-hooks 'sgml-tags-invisible-hook)
732 (message "")))
733
734(defun sgml-point-entered (x y)
735 ;; Show preceding or following hidden tag, depending of cursor direction.
736 (let ((inhibit-point-motion-hooks t))
737 (save-excursion
738 (message "Invisible tag: %s"
739 (buffer-substring
740 (point)
741 (if (or (and (> x y)
742 (not (eq (following-char) ?<)))
743 (and (< x y)
744 (eq (preceding-char) ?>)))
745 (backward-list)
746 (forward-list)))))))
a391b179 747\f
1caf38eb
RS
748(autoload 'compile-internal "compile")
749
72c0ae01
ER
750(defun sgml-validate (command)
751 "Validate an SGML document.
752Runs COMMAND, a shell command, in a separate process asynchronously
f788776c 753with output going to the buffer `*compilation*'.
72c0ae01
ER
754You can then use the command \\[next-error] to find the next error message
755and move to the line in the SGML document that caused it."
756 (interactive
757 (list (read-string "Validate command: "
758 (or sgml-saved-validate-command
759 (concat sgml-validate-command
760 " "
761 (let ((name (buffer-file-name)))
762 (and name
763 (file-name-nondirectory name))))))))
764 (setq sgml-saved-validate-command command)
0afdd8d0
RS
765 (if (or (not compilation-ask-about-save)
766 (y-or-n-p (message "Save buffer %s? " (buffer-name))))
767 (save-buffer))
c7aa4667 768 (compile-internal command "No more errors"))
72c0ae01 769
1caf38eb
RS
770
771(defun sgml-beginning-of-tag (&optional top-level)
772 "Skip to beginning of tag and return its name.
f788776c 773If this can't be done, return t."
1caf38eb
RS
774 (or (if top-level
775 (condition-case nil
776 (up-list -1)
777 (error t))
778 (>= (point)
779 (if (search-backward "<" nil t)
780 (save-excursion
781 (forward-list)
782 (point))
783 0)))
784 (if (looking-at "<[!?/]?[[A-Za-z][A-Za-z0-9]*")
785 (buffer-substring-no-properties
786 (1+ (point))
787 (match-end 0))
788 t)))
789
790(defun sgml-value (alist)
f788776c
RS
791 "Interactively insert value taken from attributerule ALIST.
792See `sgml-tag-alist' for info about attributerules.."
1caf38eb
RS
793 (setq alist (cdr alist))
794 (if (stringp (car alist))
795 (insert "=\"" (car alist) ?\")
796 (if (eq (car alist) t)
797 (if (cdr alist)
798 (progn
799 (insert "=\"")
800 (setq alist (skeleton-read '(completing-read
d10447ba 801 "Value: " (cdr alist))))
1caf38eb 802 (if (string< "" alist)
a391b179 803 (insert alist ?\")
1caf38eb
RS
804 (delete-backward-char 2))))
805 (insert "=\"")
806 (if alist
a391b179 807 (insert (skeleton-read '(completing-read "Value: " alist))))
1caf38eb
RS
808 (insert ?\"))))
809
810(provide 'sgml-mode)
811\f
fcc3195e 812(defvar html-quick-keys sgml-quick-keys
b1e7bb48 813 "Use C-c X combinations for quick insertion of frequent tags when non-nil.
fcc3195e 814This defaults to `sgml-quick-keys'.
1caf38eb
RS
815This takes effect when first loading the library.")
816
817(defvar html-mode-map
818 (let ((map (nconc (make-sparse-keymap) sgml-mode-map))
819 (menu-map (make-sparse-keymap "HTML")))
7e49eef2
RS
820 (define-key map "\C-c6" 'html-headline-6)
821 (define-key map "\C-c5" 'html-headline-5)
822 (define-key map "\C-c4" 'html-headline-4)
823 (define-key map "\C-c3" 'html-headline-3)
824 (define-key map "\C-c2" 'html-headline-2)
825 (define-key map "\C-c1" 'html-headline-1)
fcc3195e
RS
826 (define-key map "\C-c\r" 'html-paragraph)
827 (define-key map "\C-c\n" 'html-line)
828 (define-key map "\C-c\C-c-" 'html-horizontal-rule)
7e49eef2
RS
829 (define-key map "\C-c\C-co" 'html-ordered-list)
830 (define-key map "\C-c\C-cu" 'html-unordered-list)
fcc3195e
RS
831 (define-key map "\C-c\C-cr" 'html-radio-buttons)
832 (define-key map "\C-c\C-cc" 'html-checkboxes)
833 (define-key map "\C-c\C-cl" 'html-list-item)
834 (define-key map "\C-c\C-ch" 'html-href-anchor)
835 (define-key map "\C-c\C-cn" 'html-name-anchor)
836 (define-key map "\C-c\C-ci" 'html-image)
1caf38eb
RS
837 (if html-quick-keys
838 (progn
1caf38eb 839 (define-key map "\C-c-" 'html-horizontal-rule)
7e49eef2
RS
840 (define-key map "\C-co" 'html-ordered-list)
841 (define-key map "\C-cu" 'html-unordered-list)
1caf38eb 842 (define-key map "\C-cr" 'html-radio-buttons)
fcc3195e 843 (define-key map "\C-cc" 'html-checkboxes)
1caf38eb
RS
844 (define-key map "\C-cl" 'html-list-item)
845 (define-key map "\C-ch" 'html-href-anchor)
846 (define-key map "\C-cn" 'html-name-anchor)
847 (define-key map "\C-ci" 'html-image)))
848 (define-key map "\C-c\C-s" 'html-autoview-mode)
849 (define-key map "\C-c\C-v" 'browse-url-of-buffer)
850 (define-key map [menu-bar html] (cons "HTML" menu-map))
851 (define-key menu-map [html-autoview-mode]
852 '("Toggle Autoviewing" . html-autoview-mode))
853 (define-key menu-map [browse-url-of-buffer]
854 '("View Buffer Contents" . browse-url-of-buffer))
855 (define-key menu-map [nil] '("--"))
7e49eef2
RS
856 ;;(define-key menu-map "6" '("Heading 6" . html-headline-6))
857 ;;(define-key menu-map "5" '("Heading 5" . html-headline-5))
858 ;;(define-key menu-map "4" '("Heading 4" . html-headline-4))
859 (define-key menu-map "3" '("Heading 3" . html-headline-3))
860 (define-key menu-map "2" '("Heading 2" . html-headline-2))
861 (define-key menu-map "1" '("Heading 1" . html-headline-1))
1caf38eb 862 (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons))
fcc3195e 863 (define-key menu-map "c" '("Checkboxes" . html-checkboxes))
1caf38eb 864 (define-key menu-map "l" '("List Item" . html-list-item))
7e49eef2
RS
865 (define-key menu-map "u" '("Unordered List" . html-unordered-list))
866 (define-key menu-map "o" '("Ordered List" . html-ordered-list))
fcc3195e 867 (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule))
1caf38eb
RS
868 (define-key menu-map "\n" '("Line Break" . html-line))
869 (define-key menu-map "\r" '("Paragraph" . html-paragraph))
870 (define-key menu-map "i" '("Image" . html-image))
871 (define-key menu-map "h" '("Href Anchor" . html-href-anchor))
872 (define-key menu-map "n" '("Name Anchor" . html-name-anchor))
873 map)
874 "Keymap for commands for use in HTML mode.")
875
876
877(defvar html-face-tag-alist
878 '((bold . "b")
879 (italic . "i")
880 (underline . "u")
881 (modeline . "rev"))
882 "Value of `sgml-face-tag-alist' for HTML mode.")
883
884(defvar html-tag-face-alist
885 '(("b" . bold)
886 ("big" . bold)
887 ("blink" . highlight)
888 ("cite" . italic)
889 ("em" . italic)
890 ("h1" bold underline)
891 ("h2" bold-italic underline)
892 ("h3" italic underline)
893 ("h4" . underline)
894 ("h5" . underline)
895 ("h6" . underline)
896 ("i" . italic)
897 ("rev" . modeline)
898 ("s" . underline)
899 ("small" . default)
900 ("strong" . bold)
901 ("title" bold underline)
902 ("tt" . default)
903 ("u" . underline)
904 ("var" . italic))
905 "Value of `sgml-tag-face-alist' for HTML mode.")
906
907
908(defvar html-display-text
909 '((img . "[/]")
910 (hr . "----------")
911 (li . "o "))
912 "Value of `sgml-display-text' for HTML mode.")
913
914
915; should code exactly HTML 3 here when that is finished
916(defvar html-tag-alist
d10447ba
RS
917 (let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7")))
918 (1-9 '(,@1-7 ("8") ("9")))
1caf38eb
RS
919 (align '(("align" ("left") ("center") ("right"))))
920 (valign '(("top") ("middle") ("bottom") ("baseline")))
921 (rel '(("next") ("previous") ("parent") ("subdocument") ("made")))
922 (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:")
923 ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:")
fcc3195e 924 ("wais:") ("/cgi-bin/")))
1caf38eb
RS
925 (name '("name"))
926 (link `(,href
927 ("rel" ,@rel)
928 ("rev" ,@rel)
929 ("title")))
d10447ba
RS
930 (list '((nil \n ( "List item: "
931 "<li>" str \n))))
1caf38eb
RS
932 (cell `(t
933 ,align
934 ("valign" ,@valign)
935 ("colspan" ,@1-9)
936 ("rowspan" ,@1-9)
937 ("nowrap" t))))
938 ;; put ,-expressions first, else byte-compile chokes (as of V19.29)
939 ;; and like this it's more efficient anyway
940 `(("a" ,name ,@link)
941 ("base" t ,@href)
942 ("dir" ,@list)
d10447ba 943 ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)
fcc3195e
RS
944 ("form" (\n _ \n "<input type=\"submit\" value=\"\">")
945 ("action" ,@(cdr href)) ("method" ("get") ("post")))
1caf38eb
RS
946 ("h1" ,@align)
947 ("h2" ,@align)
948 ("h3" ,@align)
949 ("h4" ,@align)
950 ("h5" ,@align)
951 ("h6" ,@align)
952 ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align)
953 ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom"))
954 ("src") ("alt") ("width" "1") ("height" "1")
955 ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t))
956 ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name
fcc3195e
RS
957 ("type" ("text") ("password") ("checkbox") ("radio")
958 ("submit") ("reset"))
1caf38eb
RS
959 ("value"))
960 ("link" t ,@link)
961 ("menu" ,@list)
d10447ba 962 ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1")))
1caf38eb
RS
963 ("p" t ,@align)
964 ("select" (nil \n
965 ("Text: "
966 "<option>" str \n))
967 ,name ("size" ,@1-9) ("multiple" t))
968 ("table" (nil \n
969 ((completing-read "Cell kind: " '(("td") ("th"))
970 nil t "t")
971 "<tr><" str ?> _ \n))
972 ("border" t ,@1-9) ("width" "10") ("cellpadding"))
973 ("td" ,@cell)
974 ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
975 ("th" ,@cell)
d10447ba 976 ("ul" ,@list ("type" ("disc") ("circle") ("square")))
1caf38eb
RS
977
978 ,@sgml-tag-alist
979
980 ("abbrev")
981 ("acronym")
982 ("address")
983 ("array" (nil \n
984 ("Item: " "<item>" str \n))
985 "align")
986 ("au")
987 ("b")
988 ("big")
989 ("blink")
990 ("blockquote" \n)
991 ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#")
992 ("link" "#") ("alink" "#") ("vlink" "#"))
993 ("box" (nil _ "<over>" _))
994 ("br" t ("clear" ("left") ("right")))
995 ("caption" ("valign" ("top") ("bottom")))
996 ("center" \n)
997 ("cite")
998 ("code" \n)
999 ("dd" t)
1000 ("del")
1001 ("dfn")
1002 ("dl" (nil \n
1003 ( "Term: "
1004 "<dt>" str "<dd>" _ \n)))
1005 ("dt" (t _ "<dd>"))
1006 ("em")
d10447ba 1007 ;("fn" "id" "fn") ; ???
1caf38eb
RS
1008 ("head" \n)
1009 ("html" (\n
1010 "<head>\n"
1011 "<title>" (setq str (read-input "Title: ")) "</title>\n"
1012 "<body>\n<h1>" str "</h1>\n" _
1013 "\n<address>\n<a href=\"mailto:"
be047262 1014 user-mail-address
1caf38eb
RS
1015 "\">" (user-full-name) "</a>\n</address>"))
1016 ("i")
1017 ("ins")
1018 ("isindex" t ("action") ("prompt"))
1019 ("kbd")
1020 ("lang")
1021 ("li" t)
1022 ("math" \n)
1023 ("nobr")
1024 ("option" t ("value") ("label") ("selected" t))
1025 ("over" t)
1026 ("person")
1027 ("pre" \n)
1028 ("q")
1029 ("rev")
1030 ("s")
1031 ("samp")
1032 ("small")
1033 ("strong")
1034 ("sub")
1035 ("sup")
1036 ("title")
1037 ("tr" t)
1038 ("tt")
1039 ("u")
1040 ("var")
1041 ("wbr" t)))
1042 "*Value of `sgml-tag-alist' for HTML mode.")
1043
1044(defvar html-tag-help
1045 `(,@sgml-tag-help
1046 ("a" . "Anchor of point or link elsewhere")
1047 ("abbrev" . "?")
1048 ("acronym" . "?")
1049 ("address" . "Formatted mail address")
1050 ("array" . "Math array")
1051 ("au" . "?")
1052 ("b" . "Bold face")
1053 ("base" . "Base address for URLs")
1054 ("big" . "Font size")
1055 ("blink" . "Blinking text")
1056 ("blockquote" . "Indented quotation")
1057 ("body" . "Document body")
1058 ("box" . "Math fraction")
1059 ("br" . "Line break")
1060 ("caption" . "Table caption")
1061 ("center" . "Centered text")
1062 ("changed" . "Change bars")
1063 ("cite" . "Citation of a document")
1064 ("code" . "Formatted source code")
1065 ("dd" . "Definition of term")
1066 ("del" . "?")
1067 ("dfn" . "?")
1068 ("dir" . "Directory list (obsolete)")
1069 ("dl" . "Definition list")
1070 ("dt" . "Term to be definined")
1071 ("em" . "Emphasised")
1072 ("embed" . "Embedded data in foreign format")
1073 ("fig" . "Figure")
1074 ("figa" . "Figure anchor")
1075 ("figd" . "Figure description")
1076 ("figt" . "Figure text")
d10447ba 1077 ;("fn" . "?") ; ???
1caf38eb
RS
1078 ("font" . "Font size")
1079 ("form" . "Form with input fields")
1080 ("group" . "Document grouping")
1081 ("h1" . "Most important section headline")
1082 ("h2" . "Important section headline")
1083 ("h3" . "Section headline")
1084 ("h4" . "Minor section headline")
1085 ("h5" . "Unimportant section headline")
1086 ("h6" . "Least important section headline")
1087 ("head" . "Document header")
1088 ("hr" . "Horizontal rule")
1089 ("html" . "HTML Document")
1090 ("i" . "Italic face")
1091 ("img" . "Graphic image")
1092 ("input" . "Form input field")
1093 ("ins" . "?")
1094 ("isindex" . "Input field for index search")
1095 ("kbd" . "Keybard example face")
1096 ("lang" . "Natural language")
1097 ("li" . "List item")
1098 ("link" . "Link relationship")
1099 ("math" . "Math formula")
1100 ("menu" . "Menu list (obsolete)")
1101 ("mh" . "Form mail header")
1102 ("nextid" . "Allocate new id")
1103 ("nobr" . "Text without line break")
1104 ("ol" . "Ordered list")
1105 ("option" . "Selection list item")
1106 ("over" . "Math fraction rule")
1107 ("p" . "Paragraph start")
1108 ("panel" . "Floating panel")
1109 ("person" . "?")
1110 ("pre" . "Preformatted fixed width text")
1111 ("q" . "?")
1112 ("rev" . "Reverse video")
1113 ("s" . "?")
1114 ("samp" . "Sample text")
1115 ("select" . "Selection list")
1116 ("small" . "Font size")
1117 ("sp" . "Nobreak space")
1118 ("strong" . "Standout text")
1119 ("sub" . "Subscript")
1120 ("sup" . "Superscript")
1121 ("table" . "Table with rows and columns")
1122 ("tb" . "Table vertical break")
1123 ("td" . "Table data cell")
1124 ("textarea" . "Form multiline edit area")
1125 ("th" . "Table header cell")
1126 ("title" . "Document title")
1127 ("tr" . "Table row separator")
1128 ("tt" . "Typewriter face")
1129 ("u" . "Underlined text")
1130 ("ul" . "Unordered list")
1131 ("var" . "Math variable face")
1132 ("wbr" . "Enable <br> within <nobr>"))
1133"*Value of `sgml-tag-help' for HTML mode.")
1134
1135
1136
1137;;;###autoload
1138(defun html-mode ()
1139 "Major mode based on SGML mode for editing HTML documents.
fcc3195e
RS
1140This allows inserting skeleton costructs used in hypertext documents with
1141completion. See below for an introduction to HTML. Use
1142\\[browse-url-of-buffer] to see how this comes out. See also `sgml-mode' on
1143which this is based.
1caf38eb 1144
fcc3195e 1145Do \\[describe-variable] html- SPC and \\[describe-variable] sgml- SPC to see available variables.
1caf38eb
RS
1146
1147To write fairly well formatted pages you only need to know few things. Most
1148browsers have a function to read the source code of the page being seen, so
1149you can imitate various tricks. Here's a very short HTML primer which you
1150can also view with a browser to see what happens:
1151
1152<title>A Title Describing Contents</title> should be on every page. Pages can
1153have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
1154<hr> Parts can be separated with horizontal rules.
1155
1156<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are
1157ignored unless the text is <pre>preformatted.</pre> Text can be marked as
1158<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-g or
1159Edit/Text Properties/Face commands.
1160
1161Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
1162to them with <a href=\"#SOMENAME\">see also somename</a>. In the same way <a
1163href=\"URL\">see also URL</a> where URL is a filename relative to current
f788776c 1164directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'.
1caf38eb
RS
1165
1166Images in many formats can be inlined with <img src=\"URL\">.
1167
f788776c
RS
1168If you mainly create your own documents, `sgml-specials' might be
1169interesting. But note that some HTML 2 browsers can't handle `&apos;'.
1170To work around that, do:
1171 (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
1caf38eb 1172
1caf38eb
RS
1173\\{html-mode-map}"
1174 (interactive)
1175 (sgml-mode-common html-tag-face-alist html-display-text)
1176 (use-local-map html-mode-map)
1177 (make-local-variable 'sgml-tag-alist)
1178 (make-local-variable 'sgml-face-tag-alist)
1179 (make-local-variable 'sgml-tag-help)
1180 (make-local-variable 'outline-regexp)
1181 (make-local-variable 'outline-heading-end-regexp)
1182 (make-local-variable 'outline-level)
da84bdc4
RS
1183 (make-local-variable 'sentence-end)
1184 (setq sentence-end
1185 "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\| $\\|\t\\| \\)[ \t\n]*")
1caf38eb
RS
1186 (setq mode-name "HTML"
1187 major-mode 'html-mode
1188 sgml-tag-alist html-tag-alist
1189 sgml-face-tag-alist html-face-tag-alist
1190 sgml-tag-help html-tag-help
1191 outline-regexp "^.*<[Hh][1-6]\\>"
1192 outline-heading-end-regexp "</[Hh][1-6]>"
1193 outline-level (lambda ()
1194 (char-after (1- (match-end 0)))))
1195 (run-hooks 'html-mode-hook))
1196
1197
1198(define-skeleton html-href-anchor
1199 "HTML anchor tag with href attribute."
a391b179
RS
1200 "URL: "
1201 '(setq input "http:")
1202 "<a href=\"" str "\">" _ "</a>")
1caf38eb
RS
1203
1204(define-skeleton html-name-anchor
1205 "HTML anchor tag with name attribute."
a391b179
RS
1206 "Name: "
1207 "<a name=\"" str "\">" _ "</a>")
1caf38eb 1208
7e49eef2
RS
1209(define-skeleton html-headline-1
1210 "HTML level 1 headline tags."
1211 nil
1212 "<h1>" _ "</h1>")
1213
1214(define-skeleton html-headline-2
1215 "HTML level 2 headline tags."
1216 nil
1217 "<h2>" _ "</h2>")
1218
1219(define-skeleton html-headline-3
1220 "HTML level 3 headline tags."
1221 nil
1222 "<h3>" _ "</h3>")
1223
1224(define-skeleton html-headline-4
1225 "HTML level 4 headline tags."
1226 nil
1227 "<h4>" _ "</h4>")
1228
1229(define-skeleton html-headline-5
1230 "HTML level 5 headline tags."
1231 nil
1232 "<h5>" _ "</h5>")
1233
1234(define-skeleton html-headline-6
1235 "HTML level 6 headline tags."
1236 nil
1237 "<h6>" _ "</h6>")
1caf38eb
RS
1238
1239(define-skeleton html-horizontal-rule
1240 "HTML horizontal rule tag."
1241 nil
1242 "<hr>" \n)
1243
1244(define-skeleton html-image
1245 "HTML image tag."
1246 nil
a391b179 1247 "<img src=\"" _ "\">")
1caf38eb
RS
1248
1249(define-skeleton html-line
1250 "HTML line break tag."
1251 nil
1252 "<br>" \n)
1253
7e49eef2
RS
1254(define-skeleton html-ordered-list
1255 "HTML ordered list tags."
1256 nil
a391b179 1257 "<ol>" \n
7e49eef2
RS
1258 "<li>" _ \n
1259 "</ol>")
1260
1261(define-skeleton html-unordered-list
1262 "HTML unordered list tags."
1263 nil
a391b179 1264 "<ul>" \n
1caf38eb 1265 "<li>" _ \n
7e49eef2 1266 "</ul>")
1caf38eb
RS
1267
1268(define-skeleton html-list-item
1269 "HTML list item tag."
1270 nil
1271 (if (bolp) nil '\n)
1272 "<li>")
1273
1274(define-skeleton html-paragraph
1275 "HTML paragraph tag."
1276 nil
1277 (if (bolp) nil ?\n)
1278 \n "<p>")
1279
fcc3195e
RS
1280(define-skeleton html-checkboxes
1281 "Group of connected checkbox inputs."
1282 nil
a391b179
RS
1283 '(setq v1 nil
1284 v2 nil)
1285 ("Value: "
d10447ba 1286 "<input type=\"" (identity "checkbox") ; see comment above about identity
a391b179 1287 "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
fcc3195e 1288 "\" value=\"" str ?\"
a391b179
RS
1289 (if (y-or-n-p "Set \"checked\" attribute? ")
1290 (funcall skeleton-transformation " checked")) ">"
1291 (skeleton-read "Text: " (capitalize str))
1292 (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
1293 (funcall skeleton-transformation "<br>")
1294 "")))
1295 \n))
fcc3195e 1296
1caf38eb
RS
1297(define-skeleton html-radio-buttons
1298 "Group of connected radio button inputs."
1299 nil
a391b179
RS
1300 '(setq v1 nil
1301 v2 (cons nil nil))
1302 ("Value: "
d10447ba 1303 "<input type=\"" (identity "radio") ; see comment above about identity
a391b179 1304 "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
1caf38eb 1305 "\" value=\"" str ?\"
a391b179
RS
1306 (if (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
1307 (funcall skeleton-transformation " checked") ">")
1308 (skeleton-read "Text: " (capitalize str))
1309 (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
1310 (funcall skeleton-transformation "<br>")
1311 "")))
1312 \n))
1caf38eb
RS
1313
1314
1315(defun html-autoview-mode (&optional arg)
1316 "Toggle automatic viewing via `html-viewer' upon saving buffer.
1317With positive prefix ARG always turns viewing on, with negative ARG always off.
1318Can be used as a value for `html-mode-hook'."
1319 (interactive "P")
1320 (if (setq arg (if arg
1321 (< (prefix-numeric-value arg) 0)
1322 (and (boundp 'after-save-hook)
1323 (memq 'browse-url-of-buffer after-save-hook))))
1324 (setq after-save-hook (delq 'browse-url-of-buffer after-save-hook))
1325 (make-local-hook 'after-save-hook)
1326 (add-hook 'after-save-hook 'browse-url-of-buffer nil t))
1327 (message "Autoviewing turned %s."
1328 (if arg "off" "on")))
1329
72c0ae01 1330;;; sgml-mode.el ends here