")))
;; C-c C-i
(defun html-add-italic ()
(interactive)
(html-open-field "I"))
;; C-c C-k
(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
(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
(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)
(let ((start (point)))
(insert " ")
(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 "
")
(save-excursion
(forward-char 7)
(re-search-forward "[^<]*"
(save-excursion (end-of-line) (point))
t)))
;; Plop the new title in its place.
(replace-match title t)
(insert "")
(html-maybe-deemphasize-region (point-min) (1- (point)))
(insert title)
(insert "")
(html-maybe-deemphasize-region (- (point) 7) (point))
(insert "\n"))))
;; C-c C-v
(defun html-add-variable ()
(interactive)
(html-open-field "VAR"))
;; C-c x
(defun html-add-plaintext ()
"Add plaintext."
(interactive)
(html-open-area "XMP"))
;;; --------------------------------------------------------------------------
;;; ---------------------------- 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 "")
(html-maybe-deemphasize-region start (1- (point))))
(insert "")
(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 "")
(html-maybe-deemphasize-region start (1- (point))))
(insert "")
(html-maybe-deemphasize-region (- (point) 3) (point)))))
;;; --------------------------------------------------------------------------
;;; ---------------------------- special commands ----------------------------
;;; --------------------------------------------------------------------------
(defun html-less-than ()
(interactive)
(insert "<"))
(defun html-greater-than ()
(interactive)
(insert ">"))
(defun html-ampersand ()
(interactive)
(insert "&"))
(defun html-real-less-than ()
(interactive)
(insert "<"))
(defun html-real-greater-than ()
(interactive)
(insert ">"))
(defun html-real-ampersand ()
(interactive)
(insert "&"))
;;; --------------------------------------------------------------------------
;;; --------------------------- 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 to ."
(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 --------------------------------
;;;###autoload
(defun html-mode ()
"Major mode for editing HTML hypertext documents. Special commands:\\{html-mode-map}
Turning on html-mode calls the value of the variable html-mode-hook,
if that value is non-nil.
More extensive documentation is available in the file 'html-mode.el'.
The latest (possibly unstable) version of this file will always be available
on anonymous FTP server ftp.ncsa.uiuc.edu in /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)
(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 (rassq 'html-mode auto-mode-alist) ;jwz
(setq auto-mode-alist (cons '("\\.html\\'" . html-mode) auto-mode-alist)))
(provide 'html-mode)