
;;; HTML mode

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


;;; Fixup RFC files

;; make-HTML-special, insert-HTML-special
;;
;; With these routines, as we identify lists and preformated blocks,
;; replace them with special 2-char, 8-bit codes, then go back and replace
;; those codes (called HTML specials) later on.
;;
;; In particular, this is how I protect the contents of PRE blocks from
;; any futher transformations.

(defun make-HTML-special (start end)
      (setq HTML-specials
	    (cons
	     (cons (concat (list (+ 128 (lsh HTML-special-code -7))
				 (+ 128 (logand HTML-special-code 127))))
		   (buffer-substring start end))
	     HTML-specials))
      (delete-region start end)
      (save-excursion
	(goto-char start)
	(insert-char 10 1)
	(insert (car (car HTML-specials)))
	(setq HTML-special-code (1+ HTML-special-code))
	(insert-char 10 1)
	(insert-char 10 1)
	)
)

(defun insert-HTML-special (HTML-special)
  (let ((Special-code (car HTML-special))
	(Special-text (cdr HTML-special)) )
    (goto-char (point-min))
    (search-forward Special-code nil t)
    (replace-match Special-text t t)
    ))



;; next-para-start, this-para-end, next-strange-start, next-UL-item-start
;;
;; Return pointer to various things (without changing point), or nil if none:
;;    - The next paragraph (identified by a \n\n combination preceeding it)
;;      If point is at the start of a paragraph, return the next one
;;    - The end of this paragraph (the point after the first \n in a \n\n)
;;    - The next line that looks "strange" i.e., like a PRE block
;;      We check the indent and see if it doesn't have enough spaces
;;    - The next line that looks like a UL (starts with an indented " - ")

(defun next-para-start ()
  (save-excursion
    (if (looking-at "\n\n+") (goto-char (match-end 0)))
    (and (re-search-forward "\n\n+" nil t)
	 (match-end 0))
    ))

(defun this-para-end ()
  (save-excursion
    (and (re-search-forward "\n\n+" nil t)
	 (1+ (match-beginning 0)))
    ))

(defun next-strange-start ()
  (save-excursion
    (and (re-search-forward "^    " nil t)
	 (match-beginning 0))
    ))


(defun next-UL-item-start ()
  (save-excursion
    (and (re-search-forward "^ +- " nil t)
	 (match-beginning 0))
    ))

(defun next-para-attributes (here)
  (save-excursion
    (let (begin end indent (height 1))
      (goto-char here)
      (cond ((re-search-forward "\n+" nil t)
	     (setq begin (point))
	     (looking-at " +")
	     (setq indent (- (match-end 0) (match-beginning 0)))
	     (next-line 1)
	     (while (looking-at " +")
	       (if (and indent
			(not (= indent (- (match-end 0) (match-beginning 0)))))
		   (setq indent nil) )
	       (setq height (1+ height))
	       (next-line 1) )
	     (list begin (point) indent height)
	     )
	    (t nil))
      )))

(defun fixup-by-attributes ()
  (goto-char (point-min))
  (let ((current-indent 0) parattribs)
    (while (setq parattribs (next-para-attributes (point)))
      (goto-char (first parattribs))
      (cond ((and (eq (fourth parattribs) 1)
		  (looking-at " *[0-9.]+\\. "))
	     (setq current-indent (third (next-para-attributes (second parattribs))))
	     (make-header-line))
	    ((eq current-indent (third parattribs))
	     (insert "<P>\n"))
	    (t
	     (setq current-ident (third parattribs))) )
      (goto-char (second parattribs))
      )) )

;; fixup-rfc
;;
;; Maybe we should record all deleted/changed info in another buffer,
;; for the user to easily view, like this:
;;    (setq change-list (cons
;;		       (list "DELETE-nroff-break"
;;			     (buffer-substring
;;			      (match-beginning 0) (match-end 0)))
;;		       change-list))

(defun section-title-depth (section-title)
  (cond ((string-match "^[0-9]+\\. " section-title) 0)
	((string-match "^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\. " section-title) 3)
	((string-match "^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\." section-title) 4)
	((string-match "^[0-9]+\\.[0-9]+\\.[0-9]+\\. " section-title) 2)
	((string-match "^[0-9]+\\.[0-9]+\\.[0-9]+\\." section-title) 3)
	((string-match "^[0-9]+\\.[0-9]+\\. " section-title) 1)
	((string-match "^[0-9]+\\.[0-9]+\\." section-title) 2)
	((string-match "^[0-9]+\\.[0-9]" section-title) 1)
	((string-match "^[A-Z]\\.[0-9]+\\.[0-9]" section-title) 2)
	((string-match "^[A-Z]\\.[0-9]" section-title) 1)
	((string-match "^$" section-title) 0)
	((string-match "^Appendix" section-title) 0)
	((string-match "^References" section-title) 0)
	((string-match "^Bibliography" section-title) 0)
	(t 0)
	))

(defun firstn (n list)
  (cond ((<= n 0) nil)
	(t (cons (car list)
		 (firstn (1- n) (cdr list))
		 )) ))

(defun insert-up-link (link-title)
  (insert "<BR><B>Up:</B> <A HREF=\"")
  (insert (car link-title))
  (insert "\">")
  (insert (nth 1 link-title))
  (insert "</A>\n") )

;; write-kill-as-html-file
;;
;; This is pretty important function, as it is responsible for building
;; the header and footer of each HTML file.  The most recent item
;; in the kill ring is the text of the fill.  Pass the title/file-name
;; pairs in for the header.  This function maintains an up-links global
;; variable (that must be initialized to nil by another function) to
;; keep track of parents as we move through the hierarchy
;;
;; Everything is labeled "RFC 000" - I go behind with sededit like this:
;;       sededit 's/RFC 000/RFC 950/g' *.html
;; I find this easier that changing this function for every RFC

(defun write-kill-as-html-file (prev-section-title prev-file-name
				this-section-title this-file-name
				next-section-title next-file-name)
  ;; Write the last item in the kill ring as an HTML file
  (save-excursion
    (find-file this-file-name)
    (erase-buffer)
    (insert "<HTML>
<HEAD>
<TITLE>RFC 000 - ") (insert this-section-title) (insert "</TITLE>
</HEAD>
<BODY>
<B>Connected: An Internet Encyclopedia</B>
<BR>
<EM> RFC 000 - ") (insert this-section-title) (insert "</EM>
<HR>
<CENTER>
<B>Home:</B> <A HREF=\"/index.html\">FreeSoft</A>
<BR><B>Top:</B> <A HREF=\"/Connected/index.html\">Connected: An Internet Encyclopedia</A>
<BR><B>Up:</B> <A HREF=\"../index.html\">Requests For Comments</A>
<BR><B>Up:</B> <A HREF=\"index.html\">RFC 000</A>\n")
    (setq up-links (firstn (section-title-depth this-section-title) up-links))
    (if (not (null up-links))
	(progn (mapcar 'insert-up-link up-links)
	       (setq up-links (append up-links
				      (list (list this-file-name
						  this-section-title))) ))
      (progn (setq up-links (list (list this-file-name this-section-title)))))
    (insert "</CENTER>\n")
    (if prev-section-title
	(progn (insert "<B>Prev:</B> <A HREF=\"")
	       (insert prev-file-name)
	       (insert "\"> ")
	       (insert prev-section-title)
	       (insert "</A>\n") ))
    (if (and prev-section-title next-section-title) (insert "<BR>\n"))
    (if next-section-title
	(progn (insert "<B>Next:</B> <A HREF=\"")
	       (insert next-file-name)
	       (insert "\"> ")
	       (insert next-section-title)
	       (insert "</A>\n") ))
    (insert "<HR><P>\n")

    (yank)
    (insert (car insert-list))
    (setq insert-list (cdr insert-list))

    (insert "<P><HR>\n")
    (if next-section-title
	(progn (insert "<CENTER>\n<B>Next:</B> <A HREF=\"")
	       (insert next-file-name)
	       (insert "\"> ")
	       (insert next-section-title)
	       (insert "</A>\n</CENTER>\n<HR>\n") ))
    (insert "<B>Connected: An Internet Encyclopedia</B>
<BR>
<EM> RFC 000 - ") (insert this-section-title) (insert "</EM>
</BODY>
</HTML>
")
    (save-buffer)
    ))


(defun write-ToC-entry (section-head-entry)
  (setq end-insert nil)
  (if (= current-heading-level (car section-head-entry))
      (progn (goto-char (point-min))
	     (insert "<BR>\n")))
  (while (< current-heading-level (car section-head-entry))
    (goto-char (point-min))
    (insert "</UL>\n")
    (setq end-insert-list (cons (point-marker) end-insert-list))
    (setq current-heading-level (1+ current-heading-level)))
  (while (> current-heading-level (car section-head-entry))
    (goto-char (point-min))
    (insert "<UL>\n")
    (if (not (null end-insert)) (set-marker end-insert nil))
    (setq end-insert (car end-insert-list))
    (setq end-insert-list (cdr end-insert-list))
    (setq current-heading-level (1- current-heading-level)))

  (setq this-insert "")
  (if (not (null end-insert))
      (progn
	(setq this-insert (buffer-substring (point-min)
					    (marker-position end-insert)))
	(set-marker end-insert nil) ))
  (setq insert-list (cons this-insert insert-list))

  (goto-char (point-min))
  (insert "<A HREF=\"")
  (insert (car (cdr (cdr section-head-entry))))
  (insert "\">")
  (insert (car (cdr section-head-entry)))
  (insert "</A>\n")
)

;; build-section-heads
(defun build-section-heads ()

  (goto-char (point-min))
  (setq this-file-num 1)
  (setq section-heads nil)
  (while (re-search-forward "\n<H3>\\(.*\\)</H3>" nil t)
    (setq this-section-title (buffer-substring (match-beginning 1)
					       (match-end 1)))
    (setq section-heads (cons (list (section-title-depth this-section-title)
				    this-section-title
				    (format "%d.html" this-file-num))
			      section-heads))
    (setq this-file-num (1+ this-file-num))
    )

  ;; Create index.html, containing links to all the document sections
  (save-excursion
    (find-file "index.html")
    (erase-buffer)
    (insert "</UL>\n")
    (setq current-heading-level 0)
    (setq end-insert-list nil)
    (setq insert-list nil)
    (mapcar 'write-ToC-entry section-heads)
    (setq insert-list (cons "" insert-list))
    (goto-char (point-min))
    (insert "<UL>\n")
    (save-buffer))
)

;; This function takes a completely parsed HTML file, breaks it up
;; by sections, and writes them out as individual files.

(defun write-html-files ()
  (interactive)

  (build-section-heads)

  (setq last-section-title nil)
  (setq this-section-title nil)
  (setq next-section-title "")
  (setq this-file-num 0)
  (setq up-links nil)

  (goto-char (point-min))
  (setq section-start (point))

  (while (re-search-forward "\n<H3>\\(.*\\)</H3>" nil t)
    (setq last-section-title this-section-title)
    (setq this-section-title next-section-title)
    (setq next-section-title (buffer-substring (match-beginning 1)
					       (match-end 1)))
    (goto-char (1+ (match-beginning 0)))
    (copy-region-as-kill section-start (point))
    (write-kill-as-html-file
     last-section-title (format "%d.html" (1- this-file-num))
     this-section-title (format "%d.html" this-file-num)
     next-section-title (format "%d.html" (1+ this-file-num)))
    (setq section-start (point))
    (setq this-file-num (1+ this-file-num)) )

  (setq last-section-title this-section-title)
  (setq this-section-title next-section-title)
  (setq next-section-title nil)
  (copy-region-as-kill section-start (point-max))
  (write-kill-as-html-file
   last-section-title (format "%d.html" (1- this-file-num))
   this-section-title (format "%d.html" this-file-num)
   next-section-title (format "%d.html" (1+ this-file-num)))
  (goto-char (point-max))

)

;; remove-footnotes
;;
;; Written for RFC 1144
;; Probably not much use for anything else

(defun remove-footnotes ()

  (goto-char (point-min))

  (while (re-search-forward
	  "\n   ----------------------------\n\\(\\(   .*\n\\)+\\)" nil t)
    (copy-region-as-kill (match-beginning 1) (match-end 1))
    (save-excursion
      (find-file "footnotes")
      (yank))
    (kill-region (match-beginning 0) (match-end 0))
    ))

;; remove-page-breaks
;;
;; This is one function I check against every RFC first, tweaking the
;; REGEX as needed.

(defun remove-page-breaks ()




  ;; Remove nroff page breaks
  (goto-char (point-min))
  (while (re-search-forward
	  "\n\n\n.*Page.*\n\f\n.*RFC.*\n\n\n" nil t)
    (replace-match "" nil nil))





  ;; Remove nroff page breaks - odd pages
  (goto-char (point-min))
  (while (re-search-forward
	  "\n\n .*Page.*\n\f\n\n.* 19.*\n\\(\\w.*\n\\)+\n\n\n" nil t)
    (replace-match "" nil nil))

  ;; Remove nroff page breaks - even pages
  (goto-char (point-min))
  (while (re-search-forward
	  "\n\n[^ ].*Page.*\n\f\n\n\\w.* 19.*\n\\( .*\\w\n\\)+\n\n" nil t)
    (replace-match "" nil nil))

  ;; Remove nroff page breaks - pages that don't change
  (goto-char (point-min))
  (while (re-search-forward
	  "\n+[^ ].*Page.*\n\f\n\n\n\\w.* 19.*\n\\(\\w.*\n\\)+\n+" nil t)
    (replace-match "\n\n" nil nil))

  ;; Remove trailing page break
  (while (re-search-forward "\n+.*Page.*\n\f" nil t)
    (replace-match "" nil nil))
)

;; simplify-vertical-skips
;;
;; Collapse multiple \n's into a single \n\n pair

(defun simplify-vertical-skips nil
  (goto-char (point-min))
  (while (re-search-forward "\n\n+" nil t)
    (replace-match "\n\n" nil nil))
  )

;; escape-html-special-chars
;;
;; Replaces <, > and & with HTML character escape codes

(defun escape-html-special-chars nil
  (goto-char (point-min))
  (while (re-search-forward "&\\|<\\|>" nil t)
    (let ((special-char (string-to-char (buffer-substring
					 (match-beginning 0) (match-end 0)))))
      (cond ((= special-char ?&) (replace-match "&amp;" t t))
	    ((= special-char ?<) (replace-match "&lt;" t t))
	    ((= special-char ?>) (replace-match "&gt;" t t))
	    (t (error "Invalid HTML special char: %c" special-char))
	    )))
  )


;; convert-section-heads-to-specials
;;
;; A "section head" is defined by the screwy REGEX below.  In particular,
;; the spacing somethings needs to be tweaked
;;
;; Section heads that have doublequotes in them are not correctly
;; handled.  I go back and remove the quotes in the NAME= tag by hand.
;; The NAME= tag probably isn't really needed, anyway.

(defun convert-section-heads-to-specials ()
  (goto-char (point-min))
  (setq this-file-num 1)

  ;; This is the simple regex that just handles numbered sections.
  ;; (while (re-search-forward "^ *\\([0-9\\.]+\\..*\\)$" nil t)
  ;; This more complex one picks up APPENDIXes, GLOSSARYs, and REFERENCES

  (while (re-search-forward "^\\(    \\)?\\([0-9\\.]+\\..*\\|APPENDIX.*\\|GLOSSARY.*\\|REFERENCES.*\\)$" nil t)
    (setq section-heads
	  (concat section-heads (format "<A HREF=\"%d.html\">" this-file-num)
		  (buffer-substring (match-beginning 2) (match-end 2))
		  "</A>\n"))
    (setq this-file-num (1+ this-file-num))
    (replace-match "<H3>\\2</H3>" t nil)
    (make-HTML-special (match-beginning 0) (point))
    ))

;; convert-pre-blocks-to-specials
;;
;; Find <PRE> blocks (anything that doesn't conform to our idea of
;; a paragraph being uniformly indented)
;;
;; We look ahead for the next paragraph break and the next "strange"
;; line.  If the paragraph break comes first, jump to it's end and repeat.
;; Otherwise, we're at the beginning of a paragraph with "strange"
;; lines in it, so start a <PRE> block and jump forward to the next
;; paragraph break.  Continue so long as the next paragraph
;; is also "strange".  When the next paragraph appears normal,
;; end the <PRE> block and commit it as an HTML special.

(defun convert-pre-blocks-to-specials ()

  (goto-char (point-min))
  (let (para-start strange-start pre-start)
    (while (setq para-start (next-para-start))
      (setq strange-start (next-strange-start))
      (cond ((or (null strange-start)
		 (>= strange-start para-start)) (goto-char para-start))

;;          This code attempts to figure out ULs.  It never works very well.
;;
;;	    ((and (next-UL-item-start)
;;		  (= (point) (next-UL-item-start)))
;;	     (insert "<UL>\n")
;;	     (while (and (next-UL-item-start)
;;			 (= (point) (next-UL-item-start)))
;;	       (if (re-search-forward " - " nil t)
;;		   (replace-match "<LI>" nil nil))
;;	       (goto-char (next-para-start)))
;;	     (insert "</UL>\n\n"))

	    (t (setq pre-start (point))
	       (insert "<PRE>\n")
	       (while (and (setq para-start (next-para-start))
			   (setq strange-start (next-strange-start))
			   (<= strange-start para-start))
		 (goto-char (this-para-end)))
	       (if (null para-start) (goto-char (point-max)))
	       (insert "</PRE>\n")
	       (make-HTML-special pre-start (point))

	       (setq para-start (next-para-start))
	       (if para-start (goto-char para-start))
	       ))
      )) )



(defun fixup-rfc ()
  (interactive)
  (setq HTML-specials nil)
  (setq HTML-special-code 0)
  (setq section-heads "")

  (remove-page-breaks)
  (simplify-vertical-skips)
  (escape-html-special-chars)
      

  ;; Remove all FormFeeds within the header

  (goto-char (point-min))
  (insert "<PRE>\n")
  (while (re-search-forward "\f" nil t)
    (replace-match "" nil nil))
  (insert "</PRE>\n")
  (make-HTML-special (point-min) (point))

  (convert-section-heads-to-specials)
  (convert-pre-blocks-to-specials)

  ;; Insert <P> at all paragraph breaks
  (goto-char (point-min))
  (while (re-search-forward "\n\n+" nil t)
    (replace-match "\n<P>\n" nil nil))

;;  (fixup-by-attributes)

  ;; Insert HTML specials back into the text
  (mapcar 'insert-HTML-special HTML-specials)

  ; (write-html-files)
)

;; This is a function I bind to ^X^H, and turns a line into a header line.
;;
;; A nice extension would be for it to act as toggle, turning a normal
;; line into a header, or a header back into the original line

(defun make-header-line ()
  (interactive)
  (save-excursion
    (beginning-of-line)
    (while (eq (following-char) 32) (delete-char 1))
    (kill-line)
    (insert "<H3>")
    (yank)
    (insert "</H3>")
    (beginning-of-line)
    ))

;; A function I bind to ^X^L, to throw an HREF link around the current line

(defun make-link-line ()
  (interactive)
  (save-excursion
    (beginning-of-line)
    (while (eq (following-char) 32) (forward-char 1))
    (insert "<A HREF=\"1.html\">")
    (end-of-line)
    (insert "</A>")
    ))

(defun make-DL-line ()
  (interactive)
  (save-excursion
    (beginning-of-line)
    (while (eq (following-char) 32) (forward-char 1))
    (insert "<DT>")
    (end-of-line)
    (insert "<DD>\n<P>")
    ))

;;; This is for ASSIGNED NUMBERS RFCs

(defun fixup-assigned-number-rfc ()
  (interactive)

  (remove-page-breaks)
  (simplify-vertical-skips)
  (escape-html-special-chars)

  (goto-char (point-min))
  (while (re-search-forward "\n\\([A-Z][-A-Z0-9/_ ]*\\)\n\n" nil t)
    (replace-match "\n</PRE>\n<H3>\\1</H3>\n<PRE>\n\n" nil nil)
    (backward-char 1) )

  )


;;; These next few are for RFC 1812 and probably wont be of much use for others

(defun fixup-discussion-blocks ()
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "\n<PRE>\n   DISCUSSION\n" nil t)
    (replace-match "\n<DL>\n   <DT>DISCUSSION<DD>\n<P>\n")
    (setq begin-discussion (point))
    (re-search-forward "\n</PRE>\n" nil t)
    (setq end-pre-block (match-beginning 0))
    (goto-char begin-discussion)
    (while (and (re-search-forward "\n\n" nil t)
		(< (match-beginning 0) end-pre-block))
      (replace-match "\n<P>\n") )
    (goto-char begin-discussion)
    (re-search-forward "\n</PRE>\n" nil t)
    (replace-match "\n</DL>\n")
    ))

(defun fixup-o-lists ()
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "\n<PRE>\n   o " nil t)
    (replace-match "\n<UL>\n   <LI> ")
    (setq begin-list (point))
    (re-search-forward "\n</PRE>\n" nil t)
    (setq end-pre-block (match-beginning 0))
    (goto-char begin-list)
    (while (and (re-search-forward "\n   o " nil t)
		(< (match-beginning 0) end-pre-block))
      (replace-match "\n   <LI> ") )
    (goto-char begin-list)
    (while (and (re-search-forward "\n\n" nil t)
		(< (match-beginning 0) end-pre-block))
      (replace-match "\n<P>\n") )
    (goto-char begin-list)
    (re-search-forward "\n</PRE>\n" nil t)
    (replace-match "\n</UL>\n")
    ))

(defun fixup-dash-lists ()
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "\n<PRE>\n       - " nil t)
    (replace-match "\n<UL>\n      <LI> ")
    (setq begin-list (point))
    (re-search-forward "\n</PRE>\n" nil t)
    (setq end-pre-block (match-beginning 0))
    (goto-char begin-list)
    (while (and (re-search-forward "\n       - " nil t)
		(< (match-beginning 0) end-pre-block))
      (replace-match "\n      <LI> ") )
    (goto-char begin-list)
    (while (and (re-search-forward "\n\n" nil t)
		(< (match-beginning 0) end-pre-block))
      (replace-match "\n<P>\n") )
    (goto-char begin-list)
    (re-search-forward "\n</PRE>\n" nil t)
    (replace-match "\n</UL>\n")
    ))

(defun fixup-num-lists ()
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "\n<PRE>\n     1\\. " nil t)
    (replace-match "\n<OL>\n     <LI> ")
    (setq begin-list (point))
    (re-search-forward "\n</PRE>\n" nil t)
    (setq end-pre-block (match-beginning 0))
    (goto-char begin-list)
    (while (and (re-search-forward "\n     [0-9+]\\. " nil t)
		(< (match-beginning 0) end-pre-block))
      (replace-match "\n     <LI> ") )
    (goto-char begin-list)
    (while (and (re-search-forward "\n\n" nil t)
		(< (match-beginning 0) end-pre-block))
      (replace-match "\n<P>\n") )
    (goto-char begin-list)
    (re-search-forward "\n</PRE>\n" nil t)
    (replace-match "\n</OL>\n")
    ))

(defun fixup-letter-lists ()
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "\n<PRE>\n      a) " nil t)
    (replace-match "\n<OL>\n      <LI> ")
    (setq begin-list (point))
    (re-search-forward "\n</PRE>\n" nil t)
    (setq end-pre-block (match-beginning 0))
    (goto-char begin-list)
    (while (and (re-search-forward "\n      [a-z]) " nil t)
		(< (match-beginning 0) end-pre-block))
      (replace-match "\n      <LI> ") )
    (goto-char begin-list)
    (while (and (re-search-forward "\n\n" nil t)
		(< (match-beginning 0) end-pre-block))
      (replace-match "\n<P>\n") )
    (goto-char begin-list)
    (re-search-forward "\n</PRE>\n" nil t)
    (replace-match "\n</OL>\n")
    ))



(global-set-key "" 'make-header-line)
(global-set-key "" 'make-link-line)
(global-set-key "" 'make-DL-line)


;; I find this very useful, but it can be tricky
;; (global-set-key "%" 'query-replace-regexp)



;; This creates an pulldown menu I attach to Cntl-third-button
;;
;; The functions it provides could be greatly expanded
;;
;; Uncomment the "global-set-key" to turn it on

(defvar html-map (make-sparse-keymap "HTML Operations"))
(fset 'html-menu html-map)

(define-key html-map [o-lists]
  '("Fixup o lists" . fixup-o-lists))
(define-key html-map [dash-lists]
  '("Fixup - lists" . fixup-dash-lists))
(define-key html-map [num-lists]
  '("Fixup numbered lists" . fixup-num-lists))
(define-key html-map [letter-lists]
  '("Fixup lettered lists" . fixup-letter-lists))
(define-key html-map [disc-blocks]
  '("Fixup discussion blocks" . fixup-discussion-blocks))

;; (global-set-key [C-down-mouse-3] 'html-menu)
