;;; psgml-html.el --- HTML mode in conjunction with PSGML

;; Copyright (C) 1994 Nelson Minar.
;; Copyright (C) 1995 Nelson Minar and Ulrik Dickow.
;; Copyright (C) 1996 Ben Wing.

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.

;;; Synched up with: FSF 19.30.

;;; Author: Ben Wing.

;;; Commentary:

; Parts were taken from html-helper-mode and from code by Alastair Burt.

; If you'd like to use the hm--html-minor-mode together with this
; mode, you have to put the following line to your ~/.emacs:
;	(add-hook 'html-mode-hook 'hm--html-minor-mode)

;;; Code:

(defvar html-auto-sgml-entity-conversion nil
  "*Control automatic SGML entity to ISO-8859-1 conversion.")

(provide 'psgml-html)
(require 'psgml)
(require 'derived)
(when html-auto-sgml-entity-conversion
  (require 'iso-sgml))
(require 'tempo)			;essential part of html-helper-mode

(eval-when-compile
  (require 'browse-url)
  (require 'font-lock)
  (require 'imenu)
  (require 'sendmail))

;;{{{ user variables

(defgroup html nil
  "HyperText Markup Language"
  :group 'sgml)

(defgroup psgml-html nil
  "HTML mode in conjunction with PSGML"
  :tag "Psgml Html"
  :prefix "html-helper-"
  :prefix "psgml-html-"
  :group 'html
  :group 'hypermedia
  :group 'psgml)

(defcustom html-helper-address-string
  (concat "<a href=\"mailto:"
	  (or user-mail-address
	      (concat (user-login-name) "@"
		      (or mail-host-address (system-name))))
	  "\">" (user-full-name) "</a>")
  "*The default author string of each file."
  :type 'string
  :group 'psgml-html)

(defcustom html-helper-htmldtd-version "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n"
  "*Version of HTML DTD you're using."
  :type 'string
  :group 'psgml-html)

(defcustom html-helper-do-write-file-hooks t
  "*If not nil, then modify `local-write-file-hooks' to do timestamps."
  :type 'boolean
  :group 'psgml-html)

(defcustom html-helper-build-new-buffer t
  "*If not nil, then insert `html-helper-new-buffer-strings' for new buffers."
  :type 'boolean
  :group 'psgml-html)

(defcustom html-helper-timestamp-hook 'html-helper-default-insert-timestamp
  "*Hook called for timestamp insertion.
Override this for your own timestamp styles."
  :type 'hook
  :group 'psgml-html)

;; strings you might want to change

(defcustom html-helper-new-buffer-template
  '(html-helper-htmldtd-version
    "<html>\n"
    "  <head>\n"
    "    <title>" (p "Document Title: " title) "</title>\n"
    "  </head>\n"
    "\n"
    "  <body>\n"
    "    <h1>" (s title) "</h1>\n\n"
    p
    "\n\n    <hr>\n"
    "    <address>" html-helper-address-string "</address>\n"
    (html-helper-return-created-string)
    html-helper-timestamp-start
    html-helper-timestamp-end
    "\n  </body>\n</html>\n")
  "*Template for new buffers.
Inserted by `html-helper-insert-new-buffer-strings' if
`html-helper-build-new-buffer' is set to t"
  :type 'sexp
  :group 'psgml-html)

(defcustom html-helper-timestamp-start "<!-- hhmts start -->\n"
  "*Start delimiter for timestamps.
Everything between `html-helper-timestamp-start' and
`html-helper-timestamp-end' will be deleted and replaced with the output
of the functions `html-helper-timestamp-hook' if
`html-helper-do-write-file-hooks' is t"
  :type 'string
  :group 'psgml-html)

(defcustom html-helper-timestamp-end "<!-- hhmts end -->"
  "*End delimiter for timestamps.
Everything between `html-helper-timestamp-start' and
`html-helper-timestamp-end' will be deleted and replaced with the output
of the function `html-helper-insert-timestamp' if
`html-helper-do-write-file-hooks' is t"
  :type 'string
  :group 'psgml-html)

;; control over what types of tags to load. By default, we load all the
;; ones we know of.

(defcustom html-helper-types-to-install
  '(anchor header logical phys list textel entity image head form table
	   special)
  "*List of tag types to install when html-helper-mode is first loaded.
If you want to not install some type of tag, override this variable.
Order is significant: menus go in this order."
  :type '(repeat symbol)
  :group 'psgml-html)

(defcustom html-helper-use-expert-menu nil
  "*If not nil, then use the full HTML menu."
  :type 'boolean
  :group 'psgml-html)

(defcustom html-helper-user-menu nil
  "*Extra items to put in the HTML expert menu.
The value of this symbol is appended to the beginning of the expert
menu that is handed off to easymenu for definition. It should be a
list of vectors or lists which themselves are vectors (for submenus)."
  :type 'sexp
  :group 'psgml-html)

(defgroup psgml-html-faces nil
  "Faces for highlighting HTML."
  :prefix "html-helper-"
  :group 'faces
  :group 'psgml-html)

(defface html-helper-bold-face '((t (:bold t)))
  "*Face for highlighting bold text."
  :group 'psgml-html-faces)

(defface html-helper-italic-face '((t (:italic t)))
  "*Face for highlighting italic text."
  :group 'psgml-html-faces)

(defface html-helper-underline-face '((t (:underline t)))
  "*Face for highlighting underlined text."
  :group 'psgml-html-faces)

(defface html-helper-strikethrough-face '((t (:strikethru t)))
  "*Face for highlighting strikethrough text."
  :group 'psgml-html-faces)

;; Could be underline, but it looks ugly at line breaks.
(defface html-helper-link-face '((t (:foreground "blue")))
  "*Face for highlighting link text."
  :group 'psgml-html-faces)

(defface html-helper-significant-tag-face '((t (:foreground "salmon")))
  "*Face for highlighting html, body, head, form, input and img tags."
  :group 'psgml-html-faces)

;;}}} end of user variables
;;{{{ type based keymap and menu variable and function setup

;; html-helper-mode has a concept of "type" of tags. Each type is a
;; list of tags that all go together in one keymap and one menu.
;; Types can be added to the system after html-helper has been loaded,
;; briefly by doing html-helper-add-type-to-alist, then
;; html-helper-install-type, then html-helper-add-tag (for each tag)
;; then html-helper-rebuild-menu. See the mode documentation for more detail.

(defconst html-helper-type-alist nil
  "Alist: type of tag -> keymap, keybinding, menu, menu string.
Add to this with `html-helper-add-type-to-alist'.")

;;{{{ accessor functions for html-helper-type-alist

(defun html-helper-keymap-for (type)
  "Accessor function for alist: for type, return keymap or nil"
  (nth 0 (cdr-safe (assq type html-helper-type-alist))))

(defun html-helper-key-for (type)
  "Accessor function for alist: for type, return keybinding or nil"
  (nth 1 (cdr-safe (assq type html-helper-type-alist))))

(defun html-helper-menu-for (type)
  "Accessor function for alist: for type, return menu or nil"
  (nth 2 (cdr-safe (assq type html-helper-type-alist))))

(defun html-helper-menu-string-for (type)
  "Accessor function for alist: for type, return menustring or nil"
  (nth 3 (cdr-safe (assq type html-helper-type-alist))))

(defun html-helper-normalized-menu-for (type)
  "Helper function for building menus from submenus: add on string to menu."
  (cons (html-helper-menu-string-for type)
	(eval (html-helper-menu-for type))))

;;}}}

(define-derived-mode html-mode sgml-mode "HTML"
  "Major mode for editing HTML documents.
This is based on PSGML mode, and has a sophisticated SGML parser in it.
It knows how to properly indent HTML/SGML documents, and it can do
  a form of document validation (use \\[sgml-next-trouble-spot] to find
  the next error in your document).
Commands beginning with C-z insert various types of HTML tags
  (prompting for the required information); to iconify or suspend,
  use C-z C-z.
To literally insert special characters such as < and &, use C-c followed
  by the character.
Use \\[sgml-insert-end-tag] to insert the proper closing tag.
Use \\[sgml-edit-attributes] to edit the attributes for a tag.
Use \\[sgml-show-context] to show the current HTML context.

More specifically:
\\{html-mode-map}
"
  (make-local-variable 'sgml-declaration)
  (make-local-variable 'sgml-default-doctype-name)
  (setq sgml-declaration             (expand-file-name "html.decl"
						       sgml-data-directory)
	sgml-default-doctype-name    "HTML"
	sgml-always-quote-attributes t
	sgml-indent-step             2
	sgml-indent-data	     t
	sgml-inhibit-indent-tags     '("pre")
	sgml-minimize-attributes     nil
	sgml-omittag                 t
	sgml-shorttag                t)

  ;; font-lock setup for various emacsen: XEmacs, Emacs 19.29+, Emacs <19.29.
  ;; By Ulrik Dickow <dickow@nbi.dk>.  (Last update: 05-Sep-1995).
  (cond	(running-xemacs ; XEmacs/Lucid
	 (put major-mode 'font-lock-keywords-case-fold-search t))
	;; XEmacs (19.13, at least) guesses the rest correctly.
	;; If any older XEmacsen don't, then tell me.
	;;
	((string-lessp "19.28.89" emacs-version) ; Emacs 19.29 and later
	 (make-local-variable 'font-lock-defaults)
	 (setq font-lock-defaults '(html-font-lock-keywords t t)))
	;;
	(t ; Emacs 19.28 and older
	 (make-local-variable 'font-lock-keywords-case-fold-search)
	 (make-local-variable 'font-lock-keywords)
	 (make-local-variable 'font-lock-no-comments)
	 (setq font-lock-keywords-case-fold-search t)
	 (setq font-lock-keywords html-font-lock-keywords)
	 (setq font-lock-no-comments t)))

  (if html-helper-do-write-file-hooks
      (add-hook 'local-write-file-hooks 'html-helper-update-timestamp))

  (if (and html-helper-build-new-buffer (zerop (buffer-size)))
      (html-helper-insert-new-buffer-strings))

  (set (make-local-variable 'sgml-custom-markup)
       '(("<A>" "<A HREF=\"\">\r</a>")))

  ;; Set up the syntax table.
  (modify-syntax-entry ?< "(>" html-mode-syntax-table)
  (modify-syntax-entry ?> ")<" html-mode-syntax-table)
  (modify-syntax-entry ?\" ".   " html-mode-syntax-table)
  (modify-syntax-entry ?\\ ".   " html-mode-syntax-table)
  (modify-syntax-entry ?'  "w   " html-mode-syntax-table)

  (tempo-use-tag-list 'html-helper-tempo-tags html-helper-completion-finder)
  (set (make-local-variable 'imenu-create-index-function)
       'html-helper-imenu-index)
  (set (make-local-variable 'imenu-sort-function) nil) ; sorting the
						       ; menu defeats
						       ; the purpose

  ; sigh ...  need to call this now to get things working.
  (sgml-build-custom-menus)
  ;; (add-submenu nil sgml-html-menu "SGML")
  (setq sgml-menu-name "HTML")
  (easy-menu-add sgml-html-menu)
  (html-helper-rebuild-menu)
  (unless (featurep 'infodock)
    (delete-menu-item '("SGML"))))

(defvar html-helper-imenu-regexp
  "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
  "*A regular expression matching a head line to be added to the menu.
The first `match-string' should be a number from 1-9.
The second `match-string' matches extra tags and is ignored.
The third `match-string' will be the used in the menu.")

;; Make an index for imenu
(defun html-helper-imenu-index ()
  "Return an table of contents for an html buffer for use with Imenu."
  (let ((space ?\ ) ; a char
	(toc-index '())
	toc-str)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward html-helper-imenu-regexp nil t)
	(setq toc-str
	      (concat
	       (make-string
		(* 2 (- (string-to-number (match-string 1)) 1))
		space)
	       (match-string 3)))
	(beginning-of-line)
	(setq toc-index (cons (cons toc-str (point)) toc-index))
	(end-of-line)))
    (nreverse toc-index)))

(defun html-helper-add-type-to-alist (type)
  "Add a type specification to the alist.
The spec goes (type . (keymap-symbol keyprefix menu-symbol menu-string)).
See code for an example."
  (setq html-helper-type-alist (cons type html-helper-type-alist)))

;; Here are the types provided by html-helper-mode.
(mapcar 'html-helper-add-type-to-alist
  '((entity  . (nil nil html-helper-entity-menu "Insert Character Entities"))
    (textel  . (nil nil html-helper-textel-menu "Insert Text Elements"))
    (head    . (html-helper-head-map "\C-zw" html-helper-head-menu "Insert Structural Elements"))
    (header  . (html-helper-base-map "\C-z" html-helper-header-menu "Insert Headers"))
    (anchor  . (html-helper-base-map "\C-z" html-helper-anchor-menu "Insert Hyperlinks"))
    (logical . (html-helper-base-map "\C-z" html-helper-logical-menu "Insert Logical Styles"))
    (phys    . (html-helper-base-map "\C-z" html-helper-phys-menu "Insert Physical Styles"))
    (list    . (html-helper-list-map "\C-zl" html-helper-list-menu "Insert List Elements"))
    (form    . (html-helper-form-map "\C-zf" html-helper-form-menu "Insert Form Elements"))
    (table   . (html-helper-table-map "\C-zt" html-helper-table-menu "Insert Table Elements"))
    (image   . (html-helper-image-map "\C-zm" html-helper-image-menu "Insert Inlined Images"))
    (special . (html-helper-base-map "\C-z" html-helper-special-menu "Insert Specials"))))

;; Once html-helper-mode is aware of a type, it can then install the
;; type: arrange for keybindings, menus, etc.

(defconst html-helper-installed-types nil
  "The types that have been installed (used when building menus).
There is no support for removing a type once it has been installed.")

(defun html-helper-install-type (type)
  "Install a new tag type: add it to the keymap, menu structures, etc.
For this to work, the type must first have been added to the list of types
with html-helper-add-type-to-alist."
  (setq html-helper-installed-types (cons type html-helper-installed-types))
  (let ((keymap (html-helper-keymap-for type))
	(key (html-helper-key-for type))
	(menu (html-helper-menu-for type))
	(menu-string (html-helper-menu-string-for type)))
    (and key
	 (progn
	   (set keymap nil)
	   (define-prefix-command keymap)
	   (define-key html-mode-map key keymap)))
    (and menu
	 (progn
	   (set menu nil)))))

;; install the default types.
(mapcar 'html-helper-install-type html-helper-types-to-install)

;;}}}

;;{{{ html-helper-add-tag function for building basic tags

(defvar html-helper-tempo-tags nil
  "List of tags used in completion.")

;; this while loop is awfully Cish
;; isn't there an emacs lisp function to do this?
(defun html-helper-string-to-symbol (input-string)
  "Given a string, downcase it and replace spaces with -.
We use this to turn menu entries into good symbols for functions.
It's not entirely successful, but fortunately emacs lisp is forgiving."
  (let* ((s (downcase input-string))
	 (l (1- (length s))))
    (while (>= l 0)
      (if (char-equal (aref s l) ?\ )
	  (aset s l ?\-))
      (setq l (1- l)))
    (concat "html-" s)))


(defun html-helper-add-tag (l)
  "Add a new tag to html-helper-mode.
Builds a tempo-template for the tag and puts it into the
appropriate keymap if a key is requested. Format:
`(html-helper-add-tag '(type keybinding completion-tag menu-name template doc)'"
  (let* ((type (car l))
	 (keymap (html-helper-keymap-for type))
	 (menu (html-helper-menu-for type))
	 (key (nth 1 l))
	 (completer (nth 2 l))
	 (name (nth 3 l))
	 (tag (nth 4 l))
	 (doc (nth 5 l))
	 (command (tempo-define-template (html-helper-string-to-symbol name)
					 tag completer doc
					 'html-helper-tempo-tags)))

    (if (null (memq type html-helper-installed-types))    ;type loaded?
	t                                                 ;no, do nothing.
      (if (stringp key)			                  ;bind key somewhere?
	  (if keymap			                  ;special keymap?
	      (define-key (eval keymap) key command)      ;t:   bind to prefix
	    (define-key html-mode-map key command))	  ;nil: bind to global
	t)
      (if menu				                  ;is there a menu?
	  (set menu			                  ;good, cons it in
	       (cons (vector name command t) (eval menu))))
      )))

;;}}}

;;{{{ most of the HTML tags

;; These tags are an attempt to be HTML 3.2 compliant
;; For reference see <URL:http://www.w3.org/TR/REC-html32.html>

;; order here is significant: within a tag type, menus and mode help
;; go in the reverse order of what you see here. Sorry about that, it's
;; not easy to fix.

(mapcar
 'html-helper-add-tag
 '(
   ;;entities
   (entity  "\C-c#"   "&#"              "Ascii Code"     ("&#" (r "Ascii: ") ";"))
   (entity  "\C-c\""  "&quot;"          "Quotation mark" ("&quot;"))
   (entity  "\C-c$"   "&reg;"           "Registered"     ("&reg;"))
   (entity  "\C-c@"   "&copy;"          "Copyright"      ("&copy;"))
   (entity  "\C-c-"   "&shy;"           "Soft Hyphen"    ("&shy;"))
   (entity  "\C-c "   "&nbsp;"		"Nonbreaking Space" ("&nbsp;"))
   (entity  "\C-c&"   "&amp;"		"Ampersand"	 ("&amp;"))
   (entity  "\C-c>"   "&gt;"	  	"Greater Than"   ("&gt;"))
   (entity  "\C-c<"   "&lt;"		"Less Than"	 ("&lt;"))

   ;; logical styles
   (logical "v"       "<div"            "Text Division"  ("<div align=\"" (r "Alignment: ") "\">" (r "Text: ") "</div>"))
   (logical "n"       "<center>"        "Center"         ("<center>" (r "Text: ") "</center>"))
   (logical "q"       "<blockquote>"	"Blockquote"     ("<blockquote>" (r "Quote: ") "</blockquote>"))
   (logical "c"       "<code>"		"Code"           ("<code>" (r "Code: ") "</code>"))
   (logical "x"       "<samp>"		"Sample"         ("<samp>" (r "Sample code") "</samp>"))
   (logical "r"       "<cite>"		"Citation"       ("<cite>" (r "Citation: ") "</cite>"))
   (logical "k"       "<kbd>"		"Keyboard Input" ("<kbd>" (r "Keyboard: ") "</kbd>"))
   (logical "v"       "<var>"		"Variable"       ("<var>" (r "Variable: ") "</var>"))
   (logical "d"       "<dfn>"		"Definition"     ("<dfn>" (r "Definition: ") "</dfn>"))
   (logical "a"	      "<address>"	"Address"	 ("<address>" r "</address>"))
   (logical "e"       "<em>"		"Emphasized"     ("<em>" (r "Text: ") "</em>"))
   (logical "s"       "<strong>"	"Strong"         ("<strong>" (r "Text: ") "</strong>"))
   (logical "p"       "<pre>"		"Preformatted"   ("<pre>" (r "Text: ") "</pre>"))

   ;;physical styles
   (phys    "p"       "<sup>"           "Superscript"    ("<sup>" (r "Text: ") "</sup>"))
   (phys    "u"       "<sub>"           "Subscript"      ("<sub>" (r "Text: ") "</sub>"))
   (phys    "s"       "<small>"         "Small"          ("<small>" (r "Text: ") "</small>"))
   (phys    "g"       "<big>"           "Big"            ("<big>" (r "Text: ") "</big>"))
   (phys    "-"       "<strike>"	"Strikethru"     ("<strike>" (r "Text: ") "</strike>"))
   (phys    "u"       "<u>"		"Underline"      ("<u>" (r "Text: ") "</u>"))
   (phys    "o"       "<i>"		"Italic"         ("<i>" (r "Text: ") "</i>"))
   (phys    "b"	      "<b>"    		"Bold"           ("<b>" (r "Text: ") "</b>"))
   (phys    "t"       "<tt>"		"Fixed"          ("<tt>" (r "Text: ") "</tt>"))

   ;;headers
   (header  "6"       "<h6>"		"Header 6"       ("<h6>" (r "Header: ") "</h6>"))
   (header  "5"       "<h5>"		"Header 5"       ("<h5>" (r "Header: ") "</h5>"))
   (header  "4"       "<h4>"		"Header 4"       ("<h4>" (r "Header: ") "</h4>"))
   (header  "3"       "<h3>"		"Header 3"       ("<h3>" (r "Header: ") "</h3>"))
   (header  "2"       "<h2>"		"Header 2"       ("<h2>" (r "Header: ") "</h2>"))
   (header  "1"	      "<h1>"     	"Header 1"       ("<h1>" (r "Header: ") "</h1>"))

   ;; forms
   (form    "o"       "<option>"        "Option"         (& "<option>" > ))
   (form    "v"       "<option value"   "Option with Value"  (& "<option value=\"" (r "Value: ") "\">" >))
   (form    "s"       "<select"		"Selections"	 ("<select name=\"" (p "Name: ") "\">\n<option>" > "\n</select>")"<select")
   (form    "z"	      "<input"		"Reset Form"     ("<input type=\"RESET\" value=\"" (p "Reset button text: ") "\">"))
   (form    "b"	      "<input"		"Submit Form"    ("<input type=\"SUBMIT\" value=\"" (p "Submit button text: ") "\">"))
   (form    "i"	      "<input"		"Image Field"    ("<input type=\"IMAGE\" name=\"" (p "Name: ") "\" src=\"" (p "Image URL: ") "\">"))
   (form    "h"       "<input"          "Hidden Field"   ("<input type=\"HIDDEN\" name=\"" (p "Name: ") "\" value=\"" (p "Value: ") "\">"))
   (form    "p"	      "<textarea"	"Text Area"	 ("<textarea name=\"" (p "Name: ") "\" rows=\"" (p "Rows: ") "\" cols=\"" (p "Columns: ") "\">" r "</textarea>"))
   (form    "c"	      "<input"		"Checkbox"   	 ("<input type=\"CHECKBOX\" name=\"" (p "Name: ") "\">"))
   (form    "r"	      "<input"		"Radiobutton"    ("<input type=\"RADIO\" name=\"" (p "Name: ") "\">"))
   (form    "t"	      "<input"		"Text Field"	 ("<input type=\"TEXT\" name=\"" (p "Name: ") "\" size=\"" (p "Size: ") "\">"))
   (form    "f"	      "<form"           "Form"		 ("<form action=\"" (p "Action: ") "\" method=\"" (p "Method: ") "\">\n</form>\n"))

   ;;tables
   (table   "d"       "<td>"            "Data cell"      ("<td>"))
   (table   "h"       "<th>"            "Header"         ("<th>"))
   (table   "r"       "<tr>"            "Row"            ("<tr>"))
   (table   "t"       "<table>"         "Table"          ("<table>\n<tr>\n</table>\n"))

   ;;lists
   (list    "t"       "<dt>"            "Definition Item" (& "<dt>" > (p "Term: ") "\n<dd>" > (r "Definition: ")))
   (list    "l"       "<li>"            "List Item"      (& "<li>" > (r "Item: ")))
   (list    "r"	      "<dir>"		"DirectoryList"  (& "<dir>" > "\n<li>" > (r "Item: ") "\n</dir>" >))
   (list    "m"	      "<menu>"		"Menu List"	 (& "<menu>" > "\n<li>" > (r "Item: ") "\n</menu>" >))
   (list    "o"	      "<ol>"		"Ordered List"   (& "<ol>" > "\n<li>" > (r "Item: ") "\n</ol>" >))
   (list    "d"	      "<dl>"		"Definition List" (& "<dl>" > "\n<dt>" > (p "Term: ") "\n<dd>" > (r "Definition: ") "\n</dl>" >))
   (list    "u"	      "<ul>"		"Unordered List" (& "<ul>" > "\n<li>" > (r "Item: ") "\n</ul>" >))

   ;;anchors
   (anchor  "n"	      "<a name="	"Link Target"	 ("<a name=\"" (p "Anchor name: ") "\">" (r "Anchor text: ") "</a>"))
   (anchor  "h"	      "<a href="        "Hyperlink"      ("<a href=\"" (p "URL: ") "\">" (r "Anchor text: ") "</a>"))

   ;;graphics
   (image   "m"       "<map name="      "Image map"      ("<map name=\"" (r "Map name: ") "\">"))
   (image   "a"       nil               "Aligned Image"	 ("<img align=\"" (r "Alignment: ") "\" src=\"" (r "Image URL: ") "\">"))
   (image   "i"       "<img src="	"Image"		 ("<img src=\"" (r "Image URL: ") "\">"))
   (image   "e"       "<img align="     "Aligned Image With Alt. Text"	("<img align=\"" (r "Alignment: ") "\" src=\"" (r "Image URL: ") "\" alt=\"" (r "Text URL: ") "\">"))
   (image   "t"       "<img alt="	"Image With Alternate Text"	("<img alt=\"" (r "Text URL: ") "\" src=\"" (r "Image URL: ") "\">"))

   ;;specials
   (special "a"       "<applet code="   "Applet"         ("<applet code=\"" (r "Applet class: ") "\" width=" (r "Applet width: ") " height=" (r "Applet height: ") ">"))
   (special "b"       "<basefont size=" "Base font size" ("<basefont size=" (r "Font size: ") ">"))
   (special "c"       "<font color="    "Font color"     ("<font color=\"" (r "Color: ") "\">" (r "Text: ") "</font>"))
   (special "s"       "<font size="     "Font size"      ("<font size=" (r "Font size: ") ">" (r "Text: ") "</font>"))

   ;;text elements
   (textel  "\C-c="   nil		"Horizontal Line" (& "<hr>\n"))
   (textel  "\C-c\C-m" nil		"Line Break"	 ("<br>\n"))
   (textel  "\e\C-m"  nil		"Paragraph"	 ("<p>" (progn (sgml-indent-line) nil) "\n"))

   ;;head elements
   (head    "H"       "<head>"          "Head"           ("<head>\n" "</head>\n"))
   (head    "B"       "<body>"          "Body"           ("<body>\n" "</body>\n"))
   (head    "i"	      "<isindex>"	"Isindex"        ("<isindex>\n"))
   (head    "n"	      "<nextid>"	"Nextid"         ("<nextid>\n"))
   (head    "h"       "<meta http-equiv=" "HTTP Equivalent" ("<meta http-equiv=\"" (p "Equivalent: ") "\" content=\"" (r "Content: ") "\">\n"))
   (head    "m"       "<meta name="     "Meta Name"      ("<meta name=\"" (p "Name: ") "\" content=\"" (r "Content: ") "\">\n"))
   (head    "l"	      "<link"		"Link"           ("<link href=\"" p "\">"))
   (head    "s"       "<script>"        "Script"         ("<script>"))
   (head    "y"       "<style>"         "Style"          ("<style>"))
   (head    "b"       "<base"		"Base"           ("<base href=\"" r "\">"))
   (head    "t"	      "<title>"		"Title"          ("<title>" (r "Document title: ") "</title>"))
   ))

;;}}}
;;{{{ html-helper-smart-insert-item

;; there are two different kinds of items in HTML - those in regular
;; lists <li> and those in dictionaries <dt>..<dd>
;; This command will insert the appropriate one depending on context.

(defun html-helper-smart-insert-item (&optional arg)
  "Insert a new item, either in a regular list or a dictionary."
  (interactive "*P")
  (let ((case-fold-search t))
    (if
        (save-excursion
          (re-search-backward "<li>\\|<dt>\\|<ul>\\|<ol>\\|<dd>\\|<menu>\\|<dir>\\|<dl>" nil t)
          (looking-at "<dt>\\|<dl>\\|<dd>"))
        (tempo-template-html-definition-item arg)
      (tempo-template-html-list-item arg))))

;; special keybindings in the prefix maps (not in the list of tags)
(and (boundp 'html-helper-base-map)
     (define-key html-helper-base-map "i" 'html-helper-smart-insert-item))

(define-key html-mode-map "\C-z\C-z" 'suspend-or-iconify-emacs)
(define-key html-mode-map "\C-zg" 'html-insert-mailto-reference-from-click)

;; and, special menu bindings
(and (boundp 'html-helper-list-menu)
     (setq html-helper-list-menu
	   (cons '["List Item" html-helper-smart-insert-item t] html-helper-list-menu)))

;;}}}

;;{{{ menu support

;; menus are built for easymenu. html-helper-add-tag builds
;; submenus based on tag type, the expert menu code lumps them
;; together into one list and calls easy-menu-define

(defun html-helper-rebuild-menu nil
  "Rebuild and install the HTML menu (using `easy-menu-define').
If `html-helper-use-expert-menu' is nil, then just use a novice menu."
  (let ((menu (html-helper-expert-menu)))
    (easy-menu-remove menu)
    (easy-menu-add menu html-mode-map)))

(defun html-helper-toggle-expert-menu (&optional arg)
  "Toggle full HTML menus. Optional arg acts like minor-mode args."
  (interactive "P")
  (setq html-helper-use-expert-menu
	(if (null arg) (not html-helper-use-expert-menu)
	  (> (prefix-numeric-value arg) 0)))
  (html-helper-rebuild-menu))

;; Expert menus: consed up out of html-helper-installed-types
(defun html-helper-expert-menu ()
  "This menu is based on the current value of `html-helper-installed-types'.
This function can be called again, it redoes the entire menu."
  ;; Start with the user-provided menu stuff
  (let ((html-helper-mode-menu html-helper-user-menu))
    ;; Now cons in the browse-url functions
    (if (fboundp 'browse-url-of-file)
	(setq html-helper-mode-menu
	      (cons '["Load this Buffer in Browser" browse-url-of-file t]
		    html-helper-mode-menu)))
    (setq html-helper-mode-menu
          (cons (vector "Browse URL at point"
                        (when (and (boundp 'browse-url-browser-function)
                                   browse-url-browser-function)
                          ;; If the value is not a function it should be a list of pairs
                          ;; (REGEXP . FUNCTION)
                          (cond
                           ((functionp browse-url-browser-function))
                           ((listp browse-url-browser-function)
                            (dolist (elt browse-url-browser-function)
                              (when (not (string-match "mail" (symbol-name (cdr-safe elt))))
                                (return (cdr elt)))))))
                        t)
                html-helper-mode-menu))

    ;; cons in the timestamp delimiters
    (setq html-helper-mode-menu
	  (cons '["Insert Timestamp Delimiter"
		  html-helper-insert-timestamp-delimiter-at-point t]
		html-helper-mode-menu))

    ;; now cons up the main menu out of the submenus
    (mapcar
     (function (lambda (type)
		 (setq html-helper-mode-menu
		       (cons (html-helper-normalized-menu-for type)
			     html-helper-mode-menu))))
     html-helper-installed-types)

    ;; now tack on our name
    (setq html-helper-mode-menu (cons "Insert" html-helper-mode-menu))

    ;; special mode keys
    (define-key html-mode-map (kbd "<M-iso-left-tab>") 'tempo-complete-tag)
    ;;("\M-\C-f" tempo-forward-mark)
    ;;("\M-\C-b" tempo-backward-mark)

    html-helper-mode-menu))

;;}}}

;;{{{ patterns for font-lock

; Old patterns from html-mode.el
;(defvar html-font-lock-keywords
;  (list
;   '("\\(<[^>]*>\\)+" . font-lock-comment-face)
;   '("[Hh][Rr][Ee][Ff]=\"\\([^\"]*\\)\"" 1 font-lock-string-face t)
;   '("[Ss][Rr][Cc]=\"\\([^\"]*\\)\"" 1 font-lock-string-face t))
;  "Patterns to highlight in HTML buffers.")

;; By Ulrik Dickow <dickow@nbi.dk>.
;;
;; Originally aimed at Emacs 19.29.  Later on disabled syntactic fontification
;; and reordered regexps completely, to be compatible with XEmacs (it doesn't
;; understand OVERRIDE=`keep').
;;
;; We make an effort on handling nested tags intelligently.

;;;###autoload
(defvar html-font-lock-keywords
  (let (;; Titles and H1's, like function defs.
	;;   We allow for HTML 3.0 attributes, like `<h1 align=center>'.
	(tword "\\(h1\\|title\\)\\([ \t\n]+[^>]+\\)?")
	;; Names of tags to boldify.
	(bword "\\(b\\|h[2-4]\\|strong\\)\\([ \t\n]+[^>]+\\)?")
	;; Names of tags to italify.
	(iword "\\(address\\|cite\\|em\\|i\\|var\\)\\([ \t\n]+[^>]+\\)?")
	;; Regexp to match shortest sequence that surely isn't a bold end.
	;; We simplify a bit by extending "</strong>" to "</str.*".
	;; Do similarly for non-italic and non-title ends.
	(not-bend (concat "\\([^<]\\|<\\([^/]\\|/\\([^bhs]\\|"
			  "b[^>]\\|"
			  "h\\([^2-4]\\|[2-4][^>]\\)\\|"
			  "s\\([^t]\\|t[^r]\\)\\)\\)\\)"))
	(not-iend (concat "\\([^<]\\|<\\([^/]\\|/\\([^aceiv]\\|"
			  "a\\([^d]\\|d[^d]\\)\\|"
			  "c\\([^i]\\|i[^t]\\)\\|"
			  "e\\([^m]\\|m[^>]\\)\\|"
			  "i[^>]\\|"
			  "v\\([^a]\\|a[^r]\\)\\)\\)\\)"))
	(not-tend (concat "\\([^<]\\|<\\([^/]\\|/\\([^ht]\\|"
			  "h[^1]\\|t\\([^i]\\|i[^t]\\)\\)\\)\\)")))
    (list ; Avoid use of `keep', since XEmacs will treat it the same as `t'.
     ;; First fontify the text of a HREF anchor.  It may be overridden later.
     ;; Anchors in headings will be made bold, for instance.
     '("<a\\s-+href[^>]*>\\([^>]+\\)</a>"
       1 html-helper-link-face t)
     ;; Tag pairs like <b>...</b> etc.
     ;; Cunning repeated fontification to handle common cases of overlap.
     ;; Bold complex --- possibly with arbitrary other non-bold stuff inside.
     (list (concat "<" bword ">\\(" not-bend "*\\)</\\1>")
	   3 'html-helper-bold-face t)
     ;; Italic complex --- possibly with arbitrary non-italic kept inside.
     (list (concat "<" iword ">\\(" not-iend "*\\)</\\1>")
	   3 'html-helper-italic-face t)
     ;; Bold simple --- first fontify bold regions with no tags inside.
     (list (concat "<" bword ">\\("  "[^<]"  "*\\)</\\1>")
	   3 'html-helper-bold-face t)
     ;; Any tag, general rule, just after bold/italic stuff.
     '("\\(<[^>]*>\\)" 1 font-lock-type-face t)
     ;; Titles and level 1 headings (anchors do sometimes appear in h1's)
     (list (concat "<" tword ">\\(" not-tend "*\\)</\\1>")
	   3 'font-lock-function-name-face t)
     ;; Underline is rarely used. Only handle it when no tags inside.
     '("<u>\\([^<]*\\)</u>" 1 html-helper-underline-face t)
     ;; Ditto for strikethrough.
     '("<strike>\\([^<]*\\)</strike>" 1 html-helper-strikethrough-face t)
     ;; Forms, anchors & images (also fontify strings inside)
     '("\\(<\\(form\\|i\\(mg\\|nput\\)\\)\\>[^>]*>\\)"
       1 html-helper-significant-tag-face t)
     '("</a>" 0 font-lock-keyword-face t)
     '("\\(<a\\b[^>]*>\\)" 1 font-lock-keyword-face t)
     '("=[ \t\n]*\\(\"[^\"]+\"\\)" 1 font-lock-string-face t)
     ;; Large-scale structure keywords (like "program" in Fortran).
     ;;   "<html>" "</html>" "<body>" "</body>" "<head>" "</head>" "</form>"
     '("</?\\(body\\|form\\|h\\(ead\\|tml\\)\\)>"
       0 html-helper-significant-tag-face t)
     ;; HTML special characters
     '("&[^;\n]*;" 0 font-lock-string-face t)
     ;; SGML things like <!DOCTYPE ...> with possible <!ENTITY...> inside.
     '("\\(<![a-z]+\\>[^<>]*\\(<[^>]*>[^<>]*\\)*>\\)"
       1 font-lock-comment-face t)
     ;; Comments: <!-- ... -->. They traditionally override anything else.
     ;; It's complicated 'cause we won't allow "-->" inside a comment, and
     ;; font-lock colours the *longest* possible match of the regexp.
     '("\\(<!--\\([^-]\\|-[^-]\\|--[^>]\\)*-->\\)"
       1 font-lock-comment-face t)))
    "Additional expressions to highlight in HTML mode.")

(put 'html-mode 'font-lock-defaults '(html-font-lock-keywords nil t))

;;}}}

;;{{{ patterns for hilit19

;; Define some useful highlighting patterns for the hilit19 package.
;; These will activate only if hilit19 has already been loaded.
;; Thanks to <dickow@nbi.dk> for some pattern suggestions

(if (featurep 'hilit19)
    (hilit-set-mode-patterns
     'html-helper-mode
     '(("<!--" "-->" comment)
       ("<![a-z]+\\>[^<>]*\\(<[^>]*>[^<>]*\\)*>" nil comment) ;<!DOCTYPE ...>
       ("<title>" "</title>" defun)
       ("<h[1-6]>" "</h[1-6]>" bold) ;only colour inside tag
       ("<a\\b" ">" define)
       ("</a>" nil define)
       ("<img\\b" ">" include)
       ("<option\\|</?select\\|<input\\|</?form\\|</?textarea" ">" include)
       ;; First <i> highlighting just handles unnested tags, then do nesting
       ("<i>[^<]*</i>" nil italic)
       ("<b>" "</b>" bold)
       ("<i>" "</i>" italic)
       ("<u>" "</u>" underline)
       ("&[^;\n]*;" nil string)
       ("<" ">" keyword))
     nil 'case-insensitive)
  nil)

;;}}}

;;{{{ completion finder for tempo

;; The regexp finds everything between the last < or & and point,
;; which is good enough to match the tags HTML might complete.
(defvar html-helper-completion-finder "\\(\\(<\\|&\\).*\\)\\="
  "Passed to tempo-use-tag-list, used to find tags to complete.")

;;}}}

;;{{{ timestamps

(defun html-helper-update-timestamp ()
  "Basic function for updating timestamps.
It finds the timestamp in the buffer by looking for
`html-helper-timestamp-start', deletes all text up to
`html-helper-timestamp-end', and runs `html-helper-timestamp-hook' which
will should insert an appropriate timestamp in the buffer."
  (save-excursion
    (goto-char (point-max))
    (if (not (search-backward html-helper-timestamp-start nil t))
	(message "timestamp delimiter start was not found")
      (let ((ts-start (+ (point) (length html-helper-timestamp-start)))
	    (ts-end (if (search-forward html-helper-timestamp-end nil t)
			(- (point) (length html-helper-timestamp-end))
		      nil)))
	(if (not ts-end)
	    (message "timestamp delimiter end was not found. Type C-c C-t to insert one.")
	  (delete-region ts-start ts-end)
	  (goto-char ts-start)
	  (run-hooks 'html-helper-timestamp-hook)))))
  nil)

(defun html-helper-return-created-string ()
  "Return a \"Created:\" string."
  (let ((time (current-time-string)))
    (concat "<!-- Created: "
	    (substring time 0 20)
	    (nth 1 (current-time-zone))
	    " "
	    (substring time -4)
	    " -->\n")))

(defun html-helper-default-insert-timestamp ()
  "Default timestamp insertion function."
  (let ((time (current-time-string)))
    (insert "Last modified: "
	    (substring time 0 20)
	    (nth 1 (current-time-zone))
	    " "
	    (substring time -4)
	    "\n")))

(defun html-helper-insert-timestamp-delimiter-at-point ()
  "Simple function that inserts timestamp delimiters at point.
Useful for adding timestamps to existing buffers."
  (interactive)
  (insert html-helper-timestamp-start)
  (insert html-helper-timestamp-end))

;;}}}

(defun mail-address-at-point (pos &optional buffer)
  "Return a list (NAME ADDRESS) of the address at POS in BUFFER."
  (or buffer (setq buffer (current-buffer)))
  (let (beg end)
    (save-excursion
      (set-buffer buffer)
      (save-excursion
	(goto-char pos)
	(or (re-search-forward "[\n,]" nil t)
	    (error "Can't find address at position"))
	(backward-char)
	(setq end (point))
	(or (re-search-backward "[\n,:]" nil t)
	    (error "Can't find address at position"))
	(forward-char)
	(re-search-forward "[ \t]*" nil t)
	(setq beg (point))
	(mail-extract-address-components (buffer-substring beg end))))))

(defun html-insert-mailto-reference-from-click ()
  "Insert a mailto: reference for the clicked-on e-mail address."
  (interactive)
  (let (event)
    (message "Click on a mail address:")
    (save-excursion
      (setq event (next-command-event))
      (or (mouse-event-p event)
	  (error "Aborted.")))
    (let ((lis (mail-address-at-point (event-closest-point event)
				      (event-buffer event))))
      (insert "<a href=\"mailto:" (car (cdr lis)) "\">"
	      (or (car lis) (car (cdr lis))) "</a>"))))

;;;###autoload
(defun html-quote-region (begin end)
  "\"Quote\" any characters in the region that have special HTML meanings.
This converts <'s, >'s, and &'s into the HTML commands necessary to
get those characters to appear literally in the output."
  (interactive "r")
  (save-excursion
    (goto-char begin)
    (while (search-forward "&" end t)
      (forward-char -1)
      (delete-char 1)
      (insert "&amp;")
      (setq end (+ 4 end)))
    (goto-char begin)
    (while (search-forward "<" end t)
      (forward-char -1)
      (delete-char 1)
      (insert "&lt;")
      (setq end (+ 3 end)))
    (goto-char begin)
    (while (search-forward ">" end t)
      (forward-char -1)
      (delete-char 1)
      (insert "&gt;")
      (setq end (+ 3 end)))))

;;{{{ html-helper-insert-new-buffer-strings

(tempo-define-template "html-skeleton" html-helper-new-buffer-template
		       nil
		       "Insert a skeleton for a HTML document")

(defun html-helper-insert-new-buffer-strings ()
  "Insert `html-helper-new-buffer-strings'."
  (tempo-template-html-skeleton))

;;}}}

;;;###autoload
(autoload 'html-mode "psgml-html" "HTML mode." t)

(defvar sgml-html-menu
  (cons "HTML"
	(append '(["View in Netscape" sgml-html-netscape-file
		   (buffer-file-name
		    (current-buffer))]
		  ["View in W3" w3-preview-this-buffer t]
		  ["View in kfm" sgml-html-kfm-file
		   (buffer-file-name (current-buffer))]
		  "---"
		  ["HTML-Quote Region" html-quote-region t]
		  "---")
		(cdr sgml-main-menu))))

(defun sgml-html-netscape-file ()
  "Preview the file for the current buffer in Netscape."
  (interactive)
  (highlight-headers-follow-url-netscape
   (concat "file:" (buffer-file-name (current-buffer)))))

(defun sgml-html-kfm-file ()
  "Preview the file for the current buffer in kfm."
  (interactive)
  (highlight-headers-follow-url-kfm
   (concat "file:" (buffer-file-name (current-buffer)))))

;;;###autoload(add-to-list 'auto-mode-alist '("\\.[sj]?html?\\'" . html-mode))
;;;###autoload(add-to-list 'auto-mode-alist '("\\.jsp\\'" . html-mode))

;;; end of psgml-html.el
