From 4d05fe986c0ce9f5c06f9655961e56eb80db7e63 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 28 May 2014 23:54:37 -0400 Subject: [PATCH] * 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. --- lisp/ChangeLog | 10 ++++ lisp/whitespace.el | 144 ++++++++++++++++++++++++++++++--------------- 2 files changed, 105 insertions(+), 49 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ea017768478..746809c12c7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,15 @@ 2014-05-29 Stefan Monnier + * 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): diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 83bd4e06074..2217506fff5 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1204,6 +1204,8 @@ SYMBOL is a valid symbol associated with CHAR. (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 @@ resultant list will be returned." (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 @@ resultant list will be returned." (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 @@ resultant list will be returned." (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 @@ beginning of buffer." (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 @@ buffer." (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 @@ buffer." (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)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -- 2.39.2