;;; --------------------------------------------------------------------------
;;; HTML mode, based on text mode.
;;; Copyright (C) 1985 Free Software Foundation, Inc.
;;; Copyright (C) 1992, 1993 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: 2.1 (beta)
;;;
;;; Changes from 2.0 (beta):
;;;   - Ripped out numeric anchor name stuff altogether (all names should be
;;;     meaningful, not just numbers).
;;;   - Fixed problem with unquoted names.
;;;   - Fixed font-lock support (yeah! thanks lamour@engin.umich.edu).
;;;
;;; ------------------------------ 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)))
;;; (or (assoc "\\.shtml$" auto-mode-alist)
;;;   (setq auto-mode-alist (cons '("\\.shtml$" . html-mode) 
;;;                               auto-mode-alist)))
;;;
;;; Emacs will detect the ``.html'' and ``.shtml'' 
;;; suffixes and activate html-mode appropriately.
;;;
;;; However, it might be better to try the following instead of the two
;;; "or" expressions above:
;;;
;;; (or (assoc "\\.s?html?$" auto-mode-alist)
;;;   (setq auto-mode-alist (cons '("\\.s?html?$" . html-mode)
;;;                               auto-mode-alist)))
;;;
;;; (This detects .shtml, .html, and .htm file extensions)
;;; 
;;; You are assumed to be at least somewhat familiar with the 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 b         html-add-blockquote
;;;
;;; C-c C-b       html-add-bold
;;;   Open a bold element.
;;;
;;; C-c c         html-add-code
;;;   Open a 'code' (fixed-font) element.
;;;   Changed to C-c w c by RMF
;;;
;;; C-c C-c       html-add-citation
;;;
;;; C-c d         html-add-description-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-description-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 C-e       html-add-emphasized
;;;   Open an emphasized element.
;;;
;;; C-c f         html-add-font
;;;   Open an area for a different font size or color.  Added by RMF.
;;;   
;;; C-c C-f       html-add-fixed
;;;   CHANGED to C-c w t (TTY) by RMF.
;;;
;;; C-c C-f f     html-add-form
;;;   Add a FORM area
;;;
;;; C-c C-f a     html-add-form-textarea
;;;   Add an INPUT TYPE=TEXTAREA
;;;
;;; C-c C-f b     html-add-form-button
;;;   Add an INPUT TYPE=BUTTON
;;;   
;;; C-c C-f c     html-add-form-checkbox
;;;   Add an INPUT TYPE=CHECKBOX
;;;
;;; C-c C-f e     html-add-form-reset
;;;   Add an INPUT TYPE=RESET (reset button)
;;;
;;; C-c C-f h     html-add-form-hidden
;;;   Add an INPUT TYPE=HIDDEN
;;;
;;; C-c C-f o     html-add-form-option
;;;   Add an OPTION (to a SELECT area)
;;;
;;; C-c C-f p     html-add-form-password
;;;   Add an INPUT TYPE=PASSWORD
;;;
;;; C-c C-f r     html-add-form-radio
;;;   Add an INPUT TYPE=RADIO (radio button)
;;;
;;; C-c C-f s     html-add-form-select
;;;   Add a SELECT area (values supplied by OPTION specifications)
;;;
;;; C-c C-f t     html-add-form-text
;;;   Add an INPUT TYPE=TEXT
;;;
;;; C-c C-f x     html-add-form-submit
;;;   Add an INPUT TYPE=SUBMIT (submit button)
;;;
;;; C-c g         html-add-img
;;;   Add an IMG element (inlined image or graphic).    You will be
;;;   prompted for the file name of the image you wish to inline into the
;;;   document.  Be sure to edit this into a URL!!!
;;;
;;;   You will also be asked for alternative text to appear for text-
;;;   only browsers or users who have turned off image loading.  Added
;;;   by RMF.
;;;
;;; C-c h         html-add-header
;;;   Add a header.  You are prompted for size (1 is biggest, 2 is
;;;   next biggest; bottom limit is 6) and header contents.
;;;
;;; C-c C-h       html-add-horiz-rule
;;;   Add a horizontal rule.  Added by RMF.
;;;
;;; 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 C-i       html-add-italic
;;;   Open an italic element.
;;;
;;; C-c j         html-add-script
;;;   Open an area for Javascript.
;;; 
;;; C-c k         html-add-line-break
;;;   Add a line break <br>.  Added by RMF.
;;;
;;; C-c C-k       html-add-keyboard
;;;   Changed to C-c w k by RMF.
;;;
;;; 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 C-l       html-add-listing
;;;   REMOVED by RMF as deprecated.  Use C-c C-p instead.
;;;
;;; 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 C-m       html-add-sample
;;;   Changed to C-c w s by RMF.
;;;
;;; C-c n         html-add-numbered-list
;;;   Open a numbered list.  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.  (Technically, it
;;;   should be used at the _start_ of a paragraph, with </P> at the
;;;   end, allowing clauses like "align=center" inside the open-para
;;;   indicator.  But no one does.  Grist for the browser wars.  Now
;;;   that XHTML is coming, however, the use of </p> will be enforced.)
;;; 
;;; C-c C-p       html-add-preformatted
;;;   Use this in place of C-c C-l and C-c x, which are deprecated (and
;;;   don't do anything different in the output anyway).
;;;
;;; C-c r         html-add-normal-reference
;;;
;;; 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 C-s       html-add-strong
;;;
;;; 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 C-t <x>   html-add-table[type]
;;;   The value of <x> may be: t to start a table (a caption will be
;;;   requested), k to add a caption later, r to add a row, h to add a
;;;   header element, d to add a datum, c to add a column, and g to add
;;;   a column group.  The h and d commands should only be used within a
;;;   row, and the r, c, g, and k commands only within a table.
;;;   Added by RMF.
;;; 
;;; C-c C-v       html-add-variable
;;;
;;; C-c x         html-add-plaintext
;;;   Add plaintext.  The cursor will be positioned where you can type
;;;   plaintext (or insert another file, or whatever).
;;;   REMOVED as deprecated usage by RMF.  Use C-c C-p instead.
;;;
;;; C-c z         html-preview-document
;;;   Fork off a Mosaic process to preview the current document.
;;;   After you do this once, subsequent invocations of
;;;   html-preview-document will cause the same Mosaic process to be
;;;   used; this magic is accomplished through Mosaic's ability to be
;;;   remote-controlled via Unix signals.  This feature is only
;;;   available when running Lucid Emacs v19 (it will maybe work with
;;;   GNU Emacs v19; I'm not sure).
;;;
;;; 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.
;;;   
;;; C-c C-r t     html-add-tag-to-region
;;;   Add a general tag surrounding a region.  This may be simpler, if
;;;   one knows the tag desired, than deleting a region, inserting a
;;;   tag, and yanking back the region, where text already exists.  It
;;;   should only be used for tags which have a negation form (e.g.,
;;;   PRE, B, I, CITE, etc.)  Added by RMF.
;;;
;;; SPECIAL COMMANDS:
;;;
;;; <, >, &
;;;   These are overridden to output &lt;, &gt;, and &amp;
;;;   respectively.  The real characters <, >, and & can be entered
;;;   into the text either by typing 'C-c' before typing the character
;;;   or by using the Emacs quoted-insert (C-q) command.
;;;
;;; C-c <, C-c >, C-c &
;;;   See '<, >, &' above.
;;;
;;; C-c SPC
;;;   Adds a non-breaking space (&nbsp;) literal.  Useful in tables.
;;;   (If you have an empty table cell, the borders don't appear; entering
;;;   a non-breaking space will prevent this.)  With a prefix, adds
;;;   that many non-breaking spaces.
;;;   Added by RMF.
;;; 
;;; ---------------------------- 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 variables 'html-use-highlighting' and 
;;; 'html-use-font-lock'.
;;;
;;; HREF and NAME arguments in anchors should always be quoted.  In
;;; some existing HTML documents, they are not.  html-mode will
;;; automatically quotify all such unquoted arguments when it
;;; encounters them.  The following variables affect this behavior.
;;;
;;; 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).
;;;
;;; -------------------------------- GOTCHAS ---------------------------------
;;;
;;; HTML documents can be tricky.  html-mode is not smart enough to
;;; enforce correctness or sanity, so you have to do that yourself.
;;;
;;; ------------------------- WHAT HTML-MODE IS NOT --------------------------
;;;
;;; html-mode is not a mode for *browsing* HTML documents.  In
;;; particular, html-mode provides no hypertext or World Wide Web
;;; capabilities.
;;;
;;; The World Wide Web browser we (naturally) recommend is NCSA
;;; Mosaic, which can be found at ftp.ncsa.uiuc.edu in /Mosaic.
;;;
;;; See file://moose.cs.indiana.edu/pub/elisp/w3 for w3.el, which is
;;; an Elisp World Wide Web browser written by William Perry.
;;;
;;; ------------------------------ WHAT HTML IS ------------------------------
;;;
;;; HTML (HyperText Markup Language) is a format for hypertext
;;; documents, particularly in the World Wide Web system.  For more
;;; information on HTML, telnet to info.cern.ch or pick up a copy of
;;; NCSA Mosaic for the X Window System via ftp to ftp.ncsa.uiuc.edu
;;; in /Mosaic; information is available online through the software
;;; products distributed at those sites.
;;;
;;; ---------------------------- 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: sometime in 1993|Revision: 2.1 (beta)|~/modes/html-mode.el.Z|
;;; --------------------------------------------------------------------------
;;;
;;; Modifications by Dr. Roger M. Firestone (rfire@cais.net)
;;; indicated by RMF
;;; 
;;;   Improved IMG tag--solicits alternative text for text-only browsers
;;;     or those with images turned off by user
;;;   HTML comment syntax defined and handled by M-; etc.
;;;   Line break (BR) tag
;;;   Horizontal rule (HR) tag
;;;   Font tag
;;;   Table mode (TABLE, TR, TH, TD) tags
;;;   Add arbitrary tag to region
;;;   Non-breaking space entry (including multiple by prefix arg)
;;;   Removal of deprecated HTML tags
;;;   Super- and sub-script tags
;;;   SCRIPT entry
;;;   Replaced various fixed-width commands (kbd, tt, samp, and code)
;;;     with sub-commands of C-c w (i.e, w for "width") to free up
;;;     syntax
;;;   Form entry
;;;   Adaptation to XHTML
;;;   
;;; --------------------------------------------------------------------------

;;; ---------------------------- emacs variations ----------------------------

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

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

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

(defvar html-quotify-hrefs-on-find t
  "*If non-nil, all HREF's (and NAME's) in a file will be automatically 
quotified when the file is loaded.  This is useful for converting ancient 
HTML documents to SGML-compatible syntax, which mandates quoted HREF's.
This should always be T.")

(defvar html-use-highlighting html-running-epoch
  "*Flag to use highlighting for HTML directives in Epoch or Lucid Emacs; 
if non-NIL, highlighting will be used.  Default is T if you are running
Epoch; nil otherwise (for Lucid Emacs, font-lock is better; see 
html-use-font-lock instead).")

(defvar html-use-font-lock html-running-lemacs
  "*Flag to use font-lock for HTML directives in Lucid Emacs.  If non-NIL,
font-lock will be used.  Default is T if you are running with Lucid Emacs;
NIL otherwise.  This doesn't currently seem to work.  Bummer.  Ten points
to the first person who tells me why not.")

(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.")

(defvar html-document-previewer "/usr/local/bin/xmosaic"
  "*Program to be used to preview HTML documents.  Program is assumed
to accept a single argument, a filename containing a file to view; program
is also assumed to follow the Mosaic convention of handling SIGUSR1 as
a remote-control mechanism.")

(defvar html-document-previewer-args "-ngh"
  "*Arguments to be given to the program named by html-document-previewer;
NIL if none should be given.")

(defvar html-sigusr1-signal-value 16
  "*Value for the SIGUSR1 signal on your system.  See, usually,
/usr/include/sys/signal.h.")

(defvar html-new-paragraph-mode nil
  "*If NIL, the html-add-paragraph-separator command generates only a
<p> (old style).  If T, it generates a <p>, 2 line breaks, and a </p>.
I.e., if T, use it before writing a paragraph, if NIL, use it after.")

;;; --------------------------------- 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-cb" 'html-add-blockquote)
;  (define-key html-mode-map "\C-cc" 'html-add-code) ;  now use ^Cwc
  (define-key html-mode-map "\C-cd" 'html-add-description-list)
  (define-key html-mode-map "\C-ce" 'html-add-description-entry)
  (define-key html-mode-map "\C-cf" 'html-add-font) ; RMF
  (define-key html-mode-map "\C-cg" 'html-add-img)
  (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-cj" 'html-add-script) ; RMF
  (define-key html-mode-map "\C-ck" 'html-add-line-break)
  (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-cn" 'html-add-numbered-list)
  (define-key html-mode-map "\C-cp" 'html-add-paragraph-separator)
  (define-key html-mode-map "\C-cr" 'html-add-normal-reference)
  (define-key html-mode-map "\C-cs" 'html-add-list)
  (define-key html-mode-map "\C-cwc" 'html-add-code) ; RMF
  (define-key html-mode-map "\C-cwf" 'html-add-fixed) ; RMF (same as t)
  (define-key html-mode-map "\C-cwk" 'html-add-keyboard) ; RMF
  (define-key html-mode-map "\C-cws" 'html-add-sample) ; RMF
  (define-key html-mode-map "\C-cwt" 'html-add-fixed) ; RMF (fixed = TTY)
  (define-key html-mode-map "\C-ct" 'html-add-title)
;  (define-key html-mode-map "\C-cx" 'html-add-plaintext) ; deprecated
  ;; html-preview-document currently requires the primitive
  ;; signal-process, which is only in v19 (is it in gnu 19? dunno).
  (and html-running-lemacs
       (define-key html-mode-map "\C-cz" 'html-preview-document))
  (define-key html-mode-map "\C-c+" 'html-add-superscript) ; RMF
  (define-key html-mode-map "\C-c-" 'html-add-subscript) ; RMF
  (define-key html-mode-map "\C-c\C-b" 'html-add-bold)
  (define-key html-mode-map "\C-c\C-c" 'html-add-citation)
  (define-key html-mode-map "\C-c\C-e" 'html-add-emphasized)
;  (define-key html-mode-map "\C-c\C-f" 'html-add-fixed) ; now use ^Cwt
  (define-key html-mode-map "\C-c\C-ff" 'html-add-form)	; RMF
  (define-key html-mode-map "\C-c\C-fa" 'html-add-form-textarea) ; RMF
  (define-key html-mode-map "\C-c\C-fb" 'html-add-form-button) ; RMF
  (define-key html-mode-map "\C-c\C-fc" 'html-add-form-checkbox) ; RMF
  (define-key html-mode-map "\C-c\C-fe" 'html-add-form-reset) ; RMF
  (define-key html-mode-map "\C-c\C-fh" 'html-add-form-hidden) ; RMF
  (define-key html-mode-map "\C-c\C-fo" 'html-add-form-option) ; RMF
  (define-key html-mode-map "\C-c\C-fp" 'html-add-form-password) ; RMF
  (define-key html-mode-map "\C-c\C-fr" 'html-add-form-radio) ; RMF
  (define-key html-mode-map "\C-c\C-fs" 'html-add-form-select) ; RMF
  (define-key html-mode-map "\C-c\C-ft" 'html-add-form-text) ; RMF
  (define-key html-mode-map "\C-c\C-fx" 'html-add-form-submit) ; RMF
  (define-key html-mode-map "\C-c\C-h" 'html-add-horiz-rule) ; RMF
  (define-key html-mode-map "\C-c\C-i" 'html-add-italic)
;  (define-key html-mode-map "\C-c\C-k" 'html-add-keyboard) ; now use ^Cwk
;  (define-key html-mode-map "\C-c\C-l" 'html-add-listing) ; deprecated
;  (define-key html-mode-map "\C-c\C-m" 'html-add-sample) ; now use ^Cws
  (define-key html-mode-map "\C-c\C-p" 'html-add-preformatted)
  (define-key html-mode-map "\C-c\C-s" 'html-add-strong)
  (define-key html-mode-map "\C-c\C-v" 'html-add-variable)
  (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 " 'html-nbsp) ; RMF
  (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)
  (define-key html-mode-map "\C-c\C-rt" 'html-add-tag-to-region) ; RMF
  (define-key html-mode-map "\C-c\C-tt" 'html-add-table) ; RMF
  (define-key html-mode-map "\C-c\C-tk" 'html-add-table-caption) ; RMF
  (define-key html-mode-map "\C-c\C-tc" 'html-add-table-column) ; RMF
  (define-key html-mode-map "\C-c\C-tg" 'html-add-table-colgroup) ; RMF
  (define-key html-mode-map "\C-c\C-tr" 'html-add-table-row) ; RMF
  (define-key html-mode-map "\C-c\C-th" 'html-add-table-header)	; RMF
  (define-key html-mode-map "\C-c\C-td" 'html-add-table-datum) ; RMF
)

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

(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)))

;;; --------------------------------------------------------------------------
;;; ------------------------ command support routines ------------------------
;;; --------------------------------------------------------------------------

(defun html-add-link (link-object)
  "Add a link.  Single argument LINK-OBJECT is value of HREF in the
new anchor.  Mark is set after anchor."
  (let ((start (point)))
    (insert "<a")
    (insert " 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-reference (ref-object)
  "Add a reference.  Single argument REF-OBJECT is value of NAME in the
new anchor.  Mark is set after anchor."
  (let ((start (point)))
    (insert "<a")
    (insert " name=\"" ref-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-list-internal (type)
  "Set up a given type of list by opening the list start/end pair
and creating an initial element.  Single argument TYPE is a string,
assumed to be a valid HTML list type (e.g. \"ul\" or \"ol\").
Mark is set after list."
  (let ((start (point)))
    (insert "<" type ">\n")
    (html-maybe-deemphasize-region start (1- (point)))
    (insert "<li> </li>")		; for XHTML, need closing tag
    ;; Point goes between them.
    (save-excursion
      (insert "\n")
      (setq start (point))
      (insert "</" type ">\n")
      (html-maybe-deemphasize-region start (1- (point)))
      ;; Reuse start to set mark.
      (setq start (point)))
    (push-mark start t)
    (backward-char 5)))

(defun html-open-area (tag)
  "Open an area for entering text such as PRE, XMP, or LISTING."
  (let ((start (point)))
    (insert "<" tag ">\n")
    (html-maybe-deemphasize-region start (1- (point)))
    (save-excursion
      (insert "\n")
      (setq start (point))
      (insert "</" tag ">\n")
      (html-maybe-deemphasize-region start (1- (point)))
      ;; Reuse start to set mark.
      (setq start (point)))
    (push-mark start t)))

(defun html-open-field (tag)
  "Open an area for entering characters, such as B, I, or STRONG."
  (let ((start (point)))
    (insert "<" tag ">")
    (html-maybe-deemphasize-region start (1- (point)))
    (setq start (point))
    (insert "</" tag ">")
    (html-maybe-deemphasize-region (1+ start) (point))
    (push-mark)
    (goto-char start)))

;;; --------------------------------------------------------------------------
;;; -------------------------------- commands --------------------------------
;;; --------------------------------------------------------------------------

;; C-c a
(defun html-add-address ()
  "Add an address."
  (interactive)
  (html-open-field "address"))

;; C-c b
(defun html-add-blockquote ()
  (interactive)
  (html-open-area "blockquote"))

;; C-c C-b
(defun html-add-bold ()
  (interactive)
  (html-open-field "b"))

;; C-c c -> C-c w c (RMF)
(defun html-add-code ()
  (interactive)
  (html-open-field "code"))

;; C-c C-c
(defun html-add-citation ()
  (interactive)
  (html-open-field "cite"))

;; C-c d
(defun html-add-description-list ()
  "Add a definition list of pairs of terms and descriptions.
Additional pairs are added by html-add-description-entry."
  (interactive)
  (let ((start (point)))
    (insert "<dl>\n")
    (html-maybe-deemphasize-region start (1- (point)))
    (insert "<dt> </dt>")		; XHTML requires closing tag
    ;; Point goes between them.
    (save-excursion
      (insert "\n<dd> </dd>\n")		; XHTML requires closing tag
      (setq start (- (point) 5))
      (insert "</dl>\n")
      (html-maybe-deemphasize-region start (1- (point)))
      ;; Reuse start to set mark.
      (setq start (point)))
    (push-mark start t)
    (backward-char 5)))

;; C-c e
(defun html-add-description-entry ()
  "Add a definition entry.  Assume we're at the end of a previous
entry."
  (interactive)
  (let ((start (point)))
    (insert "\n<dt> </dt>")		; XHTML requires closing tag
    (save-excursion
      (insert "\n<dd> </dd>"))		; XHTML requires closing tag
    (backward-char 5)))

;; C-c C-e
(defun html-add-emphasized ()
  (interactive)
  (html-open-field "em"))

;; C-c f
;; Added by RMF
(defun html-add-font (s c f)
  "Add a font field.  Ask for size, color and face."
  (interactive "*sSize: \nsColor: \nsFace: ")
  (html-open-field "font")
  (if (and (zerop (length s))
	   (zerop (length c))
	   (zerop (length f)))
      nil				; nothing specified
    (forward-char -1)
    (if (not (zerop (length s)))
	(insert " size=" ?\" s ?\"))
    (if (not (zerop (length c)))
	(insert " color=" ?\" c ?\"))
    (if (not (zerop (length f)))
	(insert " face=" ?\" f ?\"))
    (forward-char 1)))

;; C-c C-f -> C-c w t or C-c w f (RMF)
(defun html-add-fixed ()
  (interactive)
  (html-open-field "tt"))

;; C-c g
;; Alt text stuff added by RMF and string input changed to
;; allow file completion
(defun html-add-img (href alt)
  "Add an img."
  (interactive "FImage URL: \nsAlt text: ")
  ;; Above "F" was s; using F allows completion for local image files (RMF)
  (let ((start (point)))
    (if (string-equal alt "") (setq alt "[IMAGE]"))
    (insert "<img src=\"" href "\" alt=\"" alt "\" />") ; XHTML closing /
    (html-maybe-deemphasize-region (1+ start) (1- (point)))))

;; C-c h
(defun html-add-header (size header)
  "Add a header."
  (interactive "sSize (1-6; 1 biggest): \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)))))

;; C-c C-h
;; Added by RMF
(defun html-add-horiz-rule ()
  "Add a horizontal rule."
  (interactive)
  (insert "<hr />"))			; XHTML closing /

;; C-c i
(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> </li>")		; XHTML requires closing tag
    (backward-char 5)))

;; C-c C-i
(defun html-add-italic ()
  (interactive)
  (html-open-field "i"))

;; C-c j
;; Added by RMF
(defun html-add-script (p l)
  "Add a script (JavaScript by default) element.  
With a prefix argument, indicate a script file, rather than an inline script."
  (interactive "*P\nsLanguage: ")
  (let ((insert-default-directory t) f)
    (if p (setq f (read-string "Script file: " )))
    (insert "<script language=\""
	    (if (not (zerop (length l))) l "JavaScript"))
    (if p
	(progn
	  (insert "\" src=\"")
	  (insert f)
	  (insert "\">\n</script>\n"))
      (insert "\">\n<!--\n\n// -->\n</script>\n")
      (previous-line 3))))

;; C-c k
;; Added by RMF
(defun html-add-line-break (n)
  "Add a line break.  With a prefix arg n, add n line breaks."
  (interactive "p")
  (while (> n 0)
    (setq n (- n 1))
    (insert "<br />")))			; XHTML closing /

;; C-c C-k -> C-c w k (RMF)
(defun html-add-keyboard ()
  (interactive)
  (html-open-field "kbd"))

;; C-c l
(defun html-add-normal-link (link)
  "Make a link"
  (interactive "sLink to: ")
  (html-add-link link))

;; C-c C-l
;;; Remved by RMF as deprecated usage.  Use C-c C-p instead.
;;; (defun html-add-listing ()
;;;   (interactive)
;;;   (html-open-area "LISTING"))

;; C-c m
(defun html-add-menu ()
  "Add a menu."
  (interactive)
  (html-add-list-internal "menu"))

;; C-c C-m -> C-c w s (RMF)
(defun html-add-sample ()
  (interactive)
  (html-open-field "samp"))

;; C-c n
(defun html-add-numbered-list ()
  "Add a numbered list."
  (interactive)
  (html-add-list-internal "ol"))

;; C-c p
(defun html-add-paragraph-separator ()
  "Add a paragraph separator."
  (interactive)
  (if html-new-paragraph-mode
      (html-open-area "p")
    (let ((start (point)))
      (insert "  <p>")
      (html-maybe-deemphasize-region (+ start 1) (point)))))

;; C-c C-p
(defun html-add-preformatted ()
  (interactive)
  (html-open-area "pre"))

;; C-c r
(defun html-add-normal-reference (reference)
  "Add a reference (named anchor)."
  (interactive "sReference name: ")
  (html-add-reference reference))

;; C-c s
(defun html-add-list ()
  "Add a list."
  (interactive)
  (html-add-list-internal "ul"))

;; C-c C-s
(defun html-add-strong ()
  (interactive)
  (html-open-field "strong"))

;; C-c t
(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)
;       (if (looking-at "<html>") (forward-char 6)) ; RMF
;       (if (looking-at "$") (forward-char 1)) ; RMF
;       (if (looking-at "<head>") (forward-char 6)) ; RMF
;       (if (looking-at "$") (forward-char 1)) ; RMF
;       (insert "<title>")
;       (html-maybe-deemphasize-region (point-min) (1- (point)))
;       (insert title)
;       (insert "</title>")
;       (html-maybe-deemphasize-region (- (point) 7) (point))
;       (insert "\n"))
    (if (search-forward "<title>" (point-max) t)
	(let ((b (point)))		; there is a title already
	  (search-forward "</title>" (point-max) t)
	  (delete-region b (- (point) 8))
	  (goto-char b)
	  (insert title))
      (search-forward "<head>")
      (insert "\n<title>" title  "</title>\n"))
))

;; C-c C-v
(defun html-add-variable ()
  (interactive)
  (html-open-field "var"))

;; C-c w (fixed width commands)
;; RMF
;;   C-c w c  html-add-code
;;   C-c w k  html-add-keyboard
;;   C-c w s  html-add-sample
;;   C-c w t  html-add-fixed (C-c w f also works)

;; C-c x
;;;  Commented out--deprecated usage
;;; (defun html-add-plaintext ()
;;;   "Add plaintext."
;;;   (interactive)
;;;   (html-open-area "XMP"))

;; C-c +
;; RMF
(defun html-add-superscript ()
  "Add a superscript."
  (interactive)
  (html-open-field "sup"))

;; C-c -
;; RMF
(defun html-add-subscript ()
  "Add a subscript."
  (interactive)
  (html-open-field "sub"))

;;; --------------------------------------------------------------------------
;;; ------------------------------ RMF commands ------------------------------
;;; --------------------------------------------------------------------------

;;; The following three functions really shouldn't have been defined to
;;; be interactive.  They should only be called from html-init.

(defun html-add-html ()
  "Add <html> and </html> bracketing"
;  (interactive)
  (html-open-area "html")
  (save-excursion
    (backward-char 2)			; add XHTML name space info
    (insert " xmlns=\"http://www.we.org/1999/xhtml\" xml:lang=\"en\" "
	    "lang=\"en\"")))

(defun html-add-head ()
  "Add <head> and </head> bracketing"
;  (interactive)
  (html-open-area "head"))

(defun html-add-body ()
  "Add <body> and </body> bracketing"
;  (interactive)
  (html-open-area "body"))

(defun html-init (title)
  "Initialize an HTML document with <html>, <head>, <body> and <title> tags
and an <h1> tag identical to the title"
  (interactive "sTitle: ")
  (html-add-html)
  (save-excursion			; set html-new-paragraph-mode on
    (insert "\n" comment-start "\n"	; whenever editing this file
	    "Local Variables:\n"	; for XHTML requirement
	    "mode:html\n"
	    "eval:(make-local-variable 'html-new-paragraph-mode)\n"
	    "html-new-paragraph-mode:t\n"
	    "End:\n"
	    comment-end "\n"))
  (setq html-new-paragraph-mode t)	; XHTML requires this to be on
  (html-add-head)
  (insert comment-start " Created by emacs html-mode on ")
;  (shell-command "date" 1)
;  (end-of-line)
;  (delete-char 1)			; delete the CR inserted by shell
  (insert (current-time-string))	; much faster than shell-command
  (if (fboundp 'current-time-zone)	; in case of old emacs level
      (progn
	(backward-word 1)
	(insert (car (cdr (current-time-zone))) " ")
	(forward-word 1)))
  (insert comment-end)
  (insert "\n" comment-start		; let the user know something is new
	  "XHTML transition mode in use:  "
	  "html-new-paragraph-mode will be ON."
	  comment-end "\n")
  (forward-line 2)
  (html-add-title title)
  (html-add-body)
  (insert "\n<h1>" title "</h1>\n")
  (save-excursion			; leave user after level 1 hdg
    (beginning-of-buffer)
    (insert "<!DOCTYPE html PUBLIC \"-//organization//DTD XHTML"
	    " 1.0 Transitional//EN\" "
	    "\"DTD/xhtml1-transitional.dtd\">\n"))
  )

(defun html-add-base (base)
  "Enter a base document for abbreviated references.  This is usually
the directory/folder containing the present HTML document."
  (interactive "sBase: ")
  (save-excursion
    (beginning-of-buffer)
    (search-forward "<head>")
    (insert "\n<base href=\"" base "\" />\n")))

(defun html-add-maker (maker)
  "Enter the HTML document creator (as an email address)"
  (interactive "sEmail address of creator: ")
  (save-excursion
    (beginning-of-buffer)
    (search-forward "<head>")
    (insert "\n<link rev=made href=\"" maker "\" />\n")))

(defun html-add-meta (name)
  "Insert a meta tag; name is \"description\" or \"keywords\""
  (interactive
   (let ((completion-ignore-case t))
     (list (completing-read
	    "Name (description or keywords): "
	    '(("description" 1) ("keywords" 2))
	    nil t))))
  (let (p)
    (save-excursion
      (beginning-of-buffer)
      (search-forward "</head>")
      (backward-char 7)
      (insert "\n<meta name=\"" name "\" content=\"\" />\n\n")
      (backward-char 6)
      (setq p (point)))
    (goto-char p)))

;;; --------------------------------------------------------------------------
;;; ---------------------------- table commands ------------------------------
;;; --------------------------------------------------------------------------
;;; ----------------------------- added by RMF -------------------------------

(defun html-add-table (caption)		; C-c C-t t
  "Begin a table and enter caption if any"
  (interactive "sCaption: ")
  (html-open-area "table")
  (if (not (string-equal caption ""))
      (insert "<caption>" caption "</caption>\n")))

(defun html-add-table-caption (caption)	; C-c C-t k
  "Make a caption for an already-existing table"
  (interactive "sCaption: ")
  (if (not (string-equal caption ""))
      (insert "<caption>" caption "</caption>\n")))

(defun html-add-table-column (a s)	; C-c C-t c
  "Insert a col specification to override a colgroup specification"
  (interactive "sAlign: \nsSpan: ")
  (insert "<col ")
  (if (not (string-equal a "")) (insert "align=\"" a "\" "))
  (if (not (string-equal s "")) (insert "span=\"" s "\" "))
  (insert " />"))			; XHTML closing /

(defun html-add-table-colgroup (a s)	; C-c C-t g
  "Insert a colgroup specification"
  (interactive "sAlign: \nsSpan: ")
  (insert "<colgroup ")
  (if (not (string-equal a "")) (insert "align=\"" a "\" "))
  (if (not (string-equal s "")) (insert "span=\"" s "\" "))
  (insert ">"))

(defun html-add-table-row (p)		; C-c C-t r
  "Add row to a table.   With a prefix arg, asks the alignments."
  (interactive "*P")
  (html-open-area "tr")
  (if p				; there was a prefix argument
      (save-excursion
	(let (s)
	  (setq s (completing-read "valign="
				   '(("top" 1)
				     ("middle" 2)
				     ("bottom" 3))))
	  (if (not (zerop (length s)))
	      (progn (backward-char 2)
		     (insert " valign=\"" s "\"")
		     (forward-char 2)))
	  (setq s (completing-read "halign="
				   '(("left" 1)
				     ("center" 2)
				     ("right" 3))))
	  (if (not (zerop (length s)))
              (progn (backward-char 2)
		     (insert " halign=\"" s "\"")
		     (forward-char 2)))
	  ))
    ))

(defun html-add-table-header ()		; C-c C-t h
  "Add a header cell to a table"
  (interactive)
  (html-open-field "th"))

(defun html-add-table-datum (p)		; C-c C-t d
  "Add a datum to a table.  With a prefix arg, solicits the width."
  (interactive "*P")
  (html-open-field "td")
  (if p					; there was a prefix arg
      (save-excursion
	(let (s)
	  (setq s (read-from-minibuffer "width="))
	  (if (not (zerop (length s)))
	      (progn (backward-char 1)
		     (insert " width=\"" s "\""))
	    )))))

;;; --------------------------------------------------------------------------
;;; ----------------------------- form commands ------------------------------
;;; --------------------------------------------------------------------------
;;; ----------------------------- added by RMF -------------------------------

;; C-c C-f f
(defun html-add-form (method action)
  "Insert a FORM tag.  Method is GET or POST or void.  Action is optional."
  (interactive
   (let ((completion-ignore-case t))
     (list (completing-read
	    "Method (get or post): "
	    '(("get" 1) ("post" 2))
	    nil t)
	   (read-string "Action: "))))
  (html-open-area "form")
  (save-excursion
    (forward-char -2)
    (or (zerop (length method))
	(insert " method=\"" method ?\"))
    (or (zerop (length action))
	(insert " action=\"" action ?\"))))

;; C-c C-f a
(defun html-add-form-textarea (name cols rows)
  "Insert a text area of the given name and size."
  (interactive "*sName: \nnColumns: \nnRows: ")
  (if (zerop (length name))
      (error "%s" "A name is required"))
  (html-open-area "textarea")
  (save-excursion
    (forward-char -2)
    (insert " name=\"" name "\" cols=\"" (number-to-string cols) ?\"
	    " rows=\"" (number-to-string rows) ?\")))

;; C-c C-f b
(defun html-add-form-button (name value)
  "Insert a form button (needs some JavaScript onClick to be useful...)"
  (interactive "*sName: \nsValue (button label): ")
  (insert "<input type=\"button\" "
	  "name=\"" name "\" value=\"" value "\" />")) ; XHTML closing /

;; C-c C-f c
(defun html-add-form-checkbox (name value)
  "Insert an INPUT TYPE=CHECKBOX. Name and value are both required."
  (interactive "*sName: \nsValue: ")
  (if (zerop (length name))
      (error "%s" "A name is required"))
  (if (zerop (length value))
      (error "%s" "A value is required"))
  (insert "<input type=\"checkbox\" "
	  "name=\"" name "\" value=\"" value "\" />")) ; XHTML closing /

;; C-c C-f e
(defun html-add-form-reset ()
  "Insert a RESET button."
  (interactive)
  (insert "<input type=\"reset\" />"))

;; C-c C-f h
(defun html-add-form-hidden (name value)
  "Insert an INPUT TYPE=HIDDEN."
  (interactive "*sName: \nsValue: ")
  (if (zerop (length name))
      (error "%s" "A name is required"))
  (if (zerop (length value))
      (error "%s" "A value is required"))
  (insert "<input type=\"hidden\" "
	  "name=\"" name "\" value=\"" value "\" />"))

;; C-c C-f o
(defun html-add-form-option (value)
  "Insert an OPTION (for a SELECT form entry).  Value is optional.
Text describing the option follows; if value is omitted, the text is sent."
  (interactive "*sValue: ")
  (insert "<option")
  (or (zerop (length value)) (insert " value=\"" value ?\"))
  (insert " />"))

;; C-c C-f p
(defun html-add-form-password (name value)
  "Insert an INPUT TYPE=PASSWORD.  Name is required, value is optional."
  (interactive "*sName: \nsValue: ")
  (if (zerop (length name))
      (error "%s" "A name is required"))
  (insert "<input type=\"password\" name=\"" name ?\")
  (or (zerop (length value)) (insert " value=\"" value ?\"))
  (insert " />"))

;; C-c C-f r
(defun html-add-form-radio (name value)
  "Insert an INPUT TYPE=RADIO.  Name and value are both required."
  (interactive "*sName: \nsValue: ")
  (if (zerop (length name))
      (error "%s" "A name is required"))
  (if (zerop (length value))
      (error "%s" "A value is required"))
  (insert "<input type=\"radio\" name=\"" name "\" value=\"" value "\" />"))

;; C-c C-f s     
(defun html-add-form-select (name)
  "Insert a SELECT area.  Followed by OPTION entries defining values."
  (interactive "*sName: ")
  (if (zerop (length name))
      (error "%s" "A name is required"))
  (html-open-area "select")
  (save-excursion
    (forward-char -2)
    (insert " name=\"" name ?\")))

;; C-c C-f t     
(defun html-add-form-text (name value)
  "Insert an INPUT TYPE=TEXT.  Name is required, value is optional."
  (interactive "*sName: \nsValue (default content): ")
  (if (zerop (length name))
      (error "%s" "A name is required"))
  (insert "<input type=\"text\" name=\"" name ?\")
  (or (zerop (length value)) (insert " value=\"" value ?\"))
  (insert " />"))

;; C-c C-f x     
(defun html-add-form-submit (name value)
  "Insert an INPUT TYPE=SUBMIT (form submit button).  Name/value are optional."
  (interactive "*sName: \nsValue (button label): ")
  (insert "<input type=submit")
  (or (zerop (length name)) (insert " name=\"" name ?\"))
  (or (zerop (length value)) (insert " value=\"" value ?\"))
  (insert " />"))


;;; --------------------------------------------------------------------------
;;; ---------------------------- region commands -----------------------------
;;; --------------------------------------------------------------------------

;; C-c C-r l
(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)
      (insert "<a")
      (insert " href=\"" link "\">")
      (html-maybe-deemphasize-region start (1- (point))))
    (insert "</a>")
    (html-maybe-deemphasize-region (- (point) 3) (point))))

;; C-c C-r r
(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: \nr")
  (or (string= name "")
      (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)))))

(defun html-add-tag-to-region (tag start end) ; C-c C-r t    RMF
  "Add a tag (requested of user) to the current region.
Sometimes simpler than inserting a tag when text already exists that
would have to be moved within the tag area.  Use only for tags which
have a later negation (e.g., PRE, B, I, etc.)."
  (interactive "sTag: \nr")
  (setq tag (downcase tag))		; XHTML uses lowercase only
  (or (string= tag "")
      (if (= start end)
	  (progn			; point = mark, avoid reversing order
	    (insert "<" tag ">")
	    (html-maybe-deemphasize-region start (1- (point)))
	    (save-excursion
	      (insert "</" tag ">")
	      (html-maybe-deemphasize-region (- (point) 3) (point))))
	(save-excursion
	  (goto-char end)
	  (save-excursion
	    (goto-char start)
	    (insert "<" tag ">")
	    (html-maybe-deemphasize-region start (1- (point))))
	  (insert "</" tag ">")
	  (html-maybe-deemphasize-region (- (point) 3) (point))))
      ))

;;; --------------------------------------------------------------------------
;;; ---------------------------- special commands ----------------------------
;;; --------------------------------------------------------------------------

(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 "&"))

(defun html-nbsp (n)
  "Insert non-breaking space, or several if (non-neg) prefix arg is given."
  (interactive "p")
  (while (> n 0)
    (setq n (- n 1))
    (insert "&nbsp;")))

;;; --------------------------------------------------------------------------
;;; --------------------------- Mosaic previewing ----------------------------
;;; --------------------------------------------------------------------------

;; OK, we work like this: We have a variable html-previewer-process.
;; When we start, it's nil.  First time html-preview-document is
;; called, we write the current document into a tmp file and call
;; Mosaic on it.  Second time html-preview-document is called, we
;; write the current document into a tmp file, write out a tmp config
;; file, and send Mosaic SIGUSR1.

;; This feature REQUIRES the Lisp command signal-process, which seems
;; to be a Lucid Emacs v19 feature.  It might be in GNU Emacs v19 too;
;; I dunno.

(defvar html-previewer-process nil
  "Variable used to track live viewer process.")

(defun html-write-buffer-to-tmp-file ()
  "Write the current buffer to a temp file and return the name
of the tmp file."
  (let ((filename (concat "/tmp/" (make-temp-name "html") ".html")))
    (write-region (point-min) (point-max) filename nil 'foo)
    filename))

(defun html-preview-document ()
  "Preview the current buffer's HTML document by spawning off a
previewing process (assumed to be Mosaic, basically) and controlling
it with signals as long as it's alive."
  (interactive)
  (let ((tmp-file (html-write-buffer-to-tmp-file)))
    ;; If html-previewer-process is nil, we start a process.
    ;; OR if the process status is not equal to 'run.
    (if (or (eq html-previewer-process nil)
            (not (eq (process-status html-previewer-process) 'run)))
        (progn
          (message "Starting previewer...")
          (setq html-previewer-process
                (if html-document-previewer-args
                    (start-process "html-previewer" "html-previewer"
                                   html-document-previewer 
                                   html-document-previewer-args 
                                   tmp-file)
                  (start-process "html-previewer" "html-previewer"
                                 html-document-previewer 
                                 tmp-file))))
      ;; We've got a running previewer; use it via SIGUSR1.
      (save-excursion
        (let ((config-file (format "/tmp/xmosaic.%d" 
                                   (process-id html-previewer-process))))
          (set-buffer (generate-new-buffer "*html-preview-tmp*"))
          (insert "goto\nfile:" tmp-file "\n")
          (write-region (point-min) (point-max)
                        config-file nil 'foo)
          ;; This is a v19 routine only.
          (signal-process (process-id html-previewer-process)
                          html-sigusr1-signal-value)
          (delete-file config-file)
          (delete-file tmp-file)
          (kill-buffer (current-buffer)))))))

;;; --------------------------------------------------------------------------
;;; --------------------------------------------------------------------------
;;; --------------------------------------------------------------------------

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

;;; --------------------------- html-quotify-hrefs ---------------------------

(defun html-quotify-hrefs ()
  "Insert quotes around all HREF and NAME 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'.
This file is available at http://www.dc.net/rfire/html-mode.el.txt
(byte compiling highly recommended).
The latest (possibly unstable) version of the original will always be 
available on anonymous FTP server ftp.ncsa.uiuc.edu in /Mosaic/elisp."
  (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)
  (make-local-variable 'comment-start)	; RMF
  (setq comment-start "<!-- ")		; RMF
  (make-local-variable 'comment-end)	; RMF
  (setq comment-end " -->")		; RMF
  (make-local-variable 'comment-column) ; RMF
  (setq comment-column 0)		; RMF
  (make-local-variable 'comment-start-skip) ; RMF
  (setq comment-start-skip "<!-- ")     ; RMF
  (run-hooks 'html-mode-hook)
  (and html-use-font-lock
       (html-fontify)))

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

(defun html-html-mode-hook ()
  "Hook called from html-mode-hook.  
Run htlm-quotify-hrefs if html-quotify-hrefs-on-find is non-nil."
  ;; 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)

;;; -------------------------- lucid menubar setup ---------------------------

(if html-running-lemacs
    (progn
      (defvar html-menu
        '("HTML Mode"
          ["Open Address"         html-add-address      t]
          ["Open Blockquote"      html-add-blockquote   t]
          ["Open Header"          html-add-header       t]
          ["Open Hyperlink"       html-add-normal-link  t]
          ["Open Listing"         html-add-listing      t]
          ["Open Plaintext"       html-add-plaintext    t]
          ["Open Preformatted"    html-add-preformatted t]
          ["Open Reference"       html-add-normal-reference    t]
          ["Open Title"           html-add-title        t]
          "----"
          ["Open Bold"            html-add-bold         t]
          ["Open Citation"        html-add-citation     t]
          ["Open Code"            html-add-code         t]
          ["Open Emphasized"      html-add-emphasized   t]
          ["Open Fixed"           html-add-fixed        t]
          ["Open Keyboard"        html-add-keyboard     t]
          ["Open Sample"          html-add-sample       t]
          ["Open Strong"          html-add-strong       t]
          ["Open Variable"        html-add-variable     t]
          "----"
          ["Add Inlined Image"    html-add-img          t]
          ["End Paragraph"        html-add-paragraph-separator t]
          ["Preview Document"     html-preview-document t]
          "----"
          ("Definition List ..."
           ["Open Definition List"    html-add-description-list  t]
           ["Add Definition Entry"    html-add-description-entry t]
           )
          ("Other Lists ..."
           ["Open Unnumbered List"    html-add-list          t]
           ["Open Numbered List"      html-add-numbered-list t]
           ["Open Menu"               html-add-menu          t]
           "----"
           ["Add List Or Menu Item"   html-add-list-or-menu-item   t]
           )           
          ("Operations On Region ..."
           ["Add Hyperlink To Region" html-add-normal-link-to-region  t]
           ["Add Reference To Region" html-add-reference-to-region    t]
           )
          ("Reserved Characters ..."
           ["Less Than (<)"           html-real-less-than      t]
           ["Greater Than (>)"        html-real-greater-than   t]
           ["Ampersand (&)"           html-real-ampersand      t]
           )
          )
        )

      (defun html-menu (e)
        (interactive "e")
        (mouse-set-point e)
        (beginning-of-line)
        (popup-menu html-menu))
      (define-key html-mode-map 'button3 'html-menu)

      (defun html-install-menubar ()
        (if (and current-menubar (not (assoc "HTML" current-menubar)))
            (progn
              (set-buffer-menubar (copy-sequence current-menubar))
              (add-menu nil "HTML" (cdr html-menu)))))
      (html-postpend-unique-hook 'html-mode-hook 'html-install-menubar)

      (defconst 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.")

      (defun html-fontify ()
        (font-lock-mode 1)
        (make-local-variable 'font-lock-keywords) 
        (setq font-lock-keywords html-font-lock-keywords)
	(font-lock-hack-keywords (point-min) (point-max))
        (message "Hey boss, we been through html-fontify."))
      )
  )

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

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

(provide 'html-mode)