diff lisp/jit-lock.el @ 41336:36e754afaf7a

(jit-lock-defer-time): New var. (jit-lock-defer-timer, jit-lock-buffers): New vars. (jit-lock-mode): Initialize them. Cancel the timers more carefully. (jit-lock-function): Defer fontification if requested. (jit-lock-stealth-chunk-start): Pay attention to the new non-nil value. (jit-lock-stealth-fontify): Check the new `jit-lock-defer-multiline' text property. (jit-lock-deferred-fontify): New fun.

--- a/lisp/jit-lock.el	Tue Nov 20 23:54:28 2001 +0000
+++ b/lisp/jit-lock.el	Wed Nov 21 01:30:35 2001 +0000
@@ -127,7 +127,12 @@
 		 (other :tag "syntax-driven" syntax-driven))
   :group 'jit-lock)
 
-
+(defcustom jit-lock-defer-time nil ;; 0.5
+  "Idle time after which deferred fontification should take place.
+If nil, fontification is not deferred."
+  :group 'jit-lock
+  :type '(choice (const :tag "never" nil)
+	         (number :tag "seconds")))
 
 ;;; Variables that are not customizable.
 
@@ -148,6 +153,12 @@
 
 (defvar jit-lock-stealth-timer nil
   "Timer for stealth fontification in Just-in-time Lock mode.")
+
+(defvar jit-lock-defer-timer nil
+  "Timer for deferred fontification in Just-in-time Lock mode.")
+
+(defvar jit-lock-buffers nil
+  "List of buffers with pending deferred fontification.")
 
 ;;; JIT lock mode
 
@@ -186,16 +197,21 @@
   (cond (;; Turn Just-in-time Lock mode on.
 	 jit-lock-mode
 
- 	 ;; Mark the buffer for refontification
+ 	 ;; Mark the buffer for refontification.
 	 (jit-lock-refontify)
 
 	 ;; Install an idle timer for stealth fontification.
 	 (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
 	   (setq jit-lock-stealth-timer
-		 (run-with-idle-timer jit-lock-stealth-time
-				      jit-lock-stealth-time
+		 (run-with-idle-timer jit-lock-stealth-time t
 				      'jit-lock-stealth-fontify)))
 
+	 ;; Init deferred fontification timer.
+	 (when (and jit-lock-defer-time (null jit-lock-defer-timer))
+	   (setq jit-lock-defer-timer
+		 (run-with-idle-timer jit-lock-defer-time t
+				      'jit-lock-deferred-fontify)))
+
 	 ;; Initialize deferred contextual fontification if requested.
 	 (when (eq jit-lock-defer-contextually t)
 	   (setq jit-lock-first-unfontify-pos
@@ -207,10 +223,19 @@
 
 	;; Turn Just-in-time Lock mode off.
 	(t
-	 ;; Cancel our idle timer.
-	 (when jit-lock-stealth-timer
-	   (cancel-timer jit-lock-stealth-timer)
-	   (setq jit-lock-stealth-timer nil))
+	 ;; Cancel our idle timers.
+	 (when (and (or jit-lock-stealth-timer jit-lock-defer-timer)
+		    ;; Only if there's no other buffer using them.
+		    (not (catch 'found
+			   (dolist (buf (buffer-list))
+			     (with-current-buffer buf
+			       (when jit-lock-mode (throw 'found t)))))))
+	   (when jit-lock-stealth-timer
+	     (cancel-timer jit-lock-stealth-timer)
+	     (setq jit-lock-stealth-timer nil))
+	   (when jit-lock-defer-timer
+	     (cancel-timer jit-lock-defer-timer)
+	     (setq jit-lock-defer-timer nil)))
 
 	 ;; Remove hooks.
 	 (remove-hook 'after-change-functions 'jit-lock-after-change t)
@@ -242,8 +267,8 @@
   (with-buffer-prepared-for-jit-lock
    (save-restriction
      (widen)
-     (add-text-properties (or beg (point-min)) (or end (point-max))
-			  '(fontified nil)))))
+     (put-text-property (or beg (point-min)) (or end (point-max))
+			'fontified nil))))
 
 ;;; On demand fontification.
 
@@ -252,8 +277,20 @@
 This function is added to `fontification-functions' when `jit-lock-mode'
 is active."
   (when jit-lock-mode
-    (jit-lock-fontify-now start (+ start jit-lock-chunk-size))))
-     
+    (if (null jit-lock-defer-time)
+	;; No deferral.
+	(jit-lock-fontify-now start (+ start jit-lock-chunk-size))
+      ;; Record the buffer for later fontification.
+      (unless (memq (current-buffer) jit-lock-buffers)
+	(push (current-buffer) jit-lock-buffers))
+      ;; Mark the area as defer-fontified so that the redisplay engine
+      ;; is happy and so that the idle timer can find the places to fontify.
+      (with-buffer-prepared-for-jit-lock
+       (put-text-property start
+			  (next-single-property-change
+			   start 'fontified nil
+			   (min (point-max) (+ start jit-lock-chunk-size)))
+			  'fontified 'defer)))))
 
 (defun jit-lock-fontify-now (&optional start end)
   "Fontify current buffer from START to END.
@@ -294,9 +331,9 @@
 	     ;; Fontify the chunk, and mark it as fontified.
 	     ;; We mark it first, to make sure that we don't indefinitely
 	     ;; re-execute this fontification if an error occurs.
-	     (add-text-properties start next '(fontified t))
+	     (put-text-property start next 'fontified t)
 	     (run-hook-with-args 'jit-lock-functions start next)
-		   
+
 	     ;; Find the start of the next chunk, if any.
 	     (setq start (text-property-any next end 'fontified nil)))))))))
 
@@ -310,7 +347,7 @@
       nil
     (save-restriction
       (widen)
-      (let* ((next (text-property-any around (point-max) 'fontified nil))
+      (let* ((next (text-property-not-all around (point-max) 'fontified t))
 	     (prev (previous-single-property-change around 'fontified))
 	     (prop (get-text-property (max (point-min) (1- around))
 				      'fontified))
@@ -320,11 +357,11 @@
 		      ;; and the start of the buffer.  If PROP is
 		      ;; non-nil, everything in front of AROUND is
 		      ;; fontified, otherwise nothing is fontified.
-		      (if prop
+		      (if (eq prop t)
 			  nil
 			(max (point-min)
 			     (- around (/ jit-lock-chunk-size 2)))))
-		     (prop
+		     ((eq prop t)
 		      ;; PREV is the start of a region of fontified
 		      ;; text containing AROUND.  Start fontifying a
 		      ;; chunk size before the end of the unfontified
@@ -349,6 +386,7 @@
   "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
   (unless (or executing-kbd-macro
 	      (window-minibuffer-p (selected-window)))
     (let ((buffers (buffer-list))
@@ -384,9 +422,20 @@
 		    (widen)
 		    (when (and (>= jit-lock-first-unfontify-pos (point-min))
 			       (< jit-lock-first-unfontify-pos (point-max)))
+		      ;; If we're in text that matches a complex multi-line
+		      ;; font-lock pattern, make sure the whole text will be
+		      ;; redisplayed eventually.
+		      (when (get-text-property jit-lock-first-unfontify-pos
+					       'jit-lock-defer-multiline)
+			(setq jit-lock-first-unfontify-pos
+			      (or (previous-single-property-change
+				   jit-lock-first-unfontify-pos
+				   'jit-lock-defer-multiline)
+				  (point-min))))
 		      (with-buffer-prepared-for-jit-lock
-		       (put-text-property jit-lock-first-unfontify-pos
-					  (point-max) 'fontified nil))
+			(remove-text-properties
+			 jit-lock-first-unfontify-pos (point-max)
+			 '(fontified nil jit-lock-defer-multiline nil)))
 		      (setq jit-lock-first-unfontify-pos (point-max)))))
 
 		;; In the following code, the `sit-for' calls cause a
@@ -396,25 +445,54 @@
 		;; an unmodified buffer would show a `*'.
 		(let (start
 		      (nice (or jit-lock-stealth-nice 0))
-		      (point (point)))
+		      (point (point-min)))
 		  (while (and (setq start
 				    (jit-lock-stealth-chunk-start point))
 			      (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-first-unfontify-pos start)
+		    ;;   (setq jit-lock-first-unfontify-pos end))
+		    
 		    ;; Wait a little if load is too high.
 		    (when (and jit-lock-stealth-load
 			       (> (car (load-average)) jit-lock-stealth-load))
-		      (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)))))))))))))
+		      (sit-for (or jit-lock-stealth-time 30)))))))))))))
 
 
 
 ;;; Deferred fontification.
 
+(defun jit-lock-deferred-fontify ()
+  "Fontify what was deferred."
+  (when jit-lock-buffers
+    ;; Mark the deferred regions back to `fontified = nil'
+    (dolist (buffer jit-lock-buffers)
+      (when (buffer-live-p buffer)
+	(with-current-buffer buffer
+	  ;; (message "Jit-Defer %s" (buffer-name))
+	  (with-buffer-prepared-for-jit-lock
+	   (let ((pos (point-min)))
+	     (while
+		 (progn
+		   (when (eq (get-text-property pos 'fontified) 'defer)
+		     (put-text-property
+		      pos (setq pos (next-single-property-change
+				     pos 'fontified nil (point-max)))
+		      'fontified nil))
+		   (setq pos (next-single-property-change pos 'fontified)))))))))
+    (setq jit-lock-buffers nil)
+    ;; Force fontification of the visible parts.
+    (let ((jit-lock-defer-time nil))
+      ;; (message "Jit-Defer Now")
+      (sit-for 0)
+      ;; (message "Jit-Defer Done")
+      )))
+      
+
 (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'.
@@ -435,6 +513,7 @@
        
        ;; 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)