;;; sgml-mode.el --- SGML- and HTML-editing modes
-;; Copyright (C) 1992, 1995, 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1992,95,96,98,2001 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
;;; Code:
+(eval-when-compile
+ (require 'skeleton)
+ (require 'outline))
+
(defgroup sgml nil
"SGML editing mode"
:group 'languages)
(put 'sgml-transformation 'variable-interactive
"aTransformation function: ")
+(defcustom sgml-mode-hook nil
+ "Hook run by command `sgml-mode'.
+`text-mode-hook' is run first."
+ :group 'sgml
+ :type 'hook)
+
;; 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
- (let ((map (list 'keymap (make-vector 256 nil)))
+ (let ((map (make-keymap)) ;`sparse' doesn't allow binding to charsets.
(menu-map (make-sparse-keymap "SGML")))
- (define-key map "\t" 'indent-relative-maybe)
(define-key map "\C-c\C-i" 'sgml-tags-invisible)
(define-key map "/" 'sgml-slash)
(define-key map "\C-c\C-n" 'sgml-name-char)
(define-key map "\C-c?" 'sgml-tag-help)
(define-key map "\C-c8" 'sgml-name-8bit-mode)
(define-key map "\C-c\C-v" 'sgml-validate)
- (if sgml-quick-keys
- (progn
- (define-key map "&" 'sgml-name-char)
- (define-key map "<" 'sgml-tag)
- (define-key map " " 'sgml-auto-attributes)
- (define-key map ">" 'sgml-maybe-end-tag)
- (if (memq ?\" sgml-specials)
- (define-key map "\"" 'sgml-name-self))
- (if (memq ?' sgml-specials)
- (define-key map "'" 'sgml-name-self))))
+ (when sgml-quick-keys
+ (define-key map "&" 'sgml-name-char)
+ (define-key map "<" 'sgml-tag)
+ (define-key map " " 'sgml-auto-attributes)
+ (define-key map ">" 'sgml-maybe-end-tag)
+ (when (memq ?\" sgml-specials)
+ (define-key map "\"" 'sgml-name-self))
+ (when (memq ?' sgml-specials)
+ (define-key map "'" 'sgml-name-self)))
+ (define-key map (vector (make-char 'latin-iso8859-1))
+ 'sgml-maybe-name-self)
(let ((c 127)
(map (nth 1 map)))
(while (< (setq c (1+ c)) 256)
(defcustom sgml-name-8bit-mode nil
- "*When non-`nil' insert 8 bit characters with their names."
+ "*When non-nil, insert non-ASCII characters as named entities."
:type 'boolean
:group 'sgml)
"nbsp" "iexcl" "cent" "pound" "curren" "yen" "brvbar" "sect"
"uml" "copy" "ordf" "laquo" "not" "shy" "reg" "macr"
"ring" "plusmn" "sup2" "sup3" "acute" "micro" "para" "middot"
- "cedil" "sup1" "ordm" "raquo" "frac14" "half" "frac34" "iquest"
+ "cedil" "sup1" "ordm" "raquo" "frac14" "frac12" "frac34" "iquest"
"Agrave" "Aacute" "Acirc" "Atilde" "Auml" "Aring" "AElig" "Ccedil"
"Egrave" "Eacute" "Ecirc" "Euml" "Igrave" "Iacute" "Icirc" "Iuml"
"ETH" "Ntilde" "Ograve" "Oacute" "Ocirc" "Otilde" "Ouml" nil
"oslash" "ugrave" "uacute" "ucirc" "uuml" "yacute" "thorn" "yuml"]
"Vector of symbolic character names without `&' and `;'.")
+(put 'sgml-table 'char-table-extra-slots 0)
+
+(defvar sgml-char-names-table
+ (let ((table (make-char-table 'sgml-table))
+ (i 32)
+ elt)
+ (while (< i 256)
+ (setq elt (aref sgml-char-names i))
+ (if elt (aset table (make-char 'latin-iso8859-1 i) elt))
+ (setq i (1+ i)))
+ table)
+ "A table for mapping non-ASCII characters into SGML entity names.
+Currently, only Latin-1 characters are supported.")
+
-;; sgmls is a free SGML parser available from
-;; ftp.uu.net:pub/text-processing/sgml
+;; nsgmls is a free SGML parser in the SP suite available from
+;; ftp.jclark.com and otherwise packaged for GNU systems.
;; Its error messages can be parsed by next-error.
;; The -s option suppresses output.
-(defcustom sgml-validate-command "sgmls -s"
+(defcustom sgml-validate-command "nsgmls -s" ; replaced old `sgmls'
"*The command to validate an SGML document.
The file name of current buffer file name will be appended to this,
separated by a space."
:type 'string
+ :version "21.1"
:group 'sgml)
(defvar sgml-saved-validate-command nil
"The command last used to validate in this buffer.")
-;;; I doubt that null end tags are used much for large elements,
-;;; so use a small distance here.
+;; 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)
+(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 'comment-indent-function)
- (make-local-variable 'comment-start-skip)
(make-local-variable 'comment-indent-function)
(make-local-variable 'sgml-tags-invisible)
(make-local-variable 'skeleton-transformation)
(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 sgml-transformation
skeleton-further-elements '((completion-ignore-case t))
skeleton-end-hook (lambda ()
(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))
+ ;; This will allow existing comments within declarations to be
+ ;; recognized.
+ (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
+ (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
+ (dolist (pair sgml-display-text)
+ (put (car pair) 'before-string (cdr pair))))
(defun sgml-mode-facemenu-add-face-function (face end)
(setq face (funcall skeleton-transformation face))
(setq facemenu-end-add-face (concat "</" face ">"))
(concat "<" face ">"))
- (error "Face not configured for %s mode." mode-name)))
+ (error "Face not configured for %s mode" mode-name)))
;;;###autoload
-(defun sgml-mode (&optional function)
+(defun sgml-mode ()
"Major mode for editing SGML documents.
Makes > match <. Makes / blink matching /.
Keys <, &, SPC within <>, \" and ' can be electric depending on
`sgml-quick-keys'.
-An argument of N to a tag-inserting command means that the next N
-words should be wrapped. When the region is highlighted, N defaults
-to -1, which means the current region.
+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.
+your `.emacs' file.
Use \\[sgml-validate] to validate your document with an SGML parser.
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 ()
- (if (and (looking-at "--")
- (not (and (eq (preceding-char) ?!)
- (eq (char-after (- (point) 2)) ?<))))
- (progn
- (skip-chars-backward " \t")
- (max comment-column (1+ (current-column))))
- 0))
+ (if (looking-at "--") comment-column 0))
(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)
(defun sgml-name-char (&optional char)
"Insert a symbolic character name according to `sgml-char-names'.
-8 bit chars may be inserted with the meta key as in M-SPC for no break space,
-or M-- for a soft hyphen."
+Non-ASCII chars may be inserted either with the meta key, as in M-SPC for
+no-break space or M-- for a soft hyphen; or via an input method or
+encoded keyboard operation."
(interactive "*")
(insert ?&)
(or char
(insert char)
(undo-boundary)
(delete-backward-char 1)
- (insert ?&
- (or (aref sgml-char-names char)
- (format "#%d" char))
- ?\;))
-
+ (cond
+ ((< char 256)
+ (insert ?&
+ (or (aref sgml-char-names char)
+ (format "#%d" char))
+ ?\;))
+ ((aref sgml-char-names-table char)
+ (insert ?& (aref sgml-char-names-table char) ?\;))
+ ((memq (char-charset char) '(mule-unicode-0100-24ff
+ mule-unicode-2500-33ff
+ mule-unicode-e000-ffff))
+ (insert (format "&#%d;" (encode-char char 'ucs))))
+ (t
+ (insert char))))
(defun sgml-name-self ()
"Insert a symbolic character name according to `sgml-char-names'."
(interactive "*")
(sgml-name-char last-command-char))
-
(defun sgml-maybe-name-self ()
"Insert a symbolic character name according to `sgml-char-names'."
(interactive "*")
(if sgml-name-8bit-mode
- (sgml-name-char last-command-char)
+ (let ((mc last-command-char))
+ (if (< mc 256)
+ (setq mc (unibyte-char-to-multibyte mc)))
+ (or mc (setq mc last-command-char))
+ (sgml-name-char mc))
(self-insert-command 1)))
-
(defun sgml-name-8bit-mode ()
- "Toggle insertion of 8 bit characters."
+ "Toggle whether to insert named entities instead of non-ASCII characters."
(interactive)
(setq sgml-name-8bit-mode (not sgml-name-8bit-mode))
- (message "sgml name 8 bit mode is now %"
+ (message "sgml name entity 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").
+;; 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 done according to `sgml-tag-alist'.
+ "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)."
+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)) |
+ ?< str |
(("") -1 '(undo-boundary) (identity "<")) | ; see comment above
- (("") '(setq v2 (sgml-attributes v1 t)) ?>
- (if (string= "![" v1)
- (prog1 '(("") " [ " _ " ]]")
- (backward-char))
- (if (or (eq v2 t)
- (string-match "^[/!?]" v1))
- ()
- (if (symbolp v2)
- '(("") v2 _ v2 "</" v1 ?>)
- (if (eq (car v2) t)
- (cons '("") (cdr v2))
- (append '(("") (car v2))
- (cdr v2)
- '(resume: (car v2) _ "</" v1 ?>))))))))
+ `(("") '(setq v2 (sgml-attributes ,str t)) ?>
+ (if (string= "![" ,str)
+ (prog1 '(("") " [ " _ " ]]")
+ (backward-char))
+ (unless (or (sgml-skip-close-p v2) ; (eq v2 t)
+ (string-match "^[/!?]" ,str))
+ (if (symbolp v2)
+ ;; We go use `identity' to prevent skeleton from passing
+ ;; `str' through skeleton-transformation a second time.
+ '(("") v2 _ v2 "</" (identity ',str) ?>)
+ (if (eq (car v2) t)
+ (cons '("") (cdr v2))
+ (append '(("") (car v2))
+ (cdr v2)
+ '(resume: (car v2) _ "</" (identity ',str) ?>))))))))
(autoload 'skeleton-read "skeleton")
(defun sgml-attributes (tag &optional quiet)
- "When at toplevel of a tag, interactively insert attributes.
+ "When at top level of a tag, interactively insert attributes.
-Completion and configuration of TAG is done according to `sgml-tag-alist'.
-If QUIET, does not print a message when there are no attributes for TAG."
+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 tag) (error "Wrong context for adding attribute"))
(if tag
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
(interactive "P")
(let ((modified (buffer-modified-p))
(inhibit-read-only t)
+ (inhibit-modification-hooks t)
+ ;; Avoid spurious the `file-locked' checks.
+ (buffer-file-name nil)
;; 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-min))
- (if (setq sgml-tags-invisible
- (if arg
- (>= (prefix-numeric-value arg) 0)
- (not sgml-tags-invisible)))
- (while (re-search-forward "<\\([!/?A-Za-z][-A-Za-z0-9]*\\)"
- nil t)
- (setq symbol (intern-soft (downcase (match-string 1))))
- (goto-char (match-beginning 0))
- (and (get symbol 'before-string)
- (not (overlays-at (point)))
- (overlay-put (make-overlay (point)
- (match-beginning 1))
- 'category symbol))
- (put-text-property (point)
- (progn (forward-list) (point))
- 'category 'sgml-tag))
- (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)
+ (unwind-protect
+ (save-excursion
+ (goto-char (point-min))
+ (if (setq sgml-tags-invisible
+ (if arg
+ (>= (prefix-numeric-value arg) 0)
+ (not sgml-tags-invisible)))
+ (while (re-search-forward "<\\([!/?A-Za-z][-A-Za-z0-9]*\\)"
+ nil t)
+ (setq symbol (intern-soft (downcase (match-string 1))))
+ (goto-char (match-beginning 0))
+ (and (get symbol 'before-string)
+ (not (overlays-at (point)))
+ (overlay-put (make-overlay (point)
+ (match-beginning 1))
+ 'category symbol))
+ (put-text-property (point)
+ (progn (forward-list) (point))
+ 'category 'sgml-tag))
+ (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))))
+ (restore-buffer-modified-p modified))
(run-hooks 'sgml-tags-invisible-hook)
(message "")))
(let ((inhibit-point-motion-hooks t))
(save-excursion
(message "Invisible tag: %s"
- (buffer-substring
+ ;; Strip properties, otherwise, the text is invisible.
+ (buffer-substring-no-properties
(point)
(if (or (and (> x y)
(not (eq (following-char) ?<)))
(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)
(match-end 0))
t)))
+(defun sgml-skip-close-p (obj)
+ (and (eq obj t) (not html-xhtml)))
+
(defun sgml-value (alist)
- "Interactively insert value taken from ALIST, which is an
-`attributerule' as described in sgml-tag-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) ?\")
- (if (eq (car alist) t)
+ (if (sgml-skip-close-p (car alist)) ; (eq (car alist) t)
(if (cdr alist)
(progn
(insert "=\"")
(if alist
(insert (skeleton-read '(completing-read "Value: " alist))))
(insert ?\"))))
-
-(provide 'sgml-mode)
\f
+
+;;; HTML mode
+
+(defcustom html-mode-hook nil
+ "Hook run by command `html-mode'.
+`text-mode-hook' and `sgml-mode-hook' are run first."
+ :group 'sgml
+ :type 'hook
+ :options '(html-autoview-mode))
+
(defvar html-quick-keys sgml-quick-keys
"Use C-c X combinations for quick insertion of frequent tags when non-nil.
This defaults to `sgml-quick-keys'.
This takes effect when first loading the library.")
(defvar html-mode-map
- (let ((map (nconc (make-sparse-keymap) sgml-mode-map))
+ (let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap "HTML")))
+ (set-keymap-parent map sgml-mode-map)
(define-key map "\C-c6" 'html-headline-6)
(define-key map "\C-c5" 'html-headline-5)
(define-key map "\C-c4" 'html-headline-4)
(hr . "----------")
(li . "o "))
"Value of `sgml-display-text' for HTML mode.")
+\f
+(defcustom html-xhtml nil
+ "*When non-nil, tag insertion functions will be XHTML-compliant."
+ :type 'boolean
+ :version "21.2"
+ :group 'sgml)
-; should code exactly HTML 3 here when that is finished
+;; should code exactly HTML 3 here when that is finished
(defvar html-tag-alist
(let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7")))
- (1-9 '(,@1-7 ("8") ("9")))
+ (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))))
+ (list '((nil \n ("List item: " "<li>" str
+ (if html-xhtml "</li>") \n))))
(cell `(t
- ,align
+ ,@align
("valign" ,@valign)
("colspan" ,@1-9)
("rowspan" ,@1-9)
("dd" t)
("del")
("dfn")
+ ("div")
("dl" (nil \n
( "Term: "
- "<dt>" str "<dd>" _ \n)))
+ "<dt>" str (if html-xhtml "</dt>")
+ "<dd>" _ (if html-xhtml "</dd>") \n)))
("dt" (t _ "<dd>"))
("em")
;("fn" "id" "fn") ; ???
("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"))
("s")
("samp")
("small")
+ ("span")
("strong")
("sub")
("sup")
("dir" . "Directory list (obsolete)")
("dl" . "Definition list")
("dt" . "Term to be definined")
- ("em" . "Emphasised")
+ ("em" . "Emphasised")
("embed" . "Embedded data in foreign format")
("fig" . "Figure")
("figa" . "Figure anchor")
("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)
+ ;; It's for the user to decide if it defeats it or not -stef
+ ;; (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 `browse-url-of-buffer' 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))
+ (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."
"URL: "
(define-skeleton html-horizontal-rule
"HTML horizontal rule tag."
nil
- "<hr>" \n)
+ (if html-xhtml "<hr/>" "<hr>") \n)
(define-skeleton html-image
"HTML image tag."
nil
- "<img src=\"" _ "\">")
+ "<img src=\"" _ "\""
+ (if html-xhtml "/>" ">"))
(define-skeleton html-line
"HTML line break tag."
nil
- "<br>" \n)
+ (if html-xhtml "<br/>" "<br>") \n)
(define-skeleton html-ordered-list
"HTML ordered list tags."
nil
"<ol>" \n
- "<li>" _ \n
+ "<li>" _ (if html-xhtml "</li>") \n
"</ol>")
(define-skeleton html-unordered-list
"HTML unordered list tags."
nil
"<ul>" \n
- "<li>" _ \n
+ "<li>" _ (if html-xhtml "</li>") \n
"</ul>")
(define-skeleton html-list-item
"HTML list item tag."
nil
(if (bolp) nil '\n)
- "<li>")
+ "<li>" _ (if html-xhtml "</li>"))
(define-skeleton html-paragraph
"HTML paragraph tag."
nil
(if (bolp) nil ?\n)
- \n "<p>")
+ \n "<p>" _ (if html-xhtml "</p>"))
(define-skeleton html-checkboxes
"Group of connected checkbox inputs."
"<input type=\"" (identity "checkbox") ; see comment above about identity
"\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
"\" value=\"" str ?\"
- (if (y-or-n-p "Set \"checked\" attribute? ")
- (funcall skeleton-transformation " checked")) ">"
+ (when (y-or-n-p "Set \"checked\" attribute? ")
+ (funcall skeleton-transformation " checked"))
+ (if html-xhtml "/>" ">")
(skeleton-read "Text: " (capitalize str))
(or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
- (funcall skeleton-transformation "<br>")
+ (funcall skeleton-transformation
+ (if html-xhtml "<br/>" "<br>"))
"")))
\n))
"<input type=\"" (identity "radio") ; see comment above about identity
"\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
"\" value=\"" str ?\"
- (if (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
- (funcall skeleton-transformation " checked") ">")
+ (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
+ (funcall skeleton-transformation " checked"))
+ (if html-xhtml "/>" ">")
(skeleton-read "Text: " (capitalize str))
(or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
- (funcall skeleton-transformation "<br>")
+ (funcall skeleton-transformation
+ (if html-xhtml "<br/>" "<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")))
+(provide 'sgml-mode)
;;; sgml-mode.el ends here
HCoop / bpt / emacs.git / blobdiff