# HG changeset patch # User Richard M. Stallman # Date 781525406 0 # Node ID fec6bd86e836ba9e9f5e142791e83a1149e0c04a # Parent c9b5541ec9f5625caa85ec465ca336bdd75dbce3 (compilation-mode-font-lock-keywords, rmail-summary-font-lock-keywords, dired-font-lock-keywords, shell-font-lock-keywords, texi-font-lock-keywords, perl-font-lock-keywords): Deleted. (font-lock-mode): Doc fix; use add/remove-hook, not setq; removed make-local-variable of font-lock-no-comments. (font-lock-set-defaults): Do it there, and use: (font-lock-defaults-alist): Use it to set font-lock-keywords, font-lock-keywords-case-fold-search and font-lock-no-comments. (turn-on-font-lock): New function. (font-lock-fontify-buffer): Made interruptible; deleted messages. (font-lock-fontify-region): Made syntax state reliable by widening within new restriction; let cstart and cend for speed; outputs message. (font-lock-after-change-function): Remove spurious goto-char and use forward-line, not 1+ end-of-line, for end of fontification region. (font-lock-any-properties-p): Removed, use text-property-not-all. (font-lock-*-face): facename values are themselves. (font-lock-variable-name-face, font-lock-reference-face): New vars. (font-lock-doc-string-face): Removed. (font-lock-keywords): Extended value syntax. (font-lock-hack-keywords): Cope with it; outputs initial message. Merged in face-lock.el: (font-lock-display-type, font-lock-background-mode) (font-lock-face-attributes): New variables, use it. (font-lock-make-face): New function, use them. diff -r c9b5541ec9f5 -r fec6bd86e836 lisp/font-lock.el --- a/lisp/font-lock.el Fri Oct 07 10:20:37 1994 +0000 +++ b/lisp/font-lock.el Fri Oct 07 10:23:26 1994 +0000 @@ -1,7 +1,7 @@ ;; Electric Font Lock Mode ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. -;; Author: jwz, then rms +;; Author: jwz, then rms and sm (simon.marshall@mail.esrin.esa.it) ;; Maintainer: FSF ;; Keywords: languages, faces @@ -30,10 +30,7 @@ ;; ;; Comments will be displayed in `font-lock-comment-face'. ;; Strings will be displayed in `font-lock-string-face'. -;; Doc strings will be displayed in `font-lock-doc-string-face'. -;; Function and variable names (in their defining forms) will be -;; displayed in `font-lock-function-name-face'. -;; Reserved words will be displayed in `font-lock-keyword-face'. +;; Regexps are used to display selected patterns in other faces. ;; ;; To make the text you type be fontified, use M-x font-lock-mode. ;; When this minor mode is on, the fonts of the current line are @@ -44,67 +41,75 @@ ;; ;; To turn this on automatically, add this to your .emacs file: ;; -;; (setq emacs-lisp-mode-hook '(lambda () (font-lock-mode 1))) +;; (setq emacs-lisp-mode-hook 'turn-on-font-lock) ;; -;; On a Sparc2, the initial fontification takes about 12 seconds for a 120k -;; file of C code, using the default configuration. You can speed this up -;; substantially by removing some of the patterns that are highlighted by -;; default. Fontifying Lisp code is significantly faster, because Lisp has a -;; more regular syntax than C, so the expressions don't have to be as hairy. - +;; On a Sparc2, the initial fontification takes about 10 seconds for a 120k +;; file of C code using the default configuration, and about 25 seconds using +;; the more extensive configuration, though times also depend on file contents. +;; You can speed this up substantially by removing some of the patterns that +;; are highlighted by default. Fontifying Lisp code is significantly faster, +;; because Lisp has a more regular syntax than C, so the expressions don't have +;; to be as hairy. +;; +;; Nasty regexps of the form "bar\\(\\|lo\\)\\|f\\(oo\\|u\\(\\|bar\\)\\)\\|lo" +;; are made thusly: (make-regexp '("foo" "fu" "fubar" "bar" "barlo" "lo")) for +;; efficiency. See /pub/gnu/emacs/elisp-archive/functions/make-regexp.el.Z on +;; archive.cis.ohio-state.edu for this and other functions. + ;;; Code: -(defvar font-lock-comment-face - 'italic +(or window-system (error "Can't fontify on an ASCII terminal")) + +(defvar font-lock-comment-face 'font-lock-comment-face "Face to use for comments.") -(defvar font-lock-doc-string-face - 'italic - "Face to use for documentation strings.") +(defvar font-lock-string-face 'font-lock-string-face + "Face to use for strings.") -(defvar font-lock-string-face - 'underline - "Face to use for string constants.") - -(defvar font-lock-function-name-face - 'bold-italic +(defvar font-lock-function-name-face 'font-lock-function-name-face "Face to use for function names.") -(defvar font-lock-keyword-face - 'bold +(defvar font-lock-variable-name-face 'font-lock-variable-name-face + "Face to use for variable names.") + +(defvar font-lock-keyword-face 'font-lock-keyword-face "Face to use for keywords.") -(defvar font-lock-type-face - 'italic +(defvar font-lock-type-face 'font-lock-type-face "Face to use for data types.") +(defvar font-lock-reference-face 'font-lock-reference-face + "Face to use for references.") + (defvar font-lock-no-comments nil "Non-nil means Font-Lock shouldn't check for comments or strings.") (make-variable-buffer-local 'font-lock-keywords) (defvar font-lock-keywords nil "*The keywords to highlight. -If this is a list, then elements may be of the forms: +Elements should be of the form: + + REGEXP + (REGEXP . MATCH) + (REGEXP . FACENAME) + (REGEXP . HIGHLIGHT) + (REGEXP HIGHLIGHT ...) - \"string\" ; A regexp to highlight in the - ; `font-lock-keyword-face'. - (\"string\" . N) ; Highlight subexpression N of the regexp. - (\"string\" . face-name) ; Use the named face - (\"string\" N face-name) ; Both of the above - (\"string\" N face-name t) ; This allows highlighting to override - ; already-highlighted regions. - (\"string\" N face-name keep) ; This allows highlighting to occur - ; even if some parts of what STRING matches - ; are already highlighted--but does not alter - ; the existing highlighting of those parts. +where HIGHLIGHT should be of the form (MATCH FACENAME OVERRIDE LAXMATCH). +REGEXP is the regexp to search for, MATCH is the subexpression of REGEXP to be +highlighted, FACENAME is an expression whose value is the face name to use. +FACENAME's default attributes may be defined in `font-lock-face-attributes'. -These regular expressions should not match text which spans lines. -While \\[font-lock-fontify-buffer] handles multi-line patterns correctly, -updating when you edit the buffer does not, -since it considers text one line at a time. +OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing fontification may +be overriden. If `keep', only parts not already fontified are highlighted. +If LAXMATCH is non-nil, no error is signalled if there is no MATCH in REGEXP. -Be careful composing regexps for this list; the wrong pattern can dramatically -slow things down!") +These regular expressions should not match text which spans lines. While +\\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating +when you edit the buffer does not, since it considers text one line at a time. + +Be careful composing regexps for this list; +the wrong pattern can dramatically slow things down!") (defvar font-lock-keywords-case-fold-search nil "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.") @@ -119,102 +124,244 @@ ;;;###autoload (defvar font-lock-mode-hook nil "Function or functions to run on entry to Font Lock mode.") + +;; Colour etc. support. -;;; These variables record, for each buffer, -;;; the parse state at a particular position, always the start of a line. -;;; This is used to make font-lock-fontify-region faster. +(defvar font-lock-display-type + (let ((display-resource (x-get-resource ".displayType" "DisplayType"))) + (cond (display-resource (intern (downcase display-resource))) + ((x-display-color-p) 'color) + ((x-display-grayscale-p) 'grayscale) + (t 'mono))) + "A symbol indicating the display Emacs is running under. +The symbol should be one of `color', `grayscale' or `mono'. +If Emacs guesses this display attribute wrongly, either set this variable in +your `~/.emacs' file, or set the resource `Emacs.displayType' +in your `~/.Xdefaults' file. +See also `font-lock-background-mode' and `font-lock-face-attributes'.") + +(defvar font-lock-background-mode + (let ((bg-resource (x-get-resource ".backgroundMode" "BackgroundMode")) + (params (frame-parameters))) + (cond (bg-resource (intern (downcase bg-resource))) + ((or (string-equal (cdr (assq 'foreground-color params)) "white") + (string-equal (cdr (assq 'background-color params)) "black")) + 'dark) + (t 'light))) + "A symbol indicating the Emacs background brightness. +The symbol should be one of `light' or `dark'. +If Emacs guesses this frame attribute wrongly, either set this variable in +your `~/.emacs' file or set the resource `Emacs.backgroundMode' +in your `~/.Xdefaults' file. +See also `font-lock-display-type' and `font-lock-face-attributes'.") + +(defvar font-lock-face-attributes + (let ((light-bg (eq font-lock-background-mode 'light))) + (cond ((memq font-lock-display-type '(mono monochrome)) + ;; Emacs 19.25's font-lock defaults: + ;;'((font-lock-comment-face nil nil nil t nil) + ;; (font-lock-string-face nil nil nil nil t) + ;; (font-lock-keyword-face nil nil t nil nil) + ;; (font-lock-function-name-face nil nil t t nil) + ;; (font-lock-type-face nil nil nil t nil)) + (list '(font-lock-comment-face nil nil t t nil) + '(font-lock-string-face nil nil nil t nil) + '(font-lock-keyword-face nil nil t nil nil) + (list 'font-lock-function-name-face + (cdr (assq 'background-color (frame-parameters))) + (cdr (assq 'foreground-color (frame-parameters))) + t nil nil) + '(font-lock-variable-name-face nil nil t t nil) + '(font-lock-type-face nil nil t nil t) + '(font-lock-reference-face nil nil t nil t))) + ((memq font-lock-display-type '(grayscale greyscale + grayshade greyshade)) + (list (list 'font-lock-comment-face + (if light-bg "DimGray" "Gray80") nil t t nil) + (list 'font-lock-string-face + (if light-bg "Gray50" "LightGray") nil nil t nil) + (list 'font-lock-keyword-face + (if light-bg "DimGray" "Gray90") nil t nil nil) + (list 'font-lock-function-name-face + (cdr (assq 'background-color (frame-parameters))) + (cdr (assq 'foreground-color (frame-parameters))) + t nil nil) + (list 'font-lock-variable-name-face + (if light-bg "DimGray" "Gray90") nil t t nil) + (list 'font-lock-type-face + (if light-bg "DimGray" "Gray80") nil t nil t))) + (light-bg ; light colour background + '((font-lock-comment-face "Firebrick") + (font-lock-string-face "RosyBrown") + (font-lock-keyword-face "Purple") + (font-lock-function-name-face "Blue") + (font-lock-variable-name-face "DarkGoldenrod") + (font-lock-type-face "DarkOliveGreen") + (font-lock-reference-face "CadetBlue"))) + (t ; dark colour background + '((font-lock-comment-face "OrangeRed") + (font-lock-string-face "LightSalmon") + (font-lock-keyword-face "LightSteelBlue") + (font-lock-function-name-face "LightSkyBlue") + (font-lock-variable-name-face "LightGoldenrod") + (font-lock-type-face "PaleGreen") + (font-lock-reference-face "Aquamarine"))))) + "A list of default attributes to use for face attributes. +Each element of the list should be of the form + + (FACE FOREGROUND BACKGROUND BOLD-P ITALIC-P UNDERLINE-P) + +where FACE should be one of the face symbols `font-lock-comment-face', +`font-lock-string-face', `font-lock-keyword-face', `font-lock-type-face', +`font-lock-function-name-face', `font-lock-variable-name-face', and +`font-lock-reference-face'. A form for each of these face symbols should be +provided in the list, but other face symbols and attributes may be given and +used in highlighting. See `font-lock-keywords'. + +Subsequent element items should be the attributes for the corresponding +Font Lock mode faces. Attributes FOREGROUND and BACKGROUND should be strings +\(default if nil), while BOLD-P, ITALIC-P, and UNDERLINE-P should specify the +corresponding face attributes (yes if non-nil). + +Emacs uses default attributes based on display type and background brightness. +See variables `font-lock-display-type' and `font-lock-background-mode'. + +Resources can be used to over-ride these face attributes. For example, the +resource `Emacs.font-lock-comment-face.attributeUnderline' can be used to +specify the UNDERLINE-P attribute for face `font-lock-comment-face'.") + +(defun font-lock-make-face (face-attributes) + "Make a face from FACE-ATTRIBUTES. +FACE-ATTRIBUTES should be like an element `font-lock-face-attributes', so that +the face name is the first item in the list. A variable with the same name as +the face is also set; its value is the face name." + (let* ((face (nth 0 face-attributes)) + (face-name (symbol-name face)) + (set-p (function (lambda (face-name resource) + (x-get-resource (concat face-name ".attribute" resource) + (concat "Face.Attribute" resource))))) + (on-p (function (lambda (face-name resource) + (let ((set (funcall set-p face-name resource))) + (and set (member (downcase set) '("on" "true")))))))) + (make-face face) + ;; Set attributes not set from X resources (and therefore `make-face'). + (or (funcall set-p face-name "Foreground") + (condition-case nil + (set-face-foreground face (nth 1 face-attributes)) + (error nil))) + (or (funcall set-p face-name "Background") + (condition-case nil + (set-face-background face (nth 2 face-attributes)) + (error nil))) + (if (funcall set-p face-name "Bold") + (and (funcall on-p face-name "Bold") (make-face-bold face nil t)) + (and (nth 3 face-attributes) (make-face-bold face nil t))) + (if (funcall set-p face-name "Italic") + (and (funcall on-p face-name "Italic") (make-face-italic face nil t)) + (and (nth 4 face-attributes) (make-face-italic face nil t))) + (or (funcall set-p face-name "Underline") + (set-face-underline-p face (nth 5 face-attributes))) + (set face face))) + +;; Fontification. + +;; These variables record, for each buffer, the parse state at a particular +;; position, always the start of a line. Used to make font-lock-fontify-region +;; faster. (defvar font-lock-cache-position nil) (defvar font-lock-cache-state nil) (make-variable-buffer-local 'font-lock-cache-position) (make-variable-buffer-local 'font-lock-cache-state) -(defun font-lock-fontify-region (start end) +(defun font-lock-fontify-region (start end &optional loudly) "Put proper face on each string and comment between START and END." (save-excursion - (goto-char start) - (beginning-of-line) - (setq end (min end (point-max))) - (let ((buffer-read-only nil) - state startline prev prevstate - (modified (buffer-modified-p))) - ;; Find the state at the line-beginning before START. - (setq startline (point)) - (if (eq (point) font-lock-cache-position) - (setq state font-lock-cache-state) - ;; Find outermost containing sexp. - (beginning-of-defun) - ;; Find the state at STARTLINE. - (while (< (point) startline) - (setq state (parse-partial-sexp (point) startline 0))) - (setq font-lock-cache-state state - font-lock-cache-position (point))) - ;; Now find the state precisely at START. - (setq state (parse-partial-sexp (point) start nil nil state)) - ;; If the region starts inside a string, show the extent of it. - (if (nth 3 state) - (let ((beg (point))) - (while (and (re-search-forward "\\s\"" end 'move) - (nth 3 (parse-partial-sexp beg (point) - nil nil state)))) - (put-text-property beg (point) 'face font-lock-string-face) - (setq state (parse-partial-sexp beg (point) nil nil state)))) - ;; Likewise for a comment. - (if (or (nth 4 state) (nth 7 state)) - (let ((beg (point))) - (while (and (re-search-forward (if comment-end - (concat "\\s>\\|" - (regexp-quote comment-end)) - "\\s>") - end 'move) - (nth 3 (parse-partial-sexp beg (point) - nil nil state)))) - (put-text-property beg (point) 'face font-lock-comment-face) - (setq state (parse-partial-sexp beg (point) nil nil state)))) - ;; Find each interesting place between here and END. - (while (and (< (point) end) - (setq prev (point) prevstate state) - (re-search-forward (if comment-start-skip - (concat "\\s\"\\|" comment-start-skip) - "\\s\"") - end t) - ;; Clear out the fonts of what we skip over. - (progn (remove-text-properties prev (point) '(face nil)) t) - ;; Verify the state at that place - ;; so we don't get fooled by \" or \;. - (setq state (parse-partial-sexp prev (point) - nil nil state))) - (let ((here (point))) - (if (or (nth 4 state) (nth 7 state)) - ;; We found a real comment start. - (let ((beg (match-beginning 0))) - (goto-char beg) - (save-restriction - (narrow-to-region (point-min) end) - (condition-case nil - (progn - (forward-comment 1) - ;; forward-comment skips all whitespace, - ;; so go back to the real end of the comment. - (skip-chars-backward " \t")) - (error (goto-char end)))) - (put-text-property beg (point) 'face font-lock-comment-face) - (setq state (parse-partial-sexp here (point) nil nil state))) - (if (nth 3 state) + (save-restriction + (widen) + (goto-char start) + (beginning-of-line) + (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) + (let ((buffer-read-only nil) + (modified (buffer-modified-p)) + (cstart (if comment-start-skip + (concat "\\s\"\\|" comment-start-skip) + "\\s\"")) + (cend (if comment-end + (concat "\\s>\\|" (regexp-quote comment-end)) + "\\s>")) + (startline (point)) + state prev prevstate) + ;; Find the state at the line-beginning before START. + (if (eq (point) font-lock-cache-position) + (setq state font-lock-cache-state) + ;; Find outermost containing sexp. + (beginning-of-defun) + ;; Find the state at STARTLINE. + (while (< (point) startline) + (setq state (parse-partial-sexp (point) startline 0))) + (setq font-lock-cache-state state + font-lock-cache-position (point))) + ;; Now find the state precisely at START. + (setq state (parse-partial-sexp (point) start nil nil state)) + ;; If the region starts inside a string, show the extent of it. + (if (nth 3 state) + (let ((beg (point))) + (while (and (re-search-forward "\\s\"" end 'move) + (nth 3 (parse-partial-sexp beg (point) + nil nil state)))) + (put-text-property beg (point) 'face font-lock-string-face) + (setq state (parse-partial-sexp beg (point) nil nil state)))) + ;; Likewise for a comment. + (if (or (nth 4 state) (nth 7 state)) + (let ((beg (point))) + (while (and (re-search-forward cend end 'move) + (nth 3 (parse-partial-sexp beg (point) + nil nil state)))) + (put-text-property beg (point) 'face font-lock-comment-face) + (setq state (parse-partial-sexp beg (point) nil nil state)))) + ;; Find each interesting place between here and END. + (while (and (< (point) end) + (setq prev (point) prevstate state) + (re-search-forward cstart end t) + (progn + ;; Clear out the fonts of what we skip over. + (remove-text-properties prev (point) '(face nil)) + ;; Verify the state at that place + ;; so we don't get fooled by \" or \;. + (setq state (parse-partial-sexp prev (point) + nil nil state)))) + (let ((here (point))) + (if (or (nth 4 state) (nth 7 state)) + ;; We found a real comment start. (let ((beg (match-beginning 0))) - (while (and (re-search-forward "\\s\"" end 'move) - (nth 3 (parse-partial-sexp here (point) - nil nil state)))) - (put-text-property beg (point) 'face font-lock-string-face) - (setq state (parse-partial-sexp here (point) nil nil state)))) - )) - ;; Make sure PREV is non-nil after the loop - ;; only if it was set on the very last iteration. - (setq prev nil)) - (and prev - (remove-text-properties prev end '(face nil))) - (and (buffer-modified-p) - (not modified) - (set-buffer-modified-p nil))))) + (goto-char beg) + (save-restriction + (narrow-to-region (point-min) end) + (condition-case nil + (progn + (forward-comment 1) + ;; forward-comment skips all whitespace, + ;; so go back to the real end of the comment. + (skip-chars-backward " \t")) + (error (goto-char end)))) + (put-text-property beg (point) 'face font-lock-comment-face) + (setq state (parse-partial-sexp here (point) nil nil state))) + (if (nth 3 state) + (let ((beg (match-beginning 0))) + (while (and (re-search-forward "\\s\"" end 'move) + (nth 3 (parse-partial-sexp here (point) + nil nil state)))) + (put-text-property beg (point) 'face font-lock-string-face) + (setq state (parse-partial-sexp here (point) + nil nil state)))))) + ;; Make sure PREV is non-nil after the loop + ;; only if it was set on the very last iteration. + (setq prev nil)) + (and prev + (remove-text-properties prev end '(face nil))) + (and (buffer-modified-p) + (not modified) + (set-buffer-modified-p nil)))))) ;; This code used to be used to show a string on reaching the end of it. ;; It is probably not needed due to later changes to handle strings @@ -248,87 +395,96 @@ (defun font-lock-after-change-function (beg end old-len) (save-excursion (save-match-data - (goto-char beg) ;; Discard the cache info if text before it has changed. (and font-lock-cache-position (> font-lock-cache-position beg) (setq font-lock-cache-position nil)) - ;; Rescan till end of line. yes! - (goto-char end) - (end-of-line) - (setq end (point)) + ;; Rescan between start of line from `beg' and start of line after `end'. (goto-char beg) (beginning-of-line) (setq beg (point)) + (goto-char end) + (forward-line 1) + (setq end (point)) ;; First scan for strings and comments. ;; Must scan from line start in case of - ;; inserting space into `intfoo () {}'. + ;; inserting space into `intfoo () {}', and after widened. (if font-lock-no-comments - (remove-text-properties beg (min (1+ end) (point-max)) '(face nil)) - (font-lock-fontify-region beg (min (1+ end) (point-max)))) + (remove-text-properties beg end '(face nil)) + (font-lock-fontify-region beg end)) ;; Now scan for keywords. (font-lock-hack-keywords beg end)))) ;;; Fontifying arbitrary patterns -(defsubst font-lock-any-properties-p (start end) - (or (get-text-property start 'face) - (let ((next (next-single-property-change start 'face))) - (and next (< next end))))) - (defun font-lock-hack-keywords (start end &optional loudly) - (goto-char start) + "Fontify according to `font-lock-keywords' between START and END." (let ((case-fold-search font-lock-keywords-case-fold-search) - (rest font-lock-keywords) + (keywords font-lock-keywords) (count 0) (buffer-read-only nil) (modified (buffer-modified-p)) - first str match face s e allow-overlap-p - (old-syntax (syntax-table))) + (old-syntax (syntax-table)) + (bufname (buffer-name))) (unwind-protect - (progn - (if font-lock-syntax-table - (set-syntax-table font-lock-syntax-table)) - (while rest - (setq first (car rest) rest (cdr rest)) + (let (keyword regexp match highlights hs h s e) + (if loudly (message "Fontifying %s... (regexps...)" bufname)) + (if font-lock-syntax-table (set-syntax-table font-lock-syntax-table)) + (while keywords + (setq keyword (car keywords) keywords (cdr keywords) + regexp (if (stringp keyword) keyword (car keyword)) + highlights (cond ((stringp keyword) + '((0 font-lock-keyword-face))) + ((numberp (cdr keyword)) + (list (list (cdr keyword) + 'font-lock-keyword-face))) + ((symbolp (cdr keyword)) + (list (list 0 (cdr keyword)))) + ((nlistp (nth 1 keyword)) + (list (cdr keyword))) + (t + (cdr keyword)))) (goto-char start) - (cond ((consp first) - (setq str (car first)) - (cond ((consp (cdr first)) - (setq match (nth 1 first) - face (eval (nth 2 first)) - allow-overlap-p (nth 3 first))) - ((symbolp (cdr first)) - (setq match 0 allow-overlap-p nil - face (eval (cdr first)))) - (t - (setq match (cdr first) - allow-overlap-p nil - face font-lock-keyword-face)))) - (t - (setq str first match 0 allow-overlap-p nil - face font-lock-keyword-face))) - ;(message "regexp: %s" str) - (while (re-search-forward str end t) - (setq s (match-beginning match) - e (match-end match)) - (or s (error "expression did not match subexpression %d" match)) - ;; don't fontify this keyword if we're already in some other context. - (or (if allow-overlap-p nil (font-lock-any-properties-p s e)) - (if (not (memq allow-overlap-p '(t nil))) - (save-excursion - (goto-char s) - (while (< (point) e) - (let ((next (next-single-property-change (point) 'face - nil e))) - (if (or (null next) (> next e)) - (setq next e)) - (if (not (get-text-property (point) 'face)) - (put-text-property (point) next 'face face)) - (goto-char next)))) - (put-text-property s e 'face face)))) - (if loudly (message "Fontifying %s... (regexps...%s)" - (buffer-name) + (while (re-search-forward regexp end t) + (setq hs highlights) + (while hs + (setq h (car hs) match (nth 0 h) + s (match-beginning match) e (match-end match) + hs (cdr hs)) + (cond ((not s) + ;; No match but we might not signal an error + (or (nth 3 h) + (error "No subexpression %d in expression %d" + match (1+ count)))) + ((and (not (nth 2 h)) + (text-property-not-all s e 'face nil)) + ;; Can't override and already fontified + nil) + ((not (eq (nth 2 h) 'keep)) + ;; Can override but need not keep existing fontification + (put-text-property s e 'face (eval (nth 1 h)))) + (t + ;; Can override but must keep existing fontification + ;; (Does anyone use this? sm.) + (let ((p (text-property-any s e 'face nil)) n + (face (eval (nth 1 h)))) + (while p + (setq n (next-single-property-change p 'face nil e)) + (put-text-property p n 'face face) + (setq p (text-property-any n e 'face nil)))))))) +;; the above form was: +; (save-excursion +; (goto-char s) +; (while (< (point) e) +; (let ((next (next-single-property-change (point) 'face +; nil e))) +; (if (or (null next) (> next e)) +; (setq next e)) +; (if (not (get-text-property (point) 'face)) +; (put-text-property (point) next 'face face)) +; (goto-char next)))) + + (if loudly (message "Fontifying %s... (regexps...%s)" bufname (make-string (setq count (1+ count)) ?.))))) (set-syntax-table old-syntax)) (and (buffer-modified-p) @@ -338,10 +494,6 @@ ;; The user level functions (defvar font-lock-mode nil) ; for modeline -(or (assq 'font-lock-mode minor-mode-alist) - (setq minor-mode-alist - (append minor-mode-alist - '((font-lock-mode " Font"))))) (defvar font-lock-fontified nil) ; whether we have hacked this buffer (put 'font-lock-fontified 'permanent-local t) @@ -353,34 +505,36 @@ When Font Lock mode is enabled, text is fontified as you type it: - - comments are displayed in `font-lock-comment-face'; - (That is a variable whose value should be a face name.) - - strings are displayed in `font-lock-string-face'; - - documentation strings are displayed in `font-lock-doc-string-face'; - - function and variable names in their defining forms are displayed - in `font-lock-function-name-face'; - - and certain other expressions are displayed in other faces - according to the value of the variable `font-lock-keywords'. + - Comments are displayed in `font-lock-comment-face'; + - Strings are displayed in `font-lock-string-face'; + - Certain other expressions are displayed in other faces according to the + value of the variable `font-lock-keywords'. + +You can enable Font Lock mode in any major mode automatically by turning on in +the major mode's hook. For example, put in your ~/.emacs: + + (add-hook 'c-mode-hook 'turn-on-font-lock) + +Or for any visited file with the following in your ~/.emacs: + + (add-hook 'find-file-hooks 'turn-on-font-lock) + +The default Font Lock mode faces and their attributes are defined in the +variable `font-lock-face-attributes', and Font Lock mode default settings in +the variable `font-lock-defaults-alist'. When you turn Font Lock mode on/off, the buffer is fontified/defontified. To fontify a buffer without having newly typed text become fontified, you can use \\[font-lock-fontify-buffer]." (interactive "P") - (let ((on-p (if (null arg) - (not font-lock-mode) - (> (prefix-numeric-value arg) 0)))) + (let ((on-p (if arg (> (prefix-numeric-value arg) 0) (not font-lock-mode)))) (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp... (setq on-p nil)) - (make-local-variable 'after-change-functions) - (if on-p - (or (memq 'font-lock-after-change-function after-change-functions) - (setq after-change-functions (cons 'font-lock-after-change-function - after-change-functions))) - (setq after-change-functions - (delq 'font-lock-after-change-function - (copy-sequence after-change-functions)))) + (if (not on-p) + (remove-hook 'after-change-functions 'font-lock-after-change-function) + (make-local-variable 'after-change-functions) + (add-hook 'after-change-functions 'font-lock-after-change-function)) (set (make-local-variable 'font-lock-mode) on-p) - (make-local-variable 'font-lock-no-comments) (cond (on-p (font-lock-set-defaults) (make-local-variable 'before-revert-hook) @@ -397,6 +551,11 @@ (font-lock-unfontify-region (point-min) (point-max)))) (force-mode-line-update))) +;;;###autoload +(defun turn-on-font-lock () + "Unconditionally turn on Font Lock mode." + (font-lock-mode 1)) + ;; If the buffer is about to be reverted, it won't be fontified. (defun font-lock-revert-setup () (setq font-lock-fontified nil)) @@ -409,49 +568,48 @@ (not font-lock-fontified) (font-lock-mode 1))) +;;;###autoload (defun font-lock-fontify-buffer () - "Fontify the current buffer the way `font-lock-mode' would: - - - comments are displayed in `font-lock-comment-face'; - - strings are displayed in `font-lock-string-face'; - - documentation strings are displayed in `font-lock-doc-string-face'; - - function and variable names in their defining forms are displayed - in `font-lock-function-name-face'; - - and certain other expressions are displayed in other faces - according to the value of the variable `font-lock-keywords'. - -This can take a while for large buffers." + "Fontify the current buffer the way `font-lock-mode' would." (interactive) (let ((was-on font-lock-mode) - (font-lock-verbose (or font-lock-verbose (interactive-p)))) - (if font-lock-verbose (message "Fontifying %s..." (buffer-name))) + (verbose (or font-lock-verbose (interactive-p))) + (modified (buffer-modified-p))) + (make-local-variable 'font-lock-fontified) + (if verbose (message "Fontifying %s..." (buffer-name))) ;; Turn it on to run hooks and get the right font-lock-keywords. (or was-on (font-lock-set-defaults)) - (font-lock-unfontify-region (point-min) (point-max)) - (if (and font-lock-verbose (not font-lock-no-comments)) - (message "Fontifying %s... (syntactically...)" (buffer-name))) - (save-excursion - (or font-lock-no-comments - (font-lock-fontify-region (point-min) (point-max))) - (if font-lock-verbose (message "Fontifying %s... (regexps...)" - (buffer-name))) - (font-lock-hack-keywords (point-min) (point-max) font-lock-verbose)) - (set (make-local-variable 'font-lock-fontified) t) - (if font-lock-verbose (message "Fontifying %s... done." (buffer-name))) - )) + (condition-case nil + (save-excursion + (font-lock-unfontify-region (point-min) (point-max)) + (if (not font-lock-no-comments) + (font-lock-fontify-region (point-min) (point-max) verbose)) + (font-lock-hack-keywords (point-min) (point-max) verbose) + (setq font-lock-fontified t)) + ;; We don't restore the old fontification, so it's best to unfontify. + (quit (font-lock-unfontify-region (point-min) (point-max)) + (setq font-lock-fontified nil))) + (if verbose (message "Fontifying %s... %s." (buffer-name) + (if font-lock-fontified "done" "aborted"))) + (and (buffer-modified-p) + (not modified) + (set-buffer-modified-p nil)))) -;;; Various mode-specific information. +;;; Various information shared by several modes. +;;; Information specific to a single mode should go in its load library. (defconst lisp-font-lock-keywords-1 - '(;; + (list ;; highlight defining forms. This doesn't work too nicely for ;; (defun (setf foo) ...) but it does work for (defvar foo) which ;; is more important. - ("^(def[-a-z]+\\s +\\([^ \t\n\)]+\\)" 1 font-lock-function-name-face) - ;; - ;; highlight CL keywords - ("\\s :\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1) + (list (concat "^(\\(def\\(const\\|ine-key\\(\\|-after\\)\\|var\\)\\)\\>" + "\\s *\\([^ \t\n\)]+\\)?") + '(1 font-lock-keyword-face) '(4 font-lock-variable-name-face nil t)) + (list (concat "^(\\(def\\(a\\(dvice\\|lias\\)\\|macro\\|subst\\|un\\)\\)\\>" + "\\s *\\([^ \t\n\)]+\\)?") + '(1 font-lock-keyword-face) '(4 font-lock-function-name-face nil t)) ;; ;; this is highlights things like (def* (setf foo) (bar baz)), but may ;; be slower (I haven't really thought about it) @@ -464,22 +622,40 @@ (defconst lisp-font-lock-keywords-2 (append lisp-font-lock-keywords-1 - '(;; - ;; Highlight control structures - ("(\\(cond\\|if\\|when\\|unless\\|[ec]?\\(type\\)?case\\)[ \t\n]" . 1) - ("(\\(while\\|do\\|let\\*?\\|flet\\|labels\\|prog[nv12*]?\\)[ \t\n]" . 1) - ("(\\(catch\\|\\throw\\|block\\|return\\|return-from\\)[ \t\n]" . 1) - ("(\\(save-restriction\\|save-window-restriction\\)[ \t\n]" . 1) - ("(\\(save-excursion\\|unwind-protect\\|condition-case\\)[ \t\n]" . 1) - ;; - ;; highlight function names in emacs-lisp docstrings (in the syntax - ;; that substitute-command-keys understands.) - ("\\\\\\\\\\[\\([^]\\\n]+\\)]" 1 font-lock-keyword-face t) - ;; - ;; highlight words inside `' which tend to be function names - ("`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'" - 1 font-lock-keyword-face t) - )) + (list + ;; + ;; Control structures. + ;; ELisp: +; ("cond" "if" "while" "let\\*?" "prog[nv12*]?" "catch" "throw" +; "save-restriction" "save-excursion" +; "save-window-excursion" "save-match-data" "unwind-protect" +; "condition-case" "track-mouse") + (cons + (concat "(\\(" + "c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|if\\|let\\*?\\|prog[nv12*]?\\|" + "save-\\(excursion\\|match-data\\|restriction\\|window-excursion\\)\\|" + "t\\(hrow\\|rack-mouse\\)\\|unwind-protect\\|while" + "\\)[ \t\n]") 1) + ;; CLisp: +; ("when" "unless" "do" "flet" "labels" "return" "return-from") + '("(\\(do\\|flet\\|labels\\|return\\(\\|-from\\)\\|unless\\|when\\)\\>" + . 1) + ;; + ;; Fontify CLisp keywords. + '("\\s :\\([-a-zA-Z0-9]+\\)\\>" . 1) + ;; + ;; Function names in emacs-lisp docstrings (in the syntax that + ;; substitute-command-keys understands.) + '("\\\\\\\\\\[\\([^]\\\n]+\\)]" 1 font-lock-reference-face t) + ;; + ;; Words inside `' which tend to be function names + (let ((word-char "[-+a-zA-Z0-9_.*]")) + (list (concat "`\\(" word-char word-char "+\\)'") + 1 'font-lock-reference-face t)) + ;; + ;; & keywords as types + '("\\&\\(optional\\|rest\\)\\>" . font-lock-type-face) + )) "For consideration as a value of `lisp-font-lock-keywords'. This does a lot more highlighting.") @@ -506,109 +682,82 @@ "For consideration as a value of `c++-font-lock-keywords'. This does a lot more highlighting.") -(let* ((storage "auto\\|extern\\|register\\|static\\|typedef") - (struct "struct\\|union\\|enum") - (prefixes "signed\\|unsigned\\|short\\|long") - (types (concat prefixes "\\|int\\|char\\|float\\|double\\|void")) - (ctoken "[a-zA-Z0-9_:~*]+") - (c++-things (concat - "const\\|class\\|protected:\\|private:\\|public:\\|inline\\|" - "new\\|delete"))) +(let ((type-types +; ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum" +; "signed" "unsigned" "short" "long" "int" "char" "float" "double" +; "void") + (concat "auto\\|char\\|double\\|e\\(num\\|xtern\\)\\|float\\|int\\|" + "long\\|register\\|s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|" + "typedef\\|un\\(ion\\|signed\\)\\|void")) ; 4 ()s deep. + (c++-types +; ("const" "class" "protected" "private" "public" "inline" "bool" +; "virtual") + (concat "bool\\|c\\(lass\\|onst\\)\\|inline\\|" + "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|virtual")) + (ctoken "[a-zA-Z0-9_:~]+")) (setq c-font-lock-keywords-1 (list - ;; fontify preprocessor directives as comments. - '("^#[ \t]*[a-z]+" . font-lock-comment-face) ;; - ;; fontify names being defined. - '("^#[ \t]*\\(define\\|undef\\)[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 2 - font-lock-function-name-face) - ;; - ;; fontify other preprocessor lines. - '("^#[ \t]*\\(if\\|elif\\|else\\|endif\\)[ \t]+\\([^\n]+\\)" - 2 font-lock-function-name-face keep) - '("^#[ \t]*\\(ifn?def\\)[ \t]+\\([^ \t\n]+\\)" - 2 font-lock-function-name-face t) - ;; - ;; fontify the filename in #include <...> - ;; don't need to do this for #include "..." because those were - ;; already fontified as strings by the syntactic pass. + ;; Fontify filenames in #include <...> preprocessor directives. '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) ;; - ;; fontify the names of functions being defined. - (list (concat - "^\\(" ctoken "[ \t]+\\)?" ; type specs; there can be no - "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? - "\\(" ctoken "[ \t]+\\)?" - "\\([*&]+[ \t]*\\)?" ; pointer - "\\(" ctoken "\\)[ \t]*(") ; name - 5 'font-lock-function-name-face) - ;; - ;; - ;; Fontify structure names (in structure definition form). - (list (concat "^\\(" storage "\\)?[ \t]*\\<\\(" struct "\\)" - "[ \t]+\\(" ctoken "\\)[ \t]*\\(\{\\|$\\)") - 3 'font-lock-function-name-face) + ;; Fontify function macro names. + '("^#[ \t]*define[ \t]+\\(\\(\\sw+\\)(\\)" 2 font-lock-function-name-face) ;; - ;; Fontify declarations of simple identifiers (including typedefs). - ;; (Should this be in c-font-lock-keywords-2 instead?) - (list (concat "^[ \t]*\\(\\(" storage "\\)[ \t]+\\)?\\(\\(\\(" prefixes - "\\)\\>[ \t]*\\)*\\(" types "\\)\\)[ \t]+\\(" ctoken - "\\)[ \t]*[=;]") - 7 'font-lock-function-name-face 'keep) + ;; Fontify otherwise as symbol names, and the preprocessor directive names. + '("^\\(#[ \t]*[a-z]+\\)\\>[ \t]*\\(\\sw+\\)?" + (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t)) ;; - ;; And likewise for structs - (list (concat "^[ \t]*\\(\\(" storage "\\)[ \t]+\\)?\\(" struct - "\\)[ \t]+" ctoken "[ \t]+\\(" ctoken "\\);") - 4 'font-lock-function-name-face 'keep) - ;; - ;; Fontify case clauses. This is fast because its anchored on the left. - '("case[ \t]+\\(\\(\\sw\\|\\s_\\)+\\):". 1) - '("\\<\\(default\\):". 1) + ;; Fontify function name definitions (without type on line). + (list (concat "^\\(" ctoken "\\)[ \t]*(") 1 'font-lock-function-name-face) )) (setq c-font-lock-keywords-2 (append c-font-lock-keywords-1 (list ;; - ;; fontify all storage classes and type specifiers - (cons (concat "\\<\\(" storage "\\)\\>") 'font-lock-type-face) - (cons (concat "\\<\\(" types "\\)\\>") 'font-lock-type-face) - (cons (concat "\\<\\(\\(\\(" prefixes "\\)\\>[ \t]*\\)*\\(" types - "\\)\\)\\>") - 'font-lock-type-face) - (list (concat "\\<\\(" struct "\\)[ \t]+" ctoken) - 0 'font-lock-type-face 'keep) + ;; Fontify all storage classes and type specifiers (before declarations). + (cons (concat "\\<\\(" type-types "\\)\\>") 'font-lock-type-face) ;; - ;; fontify all builtin tokens + ;; Fontify variable/structure name declarations and definitions, or + ;; function name declarations (plus definitions with type on same line). + (list (concat "\\<\\(" type-types "\\)[ \t*&]+" + "\\(" ctoken "[ \t*&]+\\)*" + "\\(" ctoken "\\)[ \t]*\\((\\)?") + 7 + '(if (match-beginning 8) + 'font-lock-function-name-face + 'font-lock-variable-name-face)) + ;; Is highlighting above using (6 font-lock-type-face nil t) a good idea? + ;; + ;; Fontify variable names declared with structures, or typedef names. + '("}[ \t]*\\(\\sw+\\)[ \t]*[;,[]" 1 font-lock-variable-name-face) + ;; + ;; Fontify all builtin keywords (except case and goto; see below). (cons (concat - "[ \t]\\(" - (mapconcat 'identity - '("for" "while" "do" "return" "goto" "case" "break" "switch" - "if" "else" "default" "continue" "default") - "\\|") - "\\)[ \t\n(){};,]") - 1) +; ("for" "while" "do" "return" "goto" "case" "break" "switch" +; "if" "else" "default" "continue" "default") + "\\<\\(break\\|continue\\|d\\(efault\\|o\\)\\|else\\|" + "for\\|if\\|return\\|switch\\|while\\)\\>") + 'font-lock-keyword-face) ;; - ;; fontify case targets and goto-tags. This is slow because the - ;; expression is anchored on the right. - '("[ \t\n]\\(\\(\\sw\\|\\s_\\)+\\):" . 1) - ;; - ;; Fontify variables declared with structures, or typedef names. - '("}[ \t*]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t]*[,;]" - 1 font-lock-function-name-face) - ;; - ;; Fontify global variables without a type. -; '("^\\([_a-zA-Z0-9:~*]+\\)[ \t]*[[;={]" 1 font-lock-function-name-face) + ;; Fontify case/goto keywords and targets, and goto tags. + '("\\<\\(case\\|goto\\)\\>[ \t]*\\([^ \t\n:;]+\\)?" + (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) + '("^[ \t]*\\(\\sw+\\)[ \t]*:" 1 font-lock-reference-face) ))) - (setq c++-font-lock-keywords-1 - (cons - (concat "\\(" c++-things "\\)[ \t\n]") - c-font-lock-keywords-1)) + (setq c++-font-lock-keywords-1 c-font-lock-keywords-1) (setq c++-font-lock-keywords-2 - (cons - (cons (concat "\\<\\(" c++-things "\\)\\>") 'font-lock-type-face) - c-font-lock-keywords-2)) + (append + (list + ;; + ;; Fontify C++ type specifiers (before case targets/goto tags). + (cons (concat "\\<\\(" c++-types "\\)\\>") 'font-lock-type-face) + ;; + ;; Fontify C++ builtin keywords. + '("\\<\\(delete\\|new\\)\\>" . font-lock-keyword-face)) + c-font-lock-keywords-2)) ) ; default to the gaudier variety? @@ -618,26 +767,6 @@ (defvar c++-font-lock-keywords c++-font-lock-keywords-1 "Additional expressions to highlight in C++ mode.") - -(defvar perl-font-lock-keywords - (list - (cons (concat "[ \n\t{]*\\(" - (mapconcat 'identity - '("if" "until" "while" "elsif" "else" "unless" "for" - "foreach" "continue" "exit" "die" "last" "goto" "next" - "redo" "return" "local" "exec") - "\\|") - "\\)[ \n\t;(]") 1) - (mapconcat 'identity - '("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" - "#define" "#undef") - "\\|") - '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \t]*[{]" 1 font-lock-function-name-face) - '("[ \n\t{]*\\(eval\\)[ \n\t(;]" 1 font-lock-function-name-face) - '("\\(--- .* ---\\|=== .* ===\\)" . font-lock-doc-string-face) - ) - "Additional expressions to highlight in Perl mode.") - (defvar tex-font-lock-keywords (list '("\\(\\\\\\([a-zA-Z@]+\\|.\\)\\)" 1 font-lock-keyword-face t) @@ -651,90 +780,68 @@ ) "Additional expressions to highlight in TeX mode.") -(defvar texi-font-lock-keywords - (list - "@\\(@\\|[^}\t \n{]+\\)" ;commands - '("^\\(@c\\|@comment\\)[ \t].*$" . font-lock-comment-face) ;comments - '("^\\(*.*\\)[\t ]*$" 1 font-lock-function-name-face t) ;menu items - '("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" 2 font-lock-comment-face t) - '("@\\(file\\|kbd\\|key\\){\\([^}]+\\)" 2 font-lock-string-face t) - '("@\\(samp\\|code\\|var\\){\\([^}]+\\)" 2 font-lock-function-name-face t) - '("@\\(xref\\|pxref\\){\\([^}]+\\)" 2 font-lock-keyword-face t) - '("@end *\\([a-zA-Z0-9]+\\)[ \t]*$" 1 font-lock-function-name-face t) - '("@item \\(.*\\)$" 1 font-lock-function-name-face t) - '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) - ) - "Additional expressions to highlight in TeXinfo mode.") - -(defvar shell-font-lock-keywords - (list (cons shell-prompt-pattern 'font-lock-keyword-face) - '("[ \t]\\([+-][^ \t\n]+\\)" 1 font-lock-comment-face) - '("^[^ \t]+:.*$" . font-lock-string-face) - '("^\\[[1-9][0-9]*\\]" . font-lock-string-face)) - "Additional expressions to highlight in Shell mode.") +;; There is no html-mode.el shipped with Emacs... Yet. +;(defvar html-font-lock-keywords +; '(("