(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
- (let ((end (min (point-max) (+ start jit-lock-chunk-size)))
- (parse-sexp-lookup-properties font-lock-syntactic-keywords)
- (old-syntax-table (syntax-table))
- (font-lock-beginning-of-syntax-function nil)
- next)
- (when font-lock-syntax-table
- (set-syntax-table font-lock-syntax-table))
- (save-excursion
- (save-restriction
- (widen)
- (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))
-
- ;; Goto to the start of the chunk. Make sure we
- ;; start fontifying at the beginning of the line
- ;; containing the chunk start because font-lock
- ;; functions seem to expects this, if I believe
- ;; lazy-lock.
- (goto-char start)
- (setq 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 start 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 ()
(defsubst jit-lock-stealth-chunk-start (around)
"Return the start of the next chunk to fontify around position AROUND..
Value is nil if there is nothing more to fontify."
- (save-restriction
- (widen)
- (let ((prev (previous-single-property-change around 'fontified))
- (next (text-property-any around (point-max) 'fontified nil))
- (prop (get-text-property around 'fontified)))
- (cond ((and (null prop)
- (< around (point-max)))
- ;; Text at position AROUND is not fontified. The value of
- ;; prev, if non-nil, is the start of the region of
- ;; unfontified text. As a special case, prop will always
- ;; be nil at point-max. So don't handle that case here.
- (max (or prev (point-min))
- (- around jit-lock-chunk-size)))
-
- ((null prev)
- ;; Text at AROUND is fontified, and everything up to
- ;; point-min is. Return the value of next. If that is
- ;; nil, there is nothing left to fontify.
- next)
-
- ((or (null next)
- (< (- around prev) (- next around)))
- ;; We either have no unfontified text following AROUND, or
- ;; the unfontified text in front of AROUND is nearer. The
- ;; value of prev is the end of the region of unfontified
- ;; text in front of AROUND.
- (let ((start (previous-single-property-change prev 'fontified)))
- (max (or start (point-min))
- (- prev jit-lock-chunk-size))))
-
- (t
- next)))))
-
+ (if (zerop (buffer-size))
+ nil
+ (save-restriction
+ (widen)
+ (let* ((next (text-property-any around (point-max) 'fontified nil))
+ (prev (previous-single-property-change around 'fontified))
+ (prop (get-text-property (max (point-min) (1- around))
+ 'fontified))
+ (start (cond
+ ((null prev)
+ ;; There is no property change between AROUND
+ ;; and the start of the buffer. If PROP is
+ ;; non-nil, everything in front of AROUND is
+ ;; fontified, otherwise nothing is fontified.
+ (if prop
+ nil
+ (max (point-min)
+ (- around (/ jit-lock-chunk-size 2)))))
+ (prop
+ ;; PREV is the start of a region of fontified
+ ;; text containing AROUND. Start fontfifying a
+ ;; chunk size before the end of the unfontified
+ ;; region in front of that.
+ (max (or (previous-single-property-change prev 'fontified)
+ (point-min))
+ (- prev jit-lock-chunk-size)))
+ (t
+ ;; PREV is the start of a region of unfontified
+ ;; text containing AROUND. Start at PREV or
+ ;; chunk size in front of AROUND, whichever is
+ ;; nearer.
+ (max prev (- around jit-lock-chunk-size)))))
+ (result (cond ((null start) next)
+ ((null next) start)
+ ((< (- around start) (- next around)) start)
+ (t next))))
+ result))))
+
(defun jit-lock-stealth-fontify ()
"Fontify buffers stealthily.
(let ((buffers (buffer-list))
minibuffer-auto-raise
message-log-max)
- (while (and buffers
- (not (input-pending-p)))
+ (while (and buffers (not (input-pending-p)))
(let ((buffer (car buffers)))
(setq buffers (cdr buffers))
+
(with-current-buffer buffer
(when jit-lock-mode
;; This is funny. Calling sit-for with 3rd arg non-nil
(with-temp-message (if jit-lock-stealth-verbose
(concat "JIT stealth lock "
(buffer-name)))
-
+
;; Perform deferred unfontification, if any.
(when jit-lock-first-unfontify-pos
(save-restriction
(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)))
;; Unless there's input pending now, fontify.
(unless (input-pending-p)
- (jit-lock-function start))))))))))))
+ (jit-lock-function-1 start))))))))))))
\f