unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Colin Walters <walters@gnu.org>
Subject: Re: kill ring menu
Date: 16 May 2002 14:47:52 -0400	[thread overview]
Message-ID: <1021574872.27195.902.camel@space-ghost> (raw)
In-Reply-To: <200205100030.g4A0U2D06495@aztec.santafe.edu>

[-- Attachment #1: Type: text/plain, Size: 1060 bytes --]

On Thu, 2002-05-09 at 20:30, Richard Stallman wrote:

> The easiest way to implement these functions will often be to use
> a category property.  Then these functions can simply change the
> properties of the category, and faces will appear or disappear all thru
> the buffer.
> 
> In fact, it might make sense to have a buffer-local variable
> font-lock-category-alist whose elements look like (CATEGORY-SYMBOL .
> FACE-PROP).  

This solution is genius!  I didn't understand it at all at first, so I
sort of deferred trying to implement it, but after discovering the
`category' text property in the elisp manual it made sense.

Please find attached a patch which implements it, and changes Info,
shell (via comint), occur, and ibuffer to use it.  

I believe this patch addresses everyone's issues.   In particular,
font-core.el is very small, and it is efficient (no runtime searching
for text properties).  

Really, I think info.el should be changed to use a
`font-lock-fontify-region' function; `Info-fontify-maximum-menu-size'
could then just go away.


[-- Attachment #2: font-lock.diff --]
[-- Type: text/plain, Size: 58488 bytes --]

--- /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.
 \f
 ;; 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)))))))
 \f
-;;; 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.
-\f
 ;;; 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))))
 \f
 ;;; 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")))
 
 \f
 ;; 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)

  reply	other threads:[~2002-05-16 18:47 UTC|newest]

Thread overview: 82+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2002-04-28 19:41 kill ring menu Colin Walters
2002-04-28 20:06 ` Colin Walters
2002-04-29  5:05   ` Richard Stallman
2002-04-29 18:40     ` Richard Stallman
2002-04-28 22:53 ` Miles Bader
2002-04-28 23:36 ` Stefan Monnier
2002-04-28 23:42   ` Miles Bader
2002-04-29  4:34   ` Colin Walters
2002-04-30  4:49     ` Eli Zaretskii
2002-04-29  3:35 ` Miles Bader
2002-04-29  4:37   ` Colin Walters
2002-04-29  4:56     ` Miles Bader
2002-04-29  5:37       ` Colin Walters
2002-04-29  7:09         ` Miles Bader
2002-04-30  5:18           ` Richard Stallman
2002-04-30 10:18             ` Per Abrahamsen
2002-04-29  9:22         ` CC (was: Re: kill ring menu) Per Abrahamsen
2002-04-29 15:11           ` Benjamin Rutt
2002-04-29 15:31             ` Miles Bader
2002-04-30  5:19             ` Richard Stallman
2002-04-30 10:14           ` Per Abrahamsen
2002-04-30 11:08             ` Simon Josefsson
2002-04-29 10:10         ` Addressing email (was: " Eli Zaretskii
2002-04-29 13:13         ` kill ring menu Stefan Monnier
2002-04-29 18:40   ` Richard Stallman
     [not found] ` <200204290505.g3T55t006146@aztec.santafe.edu>
     [not found]   ` <1020059236.31789.358.camel@space-ghost>
     [not found]     ` <200204300519.g3U5Js306727@aztec.santafe.edu>
     [not found]       ` <1020212569.27106.2246.camel@space-ghost>
     [not found]         ` <200205011926.g41JQBC07690@aztec.santafe.edu>
     [not found]           ` <1020284783.27106.3417.camel@space-ghost>
2002-05-03 18:25             ` Richard Stallman
2002-05-03 18:46               ` Miles Bader
2002-05-03 19:05               ` Miles Bader
2002-05-03 20:20                 ` Colin Walters
2002-05-04  1:34                   ` Miles Bader
2002-05-04  3:36                 ` Richard Stallman
2002-05-04  3:49                   ` Miles Bader
2002-05-05  5:34                     ` Richard Stallman
2002-05-04  6:04                 ` Eli Zaretskii
     [not found]       ` <1020320725.27616.54.camel@space-ghost>
     [not found]         ` <200205031825.g43IPuD00768@aztec.santafe.edu>
     [not found]           ` <1020502030.5286.25.camel@space-ghost>
2002-05-05 17:46             ` Richard Stallman
2002-05-06  5:15               ` Colin Walters
2002-05-06  6:39                 ` Miles Bader
2002-05-06 22:55                   ` Colin Walters
2002-05-07  1:35                     ` Miles Bader
2002-05-07  3:55                       ` Colin Walters
2002-05-07  4:18                         ` Miles Bader
2002-05-07 20:07                         ` Richard Stallman
2002-05-07 20:38                           ` Colin Walters
2002-05-08  0:20                             ` Miles Bader
2002-05-08  6:05                               ` Colin Walters
2002-05-08  6:50                                 ` Miles Bader
2002-05-08  7:36                                   ` Colin Walters
2002-05-08  7:48                                     ` Miles Bader
2002-05-08  8:57                                     ` Colin Walters
2002-05-08 13:14                                       ` Stefan Monnier
2002-05-09  4:29                                         ` Colin Walters
2002-05-09 10:08                                           ` Kim F. Storm
2002-05-09  2:45                             ` Richard Stallman
2002-05-09  4:28                               ` Colin Walters
2002-05-10  0:30                                 ` Richard Stallman
2002-05-16 18:47                                   ` Colin Walters [this message]
2002-05-16 19:12                                     ` Miles Bader
2002-05-16 19:20                                       ` Colin Walters
2002-05-16 19:36                                         ` Miles Bader
2002-05-16 19:45                                           ` Miles Bader
2002-05-16 19:54                                           ` Colin Walters
2002-05-16 20:12                                     ` Miles Bader
2002-05-16 20:17                                       ` Colin Walters
2002-05-16 20:23                                         ` Miles Bader
2002-05-16 21:47                                           ` Colin Walters
2002-05-16 21:54                                           ` Kim F. Storm
2002-05-16 21:15                                             ` Miles Bader
2002-05-17 19:29                                       ` Richard Stallman
2002-05-07 19:22                     ` Alex Schroeder
2002-05-09 20:09                       ` Colin Walters
2002-05-11  6:30                       ` Richard Stallman
2002-05-13 22:17                         ` Colin Walters
2002-05-14  8:36                           ` Miles Bader
2002-05-14 12:49                           ` Emacs 21.4 (was: kill ring menu) Eli Zaretskii
2002-05-15  7:01                           ` kill ring menu Richard Stallman
2002-05-06  6:46                 ` Stephen J. Turnbull
2002-05-06 22:46                   ` Colin Walters
2002-05-08 10:06                     ` Francesco Potorti`
2002-05-08 10:20                       ` Eli Zaretskii
2002-05-06 19:32                 ` Richard Stallman
2002-05-07  4:03                   ` Colin Walters
2002-05-07  5:27                     ` Eli Zaretskii

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1021574872.27195.902.camel@space-ghost \
    --to=walters@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).