(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
+ (restore-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)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- before-change-functions
- after-change-functions
- deactivate-mark
- buffer-file-name
- buffer-file-truename)
- ,@body
- (set-buffer-modified-p modified))))
-
+ `(with-buffer-unmodified
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ before-change-functions
+ after-change-functions
+ deactivate-mark
+ buffer-file-name
+ buffer-file-truename)
+ ,@body))))
+
\f
;;; Customization.
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))
+ (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 ()
(put-text-property jit-lock-first-unfontify-pos
(point-max) 'fontified nil))
(setq jit-lock-first-unfontify-pos nil))))
-
+
+ ;; In the following code, the `sit-for' calls cause a
+ ;; redisplay, so it's required that the
+ ;; buffer-modified flag of a buffer that is displayed
+ ;; has the right value---otherwise the mode line of
+ ;; an unmodified buffer would show a `*'.
(let (start
(nice (or jit-lock-stealth-nice 0))
(point (point)))
- (while (and (setq start (jit-lock-stealth-chunk-start point))
+ (while (and (setq start
+ (jit-lock-stealth-chunk-start point))
(sit-for nice))
;; Wait a little if load is too high.
;; Unless there's input pending now, fontify.
(unless (input-pending-p)
- (jit-lock-function start))))))))))))
+ (jit-lock-function-1 start))))))))))))
\f