1 ;;; lazy-shot.el --- Lazy font locking for XEmacs
3 ;; Copyright (C) 1997 Jan Vroonhof
5 ;; Author: Jan Vroonhof <vroonhof@math.ethz.ch>
6 ;; Keywords: languages, faces
8 ;; This file is part of XEmacs
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
25 ;;; Synched up with: Not in FSF (mostly equivalent to lazy-lock 2.09
30 ;;; This is an experimental demand based font-lock implemenation. It
31 ;;; is almost equal in functionality and interface to lazy-lock 2.09
32 ;;; Does somebody really need defer-locking?
35 ;;; (add-hook 'font-lock-mode-hook 'turn-on-lazy-shot)
36 ;;; in .emacs (.xemacs/init.el). Do not use in combination with
39 ;;; It is exprimental in the sense that it relies on C support from
40 ;;; the redisplay engine, that is experimental. The code in this file
41 ;;; is more or less finished. The C code support experimental because
42 ;;; the current design is rumoured to be ugly. Secondly because
43 ;;; XEmacs does actually display the "un-font-locked" parts of the
44 ;;; buffer first, the user notices flashing as the buffer is repainted
52 (defgroup lazy-shot nil
53 "Lazy-shot customizations"
59 (defcustom lazy-shot-mode nil ;; customized for the options menu. - dverna
60 "Non nil means `lazy-shot-mode' is on."
62 :require 'lazy-shot ;; which in turn requires font-lock.
64 :initialize 'custom-initialize-default
65 :set '(lambda (var val)
69 (add-hook 'font-lock-mode-hook 'turn-on-lazy-shot))
71 (remove-hook 'font-lock-mode-hook 'turn-on-lazy-shot))
72 (setq-default lazy-shot-mode val))
75 (defvar lazy-shot-stealth-timer nil)
77 (defcustom lazy-shot-minimum-size 0
78 "*Minimum size of a buffer for demand-driven fontification.
79 On-demand fontification occurs if the buffer size is greater than this value.
80 If nil, means demand-driven fontification is never performed."
81 :type '(choice (const :tag "Off" nil)
82 (integer :tag "Size"))
86 (defcustom lazy-shot-step-size 1024 ; Please test diffent sizes
87 "Minimum size of each fontification shot."
91 (defcustom lazy-shot-stealth-time 30
92 "*Time in seconds to delay before beginning stealth fontification.
93 Stealth fontification occurs if there is no input within this time.
94 If nil, means stealth fontification is never performed.
96 The value of this variable is used when Lazy Shot mode is turned on."
97 :type '(choice (const :tag "Off" nil)
101 (defcustom lazy-shot-stealth-lines (if font-lock-maximum-decoration 100 250)
102 "*Maximum size of a chunk of stealth fontification.
103 Each iteration of stealth fontification can fontify this number of lines.
104 To speed up input response during stealth fontification, at the cost of stealth
105 taking longer to fontify, you could reduce the value of this variable."
109 (defcustom lazy-shot-stealth-nice
110 (/ (float 1) (float 8))
111 "*Time in seconds to pause between chunks of stealth fontification.
112 Each iteration of stealth fontification is separated by this amount of time.
113 To reduce machine load during stealth fontification, at the cost of stealth
114 taking longer to fontify, you could increase the value of this variable."
118 (defcustom lazy-shot-verbose (not (null font-lock-verbose))
119 "*If non-nil, means demand fontification should show status messages."
123 (defcustom lazy-shot-stealth-verbose (not (null lazy-shot-verbose))
124 "*If non-nil, means stealth fontification should show status messages."
131 (defun lazy-shot-mode (&optional arg)
132 "Toggle Lazy Lock mode.
133 With arg, turn Lazy Lock mode on if and only if ARG is positive."
135 (let ((was-on lazy-shot-mode))
136 (set (make-local-variable 'lazy-shot-mode)
137 (and (if arg (> (prefix-numeric-value arg) 0) (not lazy-shot-mode))))
138 (cond ((and lazy-shot-mode (not font-lock-mode))
139 ;; Turned on `lazy-shot-mode' rather than `font-lock-mode'.
140 (let ((font-lock-support-mode 'lazy-shot-mode))
143 ;; Turn ourselves on.
146 ;; Turn ourselves off.
147 (lazy-shot-unstall)))))
149 (custom-add-option 'font-lock-mode-hook 'turn-on-lazy-shot)
152 (defun turn-on-lazy-shot ()
153 "Unconditionally turn on Lazy Lock mode."
156 ;; Can we do something intelligent here?
157 ;; I would want to set-extent-end-position start on extents that
158 ;; only partially overlap!
159 (defun lazy-shot-clean-up-extents (start end)
160 "Make sure there are no lazy-shot-extents between START and END.
161 This improves efficiency and C-g behavior."
162 ;; Be carefull this function is typically called with inhibit-quit!
163 (map-extents (lambda (e b) (delete-extent e))
164 nil start end nil 'start-and-end-in-region 'initial-redisplay-function
165 'lazy-shot-redisplay-function))
167 (defun lazy-shot-redisplay-function (extent)
168 "Lazy lock the EXTENT when it has become visible."
169 (lazy-shot-lock-extent extent nil))
172 (defun lazy-shot-lock-extent (extent stealth)
173 "Font-lock the EXTENT. Called from redisplay-trigger functions and
174 stealth locking functions."
175 (when (and (extent-live-p extent) (null (extent-detached-p extent)))
176 (let ((start (extent-start-position extent))
177 (end (extent-end-position extent))
178 (buffer (extent-object extent)))
179 (delete-extent extent)
180 (lazy-shot-fontify-internal buffer start end
181 (or lazy-shot-verbose
183 lazy-shot-stealth-verbose))
184 (if stealth "stealthy " "")))))
186 (defun lazy-shot-fontify-internal (buffer start end verbose message)
188 ;; Should inhibit quit here
189 (set-buffer buffer) ;; with-current-buffer is silly here
190 ;; This magic should really go into font-lock-fonity-region
192 (setq start (point-at-bol))
194 (setq end (point-at-bol 2))
195 (lazy-shot-clean-up-extents start end)
196 ;; and a allow quit here
198 (display-message 'progress
199 (format "Lazy-shot fontifying %sfrom %s to %s in %s"
200 message start end buffer)))
202 (font-lock-fontify-region start end))))
204 ;; Note this is suboptimal but works for now. It is not called that often.
205 (defun lazy-shot-fontify-region (start end &optional buffer)
206 (lazy-shot-fontify-internal (or buffer (current-buffer))
207 start end lazy-shot-verbose
210 (defun lazy-shot-stealth-lock (buffer)
211 "Find an extent to lazy lock in BUFFER."
212 (if (buffer-live-p buffer)
213 (with-current-buffer buffer
215 (while (and extent (sit-for lazy-shot-stealth-nice))
217 (or ;; First after point
218 (map-extents (lambda (e n) e) nil (point) nil nil nil
219 'initial-redisplay-function
220 'lazy-shot-redisplay-function)
222 (map-extents (lambda (e n) e) nil nil (point) nil nil
223 'initial-redisplay-function
224 'lazy-shot-redisplay-function)))
226 (lazy-shot-lock-extent extent t)
227 (delete-itimer current-itimer)
228 (setq lazy-shot-stealth-timer nil)))))
229 (delete-itimer current-itimer)))
231 (defun lazy-shot-install-extent (spos epos &optional buffer)
232 "Make an extent that will lazy-shot if it is displayed."
233 (let ((extent (make-extent spos epos buffer)))
235 (set-extent-property extent 'initial-redisplay-function
236 'lazy-shot-redisplay-function))
240 (defun lazy-shot-install-extents (start end fontifying)
242 ;; Add hook if lazy-shot.el is deferring or is fontifying on scrolling.
246 (while (not (>= (point) end))
248 (goto-char (min end (+ start lazy-shot-step-size)))
250 (lazy-shot-install-extent start (point))))))
253 (defun lazy-shot-after-change-function (start end old-len)
255 ;; If it is too small an insert to notice, let font-lock take
257 (if (< (- end start) lazy-shot-step-size)
258 (font-lock-after-change-function start end old-len)
259 ;; If there is an extent of ours, get rid of it first, and
260 ;; expand the region that we should be extentifying.
261 (let ((extent (map-extents '(lambda (e b) e)
262 nil start end nil nil
263 'initial-redisplay-function
264 'lazy-shot-redisplay-function)))
266 (setq start (min start (extent-start-position extent))
267 end (max end (extent-end-position extent)))
268 (delete-extent extent)))
269 ;; Extentify the region.
270 (lazy-shot-install-extents start end font-lock-fontified))))
273 (defun lazy-shot-install-timer (fontifying)
274 (when (and lazy-shot-stealth-time fontifying)
275 (make-variable-buffer-local 'lazy-shot-stealth-timer)
277 (setq lazy-shot-stealth-timer
278 (start-itimer (format "lazy shot for %s" (current-buffer))
279 'lazy-shot-stealth-lock lazy-shot-stealth-time
280 lazy-shot-stealth-time
281 t t (current-buffer)))
282 (make-local-hook 'kill-buffer-hook)
283 (add-hook 'kill-buffer-hook 'lazy-shot-unstall-after-fontify nil t))))
286 (defun lazy-shot-install ()
287 (make-local-variable 'font-lock-fontified)
288 (setq font-lock-fontified (and lazy-shot-minimum-size
289 (>= (buffer-size) lazy-shot-minimum-size)))
290 (lazy-shot-install-extents (point-min) (point-max) font-lock-fontified)
291 (lazy-shot-install-timer font-lock-fontified)
292 (add-hook 'font-lock-after-fontify-buffer-hook
293 'lazy-shot-unstall-after-fontify)
294 ;; [Comment stolen from lazy-lock.el.]
295 ;; Fascistically remove font-lock's after-change-function and install
296 ;; our own. We know better than font-lock what to do. Otherwise,
297 ;; revert-buffer, insert-file, etc. cause full refontification of the
298 ;; entire changed area.
299 (remove-hook 'after-change-functions 'font-lock-after-change-function t)
300 (make-local-hook 'after-change-functions)
301 (add-hook 'after-change-functions 'lazy-shot-after-change-function t t))
303 ;; Kludge needed untill lazy-lock-fontify-region is more intelligent
304 (defun lazy-shot-unstall-after-fontify ()
305 (lazy-shot-unstall 1))
307 (defun lazy-shot-unstall (&optional no-fontify)
309 (when (and (boundp 'lazy-shot-stealth-timer) lazy-shot-stealth-timer)
310 (delete-itimer lazy-shot-stealth-timer)
311 (setq lazy-shot-stealth-timer nil))
312 ;; Remove the extents.
314 (lambda (e arg) (delete-extent e) nil)
315 nil nil nil nil nil 'initial-redisplay-function 'lazy-shot-redisplay-function)
316 (when (and font-lock-mode (not no-fontify))
319 (lazy-shot-fontify-region (point-min) (point-max))))
320 (remove-hook 'after-change-functions 'lazy-shot-after-change-function t)
322 (add-hook 'after-change-functions 'font-lock-after-change-function t t)))
326 ;;; lazy-shot.el ends here