;;; sgml-mode.el --- SGML- and HTML-editing modes
-;; Copyright (C) 1992, 1995, 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1995, 1996, 1998 Free Software Foundation, Inc.
;; Author: James Clark <jjc@jclark.com>
-;; Adapted-By: ESR; Daniel.Pfeiffer@Informatik.START.dbp.de
+;; Adapted-By: ESR, Daniel Pfeiffer <occitan@esperanto.org>,
+;; F.Potorti@cnuce.cnr.it
;; Keywords: wp, hypermedia, comm, languages
;; This file is part of GNU Emacs.
;;; Code:
+(eval-when-compile (require 'skeleton))
+
(defgroup sgml nil
"SGML editing mode"
:group 'languages)
+(defcustom sgml-transformation 'identity
+ "*Default value for `skeleton-transformation' (which see) in SGML mode."
+ :type 'function
+ :group 'sgml)
+
+(put 'sgml-transformation 'variable-interactive
+ "aTransformation function: ")
+
;; As long as Emacs' syntax can't be complemented with predicates to context
;; sensitively confirm the syntax of characters, we have to live with this
;; kludgy kind of tradeoff.
(defvar sgml-specials '(?\")
- "List of characters that have a special meaning for sgml-mode.
+ "List of characters that have a special meaning for SGML mode.
This list is used when first loading the sgml-mode library.
The supported characters and potential disadvantages are:
?' Makes ' in text start a string.
?- Makes -- in text start a comment.
-When only one of ?\\\" or ?' are included, \"'\" or '\"' as it can be found in
+When only one of ?\\\" or ?' are included, \"'\" or '\"', as can be found in
DTDs, start a string. To partially avoid this problem this also makes these
self insert as named entities depending on `sgml-quick-keys'.
with comments, so we normally turn it off.")
(defvar sgml-quick-keys nil
- "Use <, >, &, SPC and `sgml-specials' keys ``electrically'' when non-nil.
-This takes effect when first loading the library.")
+ "Use <, >, &, SPC and `sgml-specials' keys \"electrically\" when non-nil.
+This takes effect when first loading the sgml-mode library.")
(defvar sgml-mode-map
(defcustom sgml-name-8bit-mode nil
- "*When non-`nil' insert 8 bit characters with their names."
+ "*When non-nil, insert 8 bit characters with their names."
:type 'boolean
:group 'sgml)
nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil
- "ensp" "excl" "quot" "num" "dollar" "percnt" "amp" "apos"
+ "nbsp" "excl" "quot" "num" "dollar" "percnt" "amp" "apos"
"lpar" "rpar" "ast" "plus" "comma" "hyphen" "period" "sol"
nil nil nil nil nil nil nil nil
nil nil "colon" "semi" "lt" "eq" "gt" "quest"
;;; I doubt that null end tags are used much for large elements,
;;; so use a small distance here.
(defcustom sgml-slash-distance 1000
- "*If non-nil, is the maximum distance to search for matching /."
+ "*If non-nil, is the maximum distance to search for matching `/'."
:type '(choice (const nil) integer)
:group 'sgml)
(defconst sgml-start-tag-regex
"<[A-Za-z]\\([-.A-Za-z0-9= \n\t]\\|\"[^\"]*\"\\|'[^']*'\\)*"
"Regular expression that matches a non-empty start tag.
-Any terminating > or / is not matched.")
+Any terminating `>' or `/' is not matched.")
+
+;; internal
+(defconst sgml-font-lock-keywords-1
+ '(("<\\([!?][a-z][-.a-z0-9]*\\)" 1 font-lock-keyword-face)
+ ("<\\(/?[a-z][-.a-z0-9]*\\)" 1 font-lock-function-name-face)
+ ("[&%][a-z][-.a-z0-9]*;?" . font-lock-variable-name-face)
+ ("<! *--.*-- *>" . font-lock-comment-face)))
+
+(defconst sgml-font-lock-keywords-2 ())
-(defvar sgml-font-lock-keywords
- '(("<\\([!?][a-z0-9]+\\)" 1 font-lock-keyword-face)
- ("<\\(/?[a-z0-9]+\\)" 1 font-lock-function-name-face)
- ("[&%][-.A-Za-z0-9]+;?" . font-lock-variable-name-face)
- ("<!--[^<>]*-->" . font-lock-comment-face))
+;; for font-lock, but must be defvar'ed after
+;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above
+(defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
"*Rules for highlighting SGML code. See also `sgml-tag-face-alist'.")
;; internal
-(defvar sgml-font-lock-keywords-1 ())
-
(defvar sgml-face-tag-alist ()
"Alist of face and tag name for facemenu.")
(string :tag "Description")))
:group 'sgml)
-
-;; put read-only last to enable setting this even when read-only enabled
-(or (get 'sgml-tag 'invisible)
- (setplist 'sgml-tag
- (append '(invisible t
- rear-nonsticky t
- point-entered sgml-point-entered
- read-only t)
- (symbol-plist 'sgml-tag))))
-
-
+(defvar v2) ; free for skeleton
(defun sgml-mode-common (sgml-tag-face-alist sgml-display-text)
"Common code for setting up `sgml-mode' and derived modes.
-SGML-TAG-FACE-ALIST is used for calculating `sgml-font-lock-keywords-1'.
+SGML-TAG-FACE-ALIST is used for calculating `sgml-font-lock-keywords-2'.
SGML-DISPLAY-TEXT sets up alternate text for when tags are invisible (see
varables of same name)."
- (kill-all-local-variables)
(setq local-abbrev-table text-mode-abbrev-table)
(set-syntax-table sgml-mode-syntax-table)
(make-local-variable 'indent-line-function)
(make-local-variable 'paragraph-start)
(make-local-variable 'paragraph-separate)
+ (make-local-variable 'adaptive-fill-regexp)
(make-local-variable 'sgml-saved-validate-command)
(make-local-variable 'comment-start)
(make-local-variable 'comment-end)
(make-local-variable 'skeleton-end-hook)
(make-local-variable 'font-lock-defaults)
(make-local-variable 'sgml-font-lock-keywords-1)
+ (make-local-variable 'sgml-font-lock-keywords-2)
(make-local-variable 'facemenu-add-face-function)
(make-local-variable 'facemenu-end-add-face)
;;(make-local-variable 'facemenu-remove-face-function)
`((1 (,(concat "<\\("
(mapconcat 'car sgml-tag-face-alist "\\|")
"\\)\\([ \t].+\\)?>\\(.+\\)</\\1>")
- 3 (cdr (assoc (match-string 1) ',sgml-tag-face-alist)))))))
+ 3 (cdr (assoc (downcase (match-string 1))
+ ',sgml-tag-face-alist)))))))
(setq indent-line-function 'indent-relative-maybe
;; A start or end tag by itself on a line separates a paragraph.
;; This is desirable because SGML discards a newline that appears
;; immediately after a start tag or immediately before an end tag.
- paragraph-start "^[ \t\n]\\|\
-\\(</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$\\)"
- paragraph-separate "^[ \t\n]*$\\|\
-^</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$"
+ paragraph-separate "[ \t]*$\\|\
+\[ \t]*</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$"
+ paragraph-start "[ \t]*$\\|\
+\[ \t]*</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$"
+ adaptive-fill-regexp "[ \t]*"
comment-start "<!-- "
comment-end " -->"
comment-indent-function 'sgml-comment-indent
;; This will allow existing comments within declarations to be
;; recognized.
comment-start-skip "--[ \t]*"
- skeleton-transformation 'identity
+ skeleton-transformation sgml-transformation
skeleton-further-elements '((completion-ignore-case t))
skeleton-end-hook (lambda ()
(or (eolp)
(not (or (eq v2 '\n)
(eq (car-safe v2) '\n)))
(newline-and-indent)))
- sgml-font-lock-keywords-1 (cdr (assq 1 sgml-tag-face-alist))
+ sgml-font-lock-keywords-2 (append
+ sgml-font-lock-keywords-1
+ (cdr (assq 1 sgml-tag-face-alist)))
font-lock-defaults '((sgml-font-lock-keywords
- sgml-font-lock-keywords-1)
+ sgml-font-lock-keywords-1
+ sgml-font-lock-keywords-2)
nil
t)
facemenu-add-face-function 'sgml-mode-facemenu-add-face-function)
(while sgml-display-text
(put (car (car sgml-display-text)) 'before-string
(cdr (car sgml-display-text)))
- (setq sgml-display-text (cdr sgml-display-text)))
- (run-hooks 'text-mode-hook 'sgml-mode-hook))
+ (setq sgml-display-text (cdr sgml-display-text))))
(defun sgml-mode-facemenu-add-face-function (face end)
Keys <, &, SPC within <>, \" and ' can be electric depending on
`sgml-quick-keys'.
-Do \\[describe-variable] sgml- SPC to see available variables.
+An argument of N to a tag-inserting command means to wrap it around
+the next N words. In Transient Mark mode, when the mark is active,
+N defaults to -1, which means to wrap it around the current region.
+
+If you like upcased tags, put (setq sgml-transformation 'upcase) in
+your `.emacs' file.
Use \\[sgml-validate] to validate your document with an SGML parser.
+
+Do \\[describe-variable] sgml- SPC to see available variables.
+Do \\[describe-key] on the following bindings to discover what they do.
\\{sgml-mode-map}"
(interactive)
+ (kill-all-local-variables)
+ (setq mode-name "SGML"
+ major-mode 'sgml-mode)
(sgml-mode-common sgml-tag-face-alist sgml-display-text)
+ ;; Set imenu-generic-expression here, rather than in sgml-mode-common,
+ ;; because this definition probably is not useful in HTML mode.
+ (make-local-variable 'imenu-generic-expression)
+ (setq imenu-generic-expression
+ "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\([A-Za-z][-A-Za-z.0-9]*\\)")
(use-local-map sgml-mode-map)
- (setq mode-name "SGML"
- major-mode 'sgml-mode))
-
+ (run-hooks 'text-mode-hook 'sgml-mode-hook))
(defun sgml-comment-indent ()
(defun sgml-slash (arg)
- "Insert / and display any previous matching /.
-Two /s are treated as matching if the first / ends a net-enabling
-start tag, and the second / is the corresponding null end tag."
+ "Insert `/' and display any previous matching `/'.
+Two `/'s are treated as matching if the first `/' ends a net-enabling
+start tag, and the second `/' is the corresponding null end tag."
(interactive "p")
(insert-char ?/ arg)
(if (> arg 0)
(interactive "*")
(insert ?&)
(or char
- (setq char (read-quoted-char)))
+ (setq char (read-quoted-char "Enter char or octal number")))
(delete-backward-char 1)
(insert char)
(undo-boundary)
(defun sgml-name-8bit-mode ()
"Toggle insertion of 8 bit characters."
(interactive)
- (setq sgml-name-8bit-mode (not sgml-name-8bit-mode)))
+ (setq sgml-name-8bit-mode (not sgml-name-8bit-mode))
+ (message "sgml name 8 bit mode is now %s"
+ (if sgml-name-8bit-mode "ON" "OFF")))
+;; When an element of a skeleton is a string "str", it is passed
+;; through skeleton-transformation and inserted. If "str" is to be
+;; inserted literally, one should obtain it as the return value of a
+;; function, e.g. (identity "str").
(define-skeleton sgml-tag
- "Insert a tag you are prompted for, optionally with attributes.
-Completion and configuration is according to `sgml-tag-alist'.
-If you like tags and attributes in uppercase set `skeleton-transformation'
-to `upcase'."
+ "Prompt for a tag and insert it, optionally with attributes.
+Completion and configuration are done according to `sgml-tag-alist'.
+If you like tags and attributes in uppercase do \\[set-variable]
+skeleton-transformation RET upcase RET, or put this in your `.emacs':
+ (setq sgml-transformation 'upcase)"
(funcall skeleton-transformation
(completing-read "Tag: " sgml-tag-alist))
?< (setq v1 (eval str)) |
- (("") -1 '(undo-boundary) "<") |
+ (("") -1 '(undo-boundary) (identity "<")) | ; see comment above
(("") '(setq v2 (sgml-attributes v1 t)) ?>
(if (string= "![" v1)
(prog1 '(("") " [ " _ " ]]")
(autoload 'skeleton-read "skeleton")
-(defun sgml-attributes (alist &optional quiet)
- "When at toplevel of a tag, interactively insert attributes."
+(defun sgml-attributes (tag &optional quiet)
+ "When at top level of a tag, interactively insert attributes.
+
+Completion and configuration of TAG are done according to `sgml-tag-alist'.
+If QUIET, do not print a message when there are no attributes for TAG."
(interactive (list (save-excursion (sgml-beginning-of-tag t))))
- (or (stringp alist) (error "Wrong context for adding attribute"))
- (if alist
+ (or (stringp tag) (error "Wrong context for adding attribute"))
+ (if tag
(let ((completion-ignore-case t)
+ (alist (cdr (assoc (downcase tag) sgml-tag-alist)))
car attribute i)
- (setq alist (cdr (assoc (downcase alist) sgml-tag-alist)))
(if (or (symbolp (car alist))
(symbolp (car (car alist))))
(setq car (car alist)
(message "No attributes configured."))
(if (stringp (car alist))
(progn
- (insert (if (eq (preceding-char) ? ) "" ? ) (car alist))
+ (insert (if (eq (preceding-char) ? ) "" ? )
+ (funcall skeleton-transformation (car alist)))
(sgml-value alist))
(setq i (length alist))
(while (> i 0)
(insert (funcall skeleton-transformation
(setq attribute
(skeleton-read '(completing-read
- "[Attribute]: "
+ "Attribute: "
alist)))))
(if (string= "" attribute)
(setq i 0)
- (sgml-value (assoc attribute alist))
+ (sgml-value (assoc (downcase attribute) alist))
(setq i (1- i))))
(if (eq (preceding-char) ? )
(delete-backward-char 1)))
car)))
(defun sgml-auto-attributes (arg)
- "Self insert, except, when at top level of tag, prompt for attributes.
-With prefix ARG only self insert."
+ "Self insert the character typed; at top level of tag, prompt for attributes.
+With prefix argument, only self insert."
(interactive "*P")
(let ((point (point))
tag)
(defun sgml-tag-help (&optional tag)
- "Display description of optional TAG or tag at point."
+ "Display description of tag TAG. If TAG is omitted, use the tag at point."
(interactive)
(or tag
(save-excursion
(error "No tag selected"))
(setq tag (downcase tag))
(message "%s"
- (or (cdr (assoc tag sgml-tag-help))
+ (or (cdr (assoc (downcase tag) sgml-tag-help))
(and (eq (aref tag 0) ?/)
- (cdr (assoc (substring tag 1) sgml-tag-help)))
+ (cdr (assoc (downcase (substring tag 1)) sgml-tag-help)))
"No description available")))
(defun sgml-skip-tag-backward (arg)
"Skip to beginning of tag or matching opening tag if present.
-With prefix ARG, repeat that many times."
+With prefix argument ARG, repeat this ARG times."
(interactive "p")
(while (>= arg 1)
(search-backward "<" nil t)
(defun sgml-skip-tag-forward (arg &optional return)
"Skip to end of tag or matching closing tag if present.
-With prefix ARG, repeat that many times.
+With prefix argument ARG, repeat this ARG times.
Return t iff after a closing tag."
(interactive "p")
(setq return t)
(defun sgml-delete-tag (arg)
"Delete tag on or after cursor, and matching closing or opening tag.
-With prefix ARG, repeat that many times."
+With prefix argument ARG, repeat this ARG times."
(interactive "p")
(while (>= arg 1)
(save-excursion
(goto-char open)
(kill-sexp 1)))
(setq arg (1- arg))))
-
-
+\f
+;; Put read-only last to enable setting this even when read-only enabled.
+(or (get 'sgml-tag 'invisible)
+ (setplist 'sgml-tag
+ (append '(invisible t
+ intangible t
+ point-entered sgml-point-entered
+ rear-nonsticky t
+ read-only t)
+ (symbol-plist 'sgml-tag))))
(defun sgml-tags-invisible (arg)
"Toggle visibility of existing tags."
(interactive "P")
(let ((modified (buffer-modified-p))
(inhibit-read-only t)
- (point (point-min))
+ ;; This is needed in case font lock gets called,
+ ;; since it moves point and might call sgml-point-entered.
+ (inhibit-point-motion-hooks t)
symbol)
(save-excursion
- (goto-char point)
+ (goto-char (point-min))
(if (setq sgml-tags-invisible
(if arg
(>= (prefix-numeric-value arg) 0)
(overlay-put (make-overlay (point)
(match-beginning 1))
'category symbol))
- (put-text-property (setq point (point)) (forward-list)
- 'intangible (point))
- (put-text-property point (point)
+ (put-text-property (point)
+ (progn (forward-list) (point))
'category 'sgml-tag))
- (while (< (setq point (next-overlay-change point)) (point-max))
- (delete-overlay (car (overlays-at point))))
+ (let ((pos (point)))
+ (while (< (setq pos (next-overlay-change pos)) (point-max))
+ (delete-overlay (car (overlays-at pos)))))
(remove-text-properties (point-min) (point-max)
'(category sgml-tag intangible t))))
(set-buffer-modified-p modified)
(eq (preceding-char) ?>)))
(backward-list)
(forward-list)))))))
-
-
+\f
(autoload 'compile-internal "compile")
(defun sgml-validate (command)
"Validate an SGML document.
Runs COMMAND, a shell command, in a separate process asynchronously
-with output going to the buffer *compilation*.
+with output going to the buffer `*compilation*'.
You can then use the command \\[next-error] to find the next error message
and move to the line in the SGML document that caused it."
(interactive
(and name
(file-name-nondirectory name))))))))
(setq sgml-saved-validate-command command)
- (if (or (not compilation-ask-about-save)
- (y-or-n-p (message "Save buffer %s? " (buffer-name))))
- (save-buffer))
+ (save-some-buffers (not compilation-ask-about-save) nil)
(compile-internal command "No more errors"))
(defun sgml-beginning-of-tag (&optional top-level)
"Skip to beginning of tag and return its name.
-Else `t'."
+If this can't be done, return t."
(or (if top-level
(condition-case nil
(up-list -1)
t)))
(defun sgml-value (alist)
+ "Interactively insert value taken from attributerule ALIST.
+See `sgml-tag-alist' for info about attributerules.."
(setq alist (cdr alist))
(if (stringp (car alist))
(insert "=\"" (car alist) ?\")
(progn
(insert "=\"")
(setq alist (skeleton-read '(completing-read
- "[Value]: " (cdr alist))))
+ "Value: " (cdr alist))))
(if (string< "" alist)
- (insert (funcall skeleton-transformation alist) ?\")
+ (insert alist ?\")
(delete-backward-char 2))))
(insert "=\"")
(if alist
- (insert (funcall skeleton-transformation
- (skeleton-read '(completing-read "Value: " alist)))))
+ (insert (skeleton-read '(completing-read "Value: " alist))))
(insert ?\"))))
(provide 'sgml-mode)
(hr . "----------")
(li . "o "))
"Value of `sgml-display-text' for HTML mode.")
-
-
-; should code exactly HTML 3 here when that is finished
+\f
+;; should code exactly HTML 3 here when that is finished
(defvar html-tag-alist
- (let* ((1-9 '(("8") ("9")
- ("1") ("2") ("3") ("4") ("5") ("6") ("7")))
+ (let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7")))
+ (1-9 '(,@1-7 ("8") ("9")))
(align '(("align" ("left") ("center") ("right"))))
(valign '(("top") ("middle") ("bottom") ("baseline")))
(rel '(("next") ("previous") ("parent") ("subdocument") ("made")))
("rel" ,@rel)
("rev" ,@rel)
("title")))
- (list '((nil \n
- ( "List item: "
- "<li>" str \n))
- ("type" ("A") ("a") ("I") ("i") ("1"))))
+ (list '((nil \n ( "List item: "
+ "<li>" str \n))))
(cell `(t
,align
("valign" ,@valign)
`(("a" ,name ,@link)
("base" t ,@href)
("dir" ,@list)
- ("font" ("size" ("-1") ("+1") ("-2") ("+2") ,@(cdr (cdr 1-9))))
+ ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)
("form" (\n _ \n "<input type=\"submit\" value=\"\">")
("action" ,@(cdr href)) ("method" ("get") ("post")))
("h1" ,@align)
("value"))
("link" t ,@link)
("menu" ,@list)
- ("ol" ,@list)
+ ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1")))
("p" t ,@align)
("select" (nil \n
("Text: "
("td" ,@cell)
("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
("th" ,@cell)
- ("ul" ,@list)
+ ("ul" ,@list ("type" ("disc") ("circle") ("square")))
,@sgml-tag-alist
"<dt>" str "<dd>" _ \n)))
("dt" (t _ "<dd>"))
("em")
- ("fn" "id" "fn")
+ ;("fn" "id" "fn") ; ???
("head" \n)
("html" (\n
"<head>\n"
"<title>" (setq str (read-input "Title: ")) "</title>\n"
+ "</head>\n"
"<body>\n<h1>" str "</h1>\n" _
"\n<address>\n<a href=\"mailto:"
user-mail-address
- "\">" (user-full-name) "</a>\n</address>"))
+ "\">" (user-full-name) "</a>\n</address>\n"
+ "</body>"
+ ))
("i")
("ins")
("isindex" t ("action") ("prompt"))
("figa" . "Figure anchor")
("figd" . "Figure description")
("figt" . "Figure text")
- ("fn" . "?")
+ ;("fn" . "?") ; ???
("font" . "Font size")
("form" . "Form with input fields")
("group" . "Document grouping")
("var" . "Math variable face")
("wbr" . "Enable <br> within <nobr>"))
"*Value of `sgml-tag-help' for HTML mode.")
-
-
-
+\f
;;;###autoload
(defun html-mode ()
"Major mode based on SGML mode for editing HTML documents.
-This allows inserting skeleton costructs used in hypertext documents with
+This allows inserting skeleton constructs used in hypertext documents with
completion. See below for an introduction to HTML. Use
\\[browse-url-of-buffer] to see how this comes out. See also `sgml-mode' on
which this is based.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
to them with <a href=\"#SOMENAME\">see also somename</a>. In the same way <a
href=\"URL\">see also URL</a> where URL is a filename relative to current
-directory or something like http://www.cs.indiana.edu/elisp/w3/docs.html.
+directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'.
Images in many formats can be inlined with <img src=\"URL\">.
-If you mainly create your own documents, `sgml-specials' might be interesting.
-But note that some HTML 2 browsers can't handle '. To work around that
-do:
+If you mainly create your own documents, `sgml-specials' might be
+interesting. But note that some HTML 2 browsers can't handle `''.
+To work around that, do:
+ (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
-\(eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
\\{html-mode-map}"
(interactive)
+ (kill-all-local-variables)
+ (setq mode-name "HTML"
+ major-mode 'html-mode)
(sgml-mode-common html-tag-face-alist html-display-text)
(use-local-map html-mode-map)
(make-local-variable 'sgml-tag-alist)
(make-local-variable 'outline-level)
(make-local-variable 'sentence-end)
(setq sentence-end
- "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\| $\\|\t\\| \\)[ \t\n]*")
- (setq mode-name "HTML"
- major-mode 'html-mode
- sgml-tag-alist html-tag-alist
+ (if sentence-end-double-space
+ "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\| $\\|\t\\| \\)[ \t\n]*"
+
+ "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\| \\|\t\\)[ \t\n]*"))
+ (setq sgml-tag-alist html-tag-alist
sgml-face-tag-alist html-face-tag-alist
sgml-tag-help html-tag-help
outline-regexp "^.*<[Hh][1-6]\\>"
outline-heading-end-regexp "</[Hh][1-6]>"
outline-level (lambda ()
(char-after (1- (match-end 0)))))
- (run-hooks 'html-mode-hook))
-
+ (setq imenu-create-index-function 'html-imenu-index)
+ (make-local-variable 'imenu-sort-function)
+ (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
+ (run-hooks 'text-mode-hook 'sgml-mode-hook 'html-mode-hook))
+\f
+(defvar html-imenu-regexp
+ "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
+ "*A regular expression matching a head line to be added to the menu.
+The first `match-string' should be a number from 1-9.
+The second `match-string' matches extra tags and is ignored.
+The third `match-string' will be the used in the menu.")
+
+(defun html-imenu-index ()
+ "Return an table of contents for an HTML buffer for use with Imenu."
+ (let (toc-index)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward html-imenu-regexp nil t)
+ (setq toc-index
+ (cons (cons (concat (make-string
+ (* 2 (1- (string-to-number (match-string 1))))
+ ?\ )
+ (match-string 3))
+ (save-excursion (beginning-of-line) (point)))
+ toc-index))))
+ (nreverse toc-index)))
+(defun html-autoview-mode (&optional arg)
+ "Toggle automatic viewing via `html-viewer' upon saving buffer.
+With positive prefix ARG always turns viewing on, with negative ARG always off.
+Can be used as a value for `html-mode-hook'."
+ (interactive "P")
+ (if (setq arg (if arg
+ (< (prefix-numeric-value arg) 0)
+ (and (boundp 'after-save-hook)
+ (memq 'browse-url-of-buffer after-save-hook))))
+ (setq after-save-hook (delq 'browse-url-of-buffer after-save-hook))
+ (make-local-hook 'after-save-hook)
+ (add-hook 'after-save-hook 'browse-url-of-buffer nil t))
+ (message "Autoviewing turned %s."
+ (if arg "off" "on")))
+\f
(define-skeleton html-href-anchor
"HTML anchor tag with href attribute."
- nil
- "<a href=\"http:" _ "\"></a>")
+ "URL: "
+ '(setq input "http:")
+ "<a href=\"" str "\">" _ "</a>")
(define-skeleton html-name-anchor
"HTML anchor tag with name attribute."
- nil
- "<a name=\"" _ "\"></a>")
+ "Name: "
+ "<a name=\"" str "\">" _ "</a>")
(define-skeleton html-headline-1
"HTML level 1 headline tags."
(define-skeleton html-image
"HTML image tag."
nil
- "<img src=\"http:" _ "\">")
+ "<img src=\"" _ "\">")
(define-skeleton html-line
"HTML line break tag."
(define-skeleton html-ordered-list
"HTML ordered list tags."
nil
- ?< "ol>" \n
+ "<ol>" \n
"<li>" _ \n
"</ol>")
(define-skeleton html-unordered-list
"HTML unordered list tags."
nil
- ?< "ul>" \n
+ "<ul>" \n
"<li>" _ \n
"</ul>")
(define-skeleton html-checkboxes
"Group of connected checkbox inputs."
nil
- '(setq v1 (eval str)) ; allow passing name as argument
- ("Value & Text: "
- "<input type=\"checkbox\" name=\""
- (or v1 (setq v1 (skeleton-read "Name: ")))
+ '(setq v1 nil
+ v2 nil)
+ ("Value: "
+ "<input type=\"" (identity "checkbox") ; see comment above about identity
+ "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
"\" value=\"" str ?\"
- (if v2 "" " checked") ?> str
- (or v2 (setq v2 (if (y-or-n-p "Newline? ") "<br>" ""))) \n))
+ (if (y-or-n-p "Set \"checked\" attribute? ")
+ (funcall skeleton-transformation " checked")) ">"
+ (skeleton-read "Text: " (capitalize str))
+ (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
+ (funcall skeleton-transformation "<br>")
+ "")))
+ \n))
(define-skeleton html-radio-buttons
"Group of connected radio button inputs."
nil
- '(setq v1 (eval str)) ; allow passing name as argument
- ("Value & Text: "
- "<input type=\"radio\" name=\""
- (or v1 (setq v1 (skeleton-read "Name: ")))
+ '(setq v1 nil
+ v2 (cons nil nil))
+ ("Value: "
+ "<input type=\"" (identity "radio") ; see comment above about identity
+ "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
"\" value=\"" str ?\"
- (if v2 "" " checked") ?> str
- (or v2 (setq v2 (if (y-or-n-p "Newline? ") "<br>" ""))) \n))
-
-
-(defun html-autoview-mode (&optional arg)
- "Toggle automatic viewing via `html-viewer' upon saving buffer.
-With positive prefix ARG always turns viewing on, with negative ARG always off.
-Can be used as a value for `html-mode-hook'."
- (interactive "P")
- (if (setq arg (if arg
- (< (prefix-numeric-value arg) 0)
- (and (boundp 'after-save-hook)
- (memq 'browse-url-of-buffer after-save-hook))))
- (setq after-save-hook (delq 'browse-url-of-buffer after-save-hook))
- (make-local-hook 'after-save-hook)
- (add-hook 'after-save-hook 'browse-url-of-buffer nil t))
- (message "Autoviewing turned %s."
- (if arg "off" "on")))
+ (if (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
+ (funcall skeleton-transformation " checked") ">")
+ (skeleton-read "Text: " (capitalize str))
+ (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
+ (funcall skeleton-transformation "<br>")
+ "")))
+ \n))
;;; sgml-mode.el ends here