diff options
author | Karoly Lorentey <lorentey@elte.hu> | 2006-10-14 16:56:21 +0000 |
---|---|---|
committer | Karoly Lorentey <lorentey@elte.hu> | 2006-10-14 16:56:21 +0000 |
commit | 3f87f67ee215ffeecbd2f53bd7f342cdf03f47df (patch) | |
tree | 16f2af9111af08a94d608d96a957f5c3ec5effcc /lisp/jit-lock.el | |
parent | 350e4fb815d7413ef6d339dd664014706f742927 (diff) | |
parent | 7a210b69c7f92650c524766d1b9d3f3eefdd67c7 (diff) | |
download | emacs-3f87f67ee215ffeecbd2f53bd7f342cdf03f47df.tar.gz |
Merged from emacs@sv.gnu.org
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-371
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-372
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-373
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-374
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-375
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-376
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-377
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-378
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-379
Merge from erc--emacs--21
* emacs@sv.gnu.org/emacs--devo--0--patch-380
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-381
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-382
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-383
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-384
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-385
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-386
Update from erc--emacs--22
* emacs@sv.gnu.org/emacs--devo--0--patch-387
Fix ERC bug introduced in last patch
* emacs@sv.gnu.org/emacs--devo--0--patch-388
Update from erc--emacs--22
* emacs@sv.gnu.org/emacs--devo--0--patch-389
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-390
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-391
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-392
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-393
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-394
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-395
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-396
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-397
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-398
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-399
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-400
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-401
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-402
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-403
Rcirc update from Ryan Yeske
* emacs@sv.gnu.org/emacs--devo--0--patch-404
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-405
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-406
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-407
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-408
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-409
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-410
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-411
Miscellaneous tq-related fixes.
* emacs@sv.gnu.org/emacs--devo--0--patch-412
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-121
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-122
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-123
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-124
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-125
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-126
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-127
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-581
Diffstat (limited to 'lisp/jit-lock.el')
-rw-r--r-- | lisp/jit-lock.el | 210 |
1 files changed, 110 insertions, 100 deletions
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 0e131b665ef..89959ad8525 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -31,6 +31,8 @@ (eval-when-compile + (require 'cl) + (defmacro with-buffer-unmodified (&rest body) "Eval BODY, preserving the current buffer's modified state." (declare (debug t)) @@ -169,6 +171,8 @@ If nil, contextual fontification is disabled.") (defvar jit-lock-stealth-timer nil "Timer for stealth fontification in Just-in-time Lock mode.") +(defvar jit-lock-stealth-repeat-timer nil + "Timer for repeated stealth fontification in Just-in-time Lock mode.") (defvar jit-lock-context-timer nil "Timer for context fontification in Just-in-time Lock mode.") (defvar jit-lock-defer-timer nil @@ -176,6 +180,8 @@ If nil, contextual fontification is disabled.") (defvar jit-lock-defer-buffers nil "List of buffers with pending deferred fontification.") +(defvar jit-lock-stealth-buffers nil + "List of buffers that are being fontified stealthily.") ;;; JIT lock mode @@ -223,6 +229,13 @@ the variable `jit-lock-stealth-nice'." (run-with-idle-timer jit-lock-stealth-time t 'jit-lock-stealth-fontify))) + ;; Create, but do not activate, the idle timer for repeated + ;; stealth fontification. + (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer)) + (setq jit-lock-stealth-repeat-timer (timer-create)) + (timer-set-function jit-lock-stealth-repeat-timer + 'jit-lock-stealth-fontify '(t))) + ;; Init deferred fontification timer. (when (and jit-lock-defer-time (null jit-lock-defer-timer)) (setq jit-lock-defer-timer @@ -331,7 +344,7 @@ Defaults to the whole buffer. END can be out of bounds." ;; from the end of a buffer to its start, can do repeated ;; `parse-partial-sexp' starting from `point-min', which can ;; take a long time in a large buffer. - (let (next) + (let ((orig-start start) next) (save-match-data ;; Fontify chunks beginning at START. The end of a ;; chunk is either `end', or the start of a region @@ -374,6 +387,26 @@ Defaults to the whole buffer. END can be out of bounds." (quit (put-text-property start next 'fontified nil) (funcall 'signal (car err) (cdr err)))) + ;; The redisplay engine has already rendered the buffer up-to + ;; `orig-start' and won't notice if the above jit-lock-functions + ;; changed the appearance of any part of the buffer prior + ;; to that. So if `start' is before `orig-start', we need to + ;; cause a new redisplay cycle after this one so that any changes + ;; are properly reflected on screen. + ;; To make such repeated redisplay happen less often, we can + ;; eagerly extend the refontified region with + ;; jit-lock-after-change-extend-region-functions. + (when (< start orig-start) + (lexical-let ((start start) + (orig-start orig-start) + (buf (current-buffer))) + (run-with-timer + 0 nil (lambda () + (with-current-buffer buf + (with-buffer-prepared-for-jit-lock + (put-text-property start orig-start + 'fontified t))))))) + ;; Find the start of the next chunk, if any. (setq start (text-property-any next end 'fontified nil)))))))) @@ -421,71 +454,55 @@ Value is nil if there is nothing more to fontify." (t next)))) result)))) - -(defun jit-lock-stealth-fontify () +(defun jit-lock-stealth-fontify (&optional repeat) "Fontify buffers stealthily. -This functions is called after Emacs has been idle for -`jit-lock-stealth-time' seconds." - ;; I used to check `inhibit-read-only' here, but I can't remember why. -stef +This function is called repeatedly after Emacs has become idle for +`jit-lock-stealth-time' seconds. Optional argument REPEAT is expected +non-nil in a repeated invocation of this function." + ;; Cancel timer for repeated invocations. + (unless repeat + (cancel-timer jit-lock-stealth-repeat-timer)) (unless (or executing-kbd-macro memory-full - (window-minibuffer-p (selected-window))) - (let ((buffers (buffer-list)) - (outer-buffer (current-buffer)) + (window-minibuffer-p (selected-window)) + ;; For first invocation set up `jit-lock-stealth-buffers'. + ;; In repeated invocations it's already been set up. + (null (if repeat + jit-lock-stealth-buffers + (setq jit-lock-stealth-buffers (buffer-list))))) + (let ((buffer (car jit-lock-stealth-buffers)) + (delay 0) minibuffer-auto-raise - message-log-max) - (with-local-quit - (while (and buffers (not (input-pending-p))) - (with-current-buffer (pop buffers) - (when jit-lock-mode - ;; This is funny. Calling sit-for with 3rd arg non-nil - ;; so that it doesn't redisplay, internally calls - ;; wait_reading_process_input also with a parameter - ;; saying "don't redisplay." Since this function here - ;; is called periodically, this effectively leads to - ;; process output not being redisplayed at all because - ;; redisplay_internal is never called. (That didn't - ;; work in the old redisplay either.) So, we learn that - ;; we mustn't call sit-for that way here. But then, we - ;; have to be cautious not to call sit-for in a widened - ;; buffer, since this could display hidden parts of that - ;; buffer. This explains the seemingly weird use of - ;; save-restriction/widen here. - - (with-temp-message (if jit-lock-stealth-verbose - (concat "JIT stealth lock " - (buffer-name))) - - ;; In the following code, the `sit-for' calls cause a - ;; redisplay, so it's required that the - ;; buffer-modified flag of a buffer that is displayed - ;; has the right value---otherwise the mode line of - ;; an unmodified buffer would show a `*'. - (let (start - (nice (or jit-lock-stealth-nice 0)) - (point (point-min))) - (while (and (setq start - (jit-lock-stealth-chunk-start point)) - ;; In case sit-for runs any timers, - ;; give them the expected current buffer. - (with-current-buffer outer-buffer - (sit-for nice))) - - ;; fontify a block. - (jit-lock-fontify-now start (+ start jit-lock-chunk-size)) - ;; If stealth jit-locking is done backwards, this leads to - ;; excessive O(n^2) refontification. -stef - ;; (when (>= jit-lock-context-unfontify-pos start) - ;; (setq jit-lock-context-unfontify-pos end)) - - ;; Wait a little if load is too high. - (when (and jit-lock-stealth-load - (> (car (load-average)) jit-lock-stealth-load)) - ;; In case sit-for runs any timers, - ;; give them the expected current buffer. - (with-current-buffer outer-buffer - (sit-for (or jit-lock-stealth-time 30)))))))))))))) - + message-log-max + start) + (if (and jit-lock-stealth-load + (> (car (load-average)) jit-lock-stealth-load)) + ;; Wait a little if load is too high. + (setq delay jit-lock-stealth-time) + (if (buffer-live-p buffer) + (with-current-buffer buffer + (if (and jit-lock-mode + (setq start (jit-lock-stealth-chunk-start (point)))) + ;; Fontify one block of at most `jit-lock-chunk-size' + ;; characters. + (with-temp-message (if jit-lock-stealth-verbose + (concat "JIT stealth lock " + (buffer-name))) + (jit-lock-fontify-now start + (+ start jit-lock-chunk-size)) + ;; Run again after `jit-lock-stealth-nice' seconds. + (setq delay (or jit-lock-stealth-nice 0))) + ;; Nothing to fontify here. Remove this buffer from + ;; `jit-lock-stealth-buffers' and run again immediately. + (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers)))) + ;; Buffer is no longer live. Remove it from + ;; `jit-lock-stealth-buffers' and run again immediately. + (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers)))) + ;; Call us again. + (when jit-lock-stealth-buffers + (timer-set-idle-time jit-lock-stealth-repeat-timer (current-idle-time)) + (timer-inc-time jit-lock-stealth-repeat-timer delay) + (timer-activate-when-idle jit-lock-stealth-repeat-timer t))))) ;;; Deferred fontification. @@ -548,6 +565,19 @@ This functions is called after Emacs has been idle for '(fontified nil jit-lock-defer-multiline nil))) (setq jit-lock-context-unfontify-pos (point-max))))))))) +(defvar jit-lock-start) (defvar jit-lock-end) ; Dynamically scoped variables. +(defvar jit-lock-after-change-extend-region-functions nil + "Hook that can extend the text to refontify after a change. +This is run after every buffer change. The functions are called with +the three arguments of `after-change-functions': START END OLD-LEN. +The extended region to refontify is returned indirectly by modifying +the variables `jit-lock-start' and `jit-lock-end'. + +Note that extending the region this way is not strictly necessary, except +that the nature of the redisplay code tends to otherwise leave some of +the rehighlighted text displayed with the old highlight until the next +redisplay (see comment about repeated redisplay in `jit-lock-fontify-now').") + (defun jit-lock-after-change (start end old-len) "Mark the rest of the buffer as not fontified after a change. Installed on `after-change-functions'. @@ -557,44 +587,24 @@ This function ensures that lines following the change will be refontified in case the syntax of those lines has changed. Refontification will take place when text is fontified stealthily." (when (and jit-lock-mode (not memory-full)) - (let ((region (font-lock-extend-region start end old-len))) - (save-excursion - (with-buffer-prepared-for-jit-lock - ;; It's important that the `fontified' property be set from the - ;; beginning of the line, else font-lock will properly change the - ;; text's face, but the display will have been done already and will - ;; be inconsistent with the buffer's content. - ;; - ;; FIXME!!! (Alan Mackenzie, 2006-03-14): If start isn't at a BOL, - ;; expanding the region to BOL might mis-fontify, should the BOL not - ;; be at a "safe" position. - (setq start (if region - (car region) - (goto-char start) - (line-beginning-position))) - - ;; If we're in text that matches a multi-line font-lock pattern, - ;; make sure the whole text will be redisplayed. - ;; I'm not sure this is ever necessary and/or sufficient. -stef - (when (get-text-property start 'font-lock-multiline) - (setq start (or (previous-single-property-change - start 'font-lock-multiline) - (point-min)))) - - (if region (setq end (cdr region))) - ;; Make sure we change at least one char (in case of deletions). - (setq end (min (max end (1+ start)) (point-max))) - ;; Request refontification. - (put-text-property start end 'fontified nil)) - ;; Mark the change for deferred contextual refontification. - (when jit-lock-context-unfontify-pos - (setq jit-lock-context-unfontify-pos - ;; Here we use `start' because nothing guarantees that the - ;; text between start and end will be otherwise refontified: - ;; usually it will be refontified by virtue of being - ;; displayed, but if it's outside of any displayed area in the - ;; buffer, only jit-lock-context-* will re-fontify it. - (min jit-lock-context-unfontify-pos start))))))) + (let ((jit-lock-start start) + (jit-lock-end end)) + (with-buffer-prepared-for-jit-lock + (run-hook-with-args 'jit-lock-after-change-extend-region-functions + start end old-len) + ;; Make sure we change at least one char (in case of deletions). + (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max))) + ;; Request refontification. + (put-text-property jit-lock-start jit-lock-end 'fontified nil)) + ;; Mark the change for deferred contextual refontification. + (when jit-lock-context-unfontify-pos + (setq jit-lock-context-unfontify-pos + ;; Here we use `start' because nothing guarantees that the + ;; text between start and end will be otherwise refontified: + ;; usually it will be refontified by virtue of being + ;; displayed, but if it's outside of any displayed area in the + ;; buffer, only jit-lock-context-* will re-fontify it. + (min jit-lock-context-unfontify-pos jit-lock-start)))))) (provide 'jit-lock) |