;;; psgml-html.el --- HTML mode in conjunction with PSGML ;; Copyright (C) 1994 Nelson Minar. ;; Copyright (C) 1995 Nelson Minar and Ulrik Dickow. ;; Copyright (C) 1996 Ben Wing. ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; see the file COPYING. If not, write to the Free ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. ;;; Synched up with: FSF 19.30. ;;; Author: Ben Wing. ;;; Commentary: ; Parts were taken from html-helper-mode and from code by Alastair Burt. ; If you'd like to use the hm--html-minor-mode together with this ; mode, you have to put the following line to your ~/.emacs: ; (add-hook 'html-mode-hook 'hm--html-minor-mode) ;;; Code: (defvar html-auto-sgml-entity-conversion nil "*Control automatic SGML entity to ISO-8859-1 conversion.") (provide 'psgml-html) (require 'psgml) (require 'derived) (when html-auto-sgml-entity-conversion (require 'iso-sgml)) (require 'tempo) ;essential part of html-helper-mode (eval-when-compile (require 'browse-url) (require 'font-lock) (require 'imenu) (require 'sendmail)) ;;{{{ user variables (defgroup html nil "HyperText Markup Language" :group 'sgml) (defgroup psgml-html nil "HTML mode in conjunction with PSGML" :tag "Psgml Html" :prefix "html-helper-" :prefix "psgml-html-" :group 'html :group 'hypermedia :group 'psgml) (defcustom html-helper-address-string (concat "" (user-full-name) "") "*The default author string of each file." :type 'string :group 'psgml-html) (defcustom html-helper-htmldtd-version "\n" "*Version of HTML DTD you're using." :type 'string :group 'psgml-html) (defcustom html-helper-do-write-file-hooks t "*If not nil, then modify `local-write-file-hooks' to do timestamps." :type 'boolean :group 'psgml-html) (defcustom html-helper-build-new-buffer t "*If not nil, then insert `html-helper-new-buffer-strings' for new buffers." :type 'boolean :group 'psgml-html) (defcustom html-helper-timestamp-hook 'html-helper-default-insert-timestamp "*Hook called for timestamp insertion. Override this for your own timestamp styles." :type 'hook :group 'psgml-html) ;; strings you might want to change (defcustom html-helper-new-buffer-template '(html-helper-htmldtd-version "\n" " \n" " " (p "Document Title: " title) "\n" " \n" "\n" " \n" "

" (s title) "

\n\n" p "\n\n

\n" "

" html-helper-address-string "

\n" (html-helper-return-created-string) html-helper-timestamp-start html-helper-timestamp-end "\n \n\n") "*Template for new buffers. Inserted by `html-helper-insert-new-buffer-strings' if `html-helper-build-new-buffer' is set to t" :type 'sexp :group 'psgml-html) (defcustom html-helper-timestamp-start "\n" "*Start delimiter for timestamps. Everything between `html-helper-timestamp-start' and `html-helper-timestamp-end' will be deleted and replaced with the output of the functions `html-helper-timestamp-hook' if `html-helper-do-write-file-hooks' is t" :type 'string :group 'psgml-html) (defcustom html-helper-timestamp-end "" "*End delimiter for timestamps. Everything between `html-helper-timestamp-start' and `html-helper-timestamp-end' will be deleted and replaced with the output of the function `html-helper-insert-timestamp' if `html-helper-do-write-file-hooks' is t" :type 'string :group 'psgml-html) ;; control over what types of tags to load. By default, we load all the ;; ones we know of. (defcustom html-helper-types-to-install '(anchor header logical phys list textel entity image head form table special) "*List of tag types to install when html-helper-mode is first loaded. If you want to not install some type of tag, override this variable. Order is significant: menus go in this order." :type '(repeat symbol) :group 'psgml-html) (defcustom html-helper-use-expert-menu nil "*If not nil, then use the full HTML menu." :type 'boolean :group 'psgml-html) (defcustom html-helper-user-menu nil "*Extra items to put in the HTML expert menu. The value of this symbol is appended to the beginning of the expert menu that is handed off to easymenu for definition. It should be a list of vectors or lists which themselves are vectors (for submenus)." :type 'sexp :group 'psgml-html) (defgroup psgml-html-faces nil "Faces for highlighting HTML." :prefix "html-helper-" :group 'faces :group 'psgml-html) (defface html-helper-bold-face '((t (:bold t))) "*Face for highlighting bold text." :group 'psgml-html-faces) (defface html-helper-italic-face '((t (:italic t))) "*Face for highlighting italic text." :group 'psgml-html-faces) (defface html-helper-underline-face '((t (:underline t))) "*Face for highlighting underlined text." :group 'psgml-html-faces) (defface html-helper-strikethrough-face '((t (:strikethru t))) "*Face for highlighting strikethrough text." :group 'psgml-html-faces) ;; Could be underline, but it looks ugly at line breaks. (defface html-helper-link-face '((t (:foreground "blue"))) "*Face for highlighting link text." :group 'psgml-html-faces) (defface html-helper-significant-tag-face '((t (:foreground "salmon"))) "*Face for highlighting html, body, head, form, input and img tags." :group 'psgml-html-faces) ;;}}} end of user variables ;;{{{ type based keymap and menu variable and function setup ;; html-helper-mode has a concept of "type" of tags. Each type is a ;; list of tags that all go together in one keymap and one menu. ;; Types can be added to the system after html-helper has been loaded, ;; briefly by doing html-helper-add-type-to-alist, then ;; html-helper-install-type, then html-helper-add-tag (for each tag) ;; then html-helper-rebuild-menu. See the mode documentation for more detail. (defconst html-helper-type-alist nil "Alist: type of tag -> keymap, keybinding, menu, menu string. Add to this with `html-helper-add-type-to-alist'.") ;;{{{ accessor functions for html-helper-type-alist (defun html-helper-keymap-for (type) "Accessor function for alist: for type, return keymap or nil" (nth 0 (cdr-safe (assq type html-helper-type-alist)))) (defun html-helper-key-for (type) "Accessor function for alist: for type, return keybinding or nil" (nth 1 (cdr-safe (assq type html-helper-type-alist)))) (defun html-helper-menu-for (type) "Accessor function for alist: for type, return menu or nil" (nth 2 (cdr-safe (assq type html-helper-type-alist)))) (defun html-helper-menu-string-for (type) "Accessor function for alist: for type, return menustring or nil" (nth 3 (cdr-safe (assq type html-helper-type-alist)))) (defun html-helper-normalized-menu-for (type) "Helper function for building menus from submenus: add on string to menu." (cons (html-helper-menu-string-for type) (eval (html-helper-menu-for type)))) ;;}}} (define-derived-mode html-mode sgml-mode "HTML" "Major mode for editing HTML documents. This is based on PSGML mode, and has a sophisticated SGML parser in it. It knows how to properly indent HTML/SGML documents, and it can do a form of document validation (use \\[sgml-next-trouble-spot] to find the next error in your document). Commands beginning with C-z insert various types of HTML tags (prompting for the required information); to iconify or suspend, use C-z C-z. To literally insert special characters such as < and &, use C-c followed by the character. Use \\[sgml-insert-end-tag] to insert the proper closing tag. Use \\[sgml-edit-attributes] to edit the attributes for a tag. Use \\[sgml-show-context] to show the current HTML context. More specifically: \\{html-mode-map} " (make-local-variable 'sgml-declaration) (make-local-variable 'sgml-default-doctype-name) (setq sgml-declaration (expand-file-name "html.decl" sgml-data-directory) sgml-default-doctype-name "HTML" sgml-always-quote-attributes t sgml-indent-step 2 sgml-indent-data t sgml-inhibit-indent-tags '("pre") sgml-minimize-attributes nil sgml-omittag t sgml-shorttag t) ;; font-lock setup for various emacsen: XEmacs, Emacs 19.29+, Emacs <19.29. ;; By Ulrik Dickow . (Last update: 05-Sep-1995). (cond (running-xemacs ; XEmacs/Lucid (put major-mode 'font-lock-keywords-case-fold-search t)) ;; XEmacs (19.13, at least) guesses the rest correctly. ;; If any older XEmacsen don't, then tell me. ;; ((string-lessp "19.28.89" emacs-version) ; Emacs 19.29 and later (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(html-font-lock-keywords t t))) ;; (t ; Emacs 19.28 and older (make-local-variable 'font-lock-keywords-case-fold-search) (make-local-variable 'font-lock-keywords) (make-local-variable 'font-lock-no-comments) (setq font-lock-keywords-case-fold-search t) (setq font-lock-keywords html-font-lock-keywords) (setq font-lock-no-comments t))) (if html-helper-do-write-file-hooks (add-hook 'local-write-file-hooks 'html-helper-update-timestamp)) (if (and html-helper-build-new-buffer (zerop (buffer-size))) (html-helper-insert-new-buffer-strings)) (set (make-local-variable 'sgml-custom-markup) '(("" "\r"))) ;; Set up the syntax table. (modify-syntax-entry ?< "(>" html-mode-syntax-table) (modify-syntax-entry ?> ")<" html-mode-syntax-table) (modify-syntax-entry ?\" ". " html-mode-syntax-table) (modify-syntax-entry ?\\ ". " html-mode-syntax-table) (modify-syntax-entry ?' "w " html-mode-syntax-table) (tempo-use-tag-list 'html-helper-tempo-tags html-helper-completion-finder) (set (make-local-variable 'imenu-create-index-function) 'html-helper-imenu-index) (set (make-local-variable 'imenu-sort-function) nil) ; sorting the ; menu defeats ; the purpose ; sigh ... need to call this now to get things working. (sgml-build-custom-menus) ;; (add-submenu nil sgml-html-menu "SGML") (setq sgml-menu-name "HTML") (easy-menu-add sgml-html-menu) (html-helper-rebuild-menu) (unless (featurep 'infodock) (delete-menu-item '("SGML")))) (defvar html-helper-imenu-regexp "\\s-*]*>\$<[^\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.") ;; Make an index for imenu (defun html-helper-imenu-index () "Return an table of contents for an html buffer for use with Imenu." (let ((space ?\ ) ; a char (toc-index '()) toc-str) (save-excursion (goto-char (point-min)) (while (re-search-forward html-helper-imenu-regexp nil t) (setq toc-str (concat (make-string (* 2 (- (string-to-number (match-string 1)) 1)) space) (match-string 3))) (beginning-of-line) (setq toc-index (cons (cons toc-str (point)) toc-index)) (end-of-line))) (nreverse toc-index))) (defun html-helper-add-type-to-alist (type) "Add a type specification to the alist. The spec goes (type . (keymap-symbol keyprefix menu-symbol menu-string)). See code for an example." (setq html-helper-type-alist (cons type html-helper-type-alist))) ;; Here are the types provided by html-helper-mode. (mapcar 'html-helper-add-type-to-alist '((entity . (nil nil html-helper-entity-menu "Insert Character Entities")) (textel . (nil nil html-helper-textel-menu "Insert Text Elements")) (head . (html-helper-head-map "\C-zw" html-helper-head-menu "Insert Structural Elements")) (header . (html-helper-base-map "\C-z" html-helper-header-menu "Insert Headers")) (anchor . (html-helper-base-map "\C-z" html-helper-anchor-menu "Insert Hyperlinks")) (logical . (html-helper-base-map "\C-z" html-helper-logical-menu "Insert Logical Styles")) (phys . (html-helper-base-map "\C-z" html-helper-phys-menu "Insert Physical Styles")) (list . (html-helper-list-map "\C-zl" html-helper-list-menu "Insert List Elements")) (form . (html-helper-form-map "\C-zf" html-helper-form-menu "Insert Form Elements")) (table . (html-helper-table-map "\C-zt" html-helper-table-menu "Insert Table Elements")) (image . (html-helper-image-map "\C-zm" html-helper-image-menu "Insert Inlined Images")) (special . (html-helper-base-map "\C-z" html-helper-special-menu "Insert Specials")))) ;; Once html-helper-mode is aware of a type, it can then install the ;; type: arrange for keybindings, menus, etc. (defconst html-helper-installed-types nil "The types that have been installed (used when building menus). There is no support for removing a type once it has been installed.") (defun html-helper-install-type (type) "Install a new tag type: add it to the keymap, menu structures, etc. For this to work, the type must first have been added to the list of types with html-helper-add-type-to-alist." (setq html-helper-installed-types (cons type html-helper-installed-types)) (let ((keymap (html-helper-keymap-for type)) (key (html-helper-key-for type)) (menu (html-helper-menu-for type)) (menu-string (html-helper-menu-string-for type))) (and key (progn (set keymap nil) (define-prefix-command keymap) (define-key html-mode-map key keymap))) (and menu (progn (set menu nil))))) ;; install the default types. (mapcar 'html-helper-install-type html-helper-types-to-install) ;;}}} ;;{{{ html-helper-add-tag function for building basic tags (defvar html-helper-tempo-tags nil "List of tags used in completion.") ;; this while loop is awfully Cish ;; isn't there an emacs lisp function to do this? (defun html-helper-string-to-symbol (input-string) "Given a string, downcase it and replace spaces with -. We use this to turn menu entries into good symbols for functions. It's not entirely successful, but fortunately emacs lisp is forgiving." (let* ((s (downcase input-string)) (l (1- (length s)))) (while (>= l 0) (if (char-equal (aref s l) ?\ ) (aset s l ?\-)) (setq l (1- l))) (concat "html-" s))) (defun html-helper-add-tag (l) "Add a new tag to html-helper-mode. Builds a tempo-template for the tag and puts it into the appropriate keymap if a key is requested. Format: `(html-helper-add-tag '(type keybinding completion-tag menu-name template doc)'" (let* ((type (car l)) (keymap (html-helper-keymap-for type)) (menu (html-helper-menu-for type)) (key (nth 1 l)) (completer (nth 2 l)) (name (nth 3 l)) (tag (nth 4 l)) (doc (nth 5 l)) (command (tempo-define-template (html-helper-string-to-symbol name) tag completer doc 'html-helper-tempo-tags))) (if (null (memq type html-helper-installed-types)) ;type loaded? t ;no, do nothing. (if (stringp key) ;bind key somewhere? (if keymap ;special keymap? (define-key (eval keymap) key command) ;t: bind to prefix (define-key html-mode-map key command)) ;nil: bind to global t) (if menu ;is there a menu? (set menu ;good, cons it in (cons (vector name command t) (eval menu)))) ))) ;;}}} ;;{{{ most of the HTML tags ;; These tags are an attempt to be HTML 3.2 compliant ;; For reference see ;; order here is significant: within a tag type, menus and mode help ;; go in the reverse order of what you see here. Sorry about that, it's ;; not easy to fix. (mapcar 'html-helper-add-tag '( ;;entities (entity "\C-c#" "&#" "Ascii Code" ("&#" (r "Ascii: ") ";")) (entity "\C-c\"" """ "Quotation mark" (""")) (entity "\C-c$" "®" "Registered" ("®")) (entity "\C-c@" "©" "Copyright" ("©")) (entity "\C-c-" "" "Soft Hyphen" ("")) (entity "\C-c " " " "Nonbreaking Space" (" ")) (entity "\C-c&" "&" "Ampersand" ("&")) (entity "\C-c>" ">" "Greater Than" (">")) (entity "\C-c<" "<" "Less Than" ("<")) ;; logical styles (logical "v" "" (r "Text: ") "")) (logical "n" "" "Center" ("" (r "Text: ") "")) (logical "q" "

" "Blockquote" ("

" (r "Quote: ") "

")) (logical "c" "

"		"Code"           ("" (r "Code: ") ""))
   (logical "x"       ""		"Sample"         ("" (r "Sample code") ""))
   (logical "r"       ""		"Citation"       ("" (r "Citation: ") ""))
   (logical "k"       ""		"Keyboard Input" ("" (r "Keyboard: ") ""))
   (logical "v"       ""		"Variable"       ("" (r "Variable: ") ""))
   (logical "d"       ""		"Definition"     ("" (r "Definition: ") ""))
   (logical "a"	      ""	"Address"	 ("" r ""))
   (logical "e"       ""		"Emphasized"     ("" (r "Text: ") ""))
   (logical "s"       ""	"Strong"         ("" (r "Text: ") ""))
   (logical "p"       ""		"Preformatted"   ("" (r "Text: ") ""))

   ;;physical styles
   (phys    "p"       "^{"           "Superscript"    ("^{" (r "Text: ") "}"))
   (phys    "u"       "_{"           "Subscript"      ("_{" (r "Text: ") "}"))
   (phys    "s"       ""         "Small"          ("" (r "Text: ") ""))
   (phys    "g"       ""           "Big"            ("" (r "Text: ") ""))
   (phys    "-"       ""	"Strikethru"     ("" (r "Text: ") ""))
   (phys    "u"       ""		"Underline"      ("" (r "Text: ") ""))
   (phys    "o"       ""		"Italic"         ("" (r "Text: ") ""))
   (phys    "b"	      ""    		"Bold"           ("" (r "Text: ") ""))
   (phys    "t"       ""		"Fixed"          ("" (r "Text: ") ""))

   ;;headers
   (header  "6"       ""		"Header 6"       ("
" (r "Header: ") ""))
   (header  "5"       ""		"Header 5"       ("
" (r "Header: ") ""))
   (header  "4"       ""		"Header 4"       ("
" (r "Header: ") ""))
   (header  "3"       ""		"Header 3"       ("
" (r "Header: ") ""))
   (header  "2"       ""		"Header 2"       ("
" (r "Header: ") ""))
   (header  "1"	      ""     	"Header 1"       ("
" (r "Header: ") ""))

   ;; forms
   (form    "o"       "}}