(with-buffer-unmodified): New macro.

(with-buffer-prepared-for-font-lock): Don't preserve buffer's
modified state.
(jit-lock-function-1): Extracted from jit-lock-function; not
preserving buffer's modified state.
(jit-lock-function, jit-lock-stealth-fontify): Call
jit-lock-function-1.

diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 217407f8fe5afb020521fa039535ae46f2d8e6bf..38814707104805285491f4fbe6d353fccf46432f 100644 (file)
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -33,11 +33,20 @@
 (require 'font-lock)
 
 (eval-when-compile
+  (defmacro with-buffer-unmodified (&rest body)
+    "Eval BODY, preserving the current buffer's modified state."
+    (let ((modified (make-symbol "modified")))
+      `(let ((,modified (buffer-modified-p)))
+        ,@body
+        (unless ,modified)
+          ;; Calling set-buffer-modified causes redisplay to consider
+          ;; all windows because that function sets update_mode_lines.
+          (set-buffer-modified-p nil))))
+  
   (defmacro with-buffer-prepared-for-font-lock (&rest body)
     "Execute BODY in current buffer, overriding several variables.
 Preserves the `buffer-modified-p' state of the current buffer."
-    `(let ((modified (buffer-modified-p))
-          (buffer-undo-list t)
+    `(let ((buffer-undo-list t)
           (inhibit-read-only t)
           (inhibit-point-motion-hooks t)
           before-change-functions
@@ -45,12 +54,9 @@ Preserves the `buffer-modified-p' state of the current buffer."
           deactivate-mark
           buffer-file-name
           buffer-file-truename)
-       ,@body
-       ;; Calling set-buffer-modified causes redisplay to consider
-       ;; all windows because that function sets update_mode_lines.
-       (set-buffer-modified-p modified))))
-  
+       ,@body)))
 
+  
 \f
 ;;; Customization.
 
@@ -243,50 +249,57 @@ the variable `jit-lock-stealth-nice' and `jit-lock-stealth-lines'."
 This function is added to `fontification-functions' when `jit-lock-mode'
 is active."
   (when jit-lock-mode
-    (with-buffer-prepared-for-font-lock
-     (save-excursion
-       (save-restriction
-        (widen)
-        (let ((end (min (point-max) (+ start jit-lock-chunk-size)))
-              (parse-sexp-lookup-properties font-lock-syntactic-keywords)
-              (font-lock-beginning-of-syntax-function nil)
-              (old-syntax-table (syntax-table))
-              next font-lock-start font-lock-end)
-          (when font-lock-syntax-table
-            (set-syntax-table font-lock-syntax-table))
-          (save-match-data
-            (condition-case error
-                ;; Fontify chunks beginning at START.  The end of a
-                ;; chunk is either `end', or the start of a region
-                ;; before `end' that has already been fontified.
-                (while start
-                  ;; Determine the end of this chunk.
-                  (setq next (or (text-property-any start end 'fontified t)
-                                 end))
-
-                  ;; Decide which range of text should be fontified.
-                  ;; The problem is that START and NEXT may be in the
-                  ;; middle of something matched by a font-lock regexp.
-                  ;; Until someone has a better idea, let's start
-                  ;; at the start of the line containing START and
-                  ;; stop at the start of the line following NEXT.
-                  (goto-char next)
-                  (setq font-lock-end (line-beginning-position 2))
-                  (goto-char start)
-                  (setq font-lock-start (line-beginning-position))
+    (with-buffer-unmodified (jit-lock-function-1 start))))
+     
+  
+(defun jit-lock-function-1 (start)
+  "Fontify current buffer starting at position START.
+This function is added to `fontification-functions' when `jit-lock-mode'
+is active."
+  (with-buffer-prepared-for-font-lock
+   (save-excursion
+     (save-restriction
+       (widen)
+       (let ((end (min (point-max) (+ start jit-lock-chunk-size)))
+            (parse-sexp-lookup-properties font-lock-syntactic-keywords)
+            (font-lock-beginning-of-syntax-function nil)
+            (old-syntax-table (syntax-table))
+            next font-lock-start font-lock-end)
+        (when font-lock-syntax-table
+          (set-syntax-table font-lock-syntax-table))
+        (save-match-data
+          (condition-case error
+              ;; Fontify chunks beginning at START.  The end of a
+              ;; chunk is either `end', or the start of a region
+              ;; before `end' that has already been fontified.
+              (while start
+                ;; Determine the end of this chunk.
+                (setq next (or (text-property-any start end 'fontified t)
+                               end))
+
+                ;; Decide which range of text should be fontified.
+                ;; The problem is that START and NEXT may be in the
+                ;; middle of something matched by a font-lock regexp.
+                ;; Until someone has a better idea, let's start
+                ;; at the start of the line containing START and
+                ;; stop at the start of the line following NEXT.
+                (goto-char next)
+                (setq font-lock-end (line-beginning-position 2))
+                (goto-char start)
+                (setq font-lock-start (line-beginning-position))
                   
-                  ;; Fontify the chunk, and mark it as fontified.
-                  (font-lock-fontify-region font-lock-start font-lock-end nil)
-                  (add-text-properties start next '(fontified t))
+                ;; Fontify the chunk, and mark it as fontified.
+                (font-lock-fontify-region font-lock-start font-lock-end nil)
+                (add-text-properties start next '(fontified t))
                   
-                  ;; Find the start of the next chunk, if any.
-                  (setq start (text-property-any next end 'fontified nil)))
+                ;; Find the start of the next chunk, if any.
+                (setq start (text-property-any next end 'fontified nil)))
               
-              ((error quit)
-               (message "Fontifying region...%s" error))))
+            ((error quit)
+             (message "Fontifying region...%s" error))))
        
-          ;; Restore previous buffer settings.
-          (set-syntax-table old-syntax-table)))))))
+        ;; Restore previous buffer settings.
+        (set-syntax-table old-syntax-table))))))
 
 
 (defun jit-lock-after-fontify-buffer ()
@@ -381,31 +394,33 @@ This functions is called after Emacs has been idle for
                                     (concat "JIT stealth lock "
                                             (buffer-name)))
 
-               ;; Perform deferred unfontification, if any.
-               (when jit-lock-first-unfontify-pos
-                 (save-restriction
-                   (widen)
-                   (when (and (>= jit-lock-first-unfontify-pos (point-min))
-                              (< jit-lock-first-unfontify-pos (point-max)))
-                     (with-buffer-prepared-for-font-lock
-                      (put-text-property jit-lock-first-unfontify-pos
-                                         (point-max) 'fontified nil))
-                     (setq jit-lock-first-unfontify-pos nil))))
+               (with-buffer-unmodified
+
+                ;; Perform deferred unfontification, if any.
+                (when jit-lock-first-unfontify-pos
+                  (save-restriction
+                    (widen)
+                    (when (and (>= jit-lock-first-unfontify-pos (point-min))
+                               (< jit-lock-first-unfontify-pos (point-max)))
+                      (with-buffer-prepared-for-font-lock
+                       (put-text-property jit-lock-first-unfontify-pos
+                                          (point-max) 'fontified nil))
+                      (setq jit-lock-first-unfontify-pos nil))))
                
-               (let (start
-                     (nice (or jit-lock-stealth-nice 0))
-                     (point (point)))
-                 (while (and (setq start (jit-lock-stealth-chunk-start point))
-                             (sit-for nice))
+                (let (start
+                      (nice (or jit-lock-stealth-nice 0))
+                      (point (point)))
+                  (while (and (setq start (jit-lock-stealth-chunk-start point))
+                              (sit-for nice))
                    
-                   ;; 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)))
+                    ;; 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-function start))))))))))))
+                    ;; Unless there's input pending now, fontify.
+                    (unless (input-pending-p)
+                      (jit-lock-function-1 start)))))))))))))
 
 
 \f