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