--- a/lisp/modes/lazy-shot.el	Mon Aug 13 10:02:48 2007 +0200
+++ b/lisp/modes/lazy-shot.el	Mon Aug 13 10:03:52 2007 +0200
@@ -22,27 +22,32 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with:  Not synched.
+;;; Synched up with:  Not in FSF (mostly equivalent to lazy-lock 2.06 
+;;; in FSF 19.34).
 
 ;;; Commentary:
 
-;; This versions has basic demand lock functionality. Somebody please
-;; sync further with lazy-lock v2 from FSF, customize etc.
-;;
-;;
-;; Idea for the stealth lock function:
-;;
-;;
-;; On an Idle itimer
-;;    Loop over all buffers with lazy-lock set
-;;       mapcar-extent in the region  (point) point-max for
-;;                      one-shot-function property
-;;         If not found do the same for [point-min,point]
-;;         font-lock the found region and delete the extent
+;;; This is an experimental demand based font-lock implemenation.  It
+;;; is almost equal in functionality and interface to lazy-lock 2.06
+;;; Does somebody really need defer-locking?
+;;;
+;;; To use: put
+;;;    (add-hook 'font-lock-mode-hook 'turn-on-lazy-shot)
+;;; in .emacs (.xemacs/init.el).  Do not use in combination with
+;;; lazy-lock.
+
+;;; It is exprimental in the sense that it relies on C support from
+;;; the redisplay engine, that is experimental.  The code in this file
+;;; is more or less finished.  The C code support experimental because
+;;; the current design is rumoured to be ugly.  Secondly because
+;;; XEmacs does actually display the "un-font-locked" parts of the
+;;; buffer first, the user notices flashing as the buffer is repainted 
+;;; with color/fonts.
 
 ;;; Code:
 
 (require 'font-lock)
+(require 'itimer)
 
 (defvar lazy-shot-mode nil)
 
@@ -50,13 +55,62 @@
 (defgroup lazy-shot nil
   "Lazy-shot customizations"
   :group 'tools
+  :group 'faces
   :prefix "lazy-shot-")
 
+(defcustom lazy-shot-minimum-size 0
+    "*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."
+    :type '(choice (const :tag "Off" nil)
+		   (integer :tag "Size"))
+    :group 'lazy-shot)
+
+
 (defcustom lazy-shot-step-size 1024	; Please test diffent sizes
   "Minimum size of each fontification shot."
   :type 'integer
   :group 'lazy-shot)
 
+(defcustom lazy-shot-stealth-time 30
+  "*Time in seconds to delay before beginning stealth fontification.
+Stealth fontification occurs if there is no input within this time.
+If nil, means stealth fontification is never performed.
+
+The value of this variable is used when Lazy Shot mode is turned on."
+  :type '(choice (const :tag "Off" nil)
+		 (number :tag "Time"))
+  :group 'lazy-shot)
+
+(defcustom lazy-shot-stealth-lines (if font-lock-maximum-decoration 100 250)
+  "*Maximum size of a chunk of stealth fontification.
+Each iteration of stealth fontification can fontify this number of lines.
+To speed up input response during stealth fontification, at the cost of stealth
+taking longer to fontify, you could reduce the value of this variable."
+  :type 'integer
+  :group 'lazy-shot)
+
+(defcustom lazy-shot-stealth-nice
+   (/ (float 1) (float 8))
+  "*Time in seconds to pause between chunks of stealth fontification.
+Each iteration of stealth fontification is separated by this amount of time.
+To reduce machine load during stealth fontification, at the cost of stealth
+taking longer to fontify, you could increase the value of this variable."
+  :type 'number
+  :group 'lazy-shot)
+
+(defcustom lazy-shot-verbose (not (null font-lock-verbose))
+  "*If non-nil, means demand fontification should show status messages."
+  :type 'boolean
+  :group 'lazy-shot)
+
+(defcustom lazy-shot-stealth-verbose (not (null lazy-shot-verbose))
+  "*If non-nil, means stealth fontification should show status messages."
+  :type 'boolean
+  :group 'lazy-shot)
+
+
+
 ;;;###autoload
 (defun lazy-shot-mode (&optional arg)
   "Toggle Lazy Lock mode.
@@ -75,72 +129,123 @@
 	 ;; Turn ourselves off.
 	 (lazy-shot-unstall))))
 
+(custom-add-option 'font-lock-mode-hook 'turn-on-lazy-lock)
+
 ;;;###autoload
 (defun turn-on-lazy-shot ()
   "Unconditionally turn on Lazy Lock mode."
   (lazy-shot-mode t))
 
+  ;; Can we do something intelligent here?
+  ;; I would want to set-extent-end-position start on extents that
+  ;; only partially overlap!
+(defun lazy-shot-clean-up-extents (start end)
+  "Make sure there are no lazy-shot-extens betweeen START and END.
+This improves efficiency and C-g behavior."
+  ;; Be carefull this function is typically called with inhibit-quit!
+  (map-extents (lambda (e b) (delete-extent e))
+	       nil start end nil 'start-and-end-in-region 'initial-redisplay-function
+	       'lazy-shot-redisplay-function))
+	         
+(defun lazy-shot-redisplay-function (extent)
+   "Lazy lock the EXTENT when it has become visisble."
+   (lazy-shot-lock-extent extent nil))
 
-(defun lazy-shot-shot-function (extent)
-   "Lazy lock the extent when it has become visisble"
-   (let ((start (extent-start-position extent))
-         (end   (extent-end-position extent))
-	 (buffer (extent-object extent)))
-     (delete-extent extent)
-     (with-current-buffer buffer
-       (save-excursion 
-	 ;; This magic should really go into font-lock-fonity-region
-	 (goto-char start)
-	 (unless (bolp)
-	   (beginning-of-line)
-	   (setq start (point)))
-	 (goto-char end)
-	 (unless (bolp)
-	   (forward-line)
-	   (setq end (point)))
-	 (display-message 'progress
-			  (format "Lazy-shot fontifying from %s to %s in %s"
-				  start end buffer))
-	 (save-match-data
-	   (font-lock-fontify-region start end))))))
+(defun lazy-shot-lock-extent (extent stealth)
+  "Font-lock the EXTENT. Called from redisplay-trigger functions and
+stealth locking functions"
+   (when (extent-live-p extent)
+     (let ((start (extent-start-position extent))
+	   (end   (extent-end-position extent))
+	   (buffer (extent-object extent)))
+       (delete-extent extent)
+       (save-excursion
+	 ;; Should inhibit quit here
+        (set-buffer buffer) ;; with-current-buffer is silly here
+	;; This magic should really go into font-lock-fonity-region
+	(goto-char start)
+	(setq start (point-at-bol))
+	(goto-char end)
+	(setq end (point-at-bol 2))
+	(lazy-shot-clean-up-extents start end)
+	(if (or lazy-shot-verbose (and stealth lazy-shot-stealth-verbose))
+	    (display-message 'progress
+	      (format "Lazy-shot fontifying %sfrom %s to %s in %s"
+		      (if stealth "stealthy " "") start end buffer)))
+	;; and a allow quit here
+	(save-match-data
+	  (font-lock-fontify-region start end))))))
 
+(defun lazy-shot-stealth-lock (buffer)
+  "Find an extent to lazy lock in buffer."
+  (if (buffer-live-p buffer)
+      (with-current-buffer buffer
+	(let ((extent t))
+	  (while (and extent (sit-for lazy-shot-stealth-nice))
+	    (setq extent
+		  (or   ;; First after point
+		   (map-extents (lambda (e n) e)  nil (point) nil nil nil
+				'initial-redisplay-function
+				'lazy-shot-redisplay-function)
+		   ;; Then before it
+		   (map-extents (lambda (e n) e) nil nil (point) nil nil
+				'initial-redisplay-function
+				'lazy-shot-redisplay-function)))
+	    (if extent
+		(lazy-shot-lock-extent extent t)
+	      (delete-itimer current-itimer)
+	      (setq lazy-shot-stealth-timer nil)))))
+    (delete-itimer current-itimer)))
+    
 (defun lazy-shot-install-extent (spos epos &optional buffer)
-  "Make an extent that will lazy-shot if it is displayed"
+  "Make an extent that will lazy-shot if it is displayed."
      (let ((extent (make-extent spos epos buffer)))
        (when extent
-         (set-extent-one-shot-function extent
-                       'lazy-shot-shot-function))
+         (set-extent-initial-redisplay-function extent
+                       'lazy-shot-redisplay-function))
        extent))
 
-(defun lazy-shot-next-line (pos &optional buffer)
-  "Return the next end-of-line from POS in BUFFER."
-  (save-excursion
-    (goto-char pos buffer)
-    (forward-line 1 buffer)
-    (point buffer)))
 
 (defun lazy-shot-install-extents (fontifying)
   ;;
   ;; Add hook if lazy-shot.el is deferring or is fontifying on scrolling.
   (when fontifying
-    (let ((max (point-max)))
-      (do* ((start (point-min) end)
-	    (end (min max (lazy-shot-next-line (+ start lazy-shot-step-size)))
-		 (min max (lazy-shot-next-line (+ start lazy-shot-step-size)))))
-	  ((>= start max))
-	(lazy-shot-install-extent start end)))))
+    (let ((max (point-max))
+	  start)
+      (save-excursion
+	(goto-char (point-min))
+	(while (not (eobp))
+	  (setq start (point))
+	  (goto-char (min max (+ start lazy-shot-step-size)))
+	  (forward-line 1)
+	  (lazy-shot-install-extent start (point)))))))
+
+(defun lazy-shot-install-timer (fontifying)
+  (when (and lazy-shot-stealth-time fontifying)
+    (make-variable-buffer-local 'lazy-shot-stealth-timer)
+    (setq lazy-shot-stealth-timer 
+      (start-itimer (format "lazy shot for %s" (current-buffer))
+		     'lazy-shot-stealth-lock lazy-shot-stealth-time
+		     lazy-shot-stealth-time
+		     t t (current-buffer)))))
+
 
 (defun lazy-shot-install ()
   (make-local-variable 'font-lock-fontified)
-  (setq font-lock-fontified t)
-  (lazy-shot-install-extents font-lock-fontified))
+  (setq font-lock-fontified (and lazy-shot-minimum-size
+				 (>= (buffer-size) lazy-shot-minimum-size))) 
+  (lazy-shot-install-extents font-lock-fontified)
+  (lazy-shot-install-timer font-lock-fontified))
 
 (defun lazy-shot-unstall ()
-  ;;
+  ;; Stop the timer
+  (when lazy-shot-stealth-timer
+    (delete-itimer lazy-shot-stealth-timer)
+    (setq lazy-shot-stealth-timer nil))
   ;; Remove the extents.
   (map-extents 
      (lambda (e arg) (delete-extent e) nil) 
-     nil nil nil nil nil 'one-shot-function 'lazy-shot-shot-function)
+     nil nil nil nil nil 'initial-redisplay-function 'lazy-shot-redisplay-function)
   ;;
   ;; Remove the fontification hooks.
   (remove-hook 'after-change-functions 'lazy-shot-defer-after-change t)