# HG changeset patch # User Gerd Moellmann # Date 954882036 0 # Node ID 030a9790d290167b2fd63b029e92bfbe8ab485e5 # Parent ec4edee8962251a210cbae463f995adceee5da7f (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 -r ec4edee89622 -r 030a9790d290 lisp/jit-lock.el --- a/lisp/jit-lock.el Tue Apr 04 20:59:17 2000 +0000 +++ b/lisp/jit-lock.el Tue Apr 04 21:00:36 2000 +0000 @@ -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 @@ 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))) + - ;;; Customization. @@ -243,50 +249,57 @@ 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)) + (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)) + ;; 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 @@ (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)))))))))))))