1;;; sgml-mode.el --- SGML- and HTML-editing modes -*- coding: iso-2022-7bit -*- 2 3;; Copyright (C) 1992, 1995, 1996, 1998, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: James Clark <jjc@jclark.com> 7;; Maintainer: FSF 8;; Adapted-By: ESR, Daniel Pfeiffer <occitan@esperanto.org>, 9;; F.Potorti@cnuce.cnr.it 10;; Keywords: wp, hypermedia, comm, languages 11 12;; This file is part of GNU Emacs. 13 14;; GNU Emacs is free software; you can redistribute it and/or modify 15;; it under the terms of the GNU General Public License as published by 16;; the Free Software Foundation; either version 2, or (at your option) 17;; any later version. 18 19;; GNU Emacs is distributed in the hope that it will be useful, 20;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22;; GNU General Public License for more details. 23 24;; You should have received a copy of the GNU General Public License 25;; along with GNU Emacs; see the file COPYING. If not, write to the 26;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 27;; Boston, MA 02110-1301, USA. 28 29;;; Commentary: 30 31;; Configurable major mode for editing document in the SGML standard general 32;; markup language. As an example contains a mode for editing the derived 33;; HTML hypertext markup language. 34 35;;; Code: 36 37(eval-when-compile 38 (require 'skeleton) 39 (require 'outline) 40 (require 'cl)) 41 42(defgroup sgml nil 43 "SGML editing mode." 44 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) 45 :group 'languages) 46 47(defcustom sgml-basic-offset 2 48 "*Specifies the basic indentation level for `sgml-indent-line'." 49 :type 'integer 50 :group 'sgml) 51 52(defcustom sgml-transformation-function 'identity 53 "*Default value for `skeleton-transformation-function' in SGML mode." 54 :type 'function 55 :group 'sgml) 56 57(put 'sgml-transformation-function 'variable-interactive 58 "aTransformation function: ") 59(defvaralias 'sgml-transformation 'sgml-transformation-function) 60 61(defcustom sgml-mode-hook nil 62 "Hook run by command `sgml-mode'. 63`text-mode-hook' is run first." 64 :group 'sgml 65 :type 'hook) 66 67;; As long as Emacs' syntax can't be complemented with predicates to context 68;; sensitively confirm the syntax of characters, we have to live with this 69;; kludgy kind of tradeoff. 70(defvar sgml-specials '(?\") 71 "List of characters that have a special meaning for SGML mode. 72This list is used when first loading the `sgml-mode' library. 73The supported characters and potential disadvantages are: 74 75 ?\\\" Makes \" in text start a string. 76 ?' Makes ' in text start a string. 77 ?- Makes -- in text start a comment. 78 79When only one of ?\\\" or ?' are included, \"'\" or '\"', as can be found in 80DTDs, start a string. To partially avoid this problem this also makes these 81self insert as named entities depending on `sgml-quick-keys'. 82 83Including ?- has the problem of affecting dashes that have nothing to do 84with comments, so we normally turn it off.") 85 86(defvar sgml-quick-keys nil 87 "Use <, >, &, /, SPC and `sgml-specials' keys \"electrically\" when non-nil. 88This takes effect when first loading the `sgml-mode' library.") 89 90(defvar sgml-mode-map 91 (let ((map (make-keymap)) ;`sparse' doesn't allow binding to charsets. 92 (menu-map (make-sparse-keymap "SGML"))) 93 (define-key map "\C-c\C-i" 'sgml-tags-invisible) 94 (define-key map "/" 'sgml-slash) 95 (define-key map "\C-c\C-n" 'sgml-name-char) 96 (define-key map "\C-c\C-t" 'sgml-tag) 97 (define-key map "\C-c\C-a" 'sgml-attributes) 98 (define-key map "\C-c\C-b" 'sgml-skip-tag-backward) 99 (define-key map [?\C-c left] 'sgml-skip-tag-backward) 100 (define-key map "\C-c\C-f" 'sgml-skip-tag-forward) 101 (define-key map [?\C-c right] 'sgml-skip-tag-forward) 102 (define-key map "\C-c\C-d" 'sgml-delete-tag) 103 (define-key map "\C-c\^?" 'sgml-delete-tag) 104 (define-key map "\C-c?" 'sgml-tag-help) 105 (define-key map "\C-c/" 'sgml-close-tag) 106 (define-key map "\C-c8" 'sgml-name-8bit-mode) 107 (define-key map "\C-c\C-v" 'sgml-validate) 108 (when sgml-quick-keys 109 (define-key map "&" 'sgml-name-char) 110 (define-key map "<" 'sgml-tag) 111 (define-key map " " 'sgml-auto-attributes) 112 (define-key map ">" 'sgml-maybe-end-tag) 113 (when (memq ?\" sgml-specials) 114 (define-key map "\"" 'sgml-name-self)) 115 (when (memq ?' sgml-specials) 116 (define-key map "'" 'sgml-name-self))) 117 (define-key map (vector (make-char 'latin-iso8859-1)) 118 'sgml-maybe-name-self) 119 (let ((c 127) 120 (map (nth 1 map))) 121 (while (< (setq c (1+ c)) 256) 122 (aset map c 'sgml-maybe-name-self))) 123 (define-key map [menu-bar sgml] (cons "SGML" menu-map)) 124 (define-key menu-map [sgml-validate] '("Validate" . sgml-validate)) 125 (define-key menu-map [sgml-name-8bit-mode] 126 '("Toggle 8 Bit Insertion" . sgml-name-8bit-mode)) 127 (define-key menu-map [sgml-tags-invisible] 128 '("Toggle Tag Visibility" . sgml-tags-invisible)) 129 (define-key menu-map [sgml-tag-help] 130 '("Describe Tag" . sgml-tag-help)) 131 (define-key menu-map [sgml-delete-tag] 132 '("Delete Tag" . sgml-delete-tag)) 133 (define-key menu-map [sgml-skip-tag-forward] 134 '("Forward Tag" . sgml-skip-tag-forward)) 135 (define-key menu-map [sgml-skip-tag-backward] 136 '("Backward Tag" . sgml-skip-tag-backward)) 137 (define-key menu-map [sgml-attributes] 138 '("Insert Attributes" . sgml-attributes)) 139 (define-key menu-map [sgml-tag] '("Insert Tag" . sgml-tag)) 140 map) 141 "Keymap for SGML mode. See also `sgml-specials'.") 142 143(defun sgml-make-syntax-table (specials) 144 (let ((table (make-syntax-table text-mode-syntax-table))) 145 (modify-syntax-entry ?< "(>" table) 146 (modify-syntax-entry ?> ")<" table) 147 (modify-syntax-entry ?: "_" table) 148 (modify-syntax-entry ?_ "_" table) 149 (modify-syntax-entry ?. "_" table) 150 (if (memq ?- specials) 151 (modify-syntax-entry ?- "_ 1234" table)) 152 (if (memq ?\" specials) 153 (modify-syntax-entry ?\" "\"\"" table)) 154 (if (memq ?' specials) 155 (modify-syntax-entry ?\' "\"'" table)) 156 table)) 157 158(defvar sgml-mode-syntax-table (sgml-make-syntax-table sgml-specials) 159 "Syntax table used in SGML mode. See also `sgml-specials'.") 160 161(defconst sgml-tag-syntax-table 162 (let ((table (sgml-make-syntax-table '(?- ?\" ?\')))) 163 (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/)) 164 (modify-syntax-entry char "." table)) 165 table) 166 "Syntax table used to parse SGML tags.") 167 168(defcustom sgml-name-8bit-mode nil 169 "*When non-nil, insert non-ASCII characters as named entities." 170 :type 'boolean 171 :group 'sgml) 172 173(defvar sgml-char-names 174 [nil nil nil nil nil nil nil nil 175 nil nil nil nil nil nil nil nil 176 nil nil nil nil nil nil nil nil 177 nil nil nil nil nil nil nil nil 178 "nbsp" "excl" "quot" "num" "dollar" "percnt" "amp" "apos" 179 "lpar" "rpar" "ast" "plus" "comma" "hyphen" "period" "sol" 180 nil nil nil nil nil nil nil nil 181 nil nil "colon" "semi" "lt" "eq" "gt" "quest" 182 "commat" nil nil nil nil nil nil nil 183 nil nil nil nil nil nil nil nil 184 nil nil nil nil nil nil nil nil 185 nil nil nil "lsqb" nil "rsqb" "uarr" "lowbar" 186 "lsquo" nil nil nil nil nil nil nil 187 nil nil nil nil nil nil nil nil 188 nil nil nil nil nil nil nil nil 189 nil nil nil "lcub" "verbar" "rcub" "tilde" nil 190 nil nil nil nil nil nil nil nil 191 nil nil nil nil nil nil nil nil 192 nil nil nil nil nil nil nil nil 193 nil nil nil nil nil nil nil nil 194 "nbsp" "iexcl" "cent" "pound" "curren" "yen" "brvbar" "sect" 195 "uml" "copy" "ordf" "laquo" "not" "shy" "reg" "macr" 196 "ring" "plusmn" "sup2" "sup3" "acute" "micro" "para" "middot" 197 "cedil" "sup1" "ordm" "raquo" "frac14" "frac12" "frac34" "iquest" 198 "Agrave" "Aacute" "Acirc" "Atilde" "Auml" "Aring" "AElig" "Ccedil" 199 "Egrave" "Eacute" "Ecirc" "Euml" "Igrave" "Iacute" "Icirc" "Iuml" 200 "ETH" "Ntilde" "Ograve" "Oacute" "Ocirc" "Otilde" "Ouml" nil 201 "Oslash" "Ugrave" "Uacute" "Ucirc" "Uuml" "Yacute" "THORN" "szlig" 202 "agrave" "aacute" "acirc" "atilde" "auml" "aring" "aelig" "ccedil" 203 "egrave" "eacute" "ecirc" "euml" "igrave" "iacute" "icirc" "iuml" 204 "eth" "ntilde" "ograve" "oacute" "ocirc" "otilde" "ouml" "divide" 205 "oslash" "ugrave" "uacute" "ucirc" "uuml" "yacute" "thorn" "yuml"] 206 "Vector of symbolic character names without `&' and `;'.") 207 208(put 'sgml-table 'char-table-extra-slots 0) 209 210(defvar sgml-char-names-table 211 (let ((table (make-char-table 'sgml-table)) 212 (i 32) 213 elt) 214 (while (< i 256) 215 (setq elt (aref sgml-char-names i)) 216 (if elt (aset table (make-char 'latin-iso8859-1 i) elt)) 217 (setq i (1+ i))) 218 table) 219 "A table for mapping non-ASCII characters into SGML entity names. 220Currently, only Latin-1 characters are supported.") 221 222;; nsgmls is a free SGML parser in the SP suite available from 223;; ftp.jclark.com and otherwise packaged for GNU systems. 224;; Its error messages can be parsed by next-error. 225;; The -s option suppresses output. 226 227(defcustom sgml-validate-command "nsgmls -s" ; replaced old `sgmls' 228 "*The command to validate an SGML document. 229The file name of current buffer file name will be appended to this, 230separated by a space." 231 :type 'string 232 :version "21.1" 233 :group 'sgml) 234 235(defvar sgml-saved-validate-command nil 236 "The command last used to validate in this buffer.") 237 238;; I doubt that null end tags are used much for large elements, 239;; so use a small distance here. 240(defcustom sgml-slash-distance 1000 241 "*If non-nil, is the maximum distance to search for matching `/'." 242 :type '(choice (const nil) integer) 243 :group 'sgml) 244 245(defconst sgml-namespace-re "[_[:alpha:]][-_.[:alnum:]]*") 246(defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*") 247(defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)")) 248(defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*") 249(defconst sgml-start-tag-regex (concat "<" sgml-name-re sgml-attrs-re) 250 "Regular expression that matches a non-empty start tag. 251Any terminating `>' or `/' is not matched.") 252 253(defface sgml-namespace 254 '((t (:inherit font-lock-builtin-face))) 255 "`sgml-mode' face used to highlight the namespace part of identifiers." 256 :group 'sgml) 257(defvar sgml-namespace-face 'sgml-namespace) 258 259;; internal 260(defconst sgml-font-lock-keywords-1 261 `((,(concat "<\\([!?]" sgml-name-re "\\)") 1 font-lock-keyword-face) 262 ;; We could use the simpler "\\(" sgml-namespace-re ":\\)?" instead, 263 ;; but it would cause a bit more backtracking in the re-matcher. 264 (,(concat "</?\\(" sgml-namespace-re "\\)\\(?::\\(" sgml-name-re "\\)\\)?") 265 (1 (if (match-end 2) sgml-namespace-face font-lock-function-name-face)) 266 (2 font-lock-function-name-face nil t)) 267 ;; FIXME: this doesn't cover the variables using a default value. 268 ;; The first shy-group is an important anchor: it prevents an O(n^2) 269 ;; pathological case where we otherwise keep retrying a failing match 270 ;; against a very long word at every possible position within the word. 271 (,(concat "\\(?:^\\|[ \t]\\)\\(" sgml-namespace-re "\\)\\(?::\\(" 272 sgml-name-re "\\)\\)?=[\"']") 273 (1 (if (match-end 2) sgml-namespace-face font-lock-variable-name-face)) 274 (2 font-lock-variable-name-face nil t)) 275 (,(concat "[&%]" sgml-name-re ";?") . font-lock-variable-name-face))) 276 277(defconst sgml-font-lock-keywords-2 278 (append 279 sgml-font-lock-keywords-1 280 '((eval 281 . (cons (concat "<" 282 (regexp-opt (mapcar 'car sgml-tag-face-alist) t) 283 "\\([ \t][^>]*\\)?>\\([^<]+\\)</\\1>") 284 '(3 (cdr (assoc (downcase (match-string 1)) 285 sgml-tag-face-alist)) prepend)))))) 286 287;; for font-lock, but must be defvar'ed after 288;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above 289(defvar sgml-font-lock-keywords sgml-font-lock-keywords-1 290 "*Rules for highlighting SGML code. See also `sgml-tag-face-alist'.") 291 292(defvar sgml-font-lock-syntactic-keywords 293 ;; Use the `b' style of comments to avoid interference with the -- ... -- 294 ;; comments recognized when `sgml-specials' includes ?-. 295 ;; FIXME: beware of <!--> blabla <!--> !! 296 '(("\\(<\\)!--" (1 "< b")) 297 ("--[ \t\n]*\\(>\\)" (1 "> b"))) 298 "Syntactic keywords for `sgml-mode'.") 299 300;; internal 301(defvar sgml-face-tag-alist () 302 "Alist of face and tag name for facemenu.") 303 304(defvar sgml-tag-face-alist () 305 "Tag names and face or list of faces to fontify with when invisible. 306When `font-lock-maximum-decoration' is 1 this is always used for fontifying. 307When more these are fontified together with `sgml-font-lock-keywords'.") 308 309(defvar sgml-display-text () 310 "Tag names as lowercase symbols, and display string when invisible.") 311 312;; internal 313(defvar sgml-tags-invisible nil) 314 315(defcustom sgml-tag-alist 316 '(("![" ("ignore" t) ("include" t)) 317 ("!attlist") 318 ("!doctype") 319 ("!element") 320 ("!entity")) 321 "*Alist of tag names for completing read and insertion rules. 322This alist is made up as 323 324 ((\"tag\" . TAGRULE) 325 ...) 326 327TAGRULE is a list of optionally t (no endtag) or `\\n' (separate endtag by 328newlines) or a skeleton with nil, t or `\\n' in place of the interactor 329followed by an ATTRIBUTERULE (for an always present attribute) or an 330attribute alist. 331 332The attribute alist is made up as 333 334 ((\"attribute\" . ATTRIBUTERULE) 335 ...) 336 337ATTRIBUTERULE is a list of optionally t (no value when no input) followed by 338an optional alist of possible values." 339 :type '(repeat (cons (string :tag "Tag Name") 340 (repeat :tag "Tag Rule" sexp))) 341 :group 'sgml) 342(put 'sgml-tag-alist 'risky-local-variable t) 343 344(defcustom sgml-tag-help 345 '(("!" . "Empty declaration for comment") 346 ("![" . "Embed declarations with parser directive") 347 ("!attlist" . "Tag attributes declaration") 348 ("!doctype" . "Document type (DTD) declaration") 349 ("!element" . "Tag declaration") 350 ("!entity" . "Entity (macro) declaration")) 351 "*Alist of tag name and short description." 352 :type '(repeat (cons (string :tag "Tag Name") 353 (string :tag "Description"))) 354 :group 'sgml) 355 356(defcustom sgml-xml-mode nil 357 "*When non-nil, tag insertion functions will be XML-compliant. 358If this variable is customized, the custom value is used always. 359Otherwise, it is set to be buffer-local when the file has 360a DOCTYPE or an XML declaration." 361 :type 'boolean 362 :version "22.1" 363 :group 'sgml) 364 365(defvar sgml-empty-tags nil 366 "List of tags whose !ELEMENT definition says EMPTY.") 367 368(defvar sgml-unclosed-tags nil 369 "List of tags whose !ELEMENT definition says the end-tag is optional.") 370 371(defun sgml-xml-guess () 372 "Guess whether the current buffer is XML." 373 (save-excursion 374 (goto-char (point-min)) 375 (when (or (string= "xml" (file-name-extension (or buffer-file-name ""))) 376 (looking-at "\\s-*<\\?xml") 377 (when (re-search-forward 378 (eval-when-compile 379 (mapconcat 'identity 380 '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)" 381 "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"") 382 "\\s-+")) 383 nil t) 384 (string-match "X\\(HT\\)?ML" (match-string 3)))) 385 (set (make-local-variable 'sgml-xml-mode) t)))) 386 387(defvar v2) ; free for skeleton 388 389(defun sgml-comment-indent-new-line (&optional soft) 390 (let ((comment-start "-- ") 391 (comment-start-skip "\\(<!\\)?--[ \t]*") 392 (comment-end " --") 393 (comment-style 'plain)) 394 (comment-indent-new-line soft))) 395 396(defun sgml-mode-facemenu-add-face-function (face end) 397 (if (setq face (cdr (assq face sgml-face-tag-alist))) 398 (progn 399 (setq face (funcall skeleton-transformation-function face)) 400 (setq facemenu-end-add-face (concat "</" face ">")) 401 (concat "<" face ">")) 402 (error "Face not configured for %s mode" mode-name))) 403 404(defun sgml-fill-nobreak () 405 ;; Don't break between a tag name and its first argument. 406 (save-excursion 407 (skip-chars-backward " \t") 408 (and (not (zerop (skip-syntax-backward "w_"))) 409 (skip-chars-backward "/?!") 410 (eq (char-before) ?<)))) 411 412;;;###autoload 413(define-derived-mode sgml-mode text-mode "SGML" 414 "Major mode for editing SGML documents. 415Makes > match <. 416Keys <, &, SPC within <>, \", / and ' can be electric depending on 417`sgml-quick-keys'. 418 419An argument of N to a tag-inserting command means to wrap it around 420the next N words. In Transient Mark mode, when the mark is active, 421N defaults to -1, which means to wrap it around the current region. 422 423If you like upcased tags, put (setq sgml-transformation-function 'upcase) 424in your `.emacs' file. 425 426Use \\[sgml-validate] to validate your document with an SGML parser. 427 428Do \\[describe-variable] sgml- SPC to see available variables. 429Do \\[describe-key] on the following bindings to discover what they do. 430\\{sgml-mode-map}" 431 (make-local-variable 'sgml-saved-validate-command) 432 (make-local-variable 'facemenu-end-add-face) 433 ;;(make-local-variable 'facemenu-remove-face-function) 434 ;; A start or end tag by itself on a line separates a paragraph. 435 ;; This is desirable because SGML discards a newline that appears 436 ;; immediately after a start tag or immediately before an end tag. 437 (set (make-local-variable 'paragraph-start) (concat "[ \t]*$\\|\ 438\[ \t]*</?\\(" sgml-name-re sgml-attrs-re "\\)?>")) 439 (set (make-local-variable 'paragraph-separate) 440 (concat paragraph-start "$")) 441 (set (make-local-variable 'adaptive-fill-regexp) "[ \t]*") 442 (add-hook 'fill-nobreak-predicate 'sgml-fill-nobreak nil t) 443 (set (make-local-variable 'indent-line-function) 'sgml-indent-line) 444 (set (make-local-variable 'comment-start) "<!-- ") 445 (set (make-local-variable 'comment-end) " -->") 446 (set (make-local-variable 'comment-indent-function) 'sgml-comment-indent) 447 (set (make-local-variable 'comment-line-break-function) 448 'sgml-comment-indent-new-line) 449 (set (make-local-variable 'skeleton-further-elements) 450 '((completion-ignore-case t))) 451 (set (make-local-variable 'skeleton-end-hook) 452 (lambda () 453 (or (eolp) 454 (not (or (eq v2 '\n) (eq (car-safe v2) '\n))) 455 (newline-and-indent)))) 456 (set (make-local-variable 'font-lock-defaults) 457 '((sgml-font-lock-keywords 458 sgml-font-lock-keywords-1 459 sgml-font-lock-keywords-2) 460 nil t nil nil 461 (font-lock-syntactic-keywords 462 . sgml-font-lock-syntactic-keywords))) 463 (set (make-local-variable 'facemenu-add-face-function) 464 'sgml-mode-facemenu-add-face-function) 465 (sgml-xml-guess) 466 (if sgml-xml-mode 467 (setq mode-name "XML") 468 (set (make-local-variable 'skeleton-transformation-function) 469 sgml-transformation-function)) 470 ;; This will allow existing comments within declarations to be 471 ;; recognized. 472 (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*") 473 (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?") 474 ;; This definition has an HTML leaning but probably fits well for other modes. 475 (setq imenu-generic-expression 476 `((nil 477 ,(concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\(" 478 sgml-name-re "\\)") 479 2) 480 ("Id" 481 ,(concat "<[^>]+[ \t\n]+[Ii][Dd]=\\(['\"]" 482 (if sgml-xml-mode "" "?") 483 "\\)\\(" sgml-name-re "\\)\\1") 484 2) 485 ("Name" 486 ,(concat "<[^>]+[ \t\n]+[Nn][Aa][Mm][Ee]=\\(['\"]" 487 (if sgml-xml-mode "" "?") 488 "\\)\\(" sgml-name-re "\\)\\1") 489 2)))) 490 491;; Some programs (such as Glade 2) generate XML which has 492;; -*- mode: xml -*-. 493;;;###autoload 494(defalias 'xml-mode 'sgml-mode) 495 496(defun sgml-comment-indent () 497 (if (looking-at "--") comment-column 0)) 498 499(defun sgml-slash (arg) 500 "Insert ARG slash characters. 501Behaves electrically if `sgml-quick-keys' is non-nil." 502 (interactive "p") 503 (cond 504 ((not (and (eq (char-before) ?<) (= arg 1))) 505 (sgml-slash-matching arg)) 506 ((eq sgml-quick-keys 'indent) 507 (insert-char ?/ 1) 508 (indent-according-to-mode)) 509 ((eq sgml-quick-keys 'close) 510 (delete-backward-char 1) 511 (sgml-close-tag)) 512 (t 513 (sgml-slash-matching arg)))) 514 515(defun sgml-slash-matching (arg) 516 "Insert `/' and display any previous matching `/'. 517Two `/'s are treated as matching if the first `/' ends a net-enabling 518start tag, and the second `/' is the corresponding null end tag." 519 (interactive "p") 520 (insert-char ?/ arg) 521 (if (> arg 0) 522 (let ((oldpos (point)) 523 (blinkpos) 524 (level 0)) 525 (save-excursion 526 (save-restriction 527 (if sgml-slash-distance 528 (narrow-to-region (max (point-min) 529 (- (point) sgml-slash-distance)) 530 oldpos)) 531 (if (and (re-search-backward sgml-start-tag-regex (point-min) t) 532 (eq (match-end 0) (1- oldpos))) 533 () 534 (goto-char (1- oldpos)) 535 (while (and (not blinkpos) 536 (search-backward "/" (point-min) t)) 537 (let ((tagend (save-excursion 538 (if (re-search-backward sgml-start-tag-regex 539 (point-min) t) 540 (match-end 0) 541 nil)))) 542 (if (eq tagend (point)) 543 (if (eq level 0) 544 (setq blinkpos (point)) 545 (setq level (1- level))) 546 (setq level (1+ level))))))) 547 (when blinkpos 548 (goto-char blinkpos) 549 (if (pos-visible-in-window-p) 550 (sit-for 1) 551 (message "Matches %s" 552 (buffer-substring (line-beginning-position) 553 (1+ blinkpos))))))))) 554 555;; Why doesn't this use the iso-cvt table or, preferably, generate the 556;; inverse of the extensive table in the SGML Quail input method? -- fx 557;; I guess that's moot since it only works with Latin-1 anyhow. 558(defun sgml-name-char (&optional char) 559 "Insert a symbolic character name according to `sgml-char-names'. 560Non-ASCII chars may be inserted either with the meta key, as in M-SPC for 561no-break space or M-- for a soft hyphen; or via an input method or 562encoded keyboard operation." 563 (interactive "*") 564 (insert ?&) 565 (or char 566 (setq char (read-quoted-char "Enter char or octal number"))) 567 (delete-backward-char 1) 568 (insert char) 569 (undo-boundary) 570 (sgml-namify-char)) 571 572(defun sgml-namify-char () 573 "Change the char before point into its `&name;' equivalent. 574Uses `sgml-char-names'." 575 (interactive) 576 (let* ((char (char-before)) 577 (name 578 (cond 579 ((null char) (error "No char before point")) 580 ((< char 256) (or (aref sgml-char-names char) char)) 581 ((aref sgml-char-names-table char)) 582 ((encode-char char 'ucs))))) 583 (if (not name) 584 (error "Don't know the name of `%c'" char) 585 (delete-backward-char 1) 586 (insert (format (if (numberp name) "&#%d;" "&%s;") name))))) 587 588(defun sgml-name-self () 589 "Insert a symbolic character name according to `sgml-char-names'." 590 (interactive "*") 591 (sgml-name-char last-command-char)) 592 593(defun sgml-maybe-name-self () 594 "Insert a symbolic character name according to `sgml-char-names'." 595 (interactive "*") 596 (if sgml-name-8bit-mode 597 (let ((mc last-command-char)) 598 (if (< mc 256) 599 (setq mc (unibyte-char-to-multibyte mc))) 600 (or mc (setq mc last-command-char)) 601 (sgml-name-char mc)) 602 (self-insert-command 1))) 603 604(defun sgml-name-8bit-mode () 605 "Toggle whether to insert named entities instead of non-ASCII characters. 606This only works for Latin-1 input." 607 (interactive) 608 (setq sgml-name-8bit-mode (not sgml-name-8bit-mode)) 609 (message "sgml name entity mode is now %s" 610 (if sgml-name-8bit-mode "ON" "OFF"))) 611 612;; When an element of a skeleton is a string "str", it is passed 613;; through `skeleton-transformation-function' and inserted. 614;; If "str" is to be inserted literally, one should obtain it as 615;; the return value of a function, e.g. (identity "str"). 616 617(defvar sgml-tag-last nil) 618(defvar sgml-tag-history nil) 619(define-skeleton sgml-tag 620 "Prompt for a tag and insert it, optionally with attributes. 621Completion and configuration are done according to `sgml-tag-alist'. 622If you like tags and attributes in uppercase do \\[set-variable] 623`skeleton-transformation-function' RET `upcase' RET, or put this 624in your `.emacs': 625 (setq sgml-transformation-function 'upcase)" 626 (funcall (or skeleton-transformation-function 'identity) 627 (setq sgml-tag-last 628 (completing-read 629 (if (> (length sgml-tag-last) 0) 630 (format "Tag (default %s): " sgml-tag-last) 631 "Tag: ") 632 sgml-tag-alist nil nil nil 'sgml-tag-history sgml-tag-last))) 633 ?< str | 634 (("") -1 '(undo-boundary) (identity "<")) | ; see comment above 635 `(("") '(setq v2 (sgml-attributes ,str t)) ?> 636 (cond 637 ((string= "![" ,str) 638 (backward-char) 639 '(("") " [ " _ " ]]")) 640 ((and (eq v2 t) sgml-xml-mode (member ,str sgml-empty-tags)) 641 '(("") -1 " />")) 642 ((or (and (eq v2 t) (not sgml-xml-mode)) (string-match "^[/!?]" ,str)) 643 nil) 644 ((symbolp v2) 645 ;; Make sure we don't fall into an infinite loop. 646 ;; For xhtml's `tr' tag, we should maybe use \n instead. 647 (if (eq v2 t) (setq v2 nil)) 648 ;; We use `identity' to prevent skeleton from passing 649 ;; `str' through `skeleton-transformation-function' a second time. 650 '(("") v2 _ v2 "</" (identity ',str) ?>)) 651 ((eq (car v2) t) 652 (cons '("") (cdr v2))) 653 (t 654 (append '(("") (car v2)) 655 (cdr v2) 656 '(resume: (car v2) _ "</" (identity ',str) ?>)))))) 657 658(autoload 'skeleton-read "skeleton") 659 660(defun sgml-attributes (tag &optional quiet) 661 "When at top level of a tag, interactively insert attributes. 662 663Completion and configuration of TAG are done according to `sgml-tag-alist'. 664If QUIET, do not print a message when there are no attributes for TAG." 665 (interactive (list (save-excursion (sgml-beginning-of-tag t)))) 666 (or (stringp tag) (error "Wrong context for adding attribute")) 667 (if tag 668 (let ((completion-ignore-case t) 669 (alist (cdr (assoc (downcase tag) sgml-tag-alist))) 670 car attribute i) 671 (if (or (symbolp (car alist)) 672 (symbolp (car (car alist)))) 673 (setq car (car alist) 674 alist (cdr alist))) 675 (or quiet 676 (message "No attributes configured.")) 677 (if (stringp (car alist)) 678 (progn 679 (insert (if (eq (preceding-char) ?\s) "" ?\s) 680 (funcall skeleton-transformation-function (car alist))) 681 (sgml-value alist)) 682 (setq i (length alist)) 683 (while (> i 0) 684 (insert ?\s) 685 (insert (funcall skeleton-transformation-function 686 (setq attribute 687 (skeleton-read '(completing-read 688 "Attribute: " 689 alist))))) 690 (if (string= "" attribute) 691 (setq i 0) 692 (sgml-value (assoc (downcase attribute) alist)) 693 (setq i (1- i)))) 694 (if (eq (preceding-char) ?\s) 695 (delete-backward-char 1))) 696 car))) 697 698(defun sgml-auto-attributes (arg) 699 "Self insert the character typed; at top level of tag, prompt for attributes. 700With prefix argument, only self insert." 701 (interactive "*P") 702 (let ((point (point)) 703 tag) 704 (if (or arg 705 (not sgml-tag-alist) ; no message when nothing configured 706 (symbolp (setq tag (save-excursion (sgml-beginning-of-tag t)))) 707 (eq (aref tag 0) ?/)) 708 (self-insert-command (prefix-numeric-value arg)) 709 (sgml-attributes tag) 710 (setq last-command-char ?\s) 711 (or (> (point) point) 712 (self-insert-command 1))))) 713 714(defun sgml-tag-help (&optional tag) 715 "Display description of tag TAG. If TAG is omitted, use the tag at point." 716 (interactive) 717 (or tag 718 (save-excursion 719 (if (eq (following-char) ?<) 720 (forward-char)) 721 (setq tag (sgml-beginning-of-tag)))) 722 (or (stringp tag) 723 (error "No tag selected")) 724 (setq tag (downcase tag)) 725 (message "%s" 726 (or (cdr (assoc (downcase tag) sgml-tag-help)) 727 (and (eq (aref tag 0) ?/) 728 (cdr (assoc (downcase (substring tag 1)) sgml-tag-help))) 729 "No description available"))) 730 731(defun sgml-maybe-end-tag (&optional arg) 732 "Name self unless in position to end a tag or a prefix ARG is given." 733 (interactive "P") 734 (if (or arg (eq (car (sgml-lexical-context)) 'tag)) 735 (self-insert-command (prefix-numeric-value arg)) 736 (sgml-name-self))) 737 738(defun sgml-skip-tag-backward (arg) 739 "Skip to beginning of tag or matching opening tag if present. 740With prefix argument ARG, repeat this ARG times." 741 (interactive "p") 742 ;; FIXME: use sgml-get-context or something similar. 743 (while (>= arg 1) 744 (search-backward "<" nil t) 745 (if (looking-at "</\\([^ \n\t>]+\\)") 746 ;; end tag, skip any nested pairs 747 (let ((case-fold-search t) 748 (re (concat "</?" (regexp-quote (match-string 1)) 749 ;; Ignore empty tags like <foo/>. 750 "\\([^>]*[^/>]\\)?>"))) 751 (while (and (re-search-backward re nil t) 752 (eq (char-after (1+ (point))) ?/)) 753 (forward-char 1) 754 (sgml-skip-tag-backward 1)))) 755 (setq arg (1- arg)))) 756 757(defun sgml-skip-tag-forward (arg) 758 "Skip to end of tag or matching closing tag if present. 759With prefix argument ARG, repeat this ARG times. 760Return t iff after a closing tag." 761 (interactive "p") 762 ;; FIXME: Use sgml-get-context or something similar. 763 ;; It currently might jump to an unrelated </P> if the <P> 764 ;; we're skipping has no matching </P>. 765 (let ((return t)) 766 (with-syntax-table sgml-tag-syntax-table 767 (while (>= arg 1) 768 (skip-chars-forward "^<>") 769 (if (eq (following-char) ?>) 770 (up-list -1)) 771 (if (looking-at "<\\([^/ \n\t>]+\\)\\([^>]*[^/>]\\)?>") 772 ;; start tag, skip any nested same pairs _and_ closing tag 773 (let ((case-fold-search t) 774 (re (concat "</?" (regexp-quote (match-string 1)) 775 ;; Ignore empty tags like <foo/>. 776 "\\([^>]*[^/>]\\)?>")) 777 point close) 778 (forward-list 1) 779 (setq point (point)) 780 ;; FIXME: This re-search-forward will mistakenly match 781 ;; tag-like text inside attributes. 782 (while (and (re-search-forward re nil t) 783 (not (setq close 784 (eq (char-after (1+ (match-beginning 0))) ?/))) 785 (goto-char (match-beginning 0)) 786 (sgml-skip-tag-forward 1)) 787 (setq close nil)) 788 (unless close 789 (goto-char point) 790 (setq return nil))) 791 (forward-list 1)) 792 (setq arg (1- arg))) 793 return))) 794 795(defun sgml-delete-tag (arg) 796 ;; FIXME: Should be called sgml-kill-tag or should not touch the kill-ring. 797 "Delete tag on or after cursor, and matching closing or opening tag. 798With prefix argument ARG, repeat this ARG times." 799 (interactive "p") 800 (while (>= arg 1) 801 (save-excursion 802 (let* (close open) 803 (if (looking-at "[ \t\n]*<") 804 ;; just before tag 805 (if (eq (char-after (match-end 0)) ?/) 806 ;; closing tag 807 (progn 808 (setq close (point)) 809 (goto-char (match-end 0)))) 810 ;; on tag? 811 (or (save-excursion (setq close (sgml-beginning-of-tag) 812 close (and (stringp close) 813 (eq (aref close 0) ?/) 814 (point)))) 815 ;; not on closing tag 816 (let ((point (point))) 817 (sgml-skip-tag-backward 1) 818 (if (or (not (eq (following-char) ?<)) 819 (save-excursion 820 (forward-list 1) 821 (<= (point) point))) 822 (error "Not on or before tag"))))) 823 (if close 824 (progn 825 (sgml-skip-tag-backward 1) 826 (setq open (point)) 827 (goto-char close) 828 (kill-sexp 1)) 829 (setq open (point)) 830 (when (and (sgml-skip-tag-forward 1) 831 (not (looking-back "/>"))) 832 (kill-sexp -1))) 833 ;; Delete any resulting empty line. If we didn't kill-sexp, 834 ;; this *should* do nothing, because we're right after the tag. 835 (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?")) 836 (delete-region (match-beginning 0) (match-end 0))) 837 (goto-char open) 838 (kill-sexp 1) 839 (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?")) 840 (delete-region (match-beginning 0) (match-end 0))))) 841 (setq arg (1- arg)))) 842 843 844;; Put read-only last to enable setting this even when read-only enabled. 845(or (get 'sgml-tag 'invisible) 846 (setplist 'sgml-tag 847 (append '(invisible t 848 point-entered sgml-point-entered 849 rear-nonsticky t 850 read-only t) 851 (symbol-plist 'sgml-tag)))) 852 853(defun sgml-tags-invisible (arg) 854 "Toggle visibility of existing tags." 855 (interactive "P") 856 (let ((modified (buffer-modified-p)) 857 (inhibit-read-only t) 858 (inhibit-modification-hooks t) 859 ;; Avoid spurious the `file-locked' checks. 860 (buffer-file-name nil) 861 ;; This is needed in case font lock gets called, 862 ;; since it moves point and might call sgml-point-entered. 863 ;; How could it get called? -stef 864 (inhibit-point-motion-hooks t) 865 string) 866 (unwind-protect 867 (save-excursion 868 (goto-char (point-min)) 869 (if (set (make-local-variable 'sgml-tags-invisible) 870 (if arg 871 (>= (prefix-numeric-value arg) 0) 872 (not sgml-tags-invisible))) 873 (while (re-search-forward sgml-tag-name-re nil t) 874 (setq string 875 (cdr (assq (intern-soft (downcase (match-string 1))) 876 sgml-display-text))) 877 (goto-char (match-beginning 0)) 878 (and (stringp string) 879 (not (overlays-at (point))) 880 (let ((ol (make-overlay (point) (match-beginning 1)))) 881 (overlay-put ol 'before-string string) 882 (overlay-put ol 'sgml-tag t))) 883 (put-text-property (point) 884 (progn (forward-list) (point)) 885 'category 'sgml-tag)) 886 (let ((pos (point-min))) 887 (while (< (setq pos (next-overlay-change pos)) (point-max)) 888 (dolist (ol (overlays-at pos)) 889 (if (overlay-get ol 'sgml-tag) 890 (delete-overlay ol))))) 891 (remove-text-properties (point-min) (point-max) '(category nil)))) 892 (restore-buffer-modified-p modified)) 893 (run-hooks 'sgml-tags-invisible-hook) 894 (message ""))) 895 896(defun sgml-point-entered (x y) 897 ;; Show preceding or following hidden tag, depending of cursor direction. 898 (let ((inhibit-point-motion-hooks t)) 899 (save-excursion 900 (condition-case nil 901 (message "Invisible tag: %s" 902 ;; Strip properties, otherwise, the text is invisible. 903 (buffer-substring-no-properties 904 (point) 905 (if (or (and (> x y) 906 (not (eq (following-char) ?<))) 907 (and (< x y) 908 (eq (preceding-char) ?>))) 909 (backward-list) 910 (forward-list)))) 911 (error nil))))) 912 913 914 915(defun sgml-validate (command) 916 "Validate an SGML document. 917Runs COMMAND, a shell command, in a separate process asynchronously 918with output going to the buffer `*compilation*'. 919You can then use the command \\[next-error] to find the next error message 920and move to the line in the SGML document that caused it." 921 (interactive 922 (list (read-string "Validate command: " 923 (or sgml-saved-validate-command 924 (concat sgml-validate-command 925 " " 926 (shell-quote-argument 927 (let ((name (buffer-file-name))) 928 (and name 929 (file-name-nondirectory name))))))))) 930 (setq sgml-saved-validate-command command) 931 (save-some-buffers (not compilation-ask-about-save) nil) 932 (compilation-start command)) 933 934(defsubst sgml-at-indentation-p () 935 "Return true if point is at the first non-whitespace character on the line." 936 (save-excursion 937 (skip-chars-backward " \t") 938 (bolp))) 939 940(defun sgml-lexical-context (&optional limit) 941 "Return the lexical context at point as (TYPE . START). 942START is the location of the start of the lexical element. 943TYPE is one of `string', `comment', `tag', `cdata', or `text'. 944 945Optional argument LIMIT is the position to start parsing from. 946If nil, start from a preceding tag at indentation." 947 (save-excursion 948 (let ((pos (point)) 949 text-start state) 950 (if limit 951 (goto-char limit) 952 ;; Skip tags backwards until we find one at indentation 953 (while (and (ignore-errors (sgml-parse-tag-backward)) 954 (not (sgml-at-indentation-p))))) 955 (with-syntax-table sgml-tag-syntax-table 956 (while (< (point) pos) 957 ;; When entering this loop we're inside text. 958 (setq text-start (point)) 959 (skip-chars-forward "^<" pos) 960 (setq state 961 (cond 962 ((= (point) pos) 963 ;; We got to the end without seeing a tag. 964 nil) 965 ((looking-at "<!\\[[A-Z]+\\[") 966 ;; We've found a CDATA section or similar. 967 (let ((cdata-start (point))) 968 (unless (search-forward "]]>" pos 'move) 969 (list 0 nil nil 'cdata nil nil nil nil cdata-start)))) 970 (t 971 ;; We've reached a tag. Parse it. 972 ;; FIXME: Handle net-enabling start-tags 973 (parse-partial-sexp (point) pos 0)))))) 974 (cond 975 ((eq (nth 3 state) 'cdata) (cons 'cdata (nth 8 state))) 976 ((nth 3 state) (cons 'string (nth 8 state))) 977 ((nth 4 state) (cons 'comment (nth 8 state))) 978 ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state))) 979 (t (cons 'text text-start)))))) 980 981(defun sgml-beginning-of-tag (&optional top-level) 982 "Skip to beginning of tag and return its name. 983If this can't be done, return nil." 984 (let ((context (sgml-lexical-context))) 985 (if (eq (car context) 'tag) 986 (progn 987 (goto-char (cdr context)) 988 (when (looking-at sgml-tag-name-re) 989 (match-string-no-properties 1))) 990 (if top-level nil 991 (when (not (eq (car context) 'text)) 992 (goto-char (cdr context)) 993 (sgml-beginning-of-tag t)))))) 994 995(defun sgml-value (alist) 996 "Interactively insert value taken from attribute-rule ALIST. 997See `sgml-tag-alist' for info about attribute rules." 998 (setq alist (cdr alist)) 999 (if (stringp (car alist)) 1000 (insert "=\"" (car alist) ?\") 1001 (if (and (eq (car alist) t) (not sgml-xml-mode)) 1002 (when (cdr alist) 1003 (insert "=\"") 1004 (setq alist (skeleton-read '(completing-read "Value: " (cdr alist)))) 1005 (if (string< "" alist) 1006 (insert alist ?\") 1007 (delete-backward-char 2))) 1008 (insert "=\"") 1009 (when alist 1010 (insert (skeleton-read '(completing-read "Value: " alist)))) 1011 (insert ?\")))) 1012 1013(defun sgml-quote (start end &optional unquotep) 1014 "Quote SGML text in region START ... END. 1015Only &, < and > are quoted, the rest is left untouched. 1016With prefix argument UNQUOTEP, unquote the region." 1017 (interactive "r\nP") 1018 (save-restriction 1019 (narrow-to-region start end) 1020 (goto-char (point-min)) 1021 (if unquotep 1022 ;; FIXME: We should unquote other named character references as well. 1023 (while (re-search-forward 1024 "\\(&\\(amp\\|\\(l\\|\\(g\\)\\)t\\)\\)[][<>&;\n\t \"%!'(),/=?]" 1025 nil t) 1026 (replace-match (if (match-end 4) ">" (if (match-end 3) "<" "&")) t t 1027 nil (if (eq (char-before (match-end 0)) ?\;) 0 1))) 1028 (while (re-search-forward "[&<>]" nil t) 1029 (replace-match (cdr (assq (char-before) '((?& . "&") 1030 (?< . "<") 1031 (?> . ">")))) 1032 t t))))) 1033 1034(defun sgml-pretty-print (beg end) 1035 "Simple-minded pretty printer for SGML. 1036Re-indents the code and inserts newlines between BEG and END. 1037You might want to turn on `auto-fill-mode' to get better results." 1038 ;; TODO: 1039 ;; - insert newline between some start-tag and text. 1040 ;; - don't insert newline in front of some end-tags. 1041 (interactive "r") 1042 (save-excursion 1043 (if (< beg end) 1044 (goto-char beg) 1045 (goto-char end) 1046 (setq end beg) 1047 (setq beg (point))) 1048 ;; Don't use narrowing because it screws up auto-indent. 1049 (setq end (copy-marker end t)) 1050 (with-syntax-table sgml-tag-syntax-table 1051 (while (re-search-forward "<" end t) 1052 (goto-char (match-beginning 0)) 1053 (unless (or ;;(looking-at "</") 1054 (progn (skip-chars-backward " \t") (bolp))) 1055 (reindent-then-newline-and-indent)) 1056 (forward-sexp 1))) 1057 ;; (indent-region beg end) 1058 )) 1059 1060 1061;; Parsing 1062 1063(defstruct (sgml-tag 1064 (:constructor sgml-make-tag (type start end name))) 1065 type start end name) 1066 1067(defsubst sgml-parse-tag-name () 1068 "Skip past a tag-name, and return the name." 1069 (buffer-substring-no-properties 1070 (point) (progn (skip-syntax-forward "w_") (point)))) 1071 1072(defsubst sgml-looking-back-at (str) 1073 "Return t if the test before point matches STR." 1074 (let ((start (- (point) (length str)))) 1075 (and (>= start (point-min)) 1076 (equal str (buffer-substring-no-properties start (point)))))) 1077 1078(defun sgml-tag-text-p (start end) 1079 "Return non-nil if text between START and END is a tag. 1080Checks among other things that the tag does not contain spurious 1081unquoted < or > chars inside, which would indicate that it 1082really isn't a tag after all." 1083 (save-excursion 1084 (with-syntax-table sgml-tag-syntax-table 1085 (let ((pps (parse-partial-sexp start end 2))) 1086 (and (= (nth 0 pps) 0)))))) 1087 1088(defun sgml-parse-tag-backward (&optional limit) 1089 "Parse an SGML tag backward, and return information about the tag. 1090Assume that parsing starts from within a textual context. 1091Leave point at the beginning of the tag." 1092 (catch 'found 1093 (let (tag-type tag-start tag-end name) 1094 (or (re-search-backward "[<>]" limit 'move) 1095 (error "No tag found")) 1096 (when (eq (char-after) ?<) 1097 ;; Oops!! Looks like we were not in a textual context after all!. 1098 ;; Let's try to recover. 1099 (with-syntax-table sgml-tag-syntax-table 1100 (let ((pos (point))) 1101 (condition-case nil 1102 (forward-sexp) 1103 (scan-error 1104 ;; This < seems to be just a spurious one, let's ignore it. 1105 (goto-char pos) 1106 (throw 'found (sgml-parse-tag-backward limit)))) 1107 ;; Check it is really a tag, without any extra < or > inside. 1108 (unless (sgml-tag-text-p pos (point)) 1109 (goto-char pos) 1110 (throw 'found (sgml-parse-tag-backward limit))) 1111 (forward-char -1)))) 1112 (setq tag-end (1+ (point))) 1113 (cond 1114 ((sgml-looking-back-at "--") ; comment 1115 (setq tag-type 'comment 1116 tag-start (search-backward "<!--" nil t))) 1117 ((sgml-looking-back-at "]]") ; cdata 1118 (setq tag-type 'cdata 1119 tag-start (re-search-backward "<!\\[[A-Z]+\\[" nil t))) 1120 (t 1121 (setq tag-start 1122 (with-syntax-table sgml-tag-syntax-table 1123 (goto-char tag-end) 1124 (condition-case nil 1125 (backward-sexp) 1126 (scan-error 1127 ;; This > isn't really the end of a tag. Skip it. 1128 (goto-char (1- tag-end)) 1129 (throw 'found (sgml-parse-tag-backward limit)))) 1130 (point))) 1131 (goto-char (1+ tag-start)) 1132 (case (char-after) 1133 (?! ; declaration 1134 (setq tag-type 'decl)) 1135 (?? ; processing-instruction 1136 (setq tag-type 'pi)) 1137 (?/ ; close-tag 1138 (forward-char 1) 1139 (setq tag-type 'close 1140 name (sgml-parse-tag-name))) 1141 (?% ; JSP tags 1142 (setq tag-type 'jsp)) 1143 (t ; open or empty tag 1144 (setq tag-type 'open 1145 name (sgml-parse-tag-name)) 1146 (if (or (eq ?/ (char-before (- tag-end 1))) 1147 (sgml-empty-tag-p name)) 1148 (setq tag-type 'empty)))))) 1149 (goto-char tag-start) 1150 (sgml-make-tag tag-type tag-start tag-end name)))) 1151 1152(defun sgml-get-context (&optional until) 1153 "Determine the context of the current position. 1154By default, parse until we find a start-tag as the first thing on a line. 1155If UNTIL is `empty', return even if the context is empty (i.e. 1156we just skipped over some element and got to a beginning of line). 1157 1158The context is a list of tag-info structures. The last one is the tag 1159immediately enclosing the current position. 1160 1161Point is assumed to be outside of any tag. If we discover that it's 1162not the case, the first tag returned is the one inside which we are." 1163 (let ((here (point)) 1164 (stack nil) 1165 (ignore nil) 1166 (context nil) 1167 tag-info) 1168 ;; CONTEXT keeps track of the tag-stack 1169 ;; STACK keeps track of the end tags we've seen (and thus the start-tags 1170 ;; we'll have to ignore) when skipping over matching open..close pairs. 1171 ;; IGNORE is a list of tags that can be ignored because they have been 1172 ;; closed implicitly. 1173 (skip-chars-backward " \t\n") ; Make sure we're not at indentation. 1174 (while 1175 (and (not (eq until 'now)) 1176 (or stack 1177 (not (if until (eq until 'empty) context)) 1178 (not (sgml-at-indentation-p)) 1179 (and context 1180 (/= (point) (sgml-tag-start (car context))) 1181 (sgml-unclosed-tag-p (sgml-tag-name (car context))))) 1182 (setq tag-info (ignore-errors (sgml-parse-tag-backward)))) 1183 1184 ;; This tag may enclose things we thought were tags. If so, 1185 ;; discard them. 1186 (while (and context 1187 (> (sgml-tag-end tag-info) 1188 (sgml-tag-end (car context)))) 1189 (setq context (cdr context))) 1190 1191 (cond 1192 ((> (sgml-tag-end tag-info) here) 1193 ;; Oops!! Looks like we were not outside of any tag, after all. 1194 (push tag-info context) 1195 (setq until 'now)) 1196 1197 ;; start-tag 1198 ((eq (sgml-tag-type tag-info) 'open) 1199 (cond 1200 ((null stack) 1201 (if (member-ignore-case (sgml-tag-name tag-info) ignore) 1202 ;; There was an implicit end-tag. 1203 nil 1204 (push tag-info context) 1205 ;; We're changing context so the tags implicitly closed inside 1206 ;; the previous context aren't implicitly closed here any more. 1207 ;; [ Well, actually it depends, but we don't have the info about 1208 ;; when it doesn't and when it does. --Stef ] 1209 (setq ignore nil))) 1210 ((eq t (compare-strings (sgml-tag-name tag-info) nil nil 1211 (car stack) nil nil t)) 1212 (setq stack (cdr stack))) 1213 (t 1214 ;; The open and close tags don't match. 1215 (if (not sgml-xml-mode) 1216 (unless (sgml-unclosed-tag-p (sgml-tag-name tag-info)) 1217 (message "Unclosed tag <%s>" (sgml-tag-name tag-info)) 1218 (let ((tmp stack)) 1219 ;; We could just assume that the tag is simply not closed 1220 ;; but it's a bad assumption when tags *are* closed but 1221 ;; not properly nested. 1222 (while (and (cdr tmp) 1223 (not (eq t (compare-strings 1224 (sgml-tag-name tag-info) nil nil 1225 (cadr tmp) nil nil t)))) 1226 (setq tmp (cdr tmp))) 1227 (if (cdr tmp) (setcdr tmp (cddr tmp))))) 1228 (message "Unmatched tags <%s> and </%s>" 1229 (sgml-tag-name tag-info) (pop stack))))) 1230 1231 (if (and (null stack) (sgml-unclosed-tag-p (sgml-tag-name tag-info))) 1232 ;; This is a top-level open of an implicitly closed tag, so any 1233 ;; occurrence of such an open tag at the same level can be ignored 1234 ;; because it's been implicitly closed. 1235 (push (sgml-tag-name tag-info) ignore))) 1236 1237 ;; end-tag 1238 ((eq (sgml-tag-type tag-info) 'close) 1239 (if (sgml-empty-tag-p (sgml-tag-name tag-info)) 1240 (message "Spurious </%s>: empty tag" (sgml-tag-name tag-info)) 1241 (push (sgml-tag-name tag-info) stack))) 1242 )) 1243 1244 ;; return context 1245 context)) 1246 1247(defun sgml-show-context (&optional full) 1248 "Display the current context. 1249If FULL is non-nil, parse back to the beginning of the buffer." 1250 (interactive "P") 1251 (with-output-to-temp-buffer "*XML Context*" 1252 (save-excursion 1253 (let ((context (sgml-get-context))) 1254 (when full 1255 (let ((more nil)) 1256 (while (setq more (sgml-get-context)) 1257 (setq context (nconc more context))))) 1258 (pp context))))) 1259 1260 1261;; Editing shortcuts 1262 1263(defun sgml-close-tag () 1264 "Close current element. 1265Depending on context, inserts a matching close-tag, or closes 1266the current start-tag or the current comment or the current cdata, ..." 1267 (interactive) 1268 (case (car (sgml-lexical-context)) 1269 (comment (insert " -->")) 1270 (cdata (insert "]]>")) 1271 (pi (insert " ?>")) 1272 (jsp (insert " %>")) 1273 (tag (insert " />")) 1274 (text 1275 (let ((context (save-excursion (sgml-get-context)))) 1276 (if context 1277 (progn 1278 (insert "</" (sgml-tag-name (car (last context))) ">") 1279 (indent-according-to-mode))))) 1280 (otherwise 1281 (error "Nothing to close")))) 1282 1283(defun sgml-empty-tag-p (tag-name) 1284 "Return non-nil if TAG-NAME is an implicitly empty tag." 1285 (and (not sgml-xml-mode) 1286 (member-ignore-case tag-name sgml-empty-tags))) 1287 1288(defun sgml-unclosed-tag-p (tag-name) 1289 "Return non-nil if TAG-NAME is a tag for which an end-tag is optional." 1290 (and (not sgml-xml-mode) 1291 (member-ignore-case tag-name sgml-unclosed-tags))) 1292 1293(defun sgml-calculate-indent (&optional lcon) 1294 "Calculate the column to which this line should be indented. 1295LCON is the lexical context, if any." 1296 (unless lcon (setq lcon (sgml-lexical-context))) 1297 1298 ;; Indent comment-start markers inside <!-- just like comment-end markers. 1299 (if (and (eq (car lcon) 'tag) 1300 (looking-at "--") 1301 (save-excursion (goto-char (cdr lcon)) (looking-at "<!--"))) 1302 (setq lcon (cons 'comment (+ (cdr lcon) 2)))) 1303 1304 (case (car lcon) 1305 1306 (string 1307 ;; Go back to previous non-empty line. 1308 (while (and (> (point) (cdr lcon)) 1309 (zerop (forward-line -1)) 1310 (looking-at "[ \t]*$"))) 1311 (if (> (point) (cdr lcon)) 1312 ;; Previous line is inside the string. 1313 (current-indentation) 1314 (goto-char (cdr lcon)) 1315 (1+ (current-column)))) 1316 1317 (comment 1318 (let ((mark (looking-at "--"))) 1319 ;; Go back to previous non-empty line. 1320 (while (and (> (point) (cdr lcon)) 1321 (zerop (forward-line -1)) 1322 (or (looking-at "[ \t]*$") 1323 (if mark (not (looking-at "[ \t]*--")))))) 1324 (if (> (point) (cdr lcon)) 1325 ;; Previous line is inside the comment. 1326 (skip-chars-forward " \t") 1327 (goto-char (cdr lcon)) 1328 ;; Skip `<!' to get to the `--' with which we want to align. 1329 (search-forward "--") 1330 (goto-char (match-beginning 0))) 1331 (when (and (not mark) (looking-at "--")) 1332 (forward-char 2) (skip-chars-forward " \t")) 1333 (current-column))) 1334 1335 ;; We don't know how to indent it. Let's be honest about it. 1336 (cdata nil) 1337 1338 (tag 1339 (goto-char (1+ (cdr lcon))) 1340 (skip-chars-forward "^ \t\n") ;Skip tag name. 1341 (skip-chars-forward " \t") 1342 (if (not (eolp)) 1343 (current-column) 1344 ;; This is the first attribute: indent. 1345 (goto-char (1+ (cdr lcon))) 1346 (+ (current-column) sgml-basic-offset))) 1347 1348 (text 1349 (while (looking-at "</") 1350 (forward-sexp 1) 1351 (skip-chars-forward " \t")) 1352 (let* ((here (point)) 1353 (unclosed (and ;; (not sgml-xml-mode) 1354 (looking-at sgml-tag-name-re) 1355 (member-ignore-case (match-string 1) 1356 sgml-unclosed-tags) 1357 (match-string 1))) 1358 (context 1359 ;; If possible, align on the previous non-empty text line. 1360 ;; Otherwise, do a more serious parsing to find the 1361 ;; tag(s) relative to which we should be indenting. 1362 (if (and (not unclosed) (skip-chars-backward " \t") 1363 (< (skip-chars-backward " \t\n") 0) 1364 (back-to-indentation) 1365 (> (point) (cdr lcon))) 1366 nil 1367 (goto-char here) 1368 (nreverse (sgml-get-context (if unclosed nil 'empty))))) 1369 (there (point))) 1370 ;; Ignore previous unclosed start-tag in context. 1371 (while (and context unclosed 1372 (eq t (compare-strings 1373 (sgml-tag-name (car context)) nil nil 1374 unclosed nil nil t))) 1375 (setq context (cdr context))) 1376 ;; Indent to reflect nesting. 1377 (cond 1378 ;; If we were not in a text context after all, let's try again. 1379 ((and context (> (sgml-tag-end (car context)) here)) 1380 (goto-char here) 1381 (sgml-calculate-indent 1382 (cons (if (memq (sgml-tag-type (car context)) '(comment cdata)) 1383 (sgml-tag-type (car context)) 'tag) 1384 (sgml-tag-start (car context))))) 1385 ;; Align on the first element after the nearest open-tag, if any. 1386 ((and context 1387 (goto-char (sgml-tag-end (car context))) 1388 (skip-chars-forward " \t\n") 1389 (< (point) here) (sgml-at-indentation-p)) 1390 (current-column)) 1391 (t 1392 (goto-char there) 1393 (+ (current-column) 1394 (* sgml-basic-offset (length context))))))) 1395 1396 (otherwise 1397 (error "Unrecognized context %s" (car lcon))) 1398 1399 )) 1400 1401(defun sgml-indent-line () 1402 "Indent the current line as SGML." 1403 (interactive) 1404 (let* ((savep (point)) 1405 (indent-col 1406 (save-excursion 1407 (back-to-indentation) 1408 (if (>= (point) savep) (setq savep nil)) 1409 (sgml-calculate-indent)))) 1410 (if (null indent-col) 1411 'noindent 1412 (if savep 1413 (save-excursion (indent-line-to indent-col)) 1414 (indent-line-to indent-col))))) 1415 1416(defun sgml-guess-indent () 1417 "Guess an appropriate value for `sgml-basic-offset'. 1418Base the guessed identation level on the first indented tag in the buffer. 1419Add this to `sgml-mode-hook' for convenience." 1420 (interactive) 1421 (save-excursion 1422 (goto-char (point-min)) 1423 (if (re-search-forward "^\\([ \t]+\\)<" 500 'noerror) 1424 (progn 1425 (set (make-local-variable 'sgml-basic-offset) 1426 (1- (current-column))) 1427 (message "Guessed sgml-basic-offset = %d" 1428 sgml-basic-offset) 1429 )))) 1430 1431(defun sgml-parse-dtd () 1432 "Simplistic parse of the current buffer as a DTD. 1433Currently just returns (EMPTY-TAGS UNCLOSED-TAGS)." 1434 (goto-char (point-min)) 1435 (let ((empty nil) 1436 (unclosed nil)) 1437 (while (re-search-forward "<!ELEMENT[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+[-O][ \t\n]+\\([-O]\\)[ \t\n]+\\([^ \t\n]+\\)" nil t) 1438 (cond 1439 ((string= (match-string 3) "EMPTY") 1440 (push (match-string-no-properties 1) empty)) 1441 ((string= (match-string 2) "O") 1442 (push (match-string-no-properties 1) unclosed)))) 1443 (setq empty (sort (mapcar 'downcase empty) 'string<)) 1444 (setq unclosed (sort (mapcar 'downcase unclosed) 'string<)) 1445 (list empty unclosed))) 1446 1447;;; HTML mode 1448 1449(defcustom html-mode-hook nil 1450 "Hook run by command `html-mode'. 1451`text-mode-hook' and `sgml-mode-hook' are run first." 1452 :group 'sgml 1453 :type 'hook 1454 :options '(html-autoview-mode)) 1455 1456(defvar html-quick-keys sgml-quick-keys 1457 "Use C-c X combinations for quick insertion of frequent tags when non-nil. 1458This defaults to `sgml-quick-keys'. 1459This takes effect when first loading the library.") 1460 1461(defvar html-mode-map 1462 (let ((map (make-sparse-keymap)) 1463 (menu-map (make-sparse-keymap "HTML"))) 1464 (set-keymap-parent map sgml-mode-map) 1465 (define-key map "\C-c6" 'html-headline-6) 1466 (define-key map "\C-c5" 'html-headline-5) 1467 (define-key map "\C-c4" 'html-headline-4) 1468 (define-key map "\C-c3" 'html-headline-3) 1469 (define-key map "\C-c2" 'html-headline-2) 1470 (define-key map "\C-c1" 'html-headline-1) 1471 (define-key map "\C-c\r" 'html-paragraph) 1472 (define-key map "\C-c\n" 'html-line) 1473 (define-key map "\C-c\C-c-" 'html-horizontal-rule) 1474 (define-key map "\C-c\C-co" 'html-ordered-list) 1475 (define-key map "\C-c\C-cu" 'html-unordered-list) 1476 (define-key map "\C-c\C-cr" 'html-radio-buttons) 1477 (define-key map "\C-c\C-cc" 'html-checkboxes) 1478 (define-key map "\C-c\C-cl" 'html-list-item) 1479 (define-key map "\C-c\C-ch" 'html-href-anchor) 1480 (define-key map "\C-c\C-cn" 'html-name-anchor) 1481 (define-key map "\C-c\C-ci" 'html-image) 1482 (when html-quick-keys 1483 (define-key map "\C-c-" 'html-horizontal-rule) 1484 (define-key map "\C-co" 'html-ordered-list) 1485 (define-key map "\C-cu" 'html-unordered-list) 1486 (define-key map "\C-cr" 'html-radio-buttons) 1487 (define-key map "\C-cc" 'html-checkboxes) 1488 (define-key map "\C-cl" 'html-list-item) 1489 (define-key map "\C-ch" 'html-href-anchor) 1490 (define-key map "\C-cn" 'html-name-anchor) 1491 (define-key map "\C-ci" 'html-image)) 1492 (define-key map "\C-c\C-s" 'html-autoview-mode) 1493 (define-key map "\C-c\C-v" 'browse-url-of-buffer) 1494 (define-key map [menu-bar html] (cons "HTML" menu-map)) 1495 (define-key menu-map [html-autoview-mode] 1496 '("Toggle Autoviewing" . html-autoview-mode)) 1497 (define-key menu-map [browse-url-of-buffer] 1498 '("View Buffer Contents" . browse-url-of-buffer)) 1499 (define-key menu-map [nil] '("--")) 1500 ;;(define-key menu-map "6" '("Heading 6" . html-headline-6)) 1501 ;;(define-key menu-map "5" '("Heading 5" . html-headline-5)) 1502 ;;(define-key menu-map "4" '("Heading 4" . html-headline-4)) 1503 (define-key menu-map "3" '("Heading 3" . html-headline-3)) 1504 (define-key menu-map "2" '("Heading 2" . html-headline-2)) 1505 (define-key menu-map "1" '("Heading 1" . html-headline-1)) 1506 (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons)) 1507 (define-key menu-map "c" '("Checkboxes" . html-checkboxes)) 1508 (define-key menu-map "l" '("List Item" . html-list-item)) 1509 (define-key menu-map "u" '("Unordered List" . html-unordered-list)) 1510 (define-key menu-map "o" '("Ordered List" . html-ordered-list)) 1511 (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule)) 1512 (define-key menu-map "\n" '("Line Break" . html-line)) 1513 (define-key menu-map "\r" '("Paragraph" . html-paragraph)) 1514 (define-key menu-map "i" '("Image" . html-image)) 1515 (define-key menu-map "h" '("Href Anchor" . html-href-anchor)) 1516 (define-key menu-map "n" '("Name Anchor" . html-name-anchor)) 1517 map) 1518 "Keymap for commands for use in HTML mode.") 1519 1520(defvar html-face-tag-alist 1521 '((bold . "b") 1522 (italic . "i") 1523 (underline . "u") 1524 (modeline . "rev")) 1525 "Value of `sgml-face-tag-alist' for HTML mode.") 1526 1527(defvar html-tag-face-alist 1528 '(("b" . bold) 1529 ("big" . bold) 1530 ("blink" . highlight) 1531 ("cite" . italic) 1532 ("em" . italic) 1533 ("h1" bold underline) 1534 ("h2" bold-italic underline) 1535 ("h3" italic underline) 1536 ("h4" . underline) 1537 ("h5" . underline) 1538 ("h6" . underline) 1539 ("i" . italic) 1540 ("rev" . modeline) 1541 ("s" . underline) 1542 ("small" . default) 1543 ("strong" . bold) 1544 ("title" bold underline) 1545 ("tt" . default) 1546 ("u" . underline) 1547 ("var" . italic)) 1548 "Value of `sgml-tag-face-alist' for HTML mode.") 1549 1550(defvar html-display-text 1551 '((img . "[/]") 1552 (hr . "----------") 1553 (li . "o ")) 1554 "Value of `sgml-display-text' for HTML mode.") 1555 1556 1557;; should code exactly HTML 3 here when that is finished 1558(defvar html-tag-alist 1559 (let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7"))) 1560 (1-9 `(,@1-7 ("8") ("9"))) 1561 (align '(("align" ("left") ("center") ("right")))) 1562 (valign '(("top") ("middle") ("bottom") ("baseline"))) 1563 (rel '(("next") ("previous") ("parent") ("subdocument") ("made"))) 1564 (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:") 1565 ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:") 1566 ("wais:") ("/cgi-bin/"))) 1567 (name '("name")) 1568 (link `(,href 1569 ("rel" ,@rel) 1570 ("rev" ,@rel) 1571 ("title"))) 1572 (list '((nil \n ("List item: " "<li>" str 1573 (if sgml-xml-mode "</li>") \n)))) 1574 (cell `(t 1575 ,@align 1576 ("valign" ,@valign) 1577 ("colspan" ,@1-9) 1578 ("rowspan" ,@1-9) 1579 ("nowrap" t)))) 1580 ;; put ,-expressions first, else byte-compile chokes (as of V19.29) 1581 ;; and like this it's more efficient anyway 1582 `(("a" ,name ,@link) 1583 ("base" t ,@href) 1584 ("dir" ,@list) 1585 ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7) 1586 ("form" (\n _ \n "<input type=\"submit\" value=\"\"" 1587 (if sgml-xml-mode " />" ">")) 1588 ("action" ,@(cdr href)) ("method" ("get") ("post"))) 1589 ("h1" ,@align) 1590 ("h2" ,@align) 1591 ("h3" ,@align) 1592 ("h4" ,@align) 1593 ("h5" ,@align) 1594 ("h6" ,@align) 1595 ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align) 1596 ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom")) 1597 ("src") ("alt") ("width" "1") ("height" "1") 1598 ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t)) 1599 ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name 1600 ("type" ("text") ("password") ("checkbox") ("radio") 1601 ("submit") ("reset")) 1602 ("value")) 1603 ("link" t ,@link) 1604 ("menu" ,@list) 1605 ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1"))) 1606 ("p" t ,@align) 1607 ("select" (nil \n 1608 ("Text: " 1609 "<option>" str (if sgml-xml-mode "</option>") \n)) 1610 ,name ("size" ,@1-9) ("multiple" t)) 1611 ("table" (nil \n 1612 ((completing-read "Cell kind: " '(("td") ("th")) 1613 nil t "t") 1614 "<tr><" str ?> _ 1615 (if sgml-xml-mode (concat "<" str "></tr>")) \n)) 1616 ("border" t ,@1-9) ("width" "10") ("cellpadding")) 1617 ("td" ,@cell) 1618 ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9)) 1619 ("th" ,@cell) 1620 ("ul" ,@list ("type" ("disc") ("circle") ("square"))) 1621 1622 ,@sgml-tag-alist 1623 1624 ("abbrev") 1625 ("acronym") 1626 ("address") 1627 ("array" (nil \n 1628 ("Item: " "<item>" str (if sgml-xml-mode "</item>") \n)) 1629 "align") 1630 ("au") 1631 ("b") 1632 ("big") 1633 ("blink") 1634 ("blockquote" \n) 1635 ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#") 1636 ("link" "#") ("alink" "#") ("vlink" "#")) 1637 ("box" (nil _ "<over>" _ (if sgml-xml-mode "</over>"))) 1638 ("br" t ("clear" ("left") ("right"))) 1639 ("caption" ("valign" ("top") ("bottom"))) 1640 ("center" \n) 1641 ("cite") 1642 ("code" \n) 1643 ("dd" ,(not sgml-xml-mode)) 1644 ("del") 1645 ("dfn") 1646 ("div") 1647 ("dl" (nil \n 1648 ( "Term: " 1649 "<dt>" str (if sgml-xml-mode "</dt>") 1650 "<dd>" _ (if sgml-xml-mode "</dd>") \n))) 1651 ("dt" (t _ (if sgml-xml-mode "</dt>") 1652 "<dd>" (if sgml-xml-mode "</dd>") \n)) 1653 ("em") 1654 ;("fn" "id" "fn") ; ??? 1655 ("head" \n) 1656 ("html" (\n 1657 "<head>\n" 1658 "<title>" (setq str (read-input "Title: ")) "</title>\n" 1659 "</head>\n" 1660 "<body>\n<h1>" str "</h1>\n" _ 1661 "\n<address>\n<a href=\"mailto:" 1662 user-mail-address 1663 "\">" (user-full-name) "</a>\n</address>\n" 1664 "</body>" 1665 )) 1666 ("i") 1667 ("ins") 1668 ("isindex" t ("action") ("prompt")) 1669 ("kbd") 1670 ("lang") 1671 ("li" ,(not sgml-xml-mode)) 1672 ("math" \n) 1673 ("nobr") 1674 ("option" t ("value") ("label") ("selected" t)) 1675 ("over" t) 1676 ("person") 1677 ("pre" \n) 1678 ("q") 1679 ("rev") 1680 ("s") 1681 ("samp") 1682 ("small") 1683 ("span" nil 1684 ("class" 1685 ("builtin") 1686 ("comment") 1687 ("constant") 1688 ("function-name") 1689 ("keyword") 1690 ("string") 1691 ("type") 1692 ("variable-name") 1693 ("warning"))) 1694 ("strong") 1695 ("sub") 1696 ("sup") 1697 ("title") 1698 ("tr" t) 1699 ("tt") 1700 ("u") 1701 ("var") 1702 ("wbr" t))) 1703 "*Value of `sgml-tag-alist' for HTML mode.") 1704 1705(defvar html-tag-help 1706 `(,@sgml-tag-help 1707 ("a" . "Anchor of point or link elsewhere") 1708 ("abbrev" . "?") 1709 ("acronym" . "?") 1710 ("address" . "Formatted mail address") 1711 ("array" . "Math array") 1712 ("au" . "?") 1713 ("b" . "Bold face") 1714 ("base" . "Base address for URLs") 1715 ("big" . "Font size") 1716 ("blink" . "Blinking text") 1717 ("blockquote" . "Indented quotation") 1718 ("body" . "Document body") 1719 ("box" . "Math fraction") 1720 ("br" . "Line break") 1721 ("caption" . "Table caption") 1722 ("center" . "Centered text") 1723 ("changed" . "Change bars") 1724 ("cite" . "Citation of a document") 1725 ("code" . "Formatted source code") 1726 ("dd" . "Definition of term") 1727 ("del" . "?") 1728 ("dfn" . "?") 1729 ("dir" . "Directory list (obsolete)") 1730 ("dl" . "Definition list") 1731 ("dt" . "Term to be definined") 1732 ("em" . "Emphasized") 1733 ("embed" . "Embedded data in foreign format") 1734 ("fig" . "Figure") 1735 ("figa" . "Figure anchor") 1736 ("figd" . "Figure description") 1737 ("figt" . "Figure text") 1738 ;("fn" . "?") ; ??? 1739 ("font" . "Font size") 1740 ("form" . "Form with input fields") 1741 ("group" . "Document grouping") 1742 ("h1" . "Most important section headline") 1743 ("h2" . "Important section headline") 1744 ("h3" . "Section headline") 1745 ("h4" . "Minor section headline") 1746 ("h5" . "Unimportant section headline") 1747 ("h6" . "Least important section headline") 1748 ("head" . "Document header") 1749 ("hr" . "Horizontal rule") 1750 ("html" . "HTML Document") 1751 ("i" . "Italic face") 1752 ("img" . "Graphic image") 1753 ("input" . "Form input field") 1754 ("ins" . "?") 1755 ("isindex" . "Input field for index search") 1756 ("kbd" . "Keybard example face") 1757 ("lang" . "Natural language") 1758 ("li" . "List item") 1759 ("link" . "Link relationship") 1760 ("math" . "Math formula") 1761 ("menu" . "Menu list (obsolete)") 1762 ("mh" . "Form mail header") 1763 ("nextid" . "Allocate new id") 1764 ("nobr" . "Text without line break") 1765 ("ol" . "Ordered list") 1766 ("option" . "Selection list item") 1767 ("over" . "Math fraction rule") 1768 ("p" . "Paragraph start") 1769 ("panel" . "Floating panel") 1770 ("person" . "?") 1771 ("pre" . "Preformatted fixed width text") 1772 ("q" . "?") 1773 ("rev" . "Reverse video") 1774 ("s" . "?") 1775 ("samp" . "Sample text") 1776 ("select" . "Selection list") 1777 ("small" . "Font size") 1778 ("sp" . "Nobreak space") 1779 ("strong" . "Standout text") 1780 ("sub" . "Subscript") 1781 ("sup" . "Superscript") 1782 ("table" . "Table with rows and columns") 1783 ("tb" . "Table vertical break") 1784 ("td" . "Table data cell") 1785 ("textarea" . "Form multiline edit area") 1786 ("th" . "Table header cell") 1787 ("title" . "Document title") 1788 ("tr" . "Table row separator") 1789 ("tt" . "Typewriter face") 1790 ("u" . "Underlined text") 1791 ("ul" . "Unordered list") 1792 ("var" . "Math variable face") 1793 ("wbr" . "Enable <br> within <nobr>")) 1794"*Value of `sgml-tag-help' for HTML mode.") 1795 1796 1797;;;###autoload 1798(define-derived-mode html-mode sgml-mode "HTML" 1799 "Major mode based on SGML mode for editing HTML documents. 1800This allows inserting skeleton constructs used in hypertext documents with 1801completion. See below for an introduction to HTML. Use 1802\\[browse-url-of-buffer] to see how this comes out. See also `sgml-mode' on 1803which this is based. 1804 1805Do \\[describe-variable] html- SPC and \\[describe-variable] sgml- SPC to see available variables. 1806 1807To write fairly well formatted pages you only need to know few things. Most 1808browsers have a function to read the source code of the page being seen, so 1809you can imitate various tricks. Here's a very short HTML primer which you 1810can also view with a browser to see what happens: 1811 1812<title>A Title Describing Contents</title> should be on every page. Pages can 1813have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6> 1814<hr> Parts can be separated with horizontal rules. 1815 1816<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are 1817ignored unless the text is <pre>preformatted.</pre> Text can be marked as 1818<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-o or 1819Edit/Text Properties/Face commands. 1820 1821Pages can have <a name=\"SOMENAME\">named points</a> and can link other points 1822to them with <a href=\"#SOMENAME\">see also somename</a>. In the same way <a 1823href=\"URL\">see also URL</a> where URL is a filename relative to current 1824directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'. 1825 1826Images in many formats can be inlined with <img src=\"URL\">. 1827 1828If you mainly create your own documents, `sgml-specials' might be 1829interesting. But note that some HTML 2 browsers can't handle `''. 1830To work around that, do: 1831 (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil)) 1832 1833\\{html-mode-map}" 1834 (set (make-local-variable 'sgml-display-text) html-display-text) 1835 (set (make-local-variable 'sgml-tag-face-alist) html-tag-face-alist) 1836 (make-local-variable 'sgml-tag-alist) 1837 (make-local-variable 'sgml-face-tag-alist) 1838 (make-local-variable 'sgml-tag-help) 1839 (make-local-variable 'outline-regexp) 1840 (make-local-variable 'outline-heading-end-regexp) 1841 (make-local-variable 'outline-level) 1842 (make-local-variable 'sentence-end-base) 1843 (setq sentence-end-base "[.?!][]\"'$B!I$,1r}(B)}]*\\(<[^>]*>\\)*" 1844 sgml-tag-alist html-tag-alist 1845 sgml-face-tag-alist html-face-tag-alist 1846 sgml-tag-help html-tag-help 1847 outline-regexp "^.*<[Hh][1-6]\\>" 1848 outline-heading-end-regexp "</[Hh][1-6]>" 1849 outline-level (lambda () 1850 (char-before (match-end 0)))) 1851 (setq imenu-create-index-function 'html-imenu-index) 1852 (when sgml-xml-mode (setq mode-name "XHTML")) 1853 (set (make-local-variable 'sgml-empty-tags) 1854 ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd', 1855 ;; plus manual addition of "wbr". 1856 '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input" 1857 "isindex" "link" "meta" "param" "wbr")) 1858 (set (make-local-variable 'sgml-unclosed-tags) 1859 ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'. 1860 '("body" "colgroup" "dd" "dt" "head" "html" "li" "option" 1861 "p" "tbody" "td" "tfoot" "th" "thead" "tr")) 1862 ;; It's for the user to decide if it defeats it or not -stef 1863 ;; (make-local-variable 'imenu-sort-function) 1864 ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose 1865 ) 1866 1867(defvar html-imenu-regexp 1868 "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)" 1869 "*A regular expression matching a head line to be added to the menu. 1870The first `match-string' should be a number from 1-9. 1871The second `match-string' matches extra tags and is ignored. 1872The third `match-string' will be the used in the menu.") 1873 1874(defun html-imenu-index () 1875 "Return a table of contents for an HTML buffer for use with Imenu." 1876 (let (toc-index) 1877 (save-excursion 1878 (goto-char (point-min)) 1879 (while (re-search-forward html-imenu-regexp nil t) 1880 (setq toc-index 1881 (cons (cons (concat (make-string 1882 (* 2 (1- (string-to-number (match-string 1)))) 1883 ?\s) 1884 (match-string 3)) 1885 (line-beginning-position)) 1886 toc-index)))) 1887 (nreverse toc-index))) 1888 1889(define-minor-mode html-autoview-mode 1890 "Toggle automatic viewing via `browse-url-of-buffer' upon saving buffer. 1891With positive prefix ARG always turns viewing on, with negative ARG always off. 1892Can be used as a value for `html-mode-hook'." 1893 nil nil nil 1894 :group 'sgml 1895 (if html-autoview-mode 1896 (add-hook 'after-save-hook 'browse-url-of-buffer nil t) 1897 (remove-hook 'after-save-hook 'browse-url-of-buffer t))) 1898 1899 1900(define-skeleton html-href-anchor 1901 "HTML anchor tag with href attribute." 1902 "URL: " 1903 ;; '(setq input "http:") 1904 "<a href=\"" str "\">" _ "</a>") 1905 1906(define-skeleton html-name-anchor 1907 "HTML anchor tag with name attribute." 1908 "Name: " 1909 "<a name=\"" str "\"" 1910 (if sgml-xml-mode (concat " id=\"" str "\"")) 1911 ">" _ "</a>") 1912 1913(define-skeleton html-headline-1 1914 "HTML level 1 headline tags." 1915 nil 1916 "<h1>" _ "</h1>") 1917 1918(define-skeleton html-headline-2 1919 "HTML level 2 headline tags." 1920 nil 1921 "<h2>" _ "</h2>") 1922 1923(define-skeleton html-headline-3 1924 "HTML level 3 headline tags." 1925 nil 1926 "<h3>" _ "</h3>") 1927 1928(define-skeleton html-headline-4 1929 "HTML level 4 headline tags." 1930 nil 1931 "<h4>" _ "</h4>") 1932 1933(define-skeleton html-headline-5 1934 "HTML level 5 headline tags." 1935 nil 1936 "<h5>" _ "</h5>") 1937 1938(define-skeleton html-headline-6 1939 "HTML level 6 headline tags." 1940 nil 1941 "<h6>" _ "</h6>") 1942 1943(define-skeleton html-horizontal-rule 1944 "HTML horizontal rule tag." 1945 nil 1946 (if sgml-xml-mode "<hr />" "<hr>") \n) 1947 1948(define-skeleton html-image 1949 "HTML image tag." 1950 "Image URL: " 1951 "<img src=\"" str "\" alt=\"" _ "\"" 1952 (if sgml-xml-mode " />" ">")) 1953 1954(define-skeleton html-line 1955 "HTML line break tag." 1956 nil 1957 (if sgml-xml-mode "<br />" "<br>") \n) 1958 1959(define-skeleton html-ordered-list 1960 "HTML ordered list tags." 1961 nil 1962 "<ol>" \n 1963 "<li>" _ (if sgml-xml-mode "</li>") \n 1964 "</ol>") 1965 1966(define-skeleton html-unordered-list 1967 "HTML unordered list tags." 1968 nil 1969 "<ul>" \n 1970 "<li>" _ (if sgml-xml-mode "</li>") \n 1971 "</ul>") 1972 1973(define-skeleton html-list-item 1974 "HTML list item tag." 1975 nil 1976 (if (bolp) nil '\n) 1977 "<li>" _ (if sgml-xml-mode "</li>")) 1978 1979(define-skeleton html-paragraph 1980 "HTML paragraph tag." 1981 nil 1982 (if (bolp) nil ?\n) 1983 "<p>" _ (if sgml-xml-mode "</p>")) 1984 1985(define-skeleton html-checkboxes 1986 "Group of connected checkbox inputs." 1987 nil 1988 '(setq v1 nil 1989 v2 nil) 1990 ("Value: " 1991 "<input type=\"" (identity "checkbox") ; see comment above about identity 1992 "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: "))) 1993 "\" value=\"" str ?\" 1994 (when (y-or-n-p "Set \"checked\" attribute? ") 1995 (funcall skeleton-transformation-function 1996 (if sgml-xml-mode " checked=\"checked\"" " checked"))) 1997 (if sgml-xml-mode " />" ">") 1998 (skeleton-read "Text: " (capitalize str)) 1999 (or v2 (setq v2 (if (y-or-n-p "Newline after text? ") 2000 (funcall skeleton-transformation-function 2001 (if sgml-xml-mode "<br />" "<br>")) 2002 ""))) 2003 \n)) 2004 2005(define-skeleton html-radio-buttons 2006 "Group of connected radio button inputs." 2007 nil 2008 '(setq v1 nil 2009 v2 (cons nil nil)) 2010 ("Value: " 2011 "<input type=\"" (identity "radio") ; see comment above about identity 2012 "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: "))) 2013 "\" value=\"" str ?\" 2014 (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? "))) 2015 (funcall skeleton-transformation-function 2016 (if sgml-xml-mode " checked=\"checked\"" " checked"))) 2017 (if sgml-xml-mode " />" ">") 2018 (skeleton-read "Text: " (capitalize str)) 2019 (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ") 2020 (funcall skeleton-transformation-function 2021 (if sgml-xml-mode "<br />" "<br>")) 2022 ""))) 2023 \n)) 2024 2025(provide 'sgml-mode) 2026 2027;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401 2028;;; sgml-mode.el ends here 2029