Mercurial > hg > xemacs-beta
diff 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 |
line wrap: on
line diff
--- a/lisp/packages/fast-lock.el Mon Aug 13 08:50:31 2007 +0200 +++ b/lisp/packages/fast-lock.el Mon Aug 13 08:51:03 2007 +0200 @@ -1,10 +1,10 @@ ;;; 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. @@ -25,10 +25,9 @@ ;;; 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. +;; 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!) @@ -53,7 +52,7 @@ ;; ;; 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: @@ -160,7 +159,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. @@ -192,39 +195,36 @@ ;; ;; 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) - (while list - (if (memq (car list) fast-lock-save-faces) - (setq list nil found t) - (setq list (cdr list)))) - found)))))) + (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 "simon@gnu.ai.mit.edu" "fast-lock 3.10.02" - '(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., +;(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 "simon@gnu.ai.mit.edu" "fast-lock 3.11.01" +; '(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:")))) -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:")))) - -;;;###autoload -(defvar fast-lock-mode nil) -(defvar fast-lock-cache-timestamp nil) ; for saving/reading -(defvar fast-lock-cache-filename nil) ; for deleting -;;;;;^L +(defvar fast-lock-mode nil) ; Whether we are turned on. +(defvar fast-lock-cache-timestamp nil) ; For saving/reading. +(defvar fast-lock-cache-filename nil) ; For deleting. + ;; User Variables: (defvar fast-lock-cache-directories '("." "~/.emacs-flc") @@ -278,7 +278,7 @@ (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 @@ -294,9 +294,9 @@ 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. +- 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'. @@ -327,11 +327,11 @@ "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'. +- 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) @@ -360,15 +360,15 @@ "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'. +- 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) @@ -413,7 +413,7 @@ (defun turn-on-fast-lock () "Unconditionally turn on Fast Lock mode." (fast-lock-mode t)) -;;;;;^L + ;;; API Functions: (defun fast-lock-after-fontify-buffer () @@ -427,7 +427,7 @@ (defalias 'fast-lock-after-unfontify-buffer 'ignore) -;;;;;^L + ;; Miscellaneous Functions: (defun fast-lock-save-cache-after-save-file () @@ -506,7 +506,7 @@ (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) @@ -571,10 +571,10 @@ (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. @@ -594,8 +594,8 @@ ; (setq start (next-single-property-change end 'face))) ; properties))) -;; This copes if adjacent characters have different `face' text properties, but -;; fails if they are lists. +;; 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 ...) @@ -623,18 +623,16 @@ (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) - end - (next-single-property-change end 'face)))) + (setq start (text-property-not-all end (point-max) 'face nil))) properties))) (defun fast-lock-set-face-properties (properties) @@ -653,7 +651,7 @@ (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))) @@ -718,7 +716,7 @@ (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) @@ -726,7 +724,9 @@ (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)))))