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