;;; 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 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
+;; Version: 2.11
;;; This file is part of GNU Emacs.
;; 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 `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:
;; We don't do this at the top-level as we only use non-autoloaded macros.
(require 'cl)
;;
- ;; Well, shouldn't Lazy Lock mode be as lazy as possible?
- (setq byte-compile-dynamic t byte-compile-dynamic-docstrings t)
- ;; But, we make sure that the code is as zippy as can be.
- (setq byte-optimize t)
- ;;
;; 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."
"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))
+ (put 'with-current-buffer 'lisp-indent-function 1)
+ ;;
+ ;; We use this for compatibility with a future Emacs.
+ (or (fboundp 'with-temp-message)
+ (defmacro with-temp-message (message &rest body)
+ (` (let ((temp-message (, message)) current-message)
+ (unwind-protect
+ (progn
+ (when temp-message
+ (setq current-message (current-message))
+ (message temp-message))
+ (,@ body))
+ (when temp-message
+ (message current-message)))))))
+ ;;
+ ;; 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"
+; (reporter-submit-bug-report "simon@gnu.org" "lazy-lock 2.11"
; '(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
\f
;; User Variables:
-(defgroup lazy-lock nil
- "Font Lock support mode to fontify lazily."
- :link '(custom-manual "(emacs)Support Modes")
- :group 'font-lock)
-
-(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)
- (const 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)
- (const syntax-driven))
+ (other :tag "syntax-driven" syntax-driven))
:group 'lazy-lock)
(defcustom lazy-lock-defer-time
- (if (featurep 'lisp-float-type) (/ (float 1) (float 3)) 1)
+ (if (featurep 'lisp-float-type) (/ (float 1) (float 4)) 1)
"*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
:type (if (condition-case nil (load-average) (error))
'(choice (const :tag "never" nil)
(integer :tag "load"))
- '(const :tag "never" nil))
+ '(const :format "%t: unsupported\n" nil))
:group 'lazy-lock)
(defcustom lazy-lock-stealth-nice
;;
;; 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)
+ (make-local-hook 'hs-hide-hook)
+ (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'.
- (save-excursion
- (goto-char window-start)
- (vertical-motion (window-height window) window)
- (lazy-lock-fontify-region window-start (point)))
+ ;; 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-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))
- (save-excursion
- (goto-char (window-start window))
- (vertical-motion (window-height window) window)
- (lazy-lock-fontify-region trigger-point (point))))
+ ;; (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
(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)
;; 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)
+ (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.
- (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)))
+ (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))
(defun lazy-lock-fontify-chunk ()
;; Fontify the nearest chunk, for stealth, in the current buffer.
- (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, and next, unfontified regions end, and 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.
+ (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 (or next (point-min)))
- (beginning-of-line)
+ (progn (goto-char prev)
+ (forward-line (- lazy-lock-stealth-lines))
(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))))))))
+ (progn (goto-char prev)
+ (forward-line)
+ (point)))))))))
(defun lazy-lock-fontify-window (window)
;; Fontify in WINDOW between `window-start' and `window-end'.
;; 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)
- (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)))))
+ (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.
(mapcar 'lazy-lock-fontify-conservatively
(get-buffer-window-list (pop lazy-lock-install) 'nomini t)))))
+(when (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version)))
+ nil
+ (or (and (= emacs-major-version 20) (< emacs-minor-version 4))
+ (= emacs-major-version 19)))
+ ;;
+ ;; We use `vertical-motion' rather than `window-end' UPDATE arg.
+ (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'.
+ (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))))
+ (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 following the redisplay. We cannot
+ ;; use `window-end' so we work out what it would be via `vertical-motion'.
+ (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))))))
+
(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.
(cdr (or (assq major-mode alist) (assq t alist)))
alist)))
+(unless (fboundp 'buffer-live-p)
+ ;; We use this to check that a buffer we have to fontify still exists.
+ (defun buffer-live-p (object)
+ "Return non-nil if OBJECT is an editor buffer that has not been deleted."
+ (and (bufferp object) (buffer-name object))))
+
(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)
(push window windows))))
minibuf frame)
windows)))
+
+(unless (fboundp 'current-message)
+ (defun current-message ()
+ ""))
\f
;; Install ourselves:
HCoop / bpt / emacs.git / blobdiff