aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2014-05-28 23:54:37 -0400
committerStefan Monnier2014-05-28 23:54:37 -0400
commit4d05fe986c0ce9f5c06f9655961e56eb80db7e63 (patch)
tree4331d98ad1e074a20a0646639fffb3cf36423e9a
parent6711a21f1125c0047c56eb266eb374c1ec90a967 (diff)
downloademacs-4d05fe986c0ce9f5c06f9655961e56eb80db7e63.tar.gz
emacs-4d05fe986c0ce9f5c06f9655961e56eb80db7e63.zip
* 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.
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/whitespace.el144
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 @@
12014-05-29 Stefan Monnier <monnier@iro.umontreal.ca> 12014-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * whitespace.el: Use font-lock-flush. Minimize refontifications.
4 Side benefit: it works without jit-lock.
5 (whitespace-point--used): New buffer-local var.
6 (whitespace-color-on): Initialize it and flush it. Use font-lock-flush.
7 (whitespace-color-off): Use font-lock-flush.
8 (whitespace-point--used, whitespace-point--flush-used): New functions.
9 (whitespace-trailing-regexp, whitespace-empty-at-bob-regexp)
10 (whitespace-empty-at-eob-regexp): Use them.
11 (whitespace-post-command-hook): Rewrite.
12
3 * font-lock.el (font-lock-flush, font-lock-ensure): New functions. 13 * font-lock.el (font-lock-flush, font-lock-ensure): New functions.
4 (font-lock-fontify-buffer): Mark interactive-only. 14 (font-lock-fontify-buffer): Mark interactive-only.
5 (font-lock-multiline, font-lock-fontified, font-lock-set-defaults): 15 (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.
1204(defvar whitespace-point (point) 1204(defvar whitespace-point (point)
1205 "Used to save locally current point value. 1205 "Used to save locally current point value.
1206Used by function `whitespace-trailing-regexp' (which see).") 1206Used by function `whitespace-trailing-regexp' (which see).")
1207(defvar-local whitespace-point--used nil
1208 "Region whose highlighting depends on `whitespace-point'.")
1207 1209
1208(defvar whitespace-font-lock-refontify nil 1210(defvar whitespace-font-lock-refontify nil
1209 "Used to save locally the font-lock refontify state. 1211 "Used to save locally the font-lock refontify state.
@@ -2155,7 +2157,10 @@ resultant list will be returned."
2155 (when (whitespace-style-face-p) 2157 (when (whitespace-style-face-p)
2156 ;; save current point and refontify when necessary 2158 ;; save current point and refontify when necessary
2157 (set (make-local-variable 'whitespace-point) 2159 (set (make-local-variable 'whitespace-point)
2158 (point)) 2160 (point))
2161 (setq whitespace-point--used
2162 (let ((ol (make-overlay (point) (point) nil nil t)))
2163 (delete-overlay ol) ol))
2159 (set (make-local-variable 'whitespace-font-lock-refontify) 2164 (set (make-local-variable 'whitespace-font-lock-refontify)
2160 0) 2165 0)
2161 (set (make-local-variable 'whitespace-bob-marker) 2166 (set (make-local-variable 'whitespace-bob-marker)
@@ -2170,6 +2175,7 @@ resultant list will be returned."
2170 (setq 2175 (setq
2171 whitespace-font-lock-keywords 2176 whitespace-font-lock-keywords
2172 `( 2177 `(
2178 (whitespace-point--flush-used)
2173 ,@(when (memq 'spaces whitespace-active-style) 2179 ,@(when (memq 'spaces whitespace-active-style)
2174 ;; Show SPACEs. 2180 ;; Show SPACEs.
2175 `((,whitespace-space-regexp 1 whitespace-space t) 2181 `((,whitespace-space-regexp 1 whitespace-space t)
@@ -2247,26 +2253,47 @@ resultant list will be returned."
2247 (whitespace-space-after-tab-regexp 'space))) 2253 (whitespace-space-after-tab-regexp 'space)))
2248 1 whitespace-space-after-tab t))))) 2254 1 whitespace-space-after-tab t)))))
2249 (font-lock-add-keywords nil whitespace-font-lock-keywords t) 2255 (font-lock-add-keywords nil whitespace-font-lock-keywords t)
2250 (when font-lock-mode 2256 (font-lock-flush)))
2251 (font-lock-fontify-buffer))))
2252 2257
2253 2258
2254(defun whitespace-color-off () 2259(defun whitespace-color-off ()
2255 "Turn off color visualization." 2260 "Turn off color visualization."
2256 ;; turn off font lock 2261 ;; turn off font lock
2262 (kill-local-variable 'whitespace-point--used)
2257 (when (whitespace-style-face-p) 2263 (when (whitespace-style-face-p)
2258 (remove-hook 'post-command-hook #'whitespace-post-command-hook t) 2264 (remove-hook 'post-command-hook #'whitespace-post-command-hook t)
2259 (remove-hook 'before-change-functions #'whitespace-buffer-changed t) 2265 (remove-hook 'before-change-functions #'whitespace-buffer-changed t)
2260 (font-lock-remove-keywords nil whitespace-font-lock-keywords) 2266 (font-lock-remove-keywords nil whitespace-font-lock-keywords)
2261 (when font-lock-mode 2267 (font-lock-flush)))
2262 (font-lock-fontify-buffer)))) 2268
2263 2269(defun whitespace-point--used (start end)
2270 (let ((ostart (overlay-start whitespace-point--used)))
2271 (if ostart
2272 (move-overlay whitespace-point--used
2273 (min start ostart)
2274 (max end (overlay-end whitespace-point--used)))
2275 (move-overlay whitespace-point--used start end))))
2276
2277(defun whitespace-point--flush-used (limit)
2278 (let ((ostart (overlay-start whitespace-point--used)))
2279 ;; Strip parts of whitespace-point--used we're about to refresh.
2280 (when ostart
2281 (let ((oend (overlay-end whitespace-point--used)))
2282 (if (<= (point) ostart)
2283 (if (<= oend limit)
2284 (delete-overlay whitespace-point--used)
2285 (move-overlay whitespace-point--used limit oend)))
2286 (if (<= oend limit)
2287 (move-overlay whitespace-point--used ostart (point))))))
2288 nil)
2264 2289
2265(defun whitespace-trailing-regexp (limit) 2290(defun whitespace-trailing-regexp (limit)
2266 "Match trailing spaces which do not contain the point at end of line." 2291 "Match trailing spaces which do not contain the point at end of line."
2267 (let ((status t)) 2292 (let ((status t))
2268 (while (if (re-search-forward whitespace-trailing-regexp limit t) 2293 (while (if (re-search-forward whitespace-trailing-regexp limit t)
2269 (= whitespace-point (match-end 1)) ;; loop if point at eol 2294 (when (= whitespace-point (match-end 1)) ; Loop if point at eol.
2295 (whitespace-point--used (match-beginning 0) (match-end 0))
2296 t)
2270 (setq status nil))) ;; end of buffer 2297 (setq status nil))) ;; end of buffer
2271 status)) 2298 status))
2272 2299
@@ -2279,8 +2306,11 @@ beginning of buffer."
2279 (cond 2306 (cond
2280 ;; at bob 2307 ;; at bob
2281 ((= b 1) 2308 ((= b 1)
2282 (setq r (and (/= whitespace-point 1) 2309 (setq r (and (looking-at whitespace-empty-at-bob-regexp)
2283 (looking-at whitespace-empty-at-bob-regexp))) 2310 (or (/= whitespace-point 1)
2311 (progn (whitespace-point--used (match-beginning 0)
2312 (match-end 0))
2313 nil))))
2284 (set-marker whitespace-bob-marker (if r (match-end 1) b))) 2314 (set-marker whitespace-bob-marker (if r (match-end 1) b)))
2285 ;; inside bob empty region 2315 ;; inside bob empty region
2286 ((<= limit whitespace-bob-marker) 2316 ((<= limit whitespace-bob-marker)
@@ -2318,9 +2348,11 @@ buffer."
2318 (cond 2348 (cond
2319 ;; at eob 2349 ;; at eob
2320 ((= limit e) 2350 ((= limit e)
2321 (when (/= whitespace-point e) 2351 (goto-char limit)
2322 (goto-char limit) 2352 (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
2323 (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))) 2353 (when (and r (= whitespace-point e))
2354 (setq r nil)
2355 (whitespace-point--used (match-beginning 0) (match-end 0)))
2324 (if r 2356 (if r
2325 (set-marker whitespace-eob-marker (match-beginning 1)) 2357 (set-marker whitespace-eob-marker (match-beginning 1))
2326 (set-marker whitespace-eob-marker limit) 2358 (set-marker whitespace-eob-marker limit)
@@ -2356,43 +2388,57 @@ buffer."
2356(defun whitespace-post-command-hook () 2388(defun whitespace-post-command-hook ()
2357 "Save current point into `whitespace-point' variable. 2389 "Save current point into `whitespace-point' variable.
2358Also refontify when necessary." 2390Also refontify when necessary."
2359 (setq whitespace-point (point)) ; current point position 2391 (unless (and (eq whitespace-point (point))
2360 (let ((refontify 2392 (not whitespace-buffer-changed))
2361 (or 2393 (setq whitespace-point (point)) ; current point position
2362 ;; it is at end of line ... 2394 (let ((refontify
2363 (and (eolp) 2395 (cond
2364 ;; ... with trailing SPACE or TAB 2396 ;; It is at end of buffer (eob).
2365 (or (= (preceding-char) ?\ ) 2397 ((= whitespace-point (1+ (buffer-size)))
2366 (= (preceding-char) ?\t))) 2398 (when (whitespace-looking-back whitespace-empty-at-eob-regexp
2367 ;; it is at beginning of buffer (bob) 2399 nil)
2368 (= whitespace-point 1) 2400 (match-beginning 0)))
2369 ;; the buffer was modified and ... 2401 ;; It is at end of line ...
2370 (and whitespace-buffer-changed 2402 ((and (eolp)
2371 (or 2403 ;; ... with trailing SPACE or TAB
2372 ;; ... or inside bob whitespace region 2404 (or (memq (preceding-char) '(?\s ?\t))))
2373 (<= whitespace-point whitespace-bob-marker) 2405 (line-beginning-position))
2374 ;; ... or at bob whitespace region border 2406 ;; It is at beginning of buffer (bob).
2375 (and (= whitespace-point (1+ whitespace-bob-marker)) 2407 ((and (= whitespace-point 1)
2376 (= (preceding-char) ?\n)))) 2408 (looking-at whitespace-empty-at-bob-regexp))
2377 ;; it is at end of buffer (eob) 2409 (match-end 0))))
2378 (= whitespace-point (1+ (buffer-size))) 2410 (ostart (overlay-start whitespace-point--used)))
2379 ;; the buffer was modified and ... 2411 (cond
2380 (and whitespace-buffer-changed 2412 ((not refontify)
2381 (or 2413 ;; New point does not affect highlighting: just refresh the
2382 ;; ... or inside eob whitespace region 2414 ;; highlighting of old point, if needed.
2383 (>= whitespace-point whitespace-eob-marker) 2415 (when ostart
2384 ;; ... or at eob whitespace region border 2416 (font-lock-flush ostart
2385 (and (= whitespace-point (1- whitespace-eob-marker)) 2417 (overlay-end whitespace-point--used))
2386 (= (following-char) ?\n))))))) 2418 (delete-overlay whitespace-point--used)))
2387 (when (or refontify (> whitespace-font-lock-refontify 0)) 2419 ((not ostart)
2388 (setq whitespace-buffer-changed nil) 2420 ;; Old point did not affect highlighting, but new one does: refresh the
2389 ;; adjust refontify counter 2421 ;; highlighting of new point.
2390 (setq whitespace-font-lock-refontify 2422 (font-lock-flush (min refontify (point)) (max refontify (point))))
2391 (if refontify 2423 ((save-excursion
2392 1 2424 (goto-char ostart)
2393 (1- whitespace-font-lock-refontify))) 2425 (setq ostart (line-beginning-position))
2394 ;; refontify 2426 (and (<= ostart (max refontify (point)))
2395 (jit-lock-refontify)))) 2427 (progn
2428 (goto-char (overlay-end whitespace-point--used))
2429 (let ((oend (line-beginning-position 2)))
2430 (<= (min refontify (point)) oend)))))
2431 ;; The old point highlighting and the new point highlighting
2432 ;; cover a contiguous region: do a single refresh.
2433 (font-lock-flush (min refontify (point) ostart)
2434 (max refontify (point)
2435 (overlay-end whitespace-point--used)))
2436 (delete-overlay whitespace-point--used))
2437 (t
2438 (font-lock-flush (min refontify (point))
2439 (max refontify (point)))
2440 (font-lock-flush ostart (overlay-end whitespace-point--used))
2441 (delete-overlay whitespace-point--used))))))
2396 2442
2397 2443
2398;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2444;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;