+++ /dev/null
-;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1994-1998, 2001-2022 Free Software Foundation, Inc.
-
-;; Author: Simon Marshall <simon@gnu.org>
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: faces files
-;; Version: 3.14
-;; Obsolete-since: 22.1
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Fast Lock mode is a Font Lock support mode.
-;; It makes visiting a file in Font Lock mode faster by restoring its face text
-;; properties from automatically saved associated Font Lock cache files.
-;;
-;; See caveats and feedback below.
-;; See also the lazy-lock package. (But don't use the two at the same time!)
-
-;; Installation:
-;;
-;; Put in your ~/.emacs:
-;;
-;; (setq font-lock-support-mode 'fast-lock-mode)
-;;
-;; Start up a new Emacs and use font-lock as usual (except that you can use the
-;; so-called "gaudier" fontification regexps on big files without frustration).
-;;
-;; When you visit a file (which has `font-lock-mode' enabled) that has a
-;; corresponding Font Lock cache file associated with it, the Font Lock cache
-;; will be loaded from that file instead of being generated by Font Lock code.
-
-;; Caveats:
-;;
-;; A cache will be saved when visiting a compressed file using crypt++, but not
-;; be read. This is a "feature"/"consequence"/"bug" of crypt++.
-;;
-;; Version control packages are likely to stamp all over file modification
-;; times. Therefore the act of checking out may invalidate a cache.
-\f
-;; History:
-;;
-;; 0.02--1.00:
-;; - Changed name from turbo-prop to fast-lock. Automagic for font-lock only
-;; - Made `fast-lock-mode' a minor mode, like G. Dinesh Dutt's fss-mode
-;; 1.00--1.01:
-;; - Turn on `fast-lock-mode' only if `buffer-file-name' or `interactive-p'
-;; - Made `fast-lock-file-name' use `buffer-name' if `buffer-file-name' is nil
-;; - Moved save-all conditions to `fast-lock-save-cache'
-;; - Added `fast-lock-save-text-properties' to `kill-buffer-hook'
-;; 1.01--2.00: complete rewrite---not worth the space to document
-;; - Changed structure of text properties cache and threw out file mod checks
-;; 2.00--2.01:
-;; - Made `condition-case' forms understand `quit'.
-;; - Made `fast-lock' require `font-lock'
-;; - Made `fast-lock-cache-name' chase links (from Ben Liblit)
-;; 2.01--3.00:
-;; - Changed structure of cache to include `font-lock-keywords' (from rms)
-;; - Changed `fast-lock-cache-mechanisms' to `fast-lock-cache-directories'
-;; - Removed `fast-lock-read-others'
-;; - Made `fast-lock-read-cache' ignore cache owner
-;; - Made `fast-lock-save-cache-external' create cache directory
-;; - Made `fast-lock-save-cache-external' save `font-lock-keywords'
-;; - Made `fast-lock-cache-data' check `font-lock-keywords'
-;; 3.00--3.01: incorporated port of 2.00 to Lucid, made by Barry Warsaw
-;; - Package now provides itself
-;; - Lucid: Use `font-lock-any-extents-p' for `font-lock-any-properties-p'
-;; - Lucid: Use `list-faces' for `face-list'
-;; - Lucid: Added `set-text-properties'
-;; - Lucid: Made `turn-on-fast-lock' pass 1 not t to `fast-lock-mode'
-;; - Removed test for `fast-lock-mode' from `fast-lock-read-cache'
-;; - Lucid: Added Lucid-specific `fast-lock-get-face-properties'
-;; 3.01--3.02: now works with Lucid Emacs, thanks to Barry Warsaw
-;; - Made `fast-lock-cache-name' map ":" to ";" for OS/2 (from Serganova Vera)
-;; - Made `fast-lock-cache-name' use abbreviated file name (from Barry Warsaw)
-;; - Lucid: Separated handlers for `error' and `quit' for `condition-case'
-;; 3.02--3.03:
-;; - Changed `fast-lock-save-cache-external' to `fast-lock-save-cache-data'
-;; - Lucid: Added Lucid-specific `fast-lock-set-face-properties'
-;; 3.03--3.04:
-;; - Corrected `subrp' test of Lucid code
-;; - Replaced `font-lock-any-properties-p' with `text-property-not-all'
-;; - Lucid: Made `fast-lock-set-face-properties' put `text-prop' on extents
-;; - Made `fast-lock-cache-directories' a regexp alist (from Colin Rafferty)
-;; - Made `fast-lock-cache-directory' to return a usable cache file directory
-;; 3.04--3.05:
-;; - Lucid: Fix for XEmacs 19.11 `text-property-not-all'
-;; - Replaced `subrp' test of Lucid code with `emacs-version' `string-match'
-;; - Made `byte-compile-warnings' omit `unresolved' on compilation
-;; - Made `fast-lock-save-cache-data' use a buffer (from Rick Sladkey)
-;; - Reverted to old `fast-lock-get-face-properties' (from Rick Sladkey)
-;; 3.05--3.06: incorporated hack of 3.03, made by Jonathan Stigelman (Stig)
-;; - Reverted to 3.04 version of `fast-lock-get-face-properties'
-;; - XEmacs: Removed `list-faces' `defalias'
-;; - Made `fast-lock-mode' and `turn-on-fast-lock' succeed `autoload' cookies
-;; - Added `fast-lock-submit-bug-report'
-;; - Renamed `fast-lock-save-size' to `fast-lock-minimum-size'
-;; - Made `fast-lock-save-cache' output a message if no save ever attempted
-;; - Made `fast-lock-save-cache-data' output a message if save attempted
-;; - Made `fast-lock-cache-data' output a message if load attempted
-;; - Made `fast-lock-save-cache-data' do `condition-case' not `unwind-protect'
-;; - Made `fast-lock-save-cache' and `fast-lock-read-cache' return nothing
-;; - Made `fast-lock-save-cache' check `buffer-modified-p' (Stig)
-;; - Added `fast-lock-save-events'
-;; - Added `fast-lock-after-save-hook' to `after-save-hook' (Stig)
-;; - Added `fast-lock-kill-buffer-hook' to `kill-buffer-hook'
-;; - Changed `fast-lock-save-caches' to `fast-lock-kill-emacs-hook'
-;; - Added `fast-lock-kill-emacs-hook' to `kill-emacs-hook'
-;; - Made `fast-lock-save-cache' check `verify-visited-file-modtime' (Stig)
-;; - Made `visited-file-modtime' be the basis of the timestamp (Stig)
-;; - Made `fast-lock-save-cache-1' and `fast-lock-cache-data' use/reformat it
-;; - Added `fast-lock-cache-filename' to keep track of the cache file name
-;; - Added `fast-lock-after-fontify-buffer'
-;; - Added `fast-lock-save-faces' list of faces to save (idea from Stig/Tibor)
-;; - Made `fast-lock-get-face-properties' functions use it
-;; - XEmacs: Made `fast-lock-set-face-properties' do extents the Font Lock way
-;; - XEmacs: Removed fix for `text-property-not-all' (19.11 support dropped)
-;; - Made `fast-lock-mode' ensure `font-lock-mode' is on
-;; - Made `fast-lock-save-cache' do `cdr-safe' not `cdr' (from Dave Foster)
-;; - Made `fast-lock-save-cache' do `set-buffer' first (from Dave Foster)
-;; - Made `fast-lock-save-cache' loop until saved or quit (from Georg Nikodym)
-;; - Made `fast-lock-cache-data' check `buffer-modified-p'
-;; - Made `fast-lock-cache-data' do `font-lock-compile-keywords' if necessary
-;; - XEmacs: Made `font-lock-compile-keywords' `defalias'
-;; 3.06--3.07:
-;; - XEmacs: Add `fast-lock-after-fontify-buffer' to the Font Lock hook
-;; - Made `fast-lock-cache-name' explain the use of `directory-abbrev-alist'
-;; - Made `fast-lock-mode' use `buffer-file-truename' not `buffer-file-name'
-;; 3.07--3.08:
-;; - Made `fast-lock-read-cache' set `fast-lock-cache-filename'
-;; 3.08--3.09:
-;; - Made `fast-lock-save-cache' cope if `fast-lock-minimum-size' is a list
-;; - Made `fast-lock-mode' respect the value of `font-lock-inhibit-thing-lock'
-;; - Added `fast-lock-after-unfontify-buffer'
-;; 3.09--3.10:
-;; - Rewrite for Common Lisp macros
-;; - Made fast-lock.el barf on a crap 8+3 pseudo-OS (Eli Zaretskii help)
-;; - XEmacs: Made `add-minor-mode' succeed `autoload' cookie
-;; - XEmacs: Made `fast-lock-save-faces' default to `font-lock-face-list'
-;; - Made `fast-lock-save-cache' use `font-lock-value-in-major-mode'
-;; - Wrap with `save-buffer-state' (Ray Van Tassle report)
-;; - Made `fast-lock-mode' wrap `font-lock-support-mode'
-;; 3.10--3.11:
-;; - Made `fast-lock-get-face-properties' cope with face lists
-;; - Added `fast-lock-verbose'
-;; - XEmacs: Add `font-lock-value-in-major-mode' if necessary
-;; - Removed `fast-lock-submit-bug-report' and bade farewell
-;; 3.11--3.12:
-;; - Added Custom support (Hrvoje Nikšić help)
-;; - Made `save-buffer-state' wrap `inhibit-point-motion-hooks'
-;; - Made `fast-lock-cache-data' simplify calls of `font-lock-compile-keywords'
-;; 3.12--3.13:
-;; - Removed `byte-*' variables from `eval-when-compile' (Erik Naggum hint)
-;; - Changed structure of cache to include `font-lock-syntactic-keywords'
-;; - Made `fast-lock-save-cache-1' save syntactic fontification data
-;; - Made `fast-lock-cache-data' take syntactic fontification data
-;; - Added `fast-lock-get-syntactic-properties'
-;; - Renamed `fast-lock-set-face-properties' to `fast-lock-add-properties'
-;; - Made `fast-lock-add-properties' add syntactic and face fontification data
-;; 3.13--3.14:
-;; - Made `fast-lock-cache-name' cope with `windowsnt' (Geoff Voelker fix)
-;; - Made `fast-lock-verbose' use `other' widget (Andreas Schwab fix)
-;; - Used `with-temp-message' where possible to make messages temporary.
-\f
-;;; Code:
-
-(require 'font-lock)
-
-(declare-function msdos-long-file-names "msdos.c")
-
-;; Make sure fast-lock.el is supported.
-(if (and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
- (error "`fast-lock' was written for long file name systems"))
-
-(defvar font-lock-face-list)
-
-(eval-when-compile
- ;;
- ;; We use this to verify that a face should be saved.
- (defmacro fast-lock-save-facep (face)
- "Return non-nil if FACE is one of `fast-lock-save-faces'."
- `(or (null fast-lock-save-faces)
- (if (symbolp ,face)
- (memq ,face fast-lock-save-faces)
- (let ((faces ,face))
- (while (unless (memq (car faces) fast-lock-save-faces)
- (setq faces (cdr faces))))
- faces)))))
-
-(defgroup fast-lock nil
- "Font Lock support mode to cache fontification."
- :load 'fast-lock
- :group 'font-lock)
-
-(defvar fast-lock-mode nil) ; Whether we are turned on.
-(defvar fast-lock-cache-timestamp nil) ; For saving/reading.
-(defvar fast-lock-cache-filename nil) ; For deleting.
-\f
-;; User Variables:
-
-(defcustom fast-lock-minimum-size 25600
- "Minimum size of a buffer for cached fontification.
-Only buffers more than this can have associated Font Lock cache files saved.
-If nil, means cache files are never created.
-If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
-where MAJOR-MODE is a symbol or t (meaning the default). For example:
- ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576))
-means that the minimum size is 25K for buffers in C or C++ modes, one megabyte
-for buffers in Rmail mode, and size is irrelevant otherwise."
- :type '(choice (const :tag "none" nil)
- (integer :tag "size")
- (repeat :menu-tag "mode specific" :tag "mode specific"
- :value ((t . nil))
- (cons :tag "Instance"
- (radio :tag "Mode"
- (const :tag "all" t)
- (symbol :tag "name"))
- (radio :tag "Size"
- (const :tag "none" nil)
- (integer :tag "size"))))))
-
-(defcustom fast-lock-cache-directories '("~/.emacs-flc")
-; - `internal', keep each file's Font Lock cache file in the same file.
-; - `external', keep each file's Font Lock cache file in the same directory.
- "Directories in which Font Lock cache files are saved and read.
-Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where
-DIR is a directory name (relative or absolute) and REGEXP is a regexp.
-
-An attempt will be made to save or read Font Lock cache files using these items
-until one succeeds (i.e., until a readable or writable one is found). If an
-item contains REGEXP, DIR is used only if the buffer file name matches REGEXP.
-For example:
-
- (let ((home (expand-file-name (abbreviate-file-name (file-truename \"~/\")))))
- (list (cons (concat \"^\" (regexp-quote home)) \".\") \"~/.emacs-flc\"))
- =>
- ((\"^/your/true/home/directory/\" . \".\") \"~/.emacs-flc\")
-
-would cause a file's current directory to be used if the file is under your
-home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'.
-For security reasons, it is not advisable to use the file's current directory
-to avoid the possibility of using the cache of another user."
- :type '(repeat (radio (directory :tag "directory")
- (cons :tag "Matching"
- (regexp :tag "regexp")
- (directory :tag "directory")))))
-(put 'fast-lock-cache-directories 'risky-local-variable t)
-
-(defcustom fast-lock-save-events '(kill-buffer kill-emacs)
- "Events under which caches will be saved.
-Valid events are `save-buffer', `kill-buffer' and `kill-emacs'.
-If concurrent editing sessions use the same associated cache file for a file's
-buffer, then you should add `save-buffer' to this list."
- :type '(set (const :tag "buffer saving" save-buffer)
- (const :tag "buffer killing" kill-buffer)
- (const :tag "emacs killing" kill-emacs)))
-
-(defcustom fast-lock-save-others t
- "If non-nil, save Font Lock cache files irrespective of file owner.
-If nil, means only buffer files known to be owned by you can have associated
-Font Lock cache files saved. Ownership may be unknown for networked files."
- :type 'boolean)
-
-(defcustom fast-lock-verbose font-lock-verbose
- "If non-nil, means show status messages for cache processing.
-If a number, only buffers greater than this size have processing messages."
- :type '(choice (const :tag "never" nil)
- (other :tag "always" t)
- (integer :tag "size")))
-
-(defvar fast-lock-save-faces nil
- "Faces that will be saved in a Font Lock cache file.
-If nil, means information for all faces will be saved.")
-\f
-;; User Functions:
-
-;;;###autoload
-(defun fast-lock-mode (&optional arg)
- "Toggle Fast Lock mode.
-With arg, turn Fast Lock mode on if and only if arg is positive and the buffer
-is associated with a file. Enable it automatically in your `~/.emacs' by:
-
- (setq font-lock-support-mode \\='fast-lock-mode)
-
-If Fast Lock mode is enabled, and the current buffer does not contain any text
-properties, any associated Font Lock cache is used if its timestamp matches the
-buffer's file, and its `font-lock-keywords' match those that you are using.
-
-Font Lock caches may be saved:
-- When you save the file's buffer.
-- When you kill an unmodified file's buffer.
-- When you exit Emacs, for all unmodified or saved buffers.
-Depending on the value of `fast-lock-save-events'.
-See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'.
-
-Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad.
-
-Various methods of control are provided for the Font Lock cache. In general,
-see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'.
-For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events',
-`fast-lock-save-others' and `fast-lock-save-faces'."
- (interactive "P")
- ;; Only turn on if we are visiting a file. We could use `buffer-file-name',
- ;; but many packages temporarily wrap that to nil when doing their own thing.
- (set (make-local-variable 'fast-lock-mode)
- (and buffer-file-truename
- (not (memq 'fast-lock-mode font-lock-inhibit-thing-lock))
- (if arg (> (prefix-numeric-value arg) 0) (not fast-lock-mode))))
- (if (and fast-lock-mode (not font-lock-mode))
- ;; Turned on `fast-lock-mode' rather than `font-lock-mode'.
- (progn
- (message "Use font-lock-support-mode rather than calling fast-lock-mode")
- (sit-for 2))
- ;; Let's get down to business.
- (set (make-local-variable 'fast-lock-cache-timestamp) nil)
- (set (make-local-variable 'fast-lock-cache-filename) nil)
- (when (and fast-lock-mode (not font-lock-fontified))
- (fast-lock-read-cache))))
-
-(defun fast-lock-read-cache ()
- "Read the Font Lock cache for the current buffer.
-
-The following criteria must be met for a Font Lock cache file to be read:
-- Fast Lock mode must be turned on in the buffer.
-- The buffer must not be modified.
-- The buffer's `font-lock-keywords' must match the cache's.
-- The buffer file's timestamp must match the cache's.
-- Criteria imposed by `fast-lock-cache-directories'.
-
-See `fast-lock-mode'."
- (interactive)
- (let ((directories fast-lock-cache-directories)
- (modified (buffer-modified-p)) (inhibit-read-only t)
- (fontified font-lock-fontified))
- (set (make-local-variable 'font-lock-fontified) nil)
- ;; Keep trying directories until fontification is turned off.
- (while (and directories (not font-lock-fontified))
- (let ((directory (fast-lock-cache-directory (car directories) nil)))
- (condition-case nil
- (when directory
- (setq fast-lock-cache-filename (fast-lock-cache-name directory))
- (when (file-readable-p fast-lock-cache-filename)
- (load fast-lock-cache-filename t t t)))
- (error nil) (quit nil))
- (setq directories (cdr directories))))
- ;; Unset `fast-lock-cache-filename', and restore `font-lock-fontified', if
- ;; we don't use a cache. (Note that `fast-lock-cache-data' sets the value
- ;; of `fast-lock-cache-timestamp'.)
- (set-buffer-modified-p modified)
- (unless font-lock-fontified
- (setq fast-lock-cache-filename nil font-lock-fontified fontified))))
-
-(defun fast-lock-save-cache (&optional buffer)
- "Save the Font Lock cache of BUFFER or the current buffer.
-
-The following criteria must be met for a Font Lock cache file to be saved:
-- Fast Lock mode must be turned on in the buffer.
-- The event must be one of `fast-lock-save-events'.
-- The buffer must be at least `fast-lock-minimum-size' bytes long.
-- The buffer file must be owned by you, or `fast-lock-save-others' must be t.
-- The buffer must contain at least one `face' text property.
-- The buffer must not be modified.
-- The buffer file's timestamp must be the same as the file's on disk.
-- The on disk file's timestamp must be different than the buffer's cache.
-- Criteria imposed by `fast-lock-cache-directories'.
-
-See `fast-lock-mode'."
- (interactive)
- (save-excursion
- (when buffer
- (set-buffer buffer))
- (let ((min-size (font-lock-value-in-major-mode fast-lock-minimum-size))
- (file-timestamp (visited-file-modtime)) (saved nil))
- (when (and fast-lock-mode
- ;;
- ;; "Only save if the buffer matches the file, the file has
- ;; changed, and it was changed by the current emacs session."
- ;;
- ;; Only save if the buffer is not modified,
- ;; (i.e., so we don't save for something not on disk)
- (not (buffer-modified-p))
- ;; and the file's timestamp is the same as the buffer's,
- ;; (i.e., someone else hasn't written the file in the meantime)
- (verify-visited-file-modtime (current-buffer))
- ;; and the file's timestamp is different from the cache's.
- ;; (i.e., a save has occurred since the cache was read)
- (not (equal fast-lock-cache-timestamp file-timestamp))
- ;;
- ;; Only save if user's restrictions are satisfied.
- (and min-size (>= (buffer-size) min-size))
- (or fast-lock-save-others
- (eq (user-uid) (file-attribute-user-id
- (file-attributes buffer-file-name))))
- ;;
- ;; Only save if there are `face' properties to save.
- (text-property-not-all (point-min) (point-max) 'face nil))
- ;;
- ;; Try each directory until we manage to save or the user quits.
- (let ((directories fast-lock-cache-directories))
- (while (and directories (memq saved '(nil error)))
- (let* ((dir (fast-lock-cache-directory (car directories) t))
- (file (and dir (fast-lock-cache-name dir))))
- (when (and file (file-writable-p file))
- (setq saved (fast-lock-save-cache-1 file file-timestamp)))
- (setq directories (cdr directories)))))))))
-
-;;;###autoload
-(defun turn-on-fast-lock ()
- "Unconditionally turn on Fast Lock mode."
- (fast-lock-mode t))
-\f
-;;; API Functions:
-
-(defun fast-lock-after-fontify-buffer ()
- ;; Delete the Font Lock cache file used to restore fontification, if any.
- (when fast-lock-cache-filename
- (if (file-writable-p fast-lock-cache-filename)
- (delete-file fast-lock-cache-filename)
- (message "File %s font lock cache cannot be deleted" (buffer-name))))
- ;; Flag so that a cache will be saved later even if the file is never saved.
- (setq fast-lock-cache-timestamp nil))
-
-(defalias 'fast-lock-after-unfontify-buffer #'ignore)
-\f
-;; Miscellaneous Functions:
-
-(defun fast-lock-save-cache-after-save-file ()
- ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'.
- (when (memq 'save-buffer fast-lock-save-events)
- (fast-lock-save-cache)))
-
-(defun fast-lock-save-cache-before-kill-buffer ()
- ;; Do `fast-lock-save-cache' if `kill-buffer' is on `fast-lock-save-events'.
- (when (memq 'kill-buffer fast-lock-save-events)
- (fast-lock-save-cache)))
-
-(defun fast-lock-save-caches-before-kill-emacs ()
- ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'.
- (when (memq 'kill-emacs fast-lock-save-events)
- (mapcar #'fast-lock-save-cache (buffer-list))))
-
-(defun fast-lock-cache-directory (directory create)
- "Return usable directory based on DIRECTORY.
-Returns nil if the directory does not exist, or, if CREATE non-nil, cannot be
-created. DIRECTORY may be a string or a cons pair of the form (REGEXP . DIR).
-See `fast-lock-cache-directories'."
- (let ((dir
- (cond ((not buffer-file-name)
- ;; Should never be nil, but `crypt++' screws it up.
- nil)
- ((stringp directory)
- ;; Just a directory.
- directory)
- (t
- ;; A directory if the file name matches the regexp.
- (let ((bufile (expand-file-name buffer-file-truename))
- (case-fold-search nil))
- (when (save-match-data (string-match (car directory) bufile))
- (cdr directory)))))))
- (cond ((not dir)
- nil)
- ((file-accessible-directory-p dir)
- dir)
- (create
- (condition-case nil
- (progn (make-directory dir t) dir)
- (error nil))))))
-
-;; If you are wondering why we only hash if the directory is not ".", rather
-;; than if `file-name-absolute-p', it is because if we just appended ".flc" for
-;; relative cache directories (that are not ".") then it is possible that more
-;; than one file would have the same cache name in that directory, if the luser
-;; made a link from one relative cache directory to another. (Phew!)
-(defun fast-lock-cache-name (directory)
- "Return full cache file name using caching DIRECTORY.
-If DIRECTORY is `.', the file name is the buffer file name appended with `.flc'.
-Otherwise, the file name is constructed from DIRECTORY and the buffer's true
-abbreviated file name, with all `/' characters in the name replaced with `#'
-characters, and appended with `.flc'.
-
-If the same file has different cache file names when edited on different
-machines, e.g., on one machine the cache file name has the prefix `#home',
-perhaps due to automount, try putting in your `~/.emacs' something like:
-
- (setq directory-abbrev-alist (cons \\='(\"^/home/\" . \"/\") directory-abbrev-alist))
-
-Emacs automagically removes the common `/tmp_mnt' automount prefix by default.
-
-See `fast-lock-cache-directory'."
- (if (string-equal directory ".")
- (concat buffer-file-name ".flc")
- (let* ((bufile (expand-file-name buffer-file-truename))
- (chars-alist
- (if (memq system-type '(windows-nt cygwin))
- '((?/ . (?#)) (?# . (?# ?#)) (?: . (?\;)) (?\; . (?\; ?\;)))
- '((?/ . (?#)) (?# . (?# ?#)))))
- (mapchars
- (function (lambda (c) (or (cdr (assq c chars-alist)) (list c))))))
- (concat
- (file-name-as-directory (expand-file-name directory))
- (mapconcat #'char-to-string (apply #'append (mapcar mapchars bufile)) "")
- ".flc"))))
-\f
-;; Font Lock Cache Processing Functions:
-
-;; The version 3 format of the cache is:
-;;
-;; (fast-lock-cache-data VERSION TIMESTAMP
-;; font-lock-syntactic-keywords SYNTACTIC-PROPERTIES
-;; font-lock-keywords FACE-PROPERTIES)
-
-(defun fast-lock-save-cache-1 (file timestamp)
- ;; Save the FILE with the TIMESTAMP plus fontification data.
- ;; Returns non-nil if a save was attempted to a writable cache file.
- (let ((tpbuf (generate-new-buffer " *fast-lock*"))
- (verbose (if (numberp fast-lock-verbose)
- (> (buffer-size) fast-lock-verbose)
- fast-lock-verbose))
- (saved t))
- (with-temp-message
- (when verbose
- (format "Saving %s font lock cache..." (buffer-name)))
- (condition-case nil
- (save-excursion
- (print (list 'fast-lock-cache-data 3
- (list 'quote timestamp)
- (list 'quote font-lock-syntactic-keywords)
- (list 'quote (fast-lock-get-syntactic-properties))
- (list 'quote font-lock-keywords)
- (list 'quote (fast-lock-get-face-properties)))
- tpbuf)
- (set-buffer tpbuf)
- (write-region (point-min) (point-max) file nil 'quietly)
- (setq fast-lock-cache-timestamp timestamp
- fast-lock-cache-filename file))
- (error (setq saved 'error)) (quit (setq saved 'quit)))
- (kill-buffer tpbuf))
- (cond ((eq saved 'quit)
- (message "Saving %s font lock cache...quit" (buffer-name)))
- ((eq saved 'error)
- (message "Saving %s font lock cache...failed" (buffer-name))))
- ;; We return non-nil regardless of whether a failure occurred.
- saved))
-
-(defun fast-lock-cache-data (version timestamp
- syntactic-keywords syntactic-properties
- keywords face-properties
- &rest _ignored)
- ;; Find value of syntactic keywords in case it is a symbol.
- (setq font-lock-syntactic-keywords (font-lock-eval-keywords
- font-lock-syntactic-keywords))
- ;; Compile all keywords in case some are and some aren't.
- (when font-lock-syntactic-keywords
- (setq font-lock-syntactic-keywords (font-lock-compile-keywords
- font-lock-syntactic-keywords t)))
- (when syntactic-keywords
- (setq syntactic-keywords (font-lock-compile-keywords syntactic-keywords t)))
- (setq font-lock-keywords (font-lock-compile-keywords font-lock-keywords)
- keywords (font-lock-compile-keywords keywords))
- ;; Use the Font Lock cache SYNTACTIC-PROPERTIES and FACE-PROPERTIES if we're
- ;; using cache VERSION format 3, the current buffer's file timestamp matches
- ;; the TIMESTAMP, the current buffer's `font-lock-syntactic-keywords' are the
- ;; same as SYNTACTIC-KEYWORDS, and the current buffer's `font-lock-keywords'
- ;; are the same as KEYWORDS.
- (let ((buf-timestamp (visited-file-modtime))
- (verbose (if (numberp fast-lock-verbose)
- (> (buffer-size) fast-lock-verbose)
- fast-lock-verbose))
- (loaded t))
- (if (or (/= version 3)
- (buffer-modified-p)
- (not (equal timestamp buf-timestamp))
- (not (equal syntactic-keywords font-lock-syntactic-keywords))
- (not (equal keywords font-lock-keywords)))
- (setq loaded nil)
- (with-temp-message
- (when verbose
- (format "Loading %s font lock cache..." (buffer-name)))
- (condition-case nil
- (fast-lock-add-properties syntactic-properties face-properties)
- (error (setq loaded 'error)) (quit (setq loaded 'quit))))
- (cond ((eq loaded 'quit)
- (message "Loading %s font lock cache...quit" (buffer-name)))
- ((eq loaded 'error)
- (message "Loading %s font lock cache...failed" (buffer-name)))))
- (setq font-lock-fontified (eq loaded t)
- fast-lock-cache-timestamp (and (eq loaded t) timestamp))))
-\f
-;; Text Properties Processing Functions:
-
-;; This is fast, but fails if adjacent characters have different `face' text
-;; properties. Maybe that's why I dropped it in the first place?
-;(defun fast-lock-get-face-properties ()
-; "Return a list of `face' text properties in the current buffer.
-;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
-;where VALUE is a `face' property value and STARTx and ENDx are positions."
-; (save-restriction
-; (widen)
-; (let ((start (text-property-not-all (point-min) (point-max) 'face nil))
-; (limit (point-max)) end properties value cell)
-; (while start
-; (setq end (next-single-property-change start 'face nil limit)
-; value (get-text-property start 'face))
-; ;; Make, or add to existing, list of regions with same `face'.
-; (if (setq cell (assq value properties))
-; (setcdr cell (cons start (cons end (cdr cell))))
-; (setq properties (cons (list value start end) properties)))
-; (setq start (next-single-property-change end 'face)))
-; properties)))
-
-;; This is slow, but copes if adjacent characters have different `face' text
-;; properties, but fails if they are lists.
-;(defun fast-lock-get-face-properties ()
-; "Return a list of `face' text properties in the current buffer.
-;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
-;where VALUE is a `face' property value and STARTx and ENDx are positions.
-;Only those `face' VALUEs in `fast-lock-save-faces' are returned."
-; (save-restriction
-; (widen)
-; (let ((faces (or fast-lock-save-faces (face-list))) (limit (point-max))
-; properties regions face start end)
-; (while faces
-; (setq face (car faces) faces (cdr faces) regions () end (point-min))
-; ;; Make a list of start/end regions with `face' property face.
-; (while (setq start (text-property-any end limit 'face face))
-; (setq end (or (text-property-not-all start limit 'face face) limit)
-; regions (cons start (cons end regions))))
-; ;; Add `face' face's regions, if any, to properties.
-; (when regions
-; (push (cons face regions) properties)))
-; properties)))
-
-(defun fast-lock-get-face-properties ()
- "Return a list of `face' text properties in the current buffer.
-Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
-where VALUE is a `face' property value and STARTx and ENDx are positions."
- (save-restriction
- (widen)
- (let ((start (text-property-not-all (point-min) (point-max) 'face nil))
- end properties value cell)
- (while start
- (setq end (next-single-property-change start 'face nil (point-max))
- value (get-text-property start 'face))
- ;; Make, or add to existing, list of regions with same `face'.
- (cond ((setq cell (assoc value properties))
- (setcdr cell (cons start (cons end (cdr cell)))))
- ((fast-lock-save-facep value)
- (push (list value start end) properties)))
- (setq start (text-property-not-all end (point-max) 'face nil)))
- properties)))
-
-(defun fast-lock-get-syntactic-properties ()
- "Return a list of `syntax-table' text properties in the current buffer.
-See `fast-lock-get-face-properties'."
- (save-restriction
- (widen)
- (let ((start (text-property-not-all (point-min) (point-max) 'syntax-table
- nil))
- end properties value cell)
- (while start
- (setq end (next-single-property-change start 'syntax-table nil
- (point-max))
- value (get-text-property start 'syntax-table))
- ;; Make, or add to existing, list of regions with same `syntax-table'.
- (if (setq cell (assoc value properties))
- (setcdr cell (cons start (cons end (cdr cell))))
- (push (list value start end) properties))
- (setq start (text-property-not-all end (point-max) 'syntax-table nil)))
- properties)))
-
-(defun fast-lock-add-properties (syntactic-properties face-properties)
- "Add `syntax-table' and `face' text properties to the current buffer.
-Any existing `syntax-table' and `face' text properties are removed first.
-See `fast-lock-get-face-properties'."
- (with-silent-modifications
- (let ((inhibit-point-motion-hooks t))
- (save-restriction
- (widen)
- (font-lock-unfontify-region (point-min) (point-max))
- ;;
- ;; Set the `syntax-table' property for each start/end region.
- (pcase-dolist (`(,plist . ,regions) syntactic-properties)
- (while regions
- (add-text-properties (nth 0 regions) (nth 1 regions) plist)
- (setq regions (nthcdr 2 regions))))
- ;;
- ;; Set the `face' property for each start/end region.
- (pcase-dolist (`(,plist . ,regions) face-properties)
- (while regions
- (add-text-properties (nth 0 regions) (nth 1 regions) plist)
- (setq regions (nthcdr 2 regions))))))))
-
-\f
-;; Install ourselves:
-
-(add-hook 'after-save-hook #'fast-lock-save-cache-after-save-file)
-(add-hook 'kill-buffer-hook #'fast-lock-save-cache-before-kill-buffer)
-(unless noninteractive
- (add-hook 'kill-emacs-hook #'fast-lock-save-caches-before-kill-emacs))
-
-;;;###autoload
-(when (fboundp 'add-minor-mode)
- (defvar fast-lock-mode nil)
- (add-minor-mode 'fast-lock-mode nil))
-;;;###dont-autoload
-(unless (assq 'fast-lock-mode minor-mode-alist)
- (setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil)))))
-
-(provide 'fast-lock)
-
-;;; fast-lock.el ends here
-
-;; Local Variables:
-;; byte-compile-warnings: (not obsolete)
-;; End:
+++ /dev/null
-;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1994-1998, 2001-2022 Free Software Foundation, Inc.
-
-;; Author: Simon Marshall <simon@gnu.org>
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: faces files
-;; Version: 2.11
-;; Obsolete-since: 22.1
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Purpose:
-;;
-;; Lazy Lock mode is a Font Lock support mode.
-;; It makes visiting buffers in Font Lock mode faster by making fontification
-;; be demand-driven, deferred and stealthy, so that fontification only occurs
-;; when, and where, necessary.
-;;
-;; See caveats and feedback below.
-;; See also the fast-lock package. (But don't use them at the same time!)
-
-;; Installation:
-;;
-;; Put in your ~/.emacs:
-;;
-;; (setq font-lock-support-mode 'lazy-lock-mode)
-;;
-;; Start up a new Emacs and use font-lock as usual (except that you can use the
-;; so-called "gaudier" fontification regexps on big files without frustration).
-;;
-;; In a buffer (which has `font-lock-mode' enabled) which is at least
-;; `lazy-lock-minimum-size' characters long, buffer fontification will not
-;; occur and only the visible portion of the buffer will be fontified. Motion
-;; around the buffer will fontify those visible portions not previously
-;; fontified. If stealth fontification is enabled, buffer fontification will
-;; occur in invisible parts of the buffer after `lazy-lock-stealth-time'
-;; seconds of idle time. If on-the-fly fontification is deferred, on-the-fly
-;; fontification will occur after `lazy-lock-defer-time' seconds of idle time.
-
-;; User-visible differences with version 1:
-;;
-;; - Version 2 can defer on-the-fly fontification. Therefore you need not, and
-;; should not, use defer-lock.el with this version of lazy-lock.el.
-;;
-;; A number of variables have changed meaning:
-;;
-;; - A value of nil for the variable `lazy-lock-minimum-size' means never turn
-;; on demand-driven fontification. In version 1 this meant always turn on
-;; demand-driven fontification. If you really want demand-driven fontification
-;; regardless of buffer size, set this variable to 0.
-;;
-;; - The variable `lazy-lock-stealth-lines' cannot have a nil value. In
-;; version 1 this meant use `window-height' as the maximum number of lines to
-;; fontify as a stealth chunk. This makes no sense; stealth fontification is
-;; of a buffer, not a window.
-
-;; Implementation differences with version 1:
-;;
-;; - Version 1 of lazy-lock.el is a bit of a hack. Version 1 demand-driven
-;; fontification, the core feature of lazy-lock.el, is implemented by placing a
-;; function on `post-command-hook'. This function fontifies where necessary,
-;; i.e., where a window scroll has occurred. However, there are a number of
-;; problems with using `post-command-hook':
-;;
-;; (a) As the name suggests, `post-command-hook' is run after every command,
-;; i.e., frequently and regardless of whether scrolling has occurred.
-;; (b) Scrolling can occur during a command, when `post-command-hook' is not
-;; run, i.e., it is not necessarily run after scrolling has occurred.
-;; (c) When `post-command-hook' is run, there is nothing to suggest where
-;; scrolling might have occurred, i.e., which windows have scrolled.
-;;
-;; Thus lazy-lock.el's function is called almost as often as possible, usually
-;; when it need not be called, yet it is not always called when it is needed.
-;; Also, lazy-lock.el's function must check each window to see if a scroll has
-;; occurred there. Worse still, lazy-lock.el's function must fontify a region
-;; twice as large as necessary to make sure the window is completely fontified.
-;; Basically, `post-command-hook' is completely inappropriate for lazy-lock.el.
-;;
-;; Ideally, we want to attach lazy-lock.el's function to a hook that is run
-;; only when scrolling occurs, e.g., `window-start' has changed, and tells us
-;; as much information as we need, i.e., the window and its new buffer region.
-;; Richard Stallman implemented a `window-scroll-functions' for Emacs 19.30.
-;; Functions on it are run when `window-start' has changed, and are supplied
-;; with the window and the window's new `window-start' position. (It would be
-;; better if it also supplied the window's new `window-end' position, but that
-;; is calculated as part of the redisplay process, and the functions on
-;; `window-scroll-functions' are run before redisplay has finished.) Thus, the
-;; hook deals with the above problems (a), (b) and (c).
-;;
-;; If only life was that easy. Version 2 demand-driven fontification is mostly
-;; implemented by placing a function on `window-scroll-functions'. However,
-;; not all scrolling occurs when `window-start' has changed. A change in
-;; window size, e.g., via C-x 1, or a significant deletion, e.g., of a number
-;; of lines, causes text previously invisible (i.e., after `window-end') to
-;; become visible without changing `window-start'. Arguably, these events are
-;; not scrolling events, but fontification must occur for lazy-lock.el to work.
-;; Hooks `window-size-change-functions' and `redisplay-end-trigger-functions'
-;; were added for these circumstances.
-;;
-;; (Ben Wing thinks these hooks are "horribly horribly kludgy", and implemented
-;; a `pre-idle-hook', a `mother-of-all-post-command-hooks', for XEmacs 19.14.
-;; He then hacked up a version 1 lazy-lock.el to use `pre-idle-hook' rather
-;; than `post-command-hook'. Whereas functions on `post-command-hook' are
-;; called almost as often as possible, functions on `pre-idle-hook' really are
-;; called as often as possible, even when the mouse moves and, on some systems,
-;; while XEmacs is idle. Thus, the hook deals with the above problem (b), but
-;; unfortunately it makes (a) worse and does not address (c) at all.
-;;
-;; I freely admit that `redisplay-end-trigger-functions' and, to a much lesser
-;; extent, `window-size-change-functions' are not pretty. However, I feel that
-;; a `window-scroll-functions' feature is cleaner than a `pre-idle-hook', and
-;; the result is faster and smaller, less intrusive and more targeted, code.
-;; Since `pre-idle-hook' is pretty much like `post-command-hook', there is no
-;; point in making this version of lazy-lock.el work with it. Anyway, that's
-;; Lit 30 of my humble opinion.
-;;
-;; - Version 1 stealth fontification is also implemented by placing a function
-;; on `post-command-hook'. This function waits for a given amount of time,
-;; and, if Emacs remains idle, fontifies where necessary. Again, there are a
-;; number of problems with using `post-command-hook':
-;;
-;; (a) Functions on `post-command-hook' are run sequentially, so this function
-;; can interfere with other functions on the hook, and vice versa.
-;; (b) This function waits for a given amount of time, so it can interfere with
-;; various features that are dealt with by Emacs after a command, e.g.,
-;; region highlighting, asynchronous updating and keystroke echoing.
-;; (c) Fontification may be required during a command, when `post-command-hook'
-;; is not run. (Version 2 deferred fontification only.)
-;;
-;; Again, `post-command-hook' is completely inappropriate for lazy-lock.el.
-;; Richard Stallman and Morten Welinder implemented internal Timers and Idle
-;; Timers for Emacs 19.31. Functions can be run independently at given times
-;; or after given amounts of idle time. Thus, the feature deals with the above
-;; problems (a), (b) and (c). Version 2 deferral and stealth are implemented
-;; by functions on Idle Timers. (A function on XEmacs' `pre-idle-hook' is
-;; similar to an Emacs Idle Timer function with a fixed zero second timeout.)
-
-;; - Version 1 has the following problems (relative to version 2):
-;;
-;; (a) It is slow when it does its job.
-;; (b) It does not always do its job when it should.
-;; (c) It slows all interaction (when it doesn't need to do its job).
-;; (d) It interferes with other package functions on `post-command-hook'.
-;; (e) It interferes with Emacs things within the read-eval loop.
-;;
-;; Ben's hacked-up lazy-lock.el 1.14 almost solved (b) but made (c) worse.
-;;
-;; - Version 2 has the following additional features (relative to version 1):
-;;
-;; (a) It can defer fontification (both on-the-fly and on-scrolling).
-;; (b) It can fontify contextually (syntactically true on-the-fly).
-
-;; Caveats:
-;;
-;; Lazy Lock mode does not work efficiently with Outline mode.
-;; This is because when in Outline mode, although text may be not visible to
-;; you in the window, the text is visible to Emacs Lisp code (not surprisingly)
-;; and Lazy Lock fontifies it mercilessly. Maybe it will be fixed one day.
-;;
-;; Because buffer text is not necessarily fontified, other packages that expect
-;; buffer text to be fontified in Font Lock mode either might not work as
-;; expected, or might not display buffer text as expected. An example of the
-;; latter is `occur', which copies lines of buffer text into another buffer.
-;;
-;; In Emacs 19.30, Lazy Lock mode does not ensure that an existing buffer is
-;; fontified if it is made visible via a minibuffer-less command that replaces
-;; an existing window's buffer (e.g., via the Buffers menu). Upgrade!
-;;
-;; In Emacs 19.30, Lazy Lock mode does not work well with Transient Mark mode
-;; or modes based on Comint mode (e.g., Shell mode), and also interferes with
-;; the echoing of keystrokes in the minibuffer. This is because of the way
-;; deferral and stealth have to be implemented for Emacs 19.30. Upgrade!
-;;
-;; Currently XEmacs does not have the features to support this version of
-;; lazy-lock.el. Maybe it will one day.
-\f
-;; History:
-;;
-;; 1.15--2.00:
-;; - Rewrite for Emacs 19.30 and the features rms added to support lazy-lock.el
-;; so that it could work correctly and efficiently.
-;; - Many thanks to those who reported bugs, fixed bugs, made suggestions or
-;; otherwise contributed in the version 1 cycle; Jari Aalto, Kevin Broadey,
-;; Ulrik Dickow, Bill Dubuque, Bob Glickstein, Boris Goldowsky,
-;; Jonas Jarnestrom, David Karr, Michael Kifer, Erik Naggum, Rick Sladkey,
-;; Jim Thompson, Ben Wing, Ilya Zakharevich, and Richard Stallman.
-;; 2.00--2.01:
-;; - Made `lazy-lock-fontify-after-command' always `sit-for' and so redisplay
-;; - Use `buffer-name' not `buffer-live-p' (Bill Dubuque hint)
-;; - Made `lazy-lock-install' do `add-to-list' not `setq' of `current-buffer'
-;; - Made `lazy-lock-fontify-after-install' loop over buffer list
-;; - Made `lazy-lock-arrange-before-change' to arrange `window-end' triggering
-;; - Made `lazy-lock-let-buffer-state' wrap both `befter-change-functions'
-;; - Made `lazy-lock-fontify-region' do `condition-case' (Hyman Rosen report)
-;; 2.01--2.02:
-;; - Use `buffer-live-p' as `buffer-name' can barf (Richard Stanton report)
-;; - Made `lazy-lock-install' set `font-lock-fontified' (Kevin Davidson report)
-;; - Made `lazy-lock-install' add hooks only if needed
-;; - Made `lazy-lock-unstall' add `font-lock-after-change-function' if needed
-;; 2.02--2.03:
-;; - Made `lazy-lock-fontify-region' do `condition-case' for `quit' too
-;; - Made `lazy-lock-mode' respect the value of `font-lock-inhibit-thing-lock'
-;; - Added `lazy-lock-after-unfontify-buffer'
-;; - Removed `lazy-lock-fontify-after-install' hack
-;; - Made `lazy-lock-fontify-after-scroll' not `set-buffer' to `window-buffer'
-;; - Made `lazy-lock-fontify-after-trigger' not `set-buffer' to `window-buffer'
-;; - Made `lazy-lock-fontify-after-idle' be interruptible (Scott Burson hint)
-;; 2.03--2.04:
-;; - Rewrite for Emacs 19.31 idle timers
-;; - Renamed `buffer-windows' to `get-buffer-window-list'
-;; - Removed `buffer-live-p'
-;; - Made `lazy-lock-defer-after-change' always save `current-buffer'
-;; - Made `lazy-lock-fontify-after-defer' just process buffers
-;; - Made `lazy-lock-install-hooks' add hooks correctly (Kevin Broadey report)
-;; - Made `lazy-lock-install' cope if `lazy-lock-defer-time' is a list
-;; 2.04--2.05:
-;; - Rewrite for Common Lisp macros
-;; - Added `do-while' macro
-;; - Renamed `lazy-lock-let-buffer-state' macro to `save-buffer-state'
-;; - Returned `lazy-lock-fontify-after-install' hack (Darren Hall hint)
-;; - Added `lazy-lock-defer-on-scrolling' functionality (Scott Byer hint)
-;; - Made `lazy-lock-mode' wrap `font-lock-support-mode'
-;; 2.05--2.06:
-;; - Made `lazy-lock-fontify-after-defer' swap correctly (Scott Byer report)
-;; 2.06--2.07:
-;; - Added `lazy-lock-stealth-load' functionality (Rob Hooft hint)
-;; - Made `lazy-lock-unstall' call `lazy-lock-fontify-region' if needed
-;; - Made `lazy-lock-mode' call `lazy-lock-unstall' only if needed
-;; - Made `lazy-lock-defer-after-scroll' do `set-window-redisplay-end-trigger'
-;; - Added `lazy-lock-defer-contextually' functionality
-;; - Added `lazy-lock-defer-on-the-fly' from `lazy-lock-defer-time'
-;; - Renamed `lazy-lock-defer-driven' to `lazy-lock-defer-on-scrolling'
-;; - Removed `lazy-lock-submit-bug-report' and bade farewell
-;; 2.07--2.08:
-;; - Made `lazy-lock-fontify-conservatively' fontify around `window-point'
-;; - Made `save-buffer-state' wrap `inhibit-point-motion-hooks'
-;; - Added Custom support
-;; 2.08--2.09:
-;; - Removed `byte-*' variables from `eval-when-compile' (Erik Naggum hint)
-;; - Made various wrapping `inhibit-point-motion-hooks' (Vinicius Latorre hint)
-;; - Made `lazy-lock-fontify-after-idle' wrap `minibuffer-auto-raise'
-;; - Made `lazy-lock-fontify-after-defer' paranoid about deferred buffers
-;; 2.09--2.10:
-;; - Use `window-end' UPDATE arg for Emacs 20.4 and later.
-;; - Made deferral `widen' before unfontifying (Dan Nicolaescu report)
-;; - Use `lazy-lock-fontify-after-visage' for hideshow.el (Dan Nicolaescu hint)
-;; - Use `other' widget where possible (Andreas Schwab fix)
-;; 2.10--2.11:
-;; - Used `with-temp-message' where possible to make messages temporary.
-\f
-;;; Code:
-
-(require 'font-lock)
-(eval-when-compile (require 'cl-lib))
-
-(eval-when-compile
- ;;
- ;; We use this for clarity and speed. Naughty but nice.
- (defmacro do-while (test &rest body)
- "(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil.
-The order of execution is thus BODY, TEST, BODY, TEST and so on
-until TEST returns nil."
- (declare (indent 1) (debug t))
- `(while (progn ,@body ,test))))
-
-(defgroup lazy-lock nil
- "Font Lock support mode to fontify lazily."
- :group 'font-lock)
-
-(defvar lazy-lock-mode nil) ; Whether we are turned on.
-(defvar lazy-lock-buffers nil) ; For deferral.
-(defvar lazy-lock-timers (cons nil nil)) ; For deferral and stealth.
-\f
-;; User Variables:
-
-(defcustom lazy-lock-minimum-size 25600
- "Minimum size of a buffer for demand-driven fontification.
-On-demand fontification occurs if the buffer size is greater than this value.
-If nil, means demand-driven fontification is never performed.
-If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
-where MAJOR-MODE is a symbol or t (meaning the default). For example:
- ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576))
-means that the minimum size is 25K for buffers in C or C++ modes, one megabyte
-for buffers in Rmail mode, and size is irrelevant otherwise.
-
-The value of this variable is used when Lazy Lock mode is turned on."
- :type '(choice (const :tag "none" nil)
- (integer :tag "size")
- (repeat :menu-tag "mode specific" :tag "mode specific"
- :value ((t . nil))
- (cons :tag "Instance"
- (radio :tag "Mode"
- (const :tag "all" t)
- (symbol :tag "name"))
- (radio :tag "Size"
- (const :tag "none" nil)
- (integer :tag "size"))))))
-
-(defcustom lazy-lock-defer-on-the-fly t
- "If non-nil, means fontification after a change should be deferred.
-If nil, means on-the-fly fontification is performed. This means when changes
-occur in the buffer, those areas are immediately fontified.
-If a list, it should be a list of `major-mode' symbol names for which deferred
-fontification should occur. The sense of the list is negated if it begins with
-`not'. For example:
- (c-mode c++-mode)
-means that on-the-fly fontification is deferred for buffers in C and C++ modes
-only, and deferral does not occur otherwise.
-
-The value of this variable is used when Lazy Lock mode is turned on."
- :type '(choice (const :tag "never" nil)
- (const :tag "always" t)
- (set :menu-tag "mode specific" :tag "modes"
- :value (not)
- (const :tag "Except" not)
- (repeat :inline t (symbol :tag "mode")))))
-
-(defcustom lazy-lock-defer-on-scrolling nil
- "If non-nil, means fontification after a scroll should be deferred.
-If nil, means demand-driven fontification is performed. This means when
-scrolling into unfontified areas of the buffer, those areas are immediately
-fontified. Thus scrolling never presents unfontified areas. However, since
-fontification occurs during scrolling, scrolling may be slow.
-If t, means defer-driven fontification is performed. This means fontification
-of those areas is deferred. Thus scrolling may present momentarily unfontified
-areas. However, since fontification does not occur during scrolling, scrolling
-will be faster than demand-driven fontification.
-If any other value, e.g., `eventually', means demand-driven fontification is
-performed until the buffer is fontified, then buffer fontification becomes
-defer-driven. Thus scrolling never presents unfontified areas until the buffer
-is first fontified, after which subsequent scrolling may present future buffer
-insertions momentarily unfontified. However, since fontification does not
-occur during scrolling after the buffer is first fontified, scrolling will
-become faster. (But, since contextual changes continually occur, such a value
-makes little sense if `lazy-lock-defer-contextually' is non-nil.)
-
-The value of this variable is used when Lazy Lock mode is turned on."
- :type '(choice (const :tag "never" nil)
- (const :tag "always" t)
- (other :tag "eventually" eventually)))
-
-(defcustom lazy-lock-defer-contextually 'syntax-driven
- "If non-nil, means deferred fontification should be syntactically true.
-If nil, means deferred fontification occurs only on those lines modified. This
-means where modification on a line causes syntactic change on subsequent lines,
-those subsequent lines are not refontified to reflect their new context.
-If t, means deferred fontification occurs on those lines modified and all
-subsequent lines. This means those subsequent lines are refontified to reflect
-their new syntactic context, either immediately or when scrolling into them.
-If any other value, e.g., `syntax-driven', means deferred syntactically true
-fontification occurs only if syntactic fontification is performed using the
-buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil.
-
-The value of this variable is used when Lazy Lock mode is turned on."
- :type '(choice (const :tag "never" nil)
- (const :tag "always" t)
- (other :tag "syntax-driven" syntax-driven)))
-
-(defcustom lazy-lock-defer-time 0.25
- "Time in seconds to delay before beginning deferred fontification.
-Deferred fontification occurs if there is no input within this time.
-If nil, means fontification is never deferred, regardless of the values of the
-variables `lazy-lock-defer-on-the-fly', `lazy-lock-defer-on-scrolling' and
-`lazy-lock-defer-contextually'.
-
-The value of this variable is used when Lazy Lock mode is turned on."
- :type '(choice (const :tag "never" nil)
- (number :tag "seconds")))
-
-(defcustom lazy-lock-stealth-time 30
- "Time in seconds to delay before beginning stealth fontification.
-Stealth fontification occurs if there is no input within this time.
-If nil, means stealth fontification is never performed.
-
-The value of this variable is used when Lazy Lock mode is turned on."
- :type '(choice (const :tag "never" nil)
- (number :tag "seconds")))
-
-(defcustom lazy-lock-stealth-lines (if font-lock-maximum-decoration 100 250)
- "Maximum size of a chunk of stealth fontification.
-Each iteration of stealth fontification can fontify this number of lines.
-To speed up input response during stealth fontification, at the cost of stealth
-taking longer to fontify, you could reduce the value of this variable."
- :type '(integer :tag "lines"))
-
-(defcustom lazy-lock-stealth-load
- (if (condition-case nil (load-average) (error)) 200)
- "Load in percentage above which stealth fontification is suspended.
-Stealth fontification pauses when the system short-term load average (as
-returned by the function `load-average' if supported) goes above this level,
-thus reducing the demand that stealth fontification makes on the system.
-If nil, means stealth fontification is never suspended.
-To reduce machine load during stealth fontification, at the cost of stealth
-taking longer to fontify, you could reduce the value of this variable.
-See also `lazy-lock-stealth-nice'."
- :type (if (condition-case nil (load-average) (error))
- '(choice (const :tag "never" nil)
- (integer :tag "load"))
- '(const :format "%t: unsupported\n" nil)))
-
-(defcustom lazy-lock-stealth-nice 0.125
- "Time in seconds to pause between chunks of stealth fontification.
-Each iteration of stealth fontification is separated by this amount of time,
-thus reducing the demand that stealth fontification makes on the system.
-If nil, means stealth fontification is never paused.
-To reduce machine load during stealth fontification, at the cost of stealth
-taking longer to fontify, you could increase the value of this variable.
-See also `lazy-lock-stealth-load'."
- :type '(choice (const :tag "never" nil)
- (number :tag "seconds")))
-
-(defcustom lazy-lock-stealth-verbose
- (and (not lazy-lock-defer-contextually) (not (null font-lock-verbose)))
- "If non-nil, means stealth fontification should show status messages."
- :type 'boolean)
-\f
-;; User Functions:
-
-;;;###autoload
-(defun lazy-lock-mode (&optional arg)
- "Toggle Lazy Lock mode.
-With arg, turn Lazy Lock mode on if and only if arg is positive. Enable it
-automatically in your `~/.emacs' by:
-
- (setq font-lock-support-mode \\='lazy-lock-mode)
-
-For a newer font-lock support mode with similar functionality, see
-`jit-lock-mode'. Eventually, Lazy Lock mode will be deprecated in
-JIT Lock's favor.
-
-When Lazy Lock mode is enabled, fontification can be lazy in a number of ways:
-
-- Demand-driven buffer fontification if `lazy-lock-minimum-size' is non-nil.
- This means initial fontification does not occur if the buffer is greater than
- `lazy-lock-minimum-size' characters in length. Instead, fontification occurs
- when necessary, such as when scrolling through the buffer would otherwise
- reveal unfontified areas. This is useful if buffer fontification is too slow
- for large buffers.
-
-- Deferred scroll fontification if `lazy-lock-defer-on-scrolling' is non-nil.
- This means demand-driven fontification does not occur as you scroll.
- Instead, fontification is deferred until after `lazy-lock-defer-time' seconds
- of Emacs idle time, while Emacs remains idle. This is useful if
- fontification is too slow to keep up with scrolling.
-
-- Deferred on-the-fly fontification if `lazy-lock-defer-on-the-fly' is non-nil.
- This means on-the-fly fontification does not occur as you type. Instead,
- fontification is deferred until after `lazy-lock-defer-time' seconds of Emacs
- idle time, while Emacs remains idle. This is useful if fontification is too
- slow to keep up with your typing.
-
-- Deferred context fontification if `lazy-lock-defer-contextually' is non-nil.
- This means fontification updates the buffer corresponding to true syntactic
- context, after `lazy-lock-defer-time' seconds of Emacs idle time, while Emacs
- remains idle. Otherwise, fontification occurs on modified lines only, and
- subsequent lines can remain fontified corresponding to previous syntactic
- contexts. This is useful where strings or comments span lines.
-
-- Stealthy buffer fontification if `lazy-lock-stealth-time' is non-nil.
- This means remaining unfontified areas of buffers are fontified if Emacs has
- been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle.
- This is useful if any buffer has any deferred fontification.
-
-Basic Font Lock mode on-the-fly fontification behavior fontifies modified
-lines only. Thus, if `lazy-lock-defer-contextually' is non-nil, Lazy Lock mode
-on-the-fly fontification may fontify differently, albeit correctly. In any
-event, to refontify some lines you can use \\[font-lock-fontify-block].
-
-Stealth fontification only occurs while the system remains unloaded.
-If the system load rises above `lazy-lock-stealth-load' percent, stealth
-fontification is suspended. Stealth fontification intensity is controlled via
-the variable `lazy-lock-stealth-nice' and `lazy-lock-stealth-lines', and
-verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
- (interactive "P")
- (let* ((was-on lazy-lock-mode)
- (now-on (unless (memq 'lazy-lock-mode font-lock-inhibit-thing-lock)
- (if arg (> (prefix-numeric-value arg) 0) (not was-on)))))
- (cond ((and now-on (not font-lock-mode))
- ;; Turned on `lazy-lock-mode' rather than `font-lock-mode'.
- (message "Use font-lock-support-mode rather than calling lazy-lock-mode")
- (sit-for 2))
- (now-on
- ;; Turn ourselves on.
- (set (make-local-variable 'lazy-lock-mode) t)
- (lazy-lock-install))
- (was-on
- ;; Turn ourselves off.
- (set (make-local-variable 'lazy-lock-mode) nil)
- (lazy-lock-unstall)))))
-
-;;;###autoload
-(defun turn-on-lazy-lock ()
- "Unconditionally turn on Lazy Lock mode."
- (lazy-lock-mode t))
-
-(defun lazy-lock-install ()
- (let ((min-size (font-lock-value-in-major-mode lazy-lock-minimum-size))
- (defer-change (and lazy-lock-defer-time lazy-lock-defer-on-the-fly))
- (defer-scroll (and lazy-lock-defer-time lazy-lock-defer-on-scrolling))
- (defer-context (and lazy-lock-defer-time lazy-lock-defer-contextually
- (or (eq lazy-lock-defer-contextually t)
- (null font-lock-keywords-only)))))
- ;;
- ;; Tell Font Lock whether Lazy Lock will do fontification.
- (make-local-variable 'font-lock-fontified)
- (setq font-lock-fontified (and min-size (>= (buffer-size) min-size)))
- ;;
- ;; Add the text properties and fontify.
- (if (not font-lock-fontified)
- (lazy-lock-after-fontify-buffer)
- ;; Make sure we fontify in any existing windows showing the buffer.
- (let ((windows (get-buffer-window-list (current-buffer) 'nomini t)))
- (lazy-lock-after-unfontify-buffer)
- (while windows
- (lazy-lock-fontify-conservatively (car windows))
- (setq windows (cdr windows)))))
- ;;
- ;; Add the fontification hooks.
- (lazy-lock-install-hooks
- font-lock-fontified
- (cond ((eq (car-safe defer-change) 'not)
- (not (memq major-mode (cdr defer-change))))
- ((listp defer-change)
- (memq major-mode defer-change))
- (t
- defer-change))
- (eq defer-scroll t)
- defer-context)
- ;;
- ;; Add the fontification timers.
- (lazy-lock-install-timers
- (if (or defer-change defer-scroll defer-context) lazy-lock-defer-time)
- lazy-lock-stealth-time)))
-
-(defun lazy-lock-install-hooks (fontifying
- defer-change defer-scroll defer-context)
- ;;
- ;; Add hook if lazy-lock.el is fontifying on scrolling or is deferring.
- (when (or fontifying defer-change defer-scroll defer-context)
- (add-hook 'window-scroll-functions (if defer-scroll
- #'lazy-lock-defer-after-scroll
- #'lazy-lock-fontify-after-scroll)
- nil t))
- ;;
- ;; Add hook if lazy-lock.el is fontifying and is not deferring changes.
- (when (and fontifying (not defer-change) (not defer-context))
- (add-hook 'before-change-functions #'lazy-lock-arrange-before-change nil t))
- ;;
- ;; Replace Font Lock mode hook.
- (remove-hook 'after-change-functions #'font-lock-after-change-function t)
- (add-hook 'after-change-functions
- (cond ((and defer-change defer-context)
- #'lazy-lock-defer-rest-after-change)
- (defer-change
- #'lazy-lock-defer-line-after-change)
- (defer-context
- #'lazy-lock-fontify-rest-after-change)
- (t
- #'lazy-lock-fontify-line-after-change))
- nil t)
- ;;
- ;; Add package-specific hook.
- (add-hook 'outline-view-change-hook #'lazy-lock-fontify-after-visage nil t)
- (add-hook 'hs-hide-hook #'lazy-lock-fontify-after-visage nil t))
-
-(defun lazy-lock-install-timers (dtime stime)
- ;; Schedule or re-schedule the deferral and stealth timers.
- ;; The layout of `lazy-lock-timers' is:
- ;; ((DEFER-TIME . DEFER-TIMER) (STEALTH-TIME . STEALTH-TIMER)
- ;; If an idle timeout has changed, cancel the existing idle timer (if there
- ;; is one) and schedule a new one (if the new idle timeout is non-nil).
- (unless (eq dtime (car (car lazy-lock-timers)))
- (let ((defer (car lazy-lock-timers)))
- (when (cdr defer)
- (cancel-timer (cdr defer)))
- (setcar lazy-lock-timers (cons dtime (and dtime
- (run-with-idle-timer dtime t #'lazy-lock-fontify-after-defer))))))
- (unless (eq stime (car (cdr lazy-lock-timers)))
- (let ((stealth (cdr lazy-lock-timers)))
- (when (cdr stealth)
- (cancel-timer (cdr stealth)))
- (setcdr lazy-lock-timers (cons stime (and stime
- (run-with-idle-timer stime t #'lazy-lock-fontify-after-idle)))))))
-
-(defun lazy-lock-unstall ()
- ;;
- ;; If Font Lock mode is still enabled, make sure that the buffer is
- ;; fontified, and reinstall its hook. We must do this first.
- (when font-lock-mode
- (when (lazy-lock-unfontified-p)
- (let ((verbose (if (numberp font-lock-verbose)
- (> (buffer-size) font-lock-verbose)
- font-lock-verbose)))
- (with-temp-message
- (when verbose
- (format "Fontifying %s..." (buffer-name)))
- ;; Make sure we fontify etc. in the whole buffer.
- (save-restriction
- (widen)
- (lazy-lock-fontify-region (point-min) (point-max))))))
- (add-hook 'after-change-functions #'font-lock-after-change-function nil t))
- ;;
- ;; Remove the text properties.
- (lazy-lock-after-unfontify-buffer)
- ;;
- ;; Remove the fontification hooks.
- (remove-hook 'window-scroll-functions #'lazy-lock-fontify-after-scroll t)
- (remove-hook 'window-scroll-functions #'lazy-lock-defer-after-scroll t)
- (remove-hook 'before-change-functions #'lazy-lock-arrange-before-change t)
- (remove-hook 'after-change-functions #'lazy-lock-fontify-line-after-change t)
- (remove-hook 'after-change-functions #'lazy-lock-fontify-rest-after-change t)
- (remove-hook 'after-change-functions #'lazy-lock-defer-line-after-change t)
- (remove-hook 'after-change-functions #'lazy-lock-defer-rest-after-change t)
- (remove-hook 'outline-view-change-hook #'lazy-lock-fontify-after-visage t)
- (remove-hook 'hs-hide-hook #'lazy-lock-fontify-after-visage t))
-\f
-;; Hook functions.
-
-;; Lazy Lock mode intervenes when (1) a previously invisible buffer region
-;; becomes visible, i.e., for demand- or defer-driven on-the-scroll
-;; fontification, (2) a buffer modification occurs, i.e., for defer-driven
-;; on-the-fly fontification, (3) Emacs becomes idle, i.e., for fontification of
-;; deferred fontification and stealth fontification, and (4) other special
-;; occasions.
-
-;; 1. There are three ways whereby this can happen.
-;;
-;; (a) Scrolling the window, either explicitly (e.g., `scroll-up') or
-;; implicitly (e.g., `search-forward'). Here, `window-start' changes.
-;; Fontification occurs by adding `lazy-lock-fontify-after-scroll' (for
-;; demand-driven fontification) or `lazy-lock-defer-after-scroll' (for
-;; defer-driven fontification) to the hook `window-scroll-functions'.
-
-(defun lazy-lock-fontify-after-scroll (window window-start)
- ;; Called from `window-scroll-functions'.
- ;; Fontify WINDOW from WINDOW-START following the scroll.
- (let ((inhibit-point-motion-hooks t))
- (lazy-lock-fontify-region window-start (window-end window t)))
- ;; A prior deletion that did not cause scrolling, followed by a scroll, would
- ;; result in an unnecessary trigger after this if we did not cancel it now.
- (set-window-redisplay-end-trigger window nil))
-
-(defun lazy-lock-defer-after-scroll (window _window-start)
- ;; Called from `window-scroll-functions'.
- ;; Defer fontification following the scroll. Save the current buffer so that
- ;; we subsequently fontify in all windows showing the buffer.
- (unless (memq (current-buffer) lazy-lock-buffers)
- (push (current-buffer) lazy-lock-buffers))
- ;; A prior deletion that did not cause scrolling, followed by a scroll, would
- ;; result in an unnecessary trigger after this if we did not cancel it now.
- (set-window-redisplay-end-trigger window nil))
-
-;; (b) Resizing the window, either explicitly (e.g., `enlarge-window') or
-;; implicitly (e.g., `delete-other-windows'). Here, `window-end' changes.
-;; Fontification occurs by adding `lazy-lock-fontify-after-resize' to the
-;; hook `window-size-change-functions'.
-
-(defun lazy-lock-fontify-after-resize (frame)
- ;; Called from `window-size-change-functions'.
- ;; Fontify windows in FRAME following the resize. We cannot use
- ;; `window-start' or `window-end' so we fontify conservatively.
- (save-excursion
- (save-selected-window
- (select-frame frame)
- (walk-windows (function (lambda (window)
- (set-buffer (window-buffer window))
- (when lazy-lock-mode
- (lazy-lock-fontify-conservatively window))
- (set-window-redisplay-end-trigger window nil)))
- 'nomini frame))))
-
-;; (c) Deletion in the buffer. Here, a `window-end' marker can become visible.
-;; Fontification occurs by adding `lazy-lock-arrange-before-change' to
-;; `before-change-functions' and `lazy-lock-fontify-after-trigger' to the
-;; hook `redisplay-end-trigger-functions'. Before every deletion, the
-;; marker `window-redisplay-end-trigger' position is set to the soon-to-be
-;; changed `window-end' position. If the marker becomes visible,
-;; `lazy-lock-fontify-after-trigger' gets called. Ouch. Note that we only
-;; have to deal with this eventuality if there is no on-the-fly deferral.
-
-(defun lazy-lock-arrange-before-change (beg end)
- ;; Called from `before-change-functions'.
- ;; Arrange that if text becomes visible it will be fontified (if a deletion
- ;; is pending, text might become visible at the bottom).
- (unless (eq beg end)
- (let ((windows (get-buffer-window-list (current-buffer) 'nomini t)) window)
- (while windows
- (setq window (car windows))
- (unless (markerp (window-redisplay-end-trigger window))
- (set-window-redisplay-end-trigger window (make-marker)))
- (set-marker (window-redisplay-end-trigger window) (window-end window))
- (setq windows (cdr windows))))))
-
-(defun lazy-lock-fontify-after-trigger (window trigger-point)
- ;; Called from `redisplay-end-trigger-functions'.
- ;; Fontify WINDOW from TRIGGER-POINT following the redisplay.
- ;; We could probably just use `lazy-lock-fontify-after-scroll' without loss:
- ;; (inline (lazy-lock-fontify-after-scroll window (window-start window)))
- (let ((inhibit-point-motion-hooks t))
- (lazy-lock-fontify-region trigger-point (window-end window t))))
-
-;; 2. Modified text must be marked as unfontified so it can be identified and
-;; fontified later when Emacs is idle. Deferral occurs by adding one of
-;; `lazy-lock-fontify-*-after-change' (for on-the-fly fontification) or
-;; `lazy-lock-defer-*-after-change' (for deferred fontification) to the
-;; hook `after-change-functions'.
-
-(defalias 'lazy-lock-fontify-line-after-change
- ;; Called from `after-change-functions'.
- ;; Fontify the current change.
- #'font-lock-after-change-function)
-
-(defun lazy-lock-fontify-rest-after-change (beg end old-len)
- ;; Called from `after-change-functions'.
- ;; Fontify the current change and defer fontification of the rest of the
- ;; buffer. Save the current buffer so that we subsequently fontify in all
- ;; windows showing the buffer.
- (lazy-lock-fontify-line-after-change beg end old-len)
- (with-silent-modifications
- (unless (memq (current-buffer) lazy-lock-buffers)
- (push (current-buffer) lazy-lock-buffers))
- (save-restriction
- (widen)
- (remove-text-properties end (point-max) '(lazy-lock nil)))))
-
-(defun lazy-lock-defer-line-after-change (beg end _old-len)
- ;; Called from `after-change-functions'.
- ;; Defer fontification of the current change. Save the current buffer so
- ;; that we subsequently fontify in all windows showing the buffer.
- (with-silent-modifications
- (unless (memq (current-buffer) lazy-lock-buffers)
- (push (current-buffer) lazy-lock-buffers))
- (remove-text-properties (max (1- beg) (point-min))
- (min (1+ end) (point-max))
- '(lazy-lock nil))))
-
-(defun lazy-lock-defer-rest-after-change (beg _end _old-len)
- ;; Called from `after-change-functions'.
- ;; Defer fontification of the rest of the buffer. Save the current buffer so
- ;; that we subsequently fontify in all windows showing the buffer.
- (with-silent-modifications
- (unless (memq (current-buffer) lazy-lock-buffers)
- (push (current-buffer) lazy-lock-buffers))
- (save-restriction
- (widen)
- (remove-text-properties (max (1- beg) (point-min))
- (point-max)
- '(lazy-lock nil)))))
-
-;; 3. Deferred fontification and stealth fontification are done from these two
-;; functions. They are set up as Idle Timers.
-
-(defun lazy-lock-fontify-after-defer ()
- ;; Called from `timer-idle-list'.
- ;; Fontify all windows where deferral has occurred for its buffer.
- (save-excursion
- (while (and lazy-lock-buffers (not (input-pending-p)))
- (let ((buffer (car lazy-lock-buffers)) windows)
- ;; Paranoia: check that the buffer is still live and Lazy Lock mode on.
- (when (buffer-live-p buffer)
- (set-buffer buffer)
- (when lazy-lock-mode
- (setq windows (get-buffer-window-list buffer 'nomini t))
- (while windows
- (lazy-lock-fontify-window (car windows))
- (setq windows (cdr windows)))))
- (setq lazy-lock-buffers (cdr lazy-lock-buffers)))))
- ;; Add hook if fontification should now be defer-driven in this buffer.
- (when (and lazy-lock-mode lazy-lock-defer-on-scrolling
- (memq #'lazy-lock-fontify-after-scroll window-scroll-functions)
- (not (or (input-pending-p) (lazy-lock-unfontified-p))))
- (remove-hook 'window-scroll-functions #'lazy-lock-fontify-after-scroll t)
- (add-hook 'window-scroll-functions #'lazy-lock-defer-after-scroll nil t)))
-
-(defun lazy-lock-fontify-after-idle ()
- ;; Called from `timer-idle-list'.
- ;; Fontify all buffers that need it, stealthily while idle.
- (unless (or executing-kbd-macro (window-minibuffer-p (selected-window)))
- ;; Loop over all buffers, fontify stealthily for each if necessary.
- (let ((buffers (buffer-list)) (continue t)
- message message-log-max minibuffer-auto-raise)
- (save-excursion
- (do-while (and buffers continue)
- (set-buffer (car buffers))
- (if (not (and lazy-lock-mode (lazy-lock-unfontified-p)))
- (setq continue (not (input-pending-p)))
- ;; Fontify regions in this buffer while there is no input.
- (with-temp-message
- (when lazy-lock-stealth-verbose
- "Fontifying stealthily...")
- (do-while (and (lazy-lock-unfontified-p) continue)
- (if (and lazy-lock-stealth-load
- (> (car (load-average)) lazy-lock-stealth-load))
- ;; Wait a while before continuing with the loop.
- (progn
- (when message
- (message "Fontifying stealthily...suspended")
- (setq message nil))
- (setq continue (sit-for (or lazy-lock-stealth-time 30))))
- ;; Fontify a chunk.
- (when lazy-lock-stealth-verbose
- (if message
- (message "Fontifying stealthily... %2d%% of %s"
- (lazy-lock-percent-fontified) (buffer-name))
- (message "Fontifying stealthily...")
- (setq message t)))
- ;; Current buffer may have changed during `sit-for'.
- (set-buffer (car buffers))
- (lazy-lock-fontify-chunk)
- (setq continue (sit-for (or lazy-lock-stealth-nice 0)))))))
- (setq buffers (cdr buffers)))))))
-
-;; 4. Special circumstances.
-
-(defun lazy-lock-fontify-after-visage ()
- ;; Called from `outline-view-change-hook' and `hs-hide-hook'.
- ;; Fontify windows showing the current buffer, as its visibility has changed.
- ;; This is a conspiracy hack between lazy-lock.el, outline.el and
- ;; hideshow.el.
- (let ((windows (get-buffer-window-list (current-buffer) 'nomini t)))
- (while windows
- (lazy-lock-fontify-conservatively (car windows))
- (setq windows (cdr windows)))))
-
-(defun lazy-lock-after-fontify-buffer ()
- ;; Called from `font-lock-after-fontify-buffer'.
- ;; Mark the current buffer as fontified.
- ;; This is a conspiracy hack between lazy-lock.el and font-lock.el.
- (with-silent-modifications
- (add-text-properties (point-min) (point-max) '(lazy-lock t))))
-
-(defun lazy-lock-after-unfontify-buffer ()
- ;; Called from `font-lock-after-unfontify-buffer'.
- ;; Mark the current buffer as unfontified.
- ;; This is a conspiracy hack between lazy-lock.el and font-lock.el.
- (with-silent-modifications
- (remove-text-properties (point-min) (point-max) '(lazy-lock nil))))
-\f
-;; Fontification functions.
-
-;; If packages want to ensure that some region of the buffer is fontified, they
-;; should use this function. For an example, see ps-print.el.
-(defun lazy-lock-fontify-region (beg end)
- ;; Fontify between BEG and END, where necessary, in the current buffer.
- (save-restriction
- (widen)
- (when (setq beg (text-property-any beg end 'lazy-lock nil))
- (save-excursion
- (with-silent-modifications
- (let ((inhibit-point-motion-hooks t))
- ;; Find successive unfontified regions between BEG and END.
- (condition-case data
- (do-while beg
- (let ((next (or (text-property-any beg end 'lazy-lock t)
- end)))
- ;; Make sure the region end points are at beginning of line.
- (goto-char beg)
- (unless (bolp)
- (beginning-of-line)
- (setq beg (point)))
- (goto-char next)
- (unless (bolp)
- (forward-line)
- (setq next (point)))
- ;; Fontify the region, then flag it as fontified.
- (font-lock-fontify-region beg next)
- (add-text-properties beg next '(lazy-lock t))
- (setq beg (text-property-any next end 'lazy-lock nil))))
- ((error quit) (message "Fontifying region...%s" data)))))))))
-
-(defun lazy-lock-fontify-chunk ()
- ;; Fontify the nearest chunk, for stealth, in the current buffer.
- (let ((inhibit-point-motion-hooks t))
- (save-excursion
- (save-restriction
- (widen)
- ;; Move to end of line in case the character at point is not fontified.
- (end-of-line)
- ;; Find where the previous (next) unfontified regions end (begin).
- (let ((prev (previous-single-property-change (point) 'lazy-lock))
- (next (text-property-any (point) (point-max) 'lazy-lock nil)))
- ;; Fontify from the nearest unfontified position.
- (if (or (null prev) (and next (< (- next (point)) (- (point) prev))))
- ;; The next, or neither, region is the nearest not fontified.
- (lazy-lock-fontify-region
- (progn (goto-char (or next (point-min)))
- (beginning-of-line)
- (point))
- (progn (goto-char (or next (point-min)))
- (forward-line lazy-lock-stealth-lines)
- (point)))
- ;; The previous region is the nearest not fontified.
- (lazy-lock-fontify-region
- (progn (goto-char prev)
- (forward-line (- lazy-lock-stealth-lines))
- (point))
- (progn (goto-char prev)
- (forward-line)
- (point)))))))))
-
-(defun lazy-lock-fontify-window (window)
- ;; Fontify in WINDOW between `window-start' and `window-end'.
- ;; We can only do this when we can use `window-start' and `window-end'.
- (with-current-buffer (window-buffer window)
- (lazy-lock-fontify-region (window-start window) (window-end window))))
-
-(defun lazy-lock-fontify-conservatively (window)
- ;; Fontify in WINDOW conservatively around point.
- ;; Where we cannot use `window-start' and `window-end' we do `window-height'
- ;; lines around point. That way we guarantee to have done enough.
- (with-current-buffer (window-buffer window)
- (let ((inhibit-point-motion-hooks t))
- (lazy-lock-fontify-region
- (save-excursion
- (goto-char (window-point window))
- (vertical-motion (- (window-height window)) window) (point))
- (save-excursion
- (goto-char (window-point window))
- (vertical-motion (window-height window) window) (point))))))
-
-(defun lazy-lock-unfontified-p ()
- ;; Return non-nil if there is anywhere still to be fontified.
- (save-restriction
- (widen)
- (text-property-any (point-min) (point-max) 'lazy-lock nil)))
-
-(defun lazy-lock-percent-fontified ()
- ;; Return the percentage (of characters) of the buffer that are fontified.
- (save-restriction
- (widen)
- (let ((beg (point-min)) (size 0) next)
- ;; Find where the next fontified region begins.
- (while (setq beg (text-property-any beg (point-max) 'lazy-lock t))
- (setq next (or (text-property-any beg (point-max) 'lazy-lock nil)
- (point-max)))
- (cl-incf size (- next beg))
- (setq beg next))
- ;; Float because using integer multiplication will frequently overflow.
- (truncate (* (/ (float size) (point-max)) 100)))))
-\f
-;; Version dependent workarounds and fixes.
-
-(when (consp lazy-lock-defer-time)
- ;;
- ;; In 2.06.04 and below, `lazy-lock-defer-time' could specify modes and time.
- (with-output-to-temp-buffer "*Help*"
- (princ "The value of the variable `lazy-lock-defer-time' was\n ")
- (princ lazy-lock-defer-time)
- (princ "\n")
- (princ "This variable cannot now be a list of modes and time,\n")
- (princ "so instead use ")
- (princ (substitute-command-keys "\\[customize-option]"))
- (princ " to modify the variables, or put the forms:\n")
- (princ " (setq lazy-lock-defer-time ")
- (princ (cdr lazy-lock-defer-time))
- (princ ")\n")
- (princ " (setq lazy-lock-defer-on-the-fly '")
- (princ (car lazy-lock-defer-time))
- (princ ")\n")
- (princ "in your ~/.emacs. ")
- (princ "The above forms have been evaluated for this editor session,\n")
- (princ "but you should use ")
- (princ (substitute-command-keys "\\[customize-option]"))
- (princ " or change your ~/.emacs now."))
- (setq lazy-lock-defer-on-the-fly (car lazy-lock-defer-time)
- lazy-lock-defer-time (cdr lazy-lock-defer-time)))
-
-(when (boundp 'lazy-lock-defer-driven)
- ;;
- ;; In 2.06.04 and below, `lazy-lock-defer-driven' was the variable name.
- (with-output-to-temp-buffer "*Help*"
- (princ "The value of the variable `lazy-lock-defer-driven' is set to ")
- (if (memq lazy-lock-defer-driven '(nil t))
- (princ lazy-lock-defer-driven)
- (princ "`")
- (princ lazy-lock-defer-driven)
- (princ "'"))
- (princ ".\n")
- (princ "This variable is now called `lazy-lock-defer-on-scrolling',\n")
- (princ "so instead use ")
- (princ (substitute-command-keys "\\[customize-option]"))
- (princ " to modify the variable, or put the form:\n")
- (princ " (setq lazy-lock-defer-on-scrolling ")
- (unless (memq lazy-lock-defer-driven '(nil t))
- (princ "'"))
- (princ lazy-lock-defer-driven)
- (princ ")\n")
- (princ "in your ~/.emacs. ")
- (princ "The above form has been evaluated for this editor session,\n")
- (princ "but you should use ")
- (princ (substitute-command-keys "\\[customize-option]"))
- (princ " or change your ~/.emacs now."))
- (setq lazy-lock-defer-on-scrolling lazy-lock-defer-driven))
-\f
-;; Install ourselves:
-
-(add-hook 'window-size-change-functions #'lazy-lock-fontify-after-resize)
-(add-hook 'redisplay-end-trigger-functions #'lazy-lock-fontify-after-trigger)
-
-(unless (assq 'lazy-lock-mode minor-mode-alist)
- (setq minor-mode-alist (append minor-mode-alist '((lazy-lock-mode nil)))))
-
-(provide 'lazy-lock)
-
-;; Local Variables:
-;; byte-compile-warnings: (not obsolete)
-;; End:
-
-;;; lazy-lock.el ends here
projects / emacs.git / commitdiff