diff options
| author | Stefan Monnier | 2014-05-28 23:54:37 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2014-05-28 23:54:37 -0400 |
| commit | 4d05fe986c0ce9f5c06f9655961e56eb80db7e63 (patch) | |
| tree | 4331d98ad1e074a20a0646639fffb3cf36423e9a | |
| parent | 6711a21f1125c0047c56eb266eb374c1ec90a967 (diff) | |
| download | emacs-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/ChangeLog | 10 | ||||
| -rw-r--r-- | 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 @@ | |||
| 1 | 2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2014-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. |
| 1206 | Used by function `whitespace-trailing-regexp' (which see).") | 1206 | Used 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. |
| 2358 | Also refontify when necessary." | 2390 | Also 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 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |