emacs: lisp/textmodes/sgml-mode.el comparison

comparison lisp/textmodes/sgml-mode.el @ 40320:66ba1d523634

(sgml-font-lock-keywords-1): Ignore comments. (sgml-font-lock-keywords-2): Use `eval'. Moved from sgml-mode-common. (sgml-font-lock-syntactic-keywords): New var. (sgml-mode-common): Drop the two args. Don't make buffer-local variables that aren't used. Don't set sgml-font-lock-keywords-2 now that it uses `eval instead. Don't set `before-string' props from sgml-display-text. (sgml-mode): Use define-derived-mode. (sgml-tags-invisible): Use sgml-display-text. (sgml-quote): New command. (html-tag-alist): Add args for `span'. (html-mode): Use define-derived-mode. Set sgml-display-text and sgml-tag-face-alist.

author	Stefan Monnier <monnier@iro.umontreal.ca>
date	Thu, 25 Oct 2001 22:25:30 +0000
parents	744190a4880c
children	25129ef47b45

comparison

equal deleted inserted replaced

-:52af99ad587f
+:66ba1d523634
 ;; internal
 (defconst sgml-font-lock-keywords-1
 '(("<\\([!?][a-z][-.a-z0-9]*\\)" 1 font-lock-keyword-face)
 ("<\\(/?[a-z][-.a-z0-9]*\\)" 1 font-lock-function-name-face)
-("[&%][a-z][-.a-z0-9]*;?" . font-lock-variable-name-face)
+("[&%][a-z][-.a-z0-9]*;?" . font-lock-variable-name-face)))
-("<! *--.*-- *>" . font-lock-comment-face)))
+(defconst sgml-font-lock-keywords-2
-(defconst sgml-font-lock-keywords-2 ())
+(append
+sgml-font-lock-keywords-1
+'((eval
+. (cons (concat "<"
+		      (regexp-opt (mapcar 'car sgml-tag-face-alist) t)
+		      "\\([ \t][^>]*\\)?>\\([^<]+\\)</\\1>")
+	      '(3 (cdr (assoc (downcase (match-string 1))
+			      sgml-tag-face-alist))))))))
 ;; for font-lock, but must be defvar'ed after
 ;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above
 (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
 "*Rules for highlighting SGML code.  See also `sgml-tag-face-alist'.")
+(defvar sgml-font-lock-syntactic-keywords
+;; Use the `b' style of comments to avoid interference with the -- ... --
+;; comments recognized when `sgml-specials' includes ?-.
+;; FIXME: beware of <!--> blabla <!--> !!
+'(("\\(<\\)!--" (1 "< b"))
+("--[ \t\n]*\\(>\\)" (1 "> b")))
+"Syntactic keywords for `sgml-mode'.")
 ;; internal
 (defvar sgml-face-tag-alist ()
 "Alist of face and tag name for facemenu.")
 		       (string :tag "Description")))
 :group 'sgml)
 (defvar v2)				; free for skeleton
-(defun sgml-mode-common (sgml-tag-face-alist sgml-display-text)
+(defun sgml-mode-common ()
-"Common code for setting up `sgml-mode' and derived modes.
+"Common code for setting up `sgml-mode' and derived modes."
-SGML-TAG-FACE-ALIST is used for calculating `sgml-font-lock-keywords-2'.
-SGML-DISPLAY-TEXT sets up alternate text for when tags are invisible (see
-varables of same name)."
-(setq local-abbrev-table text-mode-abbrev-table)
-(set-syntax-table sgml-mode-syntax-table)
 (make-local-variable 'indent-line-function)
 (make-local-variable 'paragraph-start)
 (make-local-variable 'paragraph-separate)
 (make-local-variable 'adaptive-fill-regexp)
 (make-local-variable 'sgml-saved-validate-command)
 (make-local-variable 'comment-start)
 (make-local-variable 'comment-end)
 (make-local-variable 'comment-indent-function)
-(make-local-variable 'comment-indent-function)
-(make-local-variable 'sgml-tags-invisible)
 (make-local-variable 'skeleton-transformation)
 (make-local-variable 'skeleton-further-elements)
 (make-local-variable 'skeleton-end-hook)
 (make-local-variable 'font-lock-defaults)
-(make-local-variable 'sgml-font-lock-keywords-1)
-(make-local-variable 'sgml-font-lock-keywords-2)
 (make-local-variable 'facemenu-add-face-function)
 (make-local-variable 'facemenu-end-add-face)
 ;;(make-local-variable 'facemenu-remove-face-function)
-(and sgml-tag-face-alist
-(not (assq 1 sgml-tag-face-alist))
-(nconc sgml-tag-face-alist
-	      `((1 (,(concat "<\\("
-			     (mapconcat 'car sgml-tag-face-alist "\\|")
-			     "\\)\\([ \t].+\\)?>\\(.+\\)</\\1>")
-		    3 (cdr (assoc (downcase (match-string 1))
-',sgml-tag-face-alist)))))))
 (setq indent-line-function 'indent-relative-maybe
 	;; A start or end tag by itself on a line separates a paragraph.
 	;; This is desirable because SGML discards a newline that appears
 	;; immediately after a start tag or immediately before an end tag.
 	paragraph-separate "[ \t]*$\\|\
 	skeleton-end-hook (lambda ()
 			    (or (eolp)
 				(not (or (eq v2 '\n)
 					 (eq (car-safe v2) '\n)))
 				(newline-and-indent)))
-	sgml-font-lock-keywords-2 (append
-				   sgml-font-lock-keywords-1
-				   (cdr (assq 1 sgml-tag-face-alist)))
 	font-lock-defaults '((sgml-font-lock-keywords
 			      sgml-font-lock-keywords-1
 			      sgml-font-lock-keywords-2)
-			     nil
+			     nil t nil nil
-			     t)
+			     (font-lock-syntactic-keywords
+			      . sgml-font-lock-syntactic-keywords))
 	facemenu-add-face-function 'sgml-mode-facemenu-add-face-function)
 ;; This will allow existing comments within declarations to be
 ;; recognized.
 (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
-(set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
+(set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?"))
-(dolist (pair sgml-display-text)
-(put (car pair) 'before-string (cdr pair))))
 (defun sgml-mode-facemenu-add-face-function (face end)
 (if (setq face (cdr (assq face sgml-face-tag-alist)))
 (progn
 	(concat "<" face ">"))
 (error "Face not configured for %s mode" mode-name)))
 ;;;###autoload
-(defun sgml-mode ()
+(define-derived-mode sgml-mode text-mode "SGML"
 "Major mode for editing SGML documents.
 Makes > match <.  Makes / blink matching /.
 Keys <, &, SPC within <>, \" and ' can be electric depending on
 `sgml-quick-keys'.
 Use \\[sgml-validate] to validate your document with an SGML parser.
 Do \\[describe-variable] sgml- SPC to see available variables.
 Do \\[describe-key] on the following bindings to discover what they do.
 \\{sgml-mode-map}"
-(interactive)
+(sgml-mode-common)
-(kill-all-local-variables)
-(setq mode-name "SGML"
-	major-mode 'sgml-mode)
-(sgml-mode-common sgml-tag-face-alist sgml-display-text)
 ;; Set imenu-generic-expression here, rather than in sgml-mode-common,
 ;; because this definition probably is not useful in HTML mode.
 (make-local-variable 'imenu-generic-expression)
 (setq imenu-generic-expression
-	"<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\([A-Za-z][-A-Za-z.0-9]*\\)")
+	"<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\([A-Za-z][-A-Za-z.0-9]*\\)"))
-(use-local-map sgml-mode-map)
-(run-hooks 'text-mode-hook 'sgml-mode-hook))
 (defun sgml-comment-indent ()
 (if (looking-at "--") comment-column 0))
 	(inhibit-modification-hooks t)
 	;; Avoid spurious the `file-locked' checks.
 	(buffer-file-name nil)
 	;; This is needed in case font lock gets called,
 	;; since it moves point and might call sgml-point-entered.
+	;; How could it get called?  -stef
 	(inhibit-point-motion-hooks t)
-	symbol)
+	string)
 (unwind-protect
 	(save-excursion
 	  (goto-char (point-min))
 	  (if (setq sgml-tags-invisible
 		    (if arg
 			(>= (prefix-numeric-value arg) 0)
 		      (not sgml-tags-invisible)))
 	      (while (re-search-forward "<\\([!/?A-Za-z][-A-Za-z0-9]*\\)"
 					nil t)
-		(setq symbol (intern-soft (downcase (match-string 1))))
+		(setq string
+		      (cdr (assq (intern-soft (downcase (match-string 1)))
+				 sgml-display-text)))
 		(goto-char (match-beginning 0))
-		(and (get symbol 'before-string)
+		(and (stringp string)
 		     (not (overlays-at (point)))
 		     (overlay-put (make-overlay (point)
 						(match-beginning 1))
-				  'category symbol))
+				  'before-string string))
 		(put-text-property (point)
 				   (progn (forward-list) (point))
 				   'category 'sgml-tag))
-	    (let ((pos (point)))
+	    (let ((pos (point-min)))
 	      (while (< (setq pos (next-overlay-change pos)) (point-max))
 		(delete-overlay (car (overlays-at pos)))))
-	    (remove-text-properties (point-min) (point-max)
+	    (remove-text-properties (point-min) (point-max) '(category nil))))
-				    '(category sgml-tag intangible t))))
 (restore-buffer-modified-p modified))
 (run-hooks 'sgml-tags-invisible-hook)
 (message "")))
 (defun sgml-point-entered (x y)
 		(delete-backward-char 2))))
 (insert "=\"")
 (if alist
 	  (insert (skeleton-read '(completing-read "Value: " alist))))
 (insert ?\"))))
+(defun sgml-quote (start end &optional unquotep)
+"Quote SGML text in region.
+With prefix argument, unquote the region."
+(interactive "r\np")
+(if (< start end)
+(goto-char start)
+(goto-char end)
+(setq end start))
+(if unquotep
+(while (re-search-forward "&\\(amp\\|\\(l\\|\\(g\\)\\)t\\);" end t)
+	(replace-match (if (match-end 3) ">" (if (match-end 2) "<" "&"))))
+(while (re-search-forward "[&<>]" end t)
+(replace-match (cdr (assq (char-before) '((?& . "&amp;")
+						(?< . "&lt;")
+						(?> . "&gt;"))))))))
 ;;; HTML mode
 (defcustom html-mode-hook nil
 ("q")
 ("rev")
 ("s")
 ("samp")
 ("small")
-("span")
+("span" nil
+	("class"
+	 ("builtin")
+	 ("comment")
+	 ("constant")
+	 ("function-name")
+	 ("keyword")
+	 ("string")
+	 ("type")
+	 ("variable-name")
+	 ("warning")))
 ("strong")
 ("sub")
 ("sup")
 ("title")
 ("tr" t)
 ("var" . "Math variable face")
 ("wbr" . "Enable <br> within <nobr>"))
 "*Value of `sgml-tag-help' for HTML mode.")
 ;;;###autoload
-(defun html-mode ()
+(define-derived-mode html-mode sgml-mode "HTML"
 "Major mode based on SGML mode for editing HTML documents.
 This allows inserting skeleton constructs used in hypertext documents with
 completion.  See below for an introduction to HTML.  Use
 \\[browse-url-of-buffer] to see how this comes out.  See also `sgml-mode' on
 which this is based.
 interesting.  But note that some HTML 2 browsers can't handle `&apos;'.
 To work around that, do:
 (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
 \\{html-mode-map}"
-(interactive)
+(set (make-local-variable 'sgml-display-text) html-display-text)
-(kill-all-local-variables)
+(set (make-local-variable 'sgml-tag-face-alist) html-tag-face-alist)
-(setq mode-name "HTML"
-major-mode 'html-mode)
-(sgml-mode-common html-tag-face-alist html-display-text)
-(use-local-map html-mode-map)
 (make-local-variable 'sgml-tag-alist)
 (make-local-variable 'sgml-face-tag-alist)
 (make-local-variable 'sgml-tag-help)
 (make-local-variable 'outline-regexp)
 (make-local-variable 'outline-heading-end-regexp)
 (make-local-variable 'outline-level)
 (make-local-variable 'sentence-end)
 (setq sentence-end
 	(if sentence-end-double-space
 	    "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\| $\\|\t\\|  \\)[ \t\n]*"
+	  "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\|[ \t]\\)[ \t\n]*"))
-	  "[.?!][]\"')}]*\\(<[^>]*>\\)*\\($\\| \\|\t\\)[ \t\n]*"))
 (setq sgml-tag-alist html-tag-alist
 	sgml-face-tag-alist html-face-tag-alist
 	sgml-tag-help html-tag-help
 	outline-regexp "^.*<[Hh][1-6]\\>"
 	outline-heading-end-regexp "</[Hh][1-6]>"
 			(char-after (1- (match-end 0)))))
 (setq imenu-create-index-function 'html-imenu-index)
 ;; It's for the user to decide if it defeats it or not  -stef
 ;; (make-local-variable 'imenu-sort-function)
 ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
-(run-hooks 'text-mode-hook 'sgml-mode-hook 'html-mode-hook))
+)
 (defvar html-imenu-regexp
 "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
 "*A regular expression matching a head line to be added to the menu.
 The first `match-string' should be a number from 1-9.

Mercurial > emacs

comparison lisp/textmodes/sgml-mode.el @ 40320:66ba1d523634