Mercurial > emacs
comparison lisp/emacs-lisp/syntax.el @ 39756:cc0f91bb368d
New file.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 11 Oct 2001 00:50:53 +0000 |
parents | |
children | 9cc5a8486ab5 |
comparison
equal
deleted
inserted
replaced
39755:e3a3d7614391 | 39756:cc0f91bb368d |
---|---|
1 ;;; syntax.el --- Helper functions to find syntactic context | |
2 | |
3 ;; Copyright (C) 2000 Free Software Foundation, Inc. | |
4 | |
5 ;; This file is part of GNU Emacs. | |
6 | |
7 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
8 ;; it under the terms of the GNU General Public License as published by | |
9 ;; the Free Software Foundation; either version 2, or (at your option) | |
10 ;; any later version. | |
11 | |
12 ;; GNU Emacs is distributed in the hope that it will be useful, | |
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 ;; GNU General Public License for more details. | |
16 | |
17 ;; You should have received a copy of the GNU General Public License | |
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
20 ;; Boston, MA 02111-1307, USA. | |
21 | |
22 ;;; Commentary: | |
23 | |
24 ;; The main exported function is `syntax-ppss'. You might also need | |
25 ;; to call `syntax-ppss-after-change-function' or to add it to | |
26 ;; after-change-functions'(although this is automatically done by | |
27 ;; syntax-ppss when needed, but that might fail if syntax-ppss is | |
28 ;; called in a context where after-change-functions is temporarily | |
29 ;; let-bound to nil). | |
30 | |
31 ;;; Todo: | |
32 | |
33 ;; - do something about the case where the syntax-table is changed. | |
34 ;; This typically happens with tex-mode and its `$' operator. | |
35 ;; - move font-lock-syntactic-keywords in here. Then again, maybe not. | |
36 ;; - new functions `syntax-state', ... to replace uses of parse-partial-state | |
37 ;; with something higher-level (similar to syntax-ppss-context). | |
38 ;; - interaction with mmm-mode. | |
39 ;; - what to do when the buffer is narrowed ? | |
40 | |
41 ;;; Code: | |
42 | |
43 ;; Note: PPSS stands for `parse-partial-sexp state' | |
44 | |
45 (eval-when-compile (require 'cl)) | |
46 | |
47 (defsubst syntax-ppss-depth (ppss) | |
48 (nth 0 ppss)) | |
49 | |
50 (defsubst syntax-ppss-context (ppss) | |
51 (cond | |
52 ((nth 3 ppss) 'string) | |
53 ((nth 4 ppss) 'comment) | |
54 (t nil))) | |
55 | |
56 (defvar syntax-ppss-max-span 20000 | |
57 "Threshold below which cache info is deemed unnecessary. | |
58 We try to make sure that cache entries are at least this far apart | |
59 from each other, to avoid keeping too much useless info.") | |
60 | |
61 (defvar syntax-begin-function nil | |
62 "Function to move back outside of any comment/string/paren. | |
63 This function should move the cursor back to some syntactically safe | |
64 point (where the PPSS is equivalent to nil).") | |
65 | |
66 (defvar syntax-ppss-cache nil | |
67 "List of (POS . PPSS) pairs, in decreasing POS order.") | |
68 (make-variable-buffer-local 'syntax-ppss-cache) | |
69 (defvar syntax-ppss-last nil | |
70 "Cache of (LAST-POS . LAST-PPSS).") | |
71 (make-variable-buffer-local 'syntax-ppss-last) | |
72 | |
73 (defun syntax-ppss-after-change-function (beg &rest ignored) | |
74 ;; Flush invalid cache entries. | |
75 (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg)) | |
76 (setq syntax-ppss-cache (cdr syntax-ppss-cache))) | |
77 ;; Throw away `last' value if made invalid. | |
78 (when (< beg (or (car syntax-ppss-last) 0)) | |
79 (if (< beg (or (car (nth 10 syntax-ppss-last)) | |
80 (nth 9 syntax-ppss-last) | |
81 (nth 2 syntax-ppss-last) | |
82 0)) | |
83 (setq syntax-ppss-last nil) | |
84 (setcar syntax-ppss-last nil))) | |
85 ;; Unregister if there's no cache left. Sadly this doesn't work | |
86 ;; because `after-change-functions' is temporarily bound to nil here. | |
87 ;; (unless syntax-ppss-cache | |
88 ;; (remove-hook 'after-change-functions | |
89 ;; 'syntax-ppss-after-change-function t)) | |
90 ) | |
91 | |
92 (defvar syntax-ppss-stats | |
93 [(0 . 0.0) (0 . 0.0) (0 . 0.0) (0 . 0.0) (0 . 0.0) (1 . 2500.0)]) | |
94 (defun syntax-ppss-stats () | |
95 (mapcar (lambda (x) (cons (car x) (truncate (/ (cdr x) (car x))))) | |
96 syntax-ppss-stats)) | |
97 | |
98 (defun syntax-ppss (&optional pos) | |
99 "Parse-Partial-Sexp State at POS. | |
100 The returned value is the same as `parse-partial-sexp' except that | |
101 the 2nd and 6th values of the returned state cannot be relied upon. | |
102 | |
103 If the caller knows the PPSS of a nearby position, she can pass it | |
104 in OLP-PPSS (with or without its corresponding OLD-POS) to try and | |
105 avoid a more expansive scan. | |
106 Point is at POS when this function returns." | |
107 ;; Default values. | |
108 (unless pos (setq pos (point))) | |
109 ;; | |
110 (let ((old-ppss (cdr syntax-ppss-last)) | |
111 (old-pos (car syntax-ppss-last)) | |
112 (ppss nil) | |
113 (pt-min (point-min))) | |
114 (if (and old-pos (> old-pos pos)) (setq old-pos nil)) | |
115 ;; Use the OLD-POS if usable and close. Don't update the `last' cache. | |
116 (if (and old-pos (< (- pos old-pos) | |
117 ;; The time to find PPSS using syntax-begin-function | |
118 ;; is assumed to be about 2 * distance. | |
119 (* 2 (/ (cdr (aref syntax-ppss-stats 5)) | |
120 (1+ (car (aref syntax-ppss-stats 5))))))) | |
121 (progn | |
122 (incf (car (aref syntax-ppss-stats 0))) | |
123 (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos)) | |
124 (parse-partial-sexp old-pos pos nil nil old-ppss)) | |
125 | |
126 (cond | |
127 ;; Use OLD-PPSS if possible and close enough. | |
128 ((and (not old-pos) old-ppss | |
129 ;; BEWARE! We rely on the undocumented 9th field. | |
130 ;; The 9th field currently contains the list of positions | |
131 ;; of open-parens of the enclosing parens. I.e. those positions | |
132 ;; are outside of any string/comment and the first of those is | |
133 ;; outside of any paren (i.e. corresponds to a nil ppss). | |
134 ;; If this list is empty but we are in a string or comment, | |
135 ;; then the 8th field contains a similar "toplevel" position. | |
136 ;; If `pt-min' is too far from `pos', we could try to use | |
137 ;; other positions in (nth 9 old-ppss), but that doesn't seem | |
138 ;; to happen in practice and it would complicate this code | |
139 ;; (and the after-change-function code even more). But maybe it | |
140 ;; would be useful in "degenerate" cases such as when the whole | |
141 ;; file is wrapped in a set of parenthesis. | |
142 (setq pt-min (or (car (nth 9 old-ppss)) | |
143 (nth 8 old-ppss) | |
144 (nth 2 old-ppss))) | |
145 (<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span)) | |
146 (incf (car (aref syntax-ppss-stats 1))) | |
147 (incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min)) | |
148 (setq ppss (parse-partial-sexp pt-min pos))) | |
149 ;; The OLD-* data can't be used. Consult the cache. | |
150 (t | |
151 (let ((cache-pred nil) | |
152 (cache syntax-ppss-cache) | |
153 (pt-min (point-min)) | |
154 ;; I differentiate between PT-MIN and PT-BEST because I feel | |
155 ;; like it might be important to ensure that the cache is only | |
156 ;; filled with 100% sure data (whereas syntax-begin-function | |
157 ;; might return incorrect data). Maybe that's just stupid. | |
158 (pt-best (point-min)) | |
159 (ppss-best nil)) | |
160 ;; look for a usable cache entry. | |
161 (while (and cache (< pos (caar cache))) | |
162 (setq cache-pred cache) | |
163 (setq cache (cdr cache))) | |
164 (if cache (setq pt-min (caar cache) ppss (cdar cache))) | |
165 | |
166 ;; Setup the after-change function if necessary. | |
167 (unless (or syntax-ppss-cache syntax-ppss-last) | |
168 (add-hook 'after-change-functions | |
169 'syntax-ppss-after-change-function nil t)) | |
170 | |
171 ;; Use the best of OLD-POS and CACHE. | |
172 (if (or (not old-pos) (< old-pos pt-min)) | |
173 (setq pt-best pt-min ppss-best ppss) | |
174 (incf (car (aref syntax-ppss-stats 4))) | |
175 (incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos)) | |
176 (setq pt-best old-pos ppss-best old-ppss)) | |
177 | |
178 ;; Use the `syntax-begin-function' if available. | |
179 ;; We could try using that function earlier, but: | |
180 ;; - The result might not be 100% reliable, so it's better to use | |
181 ;; the cache if available. | |
182 ;; - The function might be slow. | |
183 ;; - If this function almost always finds a safe nearby spot, | |
184 ;; the cache won't be populated, so consulting it is cheap. | |
185 (unless (or syntax-begin-function | |
186 (not (boundp 'font-lock-beginning-of-syntax-function)) | |
187 (not font-lock-beginning-of-syntax-function)) | |
188 (set (make-local-variable 'syntax-begin-function) | |
189 font-lock-beginning-of-syntax-function)) | |
190 (when (and syntax-begin-function | |
191 (progn (goto-char pos) | |
192 (funcall syntax-begin-function) | |
193 ;; Make sure it's better. | |
194 (> (point) pt-best)) | |
195 ;; Simple sanity check. | |
196 (not (memq (get-text-property (point) 'face) | |
197 '(font-lock-string-face font-lock-comment-face | |
198 font-lock-doc-face)))) | |
199 (incf (car (aref syntax-ppss-stats 5))) | |
200 (incf (cdr (aref syntax-ppss-stats 5)) (- pos (point))) | |
201 (setq pt-best (point) ppss-best nil)) | |
202 | |
203 (cond | |
204 ;; Quick case when we found a nearby pos. | |
205 ((< (- pos pt-best) syntax-ppss-max-span) | |
206 (incf (car (aref syntax-ppss-stats 2))) | |
207 (incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best)) | |
208 (setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best))) | |
209 ;; Slow case: compute the state from some known position and | |
210 ;; populate the cache so we won't need to do it again soon. | |
211 (t | |
212 (incf (car (aref syntax-ppss-stats 3))) | |
213 (incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min)) | |
214 | |
215 ;; If `pt-min' is too far, add a few intermediate entries. | |
216 (while (> (- pos pt-min) (* 2 syntax-ppss-max-span)) | |
217 (setq ppss (parse-partial-sexp | |
218 pt-min (setq pt-min (/ (+ pt-min pos) 2)) | |
219 nil nil ppss)) | |
220 (let ((pair (cons pt-min ppss))) | |
221 (if cache-pred | |
222 (push pair (cdr cache-pred)) | |
223 (push pair syntax-ppss-cache)))) | |
224 | |
225 ;; Compute the actual return value. | |
226 (setq ppss (parse-partial-sexp pt-min pos nil nil ppss)) | |
227 | |
228 ;; Debugging check. | |
229 ;; (let ((real-ppss (parse-partial-sexp (point-min) pos))) | |
230 ;; (setcar (last ppss 4) 0) | |
231 ;; (setcar (last real-ppss 4) 0) | |
232 ;; (setcar (last ppss 8) nil) | |
233 ;; (setcar (last real-ppss 8) nil) | |
234 ;; (unless (equal ppss real-ppss) | |
235 ;; (message "!!Syntax: %s != %s" ppss real-ppss) | |
236 ;; (setq ppss real-ppss))) | |
237 | |
238 ;; Store it in the cache. | |
239 (let ((pair (cons pos ppss))) | |
240 (if cache-pred | |
241 (if (> (- (caar cache-pred) pos) syntax-ppss-max-span) | |
242 (push pair (cdr cache-pred)) | |
243 (setcar cache-pred pair)) | |
244 (if (or (null syntax-ppss-cache) | |
245 (> (- (caar syntax-ppss-cache) pos) | |
246 syntax-ppss-max-span)) | |
247 (push pair syntax-ppss-cache) | |
248 (setcar syntax-ppss-cache pair))))))))) | |
249 | |
250 (setq syntax-ppss-last (cons pos ppss)) | |
251 ppss))) | |
252 | |
253 ;; Debugging functions | |
254 | |
255 (defun syntax-ppss-debug () | |
256 (let ((pt nil) | |
257 (min-diffs nil)) | |
258 (dolist (x (append syntax-ppss-cache (list (cons (point-min) nil)))) | |
259 (when pt (push (- pt (car x)) min-diffs)) | |
260 (setq pt (car x))) | |
261 min-diffs)) | |
262 | |
263 ;; XEmacs compatibility functions | |
264 | |
265 ;; (defun buffer-syntactic-context (&optional buffer) | |
266 ;; "Syntactic context at point in BUFFER. | |
267 ;; Either of `string', `comment' or `nil'. | |
268 ;; This is an XEmacs compatibility function." | |
269 ;; (with-current-buffer (or buffer (current-buffer)) | |
270 ;; (syntax-ppss-context (syntax-ppss)))) | |
271 | |
272 ;; (defun buffer-syntactic-context-depth (&optional buffer) | |
273 ;; "Syntactic parenthesis depth at point in BUFFER. | |
274 ;; This is an XEmacs compatibility function." | |
275 ;; (with-current-buffer (or buffer (current-buffer)) | |
276 ;; (syntax-ppss-depth (syntax-ppss)))) | |
277 | |
278 (elp-instrument-list '(syntax-ppss)) | |
279 | |
280 (provide 'syntax) | |
281 ;;; syntax.el ends here |