* 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.
This commit is contained in:
Stefan Monnier
parent
6711a21f11
commit
4d05fe986c
2 changed files with 104 additions and 48 deletions
|
|
@ -1,5 +1,15 @@
|
|||
2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* 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):
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue