39 |
;; - new functions `syntax-state', ... to replace uses of parse-partial-state |
;; - new functions `syntax-state', ... to replace uses of parse-partial-state |
40 |
;; with something higher-level (similar to syntax-ppss-context). |
;; with something higher-level (similar to syntax-ppss-context). |
41 |
;; - interaction with mmm-mode. |
;; - interaction with mmm-mode. |
|
;; - what to do when the buffer is narrowed ? |
|
42 |
|
|
43 |
;;; Code: |
;;; Code: |
44 |
|
|
117 |
(pt-min (point-min))) |
(pt-min (point-min))) |
118 |
(if (and old-pos (> old-pos pos)) (setq old-pos nil)) |
(if (and old-pos (> old-pos pos)) (setq old-pos nil)) |
119 |
;; Use the OLD-POS if usable and close. Don't update the `last' cache. |
;; Use the OLD-POS if usable and close. Don't update the `last' cache. |
120 |
(if (and old-pos (< (- pos old-pos) |
(condition-case nil |
121 |
;; The time to find PPSS using syntax-begin-function |
(if (and old-pos (< (- pos old-pos) |
122 |
;; is assumed to be about 2 * distance. |
;; The time to use syntax-begin-function and |
123 |
(* 2 (/ (cdr (aref syntax-ppss-stats 5)) |
;; find PPSS is assumed to be about 2 * distance. |
124 |
(1+ (car (aref syntax-ppss-stats 5))))))) |
(* 2 (/ (cdr (aref syntax-ppss-stats 5)) |
125 |
(progn |
(1+ (car (aref syntax-ppss-stats 5))))))) |
126 |
(incf (car (aref syntax-ppss-stats 0))) |
(progn |
127 |
(incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos)) |
(incf (car (aref syntax-ppss-stats 0))) |
128 |
(parse-partial-sexp old-pos pos nil nil old-ppss)) |
(incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos)) |
129 |
|
(parse-partial-sexp old-pos pos nil nil old-ppss)) |
|
(cond |
|
|
;; Use OLD-PPSS if possible and close enough. |
|
|
((and (not old-pos) old-ppss |
|
|
;; BEWARE! We rely on the undocumented 9th field. |
|
|
;; The 9th field currently contains the list of positions |
|
|
;; of open-parens of the enclosing parens. I.e. those positions |
|
|
;; are outside of any string/comment and the first of those is |
|
|
;; outside of any paren (i.e. corresponds to a nil ppss). |
|
|
;; If this list is empty but we are in a string or comment, |
|
|
;; then the 8th field contains a similar "toplevel" position. |
|
|
;; If `pt-min' is too far from `pos', we could try to use |
|
|
;; other positions in (nth 9 old-ppss), but that doesn't seem |
|
|
;; to happen in practice and it would complicate this code |
|
|
;; (and the after-change-function code even more). But maybe it |
|
|
;; would be useful in "degenerate" cases such as when the whole |
|
|
;; file is wrapped in a set of parenthesis. |
|
|
(setq pt-min (or (car (nth 9 old-ppss)) |
|
|
(nth 8 old-ppss) |
|
|
(nth 2 old-ppss))) |
|
|
(<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span)) |
|
|
(incf (car (aref syntax-ppss-stats 1))) |
|
|
(incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min)) |
|
|
(setq ppss (parse-partial-sexp pt-min pos))) |
|
|
;; The OLD-* data can't be used. Consult the cache. |
|
|
(t |
|
|
(let ((cache-pred nil) |
|
|
(cache syntax-ppss-cache) |
|
|
(pt-min (point-min)) |
|
|
;; I differentiate between PT-MIN and PT-BEST because I feel |
|
|
;; like it might be important to ensure that the cache is only |
|
|
;; filled with 100% sure data (whereas syntax-begin-function |
|
|
;; might return incorrect data). Maybe that's just stupid. |
|
|
(pt-best (point-min)) |
|
|
(ppss-best nil)) |
|
|
;; look for a usable cache entry. |
|
|
(while (and cache (< pos (caar cache))) |
|
|
(setq cache-pred cache) |
|
|
(setq cache (cdr cache))) |
|
|
(if cache (setq pt-min (caar cache) ppss (cdar cache))) |
|
|
|
|
|
;; Setup the after-change function if necessary. |
|
|
(unless (or syntax-ppss-cache syntax-ppss-last) |
|
|
(add-hook 'after-change-functions 'syntax-ppss-flush-cache nil t)) |
|
|
|
|
|
;; Use the best of OLD-POS and CACHE. |
|
|
(if (or (not old-pos) (< old-pos pt-min)) |
|
|
(setq pt-best pt-min ppss-best ppss) |
|
|
(incf (car (aref syntax-ppss-stats 4))) |
|
|
(incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos)) |
|
|
(setq pt-best old-pos ppss-best old-ppss)) |
|
|
|
|
|
;; Use the `syntax-begin-function' if available. |
|
|
;; We could try using that function earlier, but: |
|
|
;; - The result might not be 100% reliable, so it's better to use |
|
|
;; the cache if available. |
|
|
;; - The function might be slow. |
|
|
;; - If this function almost always finds a safe nearby spot, |
|
|
;; the cache won't be populated, so consulting it is cheap. |
|
|
(unless (or syntax-begin-function |
|
|
(not (boundp 'font-lock-beginning-of-syntax-function)) |
|
|
(not font-lock-beginning-of-syntax-function)) |
|
|
(set (make-local-variable 'syntax-begin-function) |
|
|
font-lock-beginning-of-syntax-function)) |
|
|
(when (and syntax-begin-function |
|
|
(progn (goto-char pos) |
|
|
(funcall syntax-begin-function) |
|
|
;; Make sure it's better. |
|
|
(> (point) pt-best)) |
|
|
;; Simple sanity check. |
|
|
(not (memq (get-text-property (point) 'face) |
|
|
'(font-lock-string-face font-lock-comment-face |
|
|
font-lock-doc-face)))) |
|
|
(incf (car (aref syntax-ppss-stats 5))) |
|
|
(incf (cdr (aref syntax-ppss-stats 5)) (- pos (point))) |
|
|
(setq pt-best (point) ppss-best nil)) |
|
130 |
|
|
131 |
(cond |
(cond |
132 |
;; Quick case when we found a nearby pos. |
;; Use OLD-PPSS if possible and close enough. |
133 |
((< (- pos pt-best) syntax-ppss-max-span) |
((and (not old-pos) old-ppss |
134 |
(incf (car (aref syntax-ppss-stats 2))) |
;; BEWARE! We rely on the undocumented 9th field. The 9th |
135 |
(incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best)) |
;; field currently contains the list of positions of |
136 |
(setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best))) |
;; open-parens of the enclosing parens. I.e. those |
137 |
;; Slow case: compute the state from some known position and |
;; positions are outside of any string/comment |
138 |
;; populate the cache so we won't need to do it again soon. |
;; and the first of those is outside of any paren |
139 |
|
;; (i.e. corresponds to a nil ppss). If this list is empty |
140 |
|
;; but we are in a string or comment, then the 8th field |
141 |
|
;; contains a similar "toplevel" position. If `pt-min' is |
142 |
|
;; too far from `pos', we could try to use other positions |
143 |
|
;; in (nth 9 old-ppss), but that doesn't seem to happen in |
144 |
|
;; practice and it would complicate this code (and the |
145 |
|
;; after-change-function code even more). But maybe it |
146 |
|
;; would be useful in "degenerate" cases such as when the |
147 |
|
;; whole file is wrapped in a set of parenthesis. |
148 |
|
(setq pt-min (or (car (nth 9 old-ppss)) |
149 |
|
(nth 8 old-ppss) |
150 |
|
(nth 2 old-ppss))) |
151 |
|
(<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span)) |
152 |
|
(incf (car (aref syntax-ppss-stats 1))) |
153 |
|
(incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min)) |
154 |
|
(setq ppss (parse-partial-sexp pt-min pos))) |
155 |
|
;; The OLD-* data can't be used. Consult the cache. |
156 |
(t |
(t |
157 |
(incf (car (aref syntax-ppss-stats 3))) |
(let ((cache-pred nil) |
158 |
(incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min)) |
(cache syntax-ppss-cache) |
159 |
|
(pt-min (point-min)) |
160 |
;; If `pt-min' is too far, add a few intermediate entries. |
;; I differentiate between PT-MIN and PT-BEST because |
161 |
(while (> (- pos pt-min) (* 2 syntax-ppss-max-span)) |
;; I feel like it might be important to ensure that the |
162 |
(setq ppss (parse-partial-sexp |
;; cache is only filled with 100% sure data (whereas |
163 |
pt-min (setq pt-min (/ (+ pt-min pos) 2)) |
;; syntax-begin-function might return incorrect data). |
164 |
nil nil ppss)) |
;; Maybe that's just stupid. |
165 |
(let ((pair (cons pt-min ppss))) |
(pt-best (point-min)) |
166 |
(if cache-pred |
(ppss-best nil)) |
167 |
(push pair (cdr cache-pred)) |
;; look for a usable cache entry. |
168 |
(push pair syntax-ppss-cache)))) |
(while (and cache (< pos (caar cache))) |
169 |
|
(setq cache-pred cache) |
170 |
;; Compute the actual return value. |
(setq cache (cdr cache))) |
171 |
(setq ppss (parse-partial-sexp pt-min pos nil nil ppss)) |
(if cache (setq pt-min (caar cache) ppss (cdar cache))) |
172 |
|
|
173 |
;; Debugging check. |
;; Setup the after-change function if necessary. |
174 |
;; (let ((real-ppss (parse-partial-sexp (point-min) pos))) |
(unless (or syntax-ppss-cache syntax-ppss-last) |
175 |
;; (setcar (last ppss 4) 0) |
(add-hook 'after-change-functions |
176 |
;; (setcar (last real-ppss 4) 0) |
'syntax-ppss-flush-cache nil t)) |
177 |
;; (setcar (last ppss 8) nil) |
|
178 |
;; (setcar (last real-ppss 8) nil) |
;; Use the best of OLD-POS and CACHE. |
179 |
;; (unless (equal ppss real-ppss) |
(if (or (not old-pos) (< old-pos pt-min)) |
180 |
;; (message "!!Syntax: %s != %s" ppss real-ppss) |
(setq pt-best pt-min ppss-best ppss) |
181 |
;; (setq ppss real-ppss))) |
(incf (car (aref syntax-ppss-stats 4))) |
182 |
|
(incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos)) |
183 |
;; Store it in the cache. |
(setq pt-best old-pos ppss-best old-ppss)) |
184 |
(let ((pair (cons pos ppss))) |
|
185 |
(if cache-pred |
;; Use the `syntax-begin-function' if available. |
186 |
(if (> (- (caar cache-pred) pos) syntax-ppss-max-span) |
;; We could try using that function earlier, but: |
187 |
(push pair (cdr cache-pred)) |
;; - The result might not be 100% reliable, so it's better to use |
188 |
(setcar cache-pred pair)) |
;; the cache if available. |
189 |
(if (or (null syntax-ppss-cache) |
;; - The function might be slow. |
190 |
(> (- (caar syntax-ppss-cache) pos) |
;; - If this function almost always finds a safe nearby spot, |
191 |
syntax-ppss-max-span)) |
;; the cache won't be populated, so consulting it is cheap. |
192 |
(push pair syntax-ppss-cache) |
(when (and (not syntax-begin-function) |
193 |
(setcar syntax-ppss-cache pair))))))))) |
(boundp 'font-lock-beginning-of-syntax-function) |
194 |
|
font-lock-beginning-of-syntax-function) |
195 |
(setq syntax-ppss-last (cons pos ppss)) |
(set (make-local-variable 'syntax-begin-function) |
196 |
ppss))) |
font-lock-beginning-of-syntax-function)) |
197 |
|
(when (and syntax-begin-function |
198 |
|
(progn (goto-char pos) |
199 |
|
(funcall syntax-begin-function) |
200 |
|
;; Make sure it's better. |
201 |
|
(> (point) pt-best)) |
202 |
|
;; Simple sanity check. |
203 |
|
(not (memq (get-text-property (point) 'face) |
204 |
|
'(font-lock-string-face font-lock-doc-face |
205 |
|
font-lock-comment-face)))) |
206 |
|
(incf (car (aref syntax-ppss-stats 5))) |
207 |
|
(incf (cdr (aref syntax-ppss-stats 5)) (- pos (point))) |
208 |
|
(setq pt-best (point) ppss-best nil)) |
209 |
|
|
210 |
|
(cond |
211 |
|
;; Quick case when we found a nearby pos. |
212 |
|
((< (- pos pt-best) syntax-ppss-max-span) |
213 |
|
(incf (car (aref syntax-ppss-stats 2))) |
214 |
|
(incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best)) |
215 |
|
(setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best))) |
216 |
|
;; Slow case: compute the state from some known position and |
217 |
|
;; populate the cache so we won't need to do it again soon. |
218 |
|
(t |
219 |
|
(incf (car (aref syntax-ppss-stats 3))) |
220 |
|
(incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min)) |
221 |
|
|
222 |
|
;; If `pt-min' is too far, add a few intermediate entries. |
223 |
|
(while (> (- pos pt-min) (* 2 syntax-ppss-max-span)) |
224 |
|
(setq ppss (parse-partial-sexp |
225 |
|
pt-min (setq pt-min (/ (+ pt-min pos) 2)) |
226 |
|
nil nil ppss)) |
227 |
|
(let ((pair (cons pt-min ppss))) |
228 |
|
(if cache-pred |
229 |
|
(push pair (cdr cache-pred)) |
230 |
|
(push pair syntax-ppss-cache)))) |
231 |
|
|
232 |
|
;; Compute the actual return value. |
233 |
|
(setq ppss (parse-partial-sexp pt-min pos nil nil ppss)) |
234 |
|
|
235 |
|
;; Debugging check. |
236 |
|
;; (let ((real-ppss (parse-partial-sexp (point-min) pos))) |
237 |
|
;; (setcar (last ppss 4) 0) |
238 |
|
;; (setcar (last real-ppss 4) 0) |
239 |
|
;; (setcar (last ppss 8) nil) |
240 |
|
;; (setcar (last real-ppss 8) nil) |
241 |
|
;; (unless (equal ppss real-ppss) |
242 |
|
;; (message "!!Syntax: %s != %s" ppss real-ppss) |
243 |
|
;; (setq ppss real-ppss))) |
244 |
|
|
245 |
|
;; Store it in the cache. |
246 |
|
(let ((pair (cons pos ppss))) |
247 |
|
(if cache-pred |
248 |
|
(if (> (- (caar cache-pred) pos) syntax-ppss-max-span) |
249 |
|
(push pair (cdr cache-pred)) |
250 |
|
(setcar cache-pred pair)) |
251 |
|
(if (or (null syntax-ppss-cache) |
252 |
|
(> (- (caar syntax-ppss-cache) pos) |
253 |
|
syntax-ppss-max-span)) |
254 |
|
(push pair syntax-ppss-cache) |
255 |
|
(setcar syntax-ppss-cache pair))))))))) |
256 |
|
|
257 |
|
(setq syntax-ppss-last (cons pos ppss)) |
258 |
|
ppss) |
259 |
|
(args-out-of-range |
260 |
|
;; If the buffer is more narrowed than when we built the cache, |
261 |
|
;; we may end up calling parse-partial-sexp with a position before |
262 |
|
;; point-min. In that case, just parse from point-min assuming |
263 |
|
;; a nil state. |
264 |
|
(parse-partial-sexp (point-min) pos))))) |
265 |
|
|
266 |
;; Debugging functions |
;; Debugging functions |
267 |
|
|