X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4afa094d3a93dd3e6544f571e0c4671dd19b04cc..5cd62b8c044951d524a703cbacb8abf249ea0dd0:/lisp/textmodes/sgml-mode.el diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 980f324f24..a97f0888b1 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1,6 +1,6 @@ ;;; 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 ;; Adapted-By: ESR, Daniel Pfeiffer , @@ -79,9 +79,8 @@ 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) @@ -96,16 +95,17 @@ This takes effect when first loading the sgml-mode library.") (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) @@ -146,7 +146,7 @@ This takes effect when first loading the sgml-mode library.") (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) @@ -185,6 +185,20 @@ This takes effect when first loading the sgml-mode library.") "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. @@ -203,8 +217,8 @@ separated by a space." "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) @@ -365,7 +379,7 @@ varables of same name)." (setq face (funcall skeleton-transformation face)) (setq facemenu-end-add-face (concat "")) (concat "<" face ">")) - (error "Face not configured for %s mode." mode-name))) + (error "Face not configured for %s mode" mode-name))) ;;;###autoload @@ -452,8 +466,9 @@ start tag, and the second `/' is the corresponding null end tag." (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 @@ -462,31 +477,42 @@ or M-- for a soft hyphen." (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"))) @@ -501,23 +527,25 @@ 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)" - (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 ") + ;; We go use `identity' to prevent skeleton from passing + ;; `str' through skeleton-transformation a second time. + '(("") v2 _ v2 ") (if (eq (car v2) t) (cons '("") (cdr v2)) (append '(("") (car v2)) (cdr v2) - '(resume: (car v2) _ ")))))))) + '(resume: (car v2) _ ")))))))) (autoload 'skeleton-read "skeleton") @@ -714,34 +742,38 @@ With prefix argument ARG, repeat this ARG times." (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 ""))) @@ -750,7 +782,8 @@ With prefix argument ARG, repeat this ARG times." (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) ?<))) @@ -799,13 +832,16 @@ If this can't be done, return t." (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 "=\"") @@ -818,9 +854,10 @@ See `sgml-tag-alist' for info about attributerules.." (if alist (insert (skeleton-read '(completing-read "Value: " alist)))) (insert ?\")))) - -(provide 'sgml-mode) + +;;; HTML mode + (defcustom html-mode-hook nil "Hook run by command `html-mode'. `text-mode-hook' and `sgml-mode-hook' are run first." @@ -834,8 +871,9 @@ 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) @@ -930,10 +968,17 @@ This takes effect when first loading the library.") (li . "o ")) "Value of `sgml-display-text' for HTML mode.") + +(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"))) @@ -945,10 +990,10 @@ This takes effect when first loading the library.") ("rel" ,@rel) ("rev" ,@rel) ("title"))) - (list '((nil \n ( "List item: " - "
  • " str \n)))) + (list '((nil \n ("List item: " "
  • " str + (if html-xhtml "
    • ") \n)))) (cell `(t - ,align + ,@align ("valign" ,@valign) ("colspan" ,@1-9) ("rowspan" ,@1-9) @@ -1017,9 +1062,11 @@ This takes effect when first loading the library.") ("dd" t) ("del") ("dfn") + ("div") ("dl" (nil \n ( "Term: " - "
    " str "
    " _ \n))) + "
    " str (if html-xhtml "
    ") + "
    " _ (if html-xhtml "
    ") \n))) ("dt" (t _ "
    ")) ("em") ;("fn" "id" "fn") ; ??? @@ -1051,6 +1098,7 @@ This takes effect when first loading the library.") ("s") ("samp") ("small") + ("span") ("strong") ("sub") ("sup") @@ -1089,7 +1137,7 @@ This takes effect when first loading the library.") ("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") @@ -1206,7 +1254,7 @@ To work around that, do: (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 @@ -1216,8 +1264,9 @@ To work around that, do: 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)) (defvar html-imenu-regexp @@ -1300,43 +1349,44 @@ Can be used as a value for `html-mode-hook'." (define-skeleton html-horizontal-rule "HTML horizontal rule tag." nil - "
    " \n) + (if html-xhtml "
    " "
    ") \n) (define-skeleton html-image "HTML image tag." nil - "") + "" ">")) (define-skeleton html-line "HTML line break tag." nil - "
    " \n) + (if html-xhtml "
    " "
    ") \n) (define-skeleton html-ordered-list "HTML ordered list tags." nil "
      " \n - "
    1. " _ \n + "
    2. " _ (if html-xhtml "
      3. ") \n "
    ") (define-skeleton html-unordered-list "HTML unordered list tags." nil "
      " \n - "
    • " _ \n + "
    • " _ (if html-xhtml "
      • ") \n "
    ") (define-skeleton html-list-item "HTML list item tag." nil (if (bolp) nil '\n) - "
  • ") + "
  • " _ (if html-xhtml "
    • ")) (define-skeleton html-paragraph "HTML paragraph tag." nil (if (bolp) nil ?\n) - \n "

    ") + \n "

    " _ (if html-xhtml "

    ")) (define-skeleton html-checkboxes "Group of connected checkbox inputs." @@ -1347,11 +1397,13 @@ Can be used as a value for `html-mode-hook'." "" + (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 "
    ") + (funcall skeleton-transformation + (if html-xhtml "
    " "
    ")) ""))) \n)) @@ -1364,12 +1416,16 @@ Can be used as a value for `html-mode-hook'." "") + (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 "
    ") + (funcall skeleton-transformation + (if html-xhtml "
    " "
    ")) ""))) \n)) +(provide 'sgml-mode) + ;;; sgml-mode.el ends here