Function: semantic-edits-incremental-parser-1
semantic-edits-incremental-parser-1 is a byte-compiled function
defined in edit.el.gz.
Signature
(semantic-edits-incremental-parser-1)
Documentation
Incrementally reparse the current buffer.
Return the list of tags that changed.
If the incremental parse fails, throw a semantic-parse-changes-failed
exception with value t, that can be caught to schedule a full reparse.
This function is for internal use by semantic-edits-incremental-parser.
Source Code
;; Defined in /usr/src/emacs/lisp/cedet/semantic/edit.el.gz
(defun semantic-edits-incremental-parser-1 ()
"Incrementally reparse the current buffer.
Return the list of tags that changed.
If the incremental parse fails, throw a `semantic-parse-changes-failed'
exception with value t, that can be caught to schedule a full reparse.
This function is for internal use by `semantic-edits-incremental-parser'."
(let* ((changed-tags nil)
(debug-on-quit t) ; try to find this annoying bug!
(changes (semantic-changes-in-region
(point-min) (point-max)))
(tags nil) ;tags found at changes
(newf-tags nil) ;newfound tags in change
(parse-start nil) ;location to start parsing
(parse-end nil) ;location to end parsing
(parent-tag nil) ;parent of the cache list.
(cache-list nil) ;list of children within which
;we incrementally reparse.
(reparse-symbol nil) ;The ruled we start at for reparse.
(change-group nil) ;changes grouped in this reparse
(last-cond nil) ;track the last case used.
;query this when debugging to find
;source of bugs.
)
(ignore last-cond) ;; Don't warn about the var not being used.
(or changes
;; If we were called, and there are no changes, then we
;; don't know what to do. Force a full reparse.
(semantic-parse-changes-failed "Don't know what to do"))
;; Else, we have some changes. Loop over them attempting to
;; patch things up.
(while changes
;; Calculate the reparse boundary.
;; We want to take some set of changes, and group them
;; together into a small change group. One change forces
;; a reparse of a larger region (the size of some set of
;; tags it encompasses.) It may contain several tags.
;; That region may have other changes in it (several small
;; changes in one function, for example.)
;; Optimize for the simple cases here, but try to handle
;; complex ones too.
(while (and changes ; we still have changes
(or (not parse-start)
;; Below, if the change we are looking at
;; is not the first change for this
;; iteration, and it starts before the end
;; of current parse region, then it is
;; encompassed within the bounds of tags
;; modified by the previous iteration's
;; change.
(< (overlay-start (car changes))
parse-end)))
;; REMOVE LATER
(if (eq (car changes) (car change-group))
(semantic-parse-changes-failed
"Possible infinite loop detected"))
;; Store this change in this change group.
(setq change-group (cons (car changes) change-group))
(cond
;; Is this is a new parse group?
((not parse-start)
(setq last-cond "new group")
(let (tmp)
(cond
;;;; Are we encompassed all in one tag?
((setq tmp (semantic-edits-change-leaf-tag (car changes)))
(setq last-cond "Encompassed in tag")
(setq tags (list tmp)
parse-start (semantic-tag-start tmp)
parse-end (semantic-tag-end tmp)
)
(semantic-edits-assert-valid-region))
;;;; Did the change occur between some tags?
((setq cache-list (semantic-edits-change-between-tags
(car changes)))
(setq last-cond "Between and not overlapping tags")
;; The CAR of cache-list is the tag just before
;; our change, but wasn't modified. Hmmm.
;; Bound our reparse between these two tags
(setq tags nil
parent-tag
(car (semantic-find-tag-by-overlay
parse-start)))
(cond
;; A change at the beginning of the buffer.
;; Feb 06 -
;; IDed when the first cache-list tag is after
;; our change, meaning there is nothing before
;; the change.
((> (semantic-tag-start (car cache-list))
(overlay-end (car changes)))
(setq last-cond "Beginning of buffer")
(setq parse-start
;; Don't worry about parents since
;; there there would be an exact
;; match in the tag list otherwise
;; and the routine would fail.
(point-min)
parse-end
(semantic-tag-start (car cache-list)))
(semantic-edits-assert-valid-region)
)
;; A change stuck on the first surrounding tag.
((= (semantic-tag-end (car cache-list))
(overlay-start (car changes)))
(setq last-cond "Beginning of Tag")
;; Reparse that first tag.
(setq parse-start
(semantic-tag-start (car cache-list))
parse-end
(overlay-end (car changes))
tags
(list (car cache-list)))
(semantic-edits-assert-valid-region)
)
;; A change at the end of the buffer.
((not (car (cdr cache-list)))
(setq last-cond "End of buffer")
(setq parse-start (semantic-tag-end
(car cache-list))
parse-end (point-max))
(semantic-edits-assert-valid-region)
)
(t
(setq last-cond "Default")
(setq parse-start
(semantic-tag-end (car cache-list))
parse-end
(semantic-tag-start (car (cdr cache-list)))
)
(semantic-edits-assert-valid-region))))
;;;; Did the change completely overlap some number of tags?
((setq tmp (semantic-edits-change-over-tags
(car changes)))
(setq last-cond "Overlap multiple tags")
;; Extract the information
(setq tags (aref tmp 0)
cache-list (aref tmp 1)
parent-tag (aref tmp 2))
;; We can calculate parse begin/end by checking
;; out what is in TAGS. The one near start is
;; always first. Make sure the reparse includes
;; the `whitespace' around the snarfed tags.
;; Since cache-list is positioned properly, use it
;; to find that boundary.
(if (eq (car tags) (car cache-list))
;; Beginning of the buffer!
(let ((end-marker (nth (length tags)
cache-list)))
(setq parse-start (point-min))
(if end-marker
(setq parse-end
(semantic-tag-start end-marker))
(setq parse-end (overlay-end
(car changes))))
(semantic-edits-assert-valid-region)
)
;; Middle of the buffer.
(setq parse-start
(semantic-tag-end (car cache-list)))
;; For the end, we need to scoot down some
;; number of tags. We 1+ the length of tags
;; because we want to skip the first tag
;; (remove 1-) then want the tag after the end
;; of the list (1+)
(let ((end-marker (nth (1+ (length tags)) cache-list)))
(if end-marker
(setq parse-end (semantic-tag-start end-marker))
;; No marker. It is the last tag in our
;; list of tags. Only possible if END
;; already matches the end of that tag.
(setq parse-end
(overlay-end (car changes)))))
(semantic-edits-assert-valid-region)
))
;;;; Unhandled case.
;; Throw error, and force full reparse.
((semantic-parse-changes-failed "Unhandled change group")))
))
;; Is this change inside the previous parse group?
;; We already checked start.
((< (overlay-end (car changes)) parse-end)
(setq last-cond "in bounds")
nil)
;; This change extends the current parse group.
;; Find any new tags, and see how to append them.
((semantic-parse-changes-failed
(setq last-cond "overlap boundary")
"Unhandled secondary change overlapping boundary"))
)
;; Prepare for the next iteration.
(setq changes (cdr changes)))
;; By the time we get here, all TAGS are children of
;; some parent. They should all have the same start symbol
;; since that is how the multi-tag parser works. Grab
;; the reparse symbol from the first of the returned tags.
;;
;; Feb '06 - If reparse-symbol is nil, then they are top level
;; tags. (I'm guessing.) Is this right?
(setq reparse-symbol
(semantic--tag-get-property (car (or tags cache-list))
'reparse-symbol))
;; Find a parent if not provided.
(and (not parent-tag) tags
(setq parent-tag
(semantic-find-tag-parent-by-overlay
(car tags))))
;; We can do the same trick for our parent and resulting
;; cache list.
(unless cache-list
(if parent-tag
(setq cache-list
;; We need to get all children in case we happen
;; to have a mix of positioned and non-positioned
;; children.
(semantic-tag-components parent-tag))
;; Else, all the tags since there is no parent.
;; It sucks to have to use the full buffer cache in
;; this case because it can be big. Failure to provide
;; however results in a crash.
(setq cache-list semantic--buffer-cache)
))
;; Use the boundary to calculate the new tags found.
(setq newf-tags (semantic-parse-region
parse-start parse-end reparse-symbol))
;; Make sure all these tags are given overlays.
;; They have already been cooked by the parser and just
;; need the overlays.
(let ((tmp newf-tags))
(while tmp
(semantic--tag-link-to-buffer (car tmp))
(setq tmp (cdr tmp))))
;; See how this change lays out.
(cond
;;;; Whitespace change
((and (not tags) (not newf-tags))
;; A change that occurred outside of any existing tags
;; and there are no new tags to replace it.
(when semantic-edits-verbose-flag
(message "White space changes"))
nil
)
;;;; New tags in old whitespace area.
((and (not tags) newf-tags)
;; A change occurred outside existing tags which added
;; a new tag. We need to splice these tags back
;; into the cache at the right place.
(semantic-edits-splice-insert newf-tags parent-tag cache-list)
(setq changed-tags
(append newf-tags changed-tags))
(when semantic-edits-verbose-flag
(message "Inserted tags: (%s)"
(semantic-format-tag-name (car newf-tags))))
)
;;;; Old tags removed
((and tags (not newf-tags))
;; A change occurred where pre-existing tags were
;; deleted! Remove the tag from the cache.
(semantic-edits-splice-remove tags parent-tag cache-list)
(setq changed-tags
(append tags changed-tags))
(when semantic-edits-verbose-flag
(message "Deleted tags: (%s)"
(semantic-format-tag-name (car tags))))
)
;;;; One tag was updated.
((and (= (length tags) 1) (= (length newf-tags) 1))
;; One old tag was modified, and it is replaced by
;; One newfound tag. Splice the new tag into the
;; position of the old tag.
;; Do the splice.
(semantic-edits-splice-replace (car tags) (car newf-tags))
;; Add this tag to our list of changed toksns
(setq changed-tags (cons (car tags) changed-tags))
;; Debug
(when semantic-edits-verbose-flag
(message "Update Tag Table: %s"
(semantic-format-tag-name (car tags) nil t)))
;; Flush change regardless of above if statement.
)
;;;; Some unhandled case.
((semantic-parse-changes-failed "Don't know what to do")))
;; We got this far, and we didn't flag a full reparse.
;; Clear out this change group.
(while change-group
(semantic-edits-flush-change (car change-group))
(setq change-group (cdr change-group)))
;; Don't increment change here because an earlier loop
;; created change-groups.
(setq parse-start nil)
)
;; Mark that we are done with this glop
(semantic-parse-tree-set-up-to-date)
;; Return the list of tags that changed. The caller will
;; use this information to call hooks which can fix themselves.
changed-tags))