comparison lisp/fast-lock.el @ 16579:aadb4abdeaaa

(a) make fast-lock-get-face-properties cope with face property lists, (b) add fast-lock-verbose to control messages.

16578:c921b60ee783

;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.

;; Author: Simon Marshall <[e-mail]>
;; Keywords: faces files
;; Version: 3.10

;;; 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

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Purpose:
;;
;; To make visiting a file in `font-lock-mode' faster by restoring its face
;; text properties from automatically saved associated Font Lock cache files.
;;
;; See caveats and feedback below.
;; See also the lazy-lock package.  (But don't use the two at the same time!)

;; Installation:

;; A cache will be saved when visiting a compressed file using crypt++, but not
;; be read.  This is a "feature"/"consequence"/"bug" of crypt++.
;;
;; Version control packages are likely to stamp all over file modification
;; times.  Therefore the act of checking out may invalidate a cache.

;; Feedback:
;;
;; Feedback is welcome.
;; To submit a bug report (or make comments) please use the mechanism provided:
;;
;; M-x fast-lock-submit-bug-report RET

;; History:
;;
;; 0.02--1.00:
;; - Changed name from turbo-prop to fast-lock.  Automagic for font-lock only

;; - XEmacs: Made `add-minor-mode' succeed `autoload' cookie
;; - XEmacs: Made `fast-lock-save-faces' default to `font-lock-face-list'
;; - Made `fast-lock-save-cache' use `font-lock-value-in-major-mode'
;; - Wrap with `save-buffer-state' (Ray Van Tassle report)
;; - Made `fast-lock-mode' wrap `font-lock-support-mode'

(require 'font-lock)

;; Make sure fast-lock.el is supported.
(if (and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
    (error "`fast-lock' was written for long file name systems"))

  ;; We don't do this at the top-level as we only use non-autoloaded macros.
  (require 'cl)
  ;;
  ;; I prefer lazy code---and lazy mode.
  (setq byte-compile-dynamic t byte-compile-dynamic-docstrings t)
  ;;
  ;; We use this to preserve or protect things when modifying text properties.
  (defmacro save-buffer-state (varlist &rest body)
    "Bind variables according to VARLIST and eval BODY restoring buffer state."
    (` (let* ((,@ (append varlist

		     before-change-functions after-change-functions
		     deactivate-mark buffer-file-name buffer-file-truename))))
	 (,@ body)
	 (when (and (not modified) (buffer-modified-p))
	   (set-buffer-modified-p nil)))))
  (put 'save-buffer-state 'lisp-indent-function 1))

(defun fast-lock-submit-bug-report ()
  "Submit via mail a bug report on fast-lock.el."
  (interactive)
  (let ((reporter-prompt-for-summary-p t))
    (reporter-submit-bug-report "[e-mail]" "fast-lock 3.10"
     '(fast-lock-cache-directories fast-lock-minimum-size
       fast-lock-save-others fast-lock-save-events fast-lock-save-faces)
     nil nil
     (concat "Hi Si.,

I want to report a bug.  I've read the `Bugs' section of `Info' on Emacs, so I
know how to make a clear and unambiguous report.  To reproduce the bug:

Start a fresh Emacs via `" invocation-name " -no-init-file -no-site-file'.
In the `*scratch*' buffer, evaluate:"))))

(defvar fast-lock-mode nil)
(defvar fast-lock-cache-timestamp nil)	; for saving/reading
(defvar fast-lock-cache-filename nil)	; for deleting


  (when (save-match-data (string-match "XEmacs" (emacs-version)))
    ;; XEmacs uses extents for everything, so we have to pick the right ones.
    font-lock-face-list)
  "Faces that will be saved in a Font Lock cache file.
If nil, means information for all faces will be saved.")

;; User Functions:

;;;###autoload
(defun fast-lock-mode (&optional arg)

If Fast Lock mode is enabled, and the current buffer does not contain any text
properties, any associated Font Lock cache is used if its timestamp matches the
buffer's file, and its `font-lock-keywords' match those that you are using.

Font Lock caches may be saved:
 - When you save the file's buffer.
 - When you kill an unmodified file's buffer.
 - When you exit Emacs, for all unmodified or saved buffers.
Depending on the value of `fast-lock-save-events'.
See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'.

Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad.

Various methods of control are provided for the Font Lock cache.  In general,
see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'.
For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events',
`fast-lock-save-others' and `fast-lock-save-faces'.

Use \\[fast-lock-submit-bug-report] to send bug reports or feedback."
  (interactive "P")
  ;; Only turn on if we are visiting a file.  We could use `buffer-file-name',
  ;; but many packages temporarily wrap that to nil when doing their own thing.
  (set (make-local-variable 'fast-lock-mode)
       (and buffer-file-truename

(defun fast-lock-read-cache ()
  "Read the Font Lock cache for the current buffer.

The following criteria must be met for a Font Lock cache file to be read:
 - Fast Lock mode must be turned on in the buffer.
 - The buffer must not be modified.
 - The buffer's `font-lock-keywords' must match the cache's.
 - The buffer file's timestamp must match the cache's.
 - Criteria imposed by `fast-lock-cache-directories'.

See `fast-lock-mode'."
  (interactive)
  (let ((directories fast-lock-cache-directories)
	(modified (buffer-modified-p)) (inhibit-read-only t)

(defun fast-lock-save-cache (&optional buffer)
  "Save the Font Lock cache of BUFFER or the current buffer.

The following criteria must be met for a Font Lock cache file to be saved:
 - Fast Lock mode must be turned on in the buffer.
 - The event must be one of `fast-lock-save-events'.
 - The buffer must be at least `fast-lock-minimum-size' bytes long.
 - The buffer file must be owned by you, or `fast-lock-save-others' must be t.
 - The buffer must contain at least one `face' text property.
 - The buffer must not be modified.
 - The buffer file's timestamp must be the same as the file's on disk.
 - The on disk file's timestamp must be different than the buffer's cache.
 - Criteria imposed by `fast-lock-cache-directories'.

See `fast-lock-mode'."
  (interactive)
  (save-excursion
    (when buffer

(defun fast-lock-save-cache-1 (file timestamp)
  ;; Save the FILE with the TIMESTAMP as:
  ;; (fast-lock-cache-data Version=2 TIMESTAMP font-lock-keywords PROPERTIES).
  ;; Returns non-nil if a save was attempted to a writable cache file.
  (let ((tpbuf (generate-new-buffer " *fast-lock*"))
	(buname (buffer-name)) (saved t))
    (message "Saving %s font lock cache..." buname)
    (condition-case nil
	(save-excursion
	  (print (list 'fast-lock-cache-data 2
		       (list 'quote timestamp)
		       (list 'quote font-lock-keywords)

	  (write-region (point-min) (point-max) file nil 'quietly)
	  (setq fast-lock-cache-timestamp timestamp
		fast-lock-cache-filename file))
      (error (setq saved 'error)) (quit (setq saved 'quit)))
    (kill-buffer tpbuf)
    (message "Saving %s font lock cache...%s" buname
	     (cond ((eq saved 'error) "failed")
		   ((eq saved 'quit) "aborted")
		   (t "done")))
    ;; We return non-nil regardless of whether a failure occurred.
    saved))

(defun fast-lock-cache-data (version timestamp keywords properties
			     &rest ignored)

	  font-lock-keywords (font-lock-compile-keywords current)))
  ;; Use the Font Lock cache PROPERTIES if we're using cache VERSION format 2,
  ;; the current buffer's file timestamp matches the TIMESTAMP, and the current
  ;; buffer's font-lock-keywords are the same as KEYWORDS.
  (let ((buf-timestamp (visited-file-modtime))
	(buname (buffer-name)) (loaded t))
    (if (or (/= version 2)
	    (buffer-modified-p)
	    (not (equal timestamp buf-timestamp))
	    (not (equal keywords font-lock-keywords)))
	(setq loaded nil)
      (message "Loading %s font lock cache..." buname)
      (condition-case nil
	  (fast-lock-set-face-properties properties)
	(error (setq loaded 'error)) (quit (setq loaded 'quit)))
      (message "Loading %s font lock cache...%s" buname
	       (cond ((eq loaded 'error) "failed")
		     ((eq loaded 'quit) "aborted")
		     (t "done"))))
    (setq font-lock-fontified (eq loaded t)
	  fast-lock-cache-timestamp (and (eq loaded t) timestamp))))

;; Text Properties Processing Functions:

;; This is faster, but fails if adjacent characters have different `face' text
;; properties.  Maybe that's why I dropped it in the first place?
;(defun fast-lock-get-face-properties ()
;  "Return a list of all `face' text properties in the current buffer.
;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
;where VALUE is a `face' property value and STARTx and ENDx are positions."

;	    (setcdr cell (cons start (cons end (cdr cell))))
;	  (setq properties (cons (list value start end) properties)))
;	(setq start (next-single-property-change end 'face)))
;      properties)))

(defun fast-lock-get-face-properties ()
  "Return a list of all `face' text properties in the current buffer.
Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
where VALUE is a `face' property value and STARTx and ENDx are positions.
Only those `face' VALUEs in `fast-lock-save-faces' are returned."
  (save-restriction
    (widen)
    (let ((faces (or fast-lock-save-faces (face-list))) (limit (point-max))
	  properties regions face start end)
      (while faces
	(setq face (car faces) faces (cdr faces) regions () end (point-min))
	;; Make a list of start/end regions with `face' property face.
	(while (setq start (text-property-any end limit 'face face))
	  (setq end (or (text-property-not-all start limit 'face face) limit)
		regions (cons start (cons end regions))))
	;; Add `face' face's regions, if any, to properties.
	(when regions
	  (push (cons face regions) properties)))
      properties)))

(defun fast-lock-set-face-properties (properties)
  "Set all `face' text properties to PROPERTIES in the current buffer.
Any existing `face' text properties are removed first.

      (let ((properties ()) cell)
	(map-extents
	 (function (lambda (extent ignore)
	    (let ((value (extent-face extent)))
	      ;; We're only interested if it's one of `fast-lock-save-faces'.
	      (when (and value (or (null fast-lock-save-faces)
				   (memq value fast-lock-save-faces)))
		(let ((start (extent-start-position extent))
		      (end (extent-end-position extent)))
		  ;; Make or add to existing list of regions with the same
		  ;; `face' property value.
		  (if (setq cell (assq value properties))
		      (setcdr cell (cons start (cons end (cdr cell))))
		    (push (list value start end) properties))))
	      ;; Return nil to keep `map-extents' going.
	      nil))))
	properties)))

(unless (boundp 'font-lock-inhibit-thing-lock)
  (defvar font-lock-inhibit-thing-lock nil
    "List of Font Lock mode related modes that should not be turned on."))

(unless (fboundp 'font-lock-compile-keywords)
  (defalias 'font-lock-compile-keywords 'identity))

;; Install ourselves:

16579:aadb4abdeaaa

;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.

;; Author: Simon Marshall <[e-mail]>
;; Keywords: faces files
;; Version: 3.11

;;; 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

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Lazy Lock mode is a Font Lock support mode.
;; It makes visiting a file in Font Lock mode faster by restoring its face text
;; properties from automatically saved associated Font Lock cache files.
;;
;; See caveats and feedback below.
;; See also the lazy-lock package.  (But don't use the two at the same time!)

;; Installation:

;; A cache will be saved when visiting a compressed file using crypt++, but not
;; be read.  This is a "feature"/"consequence"/"bug" of crypt++.
;;
;; Version control packages are likely to stamp all over file modification
;; times.  Therefore the act of checking out may invalidate a cache.

;; History:
;;
;; 0.02--1.00:
;; - Changed name from turbo-prop to fast-lock.  Automagic for font-lock only

;; - XEmacs: Made `add-minor-mode' succeed `autoload' cookie
;; - XEmacs: Made `fast-lock-save-faces' default to `font-lock-face-list'
;; - Made `fast-lock-save-cache' use `font-lock-value-in-major-mode'
;; - Wrap with `save-buffer-state' (Ray Van Tassle report)
;; - Made `fast-lock-mode' wrap `font-lock-support-mode'
;; 3.10--3.11:
;; - Made `fast-lock-get-face-properties' cope with face lists
;; - Added `fast-lock-verbose'
;; - XEmacs: Add `font-lock-value-in-major-mode' if necessary
;; - Removed `fast-lock-submit-bug-report' and bade farewell

;;; Code:

(require 'font-lock)

;; Make sure fast-lock.el is supported.
(if (and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
    (error "`fast-lock' was written for long file name systems"))

  ;; We don't do this at the top-level as we only use non-autoloaded macros.
  (require 'cl)
  ;;
  ;; I prefer lazy code---and lazy mode.
  (setq byte-compile-dynamic t byte-compile-dynamic-docstrings t)
  ;; But, we make sure that the code is as zippy as can be.
  (setq byte-optimize t)
  ;;
  ;; We use this to preserve or protect things when modifying text properties.
  (defmacro save-buffer-state (varlist &rest body)
    "Bind variables according to VARLIST and eval BODY restoring buffer state."
    (` (let* ((,@ (append varlist

		     before-change-functions after-change-functions
		     deactivate-mark buffer-file-name buffer-file-truename))))
	 (,@ body)
	 (when (and (not modified) (buffer-modified-p))
	   (set-buffer-modified-p nil)))))
  (put 'save-buffer-state 'lisp-indent-function 1)
  ;;
  ;; We use this to verify that a face should be saved.
  (defmacro fast-lock-save-facep (face)
    "Return non-nil if FACE is one of `fast-lock-save-faces'."
    (` (or (null fast-lock-save-faces)
	   (if (symbolp (, face))
	       (memq (, face) fast-lock-save-faces)
	     (let ((faces (, face)))
	       (while (unless (memq (car faces) fast-lock-save-faces)
			(setq faces (cdr faces))))
	       faces))))))

;(defun fast-lock-submit-bug-report ()
;  "Submit via mail a bug report on fast-lock.el."
;  (interactive)
;  (let ((reporter-prompt-for-summary-p t))
;    (reporter-submit-bug-report "[e-mail]" "fast-lock 3.11"
;     '(fast-lock-cache-directories fast-lock-minimum-size
;       fast-lock-save-others fast-lock-save-events fast-lock-save-faces
;       fast-lock-verbose)
;     nil nil
;     (concat "Hi Si.,
;
;I want to report a bug.  I've read the `Bugs' section of `Info' on Emacs, so I
;know how to make a clear and unambiguous report.  To reproduce the bug:
;
;Start a fresh editor via `" invocation-name " -no-init-file -no-site-file'.
;In the `*scratch*' buffer, evaluate:"))))

(defvar fast-lock-mode nil)
(defvar fast-lock-cache-timestamp nil)	; for saving/reading
(defvar fast-lock-cache-filename nil)	; for deleting


  (when (save-match-data (string-match "XEmacs" (emacs-version)))
    ;; XEmacs uses extents for everything, so we have to pick the right ones.
    font-lock-face-list)
  "Faces that will be saved in a Font Lock cache file.
If nil, means information for all faces will be saved.")

(defvar fast-lock-verbose font-lock-verbose
  "*If non-nil, means show status messages for cache processing.
If a number, only buffers greater than this size have processing messages.")

;; User Functions:

;;;###autoload
(defun fast-lock-mode (&optional arg)

If Fast Lock mode is enabled, and the current buffer does not contain any text
properties, any associated Font Lock cache is used if its timestamp matches the
buffer's file, and its `font-lock-keywords' match those that you are using.

Font Lock caches may be saved:
- When you save the file's buffer.
- When you kill an unmodified file's buffer.
- When you exit Emacs, for all unmodified or saved buffers.
Depending on the value of `fast-lock-save-events'.
See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'.

Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad.

Various methods of control are provided for the Font Lock cache.  In general,
see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'.
For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events',
`fast-lock-save-others' and `fast-lock-save-faces'."
  (interactive "P")
  ;; Only turn on if we are visiting a file.  We could use `buffer-file-name',
  ;; but many packages temporarily wrap that to nil when doing their own thing.
  (set (make-local-variable 'fast-lock-mode)
       (and buffer-file-truename

(defun fast-lock-read-cache ()
  "Read the Font Lock cache for the current buffer.

The following criteria must be met for a Font Lock cache file to be read:
- Fast Lock mode must be turned on in the buffer.
- The buffer must not be modified.
- The buffer's `font-lock-keywords' must match the cache's.
- The buffer file's timestamp must match the cache's.
- Criteria imposed by `fast-lock-cache-directories'.

See `fast-lock-mode'."
  (interactive)
  (let ((directories fast-lock-cache-directories)
	(modified (buffer-modified-p)) (inhibit-read-only t)

(defun fast-lock-save-cache (&optional buffer)
  "Save the Font Lock cache of BUFFER or the current buffer.

The following criteria must be met for a Font Lock cache file to be saved:
- Fast Lock mode must be turned on in the buffer.
- The event must be one of `fast-lock-save-events'.
- The buffer must be at least `fast-lock-minimum-size' bytes long.
- The buffer file must be owned by you, or `fast-lock-save-others' must be t.
- The buffer must contain at least one `face' text property.
- The buffer must not be modified.
- The buffer file's timestamp must be the same as the file's on disk.
- The on disk file's timestamp must be different than the buffer's cache.
- Criteria imposed by `fast-lock-cache-directories'.

See `fast-lock-mode'."
  (interactive)
  (save-excursion
    (when buffer

(defun fast-lock-save-cache-1 (file timestamp)
  ;; Save the FILE with the TIMESTAMP as:
  ;; (fast-lock-cache-data Version=2 TIMESTAMP font-lock-keywords PROPERTIES).
  ;; Returns non-nil if a save was attempted to a writable cache file.
  (let ((tpbuf (generate-new-buffer " *fast-lock*"))
	(verbose (if (numberp fast-lock-verbose)
		     (> (buffer-size) fast-lock-verbose)
		   fast-lock-verbose))
	(saved t))
    (if verbose (message "Saving %s font lock cache..." (buffer-name)))
    (condition-case nil
	(save-excursion
	  (print (list 'fast-lock-cache-data 2
		       (list 'quote timestamp)
		       (list 'quote font-lock-keywords)

	  (write-region (point-min) (point-max) file nil 'quietly)
	  (setq fast-lock-cache-timestamp timestamp
		fast-lock-cache-filename file))
      (error (setq saved 'error)) (quit (setq saved 'quit)))
    (kill-buffer tpbuf)
    (if verbose (message "Saving %s font lock cache...%s" (buffer-name)
			 (cond ((eq saved 'error) "failed")
			       ((eq saved 'quit) "aborted")
			       (t "done"))))
    ;; We return non-nil regardless of whether a failure occurred.
    saved))

(defun fast-lock-cache-data (version timestamp keywords properties
			     &rest ignored)

	  font-lock-keywords (font-lock-compile-keywords current)))
  ;; Use the Font Lock cache PROPERTIES if we're using cache VERSION format 2,
  ;; the current buffer's file timestamp matches the TIMESTAMP, and the current
  ;; buffer's font-lock-keywords are the same as KEYWORDS.
  (let ((buf-timestamp (visited-file-modtime))
	(verbose (if (numberp fast-lock-verbose)
		     (> (buffer-size) fast-lock-verbose)
		   fast-lock-verbose))
	(loaded t))
    (if (or (/= version 2)
	    (buffer-modified-p)
	    (not (equal timestamp buf-timestamp))
	    (not (equal keywords font-lock-keywords)))
	(setq loaded nil)
      (if verbose (message "Loading %s font lock cache..." (buffer-name)))
      (condition-case nil
	  (fast-lock-set-face-properties properties)
	(error (setq loaded 'error)) (quit (setq loaded 'quit)))
      (if verbose (message "Loading %s font lock cache...%s" (buffer-name)
			   (cond ((eq loaded 'error) "failed")
				 ((eq loaded 'quit) "aborted")
				 (t "done")))))
    (setq font-lock-fontified (eq loaded t)
	  fast-lock-cache-timestamp (and (eq loaded t) timestamp))))

;; Text Properties Processing Functions:

;; This is fast, but fails if adjacent characters have different `face' text
;; properties.  Maybe that's why I dropped it in the first place?
;(defun fast-lock-get-face-properties ()
;  "Return a list of all `face' text properties in the current buffer.
;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
;where VALUE is a `face' property value and STARTx and ENDx are positions."

;	    (setcdr cell (cons start (cons end (cdr cell))))
;	  (setq properties (cons (list value start end) properties)))
;	(setq start (next-single-property-change end 'face)))
;      properties)))

;; This is slow, but copes if adjacent characters have different `face' text
;; properties, but fails if they are lists.
;(defun fast-lock-get-face-properties ()
;  "Return a list of all `face' text properties in the current buffer.
;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
;where VALUE is a `face' property value and STARTx and ENDx are positions.
;Only those `face' VALUEs in `fast-lock-save-faces' are returned."
;  (save-restriction
;    (widen)
;    (let ((faces (or fast-lock-save-faces (face-list))) (limit (point-max))
;	  properties regions face start end)
;      (while faces
;	(setq face (car faces) faces (cdr faces) regions () end (point-min))
;	;; Make a list of start/end regions with `face' property face.
;	(while (setq start (text-property-any end limit 'face face))
;	  (setq end (or (text-property-not-all start limit 'face face) limit)
;		regions (cons start (cons end regions))))
;	;; Add `face' face's regions, if any, to properties.
;	(when regions
;	  (push (cons face regions) properties)))
;      properties)))

(defun fast-lock-get-face-properties ()
  "Return a list of all `face' text properties in the current buffer.
Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
where VALUE is a `face' property value and STARTx and ENDx are positions."
  (save-restriction
    (widen)
    (let ((start (text-property-not-all (point-min) (point-max) 'face nil))
	  end properties value cell)
      (while start
	(setq end (next-single-property-change start 'face nil (point-max))
	      value (get-text-property start 'face))
	;; Make, or add to existing, list of regions with same `face'.
	(cond ((setq cell (assoc value properties))
	       (setcdr cell (cons start (cons end (cdr cell)))))
	      ((fast-lock-save-facep value)
	       (push (list value start end) properties)))
	(setq start (text-property-not-all end (point-max) 'face nil)))
      properties)))

(defun fast-lock-set-face-properties (properties)
  "Set all `face' text properties to PROPERTIES in the current buffer.
Any existing `face' text properties are removed first.

      (let ((properties ()) cell)
	(map-extents
	 (function (lambda (extent ignore)
	    (let ((value (extent-face extent)))
	      ;; We're only interested if it's one of `fast-lock-save-faces'.
	      (when (and value (fast-lock-save-facep value))
		(let ((start (extent-start-position extent))
		      (end (extent-end-position extent)))
		  ;; Make or add to existing list of regions with the same
		  ;; `face' property value.
		  (if (setq cell (assoc value properties))
		      (setcdr cell (cons start (cons end (cdr cell))))
		    (push (list value start end) properties))))
	      ;; Return nil to keep `map-extents' going.
	      nil))))
	properties)))

(unless (boundp 'font-lock-inhibit-thing-lock)
  (defvar font-lock-inhibit-thing-lock nil
    "List of Font Lock mode related modes that should not be turned on."))

(unless (fboundp 'font-lock-value-in-major-mode)
  (defun font-lock-value-in-major-mode (alist)
    ;; Return value in ALIST for `major-mode'.
    (if (consp alist)
	(cdr (or (assq major-mode alist) (assq t alist)))
      alist)))

(unless (fboundp 'font-lock-compile-keywords)
  (defalias 'font-lock-compile-keywords 'identity))

;; Install ourselves: