--- /dev/null Wed Dec 31 19:00:00 1969 +++ lisp/font-core.el Thu May 16 14:38:10 2002 @@ -0,0 +1,346 @@ +;;; font-core.el --- Core interface to font-lock + +;; Copyright (C) 1992, 93, 94, 95, 96, 97, 98, 1999, 2000, 2001, 2002 +;; Free Software Foundation, Inc. + +;; Maintainer: FSF +;; Keywords: languages, faces + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +;; This variable is used by mode packages that support Font Lock mode by +;; defining their own keywords to use for `font-lock-keywords'. (The mode +;; command should make it buffer-local and set it to provide the set up.) +(defvar font-lock-defaults nil + "Defaults for Font Lock mode specified by the major mode. +Defaults should be of the form: + + (KEYWORDS KEYWORDS-ONLY CASE-FOLD SYNTAX-ALIST SYNTAX-BEGIN ...) + +KEYWORDS may be a symbol (a variable or function whose value is the keywords to +use for fontification) or a list of symbols. If KEYWORDS-ONLY is non-nil, +syntactic fontification (strings and comments) is not performed. +If CASE-FOLD is non-nil, the case of the keywords is ignored when fontifying. +If SYNTAX-ALIST is non-nil, it should be a list of cons pairs of the form +\(CHAR-OR-STRING . STRING) used to set the local Font Lock syntax table, for +keyword and syntactic fontification (see `modify-syntax-entry'). + +If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move +backwards outside any enclosing syntactic block, for syntactic fontification. +Typical values are `beginning-of-line' (i.e., the start of the line is known to +be outside a syntactic block), or `beginning-of-defun' for programming modes or +`backward-paragraph' for textual modes (i.e., the mode-dependent function is +known to move outside a syntactic block). If nil, the beginning of the buffer +is used as a position outside of a syntactic block, in the worst case. + +These item elements are used by Font Lock mode to set the variables +`font-lock-keywords', `font-lock-keywords-only', +`font-lock-keywords-case-fold-search', `font-lock-syntax-table' and +`font-lock-beginning-of-syntax-function', respectively. + +Further item elements are alists of the form (VARIABLE . VALUE) and are in no +particular order. Each VARIABLE is made buffer-local before set to VALUE. + +Currently, appropriate variables include `font-lock-mark-block-function'. +If this is non-nil, it should be a function with no args used to mark any +enclosing block of text, for fontification via \\[font-lock-fontify-block]. +Typical values are `mark-defun' for programming modes or `mark-paragraph' for +textual modes (i.e., the mode-dependent function is known to put point and mark +around a text block relevant to that mode). + +Other variables include that for syntactic keyword fontification, +`font-lock-syntactic-keywords' +and those for buffer-specialised fontification functions, +`font-lock-fontify-buffer-function', `font-lock-unfontify-buffer-function', +`font-lock-fontify-region-function', `font-lock-unfontify-region-function', +`font-lock-inhibit-thing-lock' and `font-lock-maximum-size'.") +(make-variable-buffer-local 'font-lock-defaults) + +;; This variable is used where font-lock.el itself supplies the +;; keywords. Really, this shouldn't need to be in font-core.el, but +;; we can't avoid it. In the future, this stuff will hopefully be +;; moved to cc-mode itself. +(defvar font-lock-defaults-alist + (let (;; We use `beginning-of-defun', rather than nil, for SYNTAX-BEGIN. + ;; Thus the calculation of the cache is usually faster but not + ;; infallible, so we risk mis-fontification. sm. + (c-mode-defaults + '((c-font-lock-keywords c-font-lock-keywords-1 + c-font-lock-keywords-2 c-font-lock-keywords-3) + nil nil ((?_ . "w")) beginning-of-defun + (font-lock-syntactic-face-function + . c-font-lock-syntactic-face-function) + (font-lock-mark-block-function . mark-defun))) + (c++-mode-defaults + '((c++-font-lock-keywords c++-font-lock-keywords-1 + c++-font-lock-keywords-2 c++-font-lock-keywords-3) + nil nil ((?_ . "w")) beginning-of-defun + (font-lock-syntactic-face-function + . c-font-lock-syntactic-face-function) + (font-lock-mark-block-function . mark-defun))) + (objc-mode-defaults + '((objc-font-lock-keywords objc-font-lock-keywords-1 + objc-font-lock-keywords-2 objc-font-lock-keywords-3) + nil nil ((?_ . "w") (?$ . "w")) nil + (font-lock-syntactic-face-function + . c-font-lock-syntactic-face-function) + (font-lock-mark-block-function . mark-defun))) + (java-mode-defaults + '((java-font-lock-keywords java-font-lock-keywords-1 + java-font-lock-keywords-2 java-font-lock-keywords-3) + nil nil ((?_ . "w") (?$ . "w")) nil + (font-lock-syntactic-face-function + . java-font-lock-syntactic-face-function) + (font-lock-mark-block-function . mark-defun)))) + (list + (cons 'c-mode c-mode-defaults) + (cons 'c++-mode c++-mode-defaults) + (cons 'objc-mode objc-mode-defaults) + (cons 'java-mode java-mode-defaults))) + "Alist of fall-back Font Lock defaults for major modes. + +This variable should not be used any more. +Set the buffer-local `font-lock-keywords' in the major mode instead. + +Each item should be a list of the form: + + (MAJOR-MODE . FONT-LOCK-DEFAULTS) + +where MAJOR-MODE is a symbol and FONT-LOCK-DEFAULTS is a list of default +settings. See the variable `font-lock-defaults', which takes precedence.") +(make-obsolete-variable 'font-lock-defaults-alist 'font-lock-defaults) + +(defvar font-lock-multiline nil + "Whether font-lock should cater to multiline keywords. +If nil, don't try to handle multiline patterns. +If t, always handle multiline patterns. +If `undecided', don't try to handle multiline patterns until you see one. +Major/minor modes can set this variable if they know which option applies.") + +(defvar font-lock-fontified nil) ; Whether we have fontified the buffer. + +(defvar font-lock-category-alist nil + "An alist of (CATEGORY-SYMBOL . FACE-PROP) controlled by Font Lock. +This variable is intended to be used by special modes which construct +buffer text for display to the user (i.e. buffer-menu, occur), but +wish to have fontification turned on and off by Font Lock. If this +variable is non-nil, then calling `font-lock-mode' will simply toggle +the symbol property `face' of CATEGORY-SYMBOL.") + +(define-minor-mode font-lock-mode + "Toggle Font Lock mode. +With arg, turn Font Lock mode off if and only if arg is a non-positive +number; if arg is nil, toggle Font Lock mode; anything else turns Font +Lock on. +\(Font Lock is also known as \"syntax highlighting\".) + +When Font Lock mode is enabled, text is fontified as you type it: + + - 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'. + +To customize the faces (colors, fonts, etc.) used by Font Lock for +fontifying different parts of buffer text, use \\[customize-face]. + +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) + +Alternatively, you can use Global Font Lock mode to automagically turn on Font +Lock mode in buffers whose major mode supports it and whose major mode is one +of `font-lock-global-modes'. For example, put in your ~/.emacs: + + (global-font-lock-mode t) + +There are a number of support modes that may be used to speed up Font Lock mode +in various ways, specified via the variable `font-lock-support-mode'. Where +major modes support different levels of fontification, you can use the variable +`font-lock-maximum-decoration' to specify which level you generally prefer. +When you turn Font Lock mode on/off the buffer is fontified/defontified, though +fontification occurs only if the buffer is less than `font-lock-maximum-size'. + +For example, to specify that Font Lock mode use use Lazy Lock mode as a support +mode and use maximum levels of fontification, put in your ~/.emacs: + + (setq font-lock-support-mode 'lazy-lock-mode) + (setq font-lock-maximum-decoration t) + +To add your own highlighting for some major mode, and modify the highlighting +selected automatically via the variable `font-lock-maximum-decoration', you can +use `font-lock-add-keywords'. + +To fontify a buffer, without turning on Font Lock mode and regardless of buffer +size, you can use \\[font-lock-fontify-buffer]. + +To fontify a block (the function or paragraph containing point, or a number of +lines around point), perhaps because modification on the current line caused +syntactic change on other lines, you can use \\[font-lock-fontify-block]. + +See the variable `font-lock-defaults-alist' for the Font Lock mode default +settings. You can set your own default settings for some mode, by setting a +buffer local value for `font-lock-defaults', via its mode hook." + nil nil nil + ;; Don't turn on Font Lock mode if we don't have a display (we're running a + ;; batch job) or if the buffer is invisible (the name starts with a space). + (when (or noninteractive (eq (aref (buffer-name) 0) ?\ )) + (setq font-lock-mode nil)) + + ;; Turn on Font Lock mode. + (when font-lock-mode + (font-lock-set-defaults) + (dolist (elt font-lock-category-alist) + (put (car elt) 'face (cdr elt))) + (when font-lock-defaults + (add-hook 'after-change-functions 'font-lock-after-change-function t t) + (font-lock-turn-on-thing-lock) + ;; Fontify the buffer if we have to. + (let ((max-size (font-lock-value-in-major-mode font-lock-maximum-size))) + (cond (font-lock-fontified + nil) + ((or (null max-size) (> max-size (buffer-size))) + (font-lock-fontify-buffer)) + (font-lock-verbose + (message "Fontifying %s...buffer size greater than font-lock-maximum-size" + (buffer-name))))))) + ;; Turn off Font Lock mode. + (unless font-lock-mode + (dolist (elt font-lock-category-alist) + (put (car elt) 'face nil)) + (when font-lock-defaults + (remove-hook 'after-change-functions 'font-lock-after-change-function t) + (font-lock-unfontify-buffer) + (font-lock-turn-off-thing-lock)))) + +(defun turn-on-font-lock () + "Turn on Font Lock mode (only if the terminal can display it)." + (unless font-lock-mode + (font-lock-mode))) + +(defvar font-lock-set-defaults nil) ; Whether we have set up defaults. + +(defun font-lock-set-defaults () + "Set fontification defaults appropriately for this mode. +Sets various variables using `font-lock-defaults' (or, if nil, using +`font-lock-defaults-alist') and `font-lock-maximum-decoration'." + (unless font-lock-set-defaults + (set (make-local-variable 'font-lock-set-defaults) t) + (make-local-variable 'font-lock-fontified) + (make-local-variable 'font-lock-multiline) + ;; Detect if this is a simple mode, which doesn't use any + ;; syntactic fontification functions. + (unless font-lock-category-alist + (require 'font-lock) + (font-lock-set-defaults-1)))) + +;;; Global Font Lock mode. + +;; A few people have hassled in the past for a way to make it easier to turn on +;; Font Lock mode, without the user needing to know for which modes s/he has to +;; turn it on, perhaps the same way hilit19.el/hl319.el does. I've always +;; balked at that way, as I see it as just re-moulding the same problem in +;; another form. That is; some person would still have to keep track of which +;; modes (which may not even be distributed with Emacs) support Font Lock mode. +;; The list would always be out of date. And that person might have to be me. + +;; Implementation. +;; +;; In a previous discussion the following hack came to mind. It is a gross +;; hack, but it generally works. We use the convention that major modes start +;; by calling the function `kill-all-local-variables', which in turn runs +;; functions on the hook variable `change-major-mode-hook'. We attach our +;; function `font-lock-change-major-mode' to that hook. Of course, when this +;; hook is run, the major mode is in the process of being changed and we do not +;; know what the final major mode will be. So, `font-lock-change-major-mode' +;; only (a) notes the name of the current buffer, and (b) adds our function +;; `turn-on-font-lock-if-enabled' to the hook variables `find-file-hooks' and +;; `post-command-hook' (for buffers that are not visiting files). By the time +;; the functions on the first of these hooks to be run are run, the new major +;; mode is assumed to be in place. This way we get a Font Lock function run +;; when a major mode is turned on, without knowing major modes or their hooks. +;; +;; Naturally this requires that (a) major modes run `kill-all-local-variables', +;; as they are supposed to do, and (b) the major mode is in place after the +;; file is visited or the command that ran `kill-all-local-variables' has +;; finished, whichever the sooner. Arguably, any major mode that does not +;; follow the convension (a) is broken, and I can't think of any reason why (b) +;; would not be met (except `gnudoit' on non-files). However, it is not clean. +;; +;; Probably the cleanest solution is to have each major mode function run some +;; hook, e.g., `major-mode-hook', but maybe implementing that change is +;; impractical. I am personally against making `setq' a macro or be advised, +;; or have a special function such as `set-major-mode', but maybe someone can +;; come up with another solution? + +;; User interface. +;; +;; Although Global Font Lock mode is a pseudo-mode, I think that the user +;; interface should conform to the usual Emacs convention for modes, i.e., a +;; command to toggle the feature (`global-font-lock-mode') with a variable for +;; finer control of the mode's behaviour (`font-lock-global-modes'). +;; +;; The feature should not be enabled by loading font-lock.el, since other +;; mechanisms for turning on Font Lock mode, such as M-x font-lock-mode RET or +;; (add-hook 'c-mode-hook 'turn-on-font-lock), would cause Font Lock mode to be +;; turned on everywhere. That would not be intuitive or informative because +;; loading a file tells you nothing about the feature or how to control it. It +;; would also be contrary to the Principle of Least Surprise. sm. + +(defcustom font-lock-global-modes t + "*Modes for which Font Lock mode is automagically turned on. +Global Font Lock mode is controlled by the command `global-font-lock-mode'. +If nil, means no modes have Font Lock mode automatically turned on. +If t, all modes that support Font Lock mode have it automatically turned on. +If a list, it should be a list of `major-mode' symbol names for which Font Lock +mode should be automatically turned on. The sense of the list is negated if it +begins with `not'. For example: + (c-mode c++-mode) +means that Font Lock mode is turned on for buffers in C and C++ modes only." + :type '(choice (const :tag "none" nil) + (const :tag "all" t) + (set :menu-tag "mode specific" :tag "modes" + :value (not) + (const :tag "Except" not) + (repeat :inline t (symbol :tag "mode")))) + :group 'font-lock) + +(defun turn-on-font-lock-if-enabled () + (when (and (or font-lock-defaults + font-lock-category-alist + (assq major-mode font-lock-defaults-alist)) + (or (eq font-lock-global-modes t) + (if (eq (car-safe font-lock-global-modes) 'not) + (not (memq major-mode (cdr font-lock-global-modes))) + (memq major-mode font-lock-global-modes)))) + (let (inhibit-quit) + (turn-on-font-lock)))) + +(easy-mmode-define-global-mode + global-font-lock-mode font-lock-mode turn-on-font-lock-if-enabled + :extra-args (dummy)) + +;;; End of Global Font Lock mode. + +(provide 'font-core) + +;;; font-core.el ends here + Index: lisp/comint.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/comint.el,v retrieving revision 1.270 diff -u -d -u -r1.270 comint.el --- lisp/comint.el 18 Apr 2002 19:41:57 -0000 1.270 +++ lisp/comint.el 16 May 2002 18:42:42 -0000 @@ -397,7 +397,7 @@ :type 'boolean :group 'comint) -(defcustom comint-mode-hook '() +(defcustom comint-mode-hook '(font-lock-mode) "Called upon entry into `comint-mode' This is run before the process is cranked up." :type 'hook @@ -503,6 +503,9 @@ (setq comint-input-ring-index nil)) (or (and (boundp 'comint-save-input-ring-index) comint-save-input-ring-index) (setq comint-save-input-ring-index nil)) + (set (make-local-variable 'font-lock-category-alist) + '((comint-sent-output comint-highlight-input) + (comint-prompt comint-highlight-prompt))) (make-local-variable 'comint-matching-input-from-input-string) (make-local-variable 'comint-input-autoexpand) (make-local-variable 'comint-input-ignoredups) @@ -1460,6 +1463,7 @@ (let ((beg (marker-position pmark)) (end (if no-newline (point) (1- (point))))) (when (not (> beg end)) ; handle a special case + (put-text-property beg end 'category 'comint-sent-output) ;; Make an overlay for the input field (let ((over (make-overlay beg end nil nil t))) (unless comint-use-prompt-regexp-instead-of-fields @@ -1470,7 +1474,6 @@ ;; and output fields smoother. (overlay-put over 'field 'input)) (when comint-highlight-input - (overlay-put over 'face 'comint-highlight-input) (overlay-put over 'mouse-face 'highlight) (overlay-put over 'help-echo @@ -1713,8 +1716,9 @@ ;; Need to create the overlay (setq comint-last-prompt-overlay (make-overlay prompt-start (point))) - (overlay-put comint-last-prompt-overlay - 'face 'comint-highlight-prompt))))) + (put-text-property (overlay-start comint-last-prompt-overlay) + (overlay-end comint-last-prompt-overlay) + 'category 'comint-prompt))))) (goto-char saved-point) Index: lisp/font-lock.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/font-lock.el,v retrieving revision 1.195 diff -u -d -u -r1.195 font-lock.el --- lisp/font-lock.el 30 Mar 2002 08:08:54 -0000 1.195 +++ lisp/font-lock.el 16 May 2002 18:42:42 -0000 @@ -446,106 +446,6 @@ Be careful when composing regexps for this list; a poorly written pattern can dramatically slow things down!") -;; This variable is used by mode packages that support Font Lock mode by -;; defining their own keywords to use for `font-lock-keywords'. (The mode -;; command should make it buffer-local and set it to provide the set up.) -(defvar font-lock-defaults nil - "Defaults for Font Lock mode specified by the major mode. -Defaults should be of the form: - - (KEYWORDS KEYWORDS-ONLY CASE-FOLD SYNTAX-ALIST SYNTAX-BEGIN ...) - -KEYWORDS may be a symbol (a variable or function whose value is the keywords to -use for fontification) or a list of symbols. If KEYWORDS-ONLY is non-nil, -syntactic fontification (strings and comments) is not performed. -If CASE-FOLD is non-nil, the case of the keywords is ignored when fontifying. -If SYNTAX-ALIST is non-nil, it should be a list of cons pairs of the form -\(CHAR-OR-STRING . STRING) used to set the local Font Lock syntax table, for -keyword and syntactic fontification (see `modify-syntax-entry'). - -If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move -backwards outside any enclosing syntactic block, for syntactic fontification. -Typical values are `beginning-of-line' (i.e., the start of the line is known to -be outside a syntactic block), or `beginning-of-defun' for programming modes or -`backward-paragraph' for textual modes (i.e., the mode-dependent function is -known to move outside a syntactic block). If nil, the beginning of the buffer -is used as a position outside of a syntactic block, in the worst case. - -These item elements are used by Font Lock mode to set the variables -`font-lock-keywords', `font-lock-keywords-only', -`font-lock-keywords-case-fold-search', `font-lock-syntax-table' and -`font-lock-beginning-of-syntax-function', respectively. - -Further item elements are alists of the form (VARIABLE . VALUE) and are in no -particular order. Each VARIABLE is made buffer-local before set to VALUE. - -Currently, appropriate variables include `font-lock-mark-block-function'. -If this is non-nil, it should be a function with no args used to mark any -enclosing block of text, for fontification via \\[font-lock-fontify-block]. -Typical values are `mark-defun' for programming modes or `mark-paragraph' for -textual modes (i.e., the mode-dependent function is known to put point and mark -around a text block relevant to that mode). - -Other variables include that for syntactic keyword fontification, -`font-lock-syntactic-keywords' -and those for buffer-specialised fontification functions, -`font-lock-fontify-buffer-function', `font-lock-unfontify-buffer-function', -`font-lock-fontify-region-function', `font-lock-unfontify-region-function', -`font-lock-inhibit-thing-lock' and `font-lock-maximum-size'.") -;;;###autoload -(make-variable-buffer-local 'font-lock-defaults) - -;; This variable is used where font-lock.el itself supplies the keywords. -(defvar font-lock-defaults-alist - (let (;; We use `beginning-of-defun', rather than nil, for SYNTAX-BEGIN. - ;; Thus the calculation of the cache is usually faster but not - ;; infallible, so we risk mis-fontification. sm. - (c-mode-defaults - '((c-font-lock-keywords c-font-lock-keywords-1 - c-font-lock-keywords-2 c-font-lock-keywords-3) - nil nil ((?_ . "w")) beginning-of-defun - (font-lock-syntactic-face-function - . c-font-lock-syntactic-face-function) - (font-lock-mark-block-function . mark-defun))) - (c++-mode-defaults - '((c++-font-lock-keywords c++-font-lock-keywords-1 - c++-font-lock-keywords-2 c++-font-lock-keywords-3) - nil nil ((?_ . "w")) beginning-of-defun - (font-lock-syntactic-face-function - . c-font-lock-syntactic-face-function) - (font-lock-mark-block-function . mark-defun))) - (objc-mode-defaults - '((objc-font-lock-keywords objc-font-lock-keywords-1 - objc-font-lock-keywords-2 objc-font-lock-keywords-3) - nil nil ((?_ . "w") (?$ . "w")) nil - (font-lock-syntactic-face-function - . c-font-lock-syntactic-face-function) - (font-lock-mark-block-function . mark-defun))) - (java-mode-defaults - '((java-font-lock-keywords java-font-lock-keywords-1 - java-font-lock-keywords-2 java-font-lock-keywords-3) - nil nil ((?_ . "w") (?$ . "w")) nil - (font-lock-syntactic-face-function - . java-font-lock-syntactic-face-function) - (font-lock-mark-block-function . mark-defun)))) - (list - (cons 'c-mode c-mode-defaults) - (cons 'c++-mode c++-mode-defaults) - (cons 'objc-mode objc-mode-defaults) - (cons 'java-mode java-mode-defaults))) - "Alist of fall-back Font Lock defaults for major modes. - -This variable should not be used any more. -Set the buffer-local `font-lock-keywords' in the major mode instead. - -Each item should be a list of the form: - - (MAJOR-MODE . FONT-LOCK-DEFAULTS) - -where MAJOR-MODE is a symbol and FONT-LOCK-DEFAULTS is a list of default -settings. See the variable `font-lock-defaults', which takes precedence.") -(make-obsolete-variable 'font-lock-defaults-alist 'font-lock-defaults) - (defvar font-lock-keywords-alist nil "*Alist of `font-lock-keywords' local to a `major-mode'. This is normally set via `font-lock-add-keywords' and @@ -657,14 +557,6 @@ Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and `lazy-lock-mode'. This is normally set via `font-lock-defaults'.") -(defvar font-lock-multiline nil - "Whether font-lock should cater to multiline keywords. -If nil, don't try to handle multiline patterns. -If t, always handle multiline patterns. -If `undecided', don't try to handle multiline patterns until you see one. -Major/minor modes can set this variable if they know which option applies.") - -(defvar font-lock-fontified nil) ; Whether we have fontified the buffer. ;; Font Lock mode. @@ -698,94 +590,6 @@ (defvar font-lock-face-attributes)) ; Obsolete but respected if set. ;;;###autoload -(define-minor-mode font-lock-mode - "Toggle Font Lock mode. -With arg, turn Font Lock mode off if and only if arg is a non-positive -number; if arg is nil, toggle Font Lock mode; anything else turns Font -Lock on. -\(Font Lock is also known as \"syntax highlighting\".) - -When Font Lock mode is enabled, text is fontified as you type it: - - - 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'. - -To customize the faces (colors, fonts, etc.) used by Font Lock for -fontifying different parts of buffer text, use \\[customize-face]. - -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) - -Alternatively, you can use Global Font Lock mode to automagically turn on Font -Lock mode in buffers whose major mode supports it and whose major mode is one -of `font-lock-global-modes'. For example, put in your ~/.emacs: - - (global-font-lock-mode t) - -There are a number of support modes that may be used to speed up Font Lock mode -in various ways, specified via the variable `font-lock-support-mode'. Where -major modes support different levels of fontification, you can use the variable -`font-lock-maximum-decoration' to specify which level you generally prefer. -When you turn Font Lock mode on/off the buffer is fontified/defontified, though -fontification occurs only if the buffer is less than `font-lock-maximum-size'. - -For example, to specify that Font Lock mode use use Lazy Lock mode as a support -mode and use maximum levels of fontification, put in your ~/.emacs: - - (setq font-lock-support-mode 'lazy-lock-mode) - (setq font-lock-maximum-decoration t) - -To add your own highlighting for some major mode, and modify the highlighting -selected automatically via the variable `font-lock-maximum-decoration', you can -use `font-lock-add-keywords'. - -To fontify a buffer, without turning on Font Lock mode and regardless of buffer -size, you can use \\[font-lock-fontify-buffer]. - -To fontify a block (the function or paragraph containing point, or a number of -lines around point), perhaps because modification on the current line caused -syntactic change on other lines, you can use \\[font-lock-fontify-block]. - -See the variable `font-lock-defaults-alist' for the Font Lock mode default -settings. You can set your own default settings for some mode, by setting a -buffer local value for `font-lock-defaults', via its mode hook." - nil nil nil - ;; Don't turn on Font Lock mode if we don't have a display (we're running a - ;; batch job) or if the buffer is invisible (the name starts with a space). - (when (or noninteractive (eq (aref (buffer-name) 0) ?\ )) - (setq font-lock-mode nil)) - - ;; Turn on Font Lock mode. - (when font-lock-mode - (add-hook 'after-change-functions 'font-lock-after-change-function t t) - (font-lock-set-defaults) - (font-lock-turn-on-thing-lock) - ;; Fontify the buffer if we have to. - (let ((max-size (font-lock-value-in-major-mode font-lock-maximum-size))) - (cond (font-lock-fontified - nil) - ((or (null max-size) (> max-size (buffer-size))) - (font-lock-fontify-buffer)) - (font-lock-verbose - (message "Fontifying %s...buffer size greater than font-lock-maximum-size" - (buffer-name)))))) - ;; Turn off Font Lock mode. - (unless font-lock-mode - (remove-hook 'after-change-functions 'font-lock-after-change-function t) - (font-lock-unfontify-buffer) - (font-lock-turn-off-thing-lock))) - -;;;###autoload -(defun turn-on-font-lock () - "Turn on Font Lock mode (only if the terminal can display it)." - (unless font-lock-mode - (font-lock-mode))) - -;;;###autoload (defun font-lock-add-keywords (mode keywords &optional append) "Add highlighting KEYWORDS for MODE. MODE should be a symbol, the major mode command name, such as `c-mode' @@ -937,94 +741,6 @@ (delete (font-lock-compile-keyword keyword) font-lock-keywords))))))) -;;; Global Font Lock mode. - -;; A few people have hassled in the past for a way to make it easier to turn on -;; Font Lock mode, without the user needing to know for which modes s/he has to -;; turn it on, perhaps the same way hilit19.el/hl319.el does. I've always -;; balked at that way, as I see it as just re-moulding the same problem in -;; another form. That is; some person would still have to keep track of which -;; modes (which may not even be distributed with Emacs) support Font Lock mode. -;; The list would always be out of date. And that person might have to be me. - -;; Implementation. -;; -;; In a previous discussion the following hack came to mind. It is a gross -;; hack, but it generally works. We use the convention that major modes start -;; by calling the function `kill-all-local-variables', which in turn runs -;; functions on the hook variable `change-major-mode-hook'. We attach our -;; function `font-lock-change-major-mode' to that hook. Of course, when this -;; hook is run, the major mode is in the process of being changed and we do not -;; know what the final major mode will be. So, `font-lock-change-major-mode' -;; only (a) notes the name of the current buffer, and (b) adds our function -;; `turn-on-font-lock-if-enabled' to the hook variables `find-file-hooks' and -;; `post-command-hook' (for buffers that are not visiting files). By the time -;; the functions on the first of these hooks to be run are run, the new major -;; mode is assumed to be in place. This way we get a Font Lock function run -;; when a major mode is turned on, without knowing major modes or their hooks. -;; -;; Naturally this requires that (a) major modes run `kill-all-local-variables', -;; as they are supposed to do, and (b) the major mode is in place after the -;; file is visited or the command that ran `kill-all-local-variables' has -;; finished, whichever the sooner. Arguably, any major mode that does not -;; follow the convension (a) is broken, and I can't think of any reason why (b) -;; would not be met (except `gnudoit' on non-files). However, it is not clean. -;; -;; Probably the cleanest solution is to have each major mode function run some -;; hook, e.g., `major-mode-hook', but maybe implementing that change is -;; impractical. I am personally against making `setq' a macro or be advised, -;; or have a special function such as `set-major-mode', but maybe someone can -;; come up with another solution? - -;; User interface. -;; -;; Although Global Font Lock mode is a pseudo-mode, I think that the user -;; interface should conform to the usual Emacs convention for modes, i.e., a -;; command to toggle the feature (`global-font-lock-mode') with a variable for -;; finer control of the mode's behaviour (`font-lock-global-modes'). -;; -;; The feature should not be enabled by loading font-lock.el, since other -;; mechanisms for turning on Font Lock mode, such as M-x font-lock-mode RET or -;; (add-hook 'c-mode-hook 'turn-on-font-lock), would cause Font Lock mode to be -;; turned on everywhere. That would not be intuitive or informative because -;; loading a file tells you nothing about the feature or how to control it. It -;; would also be contrary to the Principle of Least Surprise. sm. - -(defcustom font-lock-global-modes t - "*Modes for which Font Lock mode is automagically turned on. -Global Font Lock mode is controlled by the command `global-font-lock-mode'. -If nil, means no modes have Font Lock mode automatically turned on. -If t, all modes that support Font Lock mode have it automatically turned on. -If a list, it should be a list of `major-mode' symbol names for which Font Lock -mode should be automatically turned on. The sense of the list is negated if it -begins with `not'. For example: - (c-mode c++-mode) -means that Font Lock mode is turned on for buffers in C and C++ modes only." - :type '(choice (const :tag "none" nil) - (const :tag "all" t) - (set :menu-tag "mode specific" :tag "modes" - :value (not) - (const :tag "Except" not) - (repeat :inline t (symbol :tag "mode")))) - :group 'font-lock) - -(defun turn-on-font-lock-if-enabled () - (when (and (or font-lock-defaults - (assq major-mode font-lock-defaults-alist)) - (or (eq font-lock-global-modes t) - (if (eq (car-safe font-lock-global-modes) 'not) - (not (memq major-mode (cdr font-lock-global-modes))) - (memq major-mode font-lock-global-modes)))) - (let (inhibit-quit) - (turn-on-font-lock)))) - -;;;###autoload -(easy-mmode-define-global-mode - global-font-lock-mode font-lock-mode turn-on-font-lock-if-enabled - :extra-args (dummy)) - -;;; End of Global Font Lock mode. - ;;; Font Lock Support mode. ;; This is the code used to interface font-lock.el with any of its add-on @@ -1718,60 +1434,50 @@ (t (car keywords)))) -(defvar font-lock-set-defaults nil) ; Whether we have set up defaults. - -(defun font-lock-set-defaults () - "Set fontification defaults appropriately for this mode. -Sets various variables using `font-lock-defaults' (or, if nil, using -`font-lock-defaults-alist') and `font-lock-maximum-decoration'." - ;; Set fontification defaults iff not previously set. - (unless font-lock-set-defaults - (set (make-local-variable 'font-lock-set-defaults) t) - (make-local-variable 'font-lock-fontified) - (make-local-variable 'font-lock-multiline) - (let* ((defaults (or font-lock-defaults - (cdr (assq major-mode font-lock-defaults-alist)))) - (keywords - (font-lock-choose-keywords (nth 0 defaults) - (font-lock-value-in-major-mode font-lock-maximum-decoration))) - (local (cdr (assq major-mode font-lock-keywords-alist))) - (removed-keywords - (cdr-safe (assq major-mode font-lock-removed-keywords-alist)))) - ;; Syntactic fontification? - (when (nth 1 defaults) - (set (make-local-variable 'font-lock-keywords-only) t)) - ;; Case fold during regexp fontification? - (when (nth 2 defaults) - (set (make-local-variable 'font-lock-keywords-case-fold-search) t)) - ;; Syntax table for regexp and syntactic fontification? - (when (nth 3 defaults) - (set (make-local-variable 'font-lock-syntax-table) - (copy-syntax-table (syntax-table))) - (dolist (selem (nth 3 defaults)) - ;; The character to modify may be a single CHAR or a STRING. - (let ((syntax (cdr selem))) - (dolist (char (if (numberp (car selem)) - (list (car selem)) - (mapcar 'identity (car selem)))) - (modify-syntax-entry char syntax font-lock-syntax-table))))) - ;; Syntax function for syntactic fontification? - (when (nth 4 defaults) - (set (make-local-variable 'font-lock-beginning-of-syntax-function) - (nth 4 defaults))) - ;; Variable alist? - (dolist (x (nthcdr 5 defaults)) - (set (make-local-variable (car x)) (cdr x))) - ;; Setup `font-lock-keywords' last because its value might depend - ;; on other settings (e.g. font-lock-compile-keywords uses - ;; font-lock-beginning-of-syntax-function). - (set (make-local-variable 'font-lock-keywords) - (font-lock-compile-keywords (font-lock-eval-keywords keywords) t)) - ;; Local fontification? - (while local - (font-lock-add-keywords nil (car (car local)) (cdr (car local))) - (setq local (cdr local))) - (when removed-keywords - (font-lock-remove-keywords nil removed-keywords))))) +(defun font-lock-set-defaults-1 () + (let* ((defaults (or font-lock-defaults + (cdr (assq major-mode font-lock-defaults-alist)))) + (keywords + (font-lock-choose-keywords (nth 0 defaults) + (font-lock-value-in-major-mode font-lock-maximum-decoration))) + (local (cdr (assq major-mode font-lock-keywords-alist))) + (removed-keywords + (cdr-safe (assq major-mode font-lock-removed-keywords-alist)))) + ;; Syntactic fontification? + (when (nth 1 defaults) + (set (make-local-variable 'font-lock-keywords-only) t)) + ;; Case fold during regexp fontification? + (when (nth 2 defaults) + (set (make-local-variable 'font-lock-keywords-case-fold-search) t)) + ;; Syntax table for regexp and syntactic fontification? + (when (nth 3 defaults) + (set (make-local-variable 'font-lock-syntax-table) + (copy-syntax-table (syntax-table))) + (dolist (selem (nth 3 defaults)) + ;; The character to modify may be a single CHAR or a STRING. + (let ((syntax (cdr selem))) + (dolist (char (if (numberp (car selem)) + (list (car selem)) + (mapcar 'identity (car selem)))) + (modify-syntax-entry char syntax font-lock-syntax-table))))) + ;; Syntax function for syntactic fontification? + (when (nth 4 defaults) + (set (make-local-variable 'font-lock-beginning-of-syntax-function) + (nth 4 defaults))) + ;; Variable alist? + (dolist (x (nthcdr 5 defaults)) + (set (make-local-variable (car x)) (cdr x))) + ;; Setup `font-lock-keywords' last because its value might depend + ;; on other settings (e.g. font-lock-compile-keywords uses + ;; font-lock-beginning-of-syntax-function). + (set (make-local-variable 'font-lock-keywords) + (font-lock-compile-keywords (font-lock-eval-keywords keywords) t)) + ;; Local fontification? + (while local + (font-lock-add-keywords nil (car (car local)) (cdr (car local))) + (setq local (cdr local))) + (when removed-keywords + (font-lock-remove-keywords nil removed-keywords)))) ;;; Colour etc. support. Index: lisp/info.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/info.el,v retrieving revision 1.298 diff -u -d -u -r1.298 info.el --- lisp/info.el 8 May 2002 14:38:30 -0000 1.298 +++ lisp/info.el 16 May 2002 18:42:43 -0000 @@ -55,11 +55,6 @@ The Lisp code is executed when the node is selected.") (put 'Info-enable-active-nodes 'risky-local-variable t) -(defcustom Info-fontify t - "*Non-nil enables highlighting and fonts in Info nodes." - :type 'boolean - :group 'info) - (defface info-node '((((class color) (background light)) (:foreground "brown" :weight bold :slant italic)) (((class color) (background dark)) (:foreground "white" :weight bold :slant italic)) @@ -150,6 +145,11 @@ :type 'boolean :group 'info) +(defcustom Info-mode-hook '(font-lock-mode) + "Hooks run when `info-mode' is called." + :type 'hook + :group 'info) + (defvar Info-current-file nil "Info file that Info is now looking at, or nil. This is the name that was specified in Info, not the actual file name. @@ -997,7 +997,7 @@ (read (current-buffer)))))) (point-max))) (if Info-enable-active-nodes (eval active-expression)) - (if Info-fontify (Info-fontify-node)) + (Info-fontify-node) (if Info-use-header-line (Info-setup-header-line) (setq Info-header-line nil) @@ -2340,6 +2340,16 @@ (setq Info-tag-table-marker (make-marker)) (make-local-variable 'Info-tag-table-buffer) (setq Info-tag-table-buffer nil) + (set (make-local-variable 'font-lock-category-alist) + '((info-menu-header . info-menu-header) + (info-header-node . info-header-node) + (info-header-xref . info-header-xref) + (Info-title-1-face . Info-title-1-face) + (Info-title-2-face . Info-title-2-face) + (Info-title-3-face . Info-title-3-face) + (Info-title-4-face . Info-title-4-face) + (info-menu-5 . info-menu-5) + (info-xref . info-xref))) (make-local-variable 'Info-history) (make-local-variable 'Info-index-alternatives) (set (make-local-variable 'tool-bar-map) info-tool-bar-map) @@ -2587,10 +2597,10 @@ (goto-char (point-min)) (when (re-search-forward "\\* Menu:" nil t) (put-text-property (match-beginning 0) (match-end 0) - 'face 'info-menu-header) + 'category 'info-menu-header) (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t) (put-text-property (match-beginning 1) (match-end 1) - 'face 'info-menu-header))))) + 'category 'info-menu-header))))) (defun Info-fontify-node () ;; Only fontify the node if it hasn't already been done. [We pass in @@ -2618,8 +2628,8 @@ (tbeg (match-beginning 1)) (tag (buffer-substring tbeg (match-end 1)))) (if (string-equal tag "Node") - (put-text-property nbeg nend 'face 'info-header-node) - (put-text-property nbeg nend 'face 'info-header-xref) + (put-text-property nbeg nend 'category 'info-header-node) + (put-text-property nbeg nend 'category 'info-header-xref) (put-text-property tbeg nend 'mouse-face 'highlight) (put-text-property tbeg nend 'help-echo @@ -2646,14 +2656,14 @@ (goto-char (point-min)) (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\|\\.+\\)$" nil t) - (let ((c (preceding-char)) - face) - (cond ((= c ?*) (setq face 'Info-title-1-face)) - ((= c ?=) (setq face 'Info-title-2-face)) - ((= c ?-) (setq face 'Info-title-3-face)) - (t (setq face 'Info-title-4-face))) + (let* ((c (preceding-char)) + (category + (cond ((= c ?*) 'Info-title-1-face) + ((= c ?=) 'Info-title-2-face) + ((= c ?-) 'Info-title-3-face) + (t 'Info-title-4-face)))) (put-text-property (match-beginning 1) (match-end 1) - 'face face)) + 'category category)) ;; This is a serious problem for trying to handle multiple ;; frame types at once. We want this text to be invisible ;; on frames that can display the font above. @@ -2665,7 +2675,7 @@ (if (= (char-after (1- (match-beginning 0))) ?\") ; hack nil (add-text-properties (match-beginning 1) (match-end 1) - '(face info-xref + '(category info-xref mouse-face highlight help-echo "mouse-2: go to this node")))) (goto-char (point-min)) @@ -2679,9 +2689,9 @@ (if (zerop (% n 3)) ; visual aids to help with 1-9 keys (put-text-property (match-beginning 0) (1+ (match-beginning 0)) - 'face 'info-menu-5)) + 'category 'info-menu-5)) (add-text-properties (match-beginning 1) (match-end 1) - '(face info-xref + '(category info-xref mouse-face highlight help-echo "mouse-2: go to this node"))))) (Info-fontify-menu-headers) Index: lisp/replace.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/replace.el,v retrieving revision 1.143 diff -u -d -u -r1.143 replace.el --- lisp/replace.el 15 May 2002 19:35:54 -0000 1.143 +++ lisp/replace.el 16 May 2002 18:42:43 -0000 @@ -453,6 +453,11 @@ "Arguments to pass to `occur-1' to revert an Occur mode buffer. See `occur-revert-function'.") +(defcustom occur-mode-hook '(font-lock-mode) + "Hooks run when `occur' is called." + :type 'hook + :group 'matching) + (put 'occur-mode 'mode-class 'special) (defun occur-mode () "Major mode for output from \\[occur]. @@ -466,9 +471,9 @@ (setq major-mode 'occur-mode) (setq mode-name "Occur") (make-local-variable 'revert-buffer-function) - (set (make-local-variable 'font-lock-defaults) - '(nil t nil nil nil - (font-lock-fontify-region-function . occur-fontify-region-function))) + (set (make-local-variable 'font-lock-category-alist) + '((occur-match . bold) + (occur-title . underline))) (setq revert-buffer-function 'occur-revert-function) (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) (make-local-variable 'occur-revert-arguments) @@ -785,7 +790,7 @@ (add-text-properties (match-beginning 0) (match-end 0) (append - '(occur-match t) + '(occur-match t category occur-match) (when match-face `(face ,match-face))) curstring) @@ -797,7 +802,7 @@ (append (when prefix-face `(face prefix-face)) - '(occur-prefix t))) + '(occur-prefix t category occur-prefix))) curstring "\n")) (data @@ -842,35 +847,10 @@ (append (when title-face `(face ,title-face)) - `(occur-title ,buf)))) + `(occur-title t category occur-title)))) (goto-char (point-min))))))) ;; Return the number of matches globalcount))) - -(defun occur-fontify-on-property (prop face beg end) - (let ((prop-beg (or (and (get-text-property (point) prop) (point)) - (next-single-property-change (point) prop nil end)))) - (when (and prop-beg (not (= prop-beg end))) - (let ((prop-end (next-single-property-change beg prop nil end))) - (when (and prop-end (not (= prop-end end))) - (put-text-property prop-beg prop-end 'face face) - prop-end))))) - -(defun occur-fontify-region-function (beg end &optional verbose) - (when verbose (message "Fontifying...")) - (let ((inhibit-read-only t)) - (save-excursion - (dolist (e `((occur-title . ,list-matching-lines-buffer-name-face) - (occur-match . ,list-matching-lines-face))) - ; (occur-prefix . ,list-matching-lines-prefix-face))) - (goto-char beg) - (let ((change-end nil)) - (while (setq change-end (occur-fontify-on-property (car e) - (cdr e) - (point) - end)) - (goto-char change-end)))))) - (when verbose (message "Fontifying...done"))) ;; It would be nice to use \\[...], but there is no reasonable way Index: lisp/ibuffer.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/ibuffer.el,v retrieving revision 1.29 diff -u -d -u -r1.29 ibuffer.el --- lisp/ibuffer.el 13 May 2002 06:00:06 -0000 1.29 +++ lisp/ibuffer.el 16 May 2002 18:42:42 -0000 @@ -36,6 +36,8 @@ (require 'ibuf-macs) (require 'dired)) +(require 'font-lock) + ;;; Compatibility (eval-and-compile (if (fboundp 'window-list) @@ -44,18 +46,7 @@ (defun ibuffer-window-list () (let ((ibuffer-window-list-result nil)) (walk-windows #'(lambda (win) (push win ibuffer-window-list-result)) 'nomini) - (nreverse ibuffer-window-list-result)))) - - (cond ((boundp 'global-font-lock-mode) - (defsubst ibuffer-use-fontification () - (when (boundp 'font-lock-mode) - font-lock-mode))) - ((boundp 'font-lock-auto-fontify) - (defsubst ibuffer-use-fontification () - font-lock-auto-fontify)) - (t - (defsubst ibuffer-use-fontification () - nil)))) + (nreverse ibuffer-window-list-result))))) (defgroup ibuffer nil "An advanced replacement for `buffer-menu'. @@ -67,7 +58,7 @@ (defcustom ibuffer-formats '((mark modified read-only " " (name 16 16 :left :elide) " " (size 6 -1 :right) - " " (mode 16 16 :right :elide) " " filename) + " " (mode 16 16 :right :elide) " " filename-and-process) (mark " " (name 16 -1) " " filename)) "A list of ways to display buffer lines. @@ -152,7 +143,10 @@ PRIORITY is an integer, FORM is an arbitrary form to evaluate in the buffer, and FACE is the face to use for fontification. If the FORM evaluates to non-nil, then FACE will be put on the buffer name. The -element with the highest PRIORITY takes precedence." +element with the highest PRIORITY takes precedence. + +If you change this variable, you must kill the ibuffer buffer and +recreate it for the change to take effect." :type '(repeat (list (integer :tag "Priority") (sexp :tag "Test Form") @@ -1361,9 +1355,8 @@ form)) (defun ibuffer-compile-make-eliding-form (strvar elide from-end-p) - (let ((ellipsis (if (ibuffer-use-fontification) - (propertize ibuffer-eliding-string 'face 'bold) - ibuffer-eliding-string))) + (let ((ellipsis (propertize ibuffer-eliding-string 'category + 'ibuffer-eliding-string))) (if (or elide ibuffer-elide-long-columns) `(if (> strlen 5) ,(if from-end-p @@ -1474,8 +1467,16 @@ (put ',sym 'ibuffer-column-summary (cons ret (get ',sym 'ibuffer-column-summary))) ret))) - (lambda (arg sym) - `(insert ,arg)))) + ;; We handle the `name' column specially. + (if (eq sym 'ibuffer-make-column-name) + (lambda (arg sym) + `(let ((pt (point))) + (insert ,arg) + (put-text-property pt (point) + 'category + (ibuffer-buffer-name-category buffer mark)))) + (lambda (arg sym) + `(insert ,arg))))) (mincompform `(< strlen ,(if (integerp min) min 'min))) @@ -1633,6 +1634,13 @@ dired-directory) "")))) +(define-ibuffer-column filename-and-process (:name "Filename/Process") + (let ((proc (get-buffer-process buffer)) + (filename (ibuffer-make-column-filename buffer mark))) + (if proc + (format "(%s %s) %s" proc (process-status proc) filename) + filename))) + (defun ibuffer-format-column (str width alignment) (let ((left (make-string (/ width 2) ? )) (right (make-string (- width (/ width 2)) ? ))) @@ -1641,52 +1649,23 @@ (:center (concat left str right)) (t (concat str left right))))) -(defun ibuffer-fontify-region-function (beg end &optional verbose) - (when verbose (message "Fontifying...")) - (let ((inhibit-read-only t)) - (save-excursion - (goto-char beg) - (beginning-of-line) - (while (< (point) end) - (if (get-text-property (point) 'ibuffer-title-header) - (put-text-property (point) (line-end-position) 'face ibuffer-title-face) - (if (get-text-property (point) 'ibuffer-filter-group-name) - (put-text-property (point) (line-end-position) 'face - ibuffer-filter-group-name-face) - (unless (or (get-text-property (point) 'ibuffer-title) - (get-text-property (point) 'ibuffer-summary)) - (multiple-value-bind (buf mark) - (get-text-property (point) 'ibuffer-properties) - (let* ((namebeg (next-single-property-change (point) 'ibuffer-name-column - nil (line-end-position))) - (nameend (next-single-property-change namebeg 'ibuffer-name-column - nil (line-end-position)))) - (put-text-property namebeg - nameend - 'face - (cond ((char-equal mark ibuffer-marked-char) - ibuffer-marked-face) - ((char-equal mark ibuffer-deletion-char) - ibuffer-deletion-face) - (t - (let ((level -1) - result) - (dolist (e ibuffer-fontification-alist result) - (when (and (> (car e) level) - (with-current-buffer buf - (eval (cadr e)))) - (setq level (car e) - result - (if (symbolp (caddr e)) - (if (facep (caddr e)) - (caddr e) - (symbol-value (caddr e)))))))))))))))) - (forward-line 1)))) - (when verbose (message "Fontifying...done"))) - -(defun ibuffer-unfontify-region-function (beg end) - (let ((inhibit-read-only t)) - (remove-text-properties beg end '(face nil)))) +(defun ibuffer-buffer-name-category (buf mark) + (cond ((char-equal mark ibuffer-marked-char) + 'ibuffer-category-marked) + ((char-equal mark ibuffer-deletion-char) + 'ibuffer-category-deleted) + (t + (let ((counter 0) + (level -1) + result) + (dolist (e ibuffer-fontification-alist result) + (when (and (> (car e) level) + (with-current-buffer buf + (eval (cadr e)))) + (setq level (car e) + result + (intern (format "ibuffer-category-%d" counter)))) + (incf counter)))))) (defun ibuffer-insert-buffer-line (buffer mark format) "Insert a line describing BUFFER and MARK using FORMAT." @@ -1898,7 +1877,7 @@ (next-single-property-change (point-min) 'ibuffer-title))) (goto-char (point-min)) - (put-text-property + (add-text-properties (point) (progn (let ((opos (point))) @@ -1922,7 +1901,8 @@ (- min len) align) name)))))) - (put-text-property opos (point) 'ibuffer-title-header t) + (add-text-properties opos (point) '(ibuffer-title-header + t category ibuffer-title-header)) (insert "\n") ;; Add the underlines (let ((str (save-excursion @@ -1938,14 +1918,14 @@ str))) (insert "\n")) (point)) - 'ibuffer-title t) + '(ibuffer-title t category ibuffer-title)) ;; Now, insert the summary columns. (goto-char (point-max)) (if (get-text-property (1- (point-max)) 'ibuffer-summary) (delete-region (previous-single-property-change (point-max) 'ibuffer-summary) (point-max))) - (put-text-property + (add-text-properties (point) (progn (insert "\n") @@ -1972,7 +1952,7 @@ align) summary))))))) (point)) - 'ibuffer-summary t))) + '(ibuffer-summary t category ibuffer-summary)))) (defun ibuffer-update-mode-name () (setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode @@ -2080,9 +2060,11 @@ (progn (insert "[ " display-name " ]") (point)) - `(ibuffer-filter-group-name ,name keymap ,ibuffer-mode-filter-group-map - mouse-face highlight - help-echo ,(concat filter-string "mouse-1: toggle marks in this group\nmouse-2: hide/show this filtering group "))) + `(ibuffer-filter-group-name + ,name + category ibuffer-filter-group-name keymap ,ibuffer-mode-filter-group-map + mouse-face highlight + help-echo ,(concat filter-string "mouse-1: toggle marks in this group\nmouse-2: hide/show this filtering group "))) (insert "\n") (when bmarklist (put-text-property @@ -2169,7 +2151,7 @@ ;;;###autoload (defun ibuffer (&optional other-window-p name qualifiers noselect - shrink filter-groups) + shrink filter-groups formats) "Begin using `ibuffer' to edit a list of buffers. Type 'h' after entering ibuffer for more information. @@ -2182,7 +2164,10 @@ Optional argument SHRINK means shrink the buffer to minimal size. The special value `onewindow' means always use another window. Optional argument FILTER-GROUPS is an initial set of filtering -groups to use; see `ibuffer-filter-groups'." +groups to use; see `ibuffer-filter-groups'. +Optional argument FORMATS is the value to use for `ibuffer-formats'. +If specified, then the variable `ibuffer-formats' will have that value +locally in this buffer." (interactive "P") (when ibuffer-use-other-window (setq other-window-p t)) @@ -2200,8 +2185,6 @@ (unless (eq major-mode 'ibuffer-mode) (ibuffer-mode) (setq need-update t)) - (when (ibuffer-use-fontification) - (require 'font-lock)) (setq ibuffer-delete-window-on-quit other-window-p) (when shrink (setq ibuffer-shrink-to-minimum-size shrink)) @@ -2211,6 +2194,8 @@ (when filter-groups (require 'ibuf-ext) (setq ibuffer-filter-groups filter-groups)) + (when formats + (set (make-local-variable 'ibuffer-formats) formats)) (ibuffer-update nil) ;; Skip the group name by default. (ibuffer-forward-line 0 t) @@ -2406,12 +2391,16 @@ ;; This makes things less ugly for Emacs 21 users with a non-nil ;; `show-trailing-whitespace'. (setq show-trailing-whitespace nil) - ;; Dummy font-lock-defaults to make font-lock turn on. We want this - ;; so we know when to enable ibuffer's internal fontification. - (set (make-local-variable 'font-lock-defaults) - '(nil t nil nil nil - (font-lock-fontify-region-function . ibuffer-fontify-region-function) - (font-lock-unfontify-region-function . ibuffer-unfontify-region-function))) + + (set (make-local-variable 'font-lock-category-alist) + `((ibuffer-title . ,ibuffer-title-face) + (ibuffer-filter-group-name . ,ibuffer-filter-group-name-face) + (ibuffer-eliding-string . bold))) + (dotimes (i (length ibuffer-fontification-alist)) + (push (cons (intern (format "ibuffer-category-%d" i)) + (nth 2 (nth i ibuffer-fontification-alist))) + font-lock-category-alist)) + (set (make-local-variable 'revert-buffer-function) #'ibuffer-update) (set (make-local-variable 'ibuffer-sorting-mode)