-
Notifications
You must be signed in to change notification settings - Fork 1
/
highlight-refontification.el
316 lines (276 loc) · 11.8 KB
/
highlight-refontification.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
;;; highlight-refontification.el --- Visualize font-lock refontification.
;; Copyright (C) 2014-2017 Anders Lindgren
;; Author: Anders Lindgren
;; Keywords: faces, tools
;; Created: 2014-05-15
;; Version: 0.0.3
;; URL: https://github.com/Lindydancer/highlight-refontification
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Minor mode that visualizes how font-lock refontifies a buffer.
;; This is useful when developing or debugging font-lock keywords,
;; especially for keywords that span multiple lines.
;;
;; The background of the buffer is painted in a rainbow of colors,
;; where each band in the rainbow represent a region of the buffer
;; that has been refontified. When the buffer is modified, the
;; rainbow is updated.
;; Screenshot:
;;
;; 
;; Background:
;;
;; When you edit a file, font-lock mode recalculates syntax
;; highlighting as you type. Clearly, this process must be fast. If
;; not, Emacs would appear to be slow. For this reason, as little as
;; possible is refontified, often only the line that was edited. Once
;; Emacs is idle, a larger section is refontified.
;;
;; Unfortunately, some font-lock keywords doesn't work correctly when
;; applied to region which is too small.
;; Examples:
;;
;; You can use this tool, for example, to:
;;
;; - Investigate when font-lock makes Emacs slow. If a large region is
;; refontified for every character typed, could cause this.
;;
;; - Investigate why a font-lock rule sometimes work, sometimes
;; doesn't. One cause of this could be that the region starts in
;; the middle of the language construct that should be highlighted.
;;
;; - Investigate "blinking" syntax highlighting, i.e. the effect where
;; one color is first applied, and after, say, half a second,
;; another is applied.
;; The refontification process:
;;
;; When font-lock decides to update a region, it calls the functions
;; in `font-lock-extend-region-functions'. Each function can extend
;; the region. For example, when `font-lock-multiline' is enabled,
;; the function `font-lock-extend-region-multiline' is included. It
;; will extend the region to include all the lines of something that
;; previously was matched in a multiline rule.
;; Usage:
;;
;; - `M-x highlight-refontification-mode RET' -- When this mode is
;; enabled, any change in the buffer is visualized by a change in
;; the background color.
;;
;; - `M-x highlight-refontification-list-extend-region-steps RET' --
;; Print the steps font-lock would take to extend a region.
;; Other Font Lock Tools:
;;
;; This package is part of a suite of font-lock tools. The other
;; tools in the suite are:
;;
;;
;; Font Lock Studio:
;;
;; Interactive debugger for font-lock keywords (Emacs syntax
;; highlighting rules).
;;
;; Font Lock Studio lets you *single-step* Font Lock keywords --
;; matchers, highlights, and anchored rules, so that you can see what
;; happens when a buffer is fontified. You can set *breakpoints* on or
;; inside rules and *run* until one has been hit. When inside a rule,
;; matches are *visualized* using a palette of background colors. The
;; *explainer* can describe a rule in plain-text English. Tight
;; integration with *Edebug* allows you to step into Lisp expressions
;; that are part of the Font Lock keywords.
;;
;;
;; Font Lock Profiler:
;;
;; A profiler for font-lock keywords. This package measures time and
;; counts the number of times each part of a font-lock keyword is
;; used. For matchers, it counts the total number and the number of
;; successful matches.
;;
;; The result is presented in table that can be sorted by count or
;; time. The table can be expanded to include each part of the
;; font-lock keyword.
;;
;; In addition, this package can generate a log of all font-lock
;; events. This can be used to verify font-lock implementations,
;; concretely, this is used for back-to-back tests of the real
;; font-lock engine and Font Lock Studio, an interactive debugger for
;; font-lock keywords.
;;
;;
;; Faceup:
;;
;; Emacs is capable of highlighting buffers based on language-specific
;; `font-lock' rules. This package makes it possible to perform
;; regression test for packages that provide font-lock rules.
;;
;; The underlying idea is to convert text with highlights ("faces")
;; into a plain text representation using the Faceup markup
;; language. This language is semi-human readable, for example:
;;
;; «k:this» is a keyword
;;
;; By comparing the current highlight with a highlight performed with
;; stable versions of a package, it's possible to automatically find
;; problems that otherwise would have been hard to spot.
;;
;; This package is designed to be used in conjunction with Ert, the
;; standard Emacs regression test system.
;;
;; The Faceup markup language is a generic markup language, regression
;; testing is merely one way to use it.
;;
;;
;; Font Lock Regression Suite:
;;
;; A collection of example source files for a large number of
;; programming languages, with ERT tests to ensure that syntax
;; highlighting does not accidentally change.
;;
;; For each source file, font-lock reference files are provided for
;; various Emacs versions. The reference files contains a plain-text
;; representation of source file with syntax highlighting, using the
;; format "faceup".
;;
;; Of course, the collection source file can be used for other kinds
;; of testing, not limited to font-lock regression testing.
;;; Code:
;; ------------------------------------------------------------
;; The minor mode.
;;
(defvar highlight-refontification-keywords
'((highlight-refontification-matcher))
"Font-lock keywords for `highlight-refontification-mode'.")
(defvar highlight-refontification-index nil
"Current index into `highlight-refontification-colors'.
This variable is incremented for each refontification. When
larger than the length of `highlight-refontification-colors', it
is set to 0.")
(make-variable-buffer-local 'highlight-refontification-index)
(defvar highlight-refontification-colors '("chartreuse1"
"tan1"
"PaleTurquoise2"
"gold1"
"grey85"
"OliveDrab2"
"Yellow")
"List of colors `highlight-refontification-mode' cycles through.")
(defun highlight-refontification-matcher (limit)
"Font-lock matcher for `highlight-refontification-mode'.
As a side effect, this colors the background between point and
LIMIT in a rainbow of colors, one color each time font-lock
refontifies a region."
(remove-overlays (point) limit 'highlight-refontification t)
(let ((o (make-overlay (point) limit (current-buffer)))
(color (highlight-refontification-next-color)))
;; Exclude colors of neighbouring regions.
(while (member color (list
(highlight-refontification-color-at (- (point) 1))
(highlight-refontification-color-at (+ limit 1))))
(setq color (highlight-refontification-next-color)))
(overlay-put o 'highlight-refontification t)
(overlay-put o
'face
(list :background color)))
;; Always "fail" to find anything.
nil)
(defun highlight-refontification-next-color ()
"The next color to be used to highlight the background."
(prog1
(nth highlight-refontification-index
highlight-refontification-colors)
(setq highlight-refontification-index
(mod (+ 1 highlight-refontification-index)
(length highlight-refontification-colors)))))
(defun highlight-refontification-color-at (pos)
"The previous background color at POS, or nil."
(let ((res nil))
(dolist (o (overlays-at pos))
(when (overlay-get o 'highlight-refontification)
(setq res (nth 1 (overlay-get o 'face)))))
res))
;;;###autoload
(define-minor-mode highlight-refontification-mode
"Minor mode that highlight bad whitespace and out-of-place characters."
nil
nil
nil
:group 'highlight-refontification
(if highlight-refontification-mode
(highlight-refontification-font-lock-add-keywords)
(highlight-refontification-font-lock-remove-keywords))
(when font-lock-mode
;; As of Emacs 25, `font-lock-fontify-buffer' is not legal to
;; call, instead `font-lock-flush' should be used.
(if (fboundp 'font-lock-flush)
(font-lock-flush)
(when font-lock-mode
(with-no-warnings
(font-lock-fontify-buffer))))))
(defun highlight-refontification-font-lock-add-keywords ()
"Install Highlight Refontification mode keywords into current buffer."
(setq highlight-refontification-index 0)
(font-lock-add-keywords nil highlight-refontification-keywords t))
(defun highlight-refontification-font-lock-remove-keywords ()
"Remove Highlight Refontification mode keywords in current buffer."
(font-lock-remove-keywords nil highlight-refontification-keywords)
(remove-overlays (point-min) (point-max) 'highlight-refontification t))
;; ------------------------------------------------------------
;; List extend region operations.
;;
(defun highlight-refontification-list-extend-region-steps (&optional
beg end)
"List how font-lock would extend the region between BEG and END.
BEG and END is the start and end of the area. When nil or
omitted, the current line is used.
When called interactively, the region is used if visible and the
current line otherwise."
(interactive (if (use-region-p)
(list (region-beginning)
(region-end))
(list nil nil)))
(unless beg
(setq beg (line-beginning-position)))
(unless end
(setq end (+ (line-end-position) 1)))
(with-output-to-temp-buffer "*ExtendRegion*"
(let ((funs font-lock-extend-region-functions)
(font-lock-beg beg)
(font-lock-end end))
(princ (format "Initial: (beg=%d end=%d)\n"
font-lock-beg
font-lock-end))
(while funs
(princ (format "Calling `%s' (beg=%d end=%d)\n"
(car funs)
font-lock-beg
font-lock-end))
(let ((res (funcall (car funs))))
(when res
(princ (format " Changed region to (beg=%d end=%d)\n"
font-lock-beg
font-lock-end)))
(setq funs (if (or (not res)
(eq funs font-lock-extend-region-functions))
(cdr funs)
;; If there's been a change, we should go through
;; the list again since this new position may
;; warrant a different answer from one of the fun
;; we've already seen.
font-lock-extend-region-functions))))
(princ (format "Final: (beg=%d end=%d)\n"
font-lock-beg
font-lock-end)))))
;; -------------------------------------------------------------------
;; The end
;;
(provide 'highlight-refontification)
;;; highlight-refontification.el ends here