html-mode.el v1.25, and wysiwyg html-mode
marca@ncsa.uiuc.edu (Marc Andreessen)
Date: Sat, 5 Dec 92 23:37:25 -0800
From: marca@ncsa.uiuc.edu (Marc Andreessen)
Message-id: <9212060737.AA03767@wintermute.ncsa.uiuc.edu>
To: www-talk@nxoc01.cern.ch
Subject: html-mode.el v1.25, and wysiwyg html-mode
Since Midaswww now handles quotes around HREF fields, here is a
revised html-mode.el that does the right thing wrt quotes.
As a side note, I am starting work on a WYSIWYG html-mode that will
use Epoch's zone mechanism (or equivalently Lucid Emacs's extents) to
both remove the need to show html syntax as well as to provide
formatted screen display. If you have user interface ideas or any
other ideas, please let me know...
Marc
;;; --------------------------------------------------------------------------
;;; 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.25 $
;;; $Date: 1992/12/06 07:31:30 $
;;;
;;; Canonical list of features:
;;; See below.
;;;
;;; ------------------------------ INSTRUCTIONS ------------------------------
;;;
;;; Put the following code in your .emacs file:
;;;
;;; (autoload 'html-mode "html-mode" "HTML major mode." t)
;;; (or (assoc "\\.html$" auto-mode-alist)
;;; (setq auto-mode-alist (cons '("\\.html$" . html-mode)
;;; auto-mode-alist)))
;;;
;;; Emacs will detect the ``.html'' suffix and activate html-mode
;;; 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 <, >, 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.
;;;
;;; 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 variable 'html-use-highlighting'.
;;;
;;; 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.
;;;
;;; In most current HTML documents, HREF arguments are not quoted.
;;; They really should be, so HTML can be fully SGML-compliant. Since
;;; most browsers now understand quoted HREF's, html-mode will
;;; automatically quote all new HREF's, as well as automatically
;;; convert existing HREF's to quotified format.
;;;
;;; html-quote-hrefs (variable, default t)
;;; If this is non-nil, new HREF arguments will be quoted.
;;;
;;; html-quotify-hrefs-on-find (variable, default t)
;;; If this is non-nil, all HREF arguments will be quotified
;;; automatically when a HTML document is loaded into Emacs
;;; (actually when html-mode is entered).
;;;
;;; html-quotify-hrefs
;;; This command will quotify all HREF arguments in the current
;;; document.
;;;
;;; -------------------------------- 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.
;;;
;;; ---------------------------- ACKNOWLEDGEMENTS ----------------------------
;;;
;;; Some code herein provided by:
;;; Dan Connolly <connolly@pixel.convex.com>
;;;
;;; --------------------------------------------------------------------------
;;; LCD Archive Entry:
;;; html-mode|Marc Andreessen|marca@ncsa.uiuc.edu|
;;; Major mode for editing HTML hypertext files.|
;;; $Date: 1992/12/06 07:31:30 $|$Revision: 1.25 $|~/modes/html-mode.el.Z|
;;; --------------------------------------------------------------------------
(provide 'html-mode)
;;; ------------------------------- variables --------------------------------
(defvar html-quote-hrefs t
"*New HREF fields will be quoted if this is non-nil; else they won't be.")
(defvar html-quotify-hrefs-on-find t
"*If non-nil, all HREF's in a file will be automatically quotified when
the file is loaded. This is useful for converting old HTML documents
to the new SGML-compatible syntax, which mandates quoted HREF's.")
(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))
(if html-quote-hrefs
(insert "<A NAME=" (format "%d" html-link-counter)
" HREF=\"" link-object "\">")
(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))
(if html-quote-hrefs
(insert "<A NAME=" (format "%d" html-link-counter)
" HREF=\"" link "\">")
(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 "<"))
(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-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-quotify-hrefs ---------------------------
(defun html-quotify-hrefs ()
"Insert quotes around all HREF attribute value literals.
This remedies the problem with old HTML files that can't be processed
by SGML parsers. That is, changes <A HREF=foo> to <A HREF=\"foo\">."
(interactive)
(save-excursion
(goto-char (point-min))
(while
(re-search-forward
"<[aA][ \t\n]+\\([nN][aA][mM][eE]=[a-zA-Z0-9]+[ \t\n]+\\)?[hH][rR][eE][fF]="
(point-max)
t)
(cond
((null (looking-at "\""))
(insert "\"")
(re-search-forward "[ \t\n>]" (point-max) t)
(forward-char -1)
(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.
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-html-mode-hook ()
"Hook called from html-mode-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.
Also run htlm-quotify-hrefs if html-quotify-hrefs-on-find is non-nil."
(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))))))
;; Quotify existing HREF's if html-quotify-hrefs-on-find is non-nil.
(and html-quotify-hrefs-on-find (html-quotify-hrefs)))
;;; ------------------------------- 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 'html-mode-hook 'html-html-mode-hook)
;;; ------------------------------ final setup -------------------------------
(or (assoc "\\.html$" auto-mode-alist)
(setq auto-mode-alist (cons '("\\.html$" . html-mode) auto-mode-alist)))