;;; sgml-mode.el --- SGML- and HTML-editing modes
-;; Copyright (C) 1992, 1995, 1996, 1998 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 <occitan@esperanto.org>,
(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)
"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.")
+
;; nsgmls is a free SGML parser in the SP suite available from
;; ftp.jclark.com and otherwise packaged for GNU systems.
"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 `/'."
:type '(choice (const nil) integer)
(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-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 %s"
+ (message "sgml name entity mode is now %s"
(if sgml-name-8bit-mode "ON" "OFF")))
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)"
- (completing-read "Tag: " sgml-tag-alist)
+ (funcall skeleton-transformation
+ (completing-read "Tag: " sgml-tag-alist))
?< str |
(("") -1 '(undo-boundary) (identity "<")) | ; see comment above
`(("") '(setq v2 (sgml-attributes ,str t)) ?>
(if (string= "![" ,str)
(prog1 '(("") " [ " _ " ]]")
(backward-char))
- (if (or (eq v2 t)
- (string-match "^[/!?]" ,str))
- ()
+ (unless (or (sgml-skip-close-p v2) ; (eq v2 t)
+ (string-match "^[/!?]" ,str))
(if (symbolp v2)
- '(("") v2 _ v2 "</" ,str ?>)
+ ;; 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) _ "</" ,str ?>))))))))
+ '(resume: (car v2) _ "</" (identity ',str) ?>))))))))
(autoload 'skeleton-read "skeleton")
(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) ?<)))
(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 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."
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)
(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
(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") ; ???
("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")
(setq sentence-end
(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
outline-level (lambda ()
(char-after (1- (match-end 0)))))
(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
+ ;; 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
(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))
+(provide 'sgml-mode)
+
;;; sgml-mode.el ends here
HCoop / bpt / emacs.git / blobdiff