html-mode.el
Marc Andreessen (marca@ncsa.uiuc.edu)
Tue, 17 Nov 92 19:24:59 -0800
Date: Tue, 17 Nov 92 19:24:59 -0800
From: marca@ncsa.uiuc.edu (Marc Andreessen)
Message-Id: <9211180324.AA05780@wintermute.ncsa.uiuc.edu>
To: www-talk@nxoc01.cern.ch
Subject: html-mode.el
OK, here's a first pass at an html-mode for Emacs. Comments, bug
reports, and enhancements are welcome; the latest version will always
be on ftp.ncsa.uiuc.edu in /outgoing/marca as html-mode.el.
(Somebody already sent me an smgl-mode.el, so I expect I'll add
features from that pretty quickly.)
Enjoy,
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.11 $
;;; $Date: 1992/11/18 03:20:43 $
;;;
;;; 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 (in order of
;;; their key sequences):
;;;
;;; 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).
;;;
;;; < > &
;;; These are overridden to output <, >, and &
;;; 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.
;;;
;;; ---------------------------- 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.
;;;
;;; -------------------------------- 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.
;;;
;;; ------------------------- 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/18 03:20:43 $|$Revision: 1.11 $|~/modes/html-mode.el.Z|
;;; --------------------------------------------------------------------------
(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)
)
;;; --------------------------- 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))
;;; --------------------------- 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 "<"))
(defun html-greater-than ()
(interactive)
(insert ">"))
(defun html-ampersand ()
(interactive)
(insert "&"))
(defun html-real-less-than ()
(interactive)
(insert "<"))
(defun html-real-greater-than ()
(interactive)
(insert ">"))
(defun html-real-ampersand ()
(interactive)
(insert "&"))
;;; ------------------------------- 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."
(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 NAME=" (point-max) t)
(let ((subst (buffer-substring (match-end 0)
(save-excursion
(re-search-forward " " (point-max) t)
(match-beginning 0)))))
(and subst
(> (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))))
(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)))