html-mode.el update

Marc Andreessen (marca@ncsa.uiuc.edu)
Wed, 18 Nov 92 21:42:37 -0800


Following is the latest html-mode -- a few bugs have been fixed, and
some new features added. If you use this, send me a note; if you have
ideas on how it could specifically be made to be smarter and more
helpful, let me know; if you don't think I should be mailing this to
everyone on www-talk, let me know that too (there was quite a bit of
initial interest in an html mode, so that's why I'm mailing it out
now).

Cheers,
Marc

--
Marc Andreessen
Software Development Group
National Center for Supercomputing Applications
marca@ncsa.uiuc.edu

;;; -------------------------------------------------------------------------- ;;; HTML mode, based on text mode. ;;; Copyright (C) 1985 Free Software Foundation, Inc. ;;; Copyright (C) 1992 National Center for Supercomputing Applications. ;;; NCSA modifications by Marc Andreessen (marca@ncsa.uiuc.edu). ;;; ;;; This program 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 1, or ;;; (at your option) any later version. ;;; ;;; This program 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 GNU Emacs; see the file COPYING. If not, write to the ;;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; ;;; -------------------------------- CONTENTS -------------------------------- ;;; ;;; html-mode: Major mode for editing HTML hypertext documents. ;;; $Revision: 1.18 $ ;;; $Date: 1992/11/19 05:39:25 $ ;;; ;;; Canonical list of features: ;;; See below. ;;; ;;; ------------------------------ INSTRUCTIONS ------------------------------ ;;; ;;; Load html-mode.el before editing HTML documents. html-mode will ;;; detect the ``.html'' suffix and activate itself appropriately. ;;; ;;; You are assumed to be at least somewhat familiar with HTML format. ;;; If you aren't, read about it first (see below). ;;; ;;; Here are key sequences and corresponding commands: ;;; ;;; NORMAL COMMANDS: ;;; ;;; C-c a html-add-address ;;; Open an address element. ;;; ;;; C-c d html-add-definition-list ;;; Open a definition list. The initial entry is created for you. ;;; To create subsequent entries, use 'C-c e'. ;;; ;;; C-c e html-add-definition-entry ;;; Add a new definition entry in a definition list. You are ;;; assumed to be inside a definition list (specifically, at the end ;;; of another definition entry). ;;; ;;; C-c h html-add-header ;;; Add a header. You are prompted for size (1 is biggest, 2 is ;;; next biggest) and header contents. ;;; ;;; C-c i html-add-list-or-menu-item ;;; Add a new list or menu item in a list or menu. You are assumed ;;; to be inside a list or menu (specifically, at the end of another ;;; item). ;;; ;;; C-c l html-add-normal-link ;;; Add a link. You will be prompted for the link (any string; ;;; e.g., http://foo.bar/argh/blagh). The cursor will be left where ;;; you can type the text that will represent the link in the ;;; document. ;;; ;;; C-c m html-add-menu ;;; Open a menu. The initial item is created for you. To create ;;; additional items, use 'C-c i'. ;;; ;;; C-c p html-add-paragraph-separator ;;; Use this command at the end of each paragraph. ;;; ;;; C-c s html-add-list ;;; Open a list. The initial item is created for you. To create ;;; additional items, use 'C-c i'. ;;; ;;; C-c t html-add-title ;;; Add a title to the document. You will be prompted for the ;;; contents of the title. If a title already exists at the very ;;; top of the document, the existing contents will be replaced. ;;; ;;; C-c x html-add-plaintext ;;; Add plaintext. The cursor will be positioned where you can type ;;; plaintext (or insert another file, or whatever). ;;; ;;; COMMANDS THAT OPERATE ON THE CURRENT REGION: ;;; ;;; C-c C-r l html-add-normal-link-to-region ;;; Add a link that will be represented by the current region. You ;;; will be prompted for the link (any string, as with ;;; html-add-normal-link). ;;; ;;; C-c C-r r html-add-reference-to-region ;;; Add a reference (a link that does not reference anything) that ;;; will be represented by the current region. You will be prompted ;;; for the name of the link; if you just press RET, a numeric name ;;; will be created for you. ;;; ;;; SPECIAL COMMANDS: ;;; ;;; <, >, & ;;; These are overridden to output &lt;, &gt;, and &amp; ;;; respectively. The real characters <, >, and & can be entered ;;; into the text either by prepending 'C-c' to the character or by ;;; using the Emacs quoted-insert (C-q) command. ;;; ;;; C-c <, C-c >, C-c & ;;; See '< > &' above. ;;; ;;; NOTE: The key bindings above are what I find to be useful and easy ;;; to remember. If you have ideas on how to make them easier to ;;; handle for yourself or other people, please let me know. ;;; (Ideally, these commands all go in menus; to that end, someday ;;; soon I'll add a Lucid Emacs menu to html-mode.) ;;; ;;; ---------------------------- ADDITIONAL NOTES ---------------------------- ;;; ;;; If you are running Epoch or Lucid Emacs, highlighting will be used ;;; to deemphasize HTML message elements as they are created. You can ;;; turn this off; see the source code. ;;; ;;; To reorder all of the link NAME fields in your message (in order ;;; of their occurrence in the text), use: ;;; ;;; html-reorder-numeric-names ;;; Reorder the NAME fields for links in the current buffer. The ;;; new ordering starts at 1 and increases monotonically through the ;;; buffer. If optional arg REORDER-NON-NUMERIC is non-nil, then ;;; non-numeric NAME's will also be numbered, else they won't. ;;; ;;; -------------------------------- GOTCHAS --------------------------------- ;;; ;;; HTML documents can be tricky. html-mode is not smart enough to ;;; enforce correctness or sanity, so you have to do that yourself. ;;; ;;; In particular, html-mode is smart enough to generate unique ;;; numeric NAME id's for all links that were (1) created via an ;;; html-mode command or (2) present in the file when it was loaded. ;;; Any other links (e.g. links added via Emacs cut and paste) may ;;; have ID's that conflict with ID's html-mode generates. You must ;;; watch for this and fix it when appropriate; otherwise, your ;;; hypertext document will not work correctly. ;;; ;;; html-reorder-numeric-names can be used to reset all of the NAME ;;; id's in a document to an ordered sequence; this will also give ;;; html-mode a chance to look over the document and figure out what ;;; new links should be named to be unique. ;;; ;;; ------------------------- WHAT HTML-MODE IS NOT -------------------------- ;;; ;;; html-mode is not a mode for *browsing* HTML documents. In ;;; particular, html-mode provides no hypertext capabilities. There ;;; is a clear need for an HTML browser; if you write one, let me ;;; know. ;;; ;;; ------------------------------ WHAT HTML IS ------------------------------ ;;; ;;; HTML (HyperText Markup Language) is a format for hypertext ;;; documents. For more information on HTML, telnet to info.cern.ch. ;;; ;;; -------------------------------------------------------------------------- ;;; LCD Archive Entry: ;;; html-mode|Marc Andreessen|marca@ncsa.uiuc.edu| ;;; Major mode for editing HTML hypertext files.| ;;; $Date: 1992/11/19 05:39:25 $|$Revision: 1.18 $|~/modes/html-mode.el.Z| ;;; --------------------------------------------------------------------------

;; TODO: ;; sgml-mode stuff.

(provide 'html-mode)

;;; ------------------------------- variables --------------------------------

(defvar html-use-highlighting t "*Flag to use highlighting for HTML directives in Epoch or Lucid Emacs; if non-NIL, highlighting will be used.")

(defvar html-deemphasize-color "grey80" "*Color for de-highlighting HTML directives in Epoch or Lucid Emacs.")

(defvar html-emphasize-color "yellow" "*Color for highlighting HTML something-or-others in Epoch or Lucid Emacs.")

;;; --------------------------------- setup ----------------------------------

(defvar html-mode-syntax-table nil "Syntax table used while in html mode.")

(defvar html-mode-abbrev-table nil "Abbrev table used while in html mode.") (define-abbrev-table 'html-mode-abbrev-table ())

(if html-mode-syntax-table () (setq html-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\" ". " html-mode-syntax-table) (modify-syntax-entry ?\\ ". " html-mode-syntax-table) (modify-syntax-entry ?' "w " html-mode-syntax-table))

(defvar html-mode-map nil "") (if html-mode-map () (setq html-mode-map (make-sparse-keymap)) (define-key html-mode-map "\t" 'tab-to-tab-stop) (define-key html-mode-map "\C-ca" 'html-add-address) (define-key html-mode-map "\C-cd" 'html-add-definition-list) (define-key html-mode-map "\C-ce" 'html-add-definition-entry) (define-key html-mode-map "\C-ch" 'html-add-header) (define-key html-mode-map "\C-ci" 'html-add-list-or-menu-item) (define-key html-mode-map "\C-cl" 'html-add-normal-link) (define-key html-mode-map "\C-cm" 'html-add-menu) (define-key html-mode-map "\C-cp" 'html-add-paragraph-separator) (define-key html-mode-map "\C-cs" 'html-add-list) (define-key html-mode-map "\C-ct" 'html-add-title) (define-key html-mode-map "\C-cx" 'html-add-plaintext) (define-key html-mode-map "<" 'html-less-than) (define-key html-mode-map ">" 'html-greater-than) (define-key html-mode-map "&" 'html-ampersand) (define-key html-mode-map "\C-c<" 'html-real-less-than) (define-key html-mode-map "\C-c>" 'html-real-greater-than) (define-key html-mode-map "\C-c&" 'html-real-ampersand) (define-key html-mode-map "\C-c\C-rl" 'html-add-normal-link-to-region) (define-key html-mode-map "\C-c\C-rr" 'html-add-reference-to-region) )

;;; --------------------------- buffer-local vars ----------------------------

(defvar html-link-counter-default 0) (defvar html-link-counter nil) (make-variable-buffer-local 'html-link-counter) (setq-default html-link-counter html-link-counter-default)

;;; ------------------------------ highlighting ------------------------------

(defvar html-running-lemacs (string-match "Lucid" emacs-version) "Non-nil if running Lucid Emacs.")

(defvar html-running-epoch (boundp 'epoch::version) "Non-nil if running Epoch.")

(if (and html-running-epoch html-use-highlighting) (progn (defvar html-deemphasize-style (make-style)) (set-style-foreground html-deemphasize-style html-deemphasize-color) (defvar html-emphasize-style (make-style)) (set-style-foreground html-emphasize-style html-emphasize-color)))

(if (and html-running-lemacs html-use-highlighting) (progn (defvar html-deemphasize-style (make-face 'html-deemphasize-face)) (set-face-foreground html-deemphasize-style html-deemphasize-color) (defvar html-emphasize-style (make-face 'html-emphasize-face)) (set-face-foreground html-emphasize-style html-emphasize-color)))

(if html-use-highlighting (progn (if html-running-lemacs (defun html-add-zone (start end style) "Add a Lucid Emacs extent from START to END with STYLE." (let ((extent (make-extent start end))) (set-extent-face extent style) (set-extent-data extent 'html-mode)))) (if html-running-epoch (defun html-add-zone (start end style) "Add an Epoch zone from START to END with STYLE." (let ((zone (add-zone start end style))) (epoch::set-zone-data zone 'html-mode))))))

(defun html-maybe-deemphasize-region (start end) "Maybe deemphasize a region of text. Region is from START to END." (and (or html-running-epoch html-running-lemacs) html-use-highlighting (html-add-zone start end html-deemphasize-style)))

;;; ----------------------------- link commands ------------------------------

(defun html-add-link (link-object) "Add a link." (let ((start (point))) (setq html-link-counter (1+ html-link-counter)) (insert "<A NAME=" (format "%d" html-link-counter) " HREF=" link-object ">") (html-maybe-deemphasize-region start (1- (point))) (insert "</A>") (push-mark) (forward-char -4) (html-maybe-deemphasize-region (1+ (point)) (+ (point) 4))))

(defun html-add-normal-link (link) "Make a link. There is no completion of any kind yet." (interactive "sLink to: ") (html-add-link link))

(defun html-add-normal-link-to-region (link start end) "Make a link that applies to the current region. Again, no completion." (interactive "sLink to: \nr") (save-excursion (goto-char end) (save-excursion (goto-char start) (setq html-link-counter (1+ html-link-counter)) (insert "<A NAME=" (format "%d" html-link-counter) " HREF=" link ">") (html-maybe-deemphasize-region start (1- (point)))) (insert "</A>") (html-maybe-deemphasize-region (- (point) 3) (point))))

(defun html-add-reference-to-region (name start end) "Add a reference point (a link with no reference of its own) to the current region." (interactive "sName (or RET for numeric): \nr") (and (string= name "") (progn (setq html-link-counter (1+ html-link-counter)) (setq name (format "%d" html-link-counter)))) (save-excursion (goto-char end) (save-excursion (goto-char start) (insert "<A NAME=" name ">") (html-maybe-deemphasize-region start (1- (point)))) (insert "</A>") (html-maybe-deemphasize-region (- (point) 3) (point))))

;;; --------------------------- document elements ----------------------------

(defun html-add-title (title) "Add or modify a title." (interactive "sTitle: ") (save-excursion (goto-char (point-min)) (if (and (looking-at "<TITLE>") (save-excursion (forward-char 7) (re-search-forward "[^<]*" (save-excursion (end-of-line) (point)) t))) ;; Plop the new title in its place. (replace-match title t) (insert "<TITLE>") (html-maybe-deemphasize-region (point-min) (1- (point))) (insert title) (insert "</TITLE>") (html-maybe-deemphasize-region (- (point) 7) (point)) (insert "\n"))))

(defun html-add-header (size header) "Add a header." (interactive "sSize (1 or 2): \nsHeader: ") (let ((start (point))) (insert "<H" size ">") (html-maybe-deemphasize-region start (1- (point))) (insert header) (setq start (point)) (insert "</H" size ">\n") (html-maybe-deemphasize-region (1+ start) (1- (point)))))

(defun html-add-paragraph-separator () "Add a paragraph separator." (interactive) (let ((start (point))) (insert " <P>\n\n") (html-maybe-deemphasize-region (+ start 2) (- (point) 2))))

(defun html-add-definition-list () "Add a definition list." (interactive) (let ((start (point))) (insert "<DL>\n") (html-maybe-deemphasize-region start (1- (point))) (insert "<DT> ") ;; Point goes right there. (save-excursion (insert "\n<DD> \n") (setq start (point)) (insert "</DL>\n") (html-maybe-deemphasize-region start (1- (point))) ;; Mark goes after list -- this doesn't work. (push-mark))))

(defun html-add-definition-entry () "Add a definition entry. Assume we're at the end of a previous entry." (interactive) (let ((start (point))) (insert "\n<DT> ") (save-excursion (insert "\n<DD> "))))

(defun html-add-plaintext () "Add plaintext." (interactive) (let ((start (point))) (insert "<XMP>\n") (html-maybe-deemphasize-region start (1- (point))) (save-excursion (insert "\n") (setq start (point)) (insert "</XMP>\n") (html-maybe-deemphasize-region start (1- (point))) ;; This doesn't work. (push-mark))))

(defun html-add-list-internal (type) (let ((start (point))) (insert "<" type ">\n") (html-maybe-deemphasize-region start (1- (point))) (insert "<LI> ") ;; Point goes right there. (save-excursion (insert "\n") (setq start (point)) (insert "</" type ">\n") (html-maybe-deemphasize-region start (1- (point))) ;; Mark goes after list -- this doesn't work. (push-mark))))

(defun html-add-list () "Add a list." (interactive) (html-add-list-internal "UL"))

;; Is this correct? Viola doesn't seem to do anything with it. (defun html-add-menu () "Add a menu." (interactive) (html-add-list-internal "MENU"))

(defun html-add-list-or-menu-item () "Add a list or menu item. Assume we're at the end of the last item." (interactive) (let ((start (point))) (insert "\n<LI> ")))

(defun html-add-address () "Add an address." (interactive) (let ((start (point))) (insert "<ADDRESS> ") (html-maybe-deemphasize-region start (1- (point))) (save-excursion (setq start (point)) (insert " </ADDRESS>\n") (html-maybe-deemphasize-region (+ start 2) (1- (point))) ;; Obviously this doesn't work here, so I don't ;; see why you're being an idiot and still doing it ;; like this.... (push-mark))))

(defun html-less-than () (interactive) (insert "&lt;"))

(defun html-greater-than () (interactive) (insert "&gt;"))

(defun html-ampersand () (interactive) (insert "&amp;"))

(defun html-real-less-than () (interactive) (insert "<"))

(defun html-real-greater-than () (interactive) (insert ">"))

(defun html-real-ampersand () (interactive) (insert "&"))

;;; ----------------------- html-reorder-numeric-names -----------------------

(defun replace-string-in-buffer (start end newstring) (save-excursion (goto-char start) (delete-char (1+ (- end start))) (insert newstring)))

(defun html-reorder-numeric-names (&optional reorder-non-numeric) "Reorder the NAME fields for links in the current buffer. The new ordering starts at 1 and increases monotonically through the buffer. If optional arg REORDER-NON-NUMERIC is non-nil, then non-numeric NAME's will also be numbered, else they won't.

Beware that doing this will possibly mess up references to specific links within this document (e.g., HREF=#12) or by other documents. This command is mainly intended for use during the initial creation stage of a document, especially when this creation involves cutting and pasting from other documents (which it shouldn't, since this is hypertext :-)." (interactive) (save-excursion (goto-char (point-min)) (setq html-link-counter 0) (while (re-search-forward "<A[ \t\n]+NAME=" (point-max) t) (let* ((start (match-end 0)) (end (save-excursion (re-search-forward "[ \t\n>]" (point-max) t) (match-beginning 0))) (subst (buffer-substring start end))) (and subst ;; Proceed only if we reorder non-numeric links or ;; this is in fact numeric (i.e. > 0). (or reorder-non-numeric (> (string-to-int subst) 0)) (progn (setq html-link-counter (1+ html-link-counter)) (replace-string-in-buffer start (1- end) (format "%d" html-link-counter))))))))

;;; ------------------------------- html-mode --------------------------------

(defun html-mode () "Major mode for editing HTML hypertext documents. Special commands:\\{html-mode-map} Turning on html-mode calls the value of the variable html-mode-hook, if that value is non-nil.

More extensive documentation is available in the file 'html-mode.el'. The latest (possibly unstable) version of this file will always be available on anonymous FTP server ftp.ncsa.uiuc.edu in /outgoing/marca." (interactive) (kill-all-local-variables) (use-local-map html-mode-map) (setq mode-name "Html") (setq major-mode 'html-mode) (setq local-abbrev-table html-mode-abbrev-table) (set-syntax-table html-mode-syntax-table) (run-hooks 'html-mode-hook))

;;; ------------------------------- our hooks --------------------------------

(defun html-find-file-hook () "Hook called from find-file-hooks. Set html-link-counter to the highest link value in the document (the next link created will be one greater than that) to insure unique (numeric) link ID's." (save-excursion (goto-char (point-min)) (while (re-search-forward "<A[ \t\n]+NAME=" (point-max) t) (let* ((start (match-end 0)) (end (save-excursion (re-search-forward "[ \t\n>]" (point-max) t) (match-beginning 0))) (subst (buffer-substring start end))) (and subst ;; Safe to do compare, since string-to-int passed a non-number ;; returns 0. (> (string-to-int subst) html-link-counter) (setq html-link-counter (string-to-int subst)))))))

;;; ------------------------------- hook setup -------------------------------

;; Author: Daniel LaLiberte (liberte@cs.uiuc.edu). (defun html-postpend-unique-hook (hook-var hook-function) "Postpend HOOK-VAR with HOOK-FUNCTION, if it is not already an element. hook-var's value may be a single function or a list of functions." (if (boundp hook-var) (let ((value (symbol-value hook-var))) (if (and (listp value) (not (eq (car value) 'lambda))) (and (not (memq hook-function value)) (set hook-var (append value (list hook-function)))) (and (not (eq hook-function value)) (set hook-var (append value (list hook-function)))))) (set hook-var (list hook-function))))

(html-postpend-unique-hook 'find-file-hooks 'html-find-file-hook)

;;; ------------------------------ final setup -------------------------------

(or (assoc "\\.html$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.html$" . html-mode) auto-mode-alist)))