/[emacs]/emacs/lisp/jit-lock.el
ViewVC logotype

Diff of /emacs/lisp/jit-lock.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.26 by pj, Mon Jul 16 12:22:58 2001 UTC revision 1.27 by monnier, Wed Nov 21 01:30:35 2001 UTC
# Line 127  The value of this variable is used when Line 127  The value of this variable is used when
127                   (other :tag "syntax-driven" syntax-driven))                   (other :tag "syntax-driven" syntax-driven))
128    :group 'jit-lock)    :group 'jit-lock)
129    
130    (defcustom jit-lock-defer-time nil ;; 0.5
131      "Idle time after which deferred fontification should take place.
132    If nil, fontification is not deferred."
133      :group 'jit-lock
134      :type '(choice (const :tag "never" nil)
135                     (number :tag "seconds")))
136    
137  ;;; Variables that are not customizable.  ;;; Variables that are not customizable.
138    
# Line 148  If nil, contextual fontification is disa Line 153  If nil, contextual fontification is disa
153    
154  (defvar jit-lock-stealth-timer nil  (defvar jit-lock-stealth-timer nil
155    "Timer for stealth fontification in Just-in-time Lock mode.")    "Timer for stealth fontification in Just-in-time Lock mode.")
156    
157    (defvar jit-lock-defer-timer nil
158      "Timer for deferred fontification in Just-in-time Lock mode.")
159    
160    (defvar jit-lock-buffers nil
161      "List of buffers with pending deferred fontification.")
162    
163  ;;; JIT lock mode  ;;; JIT lock mode
164    
# Line 186  the variable `jit-lock-stealth-nice'." Line 197  the variable `jit-lock-stealth-nice'."
197    (cond (;; Turn Just-in-time Lock mode on.    (cond (;; Turn Just-in-time Lock mode on.
198           jit-lock-mode           jit-lock-mode
199    
200           ;; Mark the buffer for refontification           ;; Mark the buffer for refontification.
201           (jit-lock-refontify)           (jit-lock-refontify)
202    
203           ;; Install an idle timer for stealth fontification.           ;; Install an idle timer for stealth fontification.
204           (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))           (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
205             (setq jit-lock-stealth-timer             (setq jit-lock-stealth-timer
206                   (run-with-idle-timer jit-lock-stealth-time                   (run-with-idle-timer jit-lock-stealth-time t
                                       jit-lock-stealth-time  
207                                        'jit-lock-stealth-fontify)))                                        'jit-lock-stealth-fontify)))
208    
209             ;; Init deferred fontification timer.
210             (when (and jit-lock-defer-time (null jit-lock-defer-timer))
211               (setq jit-lock-defer-timer
212                     (run-with-idle-timer jit-lock-defer-time t
213                                          'jit-lock-deferred-fontify)))
214    
215           ;; Initialize deferred contextual fontification if requested.           ;; Initialize deferred contextual fontification if requested.
216           (when (eq jit-lock-defer-contextually t)           (when (eq jit-lock-defer-contextually t)
217             (setq jit-lock-first-unfontify-pos             (setq jit-lock-first-unfontify-pos
# Line 207  the variable `jit-lock-stealth-nice'." Line 223  the variable `jit-lock-stealth-nice'."
223    
224          ;; Turn Just-in-time Lock mode off.          ;; Turn Just-in-time Lock mode off.
225          (t          (t
226           ;; Cancel our idle timer.           ;; Cancel our idle timers.
227           (when jit-lock-stealth-timer           (when (and (or jit-lock-stealth-timer jit-lock-defer-timer)
228             (cancel-timer jit-lock-stealth-timer)                      ;; Only if there's no other buffer using them.
229             (setq jit-lock-stealth-timer nil))                      (not (catch 'found
230                               (dolist (buf (buffer-list))
231                                 (with-current-buffer buf
232                                   (when jit-lock-mode (throw 'found t)))))))
233               (when jit-lock-stealth-timer
234                 (cancel-timer jit-lock-stealth-timer)
235                 (setq jit-lock-stealth-timer nil))
236               (when jit-lock-defer-timer
237                 (cancel-timer jit-lock-defer-timer)
238                 (setq jit-lock-defer-timer nil)))
239    
240           ;; Remove hooks.           ;; Remove hooks.
241           (remove-hook 'after-change-functions 'jit-lock-after-change t)           (remove-hook 'after-change-functions 'jit-lock-after-change t)
# Line 242  Only applies to the current buffer." Line 267  Only applies to the current buffer."
267    (with-buffer-prepared-for-jit-lock    (with-buffer-prepared-for-jit-lock
268     (save-restriction     (save-restriction
269       (widen)       (widen)
270       (add-text-properties (or beg (point-min)) (or end (point-max))       (put-text-property (or beg (point-min)) (or end (point-max))
271                            '(fontified nil)))))                          'fontified nil))))
272    
273  ;;; On demand fontification.  ;;; On demand fontification.
274    
# Line 252  Only applies to the current buffer." Line 277  Only applies to the current buffer."
277  This function is added to `fontification-functions' when `jit-lock-mode'  This function is added to `fontification-functions' when `jit-lock-mode'
278  is active."  is active."
279    (when jit-lock-mode    (when jit-lock-mode
280      (jit-lock-fontify-now start (+ start jit-lock-chunk-size))))      (if (null jit-lock-defer-time)
281                ;; No deferral.
282            (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
283          ;; Record the buffer for later fontification.
284          (unless (memq (current-buffer) jit-lock-buffers)
285            (push (current-buffer) jit-lock-buffers))
286          ;; Mark the area as defer-fontified so that the redisplay engine
287          ;; is happy and so that the idle timer can find the places to fontify.
288          (with-buffer-prepared-for-jit-lock
289           (put-text-property start
290                              (next-single-property-change
291                               start 'fontified nil
292                               (min (point-max) (+ start jit-lock-chunk-size)))
293                              'fontified 'defer)))))
294    
295  (defun jit-lock-fontify-now (&optional start end)  (defun jit-lock-fontify-now (&optional start end)
296    "Fontify current buffer from START to END.    "Fontify current buffer from START to END.
# Line 294  Defaults to the whole buffer.  END can b Line 331  Defaults to the whole buffer.  END can b
331               ;; Fontify the chunk, and mark it as fontified.               ;; Fontify the chunk, and mark it as fontified.
332               ;; We mark it first, to make sure that we don't indefinitely               ;; We mark it first, to make sure that we don't indefinitely
333               ;; re-execute this fontification if an error occurs.               ;; re-execute this fontification if an error occurs.
334               (add-text-properties start next '(fontified t))               (put-text-property start next 'fontified t)
335               (run-hook-with-args 'jit-lock-functions start next)               (run-hook-with-args 'jit-lock-functions start next)
336                      
337               ;; Find the start of the next chunk, if any.               ;; Find the start of the next chunk, if any.
338               (setq start (text-property-any next end 'fontified nil)))))))))               (setq start (text-property-any next end 'fontified nil)))))))))
339    
# Line 310  Value is nil if there is nothing more to Line 347  Value is nil if there is nothing more to
347        nil        nil
348      (save-restriction      (save-restriction
349        (widen)        (widen)
350        (let* ((next (text-property-any around (point-max) 'fontified nil))        (let* ((next (text-property-not-all around (point-max) 'fontified t))
351               (prev (previous-single-property-change around 'fontified))               (prev (previous-single-property-change around 'fontified))
352               (prop (get-text-property (max (point-min) (1- around))               (prop (get-text-property (max (point-min) (1- around))
353                                        'fontified))                                        'fontified))
# Line 320  Value is nil if there is nothing more to Line 357  Value is nil if there is nothing more to
357                        ;; and the start of the buffer.  If PROP is                        ;; and the start of the buffer.  If PROP is
358                        ;; non-nil, everything in front of AROUND is                        ;; non-nil, everything in front of AROUND is
359                        ;; fontified, otherwise nothing is fontified.                        ;; fontified, otherwise nothing is fontified.
360                        (if prop                        (if (eq prop t)
361                            nil                            nil
362                          (max (point-min)                          (max (point-min)
363                               (- around (/ jit-lock-chunk-size 2)))))                               (- around (/ jit-lock-chunk-size 2)))))
364                       (prop                       ((eq prop t)
365                        ;; PREV is the start of a region of fontified                        ;; PREV is the start of a region of fontified
366                        ;; text containing AROUND.  Start fontifying a                        ;; text containing AROUND.  Start fontifying a
367                        ;; chunk size before the end of the unfontified                        ;; chunk size before the end of the unfontified
# Line 349  Value is nil if there is nothing more to Line 386  Value is nil if there is nothing more to
386    "Fontify buffers stealthily.    "Fontify buffers stealthily.
387  This functions is called after Emacs has been idle for  This functions is called after Emacs has been idle for
388  `jit-lock-stealth-time' seconds."  `jit-lock-stealth-time' seconds."
389      ;; I used to check `inhibit-read-only' here, but I can't remember why.  -stef
390    (unless (or executing-kbd-macro    (unless (or executing-kbd-macro
391                (window-minibuffer-p (selected-window)))                (window-minibuffer-p (selected-window)))
392      (let ((buffers (buffer-list))      (let ((buffers (buffer-list))
# Line 384  This functions is called after Emacs has Line 422  This functions is called after Emacs has
422                      (widen)                      (widen)
423                      (when (and (>= jit-lock-first-unfontify-pos (point-min))                      (when (and (>= jit-lock-first-unfontify-pos (point-min))
424                                 (< jit-lock-first-unfontify-pos (point-max)))                                 (< jit-lock-first-unfontify-pos (point-max)))
425                          ;; If we're in text that matches a complex multi-line
426                          ;; font-lock pattern, make sure the whole text will be
427                          ;; redisplayed eventually.
428                          (when (get-text-property jit-lock-first-unfontify-pos
429                                                   'jit-lock-defer-multiline)
430                            (setq jit-lock-first-unfontify-pos
431                                  (or (previous-single-property-change
432                                       jit-lock-first-unfontify-pos
433                                       'jit-lock-defer-multiline)
434                                      (point-min))))
435                        (with-buffer-prepared-for-jit-lock                        (with-buffer-prepared-for-jit-lock
436                         (put-text-property jit-lock-first-unfontify-pos                          (remove-text-properties
437                                            (point-max) 'fontified nil))                           jit-lock-first-unfontify-pos (point-max)
438                             '(fontified nil jit-lock-defer-multiline nil)))
439                        (setq jit-lock-first-unfontify-pos (point-max)))))                        (setq jit-lock-first-unfontify-pos (point-max)))))
440    
441                  ;; In the following code, the `sit-for' calls cause a                  ;; In the following code, the `sit-for' calls cause a
# Line 396  This functions is called after Emacs has Line 445  This functions is called after Emacs has
445                  ;; an unmodified buffer would show a `*'.                  ;; an unmodified buffer would show a `*'.
446                  (let (start                  (let (start
447                        (nice (or jit-lock-stealth-nice 0))                        (nice (or jit-lock-stealth-nice 0))
448                        (point (point)))                        (point (point-min)))
449                    (while (and (setq start                    (while (and (setq start
450                                      (jit-lock-stealth-chunk-start point))                                      (jit-lock-stealth-chunk-start point))
451                                (sit-for nice))                                (sit-for nice))
452                                            
453                        ;; fontify a block.
454                        (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
455                        ;; If stealth jit-locking is done backwards, this leads to
456                        ;; excessive O(n^2) refontification.   -stef
457                        ;; (when (>= jit-lock-first-unfontify-pos start)
458                        ;;   (setq jit-lock-first-unfontify-pos end))
459                        
460                      ;; Wait a little if load is too high.                      ;; Wait a little if load is too high.
461                      (when (and jit-lock-stealth-load                      (when (and jit-lock-stealth-load
462                                 (> (car (load-average)) jit-lock-stealth-load))                                 (> (car (load-average)) jit-lock-stealth-load))
463                        (sit-for (or jit-lock-stealth-time 30)))                        (sit-for (or jit-lock-stealth-time 30)))))))))))))
                       
                     ;; Unless there's input pending now, fontify.  
                     (unless (input-pending-p)  
                       (jit-lock-fontify-now  
                        start (+ start jit-lock-chunk-size)))))))))))))  
464    
465    
466    
467  ;;; Deferred fontification.  ;;; Deferred fontification.
468    
469    (defun jit-lock-deferred-fontify ()
470      "Fontify what was deferred."
471      (when jit-lock-buffers
472        ;; Mark the deferred regions back to `fontified = nil'
473        (dolist (buffer jit-lock-buffers)
474          (when (buffer-live-p buffer)
475            (with-current-buffer buffer
476              ;; (message "Jit-Defer %s" (buffer-name))
477              (with-buffer-prepared-for-jit-lock
478               (let ((pos (point-min)))
479                 (while
480                     (progn
481                       (when (eq (get-text-property pos 'fontified) 'defer)
482                         (put-text-property
483                          pos (setq pos (next-single-property-change
484                                         pos 'fontified nil (point-max)))
485                          'fontified nil))
486                       (setq pos (next-single-property-change pos 'fontified)))))))))
487        (setq jit-lock-buffers nil)
488        ;; Force fontification of the visible parts.
489        (let ((jit-lock-defer-time nil))
490          ;; (message "Jit-Defer Now")
491          (sit-for 0)
492          ;; (message "Jit-Defer Done")
493          )))
494          
495    
496  (defun jit-lock-after-change (start end old-len)  (defun jit-lock-after-change (start end old-len)
497    "Mark the rest of the buffer as not fontified after a change.    "Mark the rest of the buffer as not fontified after a change.
498  Installed on `after-change-functions'.  Installed on `after-change-functions'.
# Line 435  will take place when text is fontified s Line 513  will take place when text is fontified s
513                
514         ;; If we're in text that matches a multi-line font-lock pattern,         ;; If we're in text that matches a multi-line font-lock pattern,
515         ;; make sure the whole text will be redisplayed.         ;; make sure the whole text will be redisplayed.
516           ;; I'm not sure this is ever necessary and/or sufficient.  -stef
517         (when (get-text-property start 'font-lock-multiline)         (when (get-text-property start 'font-lock-multiline)
518           (setq start (or (previous-single-property-change           (setq start (or (previous-single-property-change
519                            start 'font-lock-multiline)                            start 'font-lock-multiline)

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26