Commit | Line | Data |
---|---|---|
978c25c6 | 1 | ;;; semantic/edit.el --- Edit Management for Semantic |
9573e58b | 2 | |
ab422c4d | 3 | ;; Copyright (C) 1999-2013 Free Software Foundation, Inc. |
9573e58b CY |
4 | |
5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; In Semantic 1.x, changes were handled in a simplistic manner, where | |
25 | ;; tags that changed were reparsed one at a time. Any other form of | |
26 | ;; edit were managed through a full reparse. | |
27 | ;; | |
28 | ;; This code attempts to minimize the number of times a full reparse | |
29 | ;; needs to occur. While overlays and tags will continue to be | |
30 | ;; recycled in the simple case, new cases where tags are inserted | |
31 | ;; or old tags removed from the original list are handled. | |
32 | ;; | |
33 | ||
34 | ;;; NOTES FOR IMPROVEMENT | |
35 | ;; | |
36 | ;; Work done by the incremental parser could be improved by the | |
37 | ;; following: | |
38 | ;; | |
39 | ;; 1. Tags created could have as a property an overlay marking a region | |
40 | ;; of themselves that can be edited w/out affecting the definition of | |
41 | ;; that tag. | |
42 | ;; | |
43 | ;; 2. Tags w/ positioned children could have a property of an | |
44 | ;; overlay marking the region in themselves that contain the | |
45 | ;; children. This could be used to better improve splicing near | |
46 | ;; the beginning and end of the child lists. | |
47 | ;; | |
48 | ||
49 | ;;; BUGS IN INCREMENTAL PARSER | |
50 | ;; | |
51 | ;; 1. Changes in the whitespace between tags could extend a | |
52 | ;; following tag. These will be marked as merely unmatched | |
53 | ;; syntax instead. | |
54 | ;; | |
55 | ;; 2. Incremental parsing while a new function is being typed in | |
9bf6c65c | 56 | ;; sometimes gets a chance only when lists are incomplete, |
9573e58b CY |
57 | ;; preventing correct context identification. |
58 | ||
59 | ;; | |
60 | (require 'semantic) | |
9573e58b CY |
61 | |
62 | ;;; Code: | |
63 | (defvar semantic-after-partial-cache-change-hook nil | |
29e1a603 | 64 | "Normal hook run after the buffer cache has been updated. |
9573e58b CY |
65 | |
66 | This hook will run when the cache has been partially reparsed. | |
67 | Partial reparses are incurred when a user edits a buffer, and only the | |
68 | modified sections are rescanned. | |
69 | ||
70 | Hook functions must take one argument, which is the list of tags | |
71 | updated in the current buffer. | |
72 | ||
73 | For language specific hooks, make sure you define this as a local hook.") | |
74 | ||
d1069532 SM |
75 | (define-obsolete-variable-alias 'semantic-change-hooks |
76 | 'semantic-change-functions "24.3") | |
77 | (defvar semantic-change-functions | |
8bf997ef | 78 | '(semantic-edits-change-function-handle-changes) |
29e1a603 | 79 | "Abnormal hook run when semantic detects a change in a buffer. |
9573e58b CY |
80 | Each hook function must take three arguments, identical to the |
81 | common hook `after-change-functions'.") | |
82 | ||
83 | (defvar semantic-reparse-needed-change-hook nil | |
84 | "Hooks run when a user edit is detected as needing a reparse. | |
d1f18ec0 JB |
85 | For language specific hooks, make sure you define this as a local hook. |
86 | Not used yet; part of the next generation reparse mechanism.") | |
9573e58b CY |
87 | |
88 | (defvar semantic-no-reparse-needed-change-hook nil | |
89 | "Hooks run when a user edit is detected as not needing a reparse. | |
90 | If the hook returns non-nil, then declare that a reparse is needed. | |
d1f18ec0 | 91 | For language specific hooks, make sure you define this as a local hook. |
9573e58b CY |
92 | Not used yet; part of the next generation reparse mechanism.") |
93 | ||
d1069532 SM |
94 | (define-obsolete-variable-alias 'semantic-edits-new-change-hooks |
95 | 'semantic-edits-new-change-functions "24.3") | |
96 | (defvar semantic-edits-new-change-functions nil | |
29e1a603 | 97 | "Abnormal hook run when a new change is found. |
9573e58b CY |
98 | Functions must take one argument representing an overlay on that change.") |
99 | ||
d1069532 SM |
100 | (define-obsolete-variable-alias 'semantic-edits-delete-change-hooks |
101 | 'semantic-edits-delete-change-functions "24.3") | |
102 | (defvar semantic-edits-delete-change-functions nil | |
29e1a603 | 103 | "Abnormal hook run before a change overlay is deleted. |
9573e58b CY |
104 | Deleted changes occur when multiple changes are merged. |
105 | Functions must take one argument representing an overlay being deleted.") | |
106 | ||
29e1a603 CY |
107 | (defvar semantic-edits-move-change-hook nil |
108 | "Abnormal hook run after a change overlay is moved. | |
9573e58b CY |
109 | Changes move when a new change overlaps an old change. The old change |
110 | will be moved. | |
111 | Functions must take one argument representing an overlay being moved.") | |
112 | ||
d1069532 SM |
113 | (define-obsolete-variable-alias 'semantic-edits-reparse-change-hooks |
114 | 'semantic-edits-reparse-change-functions "24.3") | |
115 | (defvar semantic-edits-reparse-change-functions nil | |
29e1a603 | 116 | "Abnormal hook run after a change results in a reparse. |
9573e58b CY |
117 | Functions are called before the overlay is deleted, and after the |
118 | incremental reparse.") | |
119 | ||
b733e9bc CY |
120 | (defvar semantic-edits-incremental-reparse-failed-hook nil |
121 | "Hook run after the incremental parser fails. | |
9bf6c65c | 122 | When this happens, the buffer is marked as needing a full reparse.") |
9573e58b | 123 | |
b733e9bc | 124 | (semantic-varalias-obsolete 'semantic-edits-incremental-reparse-failed-hooks |
eefa91db | 125 | 'semantic-edits-incremental-reparse-failed-hook "23.2") |
b733e9bc | 126 | |
9573e58b | 127 | (defcustom semantic-edits-verbose-flag nil |
9bf6c65c | 128 | "Non-nil means the incremental parser is verbose. |
9573e58b CY |
129 | If nil, errors are still displayed, but informative messages are not." |
130 | :group 'semantic | |
131 | :type 'boolean) | |
132 | ||
133 | ;;; Change State management | |
134 | ;; | |
135 | ;; Manage a series of overlays that define changes recently | |
136 | ;; made to the current buffer. | |
4b674896 | 137 | ;;;###autoload |
9573e58b CY |
138 | (defun semantic-change-function (start end length) |
139 | "Provide a mechanism for semantic tag management. | |
140 | Argument START, END, and LENGTH specify the bounds of the change." | |
141 | (setq semantic-unmatched-syntax-cache-check t) | |
142 | (let ((inhibit-point-motion-hooks t) | |
143 | ) | |
d1069532 | 144 | (run-hook-with-args 'semantic-change-functions start end length) |
9573e58b CY |
145 | )) |
146 | ||
147 | (defun semantic-changes-in-region (start end &optional buffer) | |
148 | "Find change overlays which exist in whole or in part between START and END. | |
149 | Optional argument BUFFER is the buffer to search for changes in." | |
150 | (save-excursion | |
151 | (if buffer (set-buffer buffer)) | |
152 | (let ((ol (semantic-overlays-in (max start (point-min)) | |
153 | (min end (point-max)))) | |
154 | (ret nil)) | |
155 | (while ol | |
156 | (when (semantic-overlay-get (car ol) 'semantic-change) | |
157 | (setq ret (cons (car ol) ret))) | |
158 | (setq ol (cdr ol))) | |
159 | (sort ret #'(lambda (a b) (< (semantic-overlay-start a) | |
160 | (semantic-overlay-start b))))))) | |
161 | ||
162 | (defun semantic-edits-change-function-handle-changes (start end length) | |
163 | "Run whenever a buffer controlled by `semantic-mode' change. | |
164 | Tracks when and how the buffer is re-parsed. | |
165 | Argument START, END, and LENGTH specify the bounds of the change." | |
166 | ;; We move start/end by one so that we can merge changes that occur | |
167 | ;; just before, or just after. This lets simple typing capture everything | |
168 | ;; into one overlay. | |
169 | (let ((changes-in-change (semantic-changes-in-region (1- start) (1+ end))) | |
170 | ) | |
171 | (semantic-parse-tree-set-needs-update) | |
172 | (if (not changes-in-change) | |
173 | (let ((o (semantic-make-overlay start end))) | |
174 | (semantic-overlay-put o 'semantic-change t) | |
175 | ;; Run the hooks safely. When hooks blow it, our dirty | |
176 | ;; function will be removed from the list of active change | |
177 | ;; functions. | |
178 | (condition-case nil | |
d1069532 | 179 | (run-hook-with-args 'semantic-edits-new-change-functions o) |
9573e58b CY |
180 | (error nil))) |
181 | (let ((tmp changes-in-change)) | |
182 | ;; Find greatest bounds of all changes | |
183 | (while tmp | |
184 | (when (< (semantic-overlay-start (car tmp)) start) | |
185 | (setq start (semantic-overlay-start (car tmp)))) | |
186 | (when (> (semantic-overlay-end (car tmp)) end) | |
187 | (setq end (semantic-overlay-end (car tmp)))) | |
188 | (setq tmp (cdr tmp))) | |
189 | ;; Move the first found overlay, recycling that overlay. | |
190 | (semantic-overlay-move (car changes-in-change) start end) | |
191 | (condition-case nil | |
192 | (run-hook-with-args 'semantic-edits-move-change-hooks | |
193 | (car changes-in-change)) | |
194 | (error nil)) | |
195 | (setq changes-in-change (cdr changes-in-change)) | |
196 | ;; Delete other changes. They are now all bound here. | |
197 | (while changes-in-change | |
198 | (condition-case nil | |
d1069532 | 199 | (run-hook-with-args 'semantic-edits-delete-change-functions |
9573e58b CY |
200 | (car changes-in-change)) |
201 | (error nil)) | |
202 | (semantic-overlay-delete (car changes-in-change)) | |
203 | (setq changes-in-change (cdr changes-in-change)))) | |
204 | ))) | |
205 | ||
206 | (defsubst semantic-edits-flush-change (change) | |
207 | "Flush the CHANGE overlay." | |
208 | (condition-case nil | |
d1069532 | 209 | (run-hook-with-args 'semantic-edits-delete-change-functions |
9573e58b CY |
210 | change) |
211 | (error nil)) | |
212 | (semantic-overlay-delete change)) | |
213 | ||
214 | (defun semantic-edits-flush-changes () | |
215 | "Flush the changes in the current buffer." | |
216 | (let ((changes (semantic-changes-in-region (point-min) (point-max)))) | |
217 | (while changes | |
218 | (semantic-edits-flush-change (car changes)) | |
219 | (setq changes (cdr changes)))) | |
220 | ) | |
221 | ||
222 | (defun semantic-edits-change-in-one-tag-p (change hits) | |
223 | "Return non-nil of the overlay CHANGE exists solely in one leaf tag. | |
224 | HITS is the list of tags that CHANGE is in. It can have more than | |
225 | one tag in it if the leaf tag is within a parent tag." | |
226 | (and (< (semantic-tag-start (car hits)) | |
227 | (semantic-overlay-start change)) | |
228 | (> (semantic-tag-end (car hits)) | |
229 | (semantic-overlay-end change)) | |
230 | ;; Recurse on the rest. If this change is inside all | |
231 | ;; of these tags, then they are all leaves or parents | |
232 | ;; of the smallest tag. | |
233 | (or (not (cdr hits)) | |
234 | (semantic-edits-change-in-one-tag-p change (cdr hits)))) | |
235 | ) | |
236 | ||
237 | ;;; Change/Tag Query functions | |
238 | ;; | |
239 | ;; A change (region of space) can effect tags in different ways. | |
240 | ;; These functions perform queries on a buffer to determine different | |
241 | ;; ways that a change effects a buffer. | |
242 | ;; | |
243 | ;; NOTE: After debugging these, replace below to no longer look | |
244 | ;; at point and mark (via comments I assume.) | |
245 | (defsubst semantic-edits-os (change) | |
246 | "For testing: Start of CHANGE, or smaller of (point) and (mark)." | |
247 | (if change (semantic-overlay-start change) | |
248 | (if (< (point) (mark)) (point) (mark)))) | |
249 | ||
250 | (defsubst semantic-edits-oe (change) | |
251 | "For testing: End of CHANGE, or larger of (point) and (mark)." | |
252 | (if change (semantic-overlay-end change) | |
253 | (if (> (point) (mark)) (point) (mark)))) | |
254 | ||
255 | (defun semantic-edits-change-leaf-tag (change) | |
256 | "A leaf tag which completely encompasses CHANGE. | |
257 | If change overlaps a tag, but is not encompassed in it, return nil. | |
258 | Use `semantic-edits-change-overlap-leaf-tag'. | |
259 | If CHANGE is completely encompassed in a tag, but overlaps sub-tags, | |
260 | return nil." | |
261 | (let* ((start (semantic-edits-os change)) | |
262 | (end (semantic-edits-oe change)) | |
263 | (tags (nreverse | |
264 | (semantic-find-tag-by-overlay-in-region | |
265 | start end)))) | |
266 | ;; A leaf is always first in this list | |
267 | (if (and tags | |
268 | (<= (semantic-tag-start (car tags)) start) | |
269 | (> (semantic-tag-end (car tags)) end)) | |
270 | ;; Ok, we have a match. If this tag has children, | |
271 | ;; we have to do more tests. | |
272 | (let ((chil (semantic-tag-components (car tags)))) | |
273 | (if (not chil) | |
274 | ;; Simple leaf. | |
275 | (car tags) | |
276 | ;; For this type, we say that we encompass it if the | |
277 | ;; change occurs outside the range of the children. | |
278 | (if (or (not (semantic-tag-with-position-p (car chil))) | |
279 | (> start (semantic-tag-end (nth (1- (length chil)) chil))) | |
280 | (< end (semantic-tag-start (car chil)))) | |
281 | ;; We have modifications to the definition of this parent | |
282 | ;; so we have to reparse the whole thing. | |
283 | (car tags) | |
284 | ;; We actually modified an area between some children. | |
285 | ;; This means we should return nil, as that case is | |
286 | ;; calculated by someone else. | |
287 | nil))) | |
288 | nil))) | |
289 | ||
290 | (defun semantic-edits-change-between-tags (change) | |
291 | "Return a cache list of tags surrounding CHANGE. | |
292 | The returned list is the CONS cell in the master list pointing to | |
293 | a tag just before CHANGE. The CDR will have the tag just after CHANGE. | |
294 | CHANGE cannot encompass or overlap a leaf tag. | |
295 | If CHANGE is fully encompassed in a tag that has children, and | |
296 | this change occurs between those children, this returns non-nil. | |
297 | See `semantic-edits-change-leaf-tag' for details on parents." | |
298 | (let* ((start (semantic-edits-os change)) | |
299 | (end (semantic-edits-oe change)) | |
300 | (tags (nreverse | |
301 | (semantic-find-tag-by-overlay-in-region | |
302 | start end))) | |
303 | (list-to-search nil) | |
304 | (found nil)) | |
305 | (if (not tags) | |
306 | (setq list-to-search semantic--buffer-cache) | |
307 | ;; A leaf is always first in this list | |
308 | (if (and (< (semantic-tag-start (car tags)) start) | |
309 | (> (semantic-tag-end (car tags)) end)) | |
310 | ;; We are completely encompassed in a tag. | |
311 | (if (setq list-to-search | |
312 | (semantic-tag-components (car tags))) | |
313 | ;; Ok, we are completely encompassed within the first tag | |
314 | ;; entry, AND that tag has children. This means that change | |
d1f18ec0 | 315 | ;; occurred outside of all children, but inside some tag |
9573e58b CY |
316 | ;; with children. |
317 | (if (or (not (semantic-tag-with-position-p (car list-to-search))) | |
318 | (> start (semantic-tag-end | |
319 | (nth (1- (length list-to-search)) | |
320 | list-to-search))) | |
321 | (< end (semantic-tag-start (car list-to-search)))) | |
322 | ;; We have modifications to the definition of this parent | |
323 | ;; and not between it's children. Clear the search list. | |
324 | (setq list-to-search nil))) | |
325 | ;; Search list is nil. | |
326 | )) | |
c7015153 | 327 | ;; If we have a search list, let's go. Otherwise nothing. |
9573e58b CY |
328 | (while (and list-to-search (not found)) |
329 | (if (cdr list-to-search) | |
330 | ;; We end when the start of the CDR is after the end of our | |
331 | ;; asked change. | |
332 | (if (< (semantic-tag-start (cadr list-to-search)) end) | |
333 | (setq list-to-search (cdr list-to-search)) | |
334 | (setq found t)) | |
335 | (setq list-to-search nil))) | |
336 | ;; Return it. If it is nil, there is a logic bug, and we need | |
337 | ;; to avoid this bit of logic anyway. | |
338 | list-to-search | |
339 | )) | |
340 | ||
341 | (defun semantic-edits-change-over-tags (change) | |
342 | "Return a cache list of tags surrounding a CHANGE encompassing tags. | |
343 | CHANGE must not only include all overlapped tags (excepting possible | |
344 | parent tags) in their entirety. In this case, the change may be deleting | |
345 | or moving whole tags. | |
346 | The return value is a vector. | |
347 | Cell 0 is a list of all tags completely encompassed in change. | |
348 | Cell 1 is the cons cell into a master parser cache starting with | |
349 | the cell which occurs BEFORE the first position of CHANGE. | |
350 | Cell 2 is the parent of cell 1, or nil for the buffer cache. | |
351 | This function returns nil if any tag covered by change is not | |
352 | completely encompassed. | |
353 | See `semantic-edits-change-leaf-tag' for details on parents." | |
354 | (let* ((start (semantic-edits-os change)) | |
355 | (end (semantic-edits-oe change)) | |
356 | (tags (nreverse | |
357 | (semantic-find-tag-by-overlay-in-region | |
358 | start end))) | |
359 | (parent nil) | |
360 | (overlapped-tags nil) | |
361 | inner-start inner-end | |
362 | (list-to-search nil)) | |
363 | ;; By the time this is already called, we know that it is | |
364 | ;; not a leaf change, nor a between tag change. That leaves | |
365 | ;; an overlap, and this condition. | |
366 | ||
367 | ;; A leaf is always first in this list. | |
368 | ;; Is the leaf encompassed in this change? | |
369 | (if (and tags | |
370 | (>= (semantic-tag-start (car tags)) start) | |
371 | (<= (semantic-tag-end (car tags)) end)) | |
372 | (progn | |
373 | ;; We encompass one whole change. | |
374 | (setq overlapped-tags (list (car tags)) | |
375 | inner-start (semantic-tag-start (car tags)) | |
376 | inner-end (semantic-tag-end (car tags)) | |
377 | tags (cdr tags)) | |
378 | ;; Keep looping while tags are inside the change. | |
379 | (while (and tags | |
380 | (>= (semantic-tag-start (car tags)) start) | |
381 | (<= (semantic-tag-end (car tags)) end)) | |
382 | ||
383 | ;; Check if this new all-encompassing tag is a parent | |
384 | ;; of that which went before. Only check end because | |
385 | ;; we know that start is less than inner-start since | |
386 | ;; tags was sorted on that. | |
387 | (if (> (semantic-tag-end (car tags)) inner-end) | |
388 | ;; This is a parent. Drop the children found | |
389 | ;; so far. | |
390 | (setq overlapped-tags (list (car tags)) | |
391 | inner-start (semantic-tag-start (car tags)) | |
392 | inner-end (semantic-tag-end (car tags)) | |
393 | ) | |
394 | ;; It is not a parent encompassing tag | |
395 | (setq overlapped-tags (cons (car tags) | |
396 | overlapped-tags) | |
397 | inner-start (semantic-tag-start (car tags)))) | |
398 | (setq tags (cdr tags))) | |
399 | (if (not tags) | |
400 | ;; There are no tags left, and all tags originally | |
401 | ;; found are encompassed by the change. Setup our list | |
402 | ;; from the cache | |
e1dbe924 | 403 | (setq list-to-search semantic--buffer-cache);; We have a tag outside the list. Check for |
9573e58b CY |
404 | ;; We know we have a parent because it would |
405 | ;; completely cover the change. A tag can only | |
406 | ;; do that if it is a parent after we get here. | |
407 | (when (and tags | |
408 | (< (semantic-tag-start (car tags)) start) | |
409 | (> (semantic-tag-end (car tags)) end)) | |
410 | ;; We have a parent. Stuff in the search list. | |
411 | (setq parent (car tags) | |
412 | list-to-search (semantic-tag-components parent)) | |
413 | ;; If the first of TAGS is a parent (see above) | |
414 | ;; then clear out the list. All other tags in | |
415 | ;; here must therefore be parents of the car. | |
416 | (setq tags nil) | |
417 | ;; One last check, If start is before the first | |
418 | ;; tag or after the last, we may have overlap into | |
419 | ;; the characters that make up the definition of | |
420 | ;; the tag we are parsing. | |
421 | (when (or (semantic-tag-with-position-p (car list-to-search)) | |
422 | (< start (semantic-tag-start | |
423 | (car list-to-search))) | |
424 | (> end (semantic-tag-end | |
425 | (nth (1- (length list-to-search)) | |
426 | list-to-search)))) | |
427 | ;; We have a problem | |
428 | (setq list-to-search nil | |
429 | parent nil)))) | |
430 | ||
431 | (when list-to-search | |
432 | ||
433 | ;; Ok, return the vector only if all TAGS are | |
434 | ;; confirmed as the lineage of `overlapped-tags' | |
435 | ;; which must have a value by now. | |
436 | ||
97610156 | 437 | ;; Loop over the search list to find the preceding CDR. |
dbdb7031 | 438 | ;; Fortunately, (car overlapped-tags) happens to be |
9573e58b CY |
439 | ;; the first tag positionally. |
440 | (let ((tokstart (semantic-tag-start (car overlapped-tags)))) | |
441 | (while (and list-to-search | |
442 | ;; Assume always (car (cdr list-to-search)). | |
443 | ;; A thrown error will be captured nicely, but | |
444 | ;; that case shouldn't happen. | |
445 | ||
446 | ;; We end when the start of the CDR is after the | |
447 | ;; end of our asked change. | |
448 | (cdr list-to-search) | |
449 | (< (semantic-tag-start (car (cdr list-to-search))) | |
450 | tokstart) | |
451 | (setq list-to-search (cdr list-to-search))))) | |
452 | ;; Create the return vector | |
453 | (vector overlapped-tags | |
454 | list-to-search | |
455 | parent) | |
456 | )) | |
457 | nil))) | |
458 | ||
459 | ;;; Default Incremental Parser | |
460 | ;; | |
461 | ;; Logic about how to group changes for effective reparsing and splicing. | |
462 | ||
463 | (defun semantic-parse-changes-failed (&rest args) | |
464 | "Signal that Semantic failed to parse changes. | |
465 | That is, display a message by passing all ARGS to `format', then throw | |
466 | a 'semantic-parse-changes-failed exception with value t." | |
467 | (when semantic-edits-verbose-flag | |
468 | (message "Semantic parse changes failed: %S" | |
469 | (apply 'format args))) | |
470 | (throw 'semantic-parse-changes-failed t)) | |
471 | ||
472 | (defsubst semantic-edits-incremental-fail () | |
473 | "When the incremental parser fails, we mark that we need a full reparse." | |
474 | ;;(debug) | |
475 | (semantic-parse-tree-set-needs-rebuild) | |
476 | (when semantic-edits-verbose-flag | |
477 | (message "Force full reparse (%s)" | |
478 | (buffer-name (current-buffer)))) | |
b733e9bc | 479 | (run-hooks 'semantic-edits-incremental-reparse-failed-hook)) |
9573e58b | 480 | |
9954ec0d | 481 | ;;;###autoload |
9573e58b CY |
482 | (defun semantic-edits-incremental-parser () |
483 | "Incrementally reparse the current buffer. | |
484 | Incremental parser allows semantic to only reparse those sections of | |
485 | the buffer that have changed. This function depends on | |
486 | `semantic-edits-change-function-handle-changes' setting up change | |
487 | overlays in the current buffer. Those overlays are analyzed against | |
488 | the semantic cache to see what needs to be changed." | |
489 | (let ((changed-tags | |
490 | ;; Don't use `semantic-safe' here to explicitly catch errors | |
491 | ;; and reset the parse tree. | |
492 | (catch 'semantic-parse-changes-failed | |
493 | (if debug-on-error | |
494 | (semantic-edits-incremental-parser-1) | |
495 | (condition-case err | |
496 | (semantic-edits-incremental-parser-1) | |
497 | (error | |
498 | (message "incremental parser error: %S" | |
499 | (error-message-string err)) | |
500 | t)))))) | |
501 | (when (eq changed-tags t) | |
502 | ;; Force a full reparse. | |
503 | (semantic-edits-incremental-fail) | |
504 | (setq changed-tags nil)) | |
505 | changed-tags)) | |
506 | ||
507 | (defmacro semantic-edits-assert-valid-region () | |
9bf6c65c | 508 | "Assert that parse-start and parse-end are sorted correctly." |
9573e58b CY |
509 | ;;; (if (> parse-start parse-end) |
510 | ;;; (error "Bug is %s !> %d! Buff min/max = [ %d %d ]" | |
511 | ;;; parse-start parse-end | |
512 | ;;; (point-min) (point-max))) | |
513 | ) | |
514 | ||
515 | (defun semantic-edits-incremental-parser-1 () | |
516 | "Incrementally reparse the current buffer. | |
517 | Return the list of tags that changed. | |
518 | If the incremental parse fails, throw a 'semantic-parse-changes-failed | |
519 | exception with value t, that can be caught to schedule a full reparse. | |
520 | This function is for internal use by `semantic-edits-incremental-parser'." | |
521 | (let* ((changed-tags nil) | |
522 | (debug-on-quit t) ; try to find this annoying bug! | |
523 | (changes (semantic-changes-in-region | |
524 | (point-min) (point-max))) | |
525 | (tags nil) ;tags found at changes | |
526 | (newf-tags nil) ;newfound tags in change | |
527 | (parse-start nil) ;location to start parsing | |
528 | (parse-end nil) ;location to end parsing | |
529 | (parent-tag nil) ;parent of the cache list. | |
530 | (cache-list nil) ;list of children within which | |
531 | ;we incrementally reparse. | |
532 | (reparse-symbol nil) ;The ruled we start at for reparse. | |
533 | (change-group nil) ;changes grouped in this reparse | |
534 | (last-cond nil) ;track the last case used. | |
535 | ;query this when debugging to find | |
536 | ;source of bugs. | |
537 | ) | |
538 | (or changes | |
539 | ;; If we were called, and there are no changes, then we | |
540 | ;; don't know what to do. Force a full reparse. | |
541 | (semantic-parse-changes-failed "Don't know what to do")) | |
542 | ;; Else, we have some changes. Loop over them attempting to | |
543 | ;; patch things up. | |
544 | (while changes | |
545 | ;; Calculate the reparse boundary. | |
546 | ;; We want to take some set of changes, and group them | |
547 | ;; together into a small change group. One change forces | |
548 | ;; a reparse of a larger region (the size of some set of | |
4c36be58 | 549 | ;; tags it encompasses.) It may contain several tags. |
9573e58b CY |
550 | ;; That region may have other changes in it (several small |
551 | ;; changes in one function, for example.) | |
552 | ;; Optimize for the simple cases here, but try to handle | |
553 | ;; complex ones too. | |
554 | ||
555 | (while (and changes ; we still have changes | |
556 | (or (not parse-start) | |
557 | ;; Below, if the change we are looking at | |
558 | ;; is not the first change for this | |
559 | ;; iteration, and it starts before the end | |
560 | ;; of current parse region, then it is | |
cd1181db | 561 | ;; encompassed within the bounds of tags |
9573e58b CY |
562 | ;; modified by the previous iteration's |
563 | ;; change. | |
564 | (< (semantic-overlay-start (car changes)) | |
565 | parse-end))) | |
566 | ||
567 | ;; REMOVE LATER | |
568 | (if (eq (car changes) (car change-group)) | |
569 | (semantic-parse-changes-failed | |
570 | "Possible infinite loop detected")) | |
571 | ||
572 | ;; Store this change in this change group. | |
573 | (setq change-group (cons (car changes) change-group)) | |
574 | ||
575 | (cond | |
576 | ;; Is this is a new parse group? | |
577 | ((not parse-start) | |
578 | (setq last-cond "new group") | |
579 | (let (tmp) | |
580 | (cond | |
581 | ||
582 | ;;;; Are we encompassed all in one tag? | |
583 | ((setq tmp (semantic-edits-change-leaf-tag (car changes))) | |
584 | (setq last-cond "Encompassed in tag") | |
585 | (setq tags (list tmp) | |
586 | parse-start (semantic-tag-start tmp) | |
587 | parse-end (semantic-tag-end tmp) | |
588 | ) | |
589 | (semantic-edits-assert-valid-region)) | |
590 | ||
591 | ;;;; Did the change occur between some tags? | |
592 | ((setq cache-list (semantic-edits-change-between-tags | |
593 | (car changes))) | |
594 | (setq last-cond "Between and not overlapping tags") | |
595 | ;; The CAR of cache-list is the tag just before | |
596 | ;; our change, but wasn't modified. Hmmm. | |
597 | ;; Bound our reparse between these two tags | |
598 | (setq tags nil | |
599 | parent-tag | |
600 | (car (semantic-find-tag-by-overlay | |
601 | parse-start))) | |
602 | (cond | |
603 | ;; A change at the beginning of the buffer. | |
604 | ;; Feb 06 - | |
605 | ;; IDed when the first cache-list tag is after | |
606 | ;; our change, meaning there is nothing before | |
da6062e6 | 607 | ;; the change. |
9573e58b CY |
608 | ((> (semantic-tag-start (car cache-list)) |
609 | (semantic-overlay-end (car changes))) | |
610 | (setq last-cond "Beginning of buffer") | |
611 | (setq parse-start | |
612 | ;; Don't worry about parents since | |
613 | ;; there there would be an exact | |
614 | ;; match in the tag list otherwise | |
615 | ;; and the routine would fail. | |
616 | (point-min) | |
617 | parse-end | |
618 | (semantic-tag-start (car cache-list))) | |
619 | (semantic-edits-assert-valid-region) | |
620 | ) | |
621 | ;; A change stuck on the first surrounding tag. | |
622 | ((= (semantic-tag-end (car cache-list)) | |
623 | (semantic-overlay-start (car changes))) | |
624 | (setq last-cond "Beginning of Tag") | |
625 | ;; Reparse that first tag. | |
626 | (setq parse-start | |
627 | (semantic-tag-start (car cache-list)) | |
628 | parse-end | |
629 | (semantic-overlay-end (car changes)) | |
630 | tags | |
631 | (list (car cache-list))) | |
632 | (semantic-edits-assert-valid-region) | |
633 | ) | |
634 | ;; A change at the end of the buffer. | |
635 | ((not (car (cdr cache-list))) | |
636 | (setq last-cond "End of buffer") | |
637 | (setq parse-start (semantic-tag-end | |
638 | (car cache-list)) | |
639 | parse-end (point-max)) | |
640 | (semantic-edits-assert-valid-region) | |
641 | ) | |
642 | (t | |
643 | (setq last-cond "Default") | |
644 | (setq parse-start | |
645 | (semantic-tag-end (car cache-list)) | |
646 | parse-end | |
647 | (semantic-tag-start (car (cdr cache-list))) | |
648 | ) | |
649 | (semantic-edits-assert-valid-region)))) | |
650 | ||
651 | ;;;; Did the change completely overlap some number of tags? | |
652 | ((setq tmp (semantic-edits-change-over-tags | |
653 | (car changes))) | |
654 | (setq last-cond "Overlap multiple tags") | |
655 | ;; Extract the information | |
656 | (setq tags (aref tmp 0) | |
657 | cache-list (aref tmp 1) | |
658 | parent-tag (aref tmp 2)) | |
659 | ;; We can calculate parse begin/end by checking | |
660 | ;; out what is in TAGS. The one near start is | |
40ba43b4 | 661 | ;; always first. Make sure the reparse includes |
9573e58b CY |
662 | ;; the `whitespace' around the snarfed tags. |
663 | ;; Since cache-list is positioned properly, use it | |
664 | ;; to find that boundary. | |
665 | (if (eq (car tags) (car cache-list)) | |
666 | ;; Beginning of the buffer! | |
667 | (let ((end-marker (nth (length tags) | |
668 | cache-list))) | |
669 | (setq parse-start (point-min)) | |
670 | (if end-marker | |
671 | (setq parse-end | |
672 | (semantic-tag-start end-marker)) | |
673 | (setq parse-end (semantic-overlay-end | |
674 | (car changes)))) | |
675 | (semantic-edits-assert-valid-region) | |
676 | ) | |
677 | ;; Middle of the buffer. | |
678 | (setq parse-start | |
679 | (semantic-tag-end (car cache-list))) | |
680 | ;; For the end, we need to scoot down some | |
681 | ;; number of tags. We 1+ the length of tags | |
682 | ;; because we want to skip the first tag | |
683 | ;; (remove 1-) then want the tag after the end | |
684 | ;; of the list (1+) | |
685 | (let ((end-marker (nth (1+ (length tags)) cache-list))) | |
686 | (if end-marker | |
687 | (setq parse-end (semantic-tag-start end-marker)) | |
688 | ;; No marker. It is the last tag in our | |
689 | ;; list of tags. Only possible if END | |
690 | ;; already matches the end of that tag. | |
691 | (setq parse-end | |
692 | (semantic-overlay-end (car changes))))) | |
693 | (semantic-edits-assert-valid-region) | |
694 | )) | |
695 | ||
696 | ;;;; Unhandled case. | |
697 | ;; Throw error, and force full reparse. | |
698 | ((semantic-parse-changes-failed "Unhandled change group"))) | |
699 | )) | |
700 | ;; Is this change inside the previous parse group? | |
701 | ;; We already checked start. | |
702 | ((< (semantic-overlay-end (car changes)) parse-end) | |
703 | (setq last-cond "in bounds") | |
704 | nil) | |
705 | ;; This change extends the current parse group. | |
706 | ;; Find any new tags, and see how to append them. | |
707 | ((semantic-parse-changes-failed | |
708 | (setq last-cond "overlap boundary") | |
709 | "Unhandled secondary change overlapping boundary")) | |
710 | ) | |
711 | ;; Prepare for the next iteration. | |
712 | (setq changes (cdr changes))) | |
713 | ||
714 | ;; By the time we get here, all TAGS are children of | |
715 | ;; some parent. They should all have the same start symbol | |
716 | ;; since that is how the multi-tag parser works. Grab | |
717 | ;; the reparse symbol from the first of the returned tags. | |
718 | ;; | |
40ba43b4 | 719 | ;; Feb '06 - If reparse-symbol is nil, then they are top level |
9573e58b CY |
720 | ;; tags. (I'm guessing.) Is this right? |
721 | (setq reparse-symbol | |
722 | (semantic--tag-get-property (car (or tags cache-list)) | |
723 | 'reparse-symbol)) | |
724 | ;; Find a parent if not provided. | |
725 | (and (not parent-tag) tags | |
726 | (setq parent-tag | |
727 | (semantic-find-tag-parent-by-overlay | |
728 | (car tags)))) | |
729 | ;; We can do the same trick for our parent and resulting | |
730 | ;; cache list. | |
731 | (unless cache-list | |
732 | (if parent-tag | |
733 | (setq cache-list | |
734 | ;; We need to get all children in case we happen | |
735 | ;; to have a mix of positioned and non-positioned | |
736 | ;; children. | |
737 | (semantic-tag-components parent-tag)) | |
738 | ;; Else, all the tags since there is no parent. | |
739 | ;; It sucks to have to use the full buffer cache in | |
740 | ;; this case because it can be big. Failure to provide | |
741 | ;; however results in a crash. | |
742 | (setq cache-list semantic--buffer-cache) | |
743 | )) | |
744 | ;; Use the boundary to calculate the new tags found. | |
745 | (setq newf-tags (semantic-parse-region | |
746 | parse-start parse-end reparse-symbol)) | |
747 | ;; Make sure all these tags are given overlays. | |
748 | ;; They have already been cooked by the parser and just | |
749 | ;; need the overlays. | |
750 | (let ((tmp newf-tags)) | |
751 | (while tmp | |
752 | (semantic--tag-link-to-buffer (car tmp)) | |
753 | (setq tmp (cdr tmp)))) | |
754 | ||
755 | ;; See how this change lays out. | |
756 | (cond | |
757 | ||
758 | ;;;; Whitespace change | |
759 | ((and (not tags) (not newf-tags)) | |
d1f18ec0 | 760 | ;; A change that occurred outside of any existing tags |
9573e58b CY |
761 | ;; and there are no new tags to replace it. |
762 | (when semantic-edits-verbose-flag | |
763 | (message "White space changes")) | |
764 | nil | |
765 | ) | |
766 | ||
767 | ;;;; New tags in old whitespace area. | |
768 | ((and (not tags) newf-tags) | |
d1f18ec0 | 769 | ;; A change occurred outside existing tags which added |
9573e58b CY |
770 | ;; a new tag. We need to splice these tags back |
771 | ;; into the cache at the right place. | |
772 | (semantic-edits-splice-insert newf-tags parent-tag cache-list) | |
773 | ||
774 | (setq changed-tags | |
775 | (append newf-tags changed-tags)) | |
776 | ||
777 | (when semantic-edits-verbose-flag | |
778 | (message "Inserted tags: (%s)" | |
779 | (semantic-format-tag-name (car newf-tags)))) | |
780 | ) | |
781 | ||
782 | ;;;; Old tags removed | |
783 | ((and tags (not newf-tags)) | |
d1f18ec0 | 784 | ;; A change occurred where pre-existing tags were |
9573e58b CY |
785 | ;; deleted! Remove the tag from the cache. |
786 | (semantic-edits-splice-remove tags parent-tag cache-list) | |
787 | ||
788 | (setq changed-tags | |
789 | (append tags changed-tags)) | |
790 | ||
791 | (when semantic-edits-verbose-flag | |
792 | (message "Deleted tags: (%s)" | |
793 | (semantic-format-tag-name (car tags)))) | |
794 | ) | |
795 | ||
796 | ;;;; One tag was updated. | |
797 | ((and (= (length tags) 1) (= (length newf-tags) 1)) | |
798 | ;; One old tag was modified, and it is replaced by | |
799 | ;; One newfound tag. Splice the new tag into the | |
800 | ;; position of the old tag. | |
801 | ;; Do the splice. | |
802 | (semantic-edits-splice-replace (car tags) (car newf-tags)) | |
803 | ;; Add this tag to our list of changed toksns | |
804 | (setq changed-tags (cons (car tags) changed-tags)) | |
805 | ;; Debug | |
806 | (when semantic-edits-verbose-flag | |
807 | (message "Update Tag Table: %s" | |
808 | (semantic-format-tag-name (car tags) nil t))) | |
809 | ;; Flush change regardless of above if statement. | |
810 | ) | |
811 | ||
812 | ;;;; Some unhandled case. | |
813 | ((semantic-parse-changes-failed "Don't know what to do"))) | |
814 | ||
815 | ;; We got this far, and we didn't flag a full reparse. | |
816 | ;; Clear out this change group. | |
817 | (while change-group | |
818 | (semantic-edits-flush-change (car change-group)) | |
819 | (setq change-group (cdr change-group))) | |
820 | ||
821 | ;; Don't increment change here because an earlier loop | |
822 | ;; created change-groups. | |
823 | (setq parse-start nil) | |
824 | ) | |
825 | ;; Mark that we are done with this glop | |
826 | (semantic-parse-tree-set-up-to-date) | |
827 | ;; Return the list of tags that changed. The caller will | |
828 | ;; use this information to call hooks which can fix themselves. | |
829 | changed-tags)) | |
830 | ||
831 | ;; Make it the default changes parser | |
06b43459 | 832 | ;;;###autoload |
9573e58b CY |
833 | (defalias 'semantic-parse-changes-default |
834 | 'semantic-edits-incremental-parser) | |
835 | ||
836 | ;;; Cache Splicing | |
837 | ;; | |
838 | ;; The incremental parser depends on the ability to parse up sections | |
839 | ;; of the file, and splice the results back into the cache. There are | |
840 | ;; three types of splices. A REPLACE, an ADD, and a REMOVE. REPLACE | |
841 | ;; is one of the simpler cases, as the starting cons cell representing | |
842 | ;; the old tag can be used to auto-splice in. ADD and REMOVE | |
843 | ;; require scanning the cache to find the correct location so that the | |
844 | ;; list can be fiddled. | |
845 | (defun semantic-edits-splice-remove (oldtags parent cachelist) | |
846 | "Remove OLDTAGS from PARENT's CACHELIST. | |
9bf6c65c | 847 | OLDTAGS are tags in the current buffer, preferably linked |
9573e58b CY |
848 | together also in CACHELIST. |
849 | PARENT is the parent tag containing OLDTAGS. | |
850 | CACHELIST should be the children from PARENT, but may be | |
851 | pre-positioned to a convenient location." | |
852 | (let* ((first (car oldtags)) | |
853 | (last (nth (1- (length oldtags)) oldtags)) | |
854 | (chil (if parent | |
855 | (semantic-tag-components parent) | |
856 | semantic--buffer-cache)) | |
857 | (cachestart cachelist) | |
858 | (cacheend nil) | |
859 | ) | |
860 | ;; First in child list? | |
861 | (if (eq first (car chil)) | |
862 | ;; First tags in the cache are being deleted. | |
863 | (progn | |
864 | (when semantic-edits-verbose-flag | |
865 | (message "To Remove First Tag: (%s)" | |
866 | (semantic-format-tag-name first))) | |
867 | ;; Find the last tag | |
868 | (setq cacheend chil) | |
869 | (while (and cacheend (not (eq last (car cacheend)))) | |
870 | (setq cacheend (cdr cacheend))) | |
c80e3b4a | 871 | ;; The spliceable part is after cacheend.. so move cacheend |
9573e58b CY |
872 | ;; one more tag. |
873 | (setq cacheend (cdr cacheend)) | |
874 | ;; Splice the found end tag into the cons cell | |
875 | ;; owned by the current top child. | |
876 | (setcar chil (car cacheend)) | |
877 | (setcdr chil (cdr cacheend)) | |
878 | (when (not cacheend) | |
879 | ;; No cacheend.. then the whole system is empty. | |
880 | ;; The best way to deal with that is to do a full | |
881 | ;; reparse | |
882 | (semantic-parse-changes-failed "Splice-remove failed. Empty buffer?") | |
883 | )) | |
884 | (message "To Remove Middle Tag: (%s)" | |
885 | (semantic-format-tag-name first))) | |
97610156 | 886 | ;; Find in the cache the preceding tag |
9573e58b CY |
887 | (while (and cachestart (not (eq first (car (cdr cachestart))))) |
888 | (setq cachestart (cdr cachestart))) | |
889 | ;; Find the last tag | |
890 | (setq cacheend cachestart) | |
891 | (while (and cacheend (not (eq last (car cacheend)))) | |
892 | (setq cacheend (cdr cacheend))) | |
893 | ;; Splice the end position into the start position. | |
894 | ;; If there is no start, then this whole section is probably | |
895 | ;; gone. | |
896 | (if cachestart | |
897 | (setcdr cachestart (cdr cacheend)) | |
898 | (semantic-parse-changes-failed "Splice-remove failed.")) | |
899 | ||
900 | ;; Remove old overlays of these deleted tags | |
901 | (while oldtags | |
902 | (semantic--tag-unlink-from-buffer (car oldtags)) | |
903 | (setq oldtags (cdr oldtags))) | |
904 | )) | |
905 | ||
906 | (defun semantic-edits-splice-insert (newtags parent cachelist) | |
907 | "Insert NEWTAGS into PARENT using CACHELIST. | |
908 | PARENT could be nil, in which case CACHLIST is the buffer cache | |
909 | which must be updated. | |
910 | CACHELIST must be searched to find where NEWTAGS are to be inserted. | |
911 | The positions of NEWTAGS must be synchronized with those in | |
912 | CACHELIST for this to work. Some routines pre-position CACHLIST at a | |
913 | convenient location, so use that." | |
914 | (let* ((start (semantic-tag-start (car newtags))) | |
915 | (newtagendcell (nthcdr (1- (length newtags)) newtags)) | |
916 | (end (semantic-tag-end (car newtagendcell))) | |
917 | ) | |
918 | (if (> (semantic-tag-start (car cachelist)) start) | |
919 | ;; We are at the beginning. | |
920 | (let* ((pc (if parent | |
921 | (semantic-tag-components parent) | |
922 | semantic--buffer-cache)) | |
923 | (nc (cons (car pc) (cdr pc))) ; new cons cell. | |
924 | ) | |
925 | ;; Splice the new cache cons cell onto the end of our list. | |
926 | (setcdr newtagendcell nc) | |
927 | ;; Set our list into parent. | |
928 | (setcar pc (car newtags)) | |
929 | (setcdr pc (cdr newtags))) | |
930 | ;; We are at the end, or in the middle. Find our match first. | |
931 | (while (and (cdr cachelist) | |
932 | (> end (semantic-tag-start (car (cdr cachelist))))) | |
933 | (setq cachelist (cdr cachelist))) | |
934 | ;; Now splice into the list! | |
935 | (setcdr newtagendcell (cdr cachelist)) | |
936 | (setcdr cachelist newtags)))) | |
937 | ||
938 | (defun semantic-edits-splice-replace (oldtag newtag) | |
939 | "Replace OLDTAG with NEWTAG in the current cache. | |
9bf6c65c | 940 | Do this by recycling OLDTAG's first CONS cell. This effectively |
9573e58b CY |
941 | causes the new tag to completely replace the old one. |
942 | Make sure that all information in the overlay is transferred. | |
943 | It is presumed that OLDTAG and NEWTAG are both cooked. | |
944 | When this routine returns, OLDTAG is raw, and the data will be | |
945 | lost if not transferred into NEWTAG." | |
946 | (let* ((oo (semantic-tag-overlay oldtag)) | |
947 | (o (semantic-tag-overlay newtag)) | |
948 | (oo-props (semantic-overlay-properties oo))) | |
949 | (while oo-props | |
950 | (semantic-overlay-put o (car oo-props) (car (cdr oo-props))) | |
951 | (setq oo-props (cdr (cdr oo-props))) | |
952 | ) | |
953 | ;; Free the old overlay(s) | |
954 | (semantic--tag-unlink-from-buffer oldtag) | |
955 | ;; Recover properties | |
956 | (semantic--tag-copy-properties oldtag newtag) | |
957 | ;; Splice into the main list. | |
958 | (setcdr oldtag (cdr newtag)) | |
959 | (setcar oldtag (car newtag)) | |
960 | ;; This important bit is because the CONS cell representing | |
961 | ;; OLDTAG is now pointing to NEWTAG, but the NEWTAG | |
962 | ;; cell is about to be abandoned. Here we update our overlay | |
963 | ;; to point at the updated state of the world. | |
964 | (semantic-overlay-put o 'semantic oldtag) | |
965 | )) | |
8bf997ef | 966 | |
9573e58b CY |
967 | (add-hook 'semantic-before-toplevel-cache-flush-hook |
968 | #'semantic-edits-flush-changes) | |
969 | ||
970 | (provide 'semantic/edit) | |
971 | ||
06b43459 CY |
972 | ;; Local variables: |
973 | ;; generated-autoload-file: "loaddefs.el" | |
06b43459 CY |
974 | ;; generated-autoload-load-name: "semantic/edit" |
975 | ;; End: | |
976 | ||
978c25c6 | 977 | ;;; semantic/edit.el ends here |