Mercurial > hg > xemacs-beta
view lisp/hm--html-menus/html-mode.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children |
line wrap: on
line source
;;; html-mode --- Major mode for editing HTML hypertext documents for the WWW ;; Derived from Marc Andreesen's Revision 2.3. ;; Keywords: hypermedia languages help docs wp ;; 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). ;; ;; Changed by Heiko Münkel, 6 Jan 1994, 10 Jan 1994, 15 Mar 1994, 03 Jan 1995 ;; 12 May 1995, 25 May 1995, 29 Jul 1995, 3 Feb 1996 ;; ;; 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. ;; ;;; Commentary: ;; -------------------------------- CONTENTS -------------------------------- ;; ;; html-mode: Major mode for editing HTML hypertext documents. ;; Revision: 2.2 ;; ;; Changes from 2.1 (beta) ;; - Changed previewer for the new Mosaic ;; - Changed lemacs to xemacs ;; ;; 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))) ;; ;; Emacs will detect the ``.html'' suffix and activate html-mode ;; appropriately. ;; ;; 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. ;; ;; 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 C-f html-add-fixed ;; ;; C-c g html-add-img ;; Add an IMG element (inlined image or graphic). Note that the ;; IMG tag is currently an extension to HTML supported only by the ;; NCSA Mosaic browser (to my knowledge). You will be prompted for ;; the URL of the image you wish to inline into the document. ;; ;; 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 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 C-k html-add-keyboard ;; ;; 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 ;; ;; 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 ;; ;; C-c n html-add-numbered-list ;; ;; C-c p html-add-paragraph-separator ;; Use this command at the end of each paragraph. ;; ;; C-c C-p html-add-preformatted ;; ;; 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-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). ;; ;; 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 XEmacs 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. ;; ;; SPECIAL COMMANDS: ;; ;; <, >, & ;; These are overridden to output <, >, and & ;; 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. ;; ;; ---------------------------- ADDITIONAL NOTES ---------------------------- ;; ;; If you are running Epoch or XEmacs, 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| ;; -------------------------------------------------------------------------- ;;; Code: ;; XEmacs change -- we require hm--html-menu here so that we do not ;; have to manually add an autoload for html-mode. If we didn't do ;; this the autoload for html-mode would have to be changed to load ;; hm--html-menu even though it is defined in this file. (require 'hm--html-menu) ;;; ---------------------------- emacs variations ---------------------------- (defvar html-running-xemacs (if (or (string-match "XEmacs" emacs-version) (string-match "Lucid" emacs-version) ) t nil) "Non-nil if running XEmacs.") (defvar html-running-epoch (boundp 'epoch::version) "Non-nil if running Epoch.") (defvar html-running-emacs-19 (and (not html-running-xemacs) (string= (substring emacs-version 0 2) "19")) "Non-nil if running Emacs 19") ;;; ------------------------------- 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 XEmacs; if non-NIL, highlighting will be used. Default is T if you are running Epoch; nil otherwise (for XEmacs, font-lock is better; see html-use-font-lock instead).") (defvar html-use-font-lock (or html-running-xemacs html-running-emacs-19) "*Flag to use font-lock for HTML directives in XEmacs. If non-NIL, font-lock will be used. Default is T if you are running with XEmacs; 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 XEmacs.") (defvar html-emphasize-color "yellow" "*Color for highlighting HTML something-or-others in Epoch or XEmacs.") (defvar html-document-previewer "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.") ;;; --------------------------------- 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) (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-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-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-ct" 'html-add-title) (define-key html-mode-map "\C-cx" 'html-add-plaintext) ;; html-preview-document currently requires the primitive ;; signal-process, which is only in v19 (is it in gnu 19? dunno). (and html-running-xemacs (define-key html-mode-map "\C-cz" 'html-preview-document)) (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) (define-key html-mode-map "\C-c\C-i" 'html-add-italic) (define-key html-mode-map "\C-c\C-k" 'html-add-keyboard) (define-key html-mode-map "\C-c\C-l" 'html-add-listing) (define-key html-mode-map "\C-c\C-m" 'html-add-sample) (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\C-rl" 'html-add-normal-link-to-region) (define-key html-mode-map "\C-c\C-rr" 'html-add-reference-to-region) ) ;;; ------------------------------ 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-xemacs 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-xemacs (defun html-add-zone (start end style) "Add a XEmacs 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-xemacs) 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> ") ;; Point goes right there. (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))) (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) (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 (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. Blah blah." (interactive) (let ((start (point))) (insert "<DL>\n") (html-maybe-deemphasize-region start (1- (point))) (insert "<DT> ") ;; Point goes right there. (save-excursion (insert "\n<DD> \n") (setq start (point)) (insert "</DL>\n") (html-maybe-deemphasize-region start (1- (point))) ;; Reuse start to set mark. (setq start (point))) (push-mark start t))) ;; 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> ") (save-excursion (insert "\n<DD> ")))) ;; C-c C-e (defun html-add-emphasized () (interactive) (html-open-field "EM")) ;; C-c C-f (defun html-add-fixed () (interactive) (html-open-field "TT")) ;; C-c g (defun html-add-img (href) "Add an img." (interactive "sImage URL: ") (let ((start (point))) (insert "<IMG SRC=\"" href "\">") (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 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> "))) ;; 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 " <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) (insert "<TITLE>") (html-maybe-deemphasize-region (point-min) (1- (point))) (insert title) (insert "</TITLE>") (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 "<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))))) ;;; -------------------------------------------------------------------------- ;;; ---------------------------- 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 XEmacs 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/Mosaic.%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'. 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) (if hm--html-use-old-keymap (use-local-map html-mode-map) (use-local-map hm--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) ;;; -------------------------- xemacs menubar setup --------------------------- (if (or html-running-xemacs html-running-emacs-19) (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) (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.") (defun html-fontify () (font-lock-mode 1) (make-local-variable 'font-lock-keywords) (setq font-lock-keywords html-font-lock-keywords) ; The following line was needed in older versions of font-lock.el ; (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)
