[Emacs-diffs] trunk r117183: * lisp/whitespace.el: Use font-lock-flush. Minimize refontifications.

[Stefan Monnier]

------------------------------------------------------------
revno: 117183
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2014-05-28 23:54:37 -0400
message:
  * lisp/whitespace.el: Use font-lock-flush.  Minimize refontifications.
  Side benefit: it works without jit-lock.
  (whitespace-point--used): New buffer-local var.
  (whitespace-color-on): Initialize it and flush it.  Use font-lock-flush.
  (whitespace-color-off): Use font-lock-flush.
  (whitespace-point--used, whitespace-point--flush-used): New functions.
  (whitespace-trailing-regexp, whitespace-empty-at-bob-regexp)
  (whitespace-empty-at-eob-regexp): Use them.
  (whitespace-post-command-hook): Rewrite.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/whitespace.el             
whitespace.el-20091113204419-o5vbwnq5f7feedwu-8268

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-05-29 03:45:29 +0000
+++ b/lisp/ChangeLog    2014-05-29 03:54:37 +0000
@@ -1,5 +1,15 @@
 2014-05-29  Stefan Monnier  <address@hidden>
 
+       * whitespace.el: Use font-lock-flush.  Minimize refontifications.
+       Side benefit: it works without jit-lock.
+       (whitespace-point--used): New buffer-local var.
+       (whitespace-color-on): Initialize it and flush it.  Use font-lock-flush.
+       (whitespace-color-off): Use font-lock-flush.
+       (whitespace-point--used, whitespace-point--flush-used): New functions.
+       (whitespace-trailing-regexp, whitespace-empty-at-bob-regexp)
+       (whitespace-empty-at-eob-regexp): Use them.
+       (whitespace-post-command-hook): Rewrite.
+
        * font-lock.el (font-lock-flush, font-lock-ensure): New functions.
        (font-lock-fontify-buffer): Mark interactive-only.
        (font-lock-multiline, font-lock-fontified, font-lock-set-defaults):

=== modified file 'lisp/whitespace.el'
--- a/lisp/whitespace.el        2014-02-21 16:18:56 +0000
+++ b/lisp/whitespace.el        2014-05-29 03:54:37 +0000
@@ -1204,6 +1204,8 @@
 (defvar whitespace-point (point)
   "Used to save locally current point value.
 Used by function `whitespace-trailing-regexp' (which see).")
+(defvar-local whitespace-point--used nil
+  "Region whose highlighting depends on `whitespace-point'.")
 
 (defvar whitespace-font-lock-refontify nil
   "Used to save locally the font-lock refontify state.
@@ -2155,7 +2157,10 @@
   (when (whitespace-style-face-p)
     ;; save current point and refontify when necessary
     (set (make-local-variable 'whitespace-point)
-        (point))
+         (point))
+    (setq whitespace-point--used
+          (let ((ol (make-overlay (point) (point) nil nil t)))
+            (delete-overlay ol) ol))
     (set (make-local-variable 'whitespace-font-lock-refontify)
         0)
     (set (make-local-variable 'whitespace-bob-marker)
@@ -2170,6 +2175,7 @@
     (setq
      whitespace-font-lock-keywords
      `(
+       (whitespace-point--flush-used)
        ,@(when (memq 'spaces whitespace-active-style)
            ;; Show SPACEs.
            `((,whitespace-space-regexp 1 whitespace-space t)
@@ -2247,26 +2253,47 @@
                  (whitespace-space-after-tab-regexp 'space)))
               1 whitespace-space-after-tab t)))))
     (font-lock-add-keywords nil whitespace-font-lock-keywords t)
-    (when font-lock-mode
-      (font-lock-fontify-buffer))))
+    (font-lock-flush)))
 
 
 (defun whitespace-color-off ()
   "Turn off color visualization."
   ;; turn off font lock
+  (kill-local-variable 'whitespace-point--used)
   (when (whitespace-style-face-p)
     (remove-hook 'post-command-hook #'whitespace-post-command-hook t)
     (remove-hook 'before-change-functions #'whitespace-buffer-changed t)
     (font-lock-remove-keywords nil whitespace-font-lock-keywords)
-    (when font-lock-mode
-      (font-lock-fontify-buffer))))
-
+    (font-lock-flush)))
+
+(defun whitespace-point--used (start end)
+  (let ((ostart (overlay-start whitespace-point--used)))
+    (if ostart
+        (move-overlay whitespace-point--used
+                      (min start ostart)
+                      (max end (overlay-end whitespace-point--used)))
+      (move-overlay whitespace-point--used start end))))
+
+(defun whitespace-point--flush-used (limit)
+  (let ((ostart (overlay-start whitespace-point--used)))
+    ;; Strip parts of whitespace-point--used we're about to refresh.
+    (when ostart
+      (let ((oend (overlay-end whitespace-point--used)))
+        (if (<= (point) ostart)
+            (if (<= oend limit)
+                (delete-overlay whitespace-point--used)
+              (move-overlay whitespace-point--used limit oend)))
+        (if (<= oend limit)
+            (move-overlay whitespace-point--used ostart (point))))))
+  nil)
 
 (defun whitespace-trailing-regexp (limit)
   "Match trailing spaces which do not contain the point at end of line."
   (let ((status t))
     (while (if (re-search-forward whitespace-trailing-regexp limit t)
-              (= whitespace-point (match-end 1)) ;; loop if point at eol
+              (when (= whitespace-point (match-end 1)) ; Loop if point at eol.
+                 (whitespace-point--used (match-beginning 0) (match-end 0))
+                 t)
             (setq status nil)))                  ;; end of buffer
     status))
 
@@ -2279,8 +2306,11 @@
     (cond
      ;; at bob
      ((= b 1)
-      (setq r (and (/= whitespace-point 1)
-                  (looking-at whitespace-empty-at-bob-regexp)))
+      (setq r (and (looking-at whitespace-empty-at-bob-regexp)
+                   (or (/= whitespace-point 1)
+                       (progn (whitespace-point--used (match-beginning 0)
+                                                      (match-end 0))
+                              nil))))
       (set-marker whitespace-bob-marker (if r (match-end 1) b)))
      ;; inside bob empty region
      ((<= limit whitespace-bob-marker)
@@ -2318,9 +2348,11 @@
     (cond
      ;; at eob
      ((= limit e)
-      (when (/= whitespace-point e)
-       (goto-char limit)
-       (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)))
+      (goto-char limit)
+      (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
+      (when (and r (= whitespace-point e))
+        (setq r nil)
+        (whitespace-point--used (match-beginning 0) (match-end 0)))
       (if r
          (set-marker whitespace-eob-marker (match-beginning 1))
        (set-marker whitespace-eob-marker limit)
@@ -2356,43 +2388,57 @@
 (defun whitespace-post-command-hook ()
   "Save current point into `whitespace-point' variable.
 Also refontify when necessary."
-  (setq whitespace-point (point))      ; current point position
-  (let ((refontify
-        (or
-         ;; it is at end of line ...
-         (and (eolp)
-              ;; ... with trailing SPACE or TAB
-              (or (= (preceding-char) ?\ )
-                  (= (preceding-char) ?\t)))
-         ;; it is at beginning of buffer (bob)
-         (= whitespace-point 1)
-         ;; the buffer was modified and ...
-         (and whitespace-buffer-changed
-              (or
-               ;; ... or inside bob whitespace region
-               (<= whitespace-point whitespace-bob-marker)
-               ;; ... or at bob whitespace region border
-               (and (= whitespace-point (1+ whitespace-bob-marker))
-                    (= (preceding-char) ?\n))))
-         ;; it is at end of buffer (eob)
-         (= whitespace-point (1+ (buffer-size)))
-         ;; the buffer was modified and ...
-         (and whitespace-buffer-changed
-              (or
-               ;; ... or inside eob whitespace region
-               (>= whitespace-point whitespace-eob-marker)
-               ;; ... or at eob whitespace region border
-               (and (= whitespace-point (1- whitespace-eob-marker))
-                    (= (following-char) ?\n)))))))
-    (when (or refontify (> whitespace-font-lock-refontify 0))
-      (setq whitespace-buffer-changed nil)
-      ;; adjust refontify counter
-      (setq whitespace-font-lock-refontify
-           (if refontify
-               1
-             (1- whitespace-font-lock-refontify)))
-      ;; refontify
-      (jit-lock-refontify))))
+  (unless (and (eq whitespace-point (point))
+               (not whitespace-buffer-changed))
+    (setq whitespace-point (point))    ; current point position
+    (let ((refontify
+           (cond
+            ;; It is at end of buffer (eob).
+            ((= whitespace-point (1+ (buffer-size)))
+             (when (whitespace-looking-back whitespace-empty-at-eob-regexp
+                                            nil)
+               (match-beginning 0)))
+            ;; It is at end of line ...
+            ((and (eolp)
+                  ;; ... with trailing SPACE or TAB
+                  (or (memq (preceding-char) '(?\s ?\t))))
+             (line-beginning-position))
+            ;; It is at beginning of buffer (bob).
+            ((and (= whitespace-point 1)
+                  (looking-at whitespace-empty-at-bob-regexp))
+             (match-end 0))))
+          (ostart (overlay-start whitespace-point--used)))
+      (cond
+       ((not refontify)
+        ;; New point does not affect highlighting: just refresh the
+        ;; highlighting of old point, if needed.
+        (when ostart
+          (font-lock-flush ostart
+                           (overlay-end whitespace-point--used))
+          (delete-overlay whitespace-point--used)))
+       ((not ostart)
+        ;; Old point did not affect highlighting, but new one does: refresh the
+        ;; highlighting of new point.
+        (font-lock-flush (min refontify (point)) (max refontify (point))))
+       ((save-excursion
+          (goto-char ostart)
+          (setq ostart (line-beginning-position))
+          (and (<= ostart (max refontify (point)))
+               (progn
+                 (goto-char (overlay-end whitespace-point--used))
+                 (let ((oend (line-beginning-position 2)))
+                   (<= (min refontify (point)) oend)))))
+        ;; The old point highlighting and the new point highlighting
+        ;; cover a contiguous region: do a single refresh.
+        (font-lock-flush (min refontify (point) ostart)
+                         (max refontify (point)
+                              (overlay-end whitespace-point--used)))
+        (delete-overlay whitespace-point--used))
+       (t
+        (font-lock-flush (min refontify (point))
+                         (max refontify (point)))
+        (font-lock-flush ostart (overlay-end whitespace-point--used))
+        (delete-overlay whitespace-point--used))))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;