xemacs-beta: lisp/packages/fast-lock.el comparison

comparison lisp/packages/fast-lock.el @ 24:4103f0995bd7 r19-15b95

Import from CVS: tag r19-15b95

author	cvs
date	Mon, 13 Aug 2007 08:51:03 +0200
parents	8fc7fe29b841
children	131b0175ea99

comparison

equal deleted inserted replaced

-:0edd3412f124
+:4103f0995bd7
 ;;; fast-lock.el --- Automagic text properties caching for fast Font Lock mode.
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
 ;; Author: Simon Marshall <simon@gnu.ai.mit.edu>
 ;; Keywords: faces files
-;; Version: 3.10.02
+;; Version: 3.11.01
 ;;; 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:
+;; Lazy Lock mode is a Font Lock support mode.
-;;
+;; It makes visiting a file in Font Lock mode faster by restoring its face text
-;; To make visiting a file in `font-lock-mode' faster by restoring its face
+;; properties from automatically saved associated Font Lock cache files.
-;; 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.
-;;;;;^L
 ;; History:
 ;;
 ;; 0.02--1.00:
 ;; - Changed name from turbo-prop to fast-lock.  Automagic for font-lock only
 ;; - Made `fast-lock-mode' a minor mode, like G. Dinesh Dutt's fss-mode
 ;; - 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
-;;;;;^L
+;; - Removed `fast-lock-submit-bug-report' and bade farewell
+;; 3.10--3.11:
+;;; 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"))
 	   (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 matches `fast-lock-save-faces'."
+"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 ((list (, face)) found)
+	     (let ((faces (, face)))
-	       (while list
+	       (while (unless (memq (car faces) fast-lock-save-faces)
-		 (if (memq (car list) fast-lock-save-faces)
+			(setq faces (cdr faces))))
-		     (setq list nil found t)
+	       faces))))))
-		   (setq list (cdr list))))
-	       found))))))
+;(defun fast-lock-submit-bug-report ()
+;  "Submit via mail a bug report on fast-lock.el."
-(defun fast-lock-submit-bug-report ()
+;  (interactive)
-"Submit via mail a bug report on fast-lock.el."
+;  (let ((reporter-prompt-for-summary-p t))
-(interactive)
+;    (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.11.01"
-(let ((reporter-prompt-for-summary-p t))
+;     '(fast-lock-cache-directories fast-lock-minimum-size
-(reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.10.02"
+;       fast-lock-save-others fast-lock-save-events fast-lock-save-faces
-'(fast-lock-cache-directories fast-lock-minimum-size
+;       fast-lock-verbose)
-fast-lock-save-others fast-lock-save-events fast-lock-save-faces
+;     nil nil
-fast-lock-verbose)
+;     (concat "Hi Si.,
-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:
-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:"))))
-Start a fresh editor via `" invocation-name " -no-init-file -no-site-file'.
-In the `*scratch*' buffer, evaluate:"))))
+(defvar fast-lock-mode nil)		; Whether we are turned on.
+(defvar fast-lock-cache-timestamp nil)	; For saving/reading.
-;;;###autoload
+(defvar fast-lock-cache-filename nil)	; For deleting.
-(defvar fast-lock-mode nil)
-(defvar fast-lock-cache-timestamp nil)	; for saving/reading
-(defvar fast-lock-cache-filename nil)	; for deleting
-;;;;;^L
 ;; User Variables:
 (defvar fast-lock-cache-directories '("." "~/.emacs-flc")
 ; - `internal', keep each file's Font Lock cache file in the same file.
 ; - `external', keep each file's Font Lock cache file in the same directory.
 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.")
-;;;;;^L
 ;; User Functions:
 ;;;###autoload
 (defun fast-lock-mode (&optional arg)
 "Toggle Fast Lock mode.
 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.
 (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
 ;;;###autoload
 (defun turn-on-fast-lock ()
 "Unconditionally turn on Fast Lock mode."
 (fast-lock-mode t))
-;;;;;^L
 ;;; API Functions:
 (defun fast-lock-after-fontify-buffer ()
 ;; Delete the Font Lock cache file used to restore fontification, if any.
 (when fast-lock-cache-filename
 ;; Flag so that a cache will be saved later even if the file is never saved.
 (setq fast-lock-cache-timestamp nil))
 (defalias 'fast-lock-after-unfontify-buffer
 'ignore)
-;;;;;^L
 ;; Miscellaneous Functions:
 (defun fast-lock-save-cache-after-save-file ()
 ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'.
 (when (memq 'save-buffer fast-lock-save-events)
 	    (function (lambda (c) (or (cdr (assq c chars-alist)) (list c))))))
 (concat
 (file-name-as-directory (expand-file-name directory))
 (mapconcat 'char-to-string (apply 'append (mapcar mapchars bufile)) "")
 ".flc"))))
-;;;;;^L
 ;; Font Lock Cache Processing Functions:
 (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).
 			   (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))))
-;;;;;^L
 ;; Text Properties Processing Functions:
-;; This is faster, but fails if adjacent characters have different `face' text
+;; 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 copes if adjacent characters have different `face' text properties, but
+;; This is slow, but copes if adjacent characters have different `face' text
-;; fails if they are lists.
+;; 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."
 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))
-	  (limit (point-max)) end properties value cell)
+	  end properties value cell)
 (while start
-	(setq end (next-single-property-change start 'face nil limit)
+	(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 (if (get-text-property end 'face)
+	(setq start (text-property-not-all end (point-max) 'face nil)))
-			end
-		      (next-single-property-change end 'face))))
 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.
 	      properties (cdr properties))
 	;; Set the `face' property for each start/end region.
 	(while regions
 	  (set-text-properties (nth 0 regions) (nth 1 regions) plist)
 	  (setq regions (nthcdr 2 regions)))))))
-;;;;;^L
 ;; Functions for XEmacs:
 (when (save-match-data (string-match "XEmacs" (emacs-version)))
 ;;
 ;; It would be better to use XEmacs' `map-extents' over extents with a
 	(cdr (or (assq major-mode alist) (assq t alist)))
 alist)))
 (unless (fboundp 'font-lock-compile-keywords)
 (defalias 'font-lock-compile-keywords 'identity))
-;;;;;^L
 ;; Install ourselves:
 (add-hook 'after-save-hook 'fast-lock-save-cache-after-save-file)
 (add-hook 'kill-buffer-hook 'fast-lock-save-cache-before-kill-buffer)
 (add-hook 'kill-emacs-hook 'fast-lock-save-caches-before-kill-emacs)
 ;;;###autoload
-(if (fboundp 'add-minor-mode) (add-minor-mode 'fast-lock-mode nil))
+(when (fboundp 'add-minor-mode)
+(defvar fast-lock-mode nil)
+(add-minor-mode 'fast-lock-mode nil))
 ;;;###dont-autoload
 (unless (assq 'fast-lock-mode minor-mode-alist)
 (setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil)))))
 ;; Provide ourselves:

Mercurial > hg > xemacs-beta

comparison lisp/packages/fast-lock.el @ 24:4103f0995bd7 r19-15b95