[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r117183: * lisp/whitespace.el: Use font-lock-flush.
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] trunk r117183: * lisp/whitespace.el: Use font-lock-flush. Minimize refontifications. |
Date: |
Thu, 29 May 2014 03:54:42 +0000 |
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
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))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r117183: * lisp/whitespace.el: Use font-lock-flush. Minimize refontifications.,
Stefan Monnier <=