diff options
| author | Stefan Kangas | 2022-07-28 15:32:42 +0200 |
|---|---|---|
| committer | Stefan Kangas | 2022-07-28 15:32:42 +0200 |
| commit | 6b96c630f7ae76bc0bd200097f7d9bf9e856f2db (patch) | |
| tree | e4cac427c0600fadcbdc98c69bd70ebb629111c3 | |
| parent | 977aed9f7981fee0ba9ac8711a86da908fc5057e (diff) | |
| download | emacs-6b96c630f7ae76bc0bd200097f7d9bf9e856f2db.tar.gz emacs-6b96c630f7ae76bc0bd200097f7d9bf9e856f2db.zip | |
Delete fast-lock.el and lazy-lock.el
The 'font-lock-support-mode' is occasionally useful for debugging
purposes, so it remains as a defvar.
Ref: https://lists.gnu.org/r/emacs-devel/2020-08/msg00125.html
* lisp/obsolete/fast-lock.el:
* lisp/obsolete/lazy-lock.el: Delete libraries obsolete since
22.1. (Bug#56560)
* lisp/font-lock.el (font-lock-support-mode): Make into a defvar and
delete any mention of 'lazy-lock-mode' and 'fast-lock-mode'.
(font-lock-turn-on-thing-lock, font-lock-turn-off-thing-lock):
Drop support for obsolete modes lazy-lock and fast-lock.
(font-lock-after-fontify-buffer)
(font-lock-after-unfontify-buffer): Make into obsolete function
aliases for 'ignore'. Adjust callers.
(font-lock-keywords, font-lock-inhibit-thing-lock): Adjust
documentation to not mention lazy-lock and fast-lock.
* lisp/font-core.el (font-lock-defaults): Adjust documentation to
not mention 'font-lock-inhibit-thing-lock'.
* lisp/mail/rmail.el (rmail-variables): Don't inhibit obsolete
lazy-lock-mode and fast-lock-mode.
| -rw-r--r-- | etc/NEWS | 8 | ||||
| -rw-r--r-- | lisp/font-core.el | 2 | ||||
| -rw-r--r-- | lisp/font-lock.el | 107 | ||||
| -rw-r--r-- | lisp/mail/rmail.el | 3 | ||||
| -rw-r--r-- | lisp/obsolete/fast-lock.el | 730 | ||||
| -rw-r--r-- | lisp/obsolete/lazy-lock.el | 1025 |
6 files changed, 24 insertions, 1851 deletions
| @@ -343,6 +343,14 @@ Use 'skeleton' or 'tempo' instead. | |||
| 343 | ** The rlogin.el library and 'rsh' command are now obsolete. | 343 | ** The rlogin.el library and 'rsh' command are now obsolete. |
| 344 | Use something like 'M-x shell RET ssh <host> RET' instead. | 344 | Use something like 'M-x shell RET ssh <host> RET' instead. |
| 345 | 345 | ||
| 346 | --- | ||
| 347 | ** The fast-lock.el and lazy-lock.el library have been removed. | ||
| 348 | They have been obsolete since Emacs 22.1. | ||
| 349 | |||
| 350 | The variable 'font-lock-support-mode' is occasionally useful for | ||
| 351 | debugging purposes. It is now a regular variable (instead of a user | ||
| 352 | option) and can be set to nil to disable Just-in-time Lock mode. | ||
| 353 | |||
| 346 | 354 | ||
| 347 | * Changes in Emacs 29.1 | 355 | * Changes in Emacs 29.1 |
| 348 | 356 | ||
diff --git a/lisp/font-core.el b/lisp/font-core.el index f92d1e38306..f70c42bb03f 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el | |||
| @@ -65,7 +65,7 @@ Other variables include that for syntactic keyword fontification, | |||
| 65 | `font-lock-syntactic-keywords' and those for buffer-specialized fontification | 65 | `font-lock-syntactic-keywords' and those for buffer-specialized fontification |
| 66 | functions, `font-lock-fontify-buffer-function', | 66 | functions, `font-lock-fontify-buffer-function', |
| 67 | `font-lock-unfontify-buffer-function', `font-lock-fontify-region-function', | 67 | `font-lock-unfontify-buffer-function', `font-lock-fontify-region-function', |
| 68 | `font-lock-unfontify-region-function', and `font-lock-inhibit-thing-lock'.") | 68 | `font-lock-unfontify-region-function'.") |
| 69 | ;; Autoload if this file no longer dumped. | 69 | ;; Autoload if this file no longer dumped. |
| 70 | ;;;###autoload | 70 | ;;;###autoload |
| 71 | (put 'font-lock-defaults 'risky-local-variable t) | 71 | (put 'font-lock-defaults 'risky-local-variable t) |
diff --git a/lisp/font-lock.el b/lisp/font-lock.el index d815a9c9c46..4ae84220a71 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el | |||
| @@ -490,8 +490,7 @@ of the line, i.e., cause the MATCHER search to span lines. | |||
| 490 | These regular expressions can match text which spans lines, | 490 | These regular expressions can match text which spans lines, |
| 491 | although it is better to avoid it if possible since updating them | 491 | although it is better to avoid it if possible since updating them |
| 492 | while editing text is slower, and it is not guaranteed to be | 492 | while editing text is slower, and it is not guaranteed to be |
| 493 | always correct when using support modes like jit-lock or | 493 | always correct. |
| 494 | lazy-lock. | ||
| 495 | 494 | ||
| 496 | This variable is set by major modes via the variable | 495 | This variable is set by major modes via the variable |
| 497 | `font-lock-defaults'. Be careful when composing regexps for this | 496 | `font-lock-defaults'. Be careful when composing regexps for this |
| @@ -623,11 +622,8 @@ fontified.") | |||
| 623 | It should take two args, the beginning and end of the region. | 622 | It should take two args, the beginning and end of the region. |
| 624 | This is normally set via `font-lock-defaults'.") | 623 | This is normally set via `font-lock-defaults'.") |
| 625 | 624 | ||
| 626 | (defvar font-lock-inhibit-thing-lock nil | 625 | (defvar font-lock-inhibit-thing-lock nil) |
| 627 | "List of Font Lock mode related modes that should not be turned on. | 626 | (make-obsolete-variable 'font-lock-inhibit-thing-lock "it does nothing." "25.1") |
| 628 | Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and | ||
| 629 | `lazy-lock-mode'. This is normally set via `font-lock-defaults'.") | ||
| 630 | (make-obsolete-variable 'font-lock-inhibit-thing-lock nil "25.1") | ||
| 631 | 627 | ||
| 632 | (defvar-local font-lock-multiline nil | 628 | (defvar-local font-lock-multiline nil |
| 633 | "Whether font-lock should cater to multiline keywords. | 629 | "Whether font-lock should cater to multiline keywords. |
| @@ -642,7 +638,6 @@ Major/minor modes can set this variable if they know which option applies.") | |||
| 642 | 638 | ||
| 643 | (eval-when-compile | 639 | (eval-when-compile |
| 644 | ;; | 640 | ;; |
| 645 | ;; Borrowed from lazy-lock.el. | ||
| 646 | ;; We use this to preserve or protect things when modifying text properties. | 641 | ;; We use this to preserve or protect things when modifying text properties. |
| 647 | (defmacro save-buffer-state (&rest body) | 642 | (defmacro save-buffer-state (&rest body) |
| 648 | "Bind variables according to VARLIST and eval BODY restoring buffer state." | 643 | "Bind variables according to VARLIST and eval BODY restoring buffer state." |
| @@ -881,65 +876,17 @@ happens, so the major mode can be corrected." | |||
| 881 | 876 | ||
| 882 | ;;; Font Lock Support mode. | 877 | ;;; Font Lock Support mode. |
| 883 | 878 | ||
| 884 | ;; This is the code used to interface font-lock.el with any of its add-on | 879 | (defvar font-lock-support-mode #'jit-lock-mode |
| 885 | ;; packages, and provide the user interface. Packages that have their own | ||
| 886 | ;; local buffer fontification functions (see below) may have to call | ||
| 887 | ;; `font-lock-after-fontify-buffer' and/or `font-lock-after-unfontify-buffer' | ||
| 888 | ;; themselves. | ||
| 889 | |||
| 890 | (defcustom font-lock-support-mode 'jit-lock-mode | ||
| 891 | "Support mode for Font Lock mode. | 880 | "Support mode for Font Lock mode. |
| 892 | Support modes speed up Font Lock mode by being choosy about when fontification | ||
| 893 | occurs. The default support mode, Just-in-time Lock mode (symbol | ||
| 894 | `jit-lock-mode'), is recommended. | ||
| 895 | |||
| 896 | Other, older support modes are Fast Lock mode (symbol `fast-lock-mode') and | ||
| 897 | Lazy Lock mode (symbol `lazy-lock-mode'). See those modes for more info. | ||
| 898 | However, they are no longer recommended, as Just-in-time Lock mode is better. | ||
| 899 | |||
| 900 | If nil, means support for Font Lock mode is never performed. | 881 | If nil, means support for Font Lock mode is never performed. |
| 901 | If a symbol, use that support mode. | 882 | This can be useful for debugging. |
| 902 | If a list, each element should be of the form (MAJOR-MODE . SUPPORT-MODE), | ||
| 903 | where MAJOR-MODE is a symbol or t (meaning the default). For example: | ||
| 904 | ((c-mode . fast-lock-mode) (c++-mode . fast-lock-mode) (t . lazy-lock-mode)) | ||
| 905 | means that Fast Lock mode is used to support Font Lock mode for buffers in C or | ||
| 906 | C++ modes, and Lazy Lock mode is used to support Font Lock mode otherwise. | ||
| 907 | |||
| 908 | The value of this variable is used when Font Lock mode is turned on." | ||
| 909 | :type '(choice (const :tag "none" nil) | ||
| 910 | (const :tag "fast lock" fast-lock-mode) | ||
| 911 | (const :tag "lazy lock" lazy-lock-mode) | ||
| 912 | (const :tag "jit lock" jit-lock-mode) | ||
| 913 | (repeat :menu-tag "mode specific" :tag "mode specific" | ||
| 914 | :value ((t . jit-lock-mode)) | ||
| 915 | (cons :tag "Instance" | ||
| 916 | (radio :tag "Mode" | ||
| 917 | (const :tag "all" t) | ||
| 918 | (symbol :tag "name")) | ||
| 919 | (radio :tag "Support" | ||
| 920 | (const :tag "none" nil) | ||
| 921 | (const :tag "fast lock" fast-lock-mode) | ||
| 922 | (const :tag "lazy lock" lazy-lock-mode) | ||
| 923 | (const :tag "JIT lock" jit-lock-mode))) | ||
| 924 | )) | ||
| 925 | :version "21.1" | ||
| 926 | :group 'font-lock) | ||
| 927 | 883 | ||
| 928 | (defvar fast-lock-mode) | 884 | The value of this variable is used when Font Lock mode is turned on.") |
| 929 | (defvar lazy-lock-mode) | ||
| 930 | (defvar jit-lock-mode) | ||
| 931 | 885 | ||
| 932 | (declare-function fast-lock-after-fontify-buffer "fast-lock") | 886 | (defvar jit-lock-mode) |
| 933 | (declare-function fast-lock-after-unfontify-buffer "fast-lock") | ||
| 934 | (declare-function fast-lock-mode "fast-lock") | ||
| 935 | (declare-function lazy-lock-after-fontify-buffer "lazy-lock") | ||
| 936 | (declare-function lazy-lock-after-unfontify-buffer "lazy-lock") | ||
| 937 | (declare-function lazy-lock-mode "lazy-lock") | ||
| 938 | 887 | ||
| 939 | (defun font-lock-turn-on-thing-lock () | 888 | (defun font-lock-turn-on-thing-lock () |
| 940 | (pcase (font-lock-value-in-major-mode font-lock-support-mode) | 889 | (pcase (font-lock-value-in-major-mode font-lock-support-mode) |
| 941 | ('fast-lock-mode (fast-lock-mode t)) | ||
| 942 | ('lazy-lock-mode (lazy-lock-mode t)) | ||
| 943 | ('jit-lock-mode | 890 | ('jit-lock-mode |
| 944 | ;; Prepare for jit-lock | 891 | ;; Prepare for jit-lock |
| 945 | (remove-hook 'after-change-functions | 892 | (remove-hook 'after-change-functions |
| @@ -962,39 +909,11 @@ The value of this variable is used when Font Lock mode is turned on." | |||
| 962 | nil t)))) | 909 | nil t)))) |
| 963 | 910 | ||
| 964 | (defun font-lock-turn-off-thing-lock () | 911 | (defun font-lock-turn-off-thing-lock () |
| 965 | (cond ((bound-and-true-p fast-lock-mode) | 912 | (cond ((bound-and-true-p jit-lock-mode) |
| 966 | (fast-lock-mode -1)) | ||
| 967 | ((bound-and-true-p jit-lock-mode) | ||
| 968 | (jit-lock-unregister 'font-lock-fontify-region) | 913 | (jit-lock-unregister 'font-lock-fontify-region) |
| 969 | ;; Reset local vars to the non-jit-lock case. | 914 | ;; Reset local vars to the non-jit-lock case. |
| 970 | (kill-local-variable 'font-lock-fontify-buffer-function)) | 915 | (kill-local-variable 'font-lock-fontify-buffer-function)))) |
| 971 | ((bound-and-true-p lazy-lock-mode) | 916 | |
| 972 | (lazy-lock-mode -1)))) | ||
| 973 | |||
| 974 | (defun font-lock-after-fontify-buffer () | ||
| 975 | (cond ((bound-and-true-p fast-lock-mode) | ||
| 976 | (fast-lock-after-fontify-buffer)) | ||
| 977 | ;; Useless now that jit-lock intercepts font-lock-fontify-buffer. -sm | ||
| 978 | ;; (jit-lock-mode | ||
| 979 | ;; (jit-lock-after-fontify-buffer)) | ||
| 980 | ((bound-and-true-p lazy-lock-mode) | ||
| 981 | (lazy-lock-after-fontify-buffer)))) | ||
| 982 | |||
| 983 | (defun font-lock-after-unfontify-buffer () | ||
| 984 | (cond ((bound-and-true-p fast-lock-mode) | ||
| 985 | (fast-lock-after-unfontify-buffer)) | ||
| 986 | ;; Useless as well. It's only called when: | ||
| 987 | ;; - turning off font-lock: it does not matter if we leave spurious | ||
| 988 | ;; `fontified' text props around since jit-lock-mode is also off. | ||
| 989 | ;; - font-lock-default-fontify-buffer fails: this is not run | ||
| 990 | ;; any more anyway. -sm | ||
| 991 | ;; | ||
| 992 | ;; (jit-lock-mode | ||
| 993 | ;; (jit-lock-after-unfontify-buffer)) | ||
| 994 | ((bound-and-true-p lazy-lock-mode) | ||
| 995 | (lazy-lock-after-unfontify-buffer)))) | ||
| 996 | |||
| 997 | ;; End of Font Lock Support mode. | ||
| 998 | 917 | ||
| 999 | ;;; Fontification functions. | 918 | ;;; Fontification functions. |
| 1000 | 919 | ||
| @@ -1160,7 +1079,6 @@ Lock mode." | |||
| 1160 | (save-excursion | 1079 | (save-excursion |
| 1161 | (save-match-data | 1080 | (save-match-data |
| 1162 | (font-lock-fontify-region (point-min) (point-max) verbose) | 1081 | (font-lock-fontify-region (point-min) (point-max) verbose) |
| 1163 | (font-lock-after-fontify-buffer) | ||
| 1164 | (setq font-lock-fontified t))) | 1082 | (setq font-lock-fontified t))) |
| 1165 | ;; We don't restore the old fontification, so it's best to unfontify. | 1083 | ;; We don't restore the old fontification, so it's best to unfontify. |
| 1166 | (quit (font-lock-unfontify-buffer))))))) | 1084 | (quit (font-lock-unfontify-buffer))))))) |
| @@ -1171,7 +1089,6 @@ Lock mode." | |||
| 1171 | (save-restriction | 1089 | (save-restriction |
| 1172 | (widen) | 1090 | (widen) |
| 1173 | (font-lock-unfontify-region (point-min) (point-max)) | 1091 | (font-lock-unfontify-region (point-min) (point-max)) |
| 1174 | (font-lock-after-unfontify-buffer) | ||
| 1175 | (setq font-lock-fontified nil))) | 1092 | (setq font-lock-fontified nil))) |
| 1176 | 1093 | ||
| 1177 | (defvar font-lock-dont-widen nil | 1094 | (defvar font-lock-dont-widen nil |
| @@ -2395,6 +2312,10 @@ This should be an integer. Used in `cpp-font-lock-keywords'.") | |||
| 2395 | for C preprocessor directives. This definition is for the other modes | 2312 | for C preprocessor directives. This definition is for the other modes |
| 2396 | in which C preprocessor directives are used, e.g. `asm-mode' and | 2313 | in which C preprocessor directives are used, e.g. `asm-mode' and |
| 2397 | `ld-script-mode'.") | 2314 | `ld-script-mode'.") |
| 2315 | |||
| 2316 | (define-obsolete-function-alias 'font-lock-after-fontify-buffer #'ignore "29.1") | ||
| 2317 | (define-obsolete-function-alias 'font-lock-after-unfontify-buffer #'ignore "29.1") | ||
| 2318 | |||
| 2398 | 2319 | ||
| 2399 | (provide 'font-lock) | 2320 | (provide 'font-lock) |
| 2400 | 2321 | ||
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 71eda7cd2b0..4bfec22b3a9 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el | |||
| @@ -1451,8 +1451,7 @@ If so restore the actual mbox message collection." | |||
| 1451 | (setq-local font-lock-defaults | 1451 | (setq-local font-lock-defaults |
| 1452 | '(rmail-font-lock-keywords | 1452 | '(rmail-font-lock-keywords |
| 1453 | t t nil nil | 1453 | t t nil nil |
| 1454 | (font-lock-dont-widen . t) | 1454 | (font-lock-dont-widen . t))) |
| 1455 | (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode)))) | ||
| 1456 | (setq-local require-final-newline nil) | 1455 | (setq-local require-final-newline nil) |
| 1457 | (setq-local version-control 'never) | 1456 | (setq-local version-control 'never) |
| 1458 | (add-hook 'kill-buffer-hook #'rmail-mode-kill-summary nil t) | 1457 | (add-hook 'kill-buffer-hook #'rmail-mode-kill-summary nil t) |
diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el deleted file mode 100644 index 1614935f03a..00000000000 --- a/lisp/obsolete/fast-lock.el +++ /dev/null | |||
| @@ -1,730 +0,0 @@ | |||
| 1 | ;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 1994-1998, 2001-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Simon Marshall <simon@gnu.org> | ||
| 6 | ;; Maintainer: emacs-devel@gnu.org | ||
| 7 | ;; Keywords: faces files | ||
| 8 | ;; Version: 3.14 | ||
| 9 | ;; Obsolete-since: 22.1 | ||
| 10 | |||
| 11 | ;; This file is part of GNU Emacs. | ||
| 12 | |||
| 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 14 | ;; it under the terms of the GNU General Public License as published by | ||
| 15 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 16 | ;; (at your option) any later version. | ||
| 17 | |||
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 21 | ;; GNU General Public License for more details. | ||
| 22 | |||
| 23 | ;; You should have received a copy of the GNU General Public License | ||
| 24 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | |||
| 28 | ;; Fast Lock mode is a Font Lock support mode. | ||
| 29 | ;; It makes visiting a file in Font Lock mode faster by restoring its face text | ||
| 30 | ;; properties from automatically saved associated Font Lock cache files. | ||
| 31 | ;; | ||
| 32 | ;; See caveats and feedback below. | ||
| 33 | ;; See also the lazy-lock package. (But don't use the two at the same time!) | ||
| 34 | |||
| 35 | ;; Installation: | ||
| 36 | ;; | ||
| 37 | ;; Put in your ~/.emacs: | ||
| 38 | ;; | ||
| 39 | ;; (setq font-lock-support-mode 'fast-lock-mode) | ||
| 40 | ;; | ||
| 41 | ;; Start up a new Emacs and use font-lock as usual (except that you can use the | ||
| 42 | ;; so-called "gaudier" fontification regexps on big files without frustration). | ||
| 43 | ;; | ||
| 44 | ;; When you visit a file (which has `font-lock-mode' enabled) that has a | ||
| 45 | ;; corresponding Font Lock cache file associated with it, the Font Lock cache | ||
| 46 | ;; will be loaded from that file instead of being generated by Font Lock code. | ||
| 47 | |||
| 48 | ;; Caveats: | ||
| 49 | ;; | ||
| 50 | ;; A cache will be saved when visiting a compressed file using crypt++, but not | ||
| 51 | ;; be read. This is a "feature"/"consequence"/"bug" of crypt++. | ||
| 52 | ;; | ||
| 53 | ;; Version control packages are likely to stamp all over file modification | ||
| 54 | ;; times. Therefore the act of checking out may invalidate a cache. | ||
| 55 | |||
| 56 | ;; History: | ||
| 57 | ;; | ||
| 58 | ;; 0.02--1.00: | ||
| 59 | ;; - Changed name from turbo-prop to fast-lock. Automagic for font-lock only | ||
| 60 | ;; - Made `fast-lock-mode' a minor mode, like G. Dinesh Dutt's fss-mode | ||
| 61 | ;; 1.00--1.01: | ||
| 62 | ;; - Turn on `fast-lock-mode' only if `buffer-file-name' or `interactive-p' | ||
| 63 | ;; - Made `fast-lock-file-name' use `buffer-name' if `buffer-file-name' is nil | ||
| 64 | ;; - Moved save-all conditions to `fast-lock-save-cache' | ||
| 65 | ;; - Added `fast-lock-save-text-properties' to `kill-buffer-hook' | ||
| 66 | ;; 1.01--2.00: complete rewrite---not worth the space to document | ||
| 67 | ;; - Changed structure of text properties cache and threw out file mod checks | ||
| 68 | ;; 2.00--2.01: | ||
| 69 | ;; - Made `condition-case' forms understand `quit'. | ||
| 70 | ;; - Made `fast-lock' require `font-lock' | ||
| 71 | ;; - Made `fast-lock-cache-name' chase links (from Ben Liblit) | ||
| 72 | ;; 2.01--3.00: | ||
| 73 | ;; - Changed structure of cache to include `font-lock-keywords' (from rms) | ||
| 74 | ;; - Changed `fast-lock-cache-mechanisms' to `fast-lock-cache-directories' | ||
| 75 | ;; - Removed `fast-lock-read-others' | ||
| 76 | ;; - Made `fast-lock-read-cache' ignore cache owner | ||
| 77 | ;; - Made `fast-lock-save-cache-external' create cache directory | ||
| 78 | ;; - Made `fast-lock-save-cache-external' save `font-lock-keywords' | ||
| 79 | ;; - Made `fast-lock-cache-data' check `font-lock-keywords' | ||
| 80 | ;; 3.00--3.01: incorporated port of 2.00 to Lucid, made by Barry Warsaw | ||
| 81 | ;; - Package now provides itself | ||
| 82 | ;; - Lucid: Use `font-lock-any-extents-p' for `font-lock-any-properties-p' | ||
| 83 | ;; - Lucid: Use `list-faces' for `face-list' | ||
| 84 | ;; - Lucid: Added `set-text-properties' | ||
| 85 | ;; - Lucid: Made `turn-on-fast-lock' pass 1 not t to `fast-lock-mode' | ||
| 86 | ;; - Removed test for `fast-lock-mode' from `fast-lock-read-cache' | ||
| 87 | ;; - Lucid: Added Lucid-specific `fast-lock-get-face-properties' | ||
| 88 | ;; 3.01--3.02: now works with Lucid Emacs, thanks to Barry Warsaw | ||
| 89 | ;; - Made `fast-lock-cache-name' map ":" to ";" for OS/2 (from Serganova Vera) | ||
| 90 | ;; - Made `fast-lock-cache-name' use abbreviated file name (from Barry Warsaw) | ||
| 91 | ;; - Lucid: Separated handlers for `error' and `quit' for `condition-case' | ||
| 92 | ;; 3.02--3.03: | ||
| 93 | ;; - Changed `fast-lock-save-cache-external' to `fast-lock-save-cache-data' | ||
| 94 | ;; - Lucid: Added Lucid-specific `fast-lock-set-face-properties' | ||
| 95 | ;; 3.03--3.04: | ||
| 96 | ;; - Corrected `subrp' test of Lucid code | ||
| 97 | ;; - Replaced `font-lock-any-properties-p' with `text-property-not-all' | ||
| 98 | ;; - Lucid: Made `fast-lock-set-face-properties' put `text-prop' on extents | ||
| 99 | ;; - Made `fast-lock-cache-directories' a regexp alist (from Colin Rafferty) | ||
| 100 | ;; - Made `fast-lock-cache-directory' to return a usable cache file directory | ||
| 101 | ;; 3.04--3.05: | ||
| 102 | ;; - Lucid: Fix for XEmacs 19.11 `text-property-not-all' | ||
| 103 | ;; - Replaced `subrp' test of Lucid code with `emacs-version' `string-match' | ||
| 104 | ;; - Made `byte-compile-warnings' omit `unresolved' on compilation | ||
| 105 | ;; - Made `fast-lock-save-cache-data' use a buffer (from Rick Sladkey) | ||
| 106 | ;; - Reverted to old `fast-lock-get-face-properties' (from Rick Sladkey) | ||
| 107 | ;; 3.05--3.06: incorporated hack of 3.03, made by Jonathan Stigelman (Stig) | ||
| 108 | ;; - Reverted to 3.04 version of `fast-lock-get-face-properties' | ||
| 109 | ;; - XEmacs: Removed `list-faces' `defalias' | ||
| 110 | ;; - Made `fast-lock-mode' and `turn-on-fast-lock' succeed `autoload' cookies | ||
| 111 | ;; - Added `fast-lock-submit-bug-report' | ||
| 112 | ;; - Renamed `fast-lock-save-size' to `fast-lock-minimum-size' | ||
| 113 | ;; - Made `fast-lock-save-cache' output a message if no save ever attempted | ||
| 114 | ;; - Made `fast-lock-save-cache-data' output a message if save attempted | ||
| 115 | ;; - Made `fast-lock-cache-data' output a message if load attempted | ||
| 116 | ;; - Made `fast-lock-save-cache-data' do `condition-case' not `unwind-protect' | ||
| 117 | ;; - Made `fast-lock-save-cache' and `fast-lock-read-cache' return nothing | ||
| 118 | ;; - Made `fast-lock-save-cache' check `buffer-modified-p' (Stig) | ||
| 119 | ;; - Added `fast-lock-save-events' | ||
| 120 | ;; - Added `fast-lock-after-save-hook' to `after-save-hook' (Stig) | ||
| 121 | ;; - Added `fast-lock-kill-buffer-hook' to `kill-buffer-hook' | ||
| 122 | ;; - Changed `fast-lock-save-caches' to `fast-lock-kill-emacs-hook' | ||
| 123 | ;; - Added `fast-lock-kill-emacs-hook' to `kill-emacs-hook' | ||
| 124 | ;; - Made `fast-lock-save-cache' check `verify-visited-file-modtime' (Stig) | ||
| 125 | ;; - Made `visited-file-modtime' be the basis of the timestamp (Stig) | ||
| 126 | ;; - Made `fast-lock-save-cache-1' and `fast-lock-cache-data' use/reformat it | ||
| 127 | ;; - Added `fast-lock-cache-filename' to keep track of the cache file name | ||
| 128 | ;; - Added `fast-lock-after-fontify-buffer' | ||
| 129 | ;; - Added `fast-lock-save-faces' list of faces to save (idea from Stig/Tibor) | ||
| 130 | ;; - Made `fast-lock-get-face-properties' functions use it | ||
| 131 | ;; - XEmacs: Made `fast-lock-set-face-properties' do extents the Font Lock way | ||
| 132 | ;; - XEmacs: Removed fix for `text-property-not-all' (19.11 support dropped) | ||
| 133 | ;; - Made `fast-lock-mode' ensure `font-lock-mode' is on | ||
| 134 | ;; - Made `fast-lock-save-cache' do `cdr-safe' not `cdr' (from Dave Foster) | ||
| 135 | ;; - Made `fast-lock-save-cache' do `set-buffer' first (from Dave Foster) | ||
| 136 | ;; - Made `fast-lock-save-cache' loop until saved or quit (from Georg Nikodym) | ||
| 137 | ;; - Made `fast-lock-cache-data' check `buffer-modified-p' | ||
| 138 | ;; - Made `fast-lock-cache-data' do `font-lock-compile-keywords' if necessary | ||
| 139 | ;; - XEmacs: Made `font-lock-compile-keywords' `defalias' | ||
| 140 | ;; 3.06--3.07: | ||
| 141 | ;; - XEmacs: Add `fast-lock-after-fontify-buffer' to the Font Lock hook | ||
| 142 | ;; - Made `fast-lock-cache-name' explain the use of `directory-abbrev-alist' | ||
| 143 | ;; - Made `fast-lock-mode' use `buffer-file-truename' not `buffer-file-name' | ||
| 144 | ;; 3.07--3.08: | ||
| 145 | ;; - Made `fast-lock-read-cache' set `fast-lock-cache-filename' | ||
| 146 | ;; 3.08--3.09: | ||
| 147 | ;; - Made `fast-lock-save-cache' cope if `fast-lock-minimum-size' is a list | ||
| 148 | ;; - Made `fast-lock-mode' respect the value of `font-lock-inhibit-thing-lock' | ||
| 149 | ;; - Added `fast-lock-after-unfontify-buffer' | ||
| 150 | ;; 3.09--3.10: | ||
| 151 | ;; - Rewrite for Common Lisp macros | ||
| 152 | ;; - Made fast-lock.el barf on a crap 8+3 pseudo-OS (Eli Zaretskii help) | ||
| 153 | ;; - XEmacs: Made `add-minor-mode' succeed `autoload' cookie | ||
| 154 | ;; - XEmacs: Made `fast-lock-save-faces' default to `font-lock-face-list' | ||
| 155 | ;; - Made `fast-lock-save-cache' use `font-lock-value-in-major-mode' | ||
| 156 | ;; - Wrap with `save-buffer-state' (Ray Van Tassle report) | ||
| 157 | ;; - Made `fast-lock-mode' wrap `font-lock-support-mode' | ||
| 158 | ;; 3.10--3.11: | ||
| 159 | ;; - Made `fast-lock-get-face-properties' cope with face lists | ||
| 160 | ;; - Added `fast-lock-verbose' | ||
| 161 | ;; - XEmacs: Add `font-lock-value-in-major-mode' if necessary | ||
| 162 | ;; - Removed `fast-lock-submit-bug-report' and bade farewell | ||
| 163 | ;; 3.11--3.12: | ||
| 164 | ;; - Added Custom support (Hrvoje Nikšić help) | ||
| 165 | ;; - Made `save-buffer-state' wrap `inhibit-point-motion-hooks' | ||
| 166 | ;; - Made `fast-lock-cache-data' simplify calls of `font-lock-compile-keywords' | ||
| 167 | ;; 3.12--3.13: | ||
| 168 | ;; - Removed `byte-*' variables from `eval-when-compile' (Erik Naggum hint) | ||
| 169 | ;; - Changed structure of cache to include `font-lock-syntactic-keywords' | ||
| 170 | ;; - Made `fast-lock-save-cache-1' save syntactic fontification data | ||
| 171 | ;; - Made `fast-lock-cache-data' take syntactic fontification data | ||
| 172 | ;; - Added `fast-lock-get-syntactic-properties' | ||
| 173 | ;; - Renamed `fast-lock-set-face-properties' to `fast-lock-add-properties' | ||
| 174 | ;; - Made `fast-lock-add-properties' add syntactic and face fontification data | ||
| 175 | ;; 3.13--3.14: | ||
| 176 | ;; - Made `fast-lock-cache-name' cope with `windowsnt' (Geoff Voelker fix) | ||
| 177 | ;; - Made `fast-lock-verbose' use `other' widget (Andreas Schwab fix) | ||
| 178 | ;; - Used `with-temp-message' where possible to make messages temporary. | ||
| 179 | |||
| 180 | ;;; Code: | ||
| 181 | |||
| 182 | (require 'font-lock) | ||
| 183 | |||
| 184 | (declare-function msdos-long-file-names "msdos.c") | ||
| 185 | |||
| 186 | ;; Make sure fast-lock.el is supported. | ||
| 187 | (if (and (eq system-type 'ms-dos) (not (msdos-long-file-names))) | ||
| 188 | (error "`fast-lock' was written for long file name systems")) | ||
| 189 | |||
| 190 | (defvar font-lock-face-list) | ||
| 191 | |||
| 192 | (eval-when-compile | ||
| 193 | ;; | ||
| 194 | ;; We use this to verify that a face should be saved. | ||
| 195 | (defmacro fast-lock-save-facep (face) | ||
| 196 | "Return non-nil if FACE is one of `fast-lock-save-faces'." | ||
| 197 | `(or (null fast-lock-save-faces) | ||
| 198 | (if (symbolp ,face) | ||
| 199 | (memq ,face fast-lock-save-faces) | ||
| 200 | (let ((faces ,face)) | ||
| 201 | (while (unless (memq (car faces) fast-lock-save-faces) | ||
| 202 | (setq faces (cdr faces)))) | ||
| 203 | faces))))) | ||
| 204 | |||
| 205 | (defgroup fast-lock nil | ||
| 206 | "Font Lock support mode to cache fontification." | ||
| 207 | :load 'fast-lock | ||
| 208 | :group 'font-lock) | ||
| 209 | |||
| 210 | (defvar fast-lock-mode nil) ; Whether we are turned on. | ||
| 211 | (defvar fast-lock-cache-timestamp nil) ; For saving/reading. | ||
| 212 | (defvar fast-lock-cache-filename nil) ; For deleting. | ||
| 213 | |||
| 214 | ;; User Variables: | ||
| 215 | |||
| 216 | (defcustom fast-lock-minimum-size 25600 | ||
| 217 | "Minimum size of a buffer for cached fontification. | ||
| 218 | Only buffers more than this can have associated Font Lock cache files saved. | ||
| 219 | If nil, means cache files are never created. | ||
| 220 | If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), | ||
| 221 | where MAJOR-MODE is a symbol or t (meaning the default). For example: | ||
| 222 | ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576)) | ||
| 223 | means that the minimum size is 25K for buffers in C or C++ modes, one megabyte | ||
| 224 | for buffers in Rmail mode, and size is irrelevant otherwise." | ||
| 225 | :type '(choice (const :tag "none" nil) | ||
| 226 | (integer :tag "size") | ||
| 227 | (repeat :menu-tag "mode specific" :tag "mode specific" | ||
| 228 | :value ((t . nil)) | ||
| 229 | (cons :tag "Instance" | ||
| 230 | (radio :tag "Mode" | ||
| 231 | (const :tag "all" t) | ||
| 232 | (symbol :tag "name")) | ||
| 233 | (radio :tag "Size" | ||
| 234 | (const :tag "none" nil) | ||
| 235 | (integer :tag "size")))))) | ||
| 236 | |||
| 237 | (defcustom fast-lock-cache-directories '("~/.emacs-flc") | ||
| 238 | ; - `internal', keep each file's Font Lock cache file in the same file. | ||
| 239 | ; - `external', keep each file's Font Lock cache file in the same directory. | ||
| 240 | "Directories in which Font Lock cache files are saved and read. | ||
| 241 | Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where | ||
| 242 | DIR is a directory name (relative or absolute) and REGEXP is a regexp. | ||
| 243 | |||
| 244 | An attempt will be made to save or read Font Lock cache files using these items | ||
| 245 | until one succeeds (i.e., until a readable or writable one is found). If an | ||
| 246 | item contains REGEXP, DIR is used only if the buffer file name matches REGEXP. | ||
| 247 | For example: | ||
| 248 | |||
| 249 | (let ((home (expand-file-name (abbreviate-file-name (file-truename \"~/\"))))) | ||
| 250 | (list (cons (concat \"^\" (regexp-quote home)) \".\") \"~/.emacs-flc\")) | ||
| 251 | => | ||
| 252 | ((\"^/your/true/home/directory/\" . \".\") \"~/.emacs-flc\") | ||
| 253 | |||
| 254 | would cause a file's current directory to be used if the file is under your | ||
| 255 | home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'. | ||
| 256 | For security reasons, it is not advisable to use the file's current directory | ||
| 257 | to avoid the possibility of using the cache of another user." | ||
| 258 | :type '(repeat (radio (directory :tag "directory") | ||
| 259 | (cons :tag "Matching" | ||
| 260 | (regexp :tag "regexp") | ||
| 261 | (directory :tag "directory"))))) | ||
| 262 | (put 'fast-lock-cache-directories 'risky-local-variable t) | ||
| 263 | |||
| 264 | (defcustom fast-lock-save-events '(kill-buffer kill-emacs) | ||
| 265 | "Events under which caches will be saved. | ||
| 266 | Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. | ||
| 267 | If concurrent editing sessions use the same associated cache file for a file's | ||
| 268 | buffer, then you should add `save-buffer' to this list." | ||
| 269 | :type '(set (const :tag "buffer saving" save-buffer) | ||
| 270 | (const :tag "buffer killing" kill-buffer) | ||
| 271 | (const :tag "emacs killing" kill-emacs))) | ||
| 272 | |||
| 273 | (defcustom fast-lock-save-others t | ||
| 274 | "If non-nil, save Font Lock cache files irrespective of file owner. | ||
| 275 | If nil, means only buffer files known to be owned by you can have associated | ||
| 276 | Font Lock cache files saved. Ownership may be unknown for networked files." | ||
| 277 | :type 'boolean) | ||
| 278 | |||
| 279 | (defcustom fast-lock-verbose font-lock-verbose | ||
| 280 | "If non-nil, means show status messages for cache processing. | ||
| 281 | If a number, only buffers greater than this size have processing messages." | ||
| 282 | :type '(choice (const :tag "never" nil) | ||
| 283 | (other :tag "always" t) | ||
| 284 | (integer :tag "size"))) | ||
| 285 | |||
| 286 | (defvar fast-lock-save-faces nil | ||
| 287 | "Faces that will be saved in a Font Lock cache file. | ||
| 288 | If nil, means information for all faces will be saved.") | ||
| 289 | |||
| 290 | ;; User Functions: | ||
| 291 | |||
| 292 | ;;;###autoload | ||
| 293 | (defun fast-lock-mode (&optional arg) | ||
| 294 | "Toggle Fast Lock mode. | ||
| 295 | With arg, turn Fast Lock mode on if and only if arg is positive and the buffer | ||
| 296 | is associated with a file. Enable it automatically in your `~/.emacs' by: | ||
| 297 | |||
| 298 | (setq font-lock-support-mode \\='fast-lock-mode) | ||
| 299 | |||
| 300 | If Fast Lock mode is enabled, and the current buffer does not contain any text | ||
| 301 | properties, any associated Font Lock cache is used if its timestamp matches the | ||
| 302 | buffer's file, and its `font-lock-keywords' match those that you are using. | ||
| 303 | |||
| 304 | Font Lock caches may be saved: | ||
| 305 | - When you save the file's buffer. | ||
| 306 | - When you kill an unmodified file's buffer. | ||
| 307 | - When you exit Emacs, for all unmodified or saved buffers. | ||
| 308 | Depending on the value of `fast-lock-save-events'. | ||
| 309 | See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'. | ||
| 310 | |||
| 311 | Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad. | ||
| 312 | |||
| 313 | Various methods of control are provided for the Font Lock cache. In general, | ||
| 314 | see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'. | ||
| 315 | For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events', | ||
| 316 | `fast-lock-save-others' and `fast-lock-save-faces'." | ||
| 317 | (interactive "P") | ||
| 318 | ;; Only turn on if we are visiting a file. We could use `buffer-file-name', | ||
| 319 | ;; but many packages temporarily wrap that to nil when doing their own thing. | ||
| 320 | (set (make-local-variable 'fast-lock-mode) | ||
| 321 | (and buffer-file-truename | ||
| 322 | (not (memq 'fast-lock-mode font-lock-inhibit-thing-lock)) | ||
| 323 | (if arg (> (prefix-numeric-value arg) 0) (not fast-lock-mode)))) | ||
| 324 | (if (and fast-lock-mode (not font-lock-mode)) | ||
| 325 | ;; Turned on `fast-lock-mode' rather than `font-lock-mode'. | ||
| 326 | (progn | ||
| 327 | (message "Use font-lock-support-mode rather than calling fast-lock-mode") | ||
| 328 | (sit-for 2)) | ||
| 329 | ;; Let's get down to business. | ||
| 330 | (set (make-local-variable 'fast-lock-cache-timestamp) nil) | ||
| 331 | (set (make-local-variable 'fast-lock-cache-filename) nil) | ||
| 332 | (when (and fast-lock-mode (not font-lock-fontified)) | ||
| 333 | (fast-lock-read-cache)))) | ||
| 334 | |||
| 335 | (defun fast-lock-read-cache () | ||
| 336 | "Read the Font Lock cache for the current buffer. | ||
| 337 | |||
| 338 | The following criteria must be met for a Font Lock cache file to be read: | ||
| 339 | - Fast Lock mode must be turned on in the buffer. | ||
| 340 | - The buffer must not be modified. | ||
| 341 | - The buffer's `font-lock-keywords' must match the cache's. | ||
| 342 | - The buffer file's timestamp must match the cache's. | ||
| 343 | - Criteria imposed by `fast-lock-cache-directories'. | ||
| 344 | |||
| 345 | See `fast-lock-mode'." | ||
| 346 | (interactive) | ||
| 347 | (let ((directories fast-lock-cache-directories) | ||
| 348 | (modified (buffer-modified-p)) (inhibit-read-only t) | ||
| 349 | (fontified font-lock-fontified)) | ||
| 350 | (set (make-local-variable 'font-lock-fontified) nil) | ||
| 351 | ;; Keep trying directories until fontification is turned off. | ||
| 352 | (while (and directories (not font-lock-fontified)) | ||
| 353 | (let ((directory (fast-lock-cache-directory (car directories) nil))) | ||
| 354 | (condition-case nil | ||
| 355 | (when directory | ||
| 356 | (setq fast-lock-cache-filename (fast-lock-cache-name directory)) | ||
| 357 | (when (file-readable-p fast-lock-cache-filename) | ||
| 358 | (load fast-lock-cache-filename t t t))) | ||
| 359 | (error nil) (quit nil)) | ||
| 360 | (setq directories (cdr directories)))) | ||
| 361 | ;; Unset `fast-lock-cache-filename', and restore `font-lock-fontified', if | ||
| 362 | ;; we don't use a cache. (Note that `fast-lock-cache-data' sets the value | ||
| 363 | ;; of `fast-lock-cache-timestamp'.) | ||
| 364 | (set-buffer-modified-p modified) | ||
| 365 | (unless font-lock-fontified | ||
| 366 | (setq fast-lock-cache-filename nil font-lock-fontified fontified)))) | ||
| 367 | |||
| 368 | (defun fast-lock-save-cache (&optional buffer) | ||
| 369 | "Save the Font Lock cache of BUFFER or the current buffer. | ||
| 370 | |||
| 371 | The following criteria must be met for a Font Lock cache file to be saved: | ||
| 372 | - Fast Lock mode must be turned on in the buffer. | ||
| 373 | - The event must be one of `fast-lock-save-events'. | ||
| 374 | - The buffer must be at least `fast-lock-minimum-size' bytes long. | ||
| 375 | - The buffer file must be owned by you, or `fast-lock-save-others' must be t. | ||
| 376 | - The buffer must contain at least one `face' text property. | ||
| 377 | - The buffer must not be modified. | ||
| 378 | - The buffer file's timestamp must be the same as the file's on disk. | ||
| 379 | - The on disk file's timestamp must be different than the buffer's cache. | ||
| 380 | - Criteria imposed by `fast-lock-cache-directories'. | ||
| 381 | |||
| 382 | See `fast-lock-mode'." | ||
| 383 | (interactive) | ||
| 384 | (save-excursion | ||
| 385 | (when buffer | ||
| 386 | (set-buffer buffer)) | ||
| 387 | (let ((min-size (font-lock-value-in-major-mode fast-lock-minimum-size)) | ||
| 388 | (file-timestamp (visited-file-modtime)) (saved nil)) | ||
| 389 | (when (and fast-lock-mode | ||
| 390 | ;; | ||
| 391 | ;; "Only save if the buffer matches the file, the file has | ||
| 392 | ;; changed, and it was changed by the current emacs session." | ||
| 393 | ;; | ||
| 394 | ;; Only save if the buffer is not modified, | ||
| 395 | ;; (i.e., so we don't save for something not on disk) | ||
| 396 | (not (buffer-modified-p)) | ||
| 397 | ;; and the file's timestamp is the same as the buffer's, | ||
| 398 | ;; (i.e., someone else hasn't written the file in the meantime) | ||
| 399 | (verify-visited-file-modtime (current-buffer)) | ||
| 400 | ;; and the file's timestamp is different from the cache's. | ||
| 401 | ;; (i.e., a save has occurred since the cache was read) | ||
| 402 | (not (equal fast-lock-cache-timestamp file-timestamp)) | ||
| 403 | ;; | ||
| 404 | ;; Only save if user's restrictions are satisfied. | ||
| 405 | (and min-size (>= (buffer-size) min-size)) | ||
| 406 | (or fast-lock-save-others | ||
| 407 | (eq (user-uid) (file-attribute-user-id | ||
| 408 | (file-attributes buffer-file-name)))) | ||
| 409 | ;; | ||
| 410 | ;; Only save if there are `face' properties to save. | ||
| 411 | (text-property-not-all (point-min) (point-max) 'face nil)) | ||
| 412 | ;; | ||
| 413 | ;; Try each directory until we manage to save or the user quits. | ||
| 414 | (let ((directories fast-lock-cache-directories)) | ||
| 415 | (while (and directories (memq saved '(nil error))) | ||
| 416 | (let* ((dir (fast-lock-cache-directory (car directories) t)) | ||
| 417 | (file (and dir (fast-lock-cache-name dir)))) | ||
| 418 | (when (and file (file-writable-p file)) | ||
| 419 | (setq saved (fast-lock-save-cache-1 file file-timestamp))) | ||
| 420 | (setq directories (cdr directories))))))))) | ||
| 421 | |||
| 422 | ;;;###autoload | ||
| 423 | (defun turn-on-fast-lock () | ||
| 424 | "Unconditionally turn on Fast Lock mode." | ||
| 425 | (fast-lock-mode t)) | ||
| 426 | |||
| 427 | ;;; API Functions: | ||
| 428 | |||
| 429 | (defun fast-lock-after-fontify-buffer () | ||
| 430 | ;; Delete the Font Lock cache file used to restore fontification, if any. | ||
| 431 | (when fast-lock-cache-filename | ||
| 432 | (if (file-writable-p fast-lock-cache-filename) | ||
| 433 | (delete-file fast-lock-cache-filename) | ||
| 434 | (message "File %s font lock cache cannot be deleted" (buffer-name)))) | ||
| 435 | ;; Flag so that a cache will be saved later even if the file is never saved. | ||
| 436 | (setq fast-lock-cache-timestamp nil)) | ||
| 437 | |||
| 438 | (defalias 'fast-lock-after-unfontify-buffer #'ignore) | ||
| 439 | |||
| 440 | ;; Miscellaneous Functions: | ||
| 441 | |||
| 442 | (defun fast-lock-save-cache-after-save-file () | ||
| 443 | ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'. | ||
| 444 | (when (memq 'save-buffer fast-lock-save-events) | ||
| 445 | (fast-lock-save-cache))) | ||
| 446 | |||
| 447 | (defun fast-lock-save-cache-before-kill-buffer () | ||
| 448 | ;; Do `fast-lock-save-cache' if `kill-buffer' is on `fast-lock-save-events'. | ||
| 449 | (when (memq 'kill-buffer fast-lock-save-events) | ||
| 450 | (fast-lock-save-cache))) | ||
| 451 | |||
| 452 | (defun fast-lock-save-caches-before-kill-emacs () | ||
| 453 | ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'. | ||
| 454 | (when (memq 'kill-emacs fast-lock-save-events) | ||
| 455 | (mapcar #'fast-lock-save-cache (buffer-list)))) | ||
| 456 | |||
| 457 | (defun fast-lock-cache-directory (directory create) | ||
| 458 | "Return usable directory based on DIRECTORY. | ||
| 459 | Returns nil if the directory does not exist, or, if CREATE non-nil, cannot be | ||
| 460 | created. DIRECTORY may be a string or a cons pair of the form (REGEXP . DIR). | ||
| 461 | See `fast-lock-cache-directories'." | ||
| 462 | (let ((dir | ||
| 463 | (cond ((not buffer-file-name) | ||
| 464 | ;; Should never be nil, but `crypt++' screws it up. | ||
| 465 | nil) | ||
| 466 | ((stringp directory) | ||
| 467 | ;; Just a directory. | ||
| 468 | directory) | ||
| 469 | (t | ||
| 470 | ;; A directory if the file name matches the regexp. | ||
| 471 | (let ((bufile (expand-file-name buffer-file-truename)) | ||
| 472 | (case-fold-search nil)) | ||
| 473 | (when (save-match-data (string-match (car directory) bufile)) | ||
| 474 | (cdr directory))))))) | ||
| 475 | (cond ((not dir) | ||
| 476 | nil) | ||
| 477 | ((file-accessible-directory-p dir) | ||
| 478 | dir) | ||
| 479 | (create | ||
| 480 | (condition-case nil | ||
| 481 | (progn (make-directory dir t) dir) | ||
| 482 | (error nil)))))) | ||
| 483 | |||
| 484 | ;; If you are wondering why we only hash if the directory is not ".", rather | ||
| 485 | ;; than if `file-name-absolute-p', it is because if we just appended ".flc" for | ||
| 486 | ;; relative cache directories (that are not ".") then it is possible that more | ||
| 487 | ;; than one file would have the same cache name in that directory, if the luser | ||
| 488 | ;; made a link from one relative cache directory to another. (Phew!) | ||
| 489 | (defun fast-lock-cache-name (directory) | ||
| 490 | "Return full cache file name using caching DIRECTORY. | ||
| 491 | If DIRECTORY is `.', the file name is the buffer file name appended with `.flc'. | ||
| 492 | Otherwise, the file name is constructed from DIRECTORY and the buffer's true | ||
| 493 | abbreviated file name, with all `/' characters in the name replaced with `#' | ||
| 494 | characters, and appended with `.flc'. | ||
| 495 | |||
| 496 | If the same file has different cache file names when edited on different | ||
| 497 | machines, e.g., on one machine the cache file name has the prefix `#home', | ||
| 498 | perhaps due to automount, try putting in your `~/.emacs' something like: | ||
| 499 | |||
| 500 | (setq directory-abbrev-alist (cons \\='(\"^/home/\" . \"/\") directory-abbrev-alist)) | ||
| 501 | |||
| 502 | Emacs automagically removes the common `/tmp_mnt' automount prefix by default. | ||
| 503 | |||
| 504 | See `fast-lock-cache-directory'." | ||
| 505 | (if (string-equal directory ".") | ||
| 506 | (concat buffer-file-name ".flc") | ||
| 507 | (let* ((bufile (expand-file-name buffer-file-truename)) | ||
| 508 | (chars-alist | ||
| 509 | (if (memq system-type '(windows-nt cygwin)) | ||
| 510 | '((?/ . (?#)) (?# . (?# ?#)) (?: . (?\;)) (?\; . (?\; ?\;))) | ||
| 511 | '((?/ . (?#)) (?# . (?# ?#))))) | ||
| 512 | (mapchars | ||
| 513 | (function (lambda (c) (or (cdr (assq c chars-alist)) (list c)))))) | ||
| 514 | (concat | ||
| 515 | (file-name-as-directory (expand-file-name directory)) | ||
| 516 | (mapconcat #'char-to-string (apply #'append (mapcar mapchars bufile)) "") | ||
| 517 | ".flc")))) | ||
| 518 | |||
| 519 | ;; Font Lock Cache Processing Functions: | ||
| 520 | |||
| 521 | ;; The version 3 format of the cache is: | ||
| 522 | ;; | ||
| 523 | ;; (fast-lock-cache-data VERSION TIMESTAMP | ||
| 524 | ;; font-lock-syntactic-keywords SYNTACTIC-PROPERTIES | ||
| 525 | ;; font-lock-keywords FACE-PROPERTIES) | ||
| 526 | |||
| 527 | (defun fast-lock-save-cache-1 (file timestamp) | ||
| 528 | ;; Save the FILE with the TIMESTAMP plus fontification data. | ||
| 529 | ;; Returns non-nil if a save was attempted to a writable cache file. | ||
| 530 | (let ((tpbuf (generate-new-buffer " *fast-lock*")) | ||
| 531 | (verbose (if (numberp fast-lock-verbose) | ||
| 532 | (> (buffer-size) fast-lock-verbose) | ||
| 533 | fast-lock-verbose)) | ||
| 534 | (saved t)) | ||
| 535 | (with-temp-message | ||
| 536 | (when verbose | ||
| 537 | (format "Saving %s font lock cache..." (buffer-name))) | ||
| 538 | (condition-case nil | ||
| 539 | (save-excursion | ||
| 540 | (print (list 'fast-lock-cache-data 3 | ||
| 541 | (list 'quote timestamp) | ||
| 542 | (list 'quote font-lock-syntactic-keywords) | ||
| 543 | (list 'quote (fast-lock-get-syntactic-properties)) | ||
| 544 | (list 'quote font-lock-keywords) | ||
| 545 | (list 'quote (fast-lock-get-face-properties))) | ||
| 546 | tpbuf) | ||
| 547 | (set-buffer tpbuf) | ||
| 548 | (write-region (point-min) (point-max) file nil 'quietly) | ||
| 549 | (setq fast-lock-cache-timestamp timestamp | ||
| 550 | fast-lock-cache-filename file)) | ||
| 551 | (error (setq saved 'error)) (quit (setq saved 'quit))) | ||
| 552 | (kill-buffer tpbuf)) | ||
| 553 | (cond ((eq saved 'quit) | ||
| 554 | (message "Saving %s font lock cache...quit" (buffer-name))) | ||
| 555 | ((eq saved 'error) | ||
| 556 | (message "Saving %s font lock cache...failed" (buffer-name)))) | ||
| 557 | ;; We return non-nil regardless of whether a failure occurred. | ||
| 558 | saved)) | ||
| 559 | |||
| 560 | (defun fast-lock-cache-data (version timestamp | ||
| 561 | syntactic-keywords syntactic-properties | ||
| 562 | keywords face-properties | ||
| 563 | &rest _ignored) | ||
| 564 | ;; Find value of syntactic keywords in case it is a symbol. | ||
| 565 | (setq font-lock-syntactic-keywords (font-lock-eval-keywords | ||
| 566 | font-lock-syntactic-keywords)) | ||
| 567 | ;; Compile all keywords in case some are and some aren't. | ||
| 568 | (when font-lock-syntactic-keywords | ||
| 569 | (setq font-lock-syntactic-keywords (font-lock-compile-keywords | ||
| 570 | font-lock-syntactic-keywords t))) | ||
| 571 | (when syntactic-keywords | ||
| 572 | (setq syntactic-keywords (font-lock-compile-keywords syntactic-keywords t))) | ||
| 573 | (setq font-lock-keywords (font-lock-compile-keywords font-lock-keywords) | ||
| 574 | keywords (font-lock-compile-keywords keywords)) | ||
| 575 | ;; Use the Font Lock cache SYNTACTIC-PROPERTIES and FACE-PROPERTIES if we're | ||
| 576 | ;; using cache VERSION format 3, the current buffer's file timestamp matches | ||
| 577 | ;; the TIMESTAMP, the current buffer's `font-lock-syntactic-keywords' are the | ||
| 578 | ;; same as SYNTACTIC-KEYWORDS, and the current buffer's `font-lock-keywords' | ||
| 579 | ;; are the same as KEYWORDS. | ||
| 580 | (let ((buf-timestamp (visited-file-modtime)) | ||
| 581 | (verbose (if (numberp fast-lock-verbose) | ||
| 582 | (> (buffer-size) fast-lock-verbose) | ||
| 583 | fast-lock-verbose)) | ||
| 584 | (loaded t)) | ||
| 585 | (if (or (/= version 3) | ||
| 586 | (buffer-modified-p) | ||
| 587 | (not (equal timestamp buf-timestamp)) | ||
| 588 | (not (equal syntactic-keywords font-lock-syntactic-keywords)) | ||
| 589 | (not (equal keywords font-lock-keywords))) | ||
| 590 | (setq loaded nil) | ||
| 591 | (with-temp-message | ||
| 592 | (when verbose | ||
| 593 | (format "Loading %s font lock cache..." (buffer-name))) | ||
| 594 | (condition-case nil | ||
| 595 | (fast-lock-add-properties syntactic-properties face-properties) | ||
| 596 | (error (setq loaded 'error)) (quit (setq loaded 'quit)))) | ||
| 597 | (cond ((eq loaded 'quit) | ||
| 598 | (message "Loading %s font lock cache...quit" (buffer-name))) | ||
| 599 | ((eq loaded 'error) | ||
| 600 | (message "Loading %s font lock cache...failed" (buffer-name))))) | ||
| 601 | (setq font-lock-fontified (eq loaded t) | ||
| 602 | fast-lock-cache-timestamp (and (eq loaded t) timestamp)))) | ||
| 603 | |||
| 604 | ;; Text Properties Processing Functions: | ||
| 605 | |||
| 606 | ;; This is fast, but fails if adjacent characters have different `face' text | ||
| 607 | ;; properties. Maybe that's why I dropped it in the first place? | ||
| 608 | ;(defun fast-lock-get-face-properties () | ||
| 609 | ; "Return a list of `face' text properties in the current buffer. | ||
| 610 | ;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) | ||
| 611 | ;where VALUE is a `face' property value and STARTx and ENDx are positions." | ||
| 612 | ; (save-restriction | ||
| 613 | ; (widen) | ||
| 614 | ; (let ((start (text-property-not-all (point-min) (point-max) 'face nil)) | ||
| 615 | ; (limit (point-max)) end properties value cell) | ||
| 616 | ; (while start | ||
| 617 | ; (setq end (next-single-property-change start 'face nil limit) | ||
| 618 | ; value (get-text-property start 'face)) | ||
| 619 | ; ;; Make, or add to existing, list of regions with same `face'. | ||
| 620 | ; (if (setq cell (assq value properties)) | ||
| 621 | ; (setcdr cell (cons start (cons end (cdr cell)))) | ||
| 622 | ; (setq properties (cons (list value start end) properties))) | ||
| 623 | ; (setq start (next-single-property-change end 'face))) | ||
| 624 | ; properties))) | ||
| 625 | |||
| 626 | ;; This is slow, but copes if adjacent characters have different `face' text | ||
| 627 | ;; properties, but fails if they are lists. | ||
| 628 | ;(defun fast-lock-get-face-properties () | ||
| 629 | ; "Return a list of `face' text properties in the current buffer. | ||
| 630 | ;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) | ||
| 631 | ;where VALUE is a `face' property value and STARTx and ENDx are positions. | ||
| 632 | ;Only those `face' VALUEs in `fast-lock-save-faces' are returned." | ||
| 633 | ; (save-restriction | ||
| 634 | ; (widen) | ||
| 635 | ; (let ((faces (or fast-lock-save-faces (face-list))) (limit (point-max)) | ||
| 636 | ; properties regions face start end) | ||
| 637 | ; (while faces | ||
| 638 | ; (setq face (car faces) faces (cdr faces) regions () end (point-min)) | ||
| 639 | ; ;; Make a list of start/end regions with `face' property face. | ||
| 640 | ; (while (setq start (text-property-any end limit 'face face)) | ||
| 641 | ; (setq end (or (text-property-not-all start limit 'face face) limit) | ||
| 642 | ; regions (cons start (cons end regions)))) | ||
| 643 | ; ;; Add `face' face's regions, if any, to properties. | ||
| 644 | ; (when regions | ||
| 645 | ; (push (cons face regions) properties))) | ||
| 646 | ; properties))) | ||
| 647 | |||
| 648 | (defun fast-lock-get-face-properties () | ||
| 649 | "Return a list of `face' text properties in the current buffer. | ||
| 650 | Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) | ||
| 651 | where VALUE is a `face' property value and STARTx and ENDx are positions." | ||
| 652 | (save-restriction | ||
| 653 | (widen) | ||
| 654 | (let ((start (text-property-not-all (point-min) (point-max) 'face nil)) | ||
| 655 | end properties value cell) | ||
| 656 | (while start | ||
| 657 | (setq end (next-single-property-change start 'face nil (point-max)) | ||
| 658 | value (get-text-property start 'face)) | ||
| 659 | ;; Make, or add to existing, list of regions with same `face'. | ||
| 660 | (cond ((setq cell (assoc value properties)) | ||
| 661 | (setcdr cell (cons start (cons end (cdr cell))))) | ||
| 662 | ((fast-lock-save-facep value) | ||
| 663 | (push (list value start end) properties))) | ||
| 664 | (setq start (text-property-not-all end (point-max) 'face nil))) | ||
| 665 | properties))) | ||
| 666 | |||
| 667 | (defun fast-lock-get-syntactic-properties () | ||
| 668 | "Return a list of `syntax-table' text properties in the current buffer. | ||
| 669 | See `fast-lock-get-face-properties'." | ||
| 670 | (save-restriction | ||
| 671 | (widen) | ||
| 672 | (let ((start (text-property-not-all (point-min) (point-max) 'syntax-table | ||
| 673 | nil)) | ||
| 674 | end properties value cell) | ||
| 675 | (while start | ||
| 676 | (setq end (next-single-property-change start 'syntax-table nil | ||
| 677 | (point-max)) | ||
| 678 | value (get-text-property start 'syntax-table)) | ||
| 679 | ;; Make, or add to existing, list of regions with same `syntax-table'. | ||
| 680 | (if (setq cell (assoc value properties)) | ||
| 681 | (setcdr cell (cons start (cons end (cdr cell)))) | ||
| 682 | (push (list value start end) properties)) | ||
| 683 | (setq start (text-property-not-all end (point-max) 'syntax-table nil))) | ||
| 684 | properties))) | ||
| 685 | |||
| 686 | (defun fast-lock-add-properties (syntactic-properties face-properties) | ||
| 687 | "Add `syntax-table' and `face' text properties to the current buffer. | ||
| 688 | Any existing `syntax-table' and `face' text properties are removed first. | ||
| 689 | See `fast-lock-get-face-properties'." | ||
| 690 | (with-silent-modifications | ||
| 691 | (let ((inhibit-point-motion-hooks t)) | ||
| 692 | (save-restriction | ||
| 693 | (widen) | ||
| 694 | (font-lock-unfontify-region (point-min) (point-max)) | ||
| 695 | ;; | ||
| 696 | ;; Set the `syntax-table' property for each start/end region. | ||
| 697 | (pcase-dolist (`(,plist . ,regions) syntactic-properties) | ||
| 698 | (while regions | ||
| 699 | (add-text-properties (nth 0 regions) (nth 1 regions) plist) | ||
| 700 | (setq regions (nthcdr 2 regions)))) | ||
| 701 | ;; | ||
| 702 | ;; Set the `face' property for each start/end region. | ||
| 703 | (pcase-dolist (`(,plist . ,regions) face-properties) | ||
| 704 | (while regions | ||
| 705 | (add-text-properties (nth 0 regions) (nth 1 regions) plist) | ||
| 706 | (setq regions (nthcdr 2 regions)))))))) | ||
| 707 | |||
| 708 | |||
| 709 | ;; Install ourselves: | ||
| 710 | |||
| 711 | (add-hook 'after-save-hook #'fast-lock-save-cache-after-save-file) | ||
| 712 | (add-hook 'kill-buffer-hook #'fast-lock-save-cache-before-kill-buffer) | ||
| 713 | (unless noninteractive | ||
| 714 | (add-hook 'kill-emacs-hook #'fast-lock-save-caches-before-kill-emacs)) | ||
| 715 | |||
| 716 | ;;;###autoload | ||
| 717 | (when (fboundp 'add-minor-mode) | ||
| 718 | (defvar fast-lock-mode nil) | ||
| 719 | (add-minor-mode 'fast-lock-mode nil)) | ||
| 720 | ;;;###dont-autoload | ||
| 721 | (unless (assq 'fast-lock-mode minor-mode-alist) | ||
| 722 | (setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil))))) | ||
| 723 | |||
| 724 | (provide 'fast-lock) | ||
| 725 | |||
| 726 | ;;; fast-lock.el ends here | ||
| 727 | |||
| 728 | ;; Local Variables: | ||
| 729 | ;; byte-compile-warnings: (not obsolete) | ||
| 730 | ;; End: | ||
diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el deleted file mode 100644 index 5c35cb32124..00000000000 --- a/lisp/obsolete/lazy-lock.el +++ /dev/null | |||
| @@ -1,1025 +0,0 @@ | |||
| 1 | ;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 1994-1998, 2001-2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Simon Marshall <simon@gnu.org> | ||
| 6 | ;; Maintainer: emacs-devel@gnu.org | ||
| 7 | ;; Keywords: faces files | ||
| 8 | ;; Version: 2.11 | ||
| 9 | ;; Obsolete-since: 22.1 | ||
| 10 | |||
| 11 | ;; This file is part of GNU Emacs. | ||
| 12 | |||
| 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 14 | ;; it under the terms of the GNU General Public License as published by | ||
| 15 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 16 | ;; (at your option) any later version. | ||
| 17 | |||
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 21 | ;; GNU General Public License for more details. | ||
| 22 | |||
| 23 | ;; You should have received a copy of the GNU General Public License | ||
| 24 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | |||
| 28 | ;; Purpose: | ||
| 29 | ;; | ||
| 30 | ;; Lazy Lock mode is a Font Lock support mode. | ||
| 31 | ;; It makes visiting buffers in Font Lock mode faster by making fontification | ||
| 32 | ;; be demand-driven, deferred and stealthy, so that fontification only occurs | ||
| 33 | ;; when, and where, necessary. | ||
| 34 | ;; | ||
| 35 | ;; See caveats and feedback below. | ||
| 36 | ;; See also the fast-lock package. (But don't use them at the same time!) | ||
| 37 | |||
| 38 | ;; Installation: | ||
| 39 | ;; | ||
| 40 | ;; Put in your ~/.emacs: | ||
| 41 | ;; | ||
| 42 | ;; (setq font-lock-support-mode 'lazy-lock-mode) | ||
| 43 | ;; | ||
| 44 | ;; Start up a new Emacs and use font-lock as usual (except that you can use the | ||
| 45 | ;; so-called "gaudier" fontification regexps on big files without frustration). | ||
| 46 | ;; | ||
| 47 | ;; In a buffer (which has `font-lock-mode' enabled) which is at least | ||
| 48 | ;; `lazy-lock-minimum-size' characters long, buffer fontification will not | ||
| 49 | ;; occur and only the visible portion of the buffer will be fontified. Motion | ||
| 50 | ;; around the buffer will fontify those visible portions not previously | ||
| 51 | ;; fontified. If stealth fontification is enabled, buffer fontification will | ||
| 52 | ;; occur in invisible parts of the buffer after `lazy-lock-stealth-time' | ||
| 53 | ;; seconds of idle time. If on-the-fly fontification is deferred, on-the-fly | ||
| 54 | ;; fontification will occur after `lazy-lock-defer-time' seconds of idle time. | ||
| 55 | |||
| 56 | ;; User-visible differences with version 1: | ||
| 57 | ;; | ||
| 58 | ;; - Version 2 can defer on-the-fly fontification. Therefore you need not, and | ||
| 59 | ;; should not, use defer-lock.el with this version of lazy-lock.el. | ||
| 60 | ;; | ||
| 61 | ;; A number of variables have changed meaning: | ||
| 62 | ;; | ||
| 63 | ;; - A value of nil for the variable `lazy-lock-minimum-size' means never turn | ||
| 64 | ;; on demand-driven fontification. In version 1 this meant always turn on | ||
| 65 | ;; demand-driven fontification. If you really want demand-driven fontification | ||
| 66 | ;; regardless of buffer size, set this variable to 0. | ||
| 67 | ;; | ||
| 68 | ;; - The variable `lazy-lock-stealth-lines' cannot have a nil value. In | ||
| 69 | ;; version 1 this meant use `window-height' as the maximum number of lines to | ||
| 70 | ;; fontify as a stealth chunk. This makes no sense; stealth fontification is | ||
| 71 | ;; of a buffer, not a window. | ||
| 72 | |||
| 73 | ;; Implementation differences with version 1: | ||
| 74 | ;; | ||
| 75 | ;; - Version 1 of lazy-lock.el is a bit of a hack. Version 1 demand-driven | ||
| 76 | ;; fontification, the core feature of lazy-lock.el, is implemented by placing a | ||
| 77 | ;; function on `post-command-hook'. This function fontifies where necessary, | ||
| 78 | ;; i.e., where a window scroll has occurred. However, there are a number of | ||
| 79 | ;; problems with using `post-command-hook': | ||
| 80 | ;; | ||
| 81 | ;; (a) As the name suggests, `post-command-hook' is run after every command, | ||
| 82 | ;; i.e., frequently and regardless of whether scrolling has occurred. | ||
| 83 | ;; (b) Scrolling can occur during a command, when `post-command-hook' is not | ||
| 84 | ;; run, i.e., it is not necessarily run after scrolling has occurred. | ||
| 85 | ;; (c) When `post-command-hook' is run, there is nothing to suggest where | ||
| 86 | ;; scrolling might have occurred, i.e., which windows have scrolled. | ||
| 87 | ;; | ||
| 88 | ;; Thus lazy-lock.el's function is called almost as often as possible, usually | ||
| 89 | ;; when it need not be called, yet it is not always called when it is needed. | ||
| 90 | ;; Also, lazy-lock.el's function must check each window to see if a scroll has | ||
| 91 | ;; occurred there. Worse still, lazy-lock.el's function must fontify a region | ||
| 92 | ;; twice as large as necessary to make sure the window is completely fontified. | ||
| 93 | ;; Basically, `post-command-hook' is completely inappropriate for lazy-lock.el. | ||
| 94 | ;; | ||
| 95 | ;; Ideally, we want to attach lazy-lock.el's function to a hook that is run | ||
| 96 | ;; only when scrolling occurs, e.g., `window-start' has changed, and tells us | ||
| 97 | ;; as much information as we need, i.e., the window and its new buffer region. | ||
| 98 | ;; Richard Stallman implemented a `window-scroll-functions' for Emacs 19.30. | ||
| 99 | ;; Functions on it are run when `window-start' has changed, and are supplied | ||
| 100 | ;; with the window and the window's new `window-start' position. (It would be | ||
| 101 | ;; better if it also supplied the window's new `window-end' position, but that | ||
| 102 | ;; is calculated as part of the redisplay process, and the functions on | ||
| 103 | ;; `window-scroll-functions' are run before redisplay has finished.) Thus, the | ||
| 104 | ;; hook deals with the above problems (a), (b) and (c). | ||
| 105 | ;; | ||
| 106 | ;; If only life was that easy. Version 2 demand-driven fontification is mostly | ||
| 107 | ;; implemented by placing a function on `window-scroll-functions'. However, | ||
| 108 | ;; not all scrolling occurs when `window-start' has changed. A change in | ||
| 109 | ;; window size, e.g., via C-x 1, or a significant deletion, e.g., of a number | ||
| 110 | ;; of lines, causes text previously invisible (i.e., after `window-end') to | ||
| 111 | ;; become visible without changing `window-start'. Arguably, these events are | ||
| 112 | ;; not scrolling events, but fontification must occur for lazy-lock.el to work. | ||
| 113 | ;; Hooks `window-size-change-functions' and `redisplay-end-trigger-functions' | ||
| 114 | ;; were added for these circumstances. | ||
| 115 | ;; | ||
| 116 | ;; (Ben Wing thinks these hooks are "horribly horribly kludgy", and implemented | ||
| 117 | ;; a `pre-idle-hook', a `mother-of-all-post-command-hooks', for XEmacs 19.14. | ||
| 118 | ;; He then hacked up a version 1 lazy-lock.el to use `pre-idle-hook' rather | ||
| 119 | ;; than `post-command-hook'. Whereas functions on `post-command-hook' are | ||
| 120 | ;; called almost as often as possible, functions on `pre-idle-hook' really are | ||
| 121 | ;; called as often as possible, even when the mouse moves and, on some systems, | ||
| 122 | ;; while XEmacs is idle. Thus, the hook deals with the above problem (b), but | ||
| 123 | ;; unfortunately it makes (a) worse and does not address (c) at all. | ||
| 124 | ;; | ||
| 125 | ;; I freely admit that `redisplay-end-trigger-functions' and, to a much lesser | ||
| 126 | ;; extent, `window-size-change-functions' are not pretty. However, I feel that | ||
| 127 | ;; a `window-scroll-functions' feature is cleaner than a `pre-idle-hook', and | ||
| 128 | ;; the result is faster and smaller, less intrusive and more targeted, code. | ||
| 129 | ;; Since `pre-idle-hook' is pretty much like `post-command-hook', there is no | ||
| 130 | ;; point in making this version of lazy-lock.el work with it. Anyway, that's | ||
| 131 | ;; Lit 30 of my humble opinion. | ||
| 132 | ;; | ||
| 133 | ;; - Version 1 stealth fontification is also implemented by placing a function | ||
| 134 | ;; on `post-command-hook'. This function waits for a given amount of time, | ||
| 135 | ;; and, if Emacs remains idle, fontifies where necessary. Again, there are a | ||
| 136 | ;; number of problems with using `post-command-hook': | ||
| 137 | ;; | ||
| 138 | ;; (a) Functions on `post-command-hook' are run sequentially, so this function | ||
| 139 | ;; can interfere with other functions on the hook, and vice versa. | ||
| 140 | ;; (b) This function waits for a given amount of time, so it can interfere with | ||
| 141 | ;; various features that are dealt with by Emacs after a command, e.g., | ||
| 142 | ;; region highlighting, asynchronous updating and keystroke echoing. | ||
| 143 | ;; (c) Fontification may be required during a command, when `post-command-hook' | ||
| 144 | ;; is not run. (Version 2 deferred fontification only.) | ||
| 145 | ;; | ||
| 146 | ;; Again, `post-command-hook' is completely inappropriate for lazy-lock.el. | ||
| 147 | ;; Richard Stallman and Morten Welinder implemented internal Timers and Idle | ||
| 148 | ;; Timers for Emacs 19.31. Functions can be run independently at given times | ||
| 149 | ;; or after given amounts of idle time. Thus, the feature deals with the above | ||
| 150 | ;; problems (a), (b) and (c). Version 2 deferral and stealth are implemented | ||
| 151 | ;; by functions on Idle Timers. (A function on XEmacs' `pre-idle-hook' is | ||
| 152 | ;; similar to an Emacs Idle Timer function with a fixed zero second timeout.) | ||
| 153 | |||
| 154 | ;; - Version 1 has the following problems (relative to version 2): | ||
| 155 | ;; | ||
| 156 | ;; (a) It is slow when it does its job. | ||
| 157 | ;; (b) It does not always do its job when it should. | ||
| 158 | ;; (c) It slows all interaction (when it doesn't need to do its job). | ||
| 159 | ;; (d) It interferes with other package functions on `post-command-hook'. | ||
| 160 | ;; (e) It interferes with Emacs things within the read-eval loop. | ||
| 161 | ;; | ||
| 162 | ;; Ben's hacked-up lazy-lock.el 1.14 almost solved (b) but made (c) worse. | ||
| 163 | ;; | ||
| 164 | ;; - Version 2 has the following additional features (relative to version 1): | ||
| 165 | ;; | ||
| 166 | ;; (a) It can defer fontification (both on-the-fly and on-scrolling). | ||
| 167 | ;; (b) It can fontify contextually (syntactically true on-the-fly). | ||
| 168 | |||
| 169 | ;; Caveats: | ||
| 170 | ;; | ||
| 171 | ;; Lazy Lock mode does not work efficiently with Outline mode. | ||
| 172 | ;; This is because when in Outline mode, although text may be not visible to | ||
| 173 | ;; you in the window, the text is visible to Emacs Lisp code (not surprisingly) | ||
| 174 | ;; and Lazy Lock fontifies it mercilessly. Maybe it will be fixed one day. | ||
| 175 | ;; | ||
| 176 | ;; Because buffer text is not necessarily fontified, other packages that expect | ||
| 177 | ;; buffer text to be fontified in Font Lock mode either might not work as | ||
| 178 | ;; expected, or might not display buffer text as expected. An example of the | ||
| 179 | ;; latter is `occur', which copies lines of buffer text into another buffer. | ||
| 180 | ;; | ||
| 181 | ;; In Emacs 19.30, Lazy Lock mode does not ensure that an existing buffer is | ||
| 182 | ;; fontified if it is made visible via a minibuffer-less command that replaces | ||
| 183 | ;; an existing window's buffer (e.g., via the Buffers menu). Upgrade! | ||
| 184 | ;; | ||
| 185 | ;; In Emacs 19.30, Lazy Lock mode does not work well with Transient Mark mode | ||
| 186 | ;; or modes based on Comint mode (e.g., Shell mode), and also interferes with | ||
| 187 | ;; the echoing of keystrokes in the minibuffer. This is because of the way | ||
| 188 | ;; deferral and stealth have to be implemented for Emacs 19.30. Upgrade! | ||
| 189 | ;; | ||
| 190 | ;; Currently XEmacs does not have the features to support this version of | ||
| 191 | ;; lazy-lock.el. Maybe it will one day. | ||
| 192 | |||
| 193 | ;; History: | ||
| 194 | ;; | ||
| 195 | ;; 1.15--2.00: | ||
| 196 | ;; - Rewrite for Emacs 19.30 and the features rms added to support lazy-lock.el | ||
| 197 | ;; so that it could work correctly and efficiently. | ||
| 198 | ;; - Many thanks to those who reported bugs, fixed bugs, made suggestions or | ||
| 199 | ;; otherwise contributed in the version 1 cycle; Jari Aalto, Kevin Broadey, | ||
| 200 | ;; Ulrik Dickow, Bill Dubuque, Bob Glickstein, Boris Goldowsky, | ||
| 201 | ;; Jonas Jarnestrom, David Karr, Michael Kifer, Erik Naggum, Rick Sladkey, | ||
| 202 | ;; Jim Thompson, Ben Wing, Ilya Zakharevich, and Richard Stallman. | ||
| 203 | ;; 2.00--2.01: | ||
| 204 | ;; - Made `lazy-lock-fontify-after-command' always `sit-for' and so redisplay | ||
| 205 | ;; - Use `buffer-name' not `buffer-live-p' (Bill Dubuque hint) | ||
| 206 | ;; - Made `lazy-lock-install' do `add-to-list' not `setq' of `current-buffer' | ||
| 207 | ;; - Made `lazy-lock-fontify-after-install' loop over buffer list | ||
| 208 | ;; - Made `lazy-lock-arrange-before-change' to arrange `window-end' triggering | ||
| 209 | ;; - Made `lazy-lock-let-buffer-state' wrap both `befter-change-functions' | ||
| 210 | ;; - Made `lazy-lock-fontify-region' do `condition-case' (Hyman Rosen report) | ||
| 211 | ;; 2.01--2.02: | ||
| 212 | ;; - Use `buffer-live-p' as `buffer-name' can barf (Richard Stanton report) | ||
| 213 | ;; - Made `lazy-lock-install' set `font-lock-fontified' (Kevin Davidson report) | ||
| 214 | ;; - Made `lazy-lock-install' add hooks only if needed | ||
| 215 | ;; - Made `lazy-lock-unstall' add `font-lock-after-change-function' if needed | ||
| 216 | ;; 2.02--2.03: | ||
| 217 | ;; - Made `lazy-lock-fontify-region' do `condition-case' for `quit' too | ||
| 218 | ;; - Made `lazy-lock-mode' respect the value of `font-lock-inhibit-thing-lock' | ||
| 219 | ;; - Added `lazy-lock-after-unfontify-buffer' | ||
| 220 | ;; - Removed `lazy-lock-fontify-after-install' hack | ||
| 221 | ;; - Made `lazy-lock-fontify-after-scroll' not `set-buffer' to `window-buffer' | ||
| 222 | ;; - Made `lazy-lock-fontify-after-trigger' not `set-buffer' to `window-buffer' | ||
| 223 | ;; - Made `lazy-lock-fontify-after-idle' be interruptible (Scott Burson hint) | ||
| 224 | ;; 2.03--2.04: | ||
| 225 | ;; - Rewrite for Emacs 19.31 idle timers | ||
| 226 | ;; - Renamed `buffer-windows' to `get-buffer-window-list' | ||
| 227 | ;; - Removed `buffer-live-p' | ||
| 228 | ;; - Made `lazy-lock-defer-after-change' always save `current-buffer' | ||
| 229 | ;; - Made `lazy-lock-fontify-after-defer' just process buffers | ||
| 230 | ;; - Made `lazy-lock-install-hooks' add hooks correctly (Kevin Broadey report) | ||
| 231 | ;; - Made `lazy-lock-install' cope if `lazy-lock-defer-time' is a list | ||
| 232 | ;; 2.04--2.05: | ||
| 233 | ;; - Rewrite for Common Lisp macros | ||
| 234 | ;; - Added `do-while' macro | ||
| 235 | ;; - Renamed `lazy-lock-let-buffer-state' macro to `save-buffer-state' | ||
| 236 | ;; - Returned `lazy-lock-fontify-after-install' hack (Darren Hall hint) | ||
| 237 | ;; - Added `lazy-lock-defer-on-scrolling' functionality (Scott Byer hint) | ||
| 238 | ;; - Made `lazy-lock-mode' wrap `font-lock-support-mode' | ||
| 239 | ;; 2.05--2.06: | ||
| 240 | ;; - Made `lazy-lock-fontify-after-defer' swap correctly (Scott Byer report) | ||
| 241 | ;; 2.06--2.07: | ||
| 242 | ;; - Added `lazy-lock-stealth-load' functionality (Rob Hooft hint) | ||
| 243 | ;; - Made `lazy-lock-unstall' call `lazy-lock-fontify-region' if needed | ||
| 244 | ;; - Made `lazy-lock-mode' call `lazy-lock-unstall' only if needed | ||
| 245 | ;; - Made `lazy-lock-defer-after-scroll' do `set-window-redisplay-end-trigger' | ||
| 246 | ;; - Added `lazy-lock-defer-contextually' functionality | ||
| 247 | ;; - Added `lazy-lock-defer-on-the-fly' from `lazy-lock-defer-time' | ||
| 248 | ;; - Renamed `lazy-lock-defer-driven' to `lazy-lock-defer-on-scrolling' | ||
| 249 | ;; - Removed `lazy-lock-submit-bug-report' and bade farewell | ||
| 250 | ;; 2.07--2.08: | ||
| 251 | ;; - Made `lazy-lock-fontify-conservatively' fontify around `window-point' | ||
| 252 | ;; - Made `save-buffer-state' wrap `inhibit-point-motion-hooks' | ||
| 253 | ;; - Added Custom support | ||
| 254 | ;; 2.08--2.09: | ||
| 255 | ;; - Removed `byte-*' variables from `eval-when-compile' (Erik Naggum hint) | ||
| 256 | ;; - Made various wrapping `inhibit-point-motion-hooks' (Vinicius Latorre hint) | ||
| 257 | ;; - Made `lazy-lock-fontify-after-idle' wrap `minibuffer-auto-raise' | ||
| 258 | ;; - Made `lazy-lock-fontify-after-defer' paranoid about deferred buffers | ||
| 259 | ;; 2.09--2.10: | ||
| 260 | ;; - Use `window-end' UPDATE arg for Emacs 20.4 and later. | ||
| 261 | ;; - Made deferral `widen' before unfontifying (Dan Nicolaescu report) | ||
| 262 | ;; - Use `lazy-lock-fontify-after-visage' for hideshow.el (Dan Nicolaescu hint) | ||
| 263 | ;; - Use `other' widget where possible (Andreas Schwab fix) | ||
| 264 | ;; 2.10--2.11: | ||
| 265 | ;; - Used `with-temp-message' where possible to make messages temporary. | ||
| 266 | |||
| 267 | ;;; Code: | ||
| 268 | |||
| 269 | (require 'font-lock) | ||
| 270 | (eval-when-compile (require 'cl-lib)) | ||
| 271 | |||
| 272 | (eval-when-compile | ||
| 273 | ;; | ||
| 274 | ;; We use this for clarity and speed. Naughty but nice. | ||
| 275 | (defmacro do-while (test &rest body) | ||
| 276 | "(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil. | ||
| 277 | The order of execution is thus BODY, TEST, BODY, TEST and so on | ||
| 278 | until TEST returns nil." | ||
| 279 | (declare (indent 1) (debug t)) | ||
| 280 | `(while (progn ,@body ,test)))) | ||
| 281 | |||
| 282 | (defgroup lazy-lock nil | ||
| 283 | "Font Lock support mode to fontify lazily." | ||
| 284 | :group 'font-lock) | ||
| 285 | |||
| 286 | (defvar lazy-lock-mode nil) ; Whether we are turned on. | ||
| 287 | (defvar lazy-lock-buffers nil) ; For deferral. | ||
| 288 | (defvar lazy-lock-timers (cons nil nil)) ; For deferral and stealth. | ||
| 289 | |||
| 290 | ;; User Variables: | ||
| 291 | |||
| 292 | (defcustom lazy-lock-minimum-size 25600 | ||
| 293 | "Minimum size of a buffer for demand-driven fontification. | ||
| 294 | On-demand fontification occurs if the buffer size is greater than this value. | ||
| 295 | If nil, means demand-driven fontification is never performed. | ||
| 296 | If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), | ||
| 297 | where MAJOR-MODE is a symbol or t (meaning the default). For example: | ||
| 298 | ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576)) | ||
| 299 | means that the minimum size is 25K for buffers in C or C++ modes, one megabyte | ||
| 300 | for buffers in Rmail mode, and size is irrelevant otherwise. | ||
| 301 | |||
| 302 | The value of this variable is used when Lazy Lock mode is turned on." | ||
| 303 | :type '(choice (const :tag "none" nil) | ||
| 304 | (integer :tag "size") | ||
| 305 | (repeat :menu-tag "mode specific" :tag "mode specific" | ||
| 306 | :value ((t . nil)) | ||
| 307 | (cons :tag "Instance" | ||
| 308 | (radio :tag "Mode" | ||
| 309 | (const :tag "all" t) | ||
| 310 | (symbol :tag "name")) | ||
| 311 | (radio :tag "Size" | ||
| 312 | (const :tag "none" nil) | ||
| 313 | (integer :tag "size")))))) | ||
| 314 | |||
| 315 | (defcustom lazy-lock-defer-on-the-fly t | ||
| 316 | "If non-nil, means fontification after a change should be deferred. | ||
| 317 | If nil, means on-the-fly fontification is performed. This means when changes | ||
| 318 | occur in the buffer, those areas are immediately fontified. | ||
| 319 | If a list, it should be a list of `major-mode' symbol names for which deferred | ||
| 320 | fontification should occur. The sense of the list is negated if it begins with | ||
| 321 | `not'. For example: | ||
| 322 | (c-mode c++-mode) | ||
| 323 | means that on-the-fly fontification is deferred for buffers in C and C++ modes | ||
| 324 | only, and deferral does not occur otherwise. | ||
| 325 | |||
| 326 | The value of this variable is used when Lazy Lock mode is turned on." | ||
| 327 | :type '(choice (const :tag "never" nil) | ||
| 328 | (const :tag "always" t) | ||
| 329 | (set :menu-tag "mode specific" :tag "modes" | ||
| 330 | :value (not) | ||
| 331 | (const :tag "Except" not) | ||
| 332 | (repeat :inline t (symbol :tag "mode"))))) | ||
| 333 | |||
| 334 | (defcustom lazy-lock-defer-on-scrolling nil | ||
| 335 | "If non-nil, means fontification after a scroll should be deferred. | ||
| 336 | If nil, means demand-driven fontification is performed. This means when | ||
| 337 | scrolling into unfontified areas of the buffer, those areas are immediately | ||
| 338 | fontified. Thus scrolling never presents unfontified areas. However, since | ||
| 339 | fontification occurs during scrolling, scrolling may be slow. | ||
| 340 | If t, means defer-driven fontification is performed. This means fontification | ||
| 341 | of those areas is deferred. Thus scrolling may present momentarily unfontified | ||
| 342 | areas. However, since fontification does not occur during scrolling, scrolling | ||
| 343 | will be faster than demand-driven fontification. | ||
| 344 | If any other value, e.g., `eventually', means demand-driven fontification is | ||
| 345 | performed until the buffer is fontified, then buffer fontification becomes | ||
| 346 | defer-driven. Thus scrolling never presents unfontified areas until the buffer | ||
| 347 | is first fontified, after which subsequent scrolling may present future buffer | ||
| 348 | insertions momentarily unfontified. However, since fontification does not | ||
| 349 | occur during scrolling after the buffer is first fontified, scrolling will | ||
| 350 | become faster. (But, since contextual changes continually occur, such a value | ||
| 351 | makes little sense if `lazy-lock-defer-contextually' is non-nil.) | ||
| 352 | |||
| 353 | The value of this variable is used when Lazy Lock mode is turned on." | ||
| 354 | :type '(choice (const :tag "never" nil) | ||
| 355 | (const :tag "always" t) | ||
| 356 | (other :tag "eventually" eventually))) | ||
| 357 | |||
| 358 | (defcustom lazy-lock-defer-contextually 'syntax-driven | ||
| 359 | "If non-nil, means deferred fontification should be syntactically true. | ||
| 360 | If nil, means deferred fontification occurs only on those lines modified. This | ||
| 361 | means where modification on a line causes syntactic change on subsequent lines, | ||
| 362 | those subsequent lines are not refontified to reflect their new context. | ||
| 363 | If t, means deferred fontification occurs on those lines modified and all | ||
| 364 | subsequent lines. This means those subsequent lines are refontified to reflect | ||
| 365 | their new syntactic context, either immediately or when scrolling into them. | ||
| 366 | If any other value, e.g., `syntax-driven', means deferred syntactically true | ||
| 367 | fontification occurs only if syntactic fontification is performed using the | ||
| 368 | buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil. | ||
| 369 | |||
| 370 | The value of this variable is used when Lazy Lock mode is turned on." | ||
| 371 | :type '(choice (const :tag "never" nil) | ||
| 372 | (const :tag "always" t) | ||
| 373 | (other :tag "syntax-driven" syntax-driven))) | ||
| 374 | |||
| 375 | (defcustom lazy-lock-defer-time 0.25 | ||
| 376 | "Time in seconds to delay before beginning deferred fontification. | ||
| 377 | Deferred fontification occurs if there is no input within this time. | ||
| 378 | If nil, means fontification is never deferred, regardless of the values of the | ||
| 379 | variables `lazy-lock-defer-on-the-fly', `lazy-lock-defer-on-scrolling' and | ||
| 380 | `lazy-lock-defer-contextually'. | ||
| 381 | |||
| 382 | The value of this variable is used when Lazy Lock mode is turned on." | ||
| 383 | :type '(choice (const :tag "never" nil) | ||
| 384 | (number :tag "seconds"))) | ||
| 385 | |||
| 386 | (defcustom lazy-lock-stealth-time 30 | ||
| 387 | "Time in seconds to delay before beginning stealth fontification. | ||
| 388 | Stealth fontification occurs if there is no input within this time. | ||
| 389 | If nil, means stealth fontification is never performed. | ||
| 390 | |||
| 391 | The value of this variable is used when Lazy Lock mode is turned on." | ||
| 392 | :type '(choice (const :tag "never" nil) | ||
| 393 | (number :tag "seconds"))) | ||
| 394 | |||
| 395 | (defcustom lazy-lock-stealth-lines (if font-lock-maximum-decoration 100 250) | ||
| 396 | "Maximum size of a chunk of stealth fontification. | ||
| 397 | Each iteration of stealth fontification can fontify this number of lines. | ||
| 398 | To speed up input response during stealth fontification, at the cost of stealth | ||
| 399 | taking longer to fontify, you could reduce the value of this variable." | ||
| 400 | :type '(integer :tag "lines")) | ||
| 401 | |||
| 402 | (defcustom lazy-lock-stealth-load | ||
| 403 | (if (condition-case nil (load-average) (error)) 200) | ||
| 404 | "Load in percentage above which stealth fontification is suspended. | ||
| 405 | Stealth fontification pauses when the system short-term load average (as | ||
| 406 | returned by the function `load-average' if supported) goes above this level, | ||
| 407 | thus reducing the demand that stealth fontification makes on the system. | ||
| 408 | If nil, means stealth fontification is never suspended. | ||
| 409 | To reduce machine load during stealth fontification, at the cost of stealth | ||
| 410 | taking longer to fontify, you could reduce the value of this variable. | ||
| 411 | See also `lazy-lock-stealth-nice'." | ||
| 412 | :type (if (condition-case nil (load-average) (error)) | ||
| 413 | '(choice (const :tag "never" nil) | ||
| 414 | (integer :tag "load")) | ||
| 415 | '(const :format "%t: unsupported\n" nil))) | ||
| 416 | |||
| 417 | (defcustom lazy-lock-stealth-nice 0.125 | ||
| 418 | "Time in seconds to pause between chunks of stealth fontification. | ||
| 419 | Each iteration of stealth fontification is separated by this amount of time, | ||
| 420 | thus reducing the demand that stealth fontification makes on the system. | ||
| 421 | If nil, means stealth fontification is never paused. | ||
| 422 | To reduce machine load during stealth fontification, at the cost of stealth | ||
| 423 | taking longer to fontify, you could increase the value of this variable. | ||
| 424 | See also `lazy-lock-stealth-load'." | ||
| 425 | :type '(choice (const :tag "never" nil) | ||
| 426 | (number :tag "seconds"))) | ||
| 427 | |||
| 428 | (defcustom lazy-lock-stealth-verbose | ||
| 429 | (and (not lazy-lock-defer-contextually) (not (null font-lock-verbose))) | ||
| 430 | "If non-nil, means stealth fontification should show status messages." | ||
| 431 | :type 'boolean) | ||
| 432 | |||
| 433 | ;; User Functions: | ||
| 434 | |||
| 435 | ;;;###autoload | ||
| 436 | (defun lazy-lock-mode (&optional arg) | ||
| 437 | "Toggle Lazy Lock mode. | ||
| 438 | With arg, turn Lazy Lock mode on if and only if arg is positive. Enable it | ||
| 439 | automatically in your `~/.emacs' by: | ||
| 440 | |||
| 441 | (setq font-lock-support-mode \\='lazy-lock-mode) | ||
| 442 | |||
| 443 | For a newer font-lock support mode with similar functionality, see | ||
| 444 | `jit-lock-mode'. Eventually, Lazy Lock mode will be deprecated in | ||
| 445 | JIT Lock's favor. | ||
| 446 | |||
| 447 | When Lazy Lock mode is enabled, fontification can be lazy in a number of ways: | ||
| 448 | |||
| 449 | - Demand-driven buffer fontification if `lazy-lock-minimum-size' is non-nil. | ||
| 450 | This means initial fontification does not occur if the buffer is greater than | ||
| 451 | `lazy-lock-minimum-size' characters in length. Instead, fontification occurs | ||
| 452 | when necessary, such as when scrolling through the buffer would otherwise | ||
| 453 | reveal unfontified areas. This is useful if buffer fontification is too slow | ||
| 454 | for large buffers. | ||
| 455 | |||
| 456 | - Deferred scroll fontification if `lazy-lock-defer-on-scrolling' is non-nil. | ||
| 457 | This means demand-driven fontification does not occur as you scroll. | ||
| 458 | Instead, fontification is deferred until after `lazy-lock-defer-time' seconds | ||
| 459 | of Emacs idle time, while Emacs remains idle. This is useful if | ||
| 460 | fontification is too slow to keep up with scrolling. | ||
| 461 | |||
| 462 | - Deferred on-the-fly fontification if `lazy-lock-defer-on-the-fly' is non-nil. | ||
| 463 | This means on-the-fly fontification does not occur as you type. Instead, | ||
| 464 | fontification is deferred until after `lazy-lock-defer-time' seconds of Emacs | ||
| 465 | idle time, while Emacs remains idle. This is useful if fontification is too | ||
| 466 | slow to keep up with your typing. | ||
| 467 | |||
| 468 | - Deferred context fontification if `lazy-lock-defer-contextually' is non-nil. | ||
| 469 | This means fontification updates the buffer corresponding to true syntactic | ||
| 470 | context, after `lazy-lock-defer-time' seconds of Emacs idle time, while Emacs | ||
| 471 | remains idle. Otherwise, fontification occurs on modified lines only, and | ||
| 472 | subsequent lines can remain fontified corresponding to previous syntactic | ||
| 473 | contexts. This is useful where strings or comments span lines. | ||
| 474 | |||
| 475 | - Stealthy buffer fontification if `lazy-lock-stealth-time' is non-nil. | ||
| 476 | This means remaining unfontified areas of buffers are fontified if Emacs has | ||
| 477 | been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle. | ||
| 478 | This is useful if any buffer has any deferred fontification. | ||
| 479 | |||
| 480 | Basic Font Lock mode on-the-fly fontification behavior fontifies modified | ||
| 481 | lines only. Thus, if `lazy-lock-defer-contextually' is non-nil, Lazy Lock mode | ||
| 482 | on-the-fly fontification may fontify differently, albeit correctly. In any | ||
| 483 | event, to refontify some lines you can use \\[font-lock-fontify-block]. | ||
| 484 | |||
| 485 | Stealth fontification only occurs while the system remains unloaded. | ||
| 486 | If the system load rises above `lazy-lock-stealth-load' percent, stealth | ||
| 487 | fontification is suspended. Stealth fontification intensity is controlled via | ||
| 488 | the variable `lazy-lock-stealth-nice' and `lazy-lock-stealth-lines', and | ||
| 489 | verbosity is controlled via the variable `lazy-lock-stealth-verbose'." | ||
| 490 | (interactive "P") | ||
| 491 | (let* ((was-on lazy-lock-mode) | ||
| 492 | (now-on (unless (memq 'lazy-lock-mode font-lock-inhibit-thing-lock) | ||
| 493 | (if arg (> (prefix-numeric-value arg) 0) (not was-on))))) | ||
| 494 | (cond ((and now-on (not font-lock-mode)) | ||
| 495 | ;; Turned on `lazy-lock-mode' rather than `font-lock-mode'. | ||
| 496 | (message "Use font-lock-support-mode rather than calling lazy-lock-mode") | ||
| 497 | (sit-for 2)) | ||
| 498 | (now-on | ||
| 499 | ;; Turn ourselves on. | ||
| 500 | (set (make-local-variable 'lazy-lock-mode) t) | ||
| 501 | (lazy-lock-install)) | ||
| 502 | (was-on | ||
| 503 | ;; Turn ourselves off. | ||
| 504 | (set (make-local-variable 'lazy-lock-mode) nil) | ||
| 505 | (lazy-lock-unstall))))) | ||
| 506 | |||
| 507 | ;;;###autoload | ||
| 508 | (defun turn-on-lazy-lock () | ||
| 509 | "Unconditionally turn on Lazy Lock mode." | ||
| 510 | (lazy-lock-mode t)) | ||
| 511 | |||
| 512 | (defun lazy-lock-install () | ||
| 513 | (let ((min-size (font-lock-value-in-major-mode lazy-lock-minimum-size)) | ||
| 514 | (defer-change (and lazy-lock-defer-time lazy-lock-defer-on-the-fly)) | ||
| 515 | (defer-scroll (and lazy-lock-defer-time lazy-lock-defer-on-scrolling)) | ||
| 516 | (defer-context (and lazy-lock-defer-time lazy-lock-defer-contextually | ||
| 517 | (or (eq lazy-lock-defer-contextually t) | ||
| 518 | (null font-lock-keywords-only))))) | ||
| 519 | ;; | ||
| 520 | ;; Tell Font Lock whether Lazy Lock will do fontification. | ||
| 521 | (make-local-variable 'font-lock-fontified) | ||
| 522 | (setq font-lock-fontified (and min-size (>= (buffer-size) min-size))) | ||
| 523 | ;; | ||
| 524 | ;; Add the text properties and fontify. | ||
| 525 | (if (not font-lock-fontified) | ||
| 526 | (lazy-lock-after-fontify-buffer) | ||
| 527 | ;; Make sure we fontify in any existing windows showing the buffer. | ||
| 528 | (let ((windows (get-buffer-window-list (current-buffer) 'nomini t))) | ||
| 529 | (lazy-lock-after-unfontify-buffer) | ||
| 530 | (while windows | ||
| 531 | (lazy-lock-fontify-conservatively (car windows)) | ||
| 532 | (setq windows (cdr windows))))) | ||
| 533 | ;; | ||
| 534 | ;; Add the fontification hooks. | ||
| 535 | (lazy-lock-install-hooks | ||
| 536 | font-lock-fontified | ||
| 537 | (cond ((eq (car-safe defer-change) 'not) | ||
| 538 | (not (memq major-mode (cdr defer-change)))) | ||
| 539 | ((listp defer-change) | ||
| 540 | (memq major-mode defer-change)) | ||
| 541 | (t | ||
| 542 | defer-change)) | ||
| 543 | (eq defer-scroll t) | ||
| 544 | defer-context) | ||
| 545 | ;; | ||
| 546 | ;; Add the fontification timers. | ||
| 547 | (lazy-lock-install-timers | ||
| 548 | (if (or defer-change defer-scroll defer-context) lazy-lock-defer-time) | ||
| 549 | lazy-lock-stealth-time))) | ||
| 550 | |||
| 551 | (defun lazy-lock-install-hooks (fontifying | ||
| 552 | defer-change defer-scroll defer-context) | ||
| 553 | ;; | ||
| 554 | ;; Add hook if lazy-lock.el is fontifying on scrolling or is deferring. | ||
| 555 | (when (or fontifying defer-change defer-scroll defer-context) | ||
| 556 | (add-hook 'window-scroll-functions (if defer-scroll | ||
| 557 | #'lazy-lock-defer-after-scroll | ||
| 558 | #'lazy-lock-fontify-after-scroll) | ||
| 559 | nil t)) | ||
| 560 | ;; | ||
| 561 | ;; Add hook if lazy-lock.el is fontifying and is not deferring changes. | ||
| 562 | (when (and fontifying (not defer-change) (not defer-context)) | ||
| 563 | (add-hook 'before-change-functions #'lazy-lock-arrange-before-change nil t)) | ||
| 564 | ;; | ||
| 565 | ;; Replace Font Lock mode hook. | ||
| 566 | (remove-hook 'after-change-functions #'font-lock-after-change-function t) | ||
| 567 | (add-hook 'after-change-functions | ||
| 568 | (cond ((and defer-change defer-context) | ||
| 569 | #'lazy-lock-defer-rest-after-change) | ||
| 570 | (defer-change | ||
| 571 | #'lazy-lock-defer-line-after-change) | ||
| 572 | (defer-context | ||
| 573 | #'lazy-lock-fontify-rest-after-change) | ||
| 574 | (t | ||
| 575 | #'lazy-lock-fontify-line-after-change)) | ||
| 576 | nil t) | ||
| 577 | ;; | ||
| 578 | ;; Add package-specific hook. | ||
| 579 | (add-hook 'outline-view-change-hook #'lazy-lock-fontify-after-visage nil t) | ||
| 580 | (add-hook 'hs-hide-hook #'lazy-lock-fontify-after-visage nil t)) | ||
| 581 | |||
| 582 | (defun lazy-lock-install-timers (dtime stime) | ||
| 583 | ;; Schedule or re-schedule the deferral and stealth timers. | ||
| 584 | ;; The layout of `lazy-lock-timers' is: | ||
| 585 | ;; ((DEFER-TIME . DEFER-TIMER) (STEALTH-TIME . STEALTH-TIMER) | ||
| 586 | ;; If an idle timeout has changed, cancel the existing idle timer (if there | ||
| 587 | ;; is one) and schedule a new one (if the new idle timeout is non-nil). | ||
| 588 | (unless (eq dtime (car (car lazy-lock-timers))) | ||
| 589 | (let ((defer (car lazy-lock-timers))) | ||
| 590 | (when (cdr defer) | ||
| 591 | (cancel-timer (cdr defer))) | ||
| 592 | (setcar lazy-lock-timers (cons dtime (and dtime | ||
| 593 | (run-with-idle-timer dtime t #'lazy-lock-fontify-after-defer)))))) | ||
| 594 | (unless (eq stime (car (cdr lazy-lock-timers))) | ||
| 595 | (let ((stealth (cdr lazy-lock-timers))) | ||
| 596 | (when (cdr stealth) | ||
| 597 | (cancel-timer (cdr stealth))) | ||
| 598 | (setcdr lazy-lock-timers (cons stime (and stime | ||
| 599 | (run-with-idle-timer stime t #'lazy-lock-fontify-after-idle))))))) | ||
| 600 | |||
| 601 | (defun lazy-lock-unstall () | ||
| 602 | ;; | ||
| 603 | ;; If Font Lock mode is still enabled, make sure that the buffer is | ||
| 604 | ;; fontified, and reinstall its hook. We must do this first. | ||
| 605 | (when font-lock-mode | ||
| 606 | (when (lazy-lock-unfontified-p) | ||
| 607 | (let ((verbose (if (numberp font-lock-verbose) | ||
| 608 | (> (buffer-size) font-lock-verbose) | ||
| 609 | font-lock-verbose))) | ||
| 610 | (with-temp-message | ||
| 611 | (when verbose | ||
| 612 | (format "Fontifying %s..." (buffer-name))) | ||
| 613 | ;; Make sure we fontify etc. in the whole buffer. | ||
| 614 | (save-restriction | ||
| 615 | (widen) | ||
| 616 | (lazy-lock-fontify-region (point-min) (point-max)))))) | ||
| 617 | (add-hook 'after-change-functions #'font-lock-after-change-function nil t)) | ||
| 618 | ;; | ||
| 619 | ;; Remove the text properties. | ||
| 620 | (lazy-lock-after-unfontify-buffer) | ||
| 621 | ;; | ||
| 622 | ;; Remove the fontification hooks. | ||
| 623 | (remove-hook 'window-scroll-functions #'lazy-lock-fontify-after-scroll t) | ||
| 624 | (remove-hook 'window-scroll-functions #'lazy-lock-defer-after-scroll t) | ||
| 625 | (remove-hook 'before-change-functions #'lazy-lock-arrange-before-change t) | ||
| 626 | (remove-hook 'after-change-functions #'lazy-lock-fontify-line-after-change t) | ||
| 627 | (remove-hook 'after-change-functions #'lazy-lock-fontify-rest-after-change t) | ||
| 628 | (remove-hook 'after-change-functions #'lazy-lock-defer-line-after-change t) | ||
| 629 | (remove-hook 'after-change-functions #'lazy-lock-defer-rest-after-change t) | ||
| 630 | (remove-hook 'outline-view-change-hook #'lazy-lock-fontify-after-visage t) | ||
| 631 | (remove-hook 'hs-hide-hook #'lazy-lock-fontify-after-visage t)) | ||
| 632 | |||
| 633 | ;; Hook functions. | ||
| 634 | |||
| 635 | ;; Lazy Lock mode intervenes when (1) a previously invisible buffer region | ||
| 636 | ;; becomes visible, i.e., for demand- or defer-driven on-the-scroll | ||
| 637 | ;; fontification, (2) a buffer modification occurs, i.e., for defer-driven | ||
| 638 | ;; on-the-fly fontification, (3) Emacs becomes idle, i.e., for fontification of | ||
| 639 | ;; deferred fontification and stealth fontification, and (4) other special | ||
| 640 | ;; occasions. | ||
| 641 | |||
| 642 | ;; 1. There are three ways whereby this can happen. | ||
| 643 | ;; | ||
| 644 | ;; (a) Scrolling the window, either explicitly (e.g., `scroll-up') or | ||
| 645 | ;; implicitly (e.g., `search-forward'). Here, `window-start' changes. | ||
| 646 | ;; Fontification occurs by adding `lazy-lock-fontify-after-scroll' (for | ||
| 647 | ;; demand-driven fontification) or `lazy-lock-defer-after-scroll' (for | ||
| 648 | ;; defer-driven fontification) to the hook `window-scroll-functions'. | ||
| 649 | |||
| 650 | (defun lazy-lock-fontify-after-scroll (window window-start) | ||
| 651 | ;; Called from `window-scroll-functions'. | ||
| 652 | ;; Fontify WINDOW from WINDOW-START following the scroll. | ||
| 653 | (let ((inhibit-point-motion-hooks t)) | ||
| 654 | (lazy-lock-fontify-region window-start (window-end window t))) | ||
| 655 | ;; A prior deletion that did not cause scrolling, followed by a scroll, would | ||
| 656 | ;; result in an unnecessary trigger after this if we did not cancel it now. | ||
| 657 | (set-window-redisplay-end-trigger window nil)) | ||
| 658 | |||
| 659 | (defun lazy-lock-defer-after-scroll (window _window-start) | ||
| 660 | ;; Called from `window-scroll-functions'. | ||
| 661 | ;; Defer fontification following the scroll. Save the current buffer so that | ||
| 662 | ;; we subsequently fontify in all windows showing the buffer. | ||
| 663 | (unless (memq (current-buffer) lazy-lock-buffers) | ||
| 664 | (push (current-buffer) lazy-lock-buffers)) | ||
| 665 | ;; A prior deletion that did not cause scrolling, followed by a scroll, would | ||
| 666 | ;; result in an unnecessary trigger after this if we did not cancel it now. | ||
| 667 | (set-window-redisplay-end-trigger window nil)) | ||
| 668 | |||
| 669 | ;; (b) Resizing the window, either explicitly (e.g., `enlarge-window') or | ||
| 670 | ;; implicitly (e.g., `delete-other-windows'). Here, `window-end' changes. | ||
| 671 | ;; Fontification occurs by adding `lazy-lock-fontify-after-resize' to the | ||
| 672 | ;; hook `window-size-change-functions'. | ||
| 673 | |||
| 674 | (defun lazy-lock-fontify-after-resize (frame) | ||
| 675 | ;; Called from `window-size-change-functions'. | ||
| 676 | ;; Fontify windows in FRAME following the resize. We cannot use | ||
| 677 | ;; `window-start' or `window-end' so we fontify conservatively. | ||
| 678 | (save-excursion | ||
| 679 | (save-selected-window | ||
| 680 | (select-frame frame) | ||
| 681 | (walk-windows (function (lambda (window) | ||
| 682 | (set-buffer (window-buffer window)) | ||
| 683 | (when lazy-lock-mode | ||
| 684 | (lazy-lock-fontify-conservatively window)) | ||
| 685 | (set-window-redisplay-end-trigger window nil))) | ||
| 686 | 'nomini frame)))) | ||
| 687 | |||
| 688 | ;; (c) Deletion in the buffer. Here, a `window-end' marker can become visible. | ||
| 689 | ;; Fontification occurs by adding `lazy-lock-arrange-before-change' to | ||
| 690 | ;; `before-change-functions' and `lazy-lock-fontify-after-trigger' to the | ||
| 691 | ;; hook `redisplay-end-trigger-functions'. Before every deletion, the | ||
| 692 | ;; marker `window-redisplay-end-trigger' position is set to the soon-to-be | ||
| 693 | ;; changed `window-end' position. If the marker becomes visible, | ||
| 694 | ;; `lazy-lock-fontify-after-trigger' gets called. Ouch. Note that we only | ||
| 695 | ;; have to deal with this eventuality if there is no on-the-fly deferral. | ||
| 696 | |||
| 697 | (defun lazy-lock-arrange-before-change (beg end) | ||
| 698 | ;; Called from `before-change-functions'. | ||
| 699 | ;; Arrange that if text becomes visible it will be fontified (if a deletion | ||
| 700 | ;; is pending, text might become visible at the bottom). | ||
| 701 | (unless (eq beg end) | ||
| 702 | (let ((windows (get-buffer-window-list (current-buffer) 'nomini t)) window) | ||
| 703 | (while windows | ||
| 704 | (setq window (car windows)) | ||
| 705 | (unless (markerp (window-redisplay-end-trigger window)) | ||
| 706 | (set-window-redisplay-end-trigger window (make-marker))) | ||
| 707 | (set-marker (window-redisplay-end-trigger window) (window-end window)) | ||
| 708 | (setq windows (cdr windows)))))) | ||
| 709 | |||
| 710 | (defun lazy-lock-fontify-after-trigger (window trigger-point) | ||
| 711 | ;; Called from `redisplay-end-trigger-functions'. | ||
| 712 | ;; Fontify WINDOW from TRIGGER-POINT following the redisplay. | ||
| 713 | ;; We could probably just use `lazy-lock-fontify-after-scroll' without loss: | ||
| 714 | ;; (inline (lazy-lock-fontify-after-scroll window (window-start window))) | ||
| 715 | (let ((inhibit-point-motion-hooks t)) | ||
| 716 | (lazy-lock-fontify-region trigger-point (window-end window t)))) | ||
| 717 | |||
| 718 | ;; 2. Modified text must be marked as unfontified so it can be identified and | ||
| 719 | ;; fontified later when Emacs is idle. Deferral occurs by adding one of | ||
| 720 | ;; `lazy-lock-fontify-*-after-change' (for on-the-fly fontification) or | ||
| 721 | ;; `lazy-lock-defer-*-after-change' (for deferred fontification) to the | ||
| 722 | ;; hook `after-change-functions'. | ||
| 723 | |||
| 724 | (defalias 'lazy-lock-fontify-line-after-change | ||
| 725 | ;; Called from `after-change-functions'. | ||
| 726 | ;; Fontify the current change. | ||
| 727 | #'font-lock-after-change-function) | ||
| 728 | |||
| 729 | (defun lazy-lock-fontify-rest-after-change (beg end old-len) | ||
| 730 | ;; Called from `after-change-functions'. | ||
| 731 | ;; Fontify the current change and defer fontification of the rest of the | ||
| 732 | ;; buffer. Save the current buffer so that we subsequently fontify in all | ||
| 733 | ;; windows showing the buffer. | ||
| 734 | (lazy-lock-fontify-line-after-change beg end old-len) | ||
| 735 | (with-silent-modifications | ||
| 736 | (unless (memq (current-buffer) lazy-lock-buffers) | ||
| 737 | (push (current-buffer) lazy-lock-buffers)) | ||
| 738 | (save-restriction | ||
| 739 | (widen) | ||
| 740 | (remove-text-properties end (point-max) '(lazy-lock nil))))) | ||
| 741 | |||
| 742 | (defun lazy-lock-defer-line-after-change (beg end _old-len) | ||
| 743 | ;; Called from `after-change-functions'. | ||
| 744 | ;; Defer fontification of the current change. Save the current buffer so | ||
| 745 | ;; that we subsequently fontify in all windows showing the buffer. | ||
| 746 | (with-silent-modifications | ||
| 747 | (unless (memq (current-buffer) lazy-lock-buffers) | ||
| 748 | (push (current-buffer) lazy-lock-buffers)) | ||
| 749 | (remove-text-properties (max (1- beg) (point-min)) | ||
| 750 | (min (1+ end) (point-max)) | ||
| 751 | '(lazy-lock nil)))) | ||
| 752 | |||
| 753 | (defun lazy-lock-defer-rest-after-change (beg _end _old-len) | ||
| 754 | ;; Called from `after-change-functions'. | ||
| 755 | ;; Defer fontification of the rest of the buffer. Save the current buffer so | ||
| 756 | ;; that we subsequently fontify in all windows showing the buffer. | ||
| 757 | (with-silent-modifications | ||
| 758 | (unless (memq (current-buffer) lazy-lock-buffers) | ||
| 759 | (push (current-buffer) lazy-lock-buffers)) | ||
| 760 | (save-restriction | ||
| 761 | (widen) | ||
| 762 | (remove-text-properties (max (1- beg) (point-min)) | ||
| 763 | (point-max) | ||
| 764 | '(lazy-lock nil))))) | ||
| 765 | |||
| 766 | ;; 3. Deferred fontification and stealth fontification are done from these two | ||
| 767 | ;; functions. They are set up as Idle Timers. | ||
| 768 | |||
| 769 | (defun lazy-lock-fontify-after-defer () | ||
| 770 | ;; Called from `timer-idle-list'. | ||
| 771 | ;; Fontify all windows where deferral has occurred for its buffer. | ||
| 772 | (save-excursion | ||
| 773 | (while (and lazy-lock-buffers (not (input-pending-p))) | ||
| 774 | (let ((buffer (car lazy-lock-buffers)) windows) | ||
| 775 | ;; Paranoia: check that the buffer is still live and Lazy Lock mode on. | ||
| 776 | (when (buffer-live-p buffer) | ||
| 777 | (set-buffer buffer) | ||
| 778 | (when lazy-lock-mode | ||
| 779 | (setq windows (get-buffer-window-list buffer 'nomini t)) | ||
| 780 | (while windows | ||
| 781 | (lazy-lock-fontify-window (car windows)) | ||
| 782 | (setq windows (cdr windows))))) | ||
| 783 | (setq lazy-lock-buffers (cdr lazy-lock-buffers))))) | ||
| 784 | ;; Add hook if fontification should now be defer-driven in this buffer. | ||
| 785 | (when (and lazy-lock-mode lazy-lock-defer-on-scrolling | ||
| 786 | (memq #'lazy-lock-fontify-after-scroll window-scroll-functions) | ||
| 787 | (not (or (input-pending-p) (lazy-lock-unfontified-p)))) | ||
| 788 | (remove-hook 'window-scroll-functions #'lazy-lock-fontify-after-scroll t) | ||
| 789 | (add-hook 'window-scroll-functions #'lazy-lock-defer-after-scroll nil t))) | ||
| 790 | |||
| 791 | (defun lazy-lock-fontify-after-idle () | ||
| 792 | ;; Called from `timer-idle-list'. | ||
| 793 | ;; Fontify all buffers that need it, stealthily while idle. | ||
| 794 | (unless (or executing-kbd-macro (window-minibuffer-p (selected-window))) | ||
| 795 | ;; Loop over all buffers, fontify stealthily for each if necessary. | ||
| 796 | (let ((buffers (buffer-list)) (continue t) | ||
| 797 | message message-log-max minibuffer-auto-raise) | ||
| 798 | (save-excursion | ||
| 799 | (do-while (and buffers continue) | ||
| 800 | (set-buffer (car buffers)) | ||
| 801 | (if (not (and lazy-lock-mode (lazy-lock-unfontified-p))) | ||
| 802 | (setq continue (not (input-pending-p))) | ||
| 803 | ;; Fontify regions in this buffer while there is no input. | ||
| 804 | (with-temp-message | ||
| 805 | (when lazy-lock-stealth-verbose | ||
| 806 | "Fontifying stealthily...") | ||
| 807 | (do-while (and (lazy-lock-unfontified-p) continue) | ||
| 808 | (if (and lazy-lock-stealth-load | ||
| 809 | (> (car (load-average)) lazy-lock-stealth-load)) | ||
| 810 | ;; Wait a while before continuing with the loop. | ||
| 811 | (progn | ||
| 812 | (when message | ||
| 813 | (message "Fontifying stealthily...suspended") | ||
| 814 | (setq message nil)) | ||
| 815 | (setq continue (sit-for (or lazy-lock-stealth-time 30)))) | ||
| 816 | ;; Fontify a chunk. | ||
| 817 | (when lazy-lock-stealth-verbose | ||
| 818 | (if message | ||
| 819 | (message "Fontifying stealthily... %2d%% of %s" | ||
| 820 | (lazy-lock-percent-fontified) (buffer-name)) | ||
| 821 | (message "Fontifying stealthily...") | ||
| 822 | (setq message t))) | ||
| 823 | ;; Current buffer may have changed during `sit-for'. | ||
| 824 | (set-buffer (car buffers)) | ||
| 825 | (lazy-lock-fontify-chunk) | ||
| 826 | (setq continue (sit-for (or lazy-lock-stealth-nice 0))))))) | ||
| 827 | (setq buffers (cdr buffers))))))) | ||
| 828 | |||
| 829 | ;; 4. Special circumstances. | ||
| 830 | |||
| 831 | (defun lazy-lock-fontify-after-visage () | ||
| 832 | ;; Called from `outline-view-change-hook' and `hs-hide-hook'. | ||
| 833 | ;; Fontify windows showing the current buffer, as its visibility has changed. | ||
| 834 | ;; This is a conspiracy hack between lazy-lock.el, outline.el and | ||
| 835 | ;; hideshow.el. | ||
| 836 | (let ((windows (get-buffer-window-list (current-buffer) 'nomini t))) | ||
| 837 | (while windows | ||
| 838 | (lazy-lock-fontify-conservatively (car windows)) | ||
| 839 | (setq windows (cdr windows))))) | ||
| 840 | |||
| 841 | (defun lazy-lock-after-fontify-buffer () | ||
| 842 | ;; Called from `font-lock-after-fontify-buffer'. | ||
| 843 | ;; Mark the current buffer as fontified. | ||
| 844 | ;; This is a conspiracy hack between lazy-lock.el and font-lock.el. | ||
| 845 | (with-silent-modifications | ||
| 846 | (add-text-properties (point-min) (point-max) '(lazy-lock t)))) | ||
| 847 | |||
| 848 | (defun lazy-lock-after-unfontify-buffer () | ||
| 849 | ;; Called from `font-lock-after-unfontify-buffer'. | ||
| 850 | ;; Mark the current buffer as unfontified. | ||
| 851 | ;; This is a conspiracy hack between lazy-lock.el and font-lock.el. | ||
| 852 | (with-silent-modifications | ||
| 853 | (remove-text-properties (point-min) (point-max) '(lazy-lock nil)))) | ||
| 854 | |||
| 855 | ;; Fontification functions. | ||
| 856 | |||
| 857 | ;; If packages want to ensure that some region of the buffer is fontified, they | ||
| 858 | ;; should use this function. For an example, see ps-print.el. | ||
| 859 | (defun lazy-lock-fontify-region (beg end) | ||
| 860 | ;; Fontify between BEG and END, where necessary, in the current buffer. | ||
| 861 | (save-restriction | ||
| 862 | (widen) | ||
| 863 | (when (setq beg (text-property-any beg end 'lazy-lock nil)) | ||
| 864 | (save-excursion | ||
| 865 | (with-silent-modifications | ||
| 866 | (let ((inhibit-point-motion-hooks t)) | ||
| 867 | ;; Find successive unfontified regions between BEG and END. | ||
| 868 | (condition-case data | ||
| 869 | (do-while beg | ||
| 870 | (let ((next (or (text-property-any beg end 'lazy-lock t) | ||
| 871 | end))) | ||
| 872 | ;; Make sure the region end points are at beginning of line. | ||
| 873 | (goto-char beg) | ||
| 874 | (unless (bolp) | ||
| 875 | (beginning-of-line) | ||
| 876 | (setq beg (point))) | ||
| 877 | (goto-char next) | ||
| 878 | (unless (bolp) | ||
| 879 | (forward-line) | ||
| 880 | (setq next (point))) | ||
| 881 | ;; Fontify the region, then flag it as fontified. | ||
| 882 | (font-lock-fontify-region beg next) | ||
| 883 | (add-text-properties beg next '(lazy-lock t)) | ||
| 884 | (setq beg (text-property-any next end 'lazy-lock nil)))) | ||
| 885 | ((error quit) (message "Fontifying region...%s" data))))))))) | ||
| 886 | |||
| 887 | (defun lazy-lock-fontify-chunk () | ||
| 888 | ;; Fontify the nearest chunk, for stealth, in the current buffer. | ||
| 889 | (let ((inhibit-point-motion-hooks t)) | ||
| 890 | (save-excursion | ||
| 891 | (save-restriction | ||
| 892 | (widen) | ||
| 893 | ;; Move to end of line in case the character at point is not fontified. | ||
| 894 | (end-of-line) | ||
| 895 | ;; Find where the previous (next) unfontified regions end (begin). | ||
| 896 | (let ((prev (previous-single-property-change (point) 'lazy-lock)) | ||
| 897 | (next (text-property-any (point) (point-max) 'lazy-lock nil))) | ||
| 898 | ;; Fontify from the nearest unfontified position. | ||
| 899 | (if (or (null prev) (and next (< (- next (point)) (- (point) prev)))) | ||
| 900 | ;; The next, or neither, region is the nearest not fontified. | ||
| 901 | (lazy-lock-fontify-region | ||
| 902 | (progn (goto-char (or next (point-min))) | ||
| 903 | (beginning-of-line) | ||
| 904 | (point)) | ||
| 905 | (progn (goto-char (or next (point-min))) | ||
| 906 | (forward-line lazy-lock-stealth-lines) | ||
| 907 | (point))) | ||
| 908 | ;; The previous region is the nearest not fontified. | ||
| 909 | (lazy-lock-fontify-region | ||
| 910 | (progn (goto-char prev) | ||
| 911 | (forward-line (- lazy-lock-stealth-lines)) | ||
| 912 | (point)) | ||
| 913 | (progn (goto-char prev) | ||
| 914 | (forward-line) | ||
| 915 | (point))))))))) | ||
| 916 | |||
| 917 | (defun lazy-lock-fontify-window (window) | ||
| 918 | ;; Fontify in WINDOW between `window-start' and `window-end'. | ||
| 919 | ;; We can only do this when we can use `window-start' and `window-end'. | ||
| 920 | (with-current-buffer (window-buffer window) | ||
| 921 | (lazy-lock-fontify-region (window-start window) (window-end window)))) | ||
| 922 | |||
| 923 | (defun lazy-lock-fontify-conservatively (window) | ||
| 924 | ;; Fontify in WINDOW conservatively around point. | ||
| 925 | ;; Where we cannot use `window-start' and `window-end' we do `window-height' | ||
| 926 | ;; lines around point. That way we guarantee to have done enough. | ||
| 927 | (with-current-buffer (window-buffer window) | ||
| 928 | (let ((inhibit-point-motion-hooks t)) | ||
| 929 | (lazy-lock-fontify-region | ||
| 930 | (save-excursion | ||
| 931 | (goto-char (window-point window)) | ||
| 932 | (vertical-motion (- (window-height window)) window) (point)) | ||
| 933 | (save-excursion | ||
| 934 | (goto-char (window-point window)) | ||
| 935 | (vertical-motion (window-height window) window) (point)))))) | ||
| 936 | |||
| 937 | (defun lazy-lock-unfontified-p () | ||
| 938 | ;; Return non-nil if there is anywhere still to be fontified. | ||
| 939 | (save-restriction | ||
| 940 | (widen) | ||
| 941 | (text-property-any (point-min) (point-max) 'lazy-lock nil))) | ||
| 942 | |||
| 943 | (defun lazy-lock-percent-fontified () | ||
| 944 | ;; Return the percentage (of characters) of the buffer that are fontified. | ||
| 945 | (save-restriction | ||
| 946 | (widen) | ||
| 947 | (let ((beg (point-min)) (size 0) next) | ||
| 948 | ;; Find where the next fontified region begins. | ||
| 949 | (while (setq beg (text-property-any beg (point-max) 'lazy-lock t)) | ||
| 950 | (setq next (or (text-property-any beg (point-max) 'lazy-lock nil) | ||
| 951 | (point-max))) | ||
| 952 | (cl-incf size (- next beg)) | ||
| 953 | (setq beg next)) | ||
| 954 | ;; Float because using integer multiplication will frequently overflow. | ||
| 955 | (truncate (* (/ (float size) (point-max)) 100))))) | ||
| 956 | |||
| 957 | ;; Version dependent workarounds and fixes. | ||
| 958 | |||
| 959 | (when (consp lazy-lock-defer-time) | ||
| 960 | ;; | ||
| 961 | ;; In 2.06.04 and below, `lazy-lock-defer-time' could specify modes and time. | ||
| 962 | (with-output-to-temp-buffer "*Help*" | ||
| 963 | (princ "The value of the variable `lazy-lock-defer-time' was\n ") | ||
| 964 | (princ lazy-lock-defer-time) | ||
| 965 | (princ "\n") | ||
| 966 | (princ "This variable cannot now be a list of modes and time,\n") | ||
| 967 | (princ "so instead use ") | ||
| 968 | (princ (substitute-command-keys "\\[customize-option]")) | ||
| 969 | (princ " to modify the variables, or put the forms:\n") | ||
| 970 | (princ " (setq lazy-lock-defer-time ") | ||
| 971 | (princ (cdr lazy-lock-defer-time)) | ||
| 972 | (princ ")\n") | ||
| 973 | (princ " (setq lazy-lock-defer-on-the-fly '") | ||
| 974 | (princ (car lazy-lock-defer-time)) | ||
| 975 | (princ ")\n") | ||
| 976 | (princ "in your ~/.emacs. ") | ||
| 977 | (princ "The above forms have been evaluated for this editor session,\n") | ||
| 978 | (princ "but you should use ") | ||
| 979 | (princ (substitute-command-keys "\\[customize-option]")) | ||
| 980 | (princ " or change your ~/.emacs now.")) | ||
| 981 | (setq lazy-lock-defer-on-the-fly (car lazy-lock-defer-time) | ||
| 982 | lazy-lock-defer-time (cdr lazy-lock-defer-time))) | ||
| 983 | |||
| 984 | (when (boundp 'lazy-lock-defer-driven) | ||
| 985 | ;; | ||
| 986 | ;; In 2.06.04 and below, `lazy-lock-defer-driven' was the variable name. | ||
| 987 | (with-output-to-temp-buffer "*Help*" | ||
| 988 | (princ "The value of the variable `lazy-lock-defer-driven' is set to ") | ||
| 989 | (if (memq lazy-lock-defer-driven '(nil t)) | ||
| 990 | (princ lazy-lock-defer-driven) | ||
| 991 | (princ "`") | ||
| 992 | (princ lazy-lock-defer-driven) | ||
| 993 | (princ "'")) | ||
| 994 | (princ ".\n") | ||
| 995 | (princ "This variable is now called `lazy-lock-defer-on-scrolling',\n") | ||
| 996 | (princ "so instead use ") | ||
| 997 | (princ (substitute-command-keys "\\[customize-option]")) | ||
| 998 | (princ " to modify the variable, or put the form:\n") | ||
| 999 | (princ " (setq lazy-lock-defer-on-scrolling ") | ||
| 1000 | (unless (memq lazy-lock-defer-driven '(nil t)) | ||
| 1001 | (princ "'")) | ||
| 1002 | (princ lazy-lock-defer-driven) | ||
| 1003 | (princ ")\n") | ||
| 1004 | (princ "in your ~/.emacs. ") | ||
| 1005 | (princ "The above form has been evaluated for this editor session,\n") | ||
| 1006 | (princ "but you should use ") | ||
| 1007 | (princ (substitute-command-keys "\\[customize-option]")) | ||
| 1008 | (princ " or change your ~/.emacs now.")) | ||
| 1009 | (setq lazy-lock-defer-on-scrolling lazy-lock-defer-driven)) | ||
| 1010 | |||
| 1011 | ;; Install ourselves: | ||
| 1012 | |||
| 1013 | (add-hook 'window-size-change-functions #'lazy-lock-fontify-after-resize) | ||
| 1014 | (add-hook 'redisplay-end-trigger-functions #'lazy-lock-fontify-after-trigger) | ||
| 1015 | |||
| 1016 | (unless (assq 'lazy-lock-mode minor-mode-alist) | ||
| 1017 | (setq minor-mode-alist (append minor-mode-alist '((lazy-lock-mode nil))))) | ||
| 1018 | |||
| 1019 | (provide 'lazy-lock) | ||
| 1020 | |||
| 1021 | ;; Local Variables: | ||
| 1022 | ;; byte-compile-warnings: (not obsolete) | ||
| 1023 | ;; End: | ||
| 1024 | |||
| 1025 | ;;; lazy-lock.el ends here | ||