aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSimon Marshall1996-06-24 07:45:07 +0000
committerSimon Marshall1996-06-24 07:45:07 +0000
commit369cc657dbb1855a45da9d56cfc395494acb8d24 (patch)
treee979ad9cf298c0958adf963f88bf916848c16e99
parent1080879c16b3026cf099fa2223a49d080d28e6ba (diff)
downloademacs-369cc657dbb1855a45da9d56cfc395494acb8d24.tar.gz
emacs-369cc657dbb1855a45da9d56cfc395494acb8d24.zip
Protect before- and after-change-functions when updating text properties.
-rw-r--r--lisp/fast-lock.el347
1 files changed, 183 insertions, 164 deletions
diff --git a/lisp/fast-lock.el b/lisp/fast-lock.el
index f7132904cbd..7ba421c59d2 100644
--- a/lisp/fast-lock.el
+++ b/lisp/fast-lock.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Simon Marshall <simon@gnu.ai.mit.edu> 5;; Author: Simon Marshall <simon@gnu.ai.mit.edu>
6;; Keywords: faces files 6;; Keywords: faces files
7;; Version: 3.09 7;; Version: 3.10
8 8
9;;; This file is part of GNU Emacs. 9;;; This file is part of GNU Emacs.
10 10
@@ -37,7 +37,7 @@
37;; 37;;
38;; Put in your ~/.emacs: 38;; Put in your ~/.emacs:
39;; 39;;
40;; (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) 40;; (setq font-lock-support-mode 'fast-lock-mode)
41;; 41;;
42;; Start up a new Emacs and use font-lock as usual (except that you can use the 42;; Start up a new Emacs and use font-lock as usual (except that you can use the
43;; so-called "gaudier" fontification regexps on big files without frustration). 43;; so-called "gaudier" fontification regexps on big files without frustration).
@@ -152,21 +152,50 @@
152;; 3.07--3.08: 152;; 3.07--3.08:
153;; - Made `fast-lock-read-cache' set `fast-lock-cache-filename' 153;; - Made `fast-lock-read-cache' set `fast-lock-cache-filename'
154;; 3.08--3.09: 154;; 3.08--3.09:
155;; - Made `fast-lock-save-cache' cope if `fast-lock-minimum-size' is a list 155;; - Made `fast-lock-save-cache' cope if `fast-lock-minimum-size' is an a list
156;; - Made `fast-lock-mode' respect the value of `font-lock-inhibit-thing-lock' 156;; - Made `fast-lock-mode' respect the value of `font-lock-inhibit-thing-lock'
157;; - Added `fast-lock-after-unfontify-buffer' 157;; - Added `fast-lock-after-unfontify-buffer'
158;; 3.09--3.10:
159;; - Rewrite for Common Lisp macros
160;; - Made fast-lock.el barf on a crap 8+3 pseudo-OS (Eli Zaretskii help)
161;; - XEmacs: Made `add-minor-mode' succeed `autoload' cookie
162;; - XEmacs: Made `fast-lock-save-faces' default to `font-lock-face-list'
163;; - Made `fast-lock-save-cache' use `font-lock-value-in-major-mode'
164;; - Wrap with `save-buffer-state' (Ray Van Tassle report)
165;; - Made `fast-lock-mode' wrap `font-lock-support-mode'
158 166
159(require 'font-lock) 167(require 'font-lock)
160 168
169;; Make sure fast-lock.el is supported.
170(if (and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
171 (error "`fast-lock' was written for long file name systems"))
172
161(eval-when-compile 173(eval-when-compile
162 ;; Shut Emacs' byte-compiler up (cf. stop me getting mail from users). 174 ;;
163 (setq byte-compile-warnings '(free-vars callargs redefine))) 175 ;; We don't do this at the top-level as we only use non-autoloaded macros.
176 (require 'cl)
177 ;;
178 ;; I prefer lazy code---and lazy mode.
179 (setq byte-compile-dynamic t byte-compile-dynamic-docstrings t)
180 ;;
181 ;; We use this to preserve or protect things when modifying text properties.
182 (defmacro save-buffer-state (varlist &rest body)
183 "Bind variables according to VARLIST and eval BODY restoring buffer state."
184 (` (let* ((,@ (append varlist
185 '((modified (buffer-modified-p))
186 (inhibit-read-only t) (buffer-undo-list t)
187 before-change-functions after-change-functions
188 deactivate-mark buffer-file-name buffer-file-truename))))
189 (,@ body)
190 (when (and (not modified) (buffer-modified-p))
191 (set-buffer-modified-p nil)))))
192 (put 'save-buffer-state 'lisp-indent-function 1))
164 193
165(defun fast-lock-submit-bug-report () 194(defun fast-lock-submit-bug-report ()
166 "Submit via mail a bug report on fast-lock.el." 195 "Submit via mail a bug report on fast-lock.el."
167 (interactive) 196 (interactive)
168 (let ((reporter-prompt-for-summary-p t)) 197 (let ((reporter-prompt-for-summary-p t))
169 (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.09" 198 (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.10"
170 '(fast-lock-cache-directories fast-lock-minimum-size 199 '(fast-lock-cache-directories fast-lock-minimum-size
171 fast-lock-save-others fast-lock-save-events fast-lock-save-faces) 200 fast-lock-save-others fast-lock-save-events fast-lock-save-faces)
172 nil nil 201 nil nil
@@ -178,8 +207,7 @@ know how to make a clear and unambiguous report. To reproduce the bug:
178Start a fresh Emacs via `" invocation-name " -no-init-file -no-site-file'. 207Start a fresh Emacs via `" invocation-name " -no-init-file -no-site-file'.
179In the `*scratch*' buffer, evaluate:")))) 208In the `*scratch*' buffer, evaluate:"))))
180 209
181;;;###autoload 210(defvar fast-lock-mode nil)
182(defvar fast-lock-mode nil) ; for modeline
183(defvar fast-lock-cache-timestamp nil) ; for saving/reading 211(defvar fast-lock-cache-timestamp nil) ; for saving/reading
184(defvar fast-lock-cache-filename nil) ; for deleting 212(defvar fast-lock-cache-filename nil) ; for deleting
185 213
@@ -188,7 +216,7 @@ In the `*scratch*' buffer, evaluate:"))))
188(defvar fast-lock-cache-directories '("." "~/.emacs-flc") 216(defvar fast-lock-cache-directories '("." "~/.emacs-flc")
189; - `internal', keep each file's Font Lock cache file in the same file. 217; - `internal', keep each file's Font Lock cache file in the same file.
190; - `external', keep each file's Font Lock cache file in the same directory. 218; - `external', keep each file's Font Lock cache file in the same directory.
191 "Directories in which Font Lock cache files are saved and read. 219 "*Directories in which Font Lock cache files are saved and read.
192Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where 220Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where
193DIR is a directory name (relative or absolute) and REGEXP is a regexp. 221DIR is a directory name (relative or absolute) and REGEXP is a regexp.
194 222
@@ -206,37 +234,31 @@ would cause a file's current directory to be used if the file is under your
206home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'.") 234home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'.")
207 235
208(defvar fast-lock-minimum-size (* 25 1024) 236(defvar fast-lock-minimum-size (* 25 1024)
209 "If non-nil, the minimum size for buffers. 237 "*Minimum size of a buffer for cached fontification.
210Only buffers more than this can have associated Font Lock cache files saved. 238Only buffers more than this can have associated Font Lock cache files saved.
211If nil, means cache files are never created. 239If nil, means cache files are never created.
212If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), 240If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
213where MAJOR-MODE is a symbol or t (meaning the default). For example: 241where MAJOR-MODE is a symbol or t (meaning the default). For example:
214 ((c++-mode . 25600) (c-mode . 25600) (rmail-mode . 1048576)) 242 ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576))
215means that the minimum size is 25K for buffers in `c++-mode' or `c-mode', one 243means that the minimum size is 25K for buffers in C or C++ modes, one megabyte
216megabyte for buffers in `rmail-mode', and size is irrelevant otherwise.") 244for buffers in Rmail mode, and size is irrelevant otherwise.")
217 245
218(defvar fast-lock-save-events '(kill-buffer kill-emacs) 246(defvar fast-lock-save-events '(kill-buffer kill-emacs)
219 "A list of events under which caches will be saved. 247 "*Events under which caches will be saved.
220Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. 248Valid events are `save-buffer', `kill-buffer' and `kill-emacs'.
221If concurrent editing sessions use the same associated cache file for a file's 249If concurrent editing sessions use the same associated cache file for a file's
222buffer, then you should add `save-buffer' to this list.") 250buffer, then you should add `save-buffer' to this list.")
223 251
224(defvar fast-lock-save-others t 252(defvar fast-lock-save-others t
225 "If non-nil, save Font Lock cache files irrespective of file owner. 253 "*If non-nil, save Font Lock cache files irrespective of file owner.
226If nil, means only buffer files known to be owned by you can have associated 254If nil, means only buffer files known to be owned by you can have associated
227Font Lock cache files saved. Ownership may be unknown for networked files.") 255Font Lock cache files saved. Ownership may be unknown for networked files.")
228 256
229(defvar fast-lock-save-faces 257(defvar fast-lock-save-faces
230 ;; Since XEmacs uses extents for everything, we have to pick the right ones. 258 (when (save-match-data (string-match "XEmacs" (emacs-version)))
231 ;; In XEmacs 19.13 we can't identify which text properties are Font Lock's. 259 ;; XEmacs uses extents for everything, so we have to pick the right ones.
232 (if (save-match-data (string-match "XEmacs" (emacs-version))) 260 font-lock-face-list)
233 '(font-lock-string-face font-lock-doc-string-face font-lock-type-face 261 "Faces that will be saved in a Font Lock cache file.
234 font-lock-function-name-face font-lock-comment-face
235 font-lock-keyword-face font-lock-reference-face
236 font-lock-preprocessor-face)
237 ;; For Emacs 19.30 I don't think this is generally necessary.
238 nil)
239 "A list of faces that will be saved in a Font Lock cache file.
240If nil, means information for all faces will be saved.") 262If nil, means information for all faces will be saved.")
241 263
242;; User Functions: 264;; User Functions:
@@ -247,7 +269,7 @@ If nil, means information for all faces will be saved.")
247With arg, turn Fast Lock mode on if and only if arg is positive and the buffer 269With arg, turn Fast Lock mode on if and only if arg is positive and the buffer
248is associated with a file. Enable it automatically in your `~/.emacs' by: 270is associated with a file. Enable it automatically in your `~/.emacs' by:
249 271
250 (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) 272 (setq font-lock-support-mode 'fast-lock-mode)
251 273
252If Fast Lock mode is enabled, and the current buffer does not contain any text 274If Fast Lock mode is enabled, and the current buffer does not contain any text
253properties, any associated Font Lock cache is used if its timestamp matches the 275properties, any associated Font Lock cache is used if its timestamp matches the
@@ -276,15 +298,14 @@ Use \\[fast-lock-submit-bug-report] to send bug reports or feedback."
276 (not (memq 'fast-lock-mode font-lock-inhibit-thing-lock)) 298 (not (memq 'fast-lock-mode font-lock-inhibit-thing-lock))
277 (if arg (> (prefix-numeric-value arg) 0) (not fast-lock-mode)))) 299 (if arg (> (prefix-numeric-value arg) 0) (not fast-lock-mode))))
278 (if (and fast-lock-mode (not font-lock-mode)) 300 (if (and fast-lock-mode (not font-lock-mode))
279 ;; Turned on `fast-lock-mode' rather than using `font-lock-mode-hook'. 301 ;; Turned on `fast-lock-mode' rather than `font-lock-mode'.
280 (progn 302 (let ((font-lock-support-mode 'fast-lock-mode))
281 (add-hook 'font-lock-mode-hook 'turn-on-fast-lock)
282 (font-lock-mode t)) 303 (font-lock-mode t))
283 ;; Let's get down to business. 304 ;; Let's get down to business.
284 (set (make-local-variable 'fast-lock-cache-timestamp) nil) 305 (set (make-local-variable 'fast-lock-cache-timestamp) nil)
285 (set (make-local-variable 'fast-lock-cache-filename) nil) 306 (set (make-local-variable 'fast-lock-cache-filename) nil)
286 (if (and fast-lock-mode (not font-lock-fontified)) 307 (when (and fast-lock-mode (not font-lock-fontified))
287 (fast-lock-read-cache)))) 308 (fast-lock-read-cache))))
288 309
289(defun fast-lock-read-cache () 310(defun fast-lock-read-cache ()
290 "Read the Font Lock cache for the current buffer. 311 "Read the Font Lock cache for the current buffer.
@@ -305,20 +326,19 @@ See `fast-lock-mode'."
305 ;; Keep trying directories until fontification is turned off. 326 ;; Keep trying directories until fontification is turned off.
306 (while (and directories (not font-lock-fontified)) 327 (while (and directories (not font-lock-fontified))
307 (let ((directory (fast-lock-cache-directory (car directories) nil))) 328 (let ((directory (fast-lock-cache-directory (car directories) nil)))
308 (if (not directory) 329 (condition-case nil
309 nil 330 (when directory
310 (setq fast-lock-cache-filename (fast-lock-cache-name directory)) 331 (setq fast-lock-cache-filename (fast-lock-cache-name directory))
311 (condition-case nil 332 (when (file-readable-p fast-lock-cache-filename)
312 (if (file-readable-p fast-lock-cache-filename) 333 (load fast-lock-cache-filename t t t)))
313 (load fast-lock-cache-filename t t t)) 334 (error nil) (quit nil))
314 (error nil) (quit nil)))
315 (setq directories (cdr directories)))) 335 (setq directories (cdr directories))))
316 ;; Unset `fast-lock-cache-filename', and restore `font-lock-fontified', if 336 ;; Unset `fast-lock-cache-filename', and restore `font-lock-fontified', if
317 ;; we don't use a cache. (Note that `fast-lock-cache-data' sets the value 337 ;; we don't use a cache. (Note that `fast-lock-cache-data' sets the value
318 ;; of `fast-lock-cache-timestamp'.) 338 ;; of `fast-lock-cache-timestamp'.)
319 (set-buffer-modified-p modified) 339 (set-buffer-modified-p modified)
320 (if (not font-lock-fontified) 340 (unless font-lock-fontified
321 (setq fast-lock-cache-filename nil font-lock-fontified fontified)))) 341 (setq fast-lock-cache-filename nil font-lock-fontified fontified))))
322 342
323(defun fast-lock-save-cache (&optional buffer) 343(defun fast-lock-save-cache (&optional buffer)
324 "Save the Font Lock cache of BUFFER or the current buffer. 344 "Save the Font Lock cache of BUFFER or the current buffer.
@@ -337,42 +357,41 @@ The following criteria must be met for a Font Lock cache file to be saved:
337See `fast-lock-mode'." 357See `fast-lock-mode'."
338 (interactive) 358 (interactive)
339 (save-excursion 359 (save-excursion
340 (and buffer (set-buffer buffer)) 360 (when buffer
341 (let ((min-size (if (not (consp fast-lock-minimum-size)) 361 (set-buffer buffer))
342 fast-lock-minimum-size 362 (let ((min-size (font-lock-value-in-major-mode fast-lock-minimum-size))
343 (cdr (or (assq major-mode fast-lock-minimum-size)
344 (assq t fast-lock-minimum-size)))))
345 (file-timestamp (visited-file-modtime)) (saved nil)) 363 (file-timestamp (visited-file-modtime)) (saved nil))
346 (if (and fast-lock-mode 364 (when (and fast-lock-mode
347 ;; 365 ;;
348 ;; "Only save if the buffer matches the file, the file has 366 ;; "Only save if the buffer matches the file, the file has
349 ;; changed, and it was changed by the current emacs session." 367 ;; changed, and it was changed by the current emacs session."
350 ;; 368 ;;
351 ;; Only save if the buffer is not modified, 369 ;; Only save if the buffer is not modified,
352 ;; (i.e., so we don't save for something not on disk) 370 ;; (i.e., so we don't save for something not on disk)
353 (not (buffer-modified-p)) 371 (not (buffer-modified-p))
354 ;; and the file's timestamp is the same as the buffer's, 372 ;; and the file's timestamp is the same as the buffer's,
355 ;; (i.e., someone else hasn't written the file in the meantime) 373 ;; (i.e., someone else hasn't written the file in the meantime)
356 (verify-visited-file-modtime (current-buffer)) 374 (verify-visited-file-modtime (current-buffer))
357 ;; and the file's timestamp is different from the cache's. 375 ;; and the file's timestamp is different from the cache's.
358 ;; (i.e., a save has occurred since the cache was read) 376 ;; (i.e., a save has occurred since the cache was read)
359 (not (equal fast-lock-cache-timestamp file-timestamp)) 377 (not (equal fast-lock-cache-timestamp file-timestamp))
360 ;; 378 ;;
361 ;; Only save if user's restrictions are satisfied. 379 ;; Only save if user's restrictions are satisfied.
362 (and min-size (>= (buffer-size) min-size)) 380 (and min-size (>= (buffer-size) min-size))
363 (or fast-lock-save-others 381 (or fast-lock-save-others
364 (eq (user-uid) (nth 2 (file-attributes buffer-file-name)))) 382 (eq (user-uid) (nth 2 (file-attributes buffer-file-name))))
365 ;; 383 ;;
366 ;; Only save if there are `face' properties to save. 384 ;; Only save if there are `face' properties to save.
367 (text-property-not-all (point-min) (point-max) 'face nil)) 385 (text-property-not-all (point-min) (point-max) 'face nil))
368 ;; Try each directory until we manage to save or the user quits. 386 ;;
369 (let ((directories fast-lock-cache-directories)) 387 ;; Try each directory until we manage to save or the user quits.
370 (while (and directories (memq saved '(nil error))) 388 (let ((directories fast-lock-cache-directories))
371 (let* ((dir (fast-lock-cache-directory (car directories) t)) 389 (while (and directories (memq saved '(nil error)))
372 (file (and dir (fast-lock-cache-name dir)))) 390 (let* ((dir (fast-lock-cache-directory (car directories) t))
373 (if (and file (file-writable-p file)) 391 (file (and dir (fast-lock-cache-name dir))))
374 (setq saved (fast-lock-save-cache-1 file file-timestamp))) 392 (when (and file (file-writable-p file))
375 (setq directories (cdr directories))))))))) 393 (setq saved (fast-lock-save-cache-1 file file-timestamp)))
394 (setq directories (cdr directories)))))))))
376 395
377;;;###autoload 396;;;###autoload
378(defun turn-on-fast-lock () 397(defun turn-on-fast-lock ()
@@ -383,10 +402,10 @@ See `fast-lock-mode'."
383 402
384(defun fast-lock-after-fontify-buffer () 403(defun fast-lock-after-fontify-buffer ()
385 ;; Delete the Font Lock cache file used to restore fontification, if any. 404 ;; Delete the Font Lock cache file used to restore fontification, if any.
386 (if fast-lock-cache-filename 405 (when fast-lock-cache-filename
387 (if (file-writable-p fast-lock-cache-filename) 406 (if (file-writable-p fast-lock-cache-filename)
388 (delete-file fast-lock-cache-filename) 407 (delete-file fast-lock-cache-filename)
389 (message "File %s font lock cache cannot be deleted" (buffer-name)))) 408 (message "File %s font lock cache cannot be deleted" (buffer-name))))
390 ;; Flag so that a cache will be saved later even if the file is never saved. 409 ;; Flag so that a cache will be saved later even if the file is never saved.
391 (setq fast-lock-cache-timestamp nil)) 410 (setq fast-lock-cache-timestamp nil))
392 411
@@ -395,20 +414,20 @@ See `fast-lock-mode'."
395 414
396;; Miscellaneous Functions: 415;; Miscellaneous Functions:
397 416
398(defun fast-lock-after-save-hook () 417(defun fast-lock-save-cache-after-save-file ()
399 ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'. 418 ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'.
400 (if (memq 'save-buffer fast-lock-save-events) 419 (when (memq 'save-buffer fast-lock-save-events)
401 (fast-lock-save-cache))) 420 (fast-lock-save-cache)))
402 421
403(defun fast-lock-kill-buffer-hook () 422(defun fast-lock-save-cache-before-kill-buffer ()
404 ;; Do `fast-lock-save-cache' if `kill-buffer' is on `fast-lock-save-events'. 423 ;; Do `fast-lock-save-cache' if `kill-buffer' is on `fast-lock-save-events'.
405 (if (memq 'kill-buffer fast-lock-save-events) 424 (when (memq 'kill-buffer fast-lock-save-events)
406 (fast-lock-save-cache))) 425 (fast-lock-save-cache)))
407 426
408(defun fast-lock-kill-emacs-hook () 427(defun fast-lock-save-caches-before-kill-emacs ()
409 ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'. 428 ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'.
410 (if (memq 'kill-emacs fast-lock-save-events) 429 (when (memq 'kill-emacs fast-lock-save-events)
411 (mapcar 'fast-lock-save-cache (buffer-list)))) 430 (mapcar 'fast-lock-save-cache (buffer-list))))
412 431
413(defun fast-lock-cache-directory (directory create) 432(defun fast-lock-cache-directory (directory create)
414 "Return usable directory based on DIRECTORY. 433 "Return usable directory based on DIRECTORY.
@@ -426,8 +445,8 @@ See `fast-lock-cache-directories'."
426 ;; A directory iff the file name matches the regexp. 445 ;; A directory iff the file name matches the regexp.
427 (let ((bufile (expand-file-name buffer-file-truename)) 446 (let ((bufile (expand-file-name buffer-file-truename))
428 (case-fold-search nil)) 447 (case-fold-search nil))
429 (if (save-match-data (string-match (car directory) bufile)) 448 (when (save-match-data (string-match (car directory) bufile))
430 (cdr directory))))))) 449 (cdr directory)))))))
431 (cond ((not dir) 450 (cond ((not dir)
432 nil) 451 nil)
433 ((file-accessible-directory-p dir) 452 ((file-accessible-directory-p dir)
@@ -494,7 +513,7 @@ See `fast-lock-cache-directory'."
494 fast-lock-cache-filename file)) 513 fast-lock-cache-filename file))
495 (error (setq saved 'error)) (quit (setq saved 'quit))) 514 (error (setq saved 'error)) (quit (setq saved 'quit)))
496 (kill-buffer tpbuf) 515 (kill-buffer tpbuf)
497 (message "Saving %s font lock cache... %s." buname 516 (message "Saving %s font lock cache...%s" buname
498 (cond ((eq saved 'error) "failed") 517 (cond ((eq saved 'error) "failed")
499 ((eq saved 'quit) "aborted") 518 ((eq saved 'quit) "aborted")
500 (t "done"))) 519 (t "done")))
@@ -504,7 +523,8 @@ See `fast-lock-cache-directory'."
504(defun fast-lock-cache-data (version timestamp keywords properties 523(defun fast-lock-cache-data (version timestamp keywords properties
505 &rest ignored) 524 &rest ignored)
506 ;; Change from (HIGH LOW) for back compatibility. Remove for version 3! 525 ;; Change from (HIGH LOW) for back compatibility. Remove for version 3!
507 (if (consp (cdr-safe timestamp)) (setcdr timestamp (nth 1 timestamp))) 526 (when (consp (cdr-safe timestamp))
527 (setcdr timestamp (nth 1 timestamp)))
508 ;; Compile KEYWORDS and `font-lock-keywords' in case one is and one isn't. 528 ;; Compile KEYWORDS and `font-lock-keywords' in case one is and one isn't.
509 (let ((current font-lock-keywords)) 529 (let ((current font-lock-keywords))
510 (setq keywords (font-lock-compile-keywords keywords) 530 (setq keywords (font-lock-compile-keywords keywords)
@@ -523,7 +543,7 @@ See `fast-lock-cache-directory'."
523 (condition-case nil 543 (condition-case nil
524 (fast-lock-set-face-properties properties) 544 (fast-lock-set-face-properties properties)
525 (error (setq loaded 'error)) (quit (setq loaded 'quit))) 545 (error (setq loaded 'error)) (quit (setq loaded 'quit)))
526 (message "Loading %s font lock cache... %s." buname 546 (message "Loading %s font lock cache...%s" buname
527 (cond ((eq loaded 'error) "failed") 547 (cond ((eq loaded 'error) "failed")
528 ((eq loaded 'quit) "aborted") 548 ((eq loaded 'quit) "aborted")
529 (t "done")))) 549 (t "done"))))
@@ -568,98 +588,97 @@ Only those `face' VALUEs in `fast-lock-save-faces' are returned."
568 (setq end (or (text-property-not-all start limit 'face face) limit) 588 (setq end (or (text-property-not-all start limit 'face face) limit)
569 regions (cons start (cons end regions)))) 589 regions (cons start (cons end regions))))
570 ;; Add `face' face's regions, if any, to properties. 590 ;; Add `face' face's regions, if any, to properties.
571 (if regions (setq properties (cons (cons face regions) properties)))) 591 (when regions
592 (push (cons face regions) properties)))
572 properties))) 593 properties)))
573 594
574(defun fast-lock-set-face-properties (properties) 595(defun fast-lock-set-face-properties (properties)
575 "Set all `face' text properties to PROPERTIES in the current buffer. 596 "Set all `face' text properties to PROPERTIES in the current buffer.
576Any existing `face' text properties are removed first. Leaves buffer modified. 597Any existing `face' text properties are removed first.
577See `fast-lock-get-face-properties' for the format of PROPERTIES." 598See `fast-lock-get-face-properties' for the format of PROPERTIES."
578 (save-restriction 599 (save-buffer-state (plist regions)
579 (widen) 600 (save-restriction
580 (font-lock-unfontify-region (point-min) (point-max)) 601 (widen)
581 (while properties 602 (font-lock-unfontify-region (point-min) (point-max))
582 (let ((plist (list 'face (car (car properties)))) 603 (while properties
583 (regions (cdr (car properties)))) 604 (setq plist (list 'face (car (car properties)))
605 regions (cdr (car properties))
606 properties (cdr properties))
584 ;; Set the `face' property for each start/end region. 607 ;; Set the `face' property for each start/end region.
585 (while regions 608 (while regions
586 (set-text-properties (nth 0 regions) (nth 1 regions) plist) 609 (set-text-properties (nth 0 regions) (nth 1 regions) plist)
587 (setq regions (nthcdr 2 regions))) 610 (setq regions (nthcdr 2 regions)))))))
588 (setq properties (cdr properties))))))
589 611
590;; Functions for XEmacs: 612;; Functions for XEmacs:
591 613
592(if (save-match-data (string-match "XEmacs" (emacs-version))) 614(when (save-match-data (string-match "XEmacs" (emacs-version)))
593 ;; It would be better to use XEmacs 19.12's `map-extents' over extents with 615 ;;
594 ;; `font-lock' property, but `face' properties are on different extents. 616 ;; It would be better to use XEmacs' `map-extents' over extents with a
595 (defun fast-lock-get-face-properties () 617 ;; `font-lock' property, but `face' properties are on different extents.
596 "Return a list of all `face' text properties in the current buffer. 618 (defun fast-lock-get-face-properties ()
619 "Return a list of all `face' text properties in the current buffer.
597Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) 620Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
598where VALUE is a `face' property value and STARTx and ENDx are positions. 621where VALUE is a `face' property value and STARTx and ENDx are positions.
599Only those `face' VALUEs in `fast-lock-save-faces' are returned." 622Only those `face' VALUEs in `fast-lock-save-faces' are returned."
600 (save-restriction 623 (save-restriction
601 (widen) 624 (widen)
602 (let ((properties ()) cell) 625 (let ((properties ()) cell)
603 (map-extents 626 (map-extents
604 (function 627 (function (lambda (extent ignore)
605 (lambda (extent ignore) 628 (let ((value (extent-face extent)))
606 (let ((value (extent-face extent))) 629 ;; We're only interested if it's one of `fast-lock-save-faces'.
607 ;; We're only interested if it's one of `fast-lock-save-faces'. 630 (when (and value (or (null fast-lock-save-faces)
608 (if (and value (or (null fast-lock-save-faces)
609 (memq value fast-lock-save-faces))) 631 (memq value fast-lock-save-faces)))
610 (let ((start (extent-start-position extent)) 632 (let ((start (extent-start-position extent))
611 (end (extent-end-position extent))) 633 (end (extent-end-position extent)))
612 ;; Make or add to existing list of regions with the same 634 ;; Make or add to existing list of regions with the same
613 ;; `face' property value. 635 ;; `face' property value.
614 (if (setq cell (assq value properties)) 636 (if (setq cell (assq value properties))
615 (setcdr cell (cons start (cons end (cdr cell)))) 637 (setcdr cell (cons start (cons end (cdr cell))))
616 (setq properties (cons (list value start end) 638 (push (list value start end) properties))))
617 properties))))) 639 ;; Return nil to keep `map-extents' going.
618 ;; Return nil to keep `map-extents' going. 640 nil))))
619 nil)))) 641 properties)))
620 properties)))) 642 ;;
621 643 ;; Make extents just like XEmacs' font-lock.el does.
622(if (save-match-data (string-match "XEmacs" (emacs-version))) 644 (defun fast-lock-set-face-properties (properties)
623 ;; Make extents just like XEmacs's font-lock.el does. 645 "Set all `face' text properties to PROPERTIES in the current buffer.
624 (defun fast-lock-set-face-properties (properties)
625 "Set all `face' text properties to PROPERTIES in the current buffer.
626Any existing `face' text properties are removed first. 646Any existing `face' text properties are removed first.
627See `fast-lock-get-face-properties' for the format of PROPERTIES." 647See `fast-lock-get-face-properties' for the format of PROPERTIES."
628 (save-restriction 648 (save-restriction
629 (widen) 649 (widen)
630 (font-lock-unfontify-region (point-min) (point-max)) 650 (font-lock-unfontify-region (point-min) (point-max))
631 (while properties 651 (while properties
632 (let ((face (car (car properties))) 652 (let ((face (car (car properties)))
633 (regions (cdr (car properties)))) 653 (regions (cdr (car properties))))
634 ;; Set the `face' property, etc., for each start/end region. 654 ;; Set the `face' property, etc., for each start/end region.
635 (while regions 655 (while regions
636 (font-lock-set-face (nth 0 regions) (nth 1 regions) face) 656 (font-lock-set-face (nth 0 regions) (nth 1 regions) face)
637 (setq regions (nthcdr 2 regions))) 657 (setq regions (nthcdr 2 regions)))
638 (setq properties (cdr properties))))))) 658 (setq properties (cdr properties))))))
639 659 ;;
640(if (save-match-data (string-match "XEmacs" (emacs-version))) 660 ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook.
641 ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook. 661 (add-hook 'font-lock-after-fontify-buffer-hook
642 (add-hook 'font-lock-after-fontify-buffer-hook 662 'fast-lock-after-fontify-buffer))
643 'fast-lock-after-fontify-buffer)) 663
644 664(unless (boundp 'font-lock-inhibit-thing-lock)
645(or (boundp 'font-lock-inhibit-thing-lock) 665 (defvar font-lock-inhibit-thing-lock nil
646 (defvar font-lock-inhibit-thing-lock nil 666 "List of Font Lock mode related modes that should not be turned on."))
647 "List of Font Lock mode related modes that should not be turned on.")) 667
648 668(unless (fboundp 'font-lock-compile-keywords)
649(or (fboundp 'font-lock-compile-keywords) 669 (defalias 'font-lock-compile-keywords 'identity))
650 (defalias 'font-lock-compile-keywords 'identity))
651 670
652;; Install ourselves: 671;; Install ourselves:
653 672
654;; We don't install ourselves on `font-lock-mode-hook' as packages with similar 673(add-hook 'after-save-hook 'fast-lock-save-cache-after-save-file)
655;; functionality exist, and fast-lock.el should be dumpable without forcing 674(add-hook 'kill-buffer-hook 'fast-lock-save-cache-before-kill-buffer)
656;; people to use caches or making it difficult for people to use alternatives. 675(add-hook 'kill-emacs-hook 'fast-lock-save-caches-before-kill-emacs)
657(add-hook 'after-save-hook 'fast-lock-after-save-hook)
658(add-hook 'kill-buffer-hook 'fast-lock-kill-buffer-hook)
659(add-hook 'kill-emacs-hook 'fast-lock-kill-emacs-hook)
660 676
661(or (assq 'fast-lock-mode minor-mode-alist) 677;;;###autoload
662 (setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil))))) 678(if (fboundp 'add-minor-mode) (add-minor-mode 'fast-lock-mode nil))
679;;;###dont-autoload
680(unless (assq 'fast-lock-mode minor-mode-alist)
681 (setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil)))))
663 682
664;; Provide ourselves: 683;; Provide ourselves:
665 684