diff options
| author | Simon Marshall | 1996-06-24 07:45:07 +0000 |
|---|---|---|
| committer | Simon Marshall | 1996-06-24 07:45:07 +0000 |
| commit | 369cc657dbb1855a45da9d56cfc395494acb8d24 (patch) | |
| tree | e979ad9cf298c0958adf963f88bf916848c16e99 | |
| parent | 1080879c16b3026cf099fa2223a49d080d28e6ba (diff) | |
| download | emacs-369cc657dbb1855a45da9d56cfc395494acb8d24.tar.gz emacs-369cc657dbb1855a45da9d56cfc395494acb8d24.zip | |
Protect before- and after-change-functions when updating text properties.
| -rw-r--r-- | lisp/fast-lock.el | 347 |
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: | |||
| 178 | Start a fresh Emacs via `" invocation-name " -no-init-file -no-site-file'. | 207 | Start a fresh Emacs via `" invocation-name " -no-init-file -no-site-file'. |
| 179 | In the `*scratch*' buffer, evaluate:")))) | 208 | In 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. |
| 192 | Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where | 220 | Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where |
| 193 | DIR is a directory name (relative or absolute) and REGEXP is a regexp. | 221 | DIR 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 | |||
| 206 | home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'.") | 234 | home 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. |
| 210 | Only buffers more than this can have associated Font Lock cache files saved. | 238 | Only buffers more than this can have associated Font Lock cache files saved. |
| 211 | If nil, means cache files are never created. | 239 | If nil, means cache files are never created. |
| 212 | If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), | 240 | If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), |
| 213 | where MAJOR-MODE is a symbol or t (meaning the default). For example: | 241 | where 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)) |
| 215 | means that the minimum size is 25K for buffers in `c++-mode' or `c-mode', one | 243 | means that the minimum size is 25K for buffers in C or C++ modes, one megabyte |
| 216 | megabyte for buffers in `rmail-mode', and size is irrelevant otherwise.") | 244 | for 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. |
| 220 | Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. | 248 | Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. |
| 221 | If concurrent editing sessions use the same associated cache file for a file's | 249 | If concurrent editing sessions use the same associated cache file for a file's |
| 222 | buffer, then you should add `save-buffer' to this list.") | 250 | buffer, 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. |
| 226 | If nil, means only buffer files known to be owned by you can have associated | 254 | If nil, means only buffer files known to be owned by you can have associated |
| 227 | Font Lock cache files saved. Ownership may be unknown for networked files.") | 255 | Font 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. | ||
| 240 | If nil, means information for all faces will be saved.") | 262 | If 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.") | |||
| 247 | With arg, turn Fast Lock mode on if and only if arg is positive and the buffer | 269 | With arg, turn Fast Lock mode on if and only if arg is positive and the buffer |
| 248 | is associated with a file. Enable it automatically in your `~/.emacs' by: | 270 | is 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 | ||
| 252 | If Fast Lock mode is enabled, and the current buffer does not contain any text | 274 | If Fast Lock mode is enabled, and the current buffer does not contain any text |
| 253 | properties, any associated Font Lock cache is used if its timestamp matches the | 275 | properties, 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: | |||
| 337 | See `fast-lock-mode'." | 357 | See `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. |
| 576 | Any existing `face' text properties are removed first. Leaves buffer modified. | 597 | Any existing `face' text properties are removed first. |
| 577 | See `fast-lock-get-face-properties' for the format of PROPERTIES." | 598 | See `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. | ||
| 597 | Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) | 620 | Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) |
| 598 | where VALUE is a `face' property value and STARTx and ENDx are positions. | 621 | where VALUE is a `face' property value and STARTx and ENDx are positions. |
| 599 | Only those `face' VALUEs in `fast-lock-save-faces' are returned." | 622 | Only 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. | ||
| 626 | Any existing `face' text properties are removed first. | 646 | Any existing `face' text properties are removed first. |
| 627 | See `fast-lock-get-face-properties' for the format of PROPERTIES." | 647 | See `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 | ||