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