;;; 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, 675 Mass Ave, Cambridge, MA 02139, 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") (require 'psgml) (require 'derived) (when html-auto-sgml-entity-conversion (require 'iso-sgml)) (require 'tempo) ;essential part of html-helper-mode ;;{{{ 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-" :group 'html :group 'psgml) ;; Set this to be whatever signature you want on the bottom of your pages. (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 'boolean :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) "*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) ;;}}} 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-shortag t) ;; font-lock setup for various emacsen: XEmacs, Emacs 19.29+, Emacs <19.29. ;; By Ulrik Dickow . (Last update: 05-Sep-1995). (cond ((string-match "XEmacs\\|Lucid" (emacs-version)) ; 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) ; sigh ... need to call this now to get things working. (sgml-build-custom-menus) (add-submenu nil sgml-html-menu "SGML") (delete-menu-item '("SGML"))) (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-zb" 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")) (image . (html-helper-image-map "\C-zm" html-helper-image-menu "Insert Inlined Images")))) ;; 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 (copy-sequence input-string)) (l (1- (length s)))) (while (> l 0) (if (char-equal (aref s l) ?\ ) (aset s l ?\-)) (setq l (1- l))) (concat "html-" (downcase 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/2.0 compliant, with the exception ;; of container

(we adopt 3.0 behaviour). ;; 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 "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 "-" "" "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" "" > (r "Definition: "))) (list "l" "" "List Item" (& "" > (r "Item: "))) (list "r" "" "DirectoryList" (& "" > "\n" > (r "Item: ") "\n" >)) (list "m" "" "Menu List" (& "" > "\n" > (r "Item: ") "\n" >)) (list "o" "" "Ordered List" (& "" > "\n" > (r "Item: ") "\n" >)) (list "d" "" "Definition List" (& "" > "\n" > (p "Term: ") "\n " > (r "Definition: ") "\n" >)) (list "u" "" "Unordered List" (& "" > "\n" > (r "Item: ") "\n" >)) ;;anchors (anchor "n" "" (r "Anchor text: ") "")) (anchor "h" "" (r "Anchor text: ") "")) ;;graphics (image "a" nil "Aligned Image" ("")) (image "i" "")) (image "e" "")) (image "t" "")) ;;text elements (textel "\C-c=" nil "Horizontal Line" (& "\n")) (textel "\C-c\C-m" nil "Line Break" (" \n")) (textel "\e\C-m" nil "Paragraph" ("" (progn (sgml-indent-line) nil) "\n")) ;;head elements (head "H" "" "Head" ("\n" "\n")) (head "B" "" "Body" ("\n" "\n")) (head "i" "" "Isindex" ("\n")) (head "n" "" "Nextid" ("\n")) (head "h" "\n")) (head "m" "\n")) (head "l" "")) (head "b" "")) (head "t" "" "Title" ("<title>" (r "Document title: ") "")) )) ;;}}} ;;{{{ html-helper-smart-insert-item ;; there are two different kinds of items in HTML - those in regular ;; lists and those in dictionaries .. ;; This command will insert the appropriate one depending on context. (defun html-helper-smart-insert-item (&optional arg) "Insert a new item, either in a regular list or a dictionary." (interactive "*P") (let ((case-fold-search t)) (if (save-excursion (re-search-backward "\\|\\|\\|\\|\\|\\|\\|" nil t) (looking-at "\\|\\|")) (tempo-template-html-definition-item arg) (tempo-template-html-list-item arg)))) ;; special keybindings in the prefix maps (not in the list of tags) (and (boundp 'html-helper-base-map) (define-key html-helper-base-map "i" 'html-helper-smart-insert-item)) (define-key html-mode-map "\C-z\C-z" 'suspend-or-iconify-emacs) (define-key html-mode-map "\C-zg" 'html-insert-mailto-reference-from-click) ;; and, special menu bindings (and (boundp 'html-helper-list-menu) (setq html-helper-list-menu (cons '["List Item" html-helper-smart-insert-item t] html-helper-list-menu))) ;;}}} ;;{{{ patterns for font-lock ; Old patterns from html-mode.el ;(defvar html-font-lock-keywords ; (list ; '("\$<[^>]*>\$+" . font-lock-comment-face) ; '("[Hh][Rr][Ee][Ff]=\"\$[^\"]*\$\"" 1 font-lock-string-face t) ; '("[Ss][Rr][Cc]=\"\$[^\"]*\$\"" 1 font-lock-string-face t)) ; "Patterns to highlight in HTML buffers.") ;; By Ulrik Dickow . ;; ;; Originally aimed at Emacs 19.29. Later on disabled syntactic fontification ;; and reordered regexps completely, to be compatible with XEmacs (it doesn't ;; understand OVERRIDE=`keep'). ;; ;; We make an effort on handling nested tags intelligently. ;; font-lock compatibility with XEmacs/Lucid and older Emacsen (<19.29). ;; (if (string-match "XEmacs\\|Lucid" (emacs-version)) ;; XEmacs/Lucid ;; Make needed faces if the user hasn't already done so. ;; Respect X resources (`make-face' uses them when they exist). (let ((change-it (function (lambda (face) (or (if (fboundp 'facep) (facep face) (memq face (face-list))) (make-face face)) (not (face-differs-from-default-p face)))))) (if (funcall change-it 'html-helper-bold-face) (copy-face 'bold 'html-helper-bold-face)) (if (funcall change-it 'html-helper-italic-face) (copy-face 'italic 'html-helper-italic-face)) (if (funcall change-it 'html-helper-underline-face) (set-face-underline-p 'html-helper-underline-face t)) (if (funcall change-it 'font-lock-variable-name-face) (set-face-foreground 'font-lock-variable-name-face "salmon")) (if (funcall change-it 'font-lock-reference-face) (set-face-foreground 'font-lock-reference-face "violet"))) ;; Emacs (any version) ;; ;; Note that Emacs evaluates the face entries in `font-lock-keywords', ;; while XEmacs doesn't. So XEmacs doesn't use the following *variables*, ;; but instead the faces with the same names as the variables. (defvar html-helper-bold-face 'bold "Face used as bold. Typically `bold'.") (defvar html-helper-italic-face 'italic "Face used as italic. Typically `italic'.") (defvar html-helper-underline-face 'underline "Face used as underline. Typically `underline'.") ;; (if (string-lessp "19.28.89" emacs-version) () ; Emacs 19.29 and later ;; Emacs 19.28 and older ;; Define face variables that don't exist until Emacs 19.29. (defvar font-lock-variable-name-face 'font-lock-doc-string-face "Face to use for variable names -- and some HTML keywords.") (defvar font-lock-reference-face 'underline ; Ugly at line breaks "Face to use for references -- including HTML hyperlink texts."))) (defvar html-font-lock-keywords (let (;; Titles and H1's, like function defs. ;; We allow for HTML 3.0 attributes, like `'. (tword "\$h1\\|title\$\$[ \t\n]+[^>]+\$?") ;; Names of tags to boldify. (bword "\$b\\|h[2-4]\\|strong\$\$[ \t\n]+[^>]+\$?") ;; Names of tags to italify. (iword "\$address\\|cite\\|em\\|i\\|var\$\$[ \t\n]+[^>]+\$?") ;; Regexp to match shortest sequence that surely isn't a bold end. ;; We simplify a bit by extending "" to "]\\|" "h\$[^2-4]\\|[2-4][^>]\$\\|" "s\$[^t]\\|t[^r]\$\\)\\)\\)")) (not-iend (concat "\$[^<]\\|<\\([^/]\\|/\\([^aceiv]\\|" "a\\([^d]\\|d[^d]\$\\|" "c\$[^i]\\|i[^t]\$\\|" "e\$[^m]\\|m[^>]\$\\|" "i[^>]\\|" "v\$[^a]\\|a[^r]\$\\)\\)\\)")) (not-tend (concat "\$[^<]\\|<\\([^/]\\|/\\([^ht]\\|" "h[^1]\\|t\\([^i]\\|i[^t]\$\\)\\)\\)"))) (list ; Avoid use of `keep', since XEmacs will treat it the same as `t'. ;; First fontify the text of a HREF anchor. It may be overridden later. ;; Anchors in headings will be made bold, for instance. '("]*>\$[^>]+\$" 1 font-lock-reference-face t) ;; Tag pairs like ... etc. ;; Cunning repeated fontification to handle common cases of overlap. ;; Bold complex --- possibly with arbitrary other non-bold stuff inside. (list (concat "<" bword ">\$" not-bend "*\$") 3 'html-helper-bold-face t) ;; Italic complex --- possibly with arbitrary non-italic kept inside. (list (concat "<" iword ">\$" not-iend "*\$") 3 'html-helper-italic-face t) ;; Bold simple --- first fontify bold regions with no tags inside. (list (concat "<" bword ">\$" "[^<]" "*\$") 3 'html-helper-bold-face t) ;; Any tag, general rule, just after bold/italic stuff. '("\$<[^>]*>\$" 1 font-lock-type-face t) ;; Titles and level 1 headings (anchors do sometimes appear in h1's) (list (concat "<" tword ">\$" not-tend "*\$") 3 'font-lock-function-name-face t) ;; Underline is rarely used. Only handle it when no tags inside. '("\$[^<]*\$" 1 html-helper-underline-face t) ;; Forms, anchors & images (also fontify strings inside) '("\$<\\(form\\|i\\(mg\\|nput\$\\)\\>[^>]*>\\)" 1 font-lock-variable-name-face t) '("" 0 font-lock-keyword-face t) '("\$]*>\$" 1 font-lock-keyword-face t) '("=[ \t\n]*\$\"[^\"]+\"\$" 1 font-lock-string-face t) ;; Large-scale structure keywords (like "program" in Fortran). ;; "" "" "" "" "" "" "" '("" 0 font-lock-variable-name-face t) ;; HTML special characters '("&[^;\n]*;" 0 font-lock-string-face t) ;; SGML things like with possible inside. '("\$[^<>]*\\(<[^>]*>[^<>]*\$*>\\)" 1 font-lock-comment-face t) ;; Comments: . They traditionally override anything else. ;; It's complicated 'cause we won't allow "-->" inside a comment, and ;; font-lock colours the *longest* possible match of the regexp. '("\$\$" 1 font-lock-comment-face t))) "Additional expressions to highlight in HTML mode.") (put 'html-mode 'font-lock-defaults '(html-font-lock-keywords)) (put 'html3-mode 'font-lock-defaults '(html-font-lock-keywords)) ;;}}} ;;{{{ patterns for hilit19 ;; Define some useful highlighting patterns for the hilit19 package. ;; These will activate only if hilit19 has already been loaded. ;; Thanks to for some pattern suggestions (if (featurep 'hilit19) (hilit-set-mode-patterns 'html-helper-mode '(("" comment) ("[^<>]*\$<[^>]*>[^<>]*\$*>" nil comment) ; ("" "" defun) ("" "" bold) ;only colour inside tag ("" define) ("" nil define) ("" include) ("" include) ;; First highlighting just handles unnested tags, then do nesting ("[^<]*" nil italic) ("" "" bold) ("" "" italic) ("" "" underline) ("&[^;\n]*;" nil string) ("<" ">" keyword)) nil 'case-insensitive) nil) ;;}}} ;;{{{ timestamps (defun html-helper-update-timestamp () "Basic function for updating timestamps. It finds the timestamp in the buffer by looking for `html-helper-timestamp-start', deletes all text up to `html-helper-timestamp-end', and runs `html-helper-timestamp-hook' which will should insert an appropriate timestamp in the buffer." (save-excursion (goto-char (point-max)) (if (not (search-backward html-helper-timestamp-start nil t)) (message "timestamp delimiter start was not found") (let ((ts-start (+ (point) (length html-helper-timestamp-start))) (ts-end (if (search-forward html-helper-timestamp-end nil t) (- (point) (length html-helper-timestamp-end)) nil))) (if (not ts-end) (message "timestamp delimiter end was not found. Type C-c C-t to insert one.") (delete-region ts-start ts-end) (goto-char ts-start) (run-hooks 'html-helper-timestamp-hook))))) nil) (defun html-helper-return-created-string () "Return a \"Created:\" string." (let ((time (current-time-string))) (concat "\n"))) (defun html-helper-default-insert-timestamp () "Default timestamp insertion function." (let ((time (current-time-string))) (insert "Last modified: " (substring time 0 20) (nth 1 (current-time-zone)) " " (substring time -4) "\n"))) (defun html-helper-insert-timestamp-delimiter-at-point () "Simple function that inserts timestamp delimiters at point. Useful for adding timestamps to existing buffers." (interactive) (insert html-helper-timestamp-start) (insert html-helper-timestamp-end)) ;;}}} (defun mail-address-at-point (pos &optional buffer) "Return a list (NAME ADDRESS) of the address at POS in BUFFER." (or buffer (setq buffer (current-buffer))) (let (beg end) (save-excursion (set-buffer buffer) (save-excursion (goto-char pos) (or (re-search-forward "[\n,]" nil t) (error "Can't find address at position")) (backward-char) (setq end (point)) (or (re-search-backward "[\n,:]" nil t) (error "Can't find address at position")) (forward-char) (re-search-forward "[ \t]*" nil t) (setq beg (point)) (mail-extract-address-components (buffer-substring beg end)))))) (defun html-insert-mailto-reference-from-click () "Insert a mailto: reference for the clicked-on e-mail address." (interactive) (let (event) (message "Click on a mail address:") (save-excursion (setq event (next-command-event)) (or (mouse-event-p event) (error "Aborted."))) (let ((lis (mail-address-at-point (event-closest-point event) (event-buffer event)))) (insert "" (or (car lis) (car (cdr lis))) "")))) (defun html-quote-region (begin end) "\"Quote\" any characters in the region that have special HTML meanings. This converts <'s, >'s, and &'s into the HTML commands necessary to get those characters to appear literally in the output." (interactive "r") (save-excursion (goto-char begin) (while (search-forward "&" end t) (forward-char -1) (delete-char 1) (insert "&") (setq end (+ 4 end))) (goto-char begin) (while (search-forward "<" end t) (forward-char -1) (delete-char 1) (insert "<") (setq end (+ 3 end))) (goto-char begin) (while (search-forward ">" end t) (forward-char -1) (delete-char 1) (insert ">") (setq end (+ 3 end))))) ;;{{{ html-helper-insert-new-buffer-strings (tempo-define-template "html-skeleton" html-helper-new-buffer-template nil "Insert a skeleton for a HTML document") (defun html-helper-insert-new-buffer-strings () "Insert `html-helper-new-buffer-strings'." (tempo-template-html-skeleton)) ;;}}} ;;;###autoload (autoload 'html-mode "psgml-html" "HTML mode." t) ;;;###autoload (autoload 'html3-mode "psgml-html" "HTML3 mode." t) (defvar sgml-html-menu (cons "HTML" (append '(["View in Netscape" sgml-html-netscape-file (buffer-file-name (current-buffer))] ["View in W3" w3-preview-this-buffer t] "---" ["HTML-Quote Region" html-quote-region t] "---") (cdr sgml-main-menu)))) (defun sgml-html-netscape-file () "Preview the file for the current buffer in Netscape." (interactive) (highlight-headers-follow-url-netscape (concat "file:" (buffer-file-name (current-buffer))))) (define-derived-mode html3-mode html-mode "HTML3" (setq sgml-declaration (expand-file-name "html3.decl" sgml-data-directory) sgml-default-doctype-name "html-3" sgml-shortag nil ))