> My gut feeling is that this is way past the point of diminishing returns.
> Already his optimization is rarely noticeable, but breaks a couple
> (rare) special cases.
>
In the patch below I provide three variables recording the behavior of
contextual fontification
jit-lock-fail-change records the number of modifications the patch
couldn't handle because a buffer change did not occur within the bounds
of a previous change
jit-lock-fail-context records the number of buffer modifications where
syntactic context changed, including modifications of elisp doc-strings
jit-lock-succ-context records the number of buffer modifications where
contextual refontification was avoided
I believe that the patch would be useful if and only if (1) it does not
break existing code, (2) redisplay doesn't suffer noticeable delay due
to before-change-functions, (3) the value of jit-lock-succ-context
exceeds the sum of jit-lock-fail-change and jit-lock-fail-context
significantly, that is by a factor of two or three at least.
--- jit-lock.el 2005-08-18 09:58:40.000000000 +0200
+++ jit-lock.el 2005-09-28 14:17:28.000000000 +0200
@@ -164,6 +164,19 @@
If nil, contextual fontification is disabled.")
(make-variable-buffer-local 'jit-lock-context-unfontify-pos)
+(defvar jit-lock-context-start (make-marker)
+ "Position preceding text affected by latest sequence of buffer changes.
+A marker that stays behind when text is inserted there.")
+
+(defvar jit-lock-context-end (make-marker)
+ "Position following text affected by latest sequence of buffer changes.
+A marker that advances when text is inserted there.")
+(set-marker-insertion-type jit-lock-context-end t)
+
+(defvar jit-lock-context-ppss nil
+ "ppss recorded before the latest sequence of buffer changes.
+This state is recorded by `jit-lock-before-change' at position
+`jit-lock-context-end' before the first of these changes.")
(defvar jit-lock-stealth-timer nil
"Timer for stealth fontification in Just-in-time Lock mode.")
@@ -229,6 +242,7 @@
;; Initialize contextual fontification if requested.
(when (eq jit-lock-contextually t)
+ (add-hook 'before-change-functions 'jit-lock-before-change nil t)
(unless jit-lock-context-timer
(setq jit-lock-context-timer
(run-with-idle-timer jit-lock-context-time t
@@ -258,9 +272,13 @@
(setq jit-lock-context-timer nil))
(when jit-lock-defer-timer
(cancel-timer jit-lock-defer-timer)
- (setq jit-lock-defer-timer nil)))
+ (setq jit-lock-defer-timer nil))
+ ;; Reset markers.
+ (set-marker jit-lock-context-start nil)
+ (set-marker jit-lock-context-end nil))
;; Remove hooks.
+ (remove-hook 'before-change-functions 'jit-lock-before-change t)
(remove-hook 'after-change-functions 'jit-lock-after-change t)
(remove-hook 'fontification-functions 'jit-lock-function))))
@@ -509,38 +527,97 @@
(with-current-buffer buffer
(when jit-lock-context-unfontify-pos
;; (message "Jit-Context %s" (buffer-name))
- (save-restriction
- (widen)
- (when (and (>= jit-lock-context-unfontify-pos (point-min))
- (< jit-lock-context-unfontify-pos (point-max)))
- ;; If we're in text that matches a complex multi-line
- ;; font-lock pattern, make sure the whole text will be
- ;; redisplayed eventually.
- ;; Despite its name, we treat jit-lock-defer-multiline here
- ;; rather than in jit-lock-defer since it has to do with multiple
- ;; lines, i.e. with context.
- (when (get-text-property jit-lock-context-unfontify-pos
- 'jit-lock-defer-multiline)
- (setq jit-lock-context-unfontify-pos
- (or (previous-single-property-change
- jit-lock-context-unfontify-pos
- 'jit-lock-defer-multiline)
- (point-min))))
- (with-buffer-prepared-for-jit-lock
- ;; Force contextual refontification.
- (remove-text-properties
- jit-lock-context-unfontify-pos (point-max)
- '(fontified nil jit-lock-defer-multiline nil)))
- (setq jit-lock-context-unfontify-pos (point-max))))))))
+ (save-excursion
+ (save-restriction
+ (widen)
+
+ ;; If `jit-lock-context-start' points into current buffer
+ ;; investigate latest sequence of buffer modifications.
+ (when (eq (marker-buffer jit-lock-context-start) (current-buffer))
+ ;; Record ppss for `jit-lock-context-end' - a position following
+ ;; the latest sequence of buffer changes - and compare it with the
+ ;; value before these changes recorded in `jit-lock-context-ppss'.
+ (let ((ppss (syntax-ppss jit-lock-context-end)))
+ ;; Refontify contextually if
+ ;; 1. paren depth equals 1 before or after change(s) in Lisp
+ ;; modes - needed to handle doc-strings,
+ ;; 2. character that terminates containing string changed,
+ ;; 3. comment status changed,
+ ;; 4. comment type changed.
+ (if (or (and (memq major-mode '(emacs-lisp-mode lisp-mode))
+ (or (= (nth 0 ppss) 1)
+ (= (nth 0 jit-lock-context-ppss) 1)))
+ (not (equal (nth 3 ppss) (nth 3 jit-lock-context-ppss)))
+ (not (equal (nth 4 ppss) (nth 4 jit-lock-context-ppss)))
+ (not (equal (nth 7 ppss) (nth 7
jit-lock-context-ppss))))
+ ;; Assign `jit-lock-context-unfontify-pos'.
+ (progn
+ (setq jit-lock-fail-context (1+ jit-lock-fail-context))
+ (setq jit-lock-context-unfontify-pos
+ (min jit-lock-context-unfontify-pos
+ jit-lock-context-start)))
+ (setq jit-lock-succ-context (1+ jit-lock-succ-context))))
+ ;; Reset markers.
+ (set-marker jit-lock-context-start nil)
+ (set-marker jit-lock-context-end nil))
+
+ (when (and (>= jit-lock-context-unfontify-pos (point-min))
+ (< jit-lock-context-unfontify-pos (point-max)))
+ ;; If we're in text that matches a complex multi-line
+ ;; font-lock pattern, make sure the whole text will be
+ ;; redisplayed eventually.
+ ;; Despite its name, we treat jit-lock-defer-multiline here
+ ;; rather than in jit-lock-defer since it has to do with multiple
+ ;; lines, i.e. with context.
+ (when (get-text-property jit-lock-context-unfontify-pos
+ 'jit-lock-defer-multiline)
+ (setq jit-lock-context-unfontify-pos
+ (or (previous-single-property-change
+ jit-lock-context-unfontify-pos
+ 'jit-lock-defer-multiline)
+ (point-min))))
+ (with-buffer-prepared-for-jit-lock
+ ;; Force contextual refontification.
+ (remove-text-properties
+ jit-lock-context-unfontify-pos (point-max)
+ '(fontified nil jit-lock-defer-multiline nil)))
+ (setq jit-lock-context-unfontify-pos (point-max)))))))))
+
+(defun jit-lock-before-change (start end)
+ "Calculate ppss at beginning of first line following END.
+Installed on `before-change-functions' when contextual fontification is
+enabled. START and END are start and end of the changed text."
+ (when (and jit-lock-mode jit-lock-context-unfontify-pos
+ ;; Quit unless `jit-lock-context-unfontify-pos' is below START.
+ (> jit-lock-context-unfontify-pos start)
+ ;; Do this once for a sequence of modifications only, that is, iff
+ ;; `jit-lock-context-start' does not point into current buffer.
+ (not (eq (marker-buffer jit-lock-context-start)
+ (current-buffer))))
+ (when (marker-buffer jit-lock-context-start)
+ ;; `jit-lock-context-start' points into another buffer. Set
+ ;; `jit-lock-context-unfontify-pos' in that buffer.
+ (with-current-buffer (marker-buffer jit-lock-context-start)
+ (setq jit-lock-context-unfontify-pos
+ (min jit-lock-context-unfontify-pos
+ jit-lock-context-start))))
+ (save-excursion
+ ;; Install markers.
+ (set-marker jit-lock-context-start
+ (progn (goto-char start) (line-beginning-position)))
+ (set-marker jit-lock-context-end
+ (progn (goto-char end) (line-beginning-position 2)))
+ ;; Record ppss at `jit-lock-context-end'.
+ (setq jit-lock-context-ppss (syntax-ppss jit-lock-context-end)))))
(defun jit-lock-after-change (start end old-len)
"Mark the rest of the buffer as not fontified after a change.
-Installed on `after-change-functions'.
-START and END are the start and end of the changed text. OLD-LEN
-is the pre-change length.
-This function ensures that lines following the change will be refontified
-in case the syntax of those lines has changed. Refontification
-will take place when text is fontified stealthily."
+Installed on `after-change-functions'. START and END are the start and
+end of the changed text. OLD-LEN is the pre-change length. When
+contextual fontification is enabled, this function ensures that lines
+following the change will be refontified in case the syntax of those
+lines has changed. Refontification will take place during redisplay or
+when text is fontified stealthily."
(when jit-lock-mode
(save-excursion
(with-buffer-prepared-for-jit-lock
@@ -562,13 +639,50 @@
;; Make sure we change at least one char (in case of deletions).
(setq end (min (max end (1+ start)) (point-max)))
;; Request refontification.
- (put-text-property start end 'fontified nil))
- ;; Mark the change for deferred contextual refontification.
- (when jit-lock-context-unfontify-pos
- (setq jit-lock-context-unfontify-pos
- (min jit-lock-context-unfontify-pos start))))))
+ (put-text-property start end 'fontified nil)
+
+ ;; Contextual refontification.
+ (cond
+ ((not jit-lock-context-unfontify-pos))
+ ;; Handle case where `jit-lock-context-start' was not set properly for
+ ;; some reason, for example, because `before-change-functions' has been
+ ;; temporarily let-bound to nil.
+ ((not (eq (marker-buffer jit-lock-context-start) (current-buffer)))
+ ;; Adjust `jit-lock-context-unfontify-pos'.
+ (setq jit-lock-context-unfontify-pos
+ (min jit-lock-context-unfontify-pos start))
+ (when (marker-buffer jit-lock-context-start)
+ ;; `jit-lock-context-start' points into some other buffer.
+ ;; Set `jit-lock-context-unfontify-pos' in that buffer.
+ (with-current-buffer (marker-buffer jit-lock-context-start)
+ (setq jit-lock-context-unfontify-pos
+ (min jit-lock-context-unfontify-pos
+ jit-lock-context-start)))
+ ;; Reset markers.
+ (setq jit-lock-fail-change (1+ jit-lock-fail-change))
+ (set-marker jit-lock-context-start nil)
+ (set-marker jit-lock-context-end nil)))
+ ;; Quit if `jit-lock-context-unfontify-pos' is before START. Also sort
+ ;; out buffer modifications that precede `jit-lock-context-start' or
+ ;; follow `jit-lock-context-end'. We could handle backward-deletions of
+ ;; newlines here but in that case we would have to re-parse anyway.
+ ((or (<= jit-lock-context-unfontify-pos start)
+ (< start jit-lock-context-start)
+ (> end jit-lock-context-end))
+ ;; Adjust `jit-lock-context-unfontify-pos'.
+ (setq jit-lock-context-unfontify-pos
+ (min jit-lock-context-unfontify-pos
+ jit-lock-context-start start))
+ ;; Reset markers.
+ (setq jit-lock-fail-change (1+ jit-lock-fail-change))
+ (set-marker jit-lock-context-start nil)
+ (set-marker jit-lock-context-end nil)))))))
(provide 'jit-lock)
;;; arch-tag: 56b5de6e-f581-453b-bb97-49c39372ff9e
;;; jit-lock.el ends here
+
+(defvar jit-lock-fail-change 0)
+(defvar jit-lock-fail-context 0)
+(defvar jit-lock-succ-context 0)
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel
