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