Mercurial > hg > xemacs-beta
comparison lisp/psgml/psgml-html.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | ac2d302a0011 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; psgml-html.el --- HTML mode in conjunction with PSGML | |
| 2 | |
| 3 ;; Copyright (C) 1994 Nelson Minar. | |
| 4 ;; Copyright (C) 1995 Nelson Minar and Ulrik Dickow. | |
| 5 ;; Copyright (C) 1996 Ben Wing. | |
| 6 | |
| 7 ;; This file is part of XEmacs. | |
| 8 | |
| 9 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 10 ;; under the terms of the GNU General Public License as published by | |
| 11 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 12 ;; any later version. | |
| 13 | |
| 14 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 17 ;; General Public License for more details. | |
| 18 | |
| 19 ;; You should have received a copy of the GNU General Public License | |
| 20 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 22 | |
| 23 ;;; Synched up with: FSF 19.30. | |
| 24 | |
| 25 ;;; Author: Ben Wing. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ; Parts were taken from html-helper-mode and from code by Alastair Burt. | |
| 30 | |
| 31 ;;; Code: | |
| 32 | |
| 33 (require 'psgml) | |
| 34 (require 'derived) | |
| 35 (require 'iso-sgml) | |
| 36 (require 'tempo) ;essential part of html-helper-mode | |
| 37 | |
| 38 ;;{{{ user variables | |
| 39 | |
| 40 ;; Set this to be whatever signature you want on the bottom of your pages. | |
| 41 (defvar html-helper-address-string | |
| 42 (concat "<a href=\"mailto:" user-mail-address "\">" | |
| 43 (user-full-name) "</a>") | |
| 44 "*The default author string of each file.") | |
| 45 | |
| 46 (defvar html-helper-htmldtd-version "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">\n" | |
| 47 "*Version of HTML DTD you're using.") | |
| 48 | |
| 49 (defvar html-helper-do-write-file-hooks t | |
| 50 "*If not nil, then modify `local-write-file-hooks' to do timestamps.") | |
| 51 | |
| 52 (defvar html-helper-build-new-buffer t | |
| 53 "*If not nil, then insert `html-helper-new-buffer-strings' for new buffers.") | |
| 54 | |
| 55 (defvar html-helper-timestamp-hook 'html-helper-default-insert-timestamp | |
| 56 "*Hook called for timestamp insertion. | |
| 57 Override this for your own timestamp styles.") | |
| 58 | |
| 59 ;; strings you might want to change | |
| 60 | |
| 61 (defvar html-helper-new-buffer-template | |
| 62 '(html-helper-htmldtd-version | |
| 63 "<html>\n" | |
| 64 " <head>\n" | |
| 65 " <title>" (p "Document Title: " title) "</title>\n" | |
| 66 " </head>\n" | |
| 67 "\n" | |
| 68 " <body>\n" | |
| 69 " <h1>" (s title) "</h1>\n\n" | |
| 70 p | |
| 71 "\n\n <hr>\n" | |
| 72 " <address>" html-helper-address-string "</address>\n" | |
| 73 (html-helper-return-created-string) | |
| 74 html-helper-timestamp-start | |
| 75 html-helper-timestamp-end | |
| 76 "\n </body>\n</html>\n") | |
| 77 "*Template for new buffers. | |
| 78 Inserted by `html-helper-insert-new-buffer-strings' if | |
| 79 `html-helper-build-new-buffer' is set to t") | |
| 80 | |
| 81 (defvar html-helper-timestamp-start "<!-- hhmts start -->\n" | |
| 82 "*Start delimiter for timestamps. | |
| 83 Everything between `html-helper-timestamp-start' and | |
| 84 `html-helper-timestamp-end' will be deleted and replaced with the output | |
| 85 of the functions `html-helper-timestamp-hook' if | |
| 86 `html-helper-do-write-file-hooks' is t") | |
| 87 | |
| 88 (defvar html-helper-timestamp-end "<!-- hhmts end -->" | |
| 89 "*End delimiter for timestamps. | |
| 90 Everything between `html-helper-timestamp-start' and | |
| 91 `html-helper-timestamp-end' will be deleted and replaced with the output | |
| 92 of the function `html-helper-insert-timestamp' if | |
| 93 `html-helper-do-write-file-hooks' is t") | |
| 94 | |
| 95 ;; control over what types of tags to load. By default, we load all the | |
| 96 ;; ones we know of. | |
| 97 | |
| 98 (defvar html-helper-types-to-install | |
| 99 '(anchor header logical phys list textel entity image head form) | |
| 100 "*List of tag types to install when html-helper-mode is first loaded. | |
| 101 If you want to not install some type of tag, override this variable. | |
| 102 Order is significant: menus go in this order.") | |
| 103 | |
| 104 ;;}}} end of user variables | |
| 105 ;;{{{ type based keymap and menu variable and function setup | |
| 106 | |
| 107 ;; html-helper-mode has a concept of "type" of tags. Each type is a | |
| 108 ;; list of tags that all go together in one keymap and one menu. | |
| 109 ;; Types can be added to the system after html-helper has been loaded, | |
| 110 ;; briefly by doing html-helper-add-type-to-alist, then | |
| 111 ;; html-helper-install-type, then html-helper-add-tag (for each tag) | |
| 112 ;; then html-helper-rebuild-menu. See the mode documentation for more detail. | |
| 113 | |
| 114 (defconst html-helper-type-alist nil | |
| 115 "Alist: type of tag -> keymap, keybinding, menu, menu string. | |
| 116 Add to this with `html-helper-add-type-to-alist'.") | |
| 117 | |
| 118 ;;{{{ accessor functions for html-helper-type-alist | |
| 119 | |
| 120 (defun html-helper-keymap-for (type) | |
| 121 "Accessor function for alist: for type, return keymap or nil" | |
| 122 (nth 0 (cdr-safe (assq type html-helper-type-alist)))) | |
| 123 | |
| 124 (defun html-helper-key-for (type) | |
| 125 "Accessor function for alist: for type, return keybinding or nil" | |
| 126 (nth 1 (cdr-safe (assq type html-helper-type-alist)))) | |
| 127 | |
| 128 (defun html-helper-menu-for (type) | |
| 129 "Accessor function for alist: for type, return menu or nil" | |
| 130 (nth 2 (cdr-safe (assq type html-helper-type-alist)))) | |
| 131 | |
| 132 (defun html-helper-menu-string-for (type) | |
| 133 "Accessor function for alist: for type, return menustring or nil" | |
| 134 (nth 3 (cdr-safe (assq type html-helper-type-alist)))) | |
| 135 | |
| 136 (defun html-helper-normalized-menu-for (type) | |
| 137 "Helper function for building menus from submenus: add on string to menu." | |
| 138 (cons (html-helper-menu-string-for type) | |
| 139 (eval (html-helper-menu-for type)))) | |
| 140 | |
| 141 ;;}}} | |
| 142 | |
| 143 (define-derived-mode html-mode sgml-mode "HTML" | |
| 144 "Major mode for editing HTML documents. | |
| 145 This is based on PSGML mode, and has a sophisticated SGML parser in it. | |
| 146 It knows how to properly indent HTML/SGML documents, and it can do | |
| 147 a form of document validation (use \\[sgml-next-trouble-spot\\] to find | |
| 148 the next error in your document). | |
| 149 Commands beginning with C-z insert various types of HTML tags | |
| 150 (prompting for the required information); to iconify or suspend, | |
| 151 use C-z C-z. | |
| 152 To literally insert special characters such as < and &, use C-c followed | |
| 153 by the character. | |
| 154 Use \\[sgml-insert-end-tag] to insert the proper closing tag. | |
| 155 Use \\[sgml-edit-attributes] to edit the attributes for a tag. | |
| 156 Use \\[sgml-show-context] to show the current HTML context. | |
| 157 | |
| 158 More specifically: | |
| 159 \\{html-mode-map} | |
| 160 " | |
| 161 (make-local-variable 'sgml-declaration) | |
| 162 (make-local-variable 'sgml-default-doctype-name) | |
| 163 (setq sgml-declaration (expand-file-name "html.decl" | |
| 164 sgml-data-directory) | |
| 165 sgml-default-doctype-name "html" | |
| 166 sgml-always-quote-attributes t | |
| 167 sgml-indent-step 2 | |
| 168 sgml-indent-data t | |
| 169 sgml-inhibit-indent-tags '("pre") | |
| 170 sgml-minimize-attributes nil | |
| 171 sgml-omittag t | |
| 172 sgml-shortag t) | |
| 173 | |
| 174 ;; font-lock setup for various emacsen: XEmacs, Emacs 19.29+, Emacs <19.29. | |
| 175 ;; By Ulrik Dickow <dickow@nbi.dk>. (Last update: 05-Sep-1995). | |
| 176 (cond ((string-match "XEmacs\\|Lucid" (emacs-version)) ; XEmacs/Lucid | |
| 177 (put major-mode 'font-lock-keywords-case-fold-search t)) | |
| 178 ;; XEmacs (19.13, at least) guesses the rest correctly. | |
| 179 ;; If any older XEmacsen don't, then tell me. | |
| 180 ;; | |
| 181 ((string-lessp "19.28.89" emacs-version) ; Emacs 19.29 and later | |
| 182 (make-local-variable 'font-lock-defaults) | |
| 183 (setq font-lock-defaults '(html-font-lock-keywords t t))) | |
| 184 ;; | |
| 185 (t ; Emacs 19.28 and older | |
| 186 (make-local-variable 'font-lock-keywords-case-fold-search) | |
| 187 (make-local-variable 'font-lock-keywords) | |
| 188 (make-local-variable 'font-lock-no-comments) | |
| 189 (setq font-lock-keywords-case-fold-search t) | |
| 190 (setq font-lock-keywords html-font-lock-keywords) | |
| 191 (setq font-lock-no-comments t))) | |
| 192 | |
| 193 (if html-helper-do-write-file-hooks | |
| 194 (add-hook 'local-write-file-hooks 'html-helper-update-timestamp)) | |
| 195 | |
| 196 (if (and html-helper-build-new-buffer (zerop (buffer-size))) | |
| 197 (html-helper-insert-new-buffer-strings)) | |
| 198 | |
| 199 (set (make-local-variable 'sgml-custom-markup) | |
| 200 '(("<A>" "<A HREF=\"\">\r</a>"))) | |
| 201 ; sigh ... need to call this now to get things working. | |
| 202 (sgml-build-custom-menus) | |
| 203 (add-submenu nil sgml-html-menu "SGML") | |
| 204 (delete-menu-item '("SGML"))) | |
| 205 | |
| 206 (defun html-helper-add-type-to-alist (type) | |
| 207 "Add a type specification to the alist. | |
| 208 The spec goes (type . (keymap-symbol keyprefix menu-symbol menu-string)). | |
| 209 See code for an example." | |
| 210 (setq html-helper-type-alist (cons type html-helper-type-alist))) | |
| 211 | |
| 212 ;; Here are the types provided by html-helper-mode. | |
| 213 (mapcar 'html-helper-add-type-to-alist | |
| 214 '((entity . (nil nil html-helper-entity-menu "Insert Character Entities")) | |
| 215 (textel . (nil nil html-helper-textel-menu "Insert Text Elements")) | |
| 216 (head . (html-helper-head-map "\C-zb" html-helper-head-menu "Insert Structural Elements")) | |
| 217 (header . (html-helper-base-map "\C-z" html-helper-header-menu "Insert Headers")) | |
| 218 (anchor . (html-helper-base-map "\C-z" html-helper-anchor-menu "Insert Hyperlinks")) | |
| 219 (logical . (html-helper-base-map "\C-z" html-helper-logical-menu "Insert Logical Styles")) | |
| 220 (phys . (html-helper-base-map "\C-z" html-helper-phys-menu "Insert Physical Styles")) | |
| 221 (list . (html-helper-list-map "\C-zl" html-helper-list-menu "Insert List Elements")) | |
| 222 (form . (html-helper-form-map "\C-zf" html-helper-form-menu "Insert Form Elements")) | |
| 223 (image . (html-helper-image-map "\C-zm" html-helper-image-menu "Insert Inlined Images")))) | |
| 224 | |
| 225 ;; Once html-helper-mode is aware of a type, it can then install the | |
| 226 ;; type: arrange for keybindings, menus, etc. | |
| 227 | |
| 228 (defconst html-helper-installed-types nil | |
| 229 "The types that have been installed (used when building menus). | |
| 230 There is no support for removing a type once it has been installed.") | |
| 231 | |
| 232 (defun html-helper-install-type (type) | |
| 233 "Install a new tag type: add it to the keymap, menu structures, etc. | |
| 234 For this to work, the type must first have been added to the list of types | |
| 235 with html-helper-add-type-to-alist." | |
| 236 (setq html-helper-installed-types (cons type html-helper-installed-types)) | |
| 237 (let ((keymap (html-helper-keymap-for type)) | |
| 238 (key (html-helper-key-for type)) | |
| 239 (menu (html-helper-menu-for type)) | |
| 240 (menu-string (html-helper-menu-string-for type))) | |
| 241 (and key | |
| 242 (progn | |
| 243 (set keymap nil) | |
| 244 (define-prefix-command keymap) | |
| 245 (define-key html-mode-map key keymap))) | |
| 246 (and menu | |
| 247 (progn | |
| 248 (set menu nil))))) | |
| 249 | |
| 250 ;; install the default types. | |
| 251 (mapcar 'html-helper-install-type html-helper-types-to-install) | |
| 252 | |
| 253 ;;}}} | |
| 254 | |
| 255 ;;{{{ html-helper-add-tag function for building basic tags | |
| 256 | |
| 257 (defvar html-helper-tempo-tags nil | |
| 258 "List of tags used in completion.") | |
| 259 | |
| 260 ;; this while loop is awfully Cish | |
| 261 ;; isn't there an emacs lisp function to do this? | |
| 262 (defun html-helper-string-to-symbol (input-string) | |
| 263 "Given a string, downcase it and replace spaces with -. | |
| 264 We use this to turn menu entries into good symbols for functions. | |
| 265 It's not entirely successful, but fortunately emacs lisp is forgiving." | |
| 266 (let* ((s (copy-sequence input-string)) | |
| 267 (l (1- (length s)))) | |
| 268 (while (> l 0) | |
| 269 (if (char-equal (aref s l) ?\ ) | |
| 270 (aset s l ?\-)) | |
| 271 (setq l (1- l))) | |
| 272 (concat "html-" (downcase s)))) | |
| 273 | |
| 274 | |
| 275 (defun html-helper-add-tag (l) | |
| 276 "Add a new tag to html-helper-mode. | |
| 277 Builds a tempo-template for the tag and puts it into the | |
| 278 appropriate keymap if a key is requested. Format: | |
| 279 `(html-helper-add-tag '(type keybinding completion-tag menu-name template doc)'" | |
| 280 (let* ((type (car l)) | |
| 281 (keymap (html-helper-keymap-for type)) | |
| 282 (menu (html-helper-menu-for type)) | |
| 283 (key (nth 1 l)) | |
| 284 (completer (nth 2 l)) | |
| 285 (name (nth 3 l)) | |
| 286 (tag (nth 4 l)) | |
| 287 (doc (nth 5 l)) | |
| 288 (command (tempo-define-template (html-helper-string-to-symbol name) | |
| 289 tag completer doc | |
| 290 'html-helper-tempo-tags))) | |
| 291 | |
| 292 (if (null (memq type html-helper-installed-types)) ;type loaded? | |
| 293 t ;no, do nothing. | |
| 294 (if (stringp key) ;bind key somewhere? | |
| 295 (if keymap ;special keymap? | |
| 296 (define-key (eval keymap) key command) ;t: bind to prefix | |
| 297 (define-key html-mode-map key command)) ;nil: bind to global | |
| 298 t) | |
| 299 (if menu ;is there a menu? | |
| 300 (set menu ;good, cons it in | |
| 301 (cons (vector name command t) (eval menu)))) | |
| 302 ))) | |
| 303 | |
| 304 ;;}}} | |
| 305 | |
| 306 ;;{{{ most of the HTML tags | |
| 307 | |
| 308 ;; These tags are an attempt to be HTML/2.0 compliant, with the exception | |
| 309 ;; of container <p>, <li>, <dd>, <dt> (we adopt 3.0 behaviour). | |
| 310 ;; For reference see <URL:http://www.w3.org/hypertext/WWW/MarkUp/MarkUp.html> | |
| 311 | |
| 312 ;; order here is significant: within a tag type, menus and mode help | |
| 313 ;; go in the reverse order of what you see here. Sorry about that, it's | |
| 314 ;; not easy to fix. | |
| 315 | |
| 316 (mapcar | |
| 317 'html-helper-add-tag | |
| 318 '( | |
| 319 ;;entities | |
| 320 (entity "\C-c#" "&#" "Ascii Code" ("&#" (r "Ascii: ") ";")) | |
| 321 (entity "\C-c\"" """ "Quotation mark" (""")) | |
| 322 (entity "\C-c$" "®" "Registered" ("®")) | |
| 323 (entity "\C-c@" "©" "Copyright" ("©")) | |
| 324 (entity "\C-c-" "­" "Soft Hyphen" ("­")) | |
| 325 (entity "\C-c " " " "Nonbreaking Space" (" ")) | |
| 326 (entity "\C-c&" "&" "Ampersand" ("&")) | |
| 327 (entity "\C-c>" ">" "Greater Than" (">")) | |
| 328 (entity "\C-c<" "<" "Less Than" ("<")) | |
| 329 | |
| 330 ;; logical styles | |
| 331 (logical "q" "<blockquote>" "Blockquote" ("<blockquote>" (r "Quote: ") "</blockquote>")) | |
| 332 (logical "c" "<code>" "Code" ("<code>" (r "Code: ") "</code>")) | |
| 333 (logical "x" "<samp>" "Sample" ("<samp>" (r "Sample code") "</samp>")) | |
| 334 (logical "r" "<cite>" "Citation" ("<cite>" (r "Citation: ") "</cite>")) | |
| 335 (logical "k" "<kbd>" "Keyboard Input" ("<kbd>" (r "Keyboard: ") "</kbd>")) | |
| 336 (logical "v" "<var>" "Variable" ("<var>" (r "Variable: ") "</var>")) | |
| 337 (logical "d" "<dfn>" "Definition" ("<dfn>" (r "Definition: ") "</dfn>")) | |
| 338 (logical "a" "<address>" "Address" ("<address>" r "</address>")) | |
| 339 (logical "e" "<em>" "Emphasized" ("<em>" (r "Text: ") "</em>")) | |
| 340 (logical "s" "<strong>" "Strong" ("<strong>" (r "Text: ") "</strong>")) | |
| 341 (logical "p" "<pre>" "Preformatted" ("<pre>" (r "Text: ") "</pre>")) | |
| 342 | |
| 343 ;;physical styles | |
| 344 (phys "-" "<strike>" "Strikethru" ("<strike>" (r "Text: ") "</strike>")) | |
| 345 (phys "u" "<u>" "Underline" ("<u>" (r "Text: ") "</u>")) | |
| 346 (phys "o" "<i>" "Italic" ("<i>" (r "Text: ") "</i>")) | |
| 347 (phys "b" "<b>" "Bold" ("<b>" (r "Text: ") "</b>")) | |
| 348 (phys "t" "<tt>" "Fixed" ("<tt>" (r "Text: ") "</tt>")) | |
| 349 | |
| 350 ;;headers | |
| 351 (header "6" "<h6>" "Header 6" ("<h6>" (r "Header: ") "</h6>")) | |
| 352 (header "5" "<h5>" "Header 5" ("<h5>" (r "Header: ") "</h5>")) | |
| 353 (header "4" "<h4>" "Header 4" ("<h4>" (r "Header: ") "</h4>")) | |
| 354 (header "3" "<h3>" "Header 3" ("<h3>" (r "Header: ") "</h3>")) | |
| 355 (header "2" "<h2>" "Header 2" ("<h2>" (r "Header: ") "</h2>")) | |
| 356 (header "1" "<h1>" "Header 1" ("<h1>" (r "Header: ") "</h1>")) | |
| 357 | |
| 358 ;; forms | |
| 359 (form "o" "<option>" "Option" (& "<option>" > )) | |
| 360 (form "v" "<option value" "Option with Value" (& "<option value=\"" (r "Value: ") "\">" >)) | |
| 361 (form "s" "<select" "Selections" ("<select name=\"" (p "Name: ") "\">\n<option>" > "\n</select>")"<select") | |
| 362 (form "z" "<input" "Reset Form" ("<input type=\"RESET\" value=\"" (p "Reset button text: ") "\">")) | |
| 363 (form "b" "<input" "Submit Form" ("<input type=\"SUBMIT\" value=\"" (p "Submit button text: ") "\">")) | |
| 364 (form "i" "<input" "Image Field" ("<input type=\"IMAGE\" name=\"" (p "Name: ") "\" src=\"" (p "Image URL: ") "\">")) | |
| 365 (form "h" "<input" "Hidden Field" ("<input type=\"HIDDEN\" name=\"" (p "Name: ") "\" value=\"" (p "Value: ") "\">")) | |
| 366 (form "p" "<textarea" "Text Area" ("<textarea name=\"" (p "Name: ") "\" rows=\"" (p "Rows: ") "\" cols=\"" (p "Columns: ") "\">" r "</textarea>")) | |
| 367 (form "c" "<input" "Checkbox" ("<input type=\"CHECKBOX\" name=\"" (p "Name: ") "\">")) | |
| 368 (form "r" "<input" "Radiobutton" ("<input type=\"RADIO\" name=\"" (p "Name: ") "\">")) | |
| 369 (form "t" "<input" "Text Field" ("<input type=\"TEXT\" name=\"" (p "Name: ") "\" size=\"" (p "Size: ") "\">")) | |
| 370 (form "f" "<form" "Form" ("<form action=\"" (p "Action: ") "\" method=\"" (p "Method: ") "\">\n</form>\n")) | |
| 371 | |
| 372 ;;lists | |
| 373 (list "t" "<dt>" "Definition Item" (& "<dt>" > (p "Term: ") "\n<dd>" > (r "Definition: "))) | |
| 374 (list "l" "<li>" "List Item" (& "<li>" > (r "Item: "))) | |
| 375 (list "r" "<dir>" "DirectoryList" (& "<dir>" > "\n<li>" > (r "Item: ") "\n</dir>" >)) | |
| 376 (list "m" "<menu>" "Menu List" (& "<menu>" > "\n<li>" > (r "Item: ") "\n</menu>" >)) | |
| 377 (list "o" "<ol>" "Ordered List" (& "<ol>" > "\n<li>" > (r "Item: ") "\n</ol>" >)) | |
| 378 (list "d" "<dl>" "Definition List" (& "<dl>" > "\n<dt>" > (p "Term: ") "\n<dd>" > (r "Definition: ") "\n</dl>" >)) | |
| 379 (list "u" "<ul>" "Unordered List" (& "<ul>" > "\n<li>" > (r "Item: ") "\n</ul>" >)) | |
| 380 | |
| 381 ;;anchors | |
| 382 (anchor "n" "<a name=" "Link Target" ("<a name=\"" (p "Anchor name: ") "\">" (r "Anchor text: ") "</a>")) | |
| 383 (anchor "h" "<a href=" "Hyperlink" ("<a href=\"" (p "URL: ") "\">" (r "Anchor text: ") "</a>")) | |
| 384 | |
| 385 ;;graphics | |
| 386 (image "a" nil "Aligned Image" ("<img align=\"" (r "Alignment: ") "\" src=\"" (r "Image URL: ") "\">")) | |
| 387 (image "i" "<img src=" "Image" ("<img src=\"" (r "Image URL: ") "\">")) | |
| 388 (image "e" "<img align=" "Aligned Image With Alt. Text" ("<img align=\"" (r "Alignment: ") "\" src=\"" (r "Image URL: ") "\" alt=\"" (r "Text URL: ") "\">")) | |
| 389 (image "t" "<img alt=" "Image With Alternate Text" ("<img alt=\"" (r "Text URL: ") "\" src=\"" (r "Image URL: ") "\">")) | |
| 390 | |
| 391 ;;text elements | |
| 392 (textel "\C-c=" nil "Horizontal Line" (& "<hr>\n")) | |
| 393 (textel "\C-c\C-m" nil "Line Break" ("<br>\n")) | |
| 394 (textel "\e\C-m" nil "Paragraph" ("<p>" (progn (sgml-indent-line) nil) "\n")) | |
| 395 | |
| 396 ;;head elements | |
| 397 (head "H" "<head>" "Head" ("<head>\n" "</head>\n")) | |
| 398 (head "B" "<body>" "Body" ("<body>\n" "</body>\n")) | |
| 399 (head "i" "<isindex>" "Isindex" ("<isindex>\n")) | |
| 400 (head "n" "<nextid>" "Nextid" ("<nextid>\n")) | |
| 401 (head "h" "<meta http-equiv=" "HTTP Equivalent" ("<meta http-equiv=\"" (p "Equivalent: ") "\" content=\"" (r "Content: ") "\">\n")) | |
| 402 (head "m" "<meta name=" "Meta Name" ("<meta name=\"" (p "Name: ") "\" content=\"" (r "Content: ") "\">\n")) | |
| 403 (head "l" "<link" "Link" ("<link href=\"" p "\">")) | |
| 404 (head "b" "<base" "Base" ("<base href=\"" r "\">")) | |
| 405 (head "t" "<title>" "Title" ("<title>" (r "Document title: ") "</title>")) | |
| 406 )) | |
| 407 | |
| 408 ;;}}} | |
| 409 ;;{{{ html-helper-smart-insert-item | |
| 410 | |
| 411 ;; there are two different kinds of items in HTML - those in regular | |
| 412 ;; lists <li> and those in dictionaries <dt>..<dd> | |
| 413 ;; This command will insert the appropriate one depending on context. | |
| 414 | |
| 415 (defun html-helper-smart-insert-item (&optional arg) | |
| 416 "Insert a new item, either in a regular list or a dictionary." | |
| 417 (interactive "*P") | |
| 418 (let ((case-fold-search t)) | |
| 419 (if | |
| 420 (save-excursion | |
| 421 (re-search-backward "<li>\\|<dt>\\|<ul>\\|<ol>\\|<dd>\\|<menu>\\|<dir>\\|<dl>" nil t) | |
| 422 (looking-at "<dt>\\|<dl>\\|<dd>")) | |
| 423 (tempo-template-html-definition-item arg) | |
| 424 (tempo-template-html-list-item arg)))) | |
| 425 | |
| 426 ;; special keybindings in the prefix maps (not in the list of tags) | |
| 427 (and (boundp 'html-helper-base-map) | |
| 428 (define-key html-helper-base-map "i" 'html-helper-smart-insert-item)) | |
| 429 | |
| 430 (define-key html-mode-map "\C-z\C-z" 'suspend-or-iconify-emacs) | |
| 431 (define-key html-mode-map "\C-zg" 'html-insert-mailto-reference-from-click) | |
| 432 | |
| 433 ;; and, special menu bindings | |
| 434 (and (boundp 'html-helper-list-menu) | |
| 435 (setq html-helper-list-menu | |
| 436 (cons '["List Item" html-helper-smart-insert-item t] html-helper-list-menu))) | |
| 437 | |
| 438 ;;}}} | |
| 439 ;;{{{ patterns for font-lock | |
| 440 | |
| 441 ; Old patterns from html-mode.el | |
| 442 ;(defvar html-font-lock-keywords | |
| 443 ; (list | |
| 444 ; '("\\(<[^>]*>\\)+" . font-lock-comment-face) | |
| 445 ; '("[Hh][Rr][Ee][Ff]=\"\\([^\"]*\\)\"" 1 font-lock-string-face t) | |
| 446 ; '("[Ss][Rr][Cc]=\"\\([^\"]*\\)\"" 1 font-lock-string-face t)) | |
| 447 ; "Patterns to highlight in HTML buffers.") | |
| 448 | |
| 449 ;; By Ulrik Dickow <dickow@nbi.dk>. | |
| 450 ;; | |
| 451 ;; Originally aimed at Emacs 19.29. Later on disabled syntactic fontification | |
| 452 ;; and reordered regexps completely, to be compatible with XEmacs (it doesn't | |
| 453 ;; understand OVERRIDE=`keep'). | |
| 454 ;; | |
| 455 ;; We make an effort on handling nested tags intelligently. | |
| 456 | |
| 457 ;; font-lock compatibility with XEmacs/Lucid and older Emacsen (<19.29). | |
| 458 ;; | |
| 459 (if (string-match "XEmacs\\|Lucid" (emacs-version)) | |
| 460 ;; XEmacs/Lucid | |
| 461 ;; Make needed faces if the user hasn't already done so. | |
| 462 ;; Respect X resources (`make-face' uses them when they exist). | |
| 463 (let ((change-it | |
| 464 (function (lambda (face) | |
| 465 (or (if (fboundp 'facep) | |
| 466 (facep face) | |
| 467 (memq face (face-list))) | |
| 468 (make-face face)) | |
| 469 (not (face-differs-from-default-p face)))))) | |
| 470 (if (funcall change-it 'html-helper-bold-face) | |
| 471 (copy-face 'bold 'html-helper-bold-face)) | |
| 472 (if (funcall change-it 'html-helper-italic-face) | |
| 473 (copy-face 'italic 'html-helper-italic-face)) | |
| 474 (if (funcall change-it 'html-helper-underline-face) | |
| 475 (set-face-underline-p 'html-helper-underline-face t)) | |
| 476 (if (funcall change-it 'font-lock-variable-name-face) | |
| 477 (set-face-foreground 'font-lock-variable-name-face "salmon")) | |
| 478 (if (funcall change-it 'font-lock-reference-face) | |
| 479 (set-face-foreground 'font-lock-reference-face "violet"))) | |
| 480 ;; Emacs (any version) | |
| 481 ;; | |
| 482 ;; Note that Emacs evaluates the face entries in `font-lock-keywords', | |
| 483 ;; while XEmacs doesn't. So XEmacs doesn't use the following *variables*, | |
| 484 ;; but instead the faces with the same names as the variables. | |
| 485 (defvar html-helper-bold-face 'bold | |
| 486 "Face used as bold. Typically `bold'.") | |
| 487 (defvar html-helper-italic-face 'italic | |
| 488 "Face used as italic. Typically `italic'.") | |
| 489 (defvar html-helper-underline-face 'underline | |
| 490 "Face used as underline. Typically `underline'.") | |
| 491 ;; | |
| 492 (if (string-lessp "19.28.89" emacs-version) | |
| 493 () ; Emacs 19.29 and later | |
| 494 ;; Emacs 19.28 and older | |
| 495 ;; Define face variables that don't exist until Emacs 19.29. | |
| 496 (defvar font-lock-variable-name-face 'font-lock-doc-string-face | |
| 497 "Face to use for variable names -- and some HTML keywords.") | |
| 498 (defvar font-lock-reference-face 'underline ; Ugly at line breaks | |
| 499 "Face to use for references -- including HTML hyperlink texts."))) | |
| 500 | |
| 501 (defvar html-font-lock-keywords | |
| 502 (let (;; Titles and H1's, like function defs. | |
| 503 ;; We allow for HTML 3.0 attributes, like `<h1 align=center>'. | |
| 504 (tword "\\(h1\\|title\\)\\([ \t\n]+[^>]+\\)?") | |
| 505 ;; Names of tags to boldify. | |
| 506 (bword "\\(b\\|h[2-4]\\|strong\\)\\([ \t\n]+[^>]+\\)?") | |
| 507 ;; Names of tags to italify. | |
| 508 (iword "\\(address\\|cite\\|em\\|i\\|var\\)\\([ \t\n]+[^>]+\\)?") | |
| 509 ;; Regexp to match shortest sequence that surely isn't a bold end. | |
| 510 ;; We simplify a bit by extending "</strong>" to "</str.*". | |
| 511 ;; Do similarly for non-italic and non-title ends. | |
| 512 (not-bend (concat "\\([^<]\\|<\\([^/]\\|/\\([^bhs]\\|" | |
| 513 "b[^>]\\|" | |
| 514 "h\\([^2-4]\\|[2-4][^>]\\)\\|" | |
| 515 "s\\([^t]\\|t[^r]\\)\\)\\)\\)")) | |
| 516 (not-iend (concat "\\([^<]\\|<\\([^/]\\|/\\([^aceiv]\\|" | |
| 517 "a\\([^d]\\|d[^d]\\)\\|" | |
| 518 "c\\([^i]\\|i[^t]\\)\\|" | |
| 519 "e\\([^m]\\|m[^>]\\)\\|" | |
| 520 "i[^>]\\|" | |
| 521 "v\\([^a]\\|a[^r]\\)\\)\\)\\)")) | |
| 522 (not-tend (concat "\\([^<]\\|<\\([^/]\\|/\\([^ht]\\|" | |
| 523 "h[^1]\\|t\\([^i]\\|i[^t]\\)\\)\\)\\)"))) | |
| 524 (list ; Avoid use of `keep', since XEmacs will treat it the same as `t'. | |
| 525 ;; First fontify the text of a HREF anchor. It may be overridden later. | |
| 526 ;; Anchors in headings will be made bold, for instance. | |
| 527 '("<a\\s-+href[^>]*>\\([^>]+\\)</a>" | |
| 528 1 font-lock-reference-face t) | |
| 529 ;; Tag pairs like <b>...</b> etc. | |
| 530 ;; Cunning repeated fontification to handle common cases of overlap. | |
| 531 ;; Bold complex --- possibly with arbitrary other non-bold stuff inside. | |
| 532 (list (concat "<" bword ">\\(" not-bend "*\\)</\\1>") | |
| 533 3 'html-helper-bold-face t) | |
| 534 ;; Italic complex --- possibly with arbitrary non-italic kept inside. | |
| 535 (list (concat "<" iword ">\\(" not-iend "*\\)</\\1>") | |
| 536 3 'html-helper-italic-face t) | |
| 537 ;; Bold simple --- first fontify bold regions with no tags inside. | |
| 538 (list (concat "<" bword ">\\(" "[^<]" "*\\)</\\1>") | |
| 539 3 'html-helper-bold-face t) | |
| 540 ;; Any tag, general rule, just after bold/italic stuff. | |
| 541 '("\\(<[^>]*>\\)" 1 font-lock-type-face t) | |
| 542 ;; Titles and level 1 headings (anchors do sometimes appear in h1's) | |
| 543 (list (concat "<" tword ">\\(" not-tend "*\\)</\\1>") | |
| 544 3 'font-lock-function-name-face t) | |
| 545 ;; Underline is rarely used. Only handle it when no tags inside. | |
| 546 '("<u>\\([^<]*\\)</u>" 1 html-helper-underline-face t) | |
| 547 ;; Forms, anchors & images (also fontify strings inside) | |
| 548 '("\\(<\\(form\\|i\\(mg\\|nput\\)\\)\\>[^>]*>\\)" | |
| 549 1 font-lock-variable-name-face t) | |
| 550 '("</a>" 0 font-lock-keyword-face t) | |
| 551 '("\\(<a\\b[^>]*>\\)" 1 font-lock-keyword-face t) | |
| 552 '("=[ \t\n]*\\(\"[^\"]+\"\\)" 1 font-lock-string-face t) | |
| 553 ;; Large-scale structure keywords (like "program" in Fortran). | |
| 554 ;; "<html>" "</html>" "<body>" "</body>" "<head>" "</head>" "</form>" | |
| 555 '("</?\\(body\\|form\\|h\\(ead\\|tml\\)\\)>" | |
| 556 0 font-lock-variable-name-face t) | |
| 557 ;; HTML special characters | |
| 558 '("&[^;\n]*;" 0 font-lock-string-face t) | |
| 559 ;; SGML things like <!DOCTYPE ...> with possible <!ENTITY...> inside. | |
| 560 '("\\(<![a-z]+\\>[^<>]*\\(<[^>]*>[^<>]*\\)*>\\)" | |
| 561 1 font-lock-comment-face t) | |
| 562 ;; Comments: <!-- ... -->. They traditionally override anything else. | |
| 563 ;; It's complicated 'cause we won't allow "-->" inside a comment, and | |
| 564 ;; font-lock colours the *longest* possible match of the regexp. | |
| 565 '("\\(<!--\\([^-]\\|-[^-]\\|--[^>]\\)*-->\\)" | |
| 566 1 font-lock-comment-face t))) | |
| 567 "Additional expressions to highlight in HTML mode.") | |
| 568 | |
| 569 (put 'html-mode 'font-lock-defaults '(html-font-lock-keywords)) | |
| 570 (put 'html3-mode 'font-lock-defaults '(html-font-lock-keywords)) | |
| 571 | |
| 572 ;;}}} | |
| 573 | |
| 574 ;;{{{ patterns for hilit19 | |
| 575 | |
| 576 ;; Define some useful highlighting patterns for the hilit19 package. | |
| 577 ;; These will activate only if hilit19 has already been loaded. | |
| 578 ;; Thanks to <dickow@nbi.dk> for some pattern suggestions | |
| 579 | |
| 580 (if (featurep 'hilit19) | |
| 581 (hilit-set-mode-patterns | |
| 582 'html-helper-mode | |
| 583 '(("<!--" "-->" comment) | |
| 584 ("<![a-z]+\\>[^<>]*\\(<[^>]*>[^<>]*\\)*>" nil comment) ;<!DOCTYPE ...> | |
| 585 ("<title>" "</title>" defun) | |
| 586 ("<h[1-6]>" "</h[1-6]>" bold) ;only colour inside tag | |
| 587 ("<a\\b" ">" define) | |
| 588 ("</a>" nil define) | |
| 589 ("<img\\b" ">" include) | |
| 590 ("<option\\|</?select\\|<input\\|</?form\\|</?textarea" ">" include) | |
| 591 ;; First <i> highlighting just handles unnested tags, then do nesting | |
| 592 ("<i>[^<]*</i>" nil italic) | |
| 593 ("<b>" "</b>" bold) | |
| 594 ("<i>" "</i>" italic) | |
| 595 ("<u>" "</u>" underline) | |
| 596 ("&[^;\n]*;" nil string) | |
| 597 ("<" ">" keyword)) | |
| 598 nil 'case-insensitive) | |
| 599 nil) | |
| 600 | |
| 601 ;;}}} | |
| 602 | |
| 603 ;;{{{ timestamps | |
| 604 | |
| 605 (defun html-helper-update-timestamp () | |
| 606 "Basic function for updating timestamps. | |
| 607 It finds the timestamp in the buffer by looking for | |
| 608 `html-helper-timestamp-start', deletes all text up to | |
| 609 `html-helper-timestamp-end', and runs `html-helper-timestamp-hook' which | |
| 610 will should insert an appropriate timestamp in the buffer." | |
| 611 (save-excursion | |
| 612 (goto-char (point-max)) | |
| 613 (if (not (search-backward html-helper-timestamp-start nil t)) | |
| 614 (message "timestamp delimiter start was not found") | |
| 615 (let ((ts-start (+ (point) (length html-helper-timestamp-start))) | |
| 616 (ts-end (if (search-forward html-helper-timestamp-end nil t) | |
| 617 (- (point) (length html-helper-timestamp-end)) | |
| 618 nil))) | |
| 619 (if (not ts-end) | |
| 620 (message "timestamp delimiter end was not found. Type C-c C-t to insert one.") | |
| 621 (delete-region ts-start ts-end) | |
| 622 (goto-char ts-start) | |
| 623 (run-hooks 'html-helper-timestamp-hook))))) | |
| 624 nil) | |
| 625 | |
| 626 (defun html-helper-return-created-string () | |
| 627 "Return a \"Created:\" string." | |
| 628 (let ((time (current-time-string))) | |
| 629 (concat "<!-- Created: " | |
| 630 (substring time 0 20) | |
| 631 (nth 1 (current-time-zone)) | |
| 632 " " | |
| 633 (substring time -4) | |
| 634 " -->\n"))) | |
| 635 | |
| 636 (defun html-helper-default-insert-timestamp () | |
| 637 "Default timestamp insertion function." | |
| 638 (let ((time (current-time-string))) | |
| 639 (insert "Last modified: " | |
| 640 (substring time 0 20) | |
| 641 (nth 1 (current-time-zone)) | |
| 642 " " | |
| 643 "\n"))) | |
| 644 | |
| 645 (defun html-helper-insert-timestamp-delimiter-at-point () | |
| 646 "Simple function that inserts timestamp delimiters at point. | |
| 647 Useful for adding timestamps to existing buffers." | |
| 648 (interactive) | |
| 649 (insert html-helper-timestamp-start) | |
| 650 (insert html-helper-timestamp-end)) | |
| 651 | |
| 652 ;;}}} | |
| 653 | |
| 654 (defun mail-address-at-point (pos &optional buffer) | |
| 655 "Return a list (NAME ADDRESS) of the address at POS in BUFFER." | |
| 656 (or buffer (setq buffer (current-buffer))) | |
| 657 (let (beg end) | |
| 658 (save-excursion | |
| 659 (set-buffer buffer) | |
| 660 (save-excursion | |
| 661 (goto-char pos) | |
| 662 (or (re-search-forward "[\n,]" nil t) | |
| 663 (error "Can't find address at position")) | |
| 664 (backward-char) | |
| 665 (setq end (point)) | |
| 666 (or (re-search-backward "[\n,:]" nil t) | |
| 667 (error "Can't find address at position")) | |
| 668 (forward-char) | |
| 669 (re-search-forward "[ \t]*" nil t) | |
| 670 (setq beg (point)) | |
| 671 (mail-extract-address-components (buffer-substring beg end)))))) | |
| 672 | |
| 673 (defun html-insert-mailto-reference-from-click () | |
| 674 "Insert a mailto: reference for the clicked-on e-mail address." | |
| 675 (interactive) | |
| 676 (let (event) | |
| 677 (message "Click on a mail address:") | |
| 678 (save-excursion | |
| 679 (setq event (next-command-event)) | |
| 680 (or (mouse-event-p event) | |
| 681 (error "Aborted."))) | |
| 682 (let ((lis (mail-address-at-point (event-closest-point event) | |
| 683 (event-buffer event)))) | |
| 684 (insert "<a href=\"mailto:" (car (cdr lis)) "\">" | |
| 685 (or (car lis) (car (cdr lis))) "</a>")))) | |
| 686 | |
| 687 (defun html-quote-region (begin end) | |
| 688 "\"Quote\" any characters in the region that have special HTML meanings. | |
| 689 This converts <'s, >'s, and &'s into the HTML commands necessary to | |
| 690 get those characters to appear literally in the output." | |
| 691 (interactive "r") | |
| 692 (save-excursion | |
| 693 (goto-char begin) | |
| 694 (while (search-forward "&" end t) | |
| 695 (forward-char -1) | |
| 696 (delete-char 1) | |
| 697 (insert "&")) | |
| 698 (goto-char begin) | |
| 699 (while (search-forward "<" end t) | |
| 700 (forward-char -1) | |
| 701 (delete-char 1) | |
| 702 (insert "<")) | |
| 703 (goto-char begin) | |
| 704 (while (search-forward ">" end t) | |
| 705 (forward-char -1) | |
| 706 (delete-char 1) | |
| 707 (insert ">")))) | |
| 708 | |
| 709 ;;{{{ html-helper-insert-new-buffer-strings | |
| 710 | |
| 711 (tempo-define-template "html-skeleton" html-helper-new-buffer-template | |
| 712 nil | |
| 713 "Insert a skeleton for a HTML document") | |
| 714 | |
| 715 (defun html-helper-insert-new-buffer-strings () | |
| 716 "Insert `html-helper-new-buffer-strings'." | |
| 717 (tempo-template-html-skeleton)) | |
| 718 | |
| 719 ;;}}} | |
| 720 | |
| 721 ;;;###autoload | |
| 722 (autoload 'html-mode "psgml-html" "HTML mode." t) | |
| 723 | |
| 724 ;;;###autoload | |
| 725 (autoload 'html3-mode "psgml-html" "HTML3 mode." t) | |
| 726 | |
| 727 (defvar sgml-html-menu | |
| 728 (cons "HTML" | |
| 729 (append '(["View in Netscape" sgml-html-netscape-file | |
| 730 (buffer-file-name | |
| 731 (current-buffer))] | |
| 732 ["View in W3" w3-preview-this-buffer t] | |
| 733 "---" | |
| 734 ["HTML-Quote Region" html-quote-region t] | |
| 735 "---") | |
| 736 (cdr sgml-sgml-menu)))) | |
| 737 | |
| 738 (defun sgml-html-netscape-file () | |
| 739 "Preview the file for the current buffer in Netscape." | |
| 740 (interactive) | |
| 741 (highlight-headers-follow-url-netscape | |
| 742 (concat "file:" (buffer-file-name (current-buffer))))) | |
| 743 | |
| 744 (define-derived-mode html3-mode html-mode "HTML3" | |
| 745 (setq sgml-declaration (expand-file-name "html3.decl" | |
| 746 sgml-data-directory) | |
| 747 sgml-default-doctype-name "html-3" | |
| 748 sgml-shortag nil )) | |
| 749 |