From 1caf38ebbc2750d7639a3aed1525771642492cd8 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Fri, 12 Jan 1996 21:14:51 +0000 Subject: [PATCH] Also load for .sgm and .dtd files. (sgml-specials, sgml-name-8bit-mode, sgml-char-names) (sgml-font-lock-keywords, sgml-face-tag-alist, sgml-tag-face-alist) (sgml-display-text, sgml-tag-alist, sgml-tag-help) (sgml-auto-attributes): New variables. (sgml-mode-common): New function. (sgml-mode): Most code moved to it. (sgml-name-char, sgml-name-self, sgml-maybe-name-self) (sgml-name-8bit-mode, sgml-tag, sgml-attributes, sgml-auto-attributes) (sgml-tag-help, sgml-maybe-end-tag, sgml-skip-tag-backward) (sgml-skip-tag-forward, sgml-tags-invisible): New commands. (sgml-beginning-of-tag, sgml-value): New functions. --- lisp/textmodes/sgml-mode.el | 1224 +++++++++++++++++++++++++++++++---- 1 file changed, 1085 insertions(+), 139 deletions(-) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 3dabd2214ee..16f87b23a9d 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1,10 +1,10 @@ -;;; sgml-mode.el --- SGML-editing mode +;;; sgml-mode.el --- SGML- and HTML-editing modes -;; Copyright (C) 1992 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1995, 1996 Free Software Foundation, Inc. ;; Author: James Clark -;; Adapted-By: ESR -;; Keywords: wp +;; Adapted-By: ESR; Daniel.Pfeiffer@Informatik.START.dbp.de +;; Keywords: wp, hypermedia, comm, languages ;; This file is part of GNU Emacs. @@ -24,20 +24,145 @@ ;;; Commentary: -;; Major mode for editing the SGML document-markup language. +;; Configurable major mode for editing document in the SGML standard general +;; markup language. As an example contains a mode for editing the derived +;; HTML hypertext markup language. ;;; Code: -(provide 'sgml-mode) -(require 'compile) +;;;###autoload +(or (rassq 'sgml-mode auto-mode-alist) + (setq auto-mode-alist `(("\\.sgml?\\'" . sgml-mode) + ("\\.dtd\\'" . sgml-mode) + ,@auto-mode-alist))) + + +;; 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. +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 string. + ?- Makes -- in text start a comment. + +When only one of ?\\\" or ?' are included, \"'\" or '\"' as it can be found in +DTDs, start a string. To partially avoid this problem this also makes these +self insert as named entities. must contain an even multiple of two +(4, 8, ...) minuses, or Emacs' syntax mechanism won't recognize a comment.") + + +(defvar sgml-mode-map + (let ((map (list 'keymap (make-vector 256 nil))) + (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 "&" 'sgml-name-char) + (define-key map "<" 'sgml-tag) + (define-key map "\C-c\C-a" 'sgml-attributes) + (define-key map "\C-c\C-b" 'sgml-skip-tag-backward) + (define-key map [?\C-c left] 'sgml-skip-tag-backward) + (define-key map "\C-c\C-f" 'sgml-skip-tag-forward) + (define-key map [?\C-c right] 'sgml-skip-tag-forward) + (define-key map "\C-c\C-d" 'sgml-delete-tag) + (define-key map "\C-c\^?" 'sgml-delete-tag) + (define-key map "\C-c?" 'sgml-tag-help) + (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)) + (define-key map "\C-c8" 'sgml-name-8bit-mode) + (define-key map "\C-c\C-v" 'sgml-validate) + (let ((c 127) + (map (nth 1 map))) + (while (< (setq c (1+ c)) 256) + (aset map c 'sgml-maybe-name-self))) + (define-key map [menu-bar sgml] (cons "SGML" menu-map)) + (define-key menu-map [sgml-validate] '("Validate" . sgml-validate)) + (define-key menu-map [sgml-name-8bit-mode] + '("Toggle 8 Bit Insertion" . sgml-name-8bit-mode)) + (define-key menu-map [sgml-tags-invisible] + '("Toggle Tag Visibility" . sgml-tags-invisible)) + (define-key menu-map [sgml-tag-help] + '("Describe Tag" . sgml-tag-help)) + (define-key menu-map [sgml-delete-tag] + '("Delete Tag" . sgml-delete-tag)) + (define-key menu-map [sgml-skip-tag-forward] + '("Forward Tag" . sgml-skip-tag-forward)) + (define-key menu-map [sgml-skip-tag-backward] + '("Backward Tag" . sgml-skip-tag-backward)) + (define-key menu-map [sgml-attributes] + '("Insert Attributes" . sgml-attributes)) + (define-key menu-map [sgml-tag] '("Insert Tag" . sgml-tag)) + map) + "Keymap for SGML mode. See also `sgml-specials'.") + + +(defvar sgml-mode-syntax-table + (let ((table (copy-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?< "(>" table) + (modify-syntax-entry ?> ")<" table) + (if (memq ?- sgml-specials) + (modify-syntax-entry ?- "_ 1234" table)) + (if (memq ?\" sgml-specials) + (modify-syntax-entry ?\" "\"\"" table)) + (if (memq ?' sgml-specials) + (modify-syntax-entry ?\' "\"'" table)) + table) + "Syntax table used in SGML mode. See also `sgml-specials'.") + -;;; sgmls is a free SGML parser available from -;;; ftp.uu.net:pub/text-processing/sgml -;;; Its error messages can be parsed by next-error. -;;; The -s option suppresses output. +(defvar sgml-name-8bit-mode nil + "*When non-`nil' insert 8 bit characters with their names.") -(defconst sgml-validate-command - "sgmls -s" +(defvar sgml-char-names + [nil nil nil nil nil nil nil nil + 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" + "lpar" "rpar" "ast" "plus" "comma" "hyphen" "period" "sol" + nil nil nil nil nil nil nil nil + nil nil "colon" "semi" "lt" "eq" "gt" "quest" + "commat" nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil + nil nil nil "lsqb" nil "rsqb" "uarr" "lowbar" + "lsquo" nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil + nil nil nil "lcub" "verbar" "rcub" "tilde" nil + nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil + "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" + "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" "szlig" + "agrave" "aacute" "acirc" "atilde" "auml" "aring" "aelig" "ccedil" + "egrave" "eacute" "ecirc" "euml" "igrave" "iacute" "icirc" "iuml" + "eth" "ntilde" "ograve" "oacute" "ocirc" "otilde" "ouml" "divide" + "oslash" "ugrave" "uacute" "ucirc" "uuml" "yacute" "thorn" "yuml"] + "Vector of symbolic character names without `&' and `;'.") + + +;; sgmls is a free SGML parser available from +;; ftp.uu.net:pub/text-processing/sgml +;; Its error messages can be parsed by next-error. +;; The -s option suppresses output. + +(defvar sgml-validate-command "sgmls -s" "*The command to validate an SGML document. The file name of current buffer file name will be appended to this, separated by a space.") @@ -45,154 +170,192 @@ separated by a space.") (defvar sgml-saved-validate-command nil "The command last used to validate in this buffer.") -(defvar sgml-mode-map nil "Keymap for SGML mode") -(if sgml-mode-map - () - (setq sgml-mode-map (make-sparse-keymap)) - (define-key sgml-mode-map ">" 'sgml-close-angle) - (define-key sgml-mode-map "/" 'sgml-slash) - (define-key sgml-mode-map "\C-c\C-v" 'sgml-validate)) +;;; I doubt that null end tags are used much for large elements, +;;; so use a small distance here. +(defconst sgml-slash-distance 1000 + "*If non-nil, is the maximum distance to search for matching /.") -;;;###autoload -(defun sgml-mode () - "Major mode for editing SGML. -Makes > display the matching <. Makes / display matching /. -Use \\[sgml-validate] to validate your document with an SGML parser." - (interactive) +(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.") + + +(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)) + "*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.") + +(defvar sgml-tag-face-alist () + "Tag names and face or list of faces to fontify with when invisible. +When `font-lock-maximum-decoration' is 1 this is always used for fontifying. +When more these are fontified together with `sgml-font-lock-keywords'.") + + +(defvar sgml-display-text () + "Tag names as lowercase symbols, and display string when invisible.") + +;; internal +(defvar sgml-tags-invisible nil) + + +(defvar sgml-tag-alist + '(("!attlist") + ("!doctype") + ("!element") + ("!entity")) + "*Alist of tag names for completing read and insertion rules. +This alist is made up as + + ((\"tag\" . TAGRULE) + ...) + +TAGRULE is a list of optionally `t' (no endtag) or `\\n' (separate endtag by +newlines) or a skeleton with `nil', `t' or `\\n' in place of the interactor +followed by an ATTRIBUTERULE (for an always present attribute) or an +attribute alist. + +The attribute alist is made up as + + ((\"attribute\" . ATTRIBUTERULE) + ...) + +ATTRIBUTERULE is a list of optionally `t' (no value when no input) followed by +an optional alist of possible values.") + +(defvar sgml-tag-help + '(("!" . "Empty declaration for comment") + ("![" . "Embed declarations with parser directive") + ("!attlist" . "Tag attributes declaration") + ("!doctype" . "Document type (DTD) declaration") + ("!element" . "Tag declaration") + ("!entity" . "Entity (macro) declaration")) + "*Alist of tag name and short description.") + + +;; 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 sgml-auto-attributes t + "*When non-`nil' SPC at top level of tag prompts for attributes.") + + + +(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-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) - (use-local-map sgml-mode-map) - (setq mode-name "SGML") - (setq major-mode 'sgml-mode) + (set-syntax-table sgml-mode-syntax-table) + (make-local-variable 'indent-line-function) (make-local-variable 'paragraph-start) - ;; 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. - (setq paragraph-start - "^[ \t\n]\\|\ -\\($\\)") (make-local-variable 'paragraph-separate) - (setq paragraph-separate - "^[ \t\n]*$\\|\ -^$") (make-local-variable 'sgml-saved-validate-command) - (set-syntax-table text-mode-syntax-table) (make-local-variable 'comment-start) - (setq comment-start "") (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'sgml-comment-indent) (make-local-variable 'comment-start-skip) - ;; This will allow existing comments within declarations to be - ;; recognized. - (setq comment-start-skip "--[ \t]*") + (make-local-variable 'comment-indent-function) + (make-local-variable 'sgml-tags-invisible) + (make-local-variable 'skeleton-transformation) + (make-local-variable 'skeleton-further-elements) + (make-local-variable 'skeleton-end-hook) + (make-local-variable 'font-lock-defaults) + (make-local-variable 'sgml-font-lock-keywords-1) + (make-local-variable 'facemenu-add-face-function) + (make-local-variable 'facemenu-end-add-face) + ;;(make-local-variable 'facemenu-remove-face-function) + (and sgml-tag-face-alist + (not (assq 1 sgml-tag-face-alist)) + (nconc sgml-tag-face-alist + `((1 (,(concat "<\\(" + (mapconcat 'car sgml-tag-face-alist "\\|") + "\\)\\([ \t].+\\)?>\\(.+\\)") + 3 (cdr (assoc (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]\\|\ +\\($\\)" + paragraph-separate "^[ \t\n]*$\\|\ +^$" + comment-start "" + comment-indent-function 'sgml-comment-indent + ;; This will allow existing comments within declarations to be + ;; recognized. + comment-start-skip "--[ \t]*" + skeleton-transformation 'identity + 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)) + font-lock-defaults '((sgml-font-lock-keywords + sgml-font-lock-keywords-1) + nil + t) + facemenu-add-face-function + (lambda (face end) + (if (setq face (cdr (assq face sgml-face-tag-alist))) + (progn + (setq facemenu-end-add-face (concat "")) + (concat "<" face ">")) + (error "Face not configured for %s mode." mode-name)))) + (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)) + +;;;###autoload +(defun sgml-mode (&optional function) + "Major mode for editing SGML documents. +Makes > match <. Makes / blink matching /. + +Do \\[describe-variable] sgml- SPC to see available variables. + +Use \\[sgml-validate] to validate your document with an SGML parser. +\\{sgml-mode-map}" + (interactive) + (sgml-mode-common sgml-tag-face-alist sgml-display-text) + (use-local-map sgml-mode-map) + (setq mode-name "SGML" + major-mode 'sgml-mode)) + + + (defun sgml-comment-indent () (if (and (looking-at "--") - (not (and (eq (char-after (1- (point))) ?!) + (not (and (eq (preceding-char) ?!) (eq (char-after (- (point) 2)) ?<)))) (progn (skip-chars-backward " \t") (max comment-column (1+ (current-column)))) 0)) -(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.") -(defvar sgml-mode-markup-syntax-table nil - "Syntax table used for scanning SGML markup.") - -(if sgml-mode-markup-syntax-table - () - (setq sgml-mode-markup-syntax-table (make-syntax-table)) - (modify-syntax-entry ?< "(>" sgml-mode-markup-syntax-table) - (modify-syntax-entry ?> ")<" sgml-mode-markup-syntax-table) - (modify-syntax-entry ?- "_ 1234" sgml-mode-markup-syntax-table) - (modify-syntax-entry ?\' "\"" sgml-mode-markup-syntax-table)) - -(defconst sgml-angle-distance 4000 - "*If non-nil, is the maximum distance to search for matching <.") - -(defun sgml-close-angle (arg) - "Insert > and display matching <." - (interactive "p") - (insert-char ?> arg) - (if (> arg 0) - (let ((oldpos (point)) - (blinkpos)) - (save-excursion - (save-restriction - (if sgml-angle-distance - (narrow-to-region (max (point-min) - (- (point) sgml-angle-distance)) - oldpos)) - ;; See if it's the end of a marked section. - (and (> (- (point) (point-min)) 3) - (eq (char-after (- (point) 2)) ?\]) - (eq (char-after (- (point) 3)) ?\]) - (re-search-backward "" oldpos t) - (eq (point) oldpos)) - (setq blinkpos msspos)))) - ;; This handles cases where the > ends one of the following: - ;; markup declaration starting with ]\\|!\\([[A-Za-z]\\|--\\)\\)")) - ;; Check that it's not a net-enabling start tag - ;; nor an unclosed start-tag. - (looking-at (concat sgml-start-tag-regex "[/<]")) - ;; Nor an unclosed end-tag. - (looking-at "" oldpos t) - (eq (point) oldpos)) - (setq blinkpos pipos)))))) - (if blinkpos - (progn - (goto-char blinkpos) - (if (pos-visible-in-window-p) - (sit-for 1) - (message "Matches %s" - (buffer-substring blinkpos - (progn (end-of-line) - (point))))))))))) - -;;; I doubt that null end tags are used much for large elements, -;;; so use a small distance here. -(defconst sgml-slash-distance 1000 - "*If non-nil, is the maximum distance to search for matching /.") (defun sgml-slash (arg) "Insert / and display any previous matching /. @@ -237,6 +400,296 @@ start tag, and the second / is the corresponding null end tag." (point)) (1+ blinkpos)))))))))) + +(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." + (interactive "*") + (insert ?&) + (or char + (setq char (read-quoted-char))) + (delete-backward-char 1) + (insert char) + (undo-boundary) + (delete-backward-char 1) + (insert ?& + (or (aref sgml-char-names char) + (format "#%d" 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) + (self-insert-command 1))) + + +(defun sgml-name-8bit-mode () + "Toggle insertion of 8 bit characters." + (interactive) + (setq sgml-name-8bit-mode (not sgml-name-8bit-mode))) + + + +(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'." + (funcall skeleton-transformation + (completing-read "Tag: " sgml-tag-alist)) + ?< (setq v1 (eval str)) | + (("") -1 '(undo-boundary) "<") | + (("") '(setq v2 (sgml-attributes v1 t)) ?> + (if (or (eq v2 t) + (string-match "^[/!?]" v1)) + () + (if (symbolp v2) + '(("") v2 _ v2 ") + (if (eq (car v2) t) + (cons '("") (cdr v2)) + (append '(("") (car v2)) + (cdr v2) + '(resume: (car v2) _ "))))))) + +(autoload 'skeleton-read "skeleton") + +(defun sgml-attributes (alist &optional quiet) + "When at toplevel of a tag, interactively insert attributes." + (interactive (list (save-excursion (sgml-beginning-of-tag t)))) + (or (stringp alist) (error "Wrong context for adding attribute")) + (if alist + (let ((completion-ignore-case t) + 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) + alist (cdr alist))) + (or quiet + (message "No attributes configured.")) + (if (stringp (car alist)) + (progn + (insert (if (eq (preceding-char) ? ) "" ? ) (car alist)) + (sgml-value alist)) + (setq i (length alist)) + (while (> i 0) + (insert ? ) + (insert (funcall skeleton-transformation + (setq attribute + (skeleton-read '(completing-read + "[Attribute]: " + alist))))) + (if (string= "" attribute) + (setq i 0) + (sgml-value (assoc 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, or if `sgml-auto-attributes' is `nil' only self insert." + (interactive "*P") + (let ((point (point)) + tag) + (if (or arg + (not sgml-auto-attributes) + (not sgml-tag-alist) ; no message when nothing configured + (symbolp (setq tag (save-excursion (sgml-beginning-of-tag t)))) + (eq (aref tag 0) ?/)) + (self-insert-command (prefix-numeric-value arg)) + (sgml-attributes tag) + (setq last-command-char ? ) + (or (> (point) point) + (self-insert-command 1))))) + + +(defun sgml-tag-help (&optional tag) + "Display description of optional TAG or tag at point." + (interactive) + (or tag + (save-excursion + (if (eq (following-char) ?<) + (forward-char)) + (setq tag (sgml-beginning-of-tag)))) + (or (stringp tag) + (error "No tag selected")) + (setq tag (downcase tag)) + (message (or (cdr (assoc tag sgml-tag-help)) + (and (eq (aref tag 0) ?/) + (cdr (assoc (substring tag 1) sgml-tag-help))) + "No description available"))) + + +(defun sgml-maybe-end-tag () + "Name self unless in position to end a tag." + (interactive) + (or (condition-case nil + (save-excursion (up-list -1)) + (error + (sgml-name-self) + t)) + (condition-case nil + (progn + (save-excursion (up-list 1)) + (sgml-name-self)) + (error (self-insert-command 1))))) + + +(defun sgml-skip-tag-backward (arg) + "Skip to beginning of tag or matching opening tag if present. +With prefix ARG, repeat that many times." + (interactive "p") + (while (>= arg 1) + (search-backward "<" nil t) + (if (looking-at "]+\\)") + ;; end tag, skip any nested pairs + (let ((case-fold-search t) + (re (concat "= arg 1) + (skip-chars-forward "^<>") + (if (eq (following-char) ?>) + (up-list -1)) + (if (looking-at "<\\([^/ \n\t>]+\\)") + ;; start tag, skip any nested same pairs _and_ closing tag + (let ((case-fold-search t) + (re (concat "= arg 1) + (save-excursion + (let* (close open) + (if (looking-at "[ \t]*<") + ;; just before tag + (if (eq (char-after (match-end 0)) ?/) + ;; closing tag + (progn + (setq close (point)) + (goto-char (match-end 0)))) + ;; on tag? + (or (save-excursion (setq close (sgml-beginning-of-tag) + close (and (stringp close) + (eq (aref close 0) ?/) + (point)))) + ;; not on closing tag + (let ((point (point))) + (sgml-skip-tag-backward 1) + (if (or (not (eq (following-char) ?<)) + (save-excursion + (forward-list 1) + (<= (point) point))) + (error "Not on or before tag"))))) + (if close + (progn + (sgml-skip-tag-backward 1) + (setq open (point)) + (goto-char close) + (kill-sexp 1)) + (setq open (point)) + (sgml-skip-tag-forward 1) + (backward-list) + (forward-char) + (if (eq (aref (sgml-beginning-of-tag) 0) ?/) + (kill-sexp 1))) + (goto-char open) + (kill-sexp 1))) + (setq arg (1- arg)))) + + + +(defun sgml-tags-invisible (arg) + "Toggle visibility of existing tags." + (interactive "P") + (let ((modified (buffer-modified-p)) + (inhibit-read-only t) + (point (point-min)) + symbol) + (save-excursion + (goto-char point) + (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 (setq point (point)) (forward-list) + 'intangible (point)) + (put-text-property point (point) + 'category 'sgml-tag)) + (while (< (setq point (next-overlay-change point)) (point-max)) + (delete-overlay (car (overlays-at point)))) + (remove-text-properties (point-min) (point-max) + '(category sgml-tag intangible t)))) + (set-buffer-modified-p modified) + (run-hooks 'sgml-tags-invisible-hook) + (message ""))) + +(defun sgml-point-entered (x y) + ;; Show preceding or following hidden tag, depending of cursor direction. + (let ((inhibit-point-motion-hooks t)) + (save-excursion + (message "Invisible tag: %s" + (buffer-substring + (point) + (if (or (and (> x y) + (not (eq (following-char) ?<))) + (and (< x y) + (eq (preceding-char) ?>))) + (backward-list) + (forward-list))))))) + + +(autoload 'compile-internal "compile") + (defun sgml-validate (command) "Validate an SGML document. Runs COMMAND, a shell command, in a separate process asynchronously @@ -254,4 +707,497 @@ and move to the line in the SGML document that caused it." (setq sgml-saved-validate-command command) (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'." + (or (if top-level + (condition-case nil + (up-list -1) + (error t)) + (>= (point) + (if (search-backward "<" nil t) + (save-excursion + (forward-list) + (point)) + 0))) + (if (looking-at "<[!?/]?[[A-Za-z][A-Za-z0-9]*") + (buffer-substring-no-properties + (1+ (point)) + (match-end 0)) + t))) + +(defun sgml-value (alist) + (setq alist (cdr alist)) + (if (stringp (car alist)) + (insert "=\"" (car alist) ?\") + (if (eq (car alist) t) + (if (cdr alist) + (progn + (insert "=\"") + (setq alist (skeleton-read '(completing-read + "[Value]: " (cdr alist)))) + (if (string< "" alist) + (insert (funcall skeleton-transformation alist) ?\") + (delete-backward-char 2)))) + (insert "=\"") + (if alist + (insert (funcall skeleton-transformation + (skeleton-read '(completing-read "Value: " alist))))) + (insert ?\")))) + +(provide 'sgml-mode) + +;;;###autoload +(or (rassq 'html-mode auto-mode-alist) + (setq auto-mode-alist `(("\\.s?html?\\'" . html-mode) + ,@auto-mode-alist))) + +(defvar html-quick-keys t + "Use C-c combinations for quick insertion of frequent tags when non-nil. +This takes effect when first loading the library.") + +(defvar html-mode-map + (let ((map (nconc (make-sparse-keymap) sgml-mode-map)) + (menu-map (make-sparse-keymap "HTML"))) + (if html-quick-keys + (progn + (define-key map "\C-c1" 'html-headline) + (define-key map "\C-c2" 'html-headline) + (define-key map "\C-c3" 'html-headline) + (define-key map "\C-c4" 'html-headline) + (define-key map "\C-c5" 'html-headline) + (define-key map "\C-c6" 'html-headline) + (define-key map "\C-c-" 'html-horizontal-rule) + (define-key map "\C-c\r" 'html-paragraph) + (define-key map "\C-c\n" 'html-line) + (define-key map "\C-co" 'html-list) + (define-key map "\C-cu" 'html-list) + (define-key map "\C-cr" 'html-radio-buttons) + (define-key map "\C-cl" 'html-list-item) + (define-key map "\C-ch" 'html-href-anchor) + (define-key map "\C-cn" 'html-name-anchor) + (define-key map "\C-ci" 'html-image))) + (define-key map "\C-c\C-s" 'html-autoview-mode) + (define-key map "\C-c\C-v" 'browse-url-of-buffer) + (define-key map [menu-bar html] (cons "HTML" menu-map)) + (define-key menu-map [html-autoview-mode] + '("Toggle Autoviewing" . html-autoview-mode)) + (define-key menu-map [browse-url-of-buffer] + '("View Buffer Contents" . browse-url-of-buffer)) + (define-key menu-map [nil] '("--")) + ;;(define-key menu-map "6" '("Heading 6" . html-headline)) + ;;(define-key menu-map "5" '("Heading 5" . html-headline)) + ;;(define-key menu-map "4" '("Heading 4" . html-headline)) + (define-key menu-map "3" '("Heading 3" . html-headline)) + (define-key menu-map "2" '("Heading 2" . html-headline)) + (define-key menu-map "1" '("Heading 1" . html-headline)) + (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons)) + (define-key menu-map "l" '("List Item" . html-list-item)) + (define-key menu-map "u" '("Unordered List" . html-list)) + (define-key menu-map "o" '("Ordered List" . html-list)) + (define-key menu-map "-" '("Horizontal rule" . html-horizontal-rule)) + (define-key menu-map "\n" '("Line Break" . html-line)) + (define-key menu-map "\r" '("Paragraph" . html-paragraph)) + (define-key menu-map "i" '("Image" . html-image)) + (define-key menu-map "h" '("Href Anchor" . html-href-anchor)) + (define-key menu-map "n" '("Name Anchor" . html-name-anchor)) + map) + "Keymap for commands for use in HTML mode.") + + +(defvar html-face-tag-alist + '((bold . "b") + (italic . "i") + (underline . "u") + (modeline . "rev")) + "Value of `sgml-face-tag-alist' for HTML mode.") + +(defvar html-tag-face-alist + '(("b" . bold) + ("big" . bold) + ("blink" . highlight) + ("cite" . italic) + ("em" . italic) + ("h1" bold underline) + ("h2" bold-italic underline) + ("h3" italic underline) + ("h4" . underline) + ("h5" . underline) + ("h6" . underline) + ("i" . italic) + ("rev" . modeline) + ("s" . underline) + ("small" . default) + ("strong" . bold) + ("title" bold underline) + ("tt" . default) + ("u" . underline) + ("var" . italic)) + "Value of `sgml-tag-face-alist' for HTML mode.") + + +(defvar html-display-text + '((img . "[/]") + (hr . "----------") + (li . "o ")) + "Value of `sgml-display-text' for HTML mode.") + + +; 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"))) + (align '(("align" ("left") ("center") ("right")))) + (valign '(("top") ("middle") ("bottom") ("baseline"))) + (rel '(("next") ("previous") ("parent") ("subdocument") ("made"))) + (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:") + ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:") + ("wais:"))) + (name '("name")) + (link `(,href + ("rel" ,@rel) + ("rev" ,@rel) + ("title"))) + (list '((nil \n + ( "List item: " + "
  • " str \n)) + ("type" ("A") ("a") ("I") ("i") ("1")))) + (cell `(t + ,align + ("valign" ,@valign) + ("colspan" ,@1-9) + ("rowspan" ,@1-9) + ("nowrap" t)))) + ;; put ,-expressions first, else byte-compile chokes (as of V19.29) + ;; and like this it's more efficient anyway + `(("a" ,name ,@link) + ("base" t ,@href) + ("dir" ,@list) + ("font" "size" ("-1") ("+1") ("-2") ("+2") ,@(cdr (cdr 1-9))) + ("form" \n ("action" ,@(cdr href)) ("method" ("get") ("post"))) + ("h1" ,@align) + ("h2" ,@align) + ("h3" ,@align) + ("h4" ,@align) + ("h5" ,@align) + ("h6" ,@align) + ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align) + ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom")) + ("src") ("alt") ("width" "1") ("height" "1") + ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t)) + ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name + ("type" ("text") ("password") ("checkbox") ("radio") ("sbmit") ("reset")) + ("value")) + ("link" t ,@link) + ("menu" ,@list) + ("ol" ,@list) + ("p" t ,@align) + ("select" (nil \n + ("Text: " + "