-;;; lazy-lock.el --- Lazy demand-driven fontification for fast Font Lock mode.
+;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode
-;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 2001
+;; Free Software Foundation, Inc.
-;; Author: Simon Marshall <simon@gnu.ai.mit.edu>
+;; Author: Simon Marshall <simon@gnu.org>
+;; Maintainer: FSF
;; Keywords: faces files
-;; Version: 2.08.04
+;; Version: 2.11
-;;; This file is part of GNU Emacs.
+;; 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
;; point in making this version of lazy-lock.el work with it. Anyway, that's
;; Lit 30 of my humble opinion.
;;
-;; Steve Baur reverted to a non-hacked version 1 lazy-lock.el for XEmacs 19.15
-;; and 20.0. Obviously, the above `post-command-hook' problems still apply.)
-;;
;; - 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
;; - 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)
-;; Make sure lazy-lock.el is supported.
-(if (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version)))
- t
- (and (= emacs-major-version 19) (< emacs-minor-version 30)))
- (error "`lazy-lock' was written for Emacs 19.30 or later"))
-
(eval-when-compile
- ;;
- ;; We don't do this at the top-level as idle timers are not necessarily used.
- (require 'timer)
- ;; We don't do this at the top-level as we only use non-autoloaded macros.
- (require 'cl)
- ;;
- ;; We use this to preserve or protect things when modifying text properties.
- (defmacro save-buffer-state (varlist &rest body)
- "Bind variables according to VARLIST and eval BODY restoring buffer state."
- (` (let* ((,@ (append varlist
- '((modified (buffer-modified-p)) (buffer-undo-list t)
- (inhibit-read-only t) (inhibit-point-motion-hooks t)
- before-change-functions after-change-functions
- deactivate-mark buffer-file-name buffer-file-truename))))
- (,@ body)
- (when (and (not modified) (buffer-modified-p))
- (set-buffer-modified-p nil)))))
- (put 'save-buffer-state 'lisp-indent-function 1)
- ;;
- ;; 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.
+ ;; We don't do this at the top-level as we only use non-autoloaded macros.
+ (require 'cl)
+ ;;
+ ;; We use this to preserve or protect things when modifying text properties.
+ (defmacro save-buffer-state (varlist &rest body)
+ "Bind variables according to VARLIST and eval BODY restoring buffer state."
+ `(let* (,@(append varlist
+ '((modified (buffer-modified-p))
+ (buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ deactivate-mark
+ buffer-file-name
+ buffer-file-truename)))
+ ,@body
+ (when (and (not modified) (buffer-modified-p))
+ (restore-buffer-modified-p nil))))
+ (put 'save-buffer-state 'lisp-indent-function 1)
+ ;;
+ ;; 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."
- (` (while (progn (,@ body) (, test)))))
- (put 'do-while 'lisp-indent-function (get 'while 'lisp-indent-function))
- ;;
- ;; We use this for clarity and speed. Borrowed from a future Emacs.
- (or (fboundp 'with-current-buffer)
- (defmacro with-current-buffer (buffer &rest body)
- "Execute the forms in BODY with BUFFER as the current buffer.
-The value returned is the value of the last form in BODY."
- (` (save-excursion (set-buffer (, buffer)) (,@ body)))))
- (put 'with-current-buffer 'lisp-indent-function 1)
- ;;
- ;; We use this for compatibility with a future Emacs.
- (or (fboundp 'defcustom)
- (defmacro defcustom (symbol value doc &rest args)
- (` (defvar (, symbol) (, value) (, doc))))))
-
-;(defun lazy-lock-submit-bug-report ()
-; "Submit via mail a bug report on lazy-lock.el."
-; (interactive)
-; (let ((reporter-prompt-for-summary-p t))
-; (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "lazy-lock 2.08.04"
-; '(lazy-lock-minimum-size lazy-lock-defer-on-the-fly
-; lazy-lock-defer-on-scrolling lazy-lock-defer-contextually
-; lazy-lock-defer-time lazy-lock-stealth-time
-; lazy-lock-stealth-load lazy-lock-stealth-nice lazy-lock-stealth-lines
-; lazy-lock-stealth-verbose)
-; nil nil
-; (concat "Hi Si.,
-;
-;I want to report a bug. I've read the `Bugs' section of `Info' on Emacs, so I
-;know how to make a clear and unambiguous report. To reproduce the bug:
-;
-;Start a fresh editor via `" invocation-name " -no-init-file -no-site-file'.
-;In the `*scratch*' buffer, evaluate:"))))
+ `(while (progn ,@body ,test)))
+ (put 'do-while 'lisp-indent-function (get 'while 'lisp-indent-function)))
(defvar lazy-lock-mode nil) ; Whether we are turned on.
(defvar lazy-lock-buffers nil) ; For deferral.
\f
;; User Variables:
-(defcustom lazy-lock-minimum-size (* 25 1024)
+(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.
The value of this variable is used when Lazy Lock mode is turned on."
:type '(choice (const :tag "never" nil)
(const :tag "always" t)
- (sexp :tag "eventually" :format "%t\n" eventually))
+ (other :tag "eventually" eventually))
:group 'lazy-lock)
(defcustom lazy-lock-defer-contextually 'syntax-driven
The value of this variable is used when Lazy Lock mode is turned on."
:type '(choice (const :tag "never" nil)
(const :tag "always" t)
- (sexp :tag "syntax-driven" :format "%t\n" syntax-driven))
+ (other :tag "syntax-driven" syntax-driven))
:group 'lazy-lock)
(defcustom lazy-lock-defer-time
(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.
;;
;; Add hook if lazy-lock.el is fontifying on scrolling or is deferring.
(when (or fontifying defer-change defer-scroll defer-context)
- (make-local-hook 'window-scroll-functions)
(add-hook 'window-scroll-functions (if defer-scroll
'lazy-lock-defer-after-scroll
'lazy-lock-fontify-after-scroll)
;;
;; Add hook if lazy-lock.el is fontifying and is not deferring changes.
(when (and fontifying (not defer-change) (not defer-context))
- (make-local-hook 'before-change-functions)
(add-hook 'before-change-functions 'lazy-lock-arrange-before-change nil t))
;;
;; Replace Font Lock mode hook.
nil t)
;;
;; Add package-specific hook.
- (make-local-hook 'outline-view-change-hook)
- (add-hook 'outline-view-change-hook 'lazy-lock-fontify-after-outline nil t))
+ (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.
(let ((verbose (if (numberp font-lock-verbose)
(> (buffer-size) font-lock-verbose)
font-lock-verbose)))
- (if verbose (message "Fontifying %s..." (buffer-name)))
- ;; Make sure we fontify etc. in the whole buffer.
- (save-restriction
- (widen)
- (lazy-lock-fontify-region (point-min) (point-max)))
- (if verbose (message "Fontifying %s...%s" (buffer-name)
- (if (lazy-lock-unfontified-p) "quit" "done")))))
+ (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.
(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-outline 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.
(defun lazy-lock-fontify-after-scroll (window window-start)
;; Called from `window-scroll-functions'.
- ;; Fontify WINDOW from WINDOW-START following the scroll. We cannot use
- ;; `window-end' so we work out what it would be via `vertical-motion'.
+ ;; Fontify WINDOW from WINDOW-START following the scroll.
(let ((inhibit-point-motion-hooks t))
- (save-excursion
- (goto-char window-start)
- (vertical-motion (window-height window) window)
- (lazy-lock-fontify-region window-start (point))))
+ (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-fontify-after-trigger (window trigger-point)
;; Called from `redisplay-end-trigger-functions'.
- ;; Fontify WINDOW from TRIGGER-POINT. We cannot use `window-end' so we work
- ;; out what it would be via `vertical-motion'.
+ ;; Fontify WINDOW from TRIGGER-POINT following the redisplay.
;; We could probably just use `lazy-lock-fontify-after-scroll' without loss:
- ;; (lazy-lock-fontify-after-scroll window (window-start window))
+ ;; (inline (lazy-lock-fontify-after-scroll window (window-start window)))
(let ((inhibit-point-motion-hooks t))
- (save-excursion
- (goto-char (window-start window))
- (vertical-motion (window-height window) window)
- (lazy-lock-fontify-region trigger-point (point)))))
+ (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
(save-buffer-state nil
(unless (memq (current-buffer) lazy-lock-buffers)
(push (current-buffer) lazy-lock-buffers))
- (remove-text-properties end (point-max) '(lazy-lock nil))))
+ (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'.
(save-buffer-state nil
(unless (memq (current-buffer) lazy-lock-buffers)
(push (current-buffer) lazy-lock-buffers))
- (remove-text-properties (max (1- beg) (point-min))
- (point-max)
- '(lazy-lock nil))))
+ (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.
- (while (and lazy-lock-buffers (not (input-pending-p)))
- (let ((windows (get-buffer-window-list (car lazy-lock-buffers) 'nomini t)))
- (while windows
- (lazy-lock-fontify-window (car windows))
- (setq windows (cdr windows)))
- (setq lazy-lock-buffers (cdr lazy-lock-buffers))))
+ (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)
(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.
- (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.
+ (with-temp-message
(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)))
- (lazy-lock-fontify-chunk)
- (setq continue (sit-for (or lazy-lock-stealth-nice 0))))))
- (setq buffers (cdr buffers))))
- (when message
- (message "Fontifying stealthily...%s" (if continue "done" "quit"))))))
+ "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-outline ()
- ;; Called from `outline-view-change-hook'.
+(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 and noutline.el.
+ ;; 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))
;; 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.
- (when (setq beg (text-property-any beg end 'lazy-lock nil))
- (save-excursion
- (save-match-data
- (save-buffer-state
- ;; Ensure syntactic fontification is always correct.
- (font-lock-beginning-of-syntax-function next)
- ;; Find successive unfontified regions between BEG and END.
- (condition-case data
- (do-while beg
- (setq 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))))))))
+ (save-restriction
+ (widen)
+ (when (setq beg (text-property-any beg end 'lazy-lock nil))
+ (save-excursion
+ (save-match-data
+ (save-buffer-state
+ ;; Ensure syntactic fontification is always correct.
+ (font-lock-beginning-of-syntax-function next)
+ ;; Find successive unfontified regions between BEG and END.
+ (condition-case data
+ (do-while beg
+ (setq 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.
\f
;; Version dependent workarounds and fixes.
-(when (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version)))
- nil
- (and (= emacs-major-version 19) (= emacs-minor-version 30)))
- ;;
- ;; We use `post-command-idle-hook' for deferral and stealth. Oh Lordy.
- (defun lazy-lock-install-timers (foo bar)
- (add-hook 'post-command-idle-hook 'lazy-lock-fontify-post-command t)
- (add-hook 'post-command-idle-hook 'lazy-lock-fontify-post-idle t)
- (add-to-list 'lazy-lock-install (current-buffer))
- (add-hook 'post-command-hook 'lazy-lock-fontify-after-install))
- (defun lazy-lock-fontify-post-command ()
- (and lazy-lock-buffers (not executing-kbd-macro)
- (progn
- (and deactivate-mark (deactivate-mark))
- (sit-for
- (or (cdr-safe lazy-lock-defer-time) lazy-lock-defer-time 0)))
- (lazy-lock-fontify-after-defer)))
- (defun lazy-lock-fontify-post-idle ()
- (and lazy-lock-stealth-time (not executing-kbd-macro)
- (not (window-minibuffer-p (selected-window)))
- (progn
- (and deactivate-mark (deactivate-mark))
- (sit-for lazy-lock-stealth-time))
- (lazy-lock-fontify-after-idle)))
- ;;
- ;; Simulate running of `window-scroll-functions' in `set-window-buffer'.
- (defvar lazy-lock-install nil)
- (defun lazy-lock-fontify-after-install ()
- (remove-hook 'post-command-hook 'lazy-lock-fontify-after-install)
- (while lazy-lock-install
- (mapcar 'lazy-lock-fontify-conservatively
- (get-buffer-window-list (pop lazy-lock-install) 'nomini t)))))
-
(when (consp lazy-lock-defer-time)
;;
;; In 2.06.04 and below, `lazy-lock-defer-time' could specify modes and time.
(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, ")
- (princ "so instead use the forms:\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 ")\n")
(princ "in your ~/.emacs. ")
(princ "The above forms have been evaluated for this editor session,\n")
- (princ "but you should change your ~/.emacs now."))
+ (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)))
(princ "'"))
(princ ".\n")
(princ "This variable is now called `lazy-lock-defer-on-scrolling',\n")
- (princ "so instead use the form:\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 ")\n")
(princ "in your ~/.emacs. ")
(princ "The above form has been evaluated for this editor session,\n")
- (princ "but you should change your ~/.emacs now."))
+ (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
-;; Possibly absent.
-
-(unless (boundp 'font-lock-inhibit-thing-lock)
- ;; Font Lock mode uses this to direct Lazy and Fast Lock modes to stay off.
- (defvar font-lock-inhibit-thing-lock nil
- "List of Font Lock mode related modes that should not be turned on."))
-
-(unless (fboundp 'font-lock-value-in-major-mode)
- (defun font-lock-value-in-major-mode (alist)
- ;; Return value in ALIST for `major-mode'.
- (if (consp alist)
- (cdr (or (assq major-mode alist) (assq t alist)))
- alist)))
-
-(unless (fboundp 'get-buffer-window-list)
- ;; We use this to get all windows showing a buffer we have to fontify.
- (defun get-buffer-window-list (buffer &optional minibuf frame)
- "Return windows currently displaying BUFFER, or nil if none."
- (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
- (walk-windows (function (lambda (window)
- (when (eq (window-buffer window) buffer)
- (push window windows))))
- minibuf frame)
- windows)))
-\f
;; Install ourselves:
(add-hook 'window-size-change-functions 'lazy-lock-fontify-after-resize)