diff lisp/modes/lazy-shot.el @ 209:41ff10fd062f r20-4b3

Import from CVS: tag r20-4b3
author cvs
date Mon, 13 Aug 2007 10:04:58 +0200
parents e45d5e7c476e
children 78478c60bfcd
line wrap: on
line diff
--- a/lisp/modes/lazy-shot.el	Mon Aug 13 10:03:54 2007 +0200
+++ b/lisp/modes/lazy-shot.el	Mon Aug 13 10:04:58 2007 +0200
@@ -22,13 +22,13 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with:  Not in FSF (mostly equivalent to lazy-lock 2.06 
-;;; in FSF 19.34).
+;;; Synched up with:  Not in FSF (mostly equivalent to lazy-lock 2.09
+;;; in FSF 20.2).
 
 ;;; Commentary:
 
 ;;; This is an experimental demand based font-lock implemenation.  It
-;;; is almost equal in functionality and interface to lazy-lock 2.06
+;;; is almost equal in functionality and interface to lazy-lock 2.09
 ;;; Does somebody really need defer-locking?
 ;;;
 ;;; To use: put
@@ -116,18 +116,19 @@
   "Toggle Lazy Lock mode.
 With arg, turn Lazy Lock mode on if and only if arg is positive."
   (interactive "P")
-  (set (make-local-variable 'lazy-shot-mode)
-       (and (if arg (> (prefix-numeric-value arg) 0) (not lazy-shot-mode))))
-  (cond ((and lazy-shot-mode (not font-lock-mode))
-	 ;; Turned on `lazy-shot-mode' rather than `font-lock-mode'.
-	 (let ((font-lock-support-mode 'lazy-shot-mode))
-	   (font-lock-mode t)))
-	(lazy-shot-mode
-	 ;; Turn ourselves on.
-	 (lazy-shot-install))
-	(t
-	 ;; Turn ourselves off.
-	 (lazy-shot-unstall))))
+  (let ((was-on lazy-shot-mode))
+    (set (make-local-variable 'lazy-shot-mode)
+	 (and (if arg (> (prefix-numeric-value arg) 0) (not lazy-shot-mode))))
+    (cond ((and lazy-shot-mode (not font-lock-mode))
+	   ;; Turned on `lazy-shot-mode' rather than `font-lock-mode'.
+	   (let ((font-lock-support-mode 'lazy-shot-mode))
+	     (font-lock-mode t)))
+	  (lazy-shot-mode
+	   ;; Turn ourselves on.
+	   (lazy-shot-install))
+	  (was-on
+	   ;; Turn ourselves off.
+	   (lazy-shot-unstall)))))
 
 (custom-add-option 'font-lock-mode-hook 'turn-on-lazy-lock)
 
@@ -151,6 +152,7 @@
    "Lazy lock the EXTENT when it has become visisble."
    (lazy-shot-lock-extent extent nil))
 
+
 (defun lazy-shot-lock-extent (extent stealth)
   "Font-lock the EXTENT. Called from redisplay-trigger functions and
 stealth locking functions"
@@ -159,22 +161,35 @@
 	   (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))))))
+       (lazy-shot-fontify-internal buffer start end
+				      (or lazy-shot-verbose 
+					  (and stealth
+					       lazy-shot-stealth-verbose))
+				      (if stealth "stealthy " "")))))
+
+(defun lazy-shot-fontify-internal (buffer start end verbose message)
+  (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)
+    ;; and a allow quit here
+    (if verbose
+	(display-message 'progress
+	  (format "Lazy-shot fontifying %sfrom %s to %s in %s"
+		     message start end buffer)))
+    (save-match-data
+      (font-lock-fontify-region start end))))
+
+;; Note this is suboptimal but works for now. It is not called that often.
+(defun lazy-shot-fontify-region (start end &optional buffer)
+  (lazy-shot-fontify-internal (or buffer (current-buffer))
+					start end lazy-shot-verbose
+					"on request "))
 
 (defun lazy-shot-stealth-lock (buffer)
   "Find an extent to lazy lock in buffer."
@@ -235,9 +250,15 @@
   (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))
+  (lazy-shot-install-timer font-lock-fontified)
+  (add-hook 'font-lock-after-fontify-buffer-hook
+	    'lazy-shot-unstall-after-fontify))
 
-(defun lazy-shot-unstall ()
+;; Kludge needed untill lazy-lock-fontify-region is more intelligent
+(defun lazy-shot-unstall-after-fontify ()
+  (lazy-shot-unstall 1))
+
+(defun lazy-shot-unstall (&optional no-fontify)
   ;; Stop the timer
   (when lazy-shot-stealth-timer
     (delete-itimer lazy-shot-stealth-timer)
@@ -246,14 +267,10 @@
   (map-extents 
      (lambda (e arg) (delete-extent e) nil) 
      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)
-  ;;
-  ;; If Font Lock mode is still enabled, reinstall its hook.
-  (when font-lock-mode
-    (add-hook 'after-change-functions 'font-lock-after-change-function nil t)))
-
+  (when (and font-lock-mode (not no-fontify))
+    (save-restriction
+      (widen)
+      (lazy-shot-fontify-region (point-min) (point-max)))))
 
 (provide 'lazy-shot)