]> git.eshelyaron.com Git - emacs.git/commitdiff
cedet/semantic/analyze.el, cedet/semantic/complete.el,
authorChong Yidong <cyd@stupidchicken.com>
Sat, 29 Aug 2009 19:00:35 +0000 (19:00 +0000)
committerChong Yidong <cyd@stupidchicken.com>
Sat, 29 Aug 2009 19:00:35 +0000 (19:00 +0000)
cedet/semantic/edit.el, cedet/semantic/html.el,
cedet/semantic/idle.el, cedet/semantic/texi.el: New files.
cedet/semantic/lex.el: Move defsubsts to front of file to avoid
compiler error.

lisp/cedet/semantic/analyze.el [new file with mode: 0644]
lisp/cedet/semantic/complete.el [new file with mode: 0644]
lisp/cedet/semantic/edit.el [new file with mode: 0644]
lisp/cedet/semantic/html.el [new file with mode: 0644]
lisp/cedet/semantic/idle.el [new file with mode: 0644]
lisp/cedet/semantic/lex.el
lisp/cedet/semantic/texi.el [new file with mode: 0644]

diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el
new file mode 100644 (file)
index 0000000..7c47ba0
--- /dev/null
@@ -0,0 +1,769 @@
+;;; analyze.el --- Analyze semantic tags against local context
+
+;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Semantic, as a tool, provides a nice list of searchable tags.
+;; That information can provide some very accurate answers if the current
+;; context of a position is known.
+;;
+;; Semantic-ctxt provides ways of analyzing, and manipulating the
+;; semantic context of a language in code.
+;;
+;; This library provides routines for finding intelligent answers to
+;; tough problems, such as if an argument to a function has the correct
+;; return type, or all possible tags that fit in a given local context.
+;;
+
+;;; Vocabulary:
+;;
+;; Here are some words used to describe different things in the analyzer:
+;;
+;; tag - A single entity
+;; prefix - The beginning of a symbol, usually used to look up something
+;;       incomplete.
+;; type - The name of a datatype in the langauge.
+;; metatype - If a type is named in a declaration like:
+;;       struct moose somevariable;
+;;       that name "moose" can be turned into a concrete type.
+;; tag sequence - In C code, a list of dereferences, such as:
+;;       this.that.theother();
+;; parent - For a datatype in an OO language, another datatype
+;;       inherited from.  This excludes interfaces.
+;; scope - A list of tags that can be dereferenced that cannot
+;;       be found from the global namespace.
+;; scopetypes - A list of tags which are datatype that contain
+;;       the scope.  The scopetypes need to have the scope extracted
+;;       in a way that honors the type of inheritance.
+;; nest/nested - When one tag is contained entirely in another.
+;;
+;; context - A semantic datatype representing a point in a buffer.
+;;
+;; constriant - If a context specifies a specific datatype is needed,
+;;       that is a constraint.
+;; constants - Some datatypes define elements of themselves as a
+;;       constant.  These need to be returned as there would be no
+;;       other possible completions.
+;;
+(require 'eieio)
+;; (require 'inversion)
+;; (eval-and-compile
+;;   (inversion-require 'eieio "1.0"))
+(require 'semantic)
+(require 'semantic/format)
+(require 'semantic/ctxt)
+(require 'semantic/sort)
+(eval-when-compile (require 'semantic/db)
+                  (require 'semantic/db-find))
+
+(require 'semantic/scope)
+(require 'semantic/analyze/fcn)
+
+;;; Code:
+(defvar semantic-analyze-error-stack nil
+  "Collection of any errors thrown during analysis.")
+
+(defun semantic-analyze-push-error (err)
+  "Push the error in ERR-DATA onto the error stack.
+Argument ERR"
+  (push err semantic-analyze-error-stack))
+
+;;; Analysis Classes
+;;
+;; These classes represent what a context is.  Different types
+;; of contexts provide differing amounts of information to help
+;; provide completions.
+;;
+(defclass semantic-analyze-context ()
+  ((bounds :initarg :bounds
+          :type list
+          :documentation "The bounds of this context.
+Usually bound to the dimension of a single symbol or command.")
+   (prefix :initarg :prefix
+          :type list
+          :documentation "List of tags defining local text.
+This can be nil, or a list where the last element can be a string
+representing text that may be incomplete.  Preceeding elements
+must be semantic tags representing variables or functions
+called in a dereference sequence.")
+   (prefixclass :initarg :prefixclass
+               :type list
+               :documentation "Tag classes expected at this context.
+These are clases for tags, such as 'function, or 'variable.")
+   (prefixtypes :initarg :prefixtypes
+          :type list
+          :documentation "List of tags defining types for :prefix.
+This list is one shorter than :prefix.  Each element is a semantic
+tag representing a type matching the semantic tag in the same
+position in PREFIX.")
+   (scope :initarg :scope
+         :type (or null semantic-scope-cache)
+         :documentation "List of tags available in scopetype.
+See `semantic-analyze-scoped-tags' for details.")
+   (buffer :initarg :buffer
+          :type buffer
+          :documentation "The buffer this context is derived from.")
+   (errors :initarg :errors
+          :documentation "Any errors thrown an caught during analysis.")
+   )
+  "Base analysis data for a any context.")
+
+(defclass semantic-analyze-context-assignment (semantic-analyze-context)
+  ((assignee :initarg :assignee
+            :type list
+            :documentation "A sequence of tags for an assignee.
+This is a variable into which some value is being placed.  The last
+item in the list is the variable accepting the value.  Earlier
+tags represent the variables being derefernece to get to the
+assignee."))
+  "Analysis class for a value in an assignment.")
+
+(defclass semantic-analyze-context-functionarg (semantic-analyze-context)
+  ((function :initarg :function
+            :type list
+            :documentation "A sequence of tags for a function.
+This is a function being called.  The cursor will be in the position
+of an argument.
+The last tag in :function is the function being called.  Earlier
+tags represent the variables being dereferenced to get to the
+function.")
+   (index :initarg :index
+         :type integer
+         :documentation "The index of the argument for this context.
+If a function takes 4 arguments, this value should be bound to
+the values 1 through 4.")
+   (argument :initarg :argument
+            :type list
+            :documentation "A sequence of tags for the :index argument.
+The argument can accept a value of some type, and this contains the
+tag for that definition.  It should be a tag, but might
+be just a string in some circumstances.")
+   )
+  "Analysis class for a value as a function argument.")
+
+(defclass semantic-analyze-context-return (semantic-analyze-context)
+  () ; No extra data.
+  "Analysis class for return data.
+Return data methods identify the requred type by the return value
+of the parent function.")
+
+;;; METHODS
+;;
+;; Simple methods against the context classes.
+;;
+(defmethod semantic-analyze-type-constraint
+  ((context semantic-analyze-context) &optional desired-type)
+  "Return a type constraint for completing :prefix in CONTEXT.
+Optional argument DESIRED-TYPE may be a non-type tag to analyze."
+  (when (semantic-tag-p desired-type)
+    ;; Convert the desired type if needed.
+    (if (not (eq (semantic-tag-class desired-type) 'type))
+       (setq desired-type (semantic-tag-type desired-type)))
+    ;; Protect against plain strings
+    (cond ((stringp desired-type)
+          (setq desired-type (list desired-type 'type)))
+         ((and (stringp (car desired-type))
+               (not (semantic-tag-p desired-type)))
+          (setq desired-type (list (car desired-type) 'type)))
+         ((semantic-tag-p desired-type)
+          ;; We have a tag of some sort.  Yay!
+          nil)
+         (t (setq desired-type nil))
+         )
+    desired-type))
+
+(defmethod semantic-analyze-type-constraint
+  ((context semantic-analyze-context-functionarg))
+  "Return a type constraint for completing :prefix in CONTEXT."
+  (call-next-method context (car (oref context argument))))
+
+(defmethod semantic-analyze-type-constraint
+  ((context semantic-analyze-context-assignment))
+  "Return a type constraint for completing :prefix in CONTEXT."
+  (call-next-method context (car (reverse (oref context assignee)))))
+
+(defmethod semantic-analyze-interesting-tag
+  ((context semantic-analyze-context))
+  "Return a tag from CONTEXT that would be most interesting to a user."
+  (let ((prefix (reverse (oref context :prefix))))
+    ;; Go back through the prefix until we find a tag we can return.
+    (while (and prefix (not (semantic-tag-p (car prefix))))
+      (setq prefix (cdr prefix)))
+    ;; Return the found tag, or nil.
+    (car prefix)))
+
+(defmethod semantic-analyze-interesting-tag
+  ((context semantic-analyze-context-functionarg))
+  "Try the base, and if that fails, return what we are assigning into."
+  (or (call-next-method) (car-safe (oref context :function))))
+
+(defmethod semantic-analyze-interesting-tag
+  ((context semantic-analyze-context-assignment))
+  "Try the base, and if that fails, return what we are assigning into."
+  (or (call-next-method) (car-safe (oref context :assignee))))
+
+;;; ANALYSIS
+;;
+;; Start out with routines that will calculate useful parts of
+;; the general analyzer function.  These could be used directly
+;; by an application that doesn't need to calculate the full
+;; context.
+
+(define-overloadable-function semantic-analyze-find-tag-sequence (sequence &optional
+                                                             scope typereturn throwsym)
+  "Attempt to find all tags in SEQUENCE.
+Optional argument LOCALVAR is the list of local variables to use when
+finding the details on the first element of SEQUENCE in case
+it is not found in the global set of tables.
+Optional argument SCOPE are additional terminals to search which are currently
+scoped.  These are not local variables, but symbols available in a structure
+which doesn't need to be dereferneced.
+Optional argument TYPERETURN is a symbol in which the types of all found
+will be stored.  If nil, that data is thrown away.
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.")
+
+(defun semantic-analyze-find-tag-sequence-default (sequence &optional
+                                                           scope typereturn
+                                                           throwsym)
+  "Attempt to find all tags in SEQUENCE.
+SCOPE are extra tags which are in scope.
+TYPERETURN is a symbol in which to place a list of tag classes that
+are found in SEQUENCE.
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable error."
+  (let ((s sequence)                   ; copy of the sequence
+       (tmp nil)                       ; tmp find variable
+       (tag nil)                       ; tag return list
+       (tagtype nil)                   ; tag types return list
+       (fname nil)
+       (miniscope (clone scope))
+       )
+    ;; First order check.  Is this wholely contained in the typecache?
+    (setq tmp (semanticdb-typecache-find sequence))
+
+    (if tmp
+       (progn
+         ;; We are effectively done...
+         (setq s nil)
+         (setq tag (list tmp)))
+
+      ;; For the first entry, it better be a variable, but it might
+      ;; be in the local context too.
+      ;; NOTE: Don't forget c++ namespace foo::bar.
+      (setq tmp (or
+                ;; Is this tag within our scope.  Scopes can sometimes
+                ;; shadow other things, so it goes first.
+                (and scope (semantic-scope-find (car s) nil scope))
+                ;; Find the tag out there... somewhere, but not in scope
+                (semantic-analyze-find-tag (car s))
+                ))
+
+      (if (and (listp tmp) (semantic-tag-p (car tmp)))
+         (setq tmp (semantic-analyze-select-best-tag tmp)))
+      (if (not (semantic-tag-p tmp))
+         (if throwsym
+             (throw throwsym "Cannot find definition")
+           (error "Cannot find definition for \"%s\"" (car s))))
+      (setq s (cdr s))
+      (setq tag (cons tmp tag)) ; tag is nil here...
+      (setq fname (semantic-tag-file-name tmp))
+      )
+
+    ;; For the middle entries
+    (while s
+      ;; Using the tag found in TMP, lets find the tag
+      ;; representing the full typeographic information of its
+      ;; type, and use that to determine the search context for
+      ;; (car s)
+      (let* ((tmptype
+             ;; In some cases the found TMP is a type,
+             ;; and we can use it directly.
+             (cond ((semantic-tag-of-class-p tmp 'type)
+                    ;; update the miniscope when we need to analyze types directly.
+                    (let ((rawscope
+                           (apply 'append
+                                  (mapcar 'semantic-tag-type-members
+                                          tagtype))))
+                      (oset miniscope fullscope rawscope))
+                    ;; Now analayze the type to remove metatypes.
+                    (or (semantic-analyze-type tmp miniscope)
+                        tmp))
+                   (t
+                    (semantic-analyze-tag-type tmp scope))))
+            (typefile
+             (when tmptype
+               (semantic-tag-file-name tmptype)))
+            (slots nil))
+
+       ;; Get the children
+       (setq slots (semantic-analyze-scoped-type-parts tmptype scope))
+
+       ;; find (car s) in the list o slots
+       (setq tmp (semantic-find-tags-by-name (car s) slots))
+
+       ;; If we have lots
+       (if (and (listp tmp) (semantic-tag-p (car tmp)))
+           (setq tmp (semantic-analyze-select-best-tag tmp)))
+
+       ;; Make sure we have a tag.
+       (if (not (semantic-tag-p tmp))
+           (if (cdr s)
+               ;; In the middle, we need to keep seeking our types out.
+               (error "Cannot find definition for \"%s\"" (car s))
+             ;; Else, it's ok to end with a non-tag
+             (setq tmp (car s))))
+
+       (setq fname (or typefile fname))
+       (when (and fname (semantic-tag-p tmp)
+                  (not (semantic-tag-in-buffer-p tmp)))
+         (semantic--tag-put-property tmp :filename fname))
+       (setq tag (cons tmp tag))
+       (setq tagtype (cons tmptype tagtype))
+       )
+      (setq s (cdr s)))
+
+    (if typereturn (set typereturn (nreverse tagtype)))
+    ;; Return the mess
+    (nreverse tag)))
+
+(defun semantic-analyze-find-tag (name &optional tagclass scope)
+  "Return the first tag found with NAME or nil if not found.
+Optional argument TAGCLASS specifies the class of tag to return, such
+as 'function or 'variable.
+Optional argument SCOPE specifies a scope object which has
+additional tags which are in SCOPE and do not need prefixing to
+find.
+
+This is a wrapper on top of semanticdb, semanticdb-typecache,
+semantic-scope, and semantic search functions.  Almost all
+searches use the same arguments."
+  (let ((namelst (if (consp name) name ;; test if pre-split.
+                  (semantic-analyze-split-name name))))
+    (cond
+     ;; If the splitter gives us a list, use the sequence finder
+     ;; to get the list.  Since this routine is expected to return
+     ;; only one tag, return the LAST tag found from the sequence
+     ;; which is supposedly the nested reference.
+     ;;
+     ;; Of note, the SEQUENCE function below calls this function
+     ;; (recursively now) so the names that we get from the above
+     ;; fcn better not, in turn, be splittable.
+     ((listp namelst)
+      ;; If we had a split, then this is likely a c++ style namespace::name sequence,
+      ;; so take a short-cut through the typecache.
+      (or (semanticdb-typecache-find namelst)
+         ;; Ok, not there, try the usual...
+         (let ((seq (semantic-analyze-find-tag-sequence
+                     namelst scope nil)))
+           (semantic-analyze-select-best-tag seq tagclass)
+           )))
+     ;; If NAME is solo, then do our searches for it here.
+     ((stringp namelst)
+      (let ((retlist (and scope (semantic-scope-find name tagclass scope))))
+       (if retlist
+           (semantic-analyze-select-best-tag
+            retlist tagclass)
+         (if (eq tagclass 'type)
+             (semanticdb-typecache-find name)
+           ;; Search in the typecache.  First entries in a sequence are
+           ;; often there.
+           (setq retlist (semanticdb-typecache-find name))
+           (if retlist
+               retlist
+             (semantic-analyze-select-best-tag
+              (semanticdb-strip-find-results
+               (semanticdb-find-tags-by-name name)
+               'name)
+              tagclass)
+             )))))
+     )))
+
+;;; SHORT ANALYSIS
+;;
+;; Create a mini-analysis of just the symbol under point.
+;;
+(define-overloadable-function semantic-analyze-current-symbol
+  (analyzehookfcn &optional position)
+  "Call ANALYZEHOOKFCN after analyzing the symbol under POSITION.
+The ANALYZEHOOKFCN is called with the current symbol bounds, and the
+analyzed prefix.  It should take the arguments (START END PREFIX).
+The ANALYZEHOOKFCN is only called if some sort of prefix with bounds was
+found under POSITION.
+
+The results of ANALYZEHOOKFCN is returned, or nil if there was nothing to
+call it with.
+
+For regular analysis, you should call `semantic-analyze-current-context'
+to calculate the context information.  The purpose for this function is
+to provide a large number of non-cached analysis for filtering symbols."
+  ;; Only do this in a Semantic enabled buffer.
+  (when (not (semantic-active-p))
+    (error "Cannot analyze buffers not supported by Semantic."))
+  ;; Always refresh out tags in a safe way before doing the
+  ;; context.
+  (semantic-refresh-tags-safe)
+  ;; Do the rest of the analysis.
+  (save-match-data
+    (save-excursion
+      (:override)))
+  )
+
+(defun semantic-analyze-current-symbol-default (analyzehookfcn position)
+  "Call ANALYZEHOOKFCN on the analyzed symbol at POSITION."
+  (let* ((semantic-analyze-error-stack nil)
+        (LLstart (current-time))
+        (prefixandbounds (semantic-ctxt-current-symbol-and-bounds (or position (point))))
+        (prefix (car prefixandbounds))
+        (bounds (nth 2 prefixandbounds))
+        (scope (semantic-calculate-scope position))
+        (end nil)
+        )
+        ;; Only do work if we have bounds (meaning a prefix to complete)
+    (when bounds
+
+      (if debug-on-error
+         (catch 'unfindable
+           ;; If debug on error is on, allow debugging in this fcn.
+           (setq prefix (semantic-analyze-find-tag-sequence
+                         prefix scope 'prefixtypes 'unfindable)))
+       ;; Debug on error is off.  Capture errors and move on
+       (condition-case err
+           ;; NOTE: This line is duplicated in
+           ;;       semantic-analyzer-debug-global-symbol
+           ;;       You will need to update both places.
+           (setq prefix (semantic-analyze-find-tag-sequence
+                         prefix scope 'prefixtypes))
+         (error (semantic-analyze-push-error err))))
+
+      (setq end (current-time))
+      ;;(message "Analysis took %.2f sec" (semantic-elapsed-time LLstart end))
+
+      )
+    (when prefix
+      (prog1
+         (funcall analyzehookfcn (car bounds) (cdr bounds) prefix)
+       ;;(setq end (current-time))
+       ;;(message "hookfcn took %.5f sec" (semantic-elapsed-time LLstart end))
+       )
+
+       )))
+
+;;; MAIN ANALYSIS
+;;
+;; Create a full-up context analysis.
+;;
+(define-overloadable-function semantic-analyze-current-context (&optional position)
+  "Analyze the current context at optional POSITION.
+If called interactively, display interesting information about POSITION
+in a separate buffer.
+Returns an object based on symbol `semantic-analyze-context'.
+
+This function can be overriden with the symbol `analyze-context'.
+When overriding this function, your override will be called while
+cursor is at POSITION.  In addition, your function will not be called
+if a cached copy of the return object is found."
+  (interactive "d")
+  ;; Only do this in a Semantic enabled buffer.
+  (when (not (semantic-active-p))
+    (error "Cannot analyze buffers not supported by Semantic."))
+  ;; Always refresh out tags in a safe way before doing the
+  ;; context.
+  (semantic-refresh-tags-safe)
+  ;; Do the rest of the analysis.
+  (if (not position) (setq position (point)))
+  (save-excursion
+    (goto-char position)
+    (let* ((answer (semantic-get-cache-data 'current-context)))
+      (with-syntax-table semantic-lex-syntax-table
+       (when (not answer)
+         (setq answer (:override))
+         (when (and answer (oref answer bounds))
+           (with-slots (bounds) answer
+             (semantic-cache-data-to-buffer (current-buffer)
+                                            (car bounds)
+                                            (cdr bounds)
+                                            answer
+                                            'current-context
+                                            'exit-cache-zone)))
+         ;; Check for interactivity
+         (when (interactive-p)
+           (if answer
+               (semantic-analyze-pop-to-context answer)
+             (message "No Context."))
+           ))
+
+       answer))))
+
+(defun semantic-analyze-current-context-default (position)
+  "Analyze the current context at POSITION.
+Returns an object based on symbol `semantic-analyze-context'."
+  (let* ((semantic-analyze-error-stack nil)
+        (context-return nil)
+        (prefixandbounds (semantic-ctxt-current-symbol-and-bounds (or position (point))))
+        (prefix (car prefixandbounds))
+        (bounds (nth 2 prefixandbounds))
+        ;; @todo - vv too early to really know this answer! vv
+        (prefixclass (semantic-ctxt-current-class-list))
+        (prefixtypes nil)
+        (scope (semantic-calculate-scope position))
+        (function nil)
+        (fntag nil)
+        arg fntagend argtag
+        assign asstag
+        )
+
+    ;; Pattern for Analysis:
+    ;;
+    ;; Step 1: Calculate DataTypes in Scope:
+    ;;
+    ;;  a) Calculate the scope (above)
+    ;;
+    ;; Step 2: Parse context
+    ;;
+    ;; a) Identify function being called, or variable assignment,
+    ;;    and find source tags for those references
+    ;; b) Identify the prefix (text cursor is on) and find the source
+    ;;    tags for those references.
+    ;;
+    ;; Step 3: Assemble an object
+    ;;
+
+    ;; Step 2 a:
+
+    (setq function (semantic-ctxt-current-function))
+
+    (when function
+      ;; Calculate the argument for the function if there is one.
+      (setq arg (semantic-ctxt-current-argument))
+
+      ;; Find a tag related to the function name.
+      (condition-case err
+         (setq fntag
+               (semantic-analyze-find-tag-sequence function scope))
+       (error (semantic-analyze-push-error err)))
+
+      ;; fntag can have the last entry as just a string, meaning we
+      ;; could not find the core datatype.  In this case, the searches
+      ;; below will not work.
+      (when (stringp (car (last fntag)))
+       ;; Take a wild guess!
+       (setcar (last fntag) (semantic-tag (car (last fntag)) 'function))
+       )
+
+      (when fntag
+       (let ((fcn (semantic-find-tags-by-class 'function fntag)))
+         (when (not fcn)
+           (let ((ty (semantic-find-tags-by-class 'type fntag)))
+             (when ty
+               ;; We might have a constructor with the same name as
+               ;; the found datatype.
+               (setq fcn (semantic-find-tags-by-name
+                          (semantic-tag-name (car ty))
+                          (semantic-tag-type-members (car ty))))
+               (if fcn
+                   (let ((lp fcn))
+                     (while lp
+                       (when (semantic-tag-get-attribute (car lp)
+                                                         :constructor)
+                         (setq fcn (cons (car lp) fcn)))
+                       (setq lp (cdr lp))))
+                 ;; Give up, go old school
+                 (setq fcn fntag))
+               )))
+         (setq fntagend (car (reverse fcn))
+               argtag
+               (when (semantic-tag-p fntagend)
+                 (nth (1- arg) (semantic-tag-function-arguments fntagend)))
+               fntag fcn))))
+
+    ;; Step 2 b:
+
+    ;; Only do work if we have bounds (meaning a prefix to complete)
+    (when bounds
+
+      (if debug-on-error
+         (catch 'unfindable
+           ;; If debug on error is on, allow debugging in this fcn.
+           (setq prefix (semantic-analyze-find-tag-sequence
+                         prefix scope 'prefixtypes 'unfindable)))
+       ;; Debug on error is off.  Capture errors and move on
+       (condition-case err
+           ;; NOTE: This line is duplicated in
+           ;;       semantic-analyzer-debug-global-symbol
+           ;;       You will need to update both places.
+           (setq prefix (semantic-analyze-find-tag-sequence
+                         prefix scope 'prefixtypes))
+         (error (semantic-analyze-push-error err))))
+      )
+
+    ;; Step 3:
+
+    (cond
+     (fntag
+      ;; If we found a tag for our function, we can go into
+      ;; functional context analysis mode, meaning we have a type
+      ;; for the argument.
+      (setq context-return
+           (semantic-analyze-context-functionarg
+            "functionargument"
+            :buffer (current-buffer)
+            :function fntag
+            :index arg
+            :argument (list argtag)
+            :scope scope
+            :prefix prefix
+            :prefixclass prefixclass
+            :bounds bounds
+            :prefixtypes prefixtypes
+            :errors semantic-analyze-error-stack)))
+
+      ;; No function, try assignment
+     ((and (setq assign (semantic-ctxt-current-assignment))
+          ;; We have some sort of an assignment
+          (condition-case err
+              (setq asstag (semantic-analyze-find-tag-sequence
+                            assign scope))
+            (error (semantic-analyze-push-error err)
+                   nil)))
+
+      (setq context-return
+           (semantic-analyze-context-assignment
+            "assignment"
+            :buffer (current-buffer)
+            :assignee asstag
+            :scope scope
+            :bounds bounds
+            :prefix prefix
+            :prefixclass prefixclass
+            :prefixtypes prefixtypes
+            :errors semantic-analyze-error-stack)))
+
+     ;; TODO: Identify return value condition.
+     ;;((setq return .... what to do?)
+     ;;  ...)
+
+     (bounds
+      ;; Nothing in particular
+      (setq context-return
+           (semantic-analyze-context
+            "context"
+            :buffer (current-buffer)
+            :scope scope
+            :bounds bounds
+            :prefix prefix
+            :prefixclass prefixclass
+            :prefixtypes prefixtypes
+            :errors semantic-analyze-error-stack)))
+
+     (t (setq context-return nil))
+     )
+
+    ;; Return our context.
+    context-return))
+
+\f
+;;; DEBUG OUTPUT
+;;
+;; Friendly output of a context analysis.
+;;
+(defmethod semantic-analyze-pulse ((context semantic-analyze-context))
+  "Pulse the region that CONTEXT affects."
+  (save-excursion
+    (set-buffer (oref context :buffer))
+    (let ((bounds (oref context :bounds)))
+      (when bounds
+       (pulse-momentary-highlight-region (car bounds) (cdr bounds))))))
+
+(defcustom semantic-analyze-summary-function 'semantic-format-tag-prototype
+  "*Function to use when creating items in Imenu.
+Some useful functions are found in `semantic-format-tag-functions'."
+  :group 'semantic
+  :type semantic-format-tag-custom-list)
+
+(defun semantic-analyze-princ-sequence (sequence &optional prefix buff)
+  "Send the tag SEQUENCE to standard out.
+Use PREFIX as a label.
+Use BUFF as a source of override methods."
+  (while sequence
+      (princ prefix)
+      (cond
+       ((semantic-tag-p (car sequence))
+       (princ (funcall semantic-analyze-summary-function
+                       (car sequence))))
+       ((stringp (car sequence))
+       (princ "\"")
+       (princ (semantic--format-colorize-text (car sequence) 'variable))
+       (princ "\""))
+       (t
+       (princ (format "'%S" (car sequence)))))
+      (princ "\n")
+      (setq sequence (cdr sequence))
+      (setq prefix (make-string (length prefix) ? ))
+      ))
+
+(defmethod semantic-analyze-show ((context semantic-analyze-context))
+  "Insert CONTEXT into the current buffer in a nice way."
+  (semantic-analyze-princ-sequence (oref context prefix) "Prefix: " )
+  (semantic-analyze-princ-sequence (oref context prefixclass) "Prefix Classes: ")
+  (semantic-analyze-princ-sequence (oref context prefixtypes) "Prefix Types: ")
+  (semantic-analyze-princ-sequence (oref context errors) "Encountered Errors: ")
+  (princ "--------\n")
+  ;(semantic-analyze-princ-sequence (oref context scopetypes) "Scope Types: ")
+  ;(semantic-analyze-princ-sequence (oref context scope) "Scope: ")
+  ;(semantic-analyze-princ-sequence (oref context localvariables) "LocalVars: ")
+  (when (oref context scope)
+    (semantic-analyze-show (oref context scope)))
+  )
+
+(defmethod semantic-analyze-show ((context semantic-analyze-context-assignment))
+  "Insert CONTEXT into the current buffer in a nice way."
+  (semantic-analyze-princ-sequence (oref context assignee) "Assignee: ")
+  (call-next-method))
+
+(defmethod semantic-analyze-show ((context semantic-analyze-context-functionarg))
+  "Insert CONTEXT into the current buffer in a nice way."
+  (semantic-analyze-princ-sequence (oref context function) "Function: ")
+  (princ "Argument Index: ")
+  (princ (oref context index))
+  (princ "\n")
+  (semantic-analyze-princ-sequence (oref context argument) "Argument: ")
+  (call-next-method))
+
+(defun semantic-analyze-pop-to-context (context)
+  "Display CONTEXT in a temporary buffer.
+CONTEXT's content is described in `semantic-analyze-current-context'."
+  (semantic-analyze-pulse context)
+  (with-output-to-temp-buffer "*Semantic Context Analysis*"
+    (princ "Context Type: ")
+    (princ (object-name context))
+    (princ "\n")
+    (princ "Bounds: ")
+    (princ (oref context bounds))
+    (princ "\n")
+    (semantic-analyze-show context)
+    )
+  (shrink-window-if-larger-than-buffer
+   (get-buffer-window "*Semantic Context Analysis*"))
+  )
+
+(provide 'semantic/analyze)
+
+;;; semantic-analyze.el ends here
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
new file mode 100644 (file)
index 0000000..d1367e3
--- /dev/null
@@ -0,0 +1,2128 @@
+;;; complete.el --- Routines for performing tag completion
+
+;;; Copyright (C) 2003, 2004, 2005, 2007, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Keywords: syntax
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Completion of tags by name using tables of semantic generated tags.
+;;
+;; While it would be a simple matter of flattening all tag known
+;; tables to perform completion across them using `all-completions',
+;; or `try-completion', that process would be slow.  In particular,
+;; when a system database is included in the mix, the potential for a
+;; ludicrous number of options becomes apparent.
+;;
+;; As such, dynamically searching across tables using a prefix,
+;; regular expression, or other feature is needed to help find symbols
+;; quickly without resorting to "show me every possible option now".
+;;
+;; In addition, some symbol names will appear in multiple locations.
+;; If it is important to distiguish, then a way to provide a choice
+;; over these locations is important as well.
+;;
+;; Beyond brute force offers for completion of plain strings,
+;; using the smarts of semantic-analyze to provide reduced lists of
+;; symbols, or fancy tabbing to zoom into files to show multiple hits
+;; of the same name can be provided.
+;;
+;;; How it works:
+;;
+;; There are several parts of any completion engine.  They are:
+;;
+;; A.  Collection of possible hits
+;; B.  Typing or selecting an option
+;; C.  Displaying possible unique completions
+;; D.  Using the result
+;;
+;; Here, we will treat each section separately (excluding D)
+;; They can then be strung together in user-visible commands to
+;; fullfill specific needs.
+;;
+;; COLLECTORS:
+;;
+;; A collector is an object which represents the means by which tags
+;; to complete on are collected.  It's first job is to find all the
+;; tags which are to be completed against.  It can also rename
+;; some tags if needed so long as `semantic-tag-clone' is used.
+;;
+;; Some collectors will gather all tags to complete against first
+;; (for in buffer queries, or other small list situations).  It may
+;; choose to do a broad search on each completion request.  Built in
+;; functionality automatically focuses the cache in as the user types.
+;;
+;; A collector choosing to create and rename tags could choose a
+;; plain name format, a postfix name such as method:class, or a
+;; prefix name such as class.method.
+;;
+;; DISPLAYORS
+;;
+;; A displayor is in charge if showing the user interesting things
+;; about available completions, and can optionally provide a focus.
+;; The simplest display just lists all available names in a separate
+;; window.  It may even choose to show short names when there are
+;; many to choose from, or long names when there are fewer.
+;;
+;; A complex displayor could opt to help the user 'focus' on some
+;; range.  For example, if 4 tags all have the same name, subsequent
+;; calls to the displayor may opt to show each tag one at a time in
+;; the buffer.  When the user likes one, selection would cause the
+;; 'focus' item to be selected.
+;;
+;; CACHE FORMAT
+;;
+;; The format of the tag lists used to perform the completions are in
+;; semanticdb "find" format, like this:
+;;
+;; ( ( DBTABLE1 TAG1 TAG2 ...)
+;;   ( DBTABLE2 TAG1 TAG2 ...)
+;;   ... )
+;;
+;; INLINE vs MINIBUFFER
+;;
+;; Two major ways completion is used in Emacs is either through a
+;; minibuffer query, or via completion in a normal editing buffer,
+;; encompassing some small range of characters.
+;;
+;; Structure for both types of completion are provided here.
+;; `semantic-complete-read-tag-engine' will use the minibuffer.
+;; `semantic-complete-inline-tag-engine' will complete text in
+;; a buffer.
+
+(require 'eieio)
+(require 'semantic/tag)
+(require 'semantic/find)
+(require 'semantic/analyze)
+(require 'semantic/format)
+(require 'semantic/ctxt)
+;; Keep semanticdb optional.
+(eval-when-compile
+  (require 'semantic/db)
+  (require 'semantic/db-find))
+
+(eval-when-compile
+  (condition-case nil
+      ;; Tooltip not available in older emacsen.
+      (require 'tooltip)
+    (error nil))
+  )
+
+;;; Code:
+
+;;; Compatibility
+;;
+(if (fboundp 'minibuffer-contents)
+    (eval-and-compile (defalias 'semantic-minibuffer-contents 'minibuffer-contents))
+  (eval-and-compile (defalias 'semantic-minibuffer-contents 'buffer-string)))
+(if (fboundp 'delete-minibuffer-contents)
+    (eval-and-compile (defalias 'semantic-delete-minibuffer-contents 'delete-minibuffer-contents))
+  (eval-and-compile (defalias 'semantic-delete-minibuffer-contents 'erase-buffer)))
+
+(defvar semantic-complete-inline-overlay nil
+  "The overlay currently active while completing inline.")
+
+(defun semantic-completion-inline-active-p ()
+  "Non-nil if inline completion is active."
+  (when (and semantic-complete-inline-overlay
+            (not (semantic-overlay-live-p semantic-complete-inline-overlay)))
+    (semantic-overlay-delete semantic-complete-inline-overlay)
+    (setq semantic-complete-inline-overlay nil))
+  semantic-complete-inline-overlay)
+
+;;; ------------------------------------------------------------
+;;; MINIBUFFER or INLINE utils
+;;
+(defun semantic-completion-text ()
+  "Return the text that is currently in the completion buffer.
+For a minibuffer prompt, this is the minibuffer text.
+For inline completion, this is the text wrapped in the inline completion
+overlay."
+  (if semantic-complete-inline-overlay
+      (semantic-complete-inline-text)
+    (semantic-minibuffer-contents)))
+
+(defun semantic-completion-delete-text ()
+  "Delete the text that is actively being completed.
+Presumably if you call this you will insert something new there."
+  (if semantic-complete-inline-overlay
+      (semantic-complete-inline-delete-text)
+    (semantic-delete-minibuffer-contents)))
+
+(defun semantic-completion-message (fmt &rest args)
+  "Display the string FMT formatted with ARGS at the end of the minibuffer."
+  (if semantic-complete-inline-overlay
+      (apply 'message fmt args)
+    (message (concat (buffer-string) (apply 'format fmt args)))))
+
+;;; ------------------------------------------------------------
+;;; MINIBUFFER: Option Selection harnesses
+;;
+(defvar semantic-completion-collector-engine nil
+  "The tag collector for the current completion operation.
+Value should be an object of a subclass of
+`semantic-completion-engine-abstract'.")
+
+(defvar semantic-completion-display-engine nil
+  "The tag display engine for the current completion operation.
+Value should be a ... what?")
+
+(defvar semantic-complete-key-map
+  (let ((km (make-sparse-keymap)))
+    (define-key km " " 'semantic-complete-complete-space)
+    (define-key km "\t" 'semantic-complete-complete-tab)
+    (define-key km "\C-m" 'semantic-complete-done)
+    (define-key km "\C-g" 'abort-recursive-edit)
+    (define-key km "\M-n" 'next-history-element)
+    (define-key km "\M-p" 'previous-history-element)
+    (define-key km "\C-n" 'next-history-element)
+    (define-key km "\C-p" 'previous-history-element)
+    ;; Add history navigation
+    km)
+  "Keymap used while completing across a list of tags.")
+
+(defvar semantic-completion-default-history nil
+  "Default history variable for any unhistoried prompt.
+Keeps STRINGS only in the history.")
+
+
+(defun semantic-complete-read-tag-engine (collector displayor prompt
+                                                   default-tag initial-input
+                                                   history)
+  "Read a semantic tag, and return a tag for the selection.
+Argument COLLECTOR is an object which can be used to to calculate
+a list of possible hits.  See `semantic-completion-collector-engine'
+for details on COLLECTOR.
+Argumeng DISPLAYOR is an object used to display a list of possible
+completions for a given prefix.  See`semantic-completion-display-engine'
+for details on DISPLAYOR.
+PROMPT is a string to prompt with.
+DEFAULT-TAG is a semantic tag or string to use as the default value.
+If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
+HISTORY is a symbol representing a variable to story the history in."
+  (let* ((semantic-completion-collector-engine collector)
+        (semantic-completion-display-engine displayor)
+        (semantic-complete-active-default nil)
+        (semantic-complete-current-matched-tag nil)
+        (default-as-tag (semantic-complete-default-to-tag default-tag))
+        (default-as-string (when (semantic-tag-p default-as-tag)
+                             (semantic-tag-name default-as-tag)))
+        )
+
+    (when default-as-string
+      ;; Add this to the prompt.
+      ;;
+      ;; I really want to add a lookup of the symbol in those
+      ;; tags available to the collector and only add it if it
+      ;; is available as a possibility, but I'm too lazy right
+      ;; now.
+      ;;
+
+      ;; @todo - move from () to into the editable area
+      (if (string-match ":" prompt)
+         (setq prompt (concat
+                       (substring prompt 0 (match-beginning 0))
+                       " (" default-as-string ")"
+                       (substring prompt (match-beginning 0))))
+       (setq prompt (concat prompt " (" default-as-string "): "))))
+    ;;
+    ;; Perform the Completion
+    ;;
+    (unwind-protect
+       (read-from-minibuffer prompt
+                             initial-input
+                             semantic-complete-key-map
+                             nil
+                             (or history
+                                 'semantic-completion-default-history)
+                             default-tag)
+      (semantic-collector-cleanup semantic-completion-collector-engine)
+      (semantic-displayor-cleanup semantic-completion-display-engine)
+      )
+    ;;
+    ;; Extract the tag from the completion machinery.
+    ;;
+    semantic-complete-current-matched-tag
+    ))
+
+\f
+;;; Util for basic completion prompts
+;;
+
+(defvar semantic-complete-active-default nil
+  "The current default tag calculated for this prompt.")
+
+(defun semantic-complete-default-to-tag (default)
+  "Convert a calculated or passed in DEFAULT into a tag."
+  (if (semantic-tag-p default)
+      ;; Just return what was passed in.
+      (setq semantic-complete-active-default default)
+    ;; If none was passed in, guess.
+    (if (null default)
+       (setq default (semantic-ctxt-current-thing)))
+    (if (null default)
+       ;; Do nothing
+       nil
+      ;; Turn default into something useful.
+      (let ((str
+            (cond
+             ;; Semantic-ctxt-current-symbol will return a list of
+             ;; strings.  Technically, we should use the analyzer to
+             ;; fully extract what we need, but for now, just grab the
+             ;; first string
+             ((and (listp default) (stringp (car default)))
+              (car default))
+             ((stringp default)
+              default)
+             ((symbolp default)
+              (symbol-name default))
+             (t
+              (signal 'wrong-type-argument
+                      (list default 'semantic-tag-p)))))
+           (tag nil))
+       ;; Now that we have that symbol string, look it up using the active
+       ;; collector.  If we get a match, use it.
+       (save-excursion
+         (semantic-collector-calculate-completions
+          semantic-completion-collector-engine
+          str nil))
+       ;; Do we have the perfect match???
+       (let ((ml (semantic-collector-current-exact-match
+                  semantic-completion-collector-engine)))
+         (when ml
+           ;; We don't care about uniqueness.  Just guess for convenience
+           (setq tag (semanticdb-find-result-nth-in-buffer ml 0))))
+       ;; save it
+       (setq semantic-complete-active-default tag)
+       ;; Return it.. .whatever it may be
+       tag))))
+
+\f
+;;; Prompt Return Value
+;;
+;; Getting a return value out of this completion prompt is a bit
+;; challenging.  The read command returns the string typed in.
+;; We need to convert this into a valid tag.  We can exit the minibuffer
+;; for different reasons.  If we purposely exit, we must make sure
+;; the focused tag is calculated... preferably once.
+(defvar semantic-complete-current-matched-tag nil
+  "Variable used to pass the tags being matched to the prompt.")
+
+(defun semantic-complete-current-match ()
+  "Calculate a match from the current completion environment.
+Save this in our completion variable.  Make sure that variable
+is cleared if any other keypress is made.
+Return value can be:
+  tag - a single tag that has been matched.
+  string - a message to show in the minibuffer."
+  ;; Query the environment for an active completion.
+  (let ((collector semantic-completion-collector-engine)
+       (displayor semantic-completion-display-engine)
+       (contents (semantic-completion-text))
+       matchlist
+       answer)
+    (if (string= contents "")
+       ;; The user wants the defaults!
+       (setq answer semantic-complete-active-default)
+      ;; This forces a full calculation of completion on CR.
+      (save-excursion
+       (semantic-collector-calculate-completions collector contents nil))
+      (semantic-complete-try-completion)
+      (cond
+       ;; Input match displayor focus entry
+       ((setq answer (semantic-displayor-current-focus displayor))
+       ;; We have answer, continue
+       )
+       ;; One match from the collector
+       ((setq matchlist (semantic-collector-current-exact-match collector))
+       (if (= (semanticdb-find-result-length matchlist) 1)
+           (setq answer (semanticdb-find-result-nth-in-buffer matchlist 0))
+         (if (semantic-displayor-focus-abstract-child-p displayor)
+             ;; For focusing displayors, we can claim this is
+             ;; not unique.  Multiple focuses can choose the correct
+             ;; one.
+             (setq answer "Not Unique")
+           ;; If we don't have a focusing displayor, we need to do something
+           ;; graceful.  First, see if all the matches have the same name.
+           (let ((allsame t)
+                 (firstname (semantic-tag-name
+                             (car
+                              (semanticdb-find-result-nth matchlist 0)))
+                            )
+                 (cnt 1)
+                 (max (semanticdb-find-result-length matchlist)))
+             (while (and allsame (< cnt max))
+               (if (not (string=
+                         firstname
+                         (semantic-tag-name
+                          (car
+                           (semanticdb-find-result-nth matchlist cnt)))))
+                   (setq allsame nil))
+               (setq cnt (1+ cnt))
+               )
+             ;; Now we know if they are all the same.  If they are, just
+             ;; accept the first, otherwise complain.
+             (if allsame
+                 (setq answer (semanticdb-find-result-nth-in-buffer
+                               matchlist 0))
+               (setq answer "Not Unique"))
+             ))))
+       ;; No match
+       (t
+       (setq answer "No Match")))
+      )
+    ;; Set it into our completion target.
+    (when (semantic-tag-p answer)
+      (setq semantic-complete-current-matched-tag answer)
+      ;; Make sure it is up to date by clearing it if the user dares
+      ;; to touch the keyboard.
+      (add-hook 'pre-command-hook
+               (lambda () (setq semantic-complete-current-matched-tag nil)))
+      )
+    ;; Return it
+    answer
+    ))
+
+\f
+;;; Keybindings
+;;
+;; Keys are bound to to perform completion using our mechanisms.
+;; Do that work here.
+(defun semantic-complete-done ()
+  "Accept the current input."
+  (interactive)
+  (let ((ans (semantic-complete-current-match)))
+    (if (stringp ans)
+       (semantic-completion-message (concat " [" ans "]"))
+      (exit-minibuffer)))
+  )
+
+(defun semantic-complete-complete-space ()
+  "Complete the partial input in the minibuffer."
+  (interactive)
+  (semantic-complete-do-completion t))
+
+(defun semantic-complete-complete-tab ()
+  "Complete the partial input in the minibuffer as far as possible."
+  (interactive)
+  (semantic-complete-do-completion))
+
+;;; Completion Functions
+;;
+;; Thees routines are functional entry points to performing completion.
+;;
+(defun semantic-complete-hack-word-boundaries (original new)
+  "Return a string to use for completion.
+ORIGINAL is the text in the minibuffer.
+NEW is the new text to insert into the minibuffer.
+Within the difference bounds of ORIGINAL and NEW, shorten NEW
+to the nearest word boundary, and return that."
+  (save-match-data
+    (let* ((diff (substring new (length original)))
+          (end (string-match "\\>" diff))
+          (start (string-match "\\<" diff)))
+      (cond
+       ((and start (> start 0))
+       ;; If start is greater than 0, include only the new
+       ;; white-space stuff
+       (concat original (substring diff 0 start)))
+       (end
+       (concat original (substring diff 0 end)))
+       (t new)))))
+
+(defun semantic-complete-try-completion (&optional partial)
+  "Try a completion for the current minibuffer.
+If PARTIAL, do partial completion stopping at spaces."
+  (let ((comp (semantic-collector-try-completion
+               semantic-completion-collector-engine
+              (semantic-completion-text))))
+    (cond
+     ((null comp)
+      (semantic-completion-message " [No Match]")
+      (ding)
+      )
+     ((stringp comp)
+      (if (string= (semantic-completion-text) comp)
+         (when partial
+           ;; Minibuffer isn't changing AND the text is not unique.
+           ;; Test for partial completion over a word separator character.
+           ;; If there is one available, use that so that SPC can
+           ;; act like a SPC insert key.
+           (let ((newcomp (semantic-collector-current-whitespace-completion
+                           semantic-completion-collector-engine)))
+             (when newcomp
+               (semantic-completion-delete-text)
+               (insert newcomp))
+             ))
+       (when partial
+         (let ((orig (semantic-completion-text)))
+           ;; For partial completion, we stop and step over
+           ;; word boundaries.  Use this nifty function to do
+           ;; that calculation for us.
+           (setq comp
+                 (semantic-complete-hack-word-boundaries orig comp))))
+       ;; Do the replacement.
+       (semantic-completion-delete-text)
+        (insert comp))
+      )
+     ((and (listp comp) (semantic-tag-p (car comp)))
+      (unless (string= (semantic-completion-text)
+                      (semantic-tag-name (car comp)))
+        ;; A fully unique completion was available.
+        (semantic-completion-delete-text)
+        (insert (semantic-tag-name (car comp))))
+      ;; The match is complete
+      (if (= (length comp) 1)
+          (semantic-completion-message " [Complete]")
+        (semantic-completion-message " [Complete, but not unique]"))
+      )
+     (t nil))))
+
+(defun semantic-complete-do-completion (&optional partial inline)
+  "Do a completion for the current minibuffer.
+If PARTIAL, do partial completion stopping at spaces.
+if INLINE, then completion is happening inline in a buffer."
+  (let* ((collector semantic-completion-collector-engine)
+        (displayor semantic-completion-display-engine)
+        (contents (semantic-completion-text))
+        (ans nil))
+
+    (save-excursion
+      (semantic-collector-calculate-completions collector contents partial))
+    (let* ((na (semantic-complete-next-action partial)))
+      (cond
+       ;; We're all done, but only from a very specific
+       ;; area of completion.
+       ((eq na 'done)
+       (semantic-completion-message " [Complete]")
+       (setq ans 'done))
+       ;; Perform completion
+       ((or (eq na 'complete)
+           (eq na 'complete-whitespace))
+       (semantic-complete-try-completion partial)
+       (setq ans 'complete))
+       ;; We need to display the completions.
+       ;; Set the completions into the display engine
+       ((or (eq na 'display) (eq na 'displayend))
+       (semantic-displayor-set-completions
+        displayor
+        (or
+         (and (not (eq na 'displayend))
+              (semantic-collector-current-exact-match collector))
+         (semantic-collector-all-completions collector contents))
+        contents)
+       ;; Ask the displayor to display them.
+       (semantic-displayor-show-request displayor))
+       ((eq na 'scroll)
+       (semantic-displayor-scroll-request displayor)
+       )
+       ((eq na 'focus)
+       (semantic-displayor-focus-next displayor)
+       (semantic-displayor-focus-request displayor)
+       )
+       ((eq na 'empty)
+       (semantic-completion-message " [No Match]"))
+       (t nil)))
+    ans))
+
+\f
+;;; ------------------------------------------------------------
+;;; INLINE: tag completion harness
+;;
+;; Unlike the minibuffer, there is no mode nor other traditional
+;; means of reading user commands in completion mode.  Instead
+;; we use a pre-command-hook to inset in our commands, and to
+;; push ourselves out of this mode on alternate keypresses.
+(defvar semantic-complete-inline-map
+  (let ((km (make-sparse-keymap)))
+    (define-key km "\C-i" 'semantic-complete-inline-TAB)
+    (define-key km "\M-p" 'semantic-complete-inline-up)
+    (define-key km "\M-n" 'semantic-complete-inline-down)
+    (define-key km "\C-m" 'semantic-complete-inline-done)
+    (define-key km "\C-\M-c" 'semantic-complete-inline-exit)
+    (define-key km "\C-g" 'semantic-complete-inline-quit)
+    (define-key km "?"
+      (lambda () (interactive)
+       (describe-variable 'semantic-complete-inline-map)))
+    km)
+  "Keymap used while performing Semantic inline completion.
+\\{semantic-complete-inline-map}")
+
+(defface semantic-complete-inline-face
+  '((((class color) (background dark))
+     (:underline "yellow"))
+    (((class color) (background light))
+     (:underline "brown")))
+  "*Face used to show the region being completed inline.
+The face is used in `semantic-complete-inline-tag-engine'."
+  :group 'semantic-faces)
+
+(defun semantic-complete-inline-text ()
+  "Return the text that is being completed inline.
+Similar to `minibuffer-contents' when completing in the minibuffer."
+  (let ((s (semantic-overlay-start semantic-complete-inline-overlay))
+       (e (semantic-overlay-end semantic-complete-inline-overlay)))
+    (if (= s e)
+       ""
+      (buffer-substring-no-properties s e ))))
+
+(defun semantic-complete-inline-delete-text ()
+  "Delete the text currently being completed in the current buffer."
+  (delete-region
+   (semantic-overlay-start semantic-complete-inline-overlay)
+   (semantic-overlay-end semantic-complete-inline-overlay)))
+
+(defun semantic-complete-inline-done ()
+  "This completion thing is DONE, OR, insert a newline."
+  (interactive)
+  (let* ((displayor semantic-completion-display-engine)
+        (tag (semantic-displayor-current-focus displayor)))
+    (if tag
+       (let ((txt (semantic-completion-text)))
+         (insert (substring (semantic-tag-name tag)
+                            (length txt)))
+         (semantic-complete-inline-exit))
+
+      ;; Get whatever binding RET usually has.
+      (let ((fcn
+            (condition-case nil
+                (lookup-key (current-active-maps) (this-command-keys))
+              (error
+               ;; I don't know why, but for some reason the above
+               ;; throws an error sometimes.
+               (lookup-key (current-global-map) (this-command-keys))
+               ))))
+       (when fcn
+         (funcall fcn)))
+      )))
+
+(defun semantic-complete-inline-quit ()
+  "Quit an inline edit."
+  (interactive)
+  (semantic-complete-inline-exit)
+  (keyboard-quit))
+
+(defun semantic-complete-inline-exit ()
+  "Exit inline completion mode."
+  (interactive)
+  ;; Remove this hook FIRST!
+  (remove-hook 'pre-command-hook 'semantic-complete-pre-command-hook)
+
+  (condition-case nil
+      (progn
+       (when semantic-completion-collector-engine
+         (semantic-collector-cleanup semantic-completion-collector-engine))
+       (when semantic-completion-display-engine
+         (semantic-displayor-cleanup semantic-completion-display-engine))
+
+       (when semantic-complete-inline-overlay
+         (let ((wc (semantic-overlay-get semantic-complete-inline-overlay
+                                         'window-config-start))
+               (buf (semantic-overlay-buffer semantic-complete-inline-overlay))
+               )
+           (semantic-overlay-delete semantic-complete-inline-overlay)
+           (setq semantic-complete-inline-overlay nil)
+           ;; DONT restore the window configuration if we just
+           ;; switched windows!
+           (when (eq buf (current-buffer))
+             (set-window-configuration wc))
+           ))
+
+       (setq semantic-completion-collector-engine nil
+             semantic-completion-display-engine nil))
+    (error nil))
+
+  ;; Remove this hook LAST!!!
+  ;; This will force us back through this function if there was
+  ;; some sort of error above.
+  (remove-hook 'post-command-hook 'semantic-complete-post-command-hook)
+
+  ;;(message "Exiting inline completion.")
+  )
+
+(defun semantic-complete-pre-command-hook ()
+  "Used to redefine what commands are being run while completing.
+When installed as a `pre-command-hook' the special keymap
+`semantic-complete-inline-map' is queried to replace commands normally run.
+Commands which edit what is in the region of interest operate normally.
+Commands which would take us out of the region of interest, or our
+quit hook, will exit this completion mode."
+  (let ((fcn (lookup-key semantic-complete-inline-map
+                        (this-command-keys) nil)))
+    (cond ((commandp fcn)
+          (setq this-command fcn))
+         (t nil)))
+  )
+
+(defun semantic-complete-post-command-hook ()
+  "Used to determine if we need to exit inline completion mode.
+If completion mode is active, check to see if we are within
+the bounds of `semantic-complete-inline-overlay', or within
+a reasonable distance."
+  (condition-case nil
+      ;; Exit if something bad happened.
+      (if (not semantic-complete-inline-overlay)
+         (progn
+           ;;(message "Inline Hook installed, but overlay deleted.")
+           (semantic-complete-inline-exit))
+       ;; Exit if commands caused us to exit the area of interest
+       (let ((s (semantic-overlay-start semantic-complete-inline-overlay))
+             (e (semantic-overlay-end semantic-complete-inline-overlay))
+             (b (semantic-overlay-buffer semantic-complete-inline-overlay))
+             (txt nil)
+             )
+         (cond
+          ;; EXIT when we are no longer in a good place.
+          ((or (not (eq b (current-buffer)))
+               (< (point) s)
+               (> (point) e))
+           ;;(message "Exit: %S %S %S" s e (point))
+           (semantic-complete-inline-exit)
+           )
+          ;; Exit if the user typed in a character that is not part
+          ;; of the symbol being completed.
+          ((and (setq txt (semantic-completion-text))
+                (not (string= txt ""))
+                (and (/= (point) s)
+                     (save-excursion
+                       (forward-char -1)
+                       (not (looking-at "\\(\\w\\|\\s_\\)")))))
+           ;;(message "Non symbol character.")
+           (semantic-complete-inline-exit))
+          ((lookup-key semantic-complete-inline-map
+                       (this-command-keys) nil)
+           ;; If the last command was one of our completion commands,
+           ;; then do nothing.
+           nil
+           )
+          (t
+           ;; Else, show completions now
+           (semantic-complete-inline-force-display)
+
+           ))))
+    ;; If something goes terribly wrong, clean up after ourselves.
+    (error (semantic-complete-inline-exit))))
+
+(defun semantic-complete-inline-force-display ()
+  "Force the display of whatever the current completions are.
+DO NOT CALL THIS IF THE INLINE COMPLETION ENGINE IS NOT ACTIVE."
+  (condition-case e
+      (save-excursion
+       (let ((collector semantic-completion-collector-engine)
+             (displayor semantic-completion-display-engine)
+             (contents (semantic-completion-text)))
+         (when collector
+           (semantic-collector-calculate-completions
+            collector contents nil)
+           (semantic-displayor-set-completions
+            displayor
+            (semantic-collector-all-completions collector contents)
+            contents)
+           ;; Ask the displayor to display them.
+           (semantic-displayor-show-request displayor))
+         ))
+    (error (message "Bug Showing Completions: %S" e))))
+
+(defun semantic-complete-inline-tag-engine
+  (collector displayor buffer start end)
+  "Perform completion based on semantic tags in a buffer.
+Argument COLLECTOR is an object which can be used to to calculate
+a list of possible hits.  See `semantic-completion-collector-engine'
+for details on COLLECTOR.
+Argumeng DISPLAYOR is an object used to display a list of possible
+completions for a given prefix.  See`semantic-completion-display-engine'
+for details on DISPLAYOR.
+BUFFER is the buffer in which completion will take place.
+START is a location for the start of the full symbol.
+If the symbol being completed is \"foo.ba\", then START
+is on the \"f\" character.
+END is at the end of the current symbol being completed."
+  ;; Set us up for doing completion
+  (setq semantic-completion-collector-engine collector
+       semantic-completion-display-engine displayor)
+  ;; Create an overlay
+  (setq semantic-complete-inline-overlay
+       (semantic-make-overlay start end buffer nil t))
+  (semantic-overlay-put semantic-complete-inline-overlay
+                       'face
+                       'semantic-complete-inline-face)
+  (semantic-overlay-put semantic-complete-inline-overlay
+                       'window-config-start
+                       (current-window-configuration))
+  ;; Install our command hooks
+  (add-hook 'pre-command-hook 'semantic-complete-pre-command-hook)
+  (add-hook 'post-command-hook 'semantic-complete-post-command-hook)
+  ;; Go!
+  (semantic-complete-inline-force-display)
+  )
+
+;;; Inline Completion Keymap Functions
+;;
+(defun semantic-complete-inline-TAB ()
+  "Perform inline completion."
+  (interactive)
+  (let ((cmpl (semantic-complete-do-completion nil t)))
+    (cond
+     ((eq cmpl 'complete)
+      (semantic-complete-inline-force-display))
+     ((eq cmpl 'done)
+      (semantic-complete-inline-done))
+     ))
+  )
+
+(defun semantic-complete-inline-down()
+  "Focus forwards through the displayor."
+  (interactive)
+  (let ((displayor semantic-completion-display-engine))
+    (semantic-displayor-focus-next    displayor)
+    (semantic-displayor-focus-request displayor)
+    ))
+
+(defun semantic-complete-inline-up ()
+  "Focus backwards through the displayor."
+  (interactive)
+  (let ((displayor semantic-completion-display-engine))
+    (semantic-displayor-focus-previous displayor)
+    (semantic-displayor-focus-request  displayor)
+    ))
+
+\f
+;;; ------------------------------------------------------------
+;;; Interactions between collection and displaying
+;;
+;; Functional routines used to help collectors communicate with
+;; the current displayor, or for the previous section.
+
+(defun semantic-complete-next-action (partial)
+  "Determine what the next completion action should be.
+PARTIAL is non-nil if we are doing partial completion.
+First, the collector can determine if we should perform a completion or not.
+If there is nothing to complete, then the displayor determines if we are
+to show a completion list, scroll, or perhaps do a focus (if it is capable.)
+Expected return values are:
+  done -> We have a singular match
+  empty -> There are no matches to the current text
+  complete -> Perform a completion action
+  complete-whitespace -> Complete next whitespace type character.
+  display -> Show the list of completions
+  scroll -> The completions have been shown, and the user keeps hitting
+            the complete button.  If possible, scroll the completions
+  focus -> The displayor knows how to shift focus among possible completions.
+           Let it do that.
+  displayend -> Whatever options the displayor had for repeating options, there
+           are none left.  Try something new."
+  (let ((ans1 (semantic-collector-next-action
+               semantic-completion-collector-engine
+               partial))
+       (ans2 (semantic-displayor-next-action
+               semantic-completion-display-engine))
+       )
+    (cond
+     ;; No collector answer, use displayor answer.
+     ((not ans1)
+      ans2)
+     ;; Displayor selection of 'scroll, 'display, or 'focus trumps
+     ;; 'done
+     ((and (eq ans1 'done) ans2)
+      ans2)
+     ;; Use ans1 when we have it.
+     (t
+      ans1))))
+
+
+\f
+;;; ------------------------------------------------------------
+;;; Collection Engines
+;;
+;; Collection engines can scan tags from the current environment and
+;; provide lists of possible completions.
+;;
+;; General features of the abstract collector:
+;; * Cache completion lists between uses
+;; * Cache itself per buffer.  Handle reparse hooks
+;;
+;; Key Interface Functions to implement:
+;; * semantic-collector-next-action
+;; * semantic-collector-calculate-completions
+;; * semantic-collector-try-completion
+;; * semantic-collector-all-completions
+
+(defvar semantic-collector-per-buffer-list nil
+  "List of collectors active in this buffer.")
+(make-variable-buffer-local 'semantic-collector-per-buffer-list)
+
+(defvar semantic-collector-list nil
+  "List of global collectors active this session.")
+
+(defclass semantic-collector-abstract ()
+  ((buffer :initarg :buffer
+          :type buffer
+          :documentation "Originating buffer for this collector.
+Some collectors use a given buffer as a starting place while looking up
+tags.")
+   (cache :initform nil
+         :type (or null semanticdb-find-result-with-nil)
+         :documentation "Cache of tags.
+These tags are re-used during a completion session.
+Sometimes these tags are cached between completion sessions.")
+   (last-all-completions :initarg nil
+                        :type semanticdb-find-result-with-nil
+                        :documentation "Last result of `all-completions'.
+This result can be used for refined completions as `last-prefix' gets
+closer to a specific result.")
+   (last-prefix :type string
+               :protection :protected
+               :documentation "The last queried prefix.
+This prefix can be used to cache intermediate completion offers.
+making the action of homing in on a token faster.")
+   (last-completion :type (or null string)
+                   :documentation "The last calculated completion.
+This completion is calculated and saved for future use.")
+   (last-whitespace-completion :type (or null string)
+                              :documentation "The last whitespace completion.
+For partial completion, SPC will disabiguate over whitespace type
+characters.  This is the last calculated version.")
+   (current-exact-match :type list
+                       :protection :protected
+                       :documentation "The list of matched tags.
+When tokens are matched, they are added to this list.")
+   )
+  "Root class for completion engines.
+The baseclass provides basic functionality for interacting with
+a completion displayor object, and tracking the current progress
+of a completion."
+  :abstract t)
+
+(defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
+  "Clean up any mess this collector may have."
+  nil)
+
+(defmethod semantic-collector-next-action
+  ((obj semantic-collector-abstract) partial)
+  "What should we do next?  OBJ can predict a next good action.
+PARTIAL indicates if we are doing a partial completion."
+  (if (and (slot-boundp obj 'last-completion)
+          (string= (semantic-completion-text) (oref obj last-completion)))
+      (let* ((cem (semantic-collector-current-exact-match obj))
+            (cemlen (semanticdb-find-result-length cem))
+            (cac (semantic-collector-all-completions
+                  obj (semantic-completion-text)))
+            (caclen (semanticdb-find-result-length cac)))
+       (cond ((and cem (= cemlen 1)
+                   cac (> caclen 1)
+                   (eq last-command this-command))
+              ;; Defer to the displayor...
+              nil)
+             ((and cem (= cemlen 1))
+              'done)
+             ((and (not cem) (not cac))
+              'empty)
+             ((and partial (semantic-collector-try-completion-whitespace
+                            obj (semantic-completion-text)))
+              'complete-whitespace)))
+    'complete))
+
+(defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
+                                           last-prefix)
+  "Return non-nil if OBJ's prefix matches PREFIX."
+  (and (slot-boundp obj 'last-prefix)
+       (string= (oref obj last-prefix) last-prefix)))
+
+(defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
+  "Get the raw cache of tags for completion.
+Calculate the cache if there isn't one."
+  (or (oref obj cache)
+      (semantic-collector-calculate-cache obj)))
+
+(defmethod semantic-collector-calculate-completions-raw
+  ((obj semantic-collector-abstract) prefix completionlist)
+  "Calculate the completions for prefix from completionlist.
+Output must be in semanticdb Find result format."
+  ;; Must output in semanticdb format
+  (let ((table (save-excursion
+                (set-buffer (oref obj buffer))
+                semanticdb-current-table))
+       (result (semantic-find-tags-for-completion
+                prefix
+                ;; To do this kind of search with a pre-built completion
+                ;; list, we need to strip it first.
+                (semanticdb-strip-find-results completionlist)))
+       )
+    (if result
+       (list (cons table result)))))
+
+(defmethod semantic-collector-calculate-completions
+  ((obj semantic-collector-abstract) prefix partial)
+  "Calculate completions for prefix as setup for other queries."
+  (let* ((case-fold-search semantic-case-fold)
+        (same-prefix-p (semantic-collector-last-prefix= obj prefix))
+        (completionlist
+         (if (or same-prefix-p
+                 (and (slot-boundp obj 'last-prefix)
+                      (eq (compare-strings (oref obj last-prefix) 0 nil
+                                           prefix 0 (length prefix))
+                          t)))
+             ;; New prefix is subset of old prefix
+             (oref obj last-all-completions)
+           (semantic-collector-get-cache obj)))
+        ;; Get the result
+        (answer (if same-prefix-p
+                    completionlist
+                  (semantic-collector-calculate-completions-raw
+                   obj prefix completionlist))
+                )
+        (completion nil)
+        (complete-not-uniq nil)
+        )
+    ;;(semanticdb-find-result-test answer)
+    (when (not same-prefix-p)
+      ;; Save results if it is interesting and beneficial
+      (oset obj last-prefix prefix)
+      (oset obj last-all-completions answer))
+    ;; Now calculate the completion.
+    (setq completion (try-completion
+                     prefix
+                     (semanticdb-strip-find-results answer)))
+    (oset obj last-whitespace-completion nil)
+    (oset obj current-exact-match nil)
+    ;; Only do this if a completion was found.  Letting a nil in
+    ;; could cause a full semanticdb search by accident.
+    (when completion
+      (oset obj last-completion
+           (cond
+            ;; Unique match in AC.  Last completion is a match.
+            ;; Also set the current-exact-match.
+            ((eq completion t)
+             (oset obj current-exact-match answer)
+             prefix)
+            ;; It may be complete (a symbol) but still not unique.
+            ;; We can capture a match
+            ((setq complete-not-uniq
+                   (semanticdb-find-tags-by-name
+                    prefix
+                    answer))
+             (oset obj current-exact-match
+                   complete-not-uniq)
+             prefix
+             )
+            ;; Non unique match, return the string that handles
+            ;; completion
+            (t (or completion prefix))
+            )))
+    ))
+
+(defmethod semantic-collector-try-completion-whitespace
+  ((obj semantic-collector-abstract) prefix)
+  "For OBJ, do whatepsace completion based on PREFIX.
+This implies that if there are two completions, one matching
+the test \"preifx\\>\", and one not, the one matching the full
+word version of PREFIX will be chosen, and that text returned.
+This function requires that `semantic-collector-calculate-completions'
+has been run first."
+  (let* ((ac (semantic-collector-all-completions obj prefix))
+        (matchme (concat "^" prefix "\\>"))
+        (compare (semanticdb-find-tags-by-name-regexp matchme ac))
+        (numtag (semanticdb-find-result-length compare))
+        )
+    (if compare
+       (let* ((idx 0)
+              (cutlen (1+ (length prefix)))
+              (twws (semanticdb-find-result-nth compare idx)))
+         ;; Is our tag with whitespace a match that has whitespace
+         ;; after it, or just an already complete symbol?
+         (while (and (< idx numtag)
+                     (< (length (semantic-tag-name (car twws))) cutlen))
+           (setq idx (1+ idx)
+                 twws (semanticdb-find-result-nth compare idx)))
+         (when (and twws (car-safe twws))
+           ;; If COMPARE has succeeded, then we should take the very
+           ;; first match, and extend prefix by one character.
+           (oset obj last-whitespace-completion
+                 (substring (semantic-tag-name (car twws))
+                            0 cutlen))))
+      )))
+
+
+(defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
+  "Return the active valid MATCH from the semantic collector.
+For now, just return the first element from our list of available
+matches.  For semanticdb based results, make sure the file is loaded
+into a buffer."
+  (when (slot-boundp obj 'current-exact-match)
+    (oref obj current-exact-match)))
+
+(defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
+  "Return the active whitespace completion value."
+  (when (slot-boundp obj 'last-whitespace-completion)
+    (oref obj last-whitespace-completion)))
+
+(defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
+  "Return the active valid MATCH from the semantic collector.
+For now, just return the first element from our list of available
+matches.  For semanticdb based results, make sure the file is loaded
+into a buffer."
+  (when (slot-boundp obj 'current-exact-match)
+    (semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0)))
+
+(defmethod semantic-collector-all-completions
+  ((obj semantic-collector-abstract) prefix)
+  "For OBJ, retrieve all completions matching PREFIX.
+The returned list consists of all the tags currently
+matching PREFIX."
+  (when (slot-boundp obj 'last-all-completions)
+    (oref obj last-all-completions)))
+
+(defmethod semantic-collector-try-completion
+  ((obj semantic-collector-abstract) prefix)
+  "For OBJ, attempt to match PREFIX.
+See `try-completion' for details on how this works.
+Return nil for no match.
+Return a string for a partial match.
+For a unique match of PREFIX, return the list of all tags
+with that name."
+  (if (slot-boundp obj 'last-completion)
+      (oref obj last-completion)))
+
+(defmethod semantic-collector-calculate-cache
+  ((obj semantic-collector-abstract))
+  "Calculate the completion cache for OBJ."
+  nil
+  )
+
+(defmethod semantic-collector-flush ((this semantic-collector-abstract))
+  "Flush THIS collector object, clearing any caches and prefix."
+  (oset this cache nil)
+  (slot-makeunbound this 'last-prefix)
+  (slot-makeunbound this 'last-completion)
+  (slot-makeunbound this 'last-all-completions)
+  (slot-makeunbound this 'current-exact-match)
+  )
+
+;;; PER BUFFER
+;;
+(defclass semantic-collector-buffer-abstract (semantic-collector-abstract)
+  ()
+  "Root class for per-buffer completion engines.
+These collectors track themselves on a per-buffer basis."
+  :abstract t)
+
+(defmethod constructor :STATIC ((this semantic-collector-buffer-abstract)
+                               newname &rest fields)
+  "Reuse previously created objects of this type in buffer."
+  (let ((old nil)
+       (bl semantic-collector-per-buffer-list))
+    (while (and bl (null old))
+      (if (eq (object-class (car bl)) this)
+         (setq old (car bl))))
+    (unless old
+      (let ((new (call-next-method)))
+       (add-to-list 'semantic-collector-per-buffer-list new)
+       (setq old new)))
+    (slot-makeunbound old 'last-completion)
+    (slot-makeunbound old 'last-prefix)
+    (slot-makeunbound old 'current-exact-match)
+    old))
+
+;; Buffer specific collectors should flush themselves
+(defun semantic-collector-buffer-flush (newcache)
+  "Flush all buffer collector objects.
+NEWCACHE is the new tag table, but we ignore it."
+  (condition-case nil
+      (let ((l semantic-collector-per-buffer-list))
+       (while l
+         (if (car l) (semantic-collector-flush (car l)))
+         (setq l (cdr l))))
+    (error nil)))
+
+(add-hook 'semantic-after-toplevel-cache-change-hook
+         'semantic-collector-buffer-flush)
+
+;;; DEEP BUFFER SPECIFIC COMPLETION
+;;
+(defclass semantic-collector-buffer-deep
+  (semantic-collector-buffer-abstract)
+  ()
+  "Completion engine for tags in the current buffer.
+When searching for a tag, uses semantic  deep searche functions.
+Basics search only in the current buffer.")
+
+(defmethod semantic-collector-calculate-cache
+  ((obj semantic-collector-buffer-deep))
+  "Calculate the completion cache for OBJ.
+Uses `semantic-flatten-tags-table'"
+  (oset obj cache
+       ;; Must create it in SEMANTICDB find format.
+       ;; ( ( DBTABLE TAG TAG ... ) ... )
+       (list
+        (cons semanticdb-current-table
+              (semantic-flatten-tags-table (oref obj buffer))))))
+
+;;; PROJECT SPECIFIC COMPLETION
+;;
+(defclass semantic-collector-project-abstract (semantic-collector-abstract)
+  ((path :initarg :path
+        :initform nil
+        :documentation "List of database tables to search.
+At creation time, it can be anything accepted by
+`semanticdb-find-translate-path' as a PATH argument.")
+   )
+  "Root class for project wide completion engines.
+Uses semanticdb for searching all tags in the current project."
+  :abstract t)
+
+;;; Project Search
+(defclass semantic-collector-project (semantic-collector-project-abstract)
+  ()
+  "Completion engine for tags in a project.")
+
+
+(defmethod semantic-collector-calculate-completions-raw
+  ((obj semantic-collector-project) prefix completionlist)
+  "Calculate the completions for prefix from completionlist."
+  (semanticdb-find-tags-for-completion prefix (oref obj path)))
+
+;;; Brutish Project search
+(defclass semantic-collector-project-brutish (semantic-collector-project-abstract)
+  ()
+  "Completion engine for tags in a project.")
+
+(defmethod semantic-collector-calculate-completions-raw
+  ((obj semantic-collector-project-brutish) prefix completionlist)
+  "Calculate the completions for prefix from completionlist."
+  (semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path)))
+
+(defclass semantic-collector-analyze-completions (semantic-collector-abstract)
+  ((context :initarg :context
+           :type semantic-analyze-context
+           :documentation "An analysis context.
+Specifies some context location from whence completion lists will be drawn."
+           )
+   (first-pass-completions :type list
+                          :documentation "List of valid completion tags.
+This list of tags is generated when completion starts.  All searches
+derive from this list.")
+   )
+  "Completion engine that uses the context analyzer to provide options.
+The only options available for completion are those which can be logically
+inserted into the current context.")
+
+(defmethod semantic-collector-calculate-completions-raw
+  ((obj semantic-collector-analyze-completions) prefix completionlist)
+  "calculate the completions for prefix from completionlist."
+  ;; if there are no completions yet, calculate them.
+  (if (not (slot-boundp obj 'first-pass-completions))
+      (oset obj first-pass-completions
+           (semantic-analyze-possible-completions (oref obj context))))
+  ;; search our cached completion list.  make it look like a semanticdb
+  ;; results type.
+  (list (cons (save-excursion
+               (set-buffer (oref (oref obj context) buffer))
+               semanticdb-current-table)
+             (semantic-find-tags-for-completion
+              prefix
+              (oref obj first-pass-completions)))))
+
+\f
+;;; ------------------------------------------------------------
+;;; Tag List Display Engines
+;;
+;; A typical displayor accepts a pre-determined list of completions
+;; generated by a collector.  This format is in semanticdb search
+;; form.  This vaguely standard form is a bit challenging to navigate
+;; because the tags do not contain buffer info, but the file assocated
+;; with the tags preceed the tag in the list.
+;;
+;; Basic displayors don't care, and can strip the results.
+;; Advanced highlighting displayors need to know when they need
+;; to load a file so that the tag in question can be highlighted.
+;;
+;; Key interface methods to a displayor are:
+;; * semantic-displayor-next-action
+;; * semantic-displayor-set-completions
+;; * semantic-displayor-current-focus
+;; * semantic-displayor-show-request
+;; * semantic-displayor-scroll-request
+;; * semantic-displayor-focus-request
+
+(defclass semantic-displayor-abstract ()
+  ((table :type (or null semanticdb-find-result-with-nil)
+         :initform nil
+         :protection :protected
+         :documentation "List of tags this displayor is showing.")
+   (last-prefix :type string
+               :protection :protected
+               :documentation "Prefix associated with slot `table'")
+   )
+  "Abstract displayor baseclass.
+Manages the display of some number of tags.
+Provides the basics for a displayor, including interacting with
+a collector, and tracking tables of completion to display."
+  :abstract t)
+
+(defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract))
+  "Clean up any mess this displayor may have."
+  nil)
+
+(defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
+  "The next action to take on the minibuffer related to display."
+  (if (and (slot-boundp obj 'last-prefix)
+          (string= (oref obj last-prefix) (semantic-completion-text))
+          (eq last-command this-command))
+      'scroll
+    'display))
+
+(defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
+                                              table prefix)
+  "Set the list of tags to be completed over to TABLE."
+  (oset obj table table)
+  (oset obj last-prefix prefix))
+
+(defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
+  "A request to show the current tags table."
+  (ding))
+
+(defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
+  "A request to for the displayor to focus on some tag option."
+  (ding))
+
+(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
+  "A request to for the displayor to scroll the completion list (if needed)."
+  (scroll-other-window))
+
+(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract))
+  "Set the current focus to the previous item."
+  nil)
+
+(defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract))
+  "Set the current focus to the next item."
+  nil)
+
+(defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
+  "Return a single tag currently in focus.
+This object type doesn't do focus, so will never have a focus object."
+  nil)
+
+;; Traditional displayor
+(defcustom semantic-completion-displayor-format-tag-function
+  #'semantic-format-tag-name
+  "*A Tag format function to use when showing completions."
+  :group 'semantic
+  :type semantic-format-tag-custom-list)
+
+(defclass semantic-displayor-traditional (semantic-displayor-abstract)
+  ()
+  "Display options in *Completions* buffer.
+Traditional display mechanism for a list of possible completions.
+Completions are showin in a new buffer and listed with the ability
+to click on the items to aid in completion.")
+
+(defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional))
+  "A request to show the current tags table."
+
+  ;; NOTE TO SELF.  Find the character to type next, and emphesize it.
+
+  (with-output-to-temp-buffer "*Completions*"
+    (display-completion-list
+     (mapcar semantic-completion-displayor-format-tag-function
+            (semanticdb-strip-find-results (oref obj table))))
+    )
+  )
+
+;;; Abstract baseclass for any displayor which supports focus
+(defclass semantic-displayor-focus-abstract (semantic-displayor-abstract)
+  ((focus :type number
+         :protection :protected
+         :documentation "A tag index from `table' which has focus.
+Multiple calls to the display function can choose to focus on a
+given tag, by highlighting its location.")
+   (find-file-focus
+    :allocation :class
+    :initform nil
+    :documentation
+    "Non-nil if focusing requires a tag's buffer be in memory.")
+   )
+  "Abstract displayor supporting `focus'.
+A displayor which has the ability to focus in on one tag.
+Focusing is a way of differentiationg between multiple tags
+which have the same name."
+  :abstract t)
+
+(defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
+  "The next action to take on the minibuffer related to display."
+  (if (and (slot-boundp obj 'last-prefix)
+          (string= (oref obj last-prefix) (semantic-completion-text))
+          (eq last-command this-command))
+      (if (and
+          (slot-boundp obj 'focus)
+          (slot-boundp obj 'table)
+          (<= (semanticdb-find-result-length (oref obj table))
+              (1+ (oref obj focus))))
+         ;; We are at the end of the focus road.
+         'displayend
+       ;; Focus on some item.
+       'focus)
+    'display))
+
+(defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
+                                              table prefix)
+  "Set the list of tags to be completed over to TABLE."
+  (call-next-method)
+  (slot-makeunbound obj 'focus))
+
+(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract))
+  "Set the current focus to the previous item.
+Not meaningful return value."
+  (when (and (slot-boundp obj 'table) (oref obj table))
+    (with-slots (table) obj
+      (if (or (not (slot-boundp obj 'focus))
+             (<= (oref obj focus) 0))
+         (oset obj focus (1- (semanticdb-find-result-length table)))
+       (oset obj focus (1- (oref obj focus)))
+       )
+      )))
+
+(defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract))
+  "Set the current focus to the next item.
+Not meaningful return value."
+  (when (and (slot-boundp obj 'table) (oref obj table))
+    (with-slots (table) obj
+      (if (not (slot-boundp obj 'focus))
+         (oset obj focus 0)
+       (oset obj focus (1+ (oref obj focus)))
+       )
+      (if (<= (semanticdb-find-result-length table) (oref obj focus))
+         (oset obj focus 0))
+      )))
+
+(defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract))
+  "Return the next tag OBJ should focus on."
+  (when (and (slot-boundp obj 'table) (oref obj table))
+    (with-slots (table) obj
+      (semanticdb-find-result-nth table (oref obj focus)))))
+
+(defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
+  "Return the tag currently in focus, or call parent method."
+  (if (and (slot-boundp obj 'focus)
+          (slot-boundp obj 'table)
+          ;; Only return the current focus IFF the minibuffer reflects
+          ;; the list this focus was derived from.
+          (slot-boundp obj 'last-prefix)
+          (string= (semantic-completion-text) (oref obj last-prefix))
+          )
+      ;; We need to focus
+      (if (oref obj find-file-focus)
+         (semanticdb-find-result-nth-in-buffer (oref obj table) (oref obj focus))
+       ;; result-nth returns a cons with car being the tag, and cdr the
+       ;; database.
+       (car (semanticdb-find-result-nth (oref obj table) (oref obj focus))))
+    ;; Do whatever
+    (call-next-method)))
+
+;;; Simple displayor which performs traditional display completion,
+;; and also focuses with highlighting.
+(defclass semantic-displayor-traditional-with-focus-highlight
+  (semantic-displayor-focus-abstract semantic-displayor-traditional)
+  ((find-file-focus :initform t))
+  "Display completions in *Completions* buffer, with focus highlight.
+A traditional displayor which can focus on a tag by showing it.
+Same as `semantic-displayor-traditional', but with selection between
+multiple tags with the same name done by 'focusing' on the source
+location of the different tags to differentiate them.")
+
+(defmethod semantic-displayor-focus-request
+  ((obj semantic-displayor-traditional-with-focus-highlight))
+  "Focus in on possible tag completions.
+Focus is performed by cycling through the tags and highlighting
+one in the source buffer."
+  (let* ((tablelength (semanticdb-find-result-length (oref obj table)))
+        (focus (semantic-displayor-focus-tag obj))
+        ;; Raw tag info.
+        (rtag (car focus))
+        (rtable (cdr focus))
+        ;; Normalize
+        (nt (semanticdb-normalize-one-tag rtable rtag))
+        (tag (cdr nt))
+        (table (car nt))
+       )
+    ;; If we fail to normalize, resete.
+    (when (not tag) (setq table rtable tag rtag))
+    ;; Do the focus.
+    (let ((buf (or (semantic-tag-buffer tag)
+                  (and table (semanticdb-get-buffer table)))))
+      ;; If no buffer is provided, then we can make up a summary buffer.
+      (when (not buf)
+       (save-excursion
+         (set-buffer (get-buffer-create "*Completion Focus*"))
+         (erase-buffer)
+         (insert "Focus on tag: \n")
+         (insert (semantic-format-tag-summarize tag nil t) "\n\n")
+         (when table
+           (insert "From table: \n")
+           (insert (object-name table) "\n\n"))
+         (when buf
+           (insert "In buffer: \n\n")
+           (insert (format "%S" buf)))
+         (setq buf (current-buffer))))
+      ;; Show the tag in the buffer.
+      (if (get-buffer-window buf)
+         (select-window (get-buffer-window buf))
+       (switch-to-buffer-other-window buf t)
+       (select-window (get-buffer-window buf)))
+      ;; Now do some positioning
+      (unwind-protect
+         (if (semantic-tag-with-position-p tag)
+             ;; Full tag positional information available
+             (progn
+               (goto-char (semantic-tag-start tag))
+               ;; This avoids a dangerous problem if we just loaded a tag
+               ;; from a file, but the original position was not updated
+               ;; in the TAG variable we are currently using.
+               (semantic-momentary-highlight-tag (semantic-current-tag))
+               ))
+       (select-window (minibuffer-window)))
+      ;; Calculate text difference between contents and the focus item.
+      (let* ((mbc (semantic-completion-text))
+            (ftn (semantic-tag-name tag))
+            (diff (substring ftn (length mbc))))
+       (semantic-completion-message
+        (format "%s [%d of %d matches]" diff (1+ (oref obj focus)) tablelength)))
+      )))
+
+\f
+;;; Tooltip completion lister
+;;
+;; Written and contributed by Masatake YAMATO <jet@gyve.org>
+;;
+;; Modified by Eric Ludlam for
+;; * Safe compatibility for tooltip free systems.
+;; * Don't use 'avoid package for tooltip positioning.
+
+(defclass semantic-displayor-tooltip (semantic-displayor-traditional)
+  ((max-tags     :type integer
+                :initarg :max-tags
+                :initform 5
+                :custom integer
+                :documentation
+                "Max number of tags displayed on tooltip at once.
+If `force-show' is 1,  this value is ignored with typing tab or space twice continuously.
+if `force-show' is 0, this value is always ignored.")
+   (force-show   :type integer
+                :initarg :force-show
+                :initform 1
+                :custom (choice (const
+                                 :tag "Show when double typing"
+                                 1)
+                                (const
+                                 :tag "Show always"
+                                 0)
+                                (const
+                                 :tag "Show if the number of tags is less than `max-tags'."
+                                 -1))
+                :documentation
+                "Control the behavior of the number of tags is greater than `max-tags'.
+-1 means tags are never shown.
+0 means the tags are always shown.
+1 means tags are shown if space or tab is typed twice continuously.")
+   (typing-count :type integer
+                :initform 0
+                :documentation
+                "Counter holding how many times the user types space or tab continuously before showing tags.")
+   (shown        :type boolean
+                :initform nil
+                :documentation
+                "Flag representing whether tags is shown once or not.")
+   )
+  "Display completions options in a tooltip.
+Display mechanism using tooltip for a list of possible completions.")
+
+(defmethod initialize-instance :AFTER ((obj semantic-displayor-tooltip) &rest args)
+  "Make sure we have tooltips required."
+  (condition-case nil
+      (require 'tooltip)
+    (error nil))
+  )
+
+(defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
+  "A request to show the current tags table."
+  (if (or (not (featurep 'tooltip)) (not tooltip-mode))
+      ;; If we cannot use tooltips, then go to the normal mode with
+      ;; a traditional completion buffer.
+      (call-next-method)
+    (let* ((tablelong (semanticdb-strip-find-results (oref obj table)))
+          (table (semantic-unique-tag-table-by-name tablelong))
+          (l (mapcar semantic-completion-displayor-format-tag-function table))
+          (ll (length l))
+          (typing-count (oref obj typing-count))
+          (force-show (oref obj force-show))
+          (matchtxt (semantic-completion-text))
+          msg)
+      (if (or (oref obj shown)
+             (< ll (oref obj max-tags))
+             (and (<= 0 force-show)
+                  (< (1- force-show) typing-count)))
+         (progn
+           (oset obj typing-count 0)
+           (oset obj shown t)
+           (if (eq 1 ll)
+               ;; We Have only one possible match.  There could be two cases.
+               ;; 1) input text != single match.
+               ;;    --> Show it!
+               ;; 2) input text == single match.
+               ;;   --> Complain about it, but still show the match.
+               (if (string= matchtxt (semantic-tag-name (car table)))
+                   (setq msg (concat "[COMPLETE]\n" (car l)))
+                 (setq msg (car l)))
+             ;; Create the long message.
+             (setq msg (mapconcat 'identity l "\n"))
+             ;; If there is nothing, say so!
+             (if (eq 0 (length msg))
+                 (setq msg "[NO MATCH]")))
+           (semantic-displayor-tooltip-show msg))
+       ;; The typing count determines if the user REALLY REALLY
+       ;; wanted to show that much stuff.  Only increment
+       ;; if the current command is a completion command.
+       (if (and (stringp (this-command-keys))
+                (string= (this-command-keys) "\C-i"))
+           (oset obj typing-count (1+ typing-count)))
+       ;; At this point, we know we have too many items.
+       ;; Lets be brave, and truncate l
+       (setcdr (nthcdr (oref obj max-tags) l) nil)
+       (setq msg (mapconcat 'identity l "\n"))
+       (cond
+        ((= force-show -1)
+         (semantic-displayor-tooltip-show (concat msg "\n...")))
+        ((= force-show 1)
+         (semantic-displayor-tooltip-show (concat msg "\n(TAB for more)")))
+        )))))
+
+;;; Compatibility
+;;
+(eval-and-compile
+  (if (fboundp 'window-inside-edges)
+      ;; Emacs devel.
+      (defalias 'semantic-displayor-window-edges
+        'window-inside-edges)
+    ;; Emacs 21
+    (defalias 'semantic-displayor-window-edges
+      'window-edges)
+    ))
+
+(defun semantic-displayor-point-position ()
+  "Return the location of POINT as positioned on the selected frame.
+Return a cons cell (X . Y)"
+  (let* ((frame (selected-frame))
+        (left (frame-parameter frame 'left))
+        (top (frame-parameter frame 'top))
+        (point-pix-pos (posn-x-y (posn-at-point)))
+        (edges (window-inside-pixel-edges (selected-window))))
+    (cons (+ (car point-pix-pos) (car edges) left)
+          (+ (cdr point-pix-pos) (cadr edges) top))))
+
+
+(defun semantic-displayor-tooltip-show (text)
+  "Display a tooltip with TEXT near cursor."
+  (let ((point-pix-pos (semantic-displayor-point-position))
+       (tooltip-frame-parameters
+        (append tooltip-frame-parameters nil)))
+    (push
+     (cons 'left (+ (car point-pix-pos) (frame-char-width)))
+     tooltip-frame-parameters)
+    (push
+     (cons 'top (+ (cdr point-pix-pos) (frame-char-height)))
+     tooltip-frame-parameters)
+    (tooltip-show text)))
+
+(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
+  "A request to for the displayor to scroll the completion list (if needed)."
+  ;; Do scrolling in the tooltip.
+  (oset obj max-tags 30)
+  (semantic-displayor-show-request obj)
+  )
+
+;; End code contributed by Masatake YAMATO <jet@gyve.org>
+
+\f
+;;; Ghost Text displayor
+;;
+(defclass semantic-displayor-ghost (semantic-displayor-focus-abstract)
+
+  ((ghostoverlay :type overlay
+                :documentation
+                "The overlay the ghost text is displayed in.")
+   (first-show :initform t
+              :documentation
+              "Non nil if we have not seen our first show request.")
+   )
+  "Cycle completions inline with ghost text.
+Completion displayor using ghost chars after point for focus options.
+Whichever completion is currently in focus will be displayed as ghost
+text using overlay options.")
+
+(defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost))
+  "The next action to take on the inline completion related to display."
+  (let ((ans (call-next-method))
+       (table (when (slot-boundp obj 'table)
+                      (oref obj table))))
+    (if (and (eq ans 'displayend)
+            table
+            (= (semanticdb-find-result-length table) 1)
+            )
+       nil
+      ans)))
+
+(defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost))
+  "Clean up any mess this displayor may have."
+  (when (slot-boundp obj 'ghostoverlay)
+    (semantic-overlay-delete (oref obj ghostoverlay)))
+  )
+
+(defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost)
+                                              table prefix)
+  "Set the list of tags to be completed over to TABLE."
+  (call-next-method)
+
+  (semantic-displayor-cleanup obj)
+  )
+
+
+(defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost))
+  "A request to show the current tags table."
+;  (if (oref obj first-show)
+;      (progn
+;      (oset obj first-show nil)
+       (semantic-displayor-focus-next obj)
+       (semantic-displayor-focus-request obj)
+;      )
+    ;; Only do the traditional thing if the first show request
+    ;; has been seen.  Use the first one to start doing the ghost
+    ;; text display.
+;    (call-next-method)
+;    )
+)
+
+(defmethod semantic-displayor-focus-request
+  ((obj semantic-displayor-ghost))
+  "Focus in on possible tag completions.
+Focus is performed by cycling through the tags and showing a possible
+completion text in ghost text."
+  (let* ((tablelength (semanticdb-find-result-length (oref obj table)))
+        (focus (semantic-displayor-focus-tag obj))
+        (tag (car focus))
+        )
+    (if (not tag)
+       (semantic-completion-message "No tags to focus on.")
+      ;; Display the focus completion as ghost text after the current
+      ;; inline text.
+      (when (or (not (slot-boundp obj 'ghostoverlay))
+               (not (semantic-overlay-live-p (oref obj ghostoverlay))))
+       (oset obj ghostoverlay
+             (semantic-make-overlay (point) (1+ (point)) (current-buffer) t)))
+
+      (let* ((lp (semantic-completion-text))
+            (os (substring (semantic-tag-name tag) (length lp)))
+            (ol (oref obj ghostoverlay))
+            )
+
+       (put-text-property 0 (length os) 'face 'region os)
+
+       (semantic-overlay-put
+        ol 'display (concat os (buffer-substring (point) (1+ (point)))))
+       )
+      ;; Calculate text difference between contents and the focus item.
+      (let* ((mbc (semantic-completion-text))
+            (ftn (concat (semantic-tag-name tag)))
+            )
+       (put-text-property (length mbc) (length ftn) 'face
+                          'bold ftn)
+       (semantic-completion-message
+        (format "%s [%d of %d matches]" ftn (1+ (oref obj focus)) tablelength)))
+      )))
+
+\f
+;;; ------------------------------------------------------------
+;;; Specific queries
+;;
+(defun semantic-complete-read-tag-buffer-deep (prompt &optional
+                                                     default-tag
+                                                     initial-input
+                                                     history)
+  "Ask for a tag by name from the current buffer.
+Available tags are from the current buffer, at any level.
+Completion options are presented in a traditional way, with highlighting
+to resolve same-name collisions.
+PROMPT is a string to prompt with.
+DEFAULT-TAG is a semantic tag or string to use as the default value.
+If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
+HISTORY is a symbol representing a variable to store the history in."
+  (semantic-complete-read-tag-engine
+   (semantic-collector-buffer-deep prompt :buffer (current-buffer))
+   (semantic-displayor-traditional-with-focus-highlight "simple")
+   ;;(semantic-displayor-tooltip "simple")
+   prompt
+   default-tag
+   initial-input
+   history)
+  )
+
+(defun semantic-complete-read-tag-project (prompt &optional
+                                                 default-tag
+                                                 initial-input
+                                                 history)
+  "Ask for a tag by name from the current project.
+Available tags are from the current project, at the top level.
+Completion options are presented in a traditional way, with highlighting
+to resolve same-name collisions.
+PROMPT is a string to prompt with.
+DEFAULT-TAG is a semantic tag or string to use as the default value.
+If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
+HISTORY is a symbol representing a variable to store the history in."
+  (semantic-complete-read-tag-engine
+   (semantic-collector-project-brutish prompt
+                                      :buffer (current-buffer)
+                                      :path (current-buffer)
+                                      )
+   (semantic-displayor-traditional-with-focus-highlight "simple")
+   prompt
+   default-tag
+   initial-input
+   history)
+  )
+
+(defun semantic-complete-inline-tag-project ()
+  "Complete a symbol name by name from within the current project.
+This is similar to `semantic-complete-read-tag-project', except
+that the completion interaction is in the buffer where the context
+was calculated from.
+Customize `semantic-complete-inline-analyzer-displayor-class'
+to control how completion options are displayed.
+See `semantic-complete-inline-tag-engine' for details on how
+completion works."
+  (let* ((collector (semantic-collector-project-brutish
+                    "inline"
+                    :buffer (current-buffer)
+                    :path (current-buffer)))
+        (sbounds (semantic-ctxt-current-symbol-and-bounds))
+        (syms (car sbounds))
+        (start (car (nth 2 sbounds)))
+        (end (cdr (nth 2 sbounds)))
+        (rsym (reverse syms))
+        (thissym (nth 1 sbounds))
+        (nextsym (car-safe (cdr rsym)))
+        (complst nil))
+    (when (and thissym (or (not (string= thissym ""))
+                          nextsym))
+      ;; Do a quick calcuation of completions.
+      (semantic-collector-calculate-completions
+       collector thissym nil)
+      ;; Get the master list
+      (setq complst (semanticdb-strip-find-results
+                    (semantic-collector-all-completions collector thissym)))
+      ;; Shorten by name
+      (setq complst (semantic-unique-tag-table-by-name complst))
+      (if (or (and (= (length complst) 1)
+                  ;; Check to see if it is the same as what is there.
+                  ;; if so, we can offer to complete.
+                  (let ((compname (semantic-tag-name (car complst))))
+                    (not (string= compname thissym))))
+             (> (length complst) 1))
+         ;; There are several options.  Do the completion.
+         (semantic-complete-inline-tag-engine
+          collector
+          (funcall semantic-complete-inline-analyzer-displayor-class
+                   "inline displayor")
+          ;;(semantic-displayor-tooltip "simple")
+          (current-buffer)
+          start end))
+      )))
+
+(defun semantic-complete-read-tag-analyzer (prompt &optional
+                                                  context
+                                                  history)
+  "Ask for a tag by name based on the current context.
+The function `semantic-analyze-current-context' is used to
+calculate the context.  `semantic-analyze-possible-completions' is used
+to generate the list of possible completions.
+PROMPT is the first part of the prompt.  Additional prompt
+is added based on the contexts full prefix.
+CONTEXT is the semantic analyzer context to start with.
+HISTORY is a symbol representing a variable to stor the history in.
+usually a default-tag and initial-input are available for completion
+prompts.  these are calculated from the CONTEXT variable passed in."
+  (if (not context) (setq context (semantic-analyze-current-context (point))))
+  (let* ((syms (semantic-ctxt-current-symbol (point)))
+        (inp (car (reverse syms))))
+    (setq syms (nreverse (cdr (nreverse syms))))
+    (semantic-complete-read-tag-engine
+     (semantic-collector-analyze-completions
+      prompt
+      :buffer (oref context buffer)
+      :context context)
+     (semantic-displayor-traditional-with-focus-highlight "simple")
+     (save-excursion
+       (set-buffer (oref context buffer))
+       (goto-char (cdr (oref context bounds)))
+       (concat prompt (mapconcat 'identity syms ".")
+              (if syms "." "")
+              ))
+     nil
+     inp
+     history)))
+
+(defvar semantic-complete-inline-custom-type
+  (append '(radio)
+         (mapcar
+          (lambda (class)
+            (let* ((C (intern (car class)))
+                   (doc (documentation-property C 'variable-documentation))
+                   (doc1 (car (split-string doc "\n")))
+                   )
+              (list 'const
+                    :tag doc1
+                    C)))
+          (eieio-build-class-alist semantic-displayor-abstract t))
+         )
+  "Possible options for inlince completion displayors.
+Use this to enable custom editing.")
+
+(defcustom semantic-complete-inline-analyzer-displayor-class
+  'semantic-displayor-traditional
+  "*Class for displayor to use with inline completion."
+  :group 'semantic
+  :type semantic-complete-inline-custom-type
+  )
+
+
+(defun semantic-complete-inline-analyzer (context)
+  "Complete a symbol name by name based on the current context.
+This is similar to `semantic-complete-read-tag-analyze', except
+that the completion interaction is in the buffer where the context
+was calculated from.
+CONTEXT is the semantic analyzer context to start with.
+Customize `semantic-complete-inline-analyzer-displayor-class'
+to control how completion options are displayed.
+
+See `semantic-complete-inline-tag-engine' for details on how
+completion works."
+  (if (not context) (setq context (semantic-analyze-current-context (point))))
+  (if (not context) (error "Nothing to complete on here"))
+  (let* ((collector (semantic-collector-analyze-completions
+                    "inline"
+                    :buffer (oref context buffer)
+                    :context context))
+        (syms (semantic-ctxt-current-symbol (point)))
+        (rsym (reverse syms))
+        (thissym (car rsym))
+        (nextsym (car-safe (cdr rsym)))
+        (complst nil))
+    (when (and thissym (or (not (string= thissym ""))
+                          nextsym))
+      ;; Do a quick calcuation of completions.
+      (semantic-collector-calculate-completions
+       collector thissym nil)
+      ;; Get the master list
+      (setq complst (semanticdb-strip-find-results
+                    (semantic-collector-all-completions collector thissym)))
+      ;; Shorten by name
+      (setq complst (semantic-unique-tag-table-by-name complst))
+      (if (or (and (= (length complst) 1)
+                  ;; Check to see if it is the same as what is there.
+                  ;; if so, we can offer to complete.
+                  (let ((compname (semantic-tag-name (car complst))))
+                    (not (string= compname thissym))))
+             (> (length complst) 1))
+         ;; There are several options.  Do the completion.
+         (semantic-complete-inline-tag-engine
+          collector
+          (funcall semantic-complete-inline-analyzer-displayor-class
+                   "inline displayor")
+          ;;(semantic-displayor-tooltip "simple")
+          (oref context buffer)
+          (car (oref context bounds))
+          (cdr (oref context bounds))
+          ))
+      )))
+
+(defcustom semantic-complete-inline-analyzer-idle-displayor-class
+  'semantic-displayor-ghost
+  "*Class for displayor to use with inline completion at idle time."
+  :group 'semantic
+  :type semantic-complete-inline-custom-type
+  )
+
+(defun semantic-complete-inline-analyzer-idle (context)
+  "Complete a symbol name by name based on the current context for idle time.
+CONTEXT is the semantic analyzer context to start with.
+This function is used from `semantic-idle-completions-mode'.
+
+This is the same as `semantic-complete-inline-analyzer', except that
+it uses `semantic-complete-inline-analyzer-idle-displayor-class'
+to control how completions are displayed.
+
+See `semantic-complete-inline-tag-engine' for details on how
+completion works."
+  (let ((semantic-complete-inline-analyzer-displayor-class
+        semantic-complete-inline-analyzer-idle-displayor-class))
+    (semantic-complete-inline-analyzer context)
+    ))
+
+\f
+;;; ------------------------------------------------------------
+;;; Testing/Samples
+;;
+(defun semantic-complete-test ()
+  "Test completion mechanisms."
+  (interactive)
+  (message "%S"
+   (semantic-format-tag-prototype
+    (semantic-complete-read-tag-project "Symbol: ")
+    )))
+
+(defun semantic-complete-jump-local ()
+  "Jump to a semantic symbol."
+  (interactive)
+  (let ((tag (semantic-complete-read-tag-buffer-deep "Symbol: ")))
+    (when (semantic-tag-p tag)
+      (push-mark)
+      (goto-char (semantic-tag-start tag))
+      (semantic-momentary-highlight-tag tag)
+      (message "%S: %s "
+              (semantic-tag-class tag)
+              (semantic-tag-name  tag)))))
+
+(defun semantic-complete-jump ()
+  "Jump to a semantic symbol."
+  (interactive)
+  (let* ((tag (semantic-complete-read-tag-project "Symbol: ")))
+    (when (semantic-tag-p tag)
+      (push-mark)
+      (semantic-go-to-tag tag)
+      (switch-to-buffer (current-buffer))
+      (semantic-momentary-highlight-tag tag)
+      (message "%S: %s "
+              (semantic-tag-class tag)
+              (semantic-tag-name  tag)))))
+
+(defun semantic-complete-analyze-and-replace ()
+  "Perform prompt completion to do in buffer completion.
+`semantic-analyze-possible-completions' is used to determine the
+possible values.
+The minibuffer is used to perform the completion.
+The result is inserted as a replacement of the text that was there."
+  (interactive)
+  (let* ((c (semantic-analyze-current-context (point)))
+        (tag (save-excursion (semantic-complete-read-tag-analyzer "" c))))
+    ;; Take tag, and replace context bound with its name.
+    (goto-char (car (oref c bounds)))
+    (delete-region (point) (cdr (oref c bounds)))
+    (insert (semantic-tag-name tag))
+    (message "%S" (semantic-format-tag-summarize tag))))
+
+(defun semantic-complete-analyze-inline ()
+  "Perform prompt completion to do in buffer completion.
+`semantic-analyze-possible-completions' is used to determine the
+possible values.
+The function returns immediately, leaving the buffer in a mode that
+will perform the completion.
+Configure `semantic-complete-inline-analyzer-displayor-class' to change
+how completion options are displayed."
+  (interactive)
+  ;; Only do this if we are not already completing something.
+  (if (not (semantic-completion-inline-active-p))
+      (semantic-complete-inline-analyzer
+       (semantic-analyze-current-context (point))))
+  ;; Report a message if things didn't startup.
+  (if (and (interactive-p)
+          (not (semantic-completion-inline-active-p)))
+      (message "Inline completion not needed.")
+    ;; Since this is most likely bound to something, and not used
+    ;; at idle time, throw in a TAB for good measure.
+    (semantic-complete-inline-TAB)
+    ))
+
+(defun semantic-complete-analyze-inline-idle ()
+  "Perform prompt completion to do in buffer completion.
+`semantic-analyze-possible-completions' is used to determine the
+possible values.
+The function returns immediately, leaving the buffer in a mode that
+will perform the completion.
+Configure `semantic-complete-inline-analyzer-idle-displayor-class'
+to change how completion options are displayed."
+  (interactive)
+  ;; Only do this if we are not already completing something.
+  (if (not (semantic-completion-inline-active-p))
+      (semantic-complete-inline-analyzer-idle
+       (semantic-analyze-current-context (point))))
+  ;; Report a message if things didn't startup.
+  (if (and (interactive-p)
+          (not (semantic-completion-inline-active-p)))
+      (message "Inline completion not needed."))
+  )
+
+(defun semantic-complete-self-insert (arg)
+  "Like `self-insert-command', but does completion afterwards.
+ARG is passed to `self-insert-command'.  If ARG is nil,
+use `semantic-complete-analyze-inline' to complete."
+  (interactive "p")
+  ;; If we are already in a completion scenario, exit now, and then start over.
+  (semantic-complete-inline-exit)
+
+  ;; Insert the key
+  (self-insert-command arg)
+
+  ;; Prepare for doing completion, but exit quickly if there is keyboard
+  ;; input.
+  (when (and (not (semantic-exit-on-input 'csi
+                   (semantic-fetch-tags)
+                   (semantic-throw-on-input 'csi)
+                   nil))
+            (= arg 1)
+            (not (semantic-exit-on-input 'csi
+                   (semantic-analyze-current-context)
+                   (semantic-throw-on-input 'csi)
+                   nil)))
+    (condition-case nil
+       (semantic-complete-analyze-inline)
+      ;; Ignore errors.  Seems likely that we'll get some once in a while.
+      (error nil))
+    ))
+
+;; @TODO - I can't  find where this fcn is used.  Delete?
+
+;;;;###autoload
+;(defun semantic-complete-inline-project ()
+;  "Perform inline completion for any symbol in the current project.
+;`semantic-analyze-possible-completions' is used to determine the
+;possible values.
+;The function returns immediately, leaving the buffer in a mode that
+;will perform the completion."
+;  (interactive)
+;  ;; Only do this if we are not already completing something.
+;  (if (not (semantic-completion-inline-active-p))
+;      (semantic-complete-inline-tag-project))
+;  ;; Report a message if things didn't startup.
+;  (if (and (interactive-p)
+;         (not (semantic-completion-inline-active-p)))
+;      (message "Inline completion not needed."))
+;  )
+
+;; End
+(provide 'semantic/complete)
+
+;;; semantic-complete.el ends here
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
new file mode 100644 (file)
index 0000000..af3b23a
--- /dev/null
@@ -0,0 +1,965 @@
+;;; semantic-edit.el --- Edit Management for Semantic
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;;; 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; In Semantic 1.x, changes were handled in a simplistic manner, where
+;; tags that changed were reparsed one at a time.  Any other form of
+;; edit were managed through a full reparse.
+;;
+;; This code attempts to minimize the number of times a full reparse
+;; needs to occur.  While overlays and tags will continue to be
+;; recycled in the simple case, new cases where tags are inserted
+;; or old tags removed  from the original list are handled.
+;;
+
+;;; NOTES FOR IMPROVEMENT
+;;
+;; Work done by the incremental parser could be improved by the
+;; following:
+;;
+;; 1. Tags created could have as a property an overlay marking a region
+;;    of themselves that can be edited w/out affecting the definition of
+;;    that tag.
+;;
+;; 2. Tags w/ positioned children could have a property of an
+;;    overlay marking the region in themselves that contain the
+;;    children.  This could be used to better improve splicing near
+;;    the beginning and end of the child lists.
+;;
+
+;;; BUGS IN INCREMENTAL PARSER
+;;
+;; 1. Changes in the whitespace between tags could extend a
+;;    following tag.  These will be marked as merely unmatched
+;;    syntax instead.
+;;
+;; 2. Incremental parsing while a new function is being typed in
+;;    somtimes gets a chance only when lists are incomplete,
+;;    preventing correct context identification.
+
+;;
+(require 'semantic)
+;; (require 'working)
+
+;;; Code:
+(defvar semantic-after-partial-cache-change-hook nil
+  "Hooks run after the buffer cache has been updated.
+
+This hook will run when the cache has been partially reparsed.
+Partial reparses are incurred when a user edits a buffer, and only the
+modified sections are rescanned.
+
+Hook functions must take one argument, which is the list of tags
+updated in the current buffer.
+
+For language specific hooks, make sure you define this as a local hook.")
+
+(defvar semantic-change-hooks nil
+  "Hooks run when semantic detects a change in a buffer.
+Each hook function must take three arguments, identical to the
+common hook `after-change-functions'.")
+
+(defvar semantic-reparse-needed-change-hook nil
+  "Hooks run when a user edit is detected as needing a reparse.
+For language specific hooks, make sure you define this as a local
+hook.
+Not used yet; part of the next generation reparse mechanism")
+
+(defvar semantic-no-reparse-needed-change-hook nil
+  "Hooks run when a user edit is detected as not needing a reparse.
+If the hook returns non-nil, then declare that a reparse is needed.
+For language specific hooks, make sure you define this as a local
+hook.
+Not used yet; part of the next generation reparse mechanism.")
+
+(defvar semantic-edits-new-change-hooks nil
+  "Hooks run when a new change is found.
+Functions must take one argument representing an overlay on that change.")
+
+(defvar semantic-edits-delete-change-hooks nil
+  "Hooks run before a change overlay is deleted.
+Deleted changes occur when multiple changes are merged.
+Functions must take one argument representing an overlay being deleted.")
+
+(defvar semantic-edits-move-change-hooks nil
+  "Hooks run after a change overlay is moved.
+Changes move when a new change overlaps an old change.  The old change
+will be moved.
+Functions must take one argument representing an overlay being moved.")
+
+(defvar semantic-edits-reparse-change-hooks nil
+  "Hooks run after a change results in a reparse.
+Functions are called before the overlay is deleted, and after the
+incremental reparse.")
+
+(defvar semantic-edits-incremental-reparse-failed-hooks nil
+  "Hooks run after the incremental parser fails.
+When this happens, the buffer is marked as needing a full reprase.")
+
+(defcustom semantic-edits-verbose-flag nil
+  "Non-nil means the incremental perser is verbose.
+If nil, errors are still displayed, but informative messages are not."
+  :group 'semantic
+  :type 'boolean)
+
+;;; Change State management
+;;
+;; Manage a series of overlays that define changes recently
+;; made to the current buffer.
+(defun semantic-change-function (start end length)
+  "Provide a mechanism for semantic tag management.
+Argument START, END, and LENGTH specify the bounds of the change."
+   (setq semantic-unmatched-syntax-cache-check t)
+   (let ((inhibit-point-motion-hooks t)
+        )
+     (run-hook-with-args 'semantic-change-hooks start end length)
+     ))
+
+(defun semantic-changes-in-region (start end &optional buffer)
+  "Find change overlays which exist in whole or in part between START and END.
+Optional argument BUFFER is the buffer to search for changes in."
+  (save-excursion
+    (if buffer (set-buffer buffer))
+    (let ((ol (semantic-overlays-in (max start (point-min))
+                                   (min end (point-max))))
+         (ret nil))
+      (while ol
+       (when (semantic-overlay-get (car ol) 'semantic-change)
+         (setq ret (cons (car ol) ret)))
+       (setq ol (cdr ol)))
+      (sort ret #'(lambda (a b) (< (semantic-overlay-start a)
+                                  (semantic-overlay-start b)))))))
+
+(defun semantic-edits-change-function-handle-changes  (start end length)
+  "Run whenever a buffer controlled by `semantic-mode' change.
+Tracks when and how the buffer is re-parsed.
+Argument START, END, and LENGTH specify the bounds of the change."
+  ;; We move start/end by one so that we can merge changes that occur
+  ;; just before, or just after.  This lets simple typing capture everything
+  ;; into one overlay.
+  (let ((changes-in-change (semantic-changes-in-region (1- start) (1+ end)))
+       )
+    (semantic-parse-tree-set-needs-update)
+    (if (not changes-in-change)
+       (let ((o (semantic-make-overlay start end)))
+         (semantic-overlay-put o 'semantic-change t)
+         ;; Run the hooks safely.  When hooks blow it, our dirty
+         ;; function will be removed from the list of active change
+         ;; functions.
+         (condition-case nil
+             (run-hook-with-args 'semantic-edits-new-change-hooks o)
+           (error nil)))
+      (let ((tmp changes-in-change))
+       ;; Find greatest bounds of all changes
+       (while tmp
+         (when (< (semantic-overlay-start (car tmp)) start)
+           (setq start (semantic-overlay-start (car tmp))))
+         (when (> (semantic-overlay-end (car tmp)) end)
+           (setq end (semantic-overlay-end (car tmp))))
+         (setq tmp (cdr tmp)))
+       ;; Move the first found overlay, recycling that overlay.
+       (semantic-overlay-move (car changes-in-change) start end)
+       (condition-case nil
+           (run-hook-with-args 'semantic-edits-move-change-hooks
+                               (car changes-in-change))
+         (error nil))
+       (setq changes-in-change (cdr changes-in-change))
+       ;; Delete other changes.  They are now all bound here.
+       (while changes-in-change
+         (condition-case nil
+             (run-hook-with-args 'semantic-edits-delete-change-hooks
+                                 (car changes-in-change))
+           (error nil))
+         (semantic-overlay-delete (car changes-in-change))
+         (setq changes-in-change (cdr changes-in-change))))
+      )))
+
+(defsubst semantic-edits-flush-change (change)
+  "Flush the CHANGE overlay."
+  (condition-case nil
+      (run-hook-with-args 'semantic-edits-delete-change-hooks
+                         change)
+    (error nil))
+  (semantic-overlay-delete change))
+
+(defun semantic-edits-flush-changes ()
+  "Flush the changes in the current buffer."
+  (let ((changes (semantic-changes-in-region (point-min) (point-max))))
+    (while changes
+      (semantic-edits-flush-change (car changes))
+      (setq changes (cdr changes))))
+  )
+
+(defun semantic-edits-change-in-one-tag-p (change hits)
+  "Return non-nil of the overlay CHANGE exists solely in one leaf tag.
+HITS is the list of tags that CHANGE is in.  It can have more than
+one tag in it if the leaf tag is within a parent tag."
+  (and (< (semantic-tag-start (car hits))
+         (semantic-overlay-start change))
+       (> (semantic-tag-end (car hits))
+         (semantic-overlay-end change))
+       ;; Recurse on the rest.  If this change is inside all
+       ;; of these tags, then they are all leaves or parents
+       ;; of the smallest tag.
+       (or (not (cdr hits))
+          (semantic-edits-change-in-one-tag-p change (cdr hits))))
+  )
+
+;;; Change/Tag Query functions
+;;
+;; A change (region of space) can effect tags in different ways.
+;; These functions perform queries on a buffer to determine different
+;; ways that a change effects a buffer.
+;;
+;; NOTE: After debugging these, replace below to no longer look
+;;       at point and mark (via comments I assume.)
+(defsubst semantic-edits-os (change)
+  "For testing: Start of CHANGE, or smaller of (point) and (mark)."
+  (if change (semantic-overlay-start change)
+    (if (< (point) (mark)) (point) (mark))))
+
+(defsubst semantic-edits-oe (change)
+  "For testing: End of CHANGE, or larger of (point) and (mark)."
+  (if change (semantic-overlay-end change)
+    (if (> (point) (mark)) (point) (mark))))
+
+(defun semantic-edits-change-leaf-tag (change)
+  "A leaf tag which completely encompasses CHANGE.
+If change overlaps a tag, but is not encompassed in it, return nil.
+Use `semantic-edits-change-overlap-leaf-tag'.
+If CHANGE is completely encompassed in a tag, but overlaps sub-tags,
+return nil."
+  (let* ((start (semantic-edits-os change))
+        (end (semantic-edits-oe change))
+        (tags (nreverse
+                 (semantic-find-tag-by-overlay-in-region
+                  start end))))
+    ;; A leaf is always first in this list
+    (if (and tags
+            (<= (semantic-tag-start (car tags)) start)
+            (> (semantic-tag-end (car tags)) end))
+       ;; Ok, we have a match.  If this tag has children,
+       ;; we have to do more tests.
+       (let ((chil (semantic-tag-components (car tags))))
+         (if (not chil)
+             ;; Simple leaf.
+             (car tags)
+           ;; For this type, we say that we encompass it if the
+           ;; change occurs outside the range of the children.
+           (if (or (not (semantic-tag-with-position-p (car chil)))
+                   (> start (semantic-tag-end (nth (1- (length chil)) chil)))
+                   (< end (semantic-tag-start (car chil))))
+               ;; We have modifications to the definition of this parent
+               ;; so we have to reparse the whole thing.
+               (car tags)
+             ;; We actually modified an area between some children.
+             ;; This means we should return nil, as that case is
+             ;; calculated by someone else.
+             nil)))
+      nil)))
+
+(defun semantic-edits-change-between-tags (change)
+  "Return a cache list of tags surrounding CHANGE.
+The returned list is the CONS cell in the master list pointing to
+a tag just before CHANGE.  The CDR will have the tag just after CHANGE.
+CHANGE cannot encompass or overlap a leaf tag.
+If CHANGE is fully encompassed in a tag that has children, and
+this change occurs between those children, this returns non-nil.
+See `semantic-edits-change-leaf-tag' for details on parents."
+  (let* ((start (semantic-edits-os change))
+        (end (semantic-edits-oe change))
+        (tags (nreverse
+                 (semantic-find-tag-by-overlay-in-region
+                  start end)))
+        (list-to-search nil)
+         (found nil))
+    (if (not tags)
+       (setq list-to-search semantic--buffer-cache)
+      ;; A leaf is always first in this list
+      (if (and (< (semantic-tag-start (car tags)) start)
+              (> (semantic-tag-end (car tags)) end))
+         ;; We are completely encompassed in a tag.
+         (if (setq list-to-search
+                   (semantic-tag-components (car tags)))
+             ;; Ok, we are completely encompassed within the first tag
+             ;; entry, AND that tag has children.  This means that change
+             ;; occured outside of all children, but inside some tag
+             ;; with children.
+             (if (or (not (semantic-tag-with-position-p (car list-to-search)))
+                     (> start (semantic-tag-end
+                               (nth (1- (length list-to-search))
+                                    list-to-search)))
+                     (< end (semantic-tag-start (car list-to-search))))
+                 ;; We have modifications to the definition of this parent
+                 ;; and not between it's children.  Clear the search list.
+                 (setq list-to-search nil)))
+       ;; Search list is nil.
+       ))
+    ;; If we have a search list, lets go.  Otherwise nothing.
+    (while (and list-to-search (not found))
+      (if (cdr list-to-search)
+          ;; We end when the start of the CDR is after the end of our
+          ;; asked change.
+          (if (< (semantic-tag-start (cadr list-to-search)) end)
+              (setq list-to-search (cdr list-to-search))
+            (setq found t))
+        (setq list-to-search nil)))
+    ;; Return it.  If it is nil, there is a logic bug, and we need
+    ;; to avoid this bit of logic anyway.
+    list-to-search
+    ))
+
+(defun semantic-edits-change-over-tags (change)
+  "Return a cache list of tags surrounding a CHANGE encompassing tags.
+CHANGE must not only include all overlapped tags (excepting possible
+parent tags) in their entirety.  In this case, the change may be deleting
+or moving whole tags.
+The return value is a vector.
+Cell 0 is a list of all tags completely encompassed in change.
+Cell 1 is the cons cell into a master parser cache starting with
+the cell which occurs BEFORE the first position of CHANGE.
+Cell 2 is the parent of cell 1, or nil for the buffer cache.
+This function returns nil if any tag covered by change is not
+completely encompassed.
+See `semantic-edits-change-leaf-tag' for details on parents."
+  (let* ((start (semantic-edits-os change))
+        (end (semantic-edits-oe change))
+        (tags (nreverse
+                 (semantic-find-tag-by-overlay-in-region
+                  start end)))
+        (parent nil)
+        (overlapped-tags nil)
+        inner-start inner-end
+        (list-to-search nil))
+    ;; By the time this is already called, we know that it is
+    ;; not a leaf change, nor a between tag change.  That leaves
+    ;; an overlap, and this condition.
+
+    ;; A leaf is always first in this list.
+    ;; Is the leaf encompassed in this change?
+    (if (and tags
+            (>= (semantic-tag-start (car tags)) start)
+            (<= (semantic-tag-end (car tags)) end))
+       (progn
+         ;; We encompass one whole change.
+         (setq overlapped-tags (list (car tags))
+               inner-start (semantic-tag-start (car tags))
+               inner-end (semantic-tag-end (car tags))
+               tags (cdr tags))
+         ;; Keep looping while tags are inside the change.
+         (while (and tags
+                     (>= (semantic-tag-start (car tags)) start)
+                     (<= (semantic-tag-end (car tags)) end))
+
+           ;; Check if this new all-encompassing tag is a parent
+           ;; of that which went before.  Only check end because
+           ;; we know that start is less than inner-start since
+           ;; tags was sorted on that.
+           (if (> (semantic-tag-end (car tags)) inner-end)
+               ;; This is a parent.  Drop the children found
+               ;; so far.
+               (setq overlapped-tags (list (car tags))
+                     inner-start (semantic-tag-start (car tags))
+                     inner-end (semantic-tag-end (car tags))
+                     )
+             ;; It is not a parent encompassing tag
+             (setq overlapped-tags (cons (car tags)
+                                           overlapped-tags)
+                   inner-start (semantic-tag-start (car tags))))
+           (setq tags (cdr tags)))
+         (if (not tags)
+             ;; There are no tags left, and all tags originally
+             ;; found are encompassed by the change.  Setup our list
+             ;; from the cache
+             (setq list-to-search semantic--buffer-cache);; We have a tag ouside the list.  Check for
+           ;; We know we have a parent because it would
+           ;; completely cover the change.  A tag can only
+           ;; do that if it is a parent after we get here.
+           (when (and tags
+                      (< (semantic-tag-start (car tags)) start)
+                      (> (semantic-tag-end (car tags)) end))
+             ;; We have a parent.  Stuff in the search list.
+             (setq parent (car tags)
+                   list-to-search (semantic-tag-components parent))
+             ;; If the first of TAGS is a parent (see above)
+             ;; then clear out the list.  All other tags in
+             ;; here must therefore be parents of the car.
+             (setq tags nil)
+             ;; One last check,  If start is before the first
+             ;; tag or after the last, we may have overlap into
+             ;; the characters that make up the definition of
+             ;; the tag we are parsing.
+             (when (or (semantic-tag-with-position-p (car list-to-search))
+                       (< start (semantic-tag-start
+                                 (car list-to-search)))
+                       (> end (semantic-tag-end
+                               (nth (1- (length list-to-search))
+                                    list-to-search))))
+               ;; We have a problem
+               (setq list-to-search nil
+                     parent nil))))
+
+         (when list-to-search
+
+           ;; Ok, return the vector only if all TAGS are
+           ;; confirmed as the lineage of `overlapped-tags'
+           ;; which must have a value by now.
+
+           ;; Loop over the search list to find the preceeding CDR.
+           ;; Fortunatly, (car overlapped-tags) happens to be
+           ;; the first tag positionally.
+           (let ((tokstart (semantic-tag-start (car overlapped-tags))))
+             (while (and list-to-search
+                         ;; Assume always (car (cdr list-to-search)).
+                         ;; A thrown error will be captured nicely, but
+                         ;; that case shouldn't happen.
+
+                         ;; We end when the start of the CDR is after the
+                         ;; end of our asked change.
+                         (cdr list-to-search)
+                         (< (semantic-tag-start (car (cdr list-to-search)))
+                            tokstart)
+                         (setq list-to-search (cdr list-to-search)))))
+           ;; Create the return vector
+           (vector overlapped-tags
+                   list-to-search
+                   parent)
+           ))
+      nil)))
+
+;;; Default Incremental Parser
+;;
+;; Logic about how to group changes for effective reparsing and splicing.
+
+(defun semantic-parse-changes-failed (&rest args)
+  "Signal that Semantic failed to parse changes.
+That is, display a message by passing all ARGS to `format', then throw
+a 'semantic-parse-changes-failed exception with value t."
+  (when semantic-edits-verbose-flag
+    (message "Semantic parse changes failed: %S"
+            (apply 'format args)))
+  (throw 'semantic-parse-changes-failed t))
+
+(defsubst semantic-edits-incremental-fail ()
+  "When the incremental parser fails, we mark that we need a full reparse."
+  ;;(debug)
+  (semantic-parse-tree-set-needs-rebuild)
+  (when semantic-edits-verbose-flag
+    (message "Force full reparse (%s)"
+            (buffer-name (current-buffer))))
+  (run-hooks 'semantic-edits-incremental-reparse-failed-hooks))
+
+(defun semantic-edits-incremental-parser ()
+  "Incrementally reparse the current buffer.
+Incremental parser allows semantic to only reparse those sections of
+the buffer that have changed.  This function depends on
+`semantic-edits-change-function-handle-changes' setting up change
+overlays in the current buffer.  Those overlays are analyzed against
+the semantic cache to see what needs to be changed."
+  (let ((changed-tags
+         ;; Don't use `semantic-safe' here to explicitly catch errors
+         ;; and reset the parse tree.
+         (catch 'semantic-parse-changes-failed
+           (if debug-on-error
+               (semantic-edits-incremental-parser-1)
+             (condition-case err
+                 (semantic-edits-incremental-parser-1)
+               (error
+                (message "incremental parser error: %S"
+                        (error-message-string err))
+                t))))))
+    (when (eq changed-tags t)
+      ;; Force a full reparse.
+      (semantic-edits-incremental-fail)
+      (setq changed-tags nil))
+    changed-tags))
+
+(defmacro semantic-edits-assert-valid-region ()
+  "Asert that parse-start and parse-end are sorted correctly."
+;;;  (if (> parse-start parse-end)
+;;;      (error "Bug is %s !> %d!  Buff min/max = [ %d %d ]"
+;;;         parse-start parse-end
+;;;         (point-min) (point-max)))
+  )
+
+(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.
+         )
+    (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 encompases.)  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
+                      ;; encompased within the bounds of tags
+                      ;; modified by the previous iteration's
+                      ;; change.
+                      (< (semantic-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 chnge.
+               ((> (semantic-tag-start (car cache-list))
+                   (semantic-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))
+                   (semantic-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
+                      (semantic-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 reprase 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 (semantic-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
+                          (semantic-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.
+         ((< (semantic-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 repase-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 occured 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 occured 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 occured 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))
+
+;; Make it the default changes parser
+(defalias 'semantic-parse-changes-default
+  'semantic-edits-incremental-parser)
+
+;;; Cache Splicing
+;;
+;; The incremental parser depends on the ability to parse up sections
+;; of the file, and splice the results back into the cache.  There are
+;; three types of splices.  A REPLACE, an ADD, and a REMOVE.  REPLACE
+;; is one of the simpler cases, as the starting cons cell representing
+;; the old tag can be used to auto-splice in.  ADD and REMOVE
+;; require scanning the cache to find the correct location so that the
+;; list can be fiddled.
+(defun semantic-edits-splice-remove (oldtags parent cachelist)
+  "Remove OLDTAGS from PARENT's CACHELIST.
+OLDTAGS are tags in the currenet buffer, preferably linked
+together also in CACHELIST.
+PARENT is the parent tag containing OLDTAGS.
+CACHELIST should be the children from PARENT, but may be
+pre-positioned to a convenient location."
+  (let* ((first (car oldtags))
+        (last (nth (1- (length oldtags)) oldtags))
+        (chil (if parent
+                  (semantic-tag-components parent)
+                semantic--buffer-cache))
+        (cachestart cachelist)
+        (cacheend nil)
+        )
+    ;; First in child list?
+    (if (eq first (car chil))
+       ;; First tags in the cache are being deleted.
+       (progn
+         (when semantic-edits-verbose-flag
+           (message "To Remove First Tag: (%s)"
+                    (semantic-format-tag-name first)))
+         ;; Find the last tag
+         (setq cacheend chil)
+         (while (and cacheend (not (eq last (car cacheend))))
+           (setq cacheend (cdr cacheend)))
+         ;; The splicable part is after cacheend.. so move cacheend
+         ;; one more tag.
+         (setq cacheend (cdr cacheend))
+         ;; Splice the found end tag into the cons cell
+         ;; owned by the current top child.
+         (setcar chil (car cacheend))
+         (setcdr chil (cdr cacheend))
+         (when (not cacheend)
+           ;; No cacheend.. then the whole system is empty.
+           ;; The best way to deal with that is to do a full
+           ;; reparse
+           (semantic-parse-changes-failed "Splice-remove failed.  Empty buffer?")
+           ))
+      (message "To Remove Middle Tag: (%s)"
+              (semantic-format-tag-name first)))
+    ;; Find in the cache the preceeding tag
+    (while (and cachestart (not (eq first (car (cdr cachestart)))))
+      (setq cachestart (cdr cachestart)))
+    ;; Find the last tag
+    (setq cacheend cachestart)
+    (while (and cacheend (not (eq last (car cacheend))))
+      (setq cacheend (cdr cacheend)))
+    ;; Splice the end position into the start position.
+    ;; If there is no start, then this whole section is probably
+    ;; gone.
+    (if cachestart
+       (setcdr cachestart (cdr cacheend))
+      (semantic-parse-changes-failed "Splice-remove failed."))
+
+    ;; Remove old overlays of these deleted tags
+    (while oldtags
+      (semantic--tag-unlink-from-buffer (car oldtags))
+      (setq oldtags (cdr oldtags)))
+    ))
+
+(defun semantic-edits-splice-insert (newtags parent cachelist)
+  "Insert NEWTAGS into PARENT using CACHELIST.
+PARENT could be nil, in which case CACHLIST is the buffer cache
+which must be updated.
+CACHELIST must be searched to find where NEWTAGS are to be inserted.
+The positions of NEWTAGS must be synchronized with those in
+CACHELIST for this to work.  Some routines pre-position CACHLIST at a
+convenient location, so use that."
+  (let* ((start (semantic-tag-start (car newtags)))
+        (newtagendcell (nthcdr (1- (length newtags)) newtags))
+        (end (semantic-tag-end (car newtagendcell)))
+        )
+    (if (> (semantic-tag-start (car cachelist)) start)
+       ;; We are at the beginning.
+       (let* ((pc (if parent
+                      (semantic-tag-components parent)
+                    semantic--buffer-cache))
+              (nc (cons (car pc) (cdr pc)))  ; new cons cell.
+              )
+         ;; Splice the new cache cons cell onto the end of our list.
+         (setcdr newtagendcell nc)
+         ;; Set our list into parent.
+         (setcar pc (car newtags))
+         (setcdr pc (cdr newtags)))
+      ;; We are at the end, or in the middle.  Find our match first.
+      (while (and (cdr cachelist)
+                 (> end (semantic-tag-start (car (cdr cachelist)))))
+       (setq cachelist (cdr cachelist)))
+      ;; Now splice into the list!
+      (setcdr newtagendcell (cdr cachelist))
+      (setcdr cachelist newtags))))
+
+(defun semantic-edits-splice-replace (oldtag newtag)
+  "Replace OLDTAG with NEWTAG in the current cache.
+Do this by recycling OLDTAG's first CONS cell.  This effectivly
+causes the new tag to completely replace the old one.
+Make sure that all information in the overlay is transferred.
+It is presumed that OLDTAG and NEWTAG are both cooked.
+When this routine returns, OLDTAG is raw, and the data will be
+lost if not transferred into NEWTAG."
+  (let* ((oo (semantic-tag-overlay oldtag))
+        (o (semantic-tag-overlay newtag))
+        (oo-props (semantic-overlay-properties oo)))
+    (while oo-props
+      (semantic-overlay-put o (car oo-props) (car (cdr oo-props)))
+      (setq oo-props (cdr (cdr oo-props)))
+      )
+    ;; Free the old overlay(s)
+    (semantic--tag-unlink-from-buffer oldtag)
+    ;; Recover properties
+    (semantic--tag-copy-properties oldtag newtag)
+    ;; Splice into the main list.
+    (setcdr oldtag (cdr newtag))
+    (setcar oldtag (car newtag))
+    ;; This important bit is because the CONS cell representing
+    ;; OLDTAG is now pointing to NEWTAG, but the NEWTAG
+    ;; cell is about to be abandoned.  Here we update our overlay
+    ;; to point at the updated state of the world.
+    (semantic-overlay-put o 'semantic oldtag)
+    ))
+\f
+;;; Setup incremental parser
+;;
+(add-hook 'semantic-change-hooks
+          #'semantic-edits-change-function-handle-changes)
+(add-hook 'semantic-before-toplevel-cache-flush-hook
+          #'semantic-edits-flush-changes)
+
+(provide 'semantic/edit)
+
+;;; semantic-edit.el ends here
diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el
new file mode 100644 (file)
index 0000000..05d1b2b
--- /dev/null
@@ -0,0 +1,262 @@
+;;; html.el --- Semantic details for html files
+
+;;; Copyright (C) 2004, 2005, 2007, 2008 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Parse HTML files and organize them in a nice way.
+;; Pay attention to anchors, including them in the tag list.
+;;
+;; Copied from the original semantic-texi.el.
+;;
+;; ToDo: Find <script> tags, and parse the contents in other
+;; parsers, such as javascript, php, shtml, or others.
+
+(require 'semantic)
+(require 'semantic/format)
+(condition-case nil
+    ;; This is not installed in all versions of Emacs.
+    (require 'sgml-mode) ;; html-mode is in here.
+  (error
+   (require 'psgml-mode) ;; XEmacs uses psgml, and html-mode is in here.
+   ))
+
+;;; Code:
+(eval-when-compile
+  (require 'semantic/ctxt)
+  (require 'semantic/imenu)
+  (require 'senator))
+
+(defvar semantic-html-super-regex
+  "<\\(h[1-9]\\|title\\|script\\|body\\|a +href\\)\\>"
+  "Regular expression used to find special sections in an HTML file.")
+
+(defvar semantic-html-section-list
+  '(("title" 1)
+    ("script" 1)
+    ("body" 1)
+    ("a" 11)
+    ("h1" 2)
+    ("h2" 3)
+    ("h3" 4)
+    ("h4" 5)
+    ("h5" 6)
+    ("h6" 7)
+    ("h7" 8)
+    ("h8" 9)
+    ("h9" 10)
+    )
+  "Alist of sectioning commands and their relative level.")
+
+(define-mode-local-override semantic-parse-region
+  html-mode (&rest ignore)
+  "Parse the current html buffer for semantic tags.
+INGNORE any arguments.  Always parse the whole buffer.
+Each tag returned is of the form:
+ (\"NAME\" section (:members CHILDREN))
+or
+ (\"NAME\" anchor)"
+  (mapcar 'semantic-html-expand-tag
+         (semantic-html-parse-headings)))
+
+(define-mode-local-override semantic-parse-changes
+  html-mode ()
+  "We can't parse changes for HTML mode right now."
+  (semantic-parse-tree-set-needs-rebuild))
+
+(defun semantic-html-expand-tag (tag)
+  "Expand the HTML tag TAG."
+  (let ((chil (semantic-html-components tag)))
+    (if chil
+        (semantic-tag-put-attribute
+         tag :members (mapcar 'semantic-html-expand-tag chil)))
+    (car (semantic--tag-expand tag))))
+
+(defun semantic-html-components (tag)
+  "Return components belonging to TAG."
+  (semantic-tag-get-attribute tag :members))
+
+(defun semantic-html-parse-headings ()
+  "Parse the current html buffer for all semantic tags."
+  (let ((pass1 nil))
+    ;; First search and snarf.
+    (save-excursion
+      (goto-char (point-min))
+
+      (let ((semantic--progress-reporter
+            (make-progress-reporter
+             (format "Parsing %s..."
+                     (file-name-nondirectory buffer-file-name))
+             (point-min) (point-max))))
+       (while (re-search-forward semantic-html-super-regex nil t)
+         (setq pass1 (cons (match-beginning 0) pass1))
+         (progress-reporter-update semantic--progress-reporter (point)))
+       (progress-reporter-done semantic--progress-reporter)))
+
+    (setq pass1 (nreverse pass1))
+    ;; Now, make some tags while creating a set of children.
+    (car (semantic-html-recursive-combobulate-list pass1 0))
+    ))
+
+(defun semantic-html-set-endpoint (metataglist pnt)
+  "Set the end point of the first section tag in METATAGLIST to PNT.
+METATAGLIST is a list of tags in the intermediate tag format used by the
+html parser.  PNT is the new point to set."
+  (let ((metatag nil))
+    (while (and metataglist
+               (not (eq (semantic-tag-class (car metataglist)) 'section)))
+      (setq metataglist (cdr metataglist)))
+    (setq metatag (car metataglist))
+    (when metatag
+      (setcar (nthcdr (1- (length metatag)) metatag) pnt)
+      metatag)))
+
+(defsubst semantic-html-new-section-tag (name members level start end)
+  "Create a semantic tag of class section.
+NAME is the name of this section.
+MEMBERS is a list of semantic tags representing the elements that make
+up this section.
+LEVEL is the levelling level.
+START and END define the location of data described by the tag."
+  (let ((anchorp (eq level 11)))
+    (append (semantic-tag name
+                         (cond (anchorp 'anchor)
+                               (t 'section))
+                         :members members)
+           (list start (if anchorp (point) end)) )))
+
+(defun semantic-html-extract-section-name ()
+  "Extract a section name from the current buffer and point.
+Assume the cursor is in the tag representing the section we
+need the name from."
+  (save-excursion
+    ; Skip over the HTML tag.
+    (forward-sexp -1)
+    (forward-char -1)
+    (forward-sexp 1)
+    (skip-chars-forward "\n\t ")
+    (while (looking-at "<")
+      (forward-sexp 1)
+      (skip-chars-forward "\n\t ")
+      )
+    (let ((start (point))
+         (end nil))
+      (if (re-search-forward "</" nil t)
+         (progn
+           (goto-char (match-beginning 0))
+           (skip-chars-backward " \n\t")
+           (setq end (point))
+           (buffer-substring-no-properties start end))
+       ""))
+    ))
+
+(defun semantic-html-recursive-combobulate-list (sectionlist level)
+  "Rearrange SECTIONLIST to be a hierarchical tag list starting at LEVEL.
+Return the rearranged new list, with all remaining tags from
+SECTIONLIST starting at ELT 2.  Sections not are not dealt with as soon as a
+tag with greater section value than LEVEL is found."
+  (let ((newl nil)
+       (oldl sectionlist)
+       (case-fold-search t)
+        tag
+       )
+    (save-excursion
+      (catch 'level-jump
+       (while oldl
+         (goto-char (car oldl))
+         (if (looking-at "<\\(\\w+\\)")
+             (let* ((word (match-string 1))
+                    (levelmatch (assoc-ignore-case
+                                  word semantic-html-section-list))
+                    text begin tmp
+                    )
+               (when (not levelmatch)
+                 (error "Tag %s matched in regexp but is not in list"
+                        word))
+               ;; Set begin to the right location
+               (setq begin (point))
+               ;; Get out of here if there if we made it that far.
+               (if (and levelmatch (<= (car (cdr levelmatch)) level))
+                   (progn
+                     (when newl
+                       (semantic-html-set-endpoint newl begin))
+                     (throw 'level-jump t)))
+               ;; When there is a match, the descriptive text
+               ;; consists of the rest of the line.
+               (goto-char (match-end 1))
+               (skip-chars-forward " \t")
+               (setq text (semantic-html-extract-section-name))
+               ;; Next, recurse into the body to find the end.
+               (setq tmp (semantic-html-recursive-combobulate-list
+                          (cdr oldl) (car (cdr levelmatch))))
+               ;; Build a tag
+               (setq tag (semantic-html-new-section-tag
+                          text (car tmp) (car (cdr levelmatch)) begin (point-max)))
+               ;; Before appending the newtag, update the previous tag
+               ;; if it is a section tag.
+               (when newl
+                 (semantic-html-set-endpoint newl begin))
+               ;; Append new tag to our master list.
+               (setq newl (cons tag newl))
+               ;; continue
+               (setq oldl (cdr tmp))
+               )
+           (error "Problem finding section in semantic/html parser"))
+         ;; (setq oldl (cdr oldl))
+         )))
+    ;; Return the list
+    (cons (nreverse newl) oldl)))
+
+(define-mode-local-override semantic-sb-tag-children-to-expand
+  html-mode (tag)
+  "The children TAG expands to."
+  (semantic-html-components tag))
+
+(defun semantic-default-html-setup ()
+  "Set up a buffer for parsing of HTML files."
+  ;; This will use our parser.
+  (setq semantic-parser-name "HTML"
+        semantic--parse-table t
+        imenu-create-index-function 'semantic-create-imenu-index
+       semantic-command-separation-character ">"
+       semantic-type-relation-separator-character '(":")
+       semantic-symbol->name-assoc-list '((section . "Section")
+
+                                          )
+       semantic-imenu-expandable-tag-classes '(section)
+       semantic-imenu-bucketize-file nil
+       semantic-imenu-bucketize-type-members nil
+       senator-step-at-start-end-tag-classes '(section)
+       semantic-stickyfunc-sticky-classes '(section)
+       )
+  (semantic-install-function-overrides
+   '((tag-components . semantic-html-components)
+     )
+   t)
+  )
+
+(add-hook 'html-mode-hook 'semantic-default-html-setup)
+
+(define-child-mode html-helper-mode html-mode
+  "`html-helper-mode' needs the same semantic support as `html-mode'.")
+
+(provide 'semantic/html)
+
+;;; semantic-html.el ends here
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
new file mode 100644 (file)
index 0000000..15dded4
--- /dev/null
@@ -0,0 +1,957 @@
+;;; idle.el --- Schedule parsing tasks in idle time
+
+;;; Copyright (C) 2003, 2004, 2005, 2006, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Keywords: syntax
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Originally, `semantic-auto-parse-mode' handled refreshing the
+;; tags in a buffer in idle time.  Other activities can be scheduled
+;; in idle time, all of which require up-to-date tag tables.
+;; Having a specialized idle time scheduler that first refreshes
+;; the tags buffer, and then enables other idle time tasks reduces
+;; the amount of work needed.  Any specialized idle tasks need not
+;; ask for a fresh tags list.
+;;
+;; NOTE ON SEMANTIC_ANALYZE
+;;
+;; Some of the idle modes use the semantic analyzer.  The analyzer
+;; automatically caches the created context, so it is shared amongst
+;; all idle modes that will need it.
+
+(require 'semantic/util-modes)
+(require 'timer)
+
+;;; Code:
+
+;;; TIMER RELATED FUNCTIONS
+;;
+(defvar semantic-idle-scheduler-timer nil
+  "Timer used to schedule tasks in idle time.")
+
+(defvar semantic-idle-scheduler-work-timer nil
+  "Timer used to schedule tasks in idle time that may take a while.")
+
+(defcustom semantic-idle-scheduler-verbose-flag nil
+  "*Non-nil means that the idle scheduler should provide debug messages.
+Use this setting to debug idle activities."
+  :group 'semantic
+  :type 'boolean)
+
+(defcustom semantic-idle-scheduler-idle-time 2
+  "*Time in seconds of idle before scheduling events.
+This time should be short enough to ensure that idle-scheduler will be
+run as soon as Emacs is idle."
+  :group 'semantic
+  :type 'number
+  :set (lambda (sym val)
+         (set-default sym val)
+         (when (timerp semantic-idle-scheduler-timer)
+           (cancel-timer semantic-idle-scheduler-timer)
+           (setq semantic-idle-scheduler-timer nil)
+           (semantic-idle-scheduler-setup-timers))))
+
+(defcustom semantic-idle-scheduler-work-idle-time 60
+  "*Time in seconds of idle before scheduling big work.
+This time should be long enough that once any big work is started, it is
+unlikely the user would be ready to type again right away."
+  :group 'semantic
+  :type 'number
+  :set (lambda (sym val)
+         (set-default sym val)
+         (when (timerp semantic-idle-scheduler-timer)
+           (cancel-timer semantic-idle-scheduler-timer)
+           (setq semantic-idle-scheduler-timer nil)
+           (semantic-idle-scheduler-setup-timers))))
+
+(defun semantic-idle-scheduler-setup-timers ()
+  "Lazy initialization of the auto parse idle timer."
+  ;; REFRESH THIS FUNCTION for XEMACS FOIBLES
+  (or (timerp semantic-idle-scheduler-timer)
+      (setq semantic-idle-scheduler-timer
+            (run-with-idle-timer
+             semantic-idle-scheduler-idle-time t
+             #'semantic-idle-scheduler-function)))
+  (or (timerp semantic-idle-scheduler-work-timer)
+      (setq semantic-idle-scheduler-work-timer
+            (run-with-idle-timer
+             semantic-idle-scheduler-work-idle-time t
+             #'semantic-idle-scheduler-work-function)))
+  )
+
+(defun semantic-idle-scheduler-kill-timer ()
+  "Kill the auto parse idle timer."
+  (if (timerp semantic-idle-scheduler-timer)
+      (cancel-timer semantic-idle-scheduler-timer))
+  (setq semantic-idle-scheduler-timer nil))
+
+\f
+;;; MINOR MODE
+;;
+;; The minor mode portion of this code just sets up the minor mode
+;; which does the initial scheduling of the idle timers.
+;;
+(defcustom global-semantic-idle-scheduler-mode nil
+  "*If non-nil, enable global use of idle-scheduler mode."
+  :group 'semantic
+  :group 'semantic-modes
+  :type 'boolean
+  :require 'semantic/idle
+  :initialize 'custom-initialize-default
+  :set (lambda (sym val)
+         (global-semantic-idle-scheduler-mode (if val 1 -1))))
+
+;;;###autoload
+(defun global-semantic-idle-scheduler-mode (&optional arg)
+  "Toggle global use of option `semantic-idle-scheduler-mode'.
+The idle scheduler with automatically reparse buffers in idle time,
+and then schedule other jobs setup with `semantic-idle-scheduler-add'.
+If ARG is positive, enable, if it is negative, disable.
+If ARG is nil, then toggle."
+  (interactive "P")
+  (setq global-semantic-idle-scheduler-mode
+        (semantic-toggle-minor-mode-globally
+         'semantic-idle-scheduler-mode arg)))
+
+(defcustom semantic-idle-scheduler-mode-hook nil
+  "*Hook run at the end of function `semantic-idle-scheduler-mode'."
+  :group 'semantic
+  :type 'hook)
+
+;;;###autoload
+(defvar semantic-idle-scheduler-mode nil
+  "Non-nil if idle-scheduler minor mode is enabled.
+Use the command `semantic-idle-scheduler-mode' to change this variable.")
+(make-variable-buffer-local 'semantic-idle-scheduler-mode)
+
+(defcustom semantic-idle-scheduler-max-buffer-size 0
+  "*Maximum size in bytes of buffers where idle-scheduler is enabled.
+If this value is less than or equal to 0, idle-scheduler is enabled in
+all buffers regardless of their size."
+  :group 'semantic
+  :type 'number)
+
+(defsubst semantic-idle-scheduler-enabled-p ()
+  "Return non-nil if idle-scheduler is enabled for this buffer.
+idle-scheduler is disabled when debugging or if the buffer size
+exceeds the `semantic-idle-scheduler-max-buffer-size' threshold."
+  (and semantic-idle-scheduler-mode
+       (not semantic-debug-enabled)
+       (not semantic-lex-debug)
+       (or (<= semantic-idle-scheduler-max-buffer-size 0)
+          (< (buffer-size) semantic-idle-scheduler-max-buffer-size))))
+
+(defun semantic-idle-scheduler-mode-setup ()
+  "Setup option `semantic-idle-scheduler-mode'.
+The minor mode can be turned on only if semantic feature is available
+and the current buffer was set up for parsing.  When minor mode is
+enabled parse the current buffer if needed.  Return non-nil if the
+minor mode is enabled."
+  (if semantic-idle-scheduler-mode
+      (if (not (and (featurep 'semantic) (semantic-active-p)))
+          (progn
+            ;; Disable minor mode if semantic stuff not available
+            (setq semantic-idle-scheduler-mode nil)
+            (error "Buffer %s was not set up idle time scheduling"
+                   (buffer-name)))
+        (semantic-idle-scheduler-setup-timers)))
+  semantic-idle-scheduler-mode)
+
+;;;###autoload
+(defun semantic-idle-scheduler-mode (&optional arg)
+  "Minor mode to auto parse buffer following a change.
+When this mode is off, a buffer is only rescanned for tokens when
+some command requests the list of available tokens.  When idle-scheduler
+is enabled, Emacs periodically checks to see if the buffer is out of
+date, and reparses while the user is idle (not typing.)
+
+With prefix argument ARG, turn on if positive, otherwise off.  The
+minor mode can be turned on only if semantic feature is available and
+the current buffer was set up for parsing.  Return non-nil if the
+minor mode is enabled."
+  (interactive
+   (list (or current-prefix-arg
+             (if semantic-idle-scheduler-mode 0 1))))
+  (setq semantic-idle-scheduler-mode
+        (if arg
+            (>
+             (prefix-numeric-value arg)
+             0)
+          (not semantic-idle-scheduler-mode)))
+  (semantic-idle-scheduler-mode-setup)
+  (run-hooks 'semantic-idle-scheduler-mode-hook)
+  (if (interactive-p)
+      (message "idle-scheduler minor mode %sabled"
+               (if semantic-idle-scheduler-mode "en" "dis")))
+  (semantic-mode-line-update)
+  semantic-idle-scheduler-mode)
+
+(semantic-add-minor-mode 'semantic-idle-scheduler-mode
+                         "ARP"
+                         nil)
+
+(semantic-alias-obsolete 'semantic-auto-parse-mode
+                        'semantic-idle-scheduler-mode)
+(semantic-alias-obsolete 'global-semantic-auto-parse-mode
+                        'global-semantic-idle-scheduler-mode)
+
+\f
+;;; SERVICES services
+;;
+;; These are services for managing idle services.
+;;
+(defvar semantic-idle-scheduler-queue nil
+  "List of functions to execute during idle time.
+These functions will be called in the current buffer after that
+buffer has had its tags made up to date.  These functions
+will not be called if there are errors parsing the
+current buffer.")
+
+;;;###autoload
+(defun semantic-idle-scheduler-add (function)
+  "Schedule FUNCTION to occur during idle time."
+  (add-to-list 'semantic-idle-scheduler-queue function))
+
+;;;###autoload
+(defun semantic-idle-scheduler-remove (function)
+  "Unschedule FUNCTION to occur during idle time."
+  (setq semantic-idle-scheduler-queue
+       (delete function semantic-idle-scheduler-queue)))
+
+;;; IDLE Function
+;;
+(defun semantic-idle-core-handler ()
+  "Core idle function that handles reparsing.
+And also manages services that depend on tag values."
+  (when semantic-idle-scheduler-verbose-flag
+    (message "IDLE: Core handler..."))
+  (semantic-exit-on-input 'idle-timer
+    (let* ((inhibit-quit nil)
+           (buffers (delq (current-buffer)
+                          (delq nil
+                                (mapcar #'(lambda (b)
+                                            (and (buffer-file-name b)
+                                                 b))
+                                        (buffer-list)))))
+          safe ;; This safe is not used, but could be.
+           others
+          mode)
+      (when (semantic-idle-scheduler-enabled-p)
+        (save-excursion
+          ;; First, reparse the current buffer.
+          (setq mode major-mode
+                safe (semantic-safe "Idle Parse Error: %S"
+                      ;(error "Goofy error 1")
+                      (semantic-idle-scheduler-refresh-tags)
+                      )
+               )
+          ;; Now loop over other buffers with same major mode, trying to
+          ;; update them as well.  Stop on keypress.
+          (dolist (b buffers)
+            (semantic-throw-on-input 'parsing-mode-buffers)
+            (with-current-buffer b
+              (if (eq major-mode mode)
+                  (and (semantic-idle-scheduler-enabled-p)
+                      (semantic-safe "Idle Parse Error: %S"
+                        ;(error "Goofy error")
+                        (semantic-idle-scheduler-refresh-tags)))
+                (push (current-buffer) others))))
+          (setq buffers others))
+        ;; If re-parse of current buffer completed, evaluate all other
+        ;; services.  Stop on keypress.
+
+       ;; NOTE ON COMMENTED SAFE HERE
+       ;; We used to not execute the services if the buffer wsa
+       ;; unparseable.  We now assume that they are lexically
+       ;; safe to do, because we have marked the buffer unparseable
+       ;; if there was a problem.
+       ;;(when safe
+       (dolist (service semantic-idle-scheduler-queue)
+         (save-excursion
+           (semantic-throw-on-input 'idle-queue)
+           (when semantic-idle-scheduler-verbose-flag
+             (message "IDLE: execture service %s..." service))
+           (semantic-safe (format "Idle Service Error %s: %%S" service)
+             (funcall service))
+           (when semantic-idle-scheduler-verbose-flag
+             (message "IDLE: execture service %s...done" service))
+           )))
+       ;;)
+      ;; Finally loop over remaining buffers, trying to update them as
+      ;; well.  Stop on keypress.
+      (save-excursion
+        (dolist (b buffers)
+          (semantic-throw-on-input 'parsing-other-buffers)
+          (with-current-buffer b
+            (and (semantic-idle-scheduler-enabled-p)
+                 (semantic-idle-scheduler-refresh-tags)))))
+      ))
+  (when semantic-idle-scheduler-verbose-flag
+    (message "IDLE: Core handler...done")))
+
+(defun semantic-debug-idle-function ()
+  "Run the Semantic idle function with debugging turned on."
+  (interactive)
+  (let ((debug-on-error t))
+    (semantic-idle-core-handler)
+    ))
+
+(defun semantic-idle-scheduler-function ()
+  "Function run when after `semantic-idle-scheduler-idle-time'.
+This function will reparse the current buffer, and if successful,
+call additional functions registered with the timer calls."
+  (when (zerop (recursion-depth))
+    (let ((debug-on-error nil))
+      (save-match-data (semantic-idle-core-handler))
+      )))
+
+\f
+;;; WORK FUNCTION
+;;
+;; Unlike the shorter timer, the WORK timer will kick of tasks that
+;; may take a long time to complete.
+(defcustom semantic-idle-work-parse-neighboring-files-flag t
+  "*Non-nil means to parse files in the same dir as the current buffer.
+Disable to prevent lots of excessive parsing in idle time."
+  :group 'semantic
+  :type 'boolean)
+
+
+(defun semantic-idle-work-for-one-buffer (buffer)
+  "Do long-processing work for for BUFFER.
+Uses `semantic-safe' and returns the output.
+Returns t of all processing succeeded."
+  (save-excursion
+    (set-buffer buffer)
+    (not (and
+         ;; Just in case
+         (semantic-safe "Idle Work Parse Error: %S"
+           (semantic-idle-scheduler-refresh-tags)
+           t)
+
+         ;; Force all our include files to get read in so we
+         ;; are ready to provide good smart completion and idle
+         ;; summary information
+         (semantic-safe "Idle Work Including Error: %S"
+           ;; Get the include related path.
+           (when (and (featurep 'semantic/db)
+                      (semanticdb-minor-mode-p))
+             (require 'semantic/db-find)
+             (semanticdb-find-translate-path buffer nil)
+             )
+           t)
+
+         ;; Pre-build the typecaches as needed.
+         (semantic-safe "Idle Work Typecaching Error: %S"
+           (when (featurep 'semantic/db-typecache)
+             (semanticdb-typecache-refresh-for-buffer buffer))
+           t)
+         ))
+    ))
+
+(defun semantic-idle-work-core-handler ()
+  "Core handler for idle work processing of long running tasks.
+Visits semantic controlled buffers, and makes sure all needed
+include files have been parsed, and that the typecache is up to date.
+Uses `semantic-idle-work-for-on-buffer' to do the work."
+  (let ((errbuf nil)
+       (interrupted
+        (semantic-exit-on-input 'idle-work-timer
+          (let* ((inhibit-quit nil)
+                 (cb (current-buffer))
+                 (buffers (delq (current-buffer)
+                                (delq nil
+                                      (mapcar #'(lambda (b)
+                                                  (and (buffer-file-name b)
+                                                       b))
+                                              (buffer-list)))))
+                 safe errbuf)
+            ;; First, handle long tasks in the current buffer.
+            (when (semantic-idle-scheduler-enabled-p)
+              (save-excursion
+                (setq safe (semantic-idle-work-for-one-buffer (current-buffer))
+                      )))
+            (when (not safe) (push (current-buffer) errbuf))
+
+            ;; Now loop over other buffers with same major mode, trying to
+            ;; update them as well.  Stop on keypress.
+            (dolist (b buffers)
+              (semantic-throw-on-input 'parsing-mode-buffers)
+              (with-current-buffer b
+                (when (semantic-idle-scheduler-enabled-p)
+                  (and (semantic-idle-scheduler-enabled-p)
+                       (unless (semantic-idle-work-for-one-buffer (current-buffer))
+                         (push (current-buffer) errbuf)))
+                  ))
+              )
+
+            ;; Save everything.
+            (semanticdb-save-all-db-idle)
+
+            ;; Parse up files near our active buffer
+            (when semantic-idle-work-parse-neighboring-files-flag
+              (semantic-safe "Idle Work Parse Neighboring Files: %S"
+                (when (and (featurep 'semantic/db)
+                           (semanticdb-minor-mode-p))
+                  (set-buffer cb)
+                  (semantic-idle-scheduler-work-parse-neighboring-files))
+                t)
+              )
+
+            ;; Save everything... again
+            (semanticdb-save-all-db-idle)
+
+            ;; Done w/ processing
+            nil))))
+
+    ;; Done
+    (if interrupted
+       "Interrupted"
+      (cond ((not errbuf)
+            "done")
+           ((not (cdr errbuf))
+            (format "done with 1 error in %s" (car errbuf)))
+           (t
+            (format "done with errors in %d buffers."
+                    (length errbuf)))))))
+
+(defun semantic-debug-idle-work-function ()
+  "Run the Semantic idle work function with debugging turned on."
+  (interactive)
+  (let ((debug-on-error t))
+    (semantic-idle-work-core-handler)
+    ))
+
+(defun semantic-idle-scheduler-work-function ()
+  "Function run when after `semantic-idle-scheduler-work-idle-time'.
+This routine handles difficult tasks that require a lot of parsing, such as
+parsing all the header files used by our active sources, or building up complex
+datasets."
+  (when semantic-idle-scheduler-verbose-flag
+    (message "Long Work Idle Timer..."))
+  (let ((exit-type (save-match-data
+                    (semantic-idle-work-core-handler))))
+    (when semantic-idle-scheduler-verbose-flag
+      (message "Long Work Idle Timer...%s" exit-type)))
+  )
+
+(defun semantic-idle-scheduler-work-parse-neighboring-files ()
+  "Parse all the files in similar directories to buffers being edited."
+  ;; Lets check to see if EDE matters.
+  (let ((ede-auto-add-method 'never))
+    (dolist (a auto-mode-alist)
+      (when (eq (cdr a) major-mode)
+       (dolist (file (directory-files default-directory t (car a) t))
+         (semantic-throw-on-input 'parsing-mode-buffers)
+         (save-excursion
+           (semanticdb-file-table-object file)
+           ))))
+    ))
+
+(defun semantic-idle-pnf-test ()
+  "Test `semantic-idle-scheduler-work-parse-neighboring-files' and time it."
+  (interactive)
+  (let ((start (current-time))
+       (junk (semantic-idle-scheduler-work-parse-neighboring-files))
+       (end (current-time)))
+    (message "Work took %.2f seconds." (semantic-elapsed-time start end)))
+  )
+
+\f
+;;; REPARSING
+;;
+;; Reparsing is installed as semantic idle service.
+;; This part ALWAYS happens, and other services occur
+;; afterwards.
+
+;; (defcustom semantic-idle-scheduler-no-working-message t
+;;   "*If non-nil, disable display of working messages during parse."
+;;   :group 'semantic
+;;   :type 'boolean)
+
+;; (defcustom semantic-idle-scheduler-working-in-modeline-flag nil
+;;   "*Non-nil means show working messages in the mode line.
+;; Typically, parsing will show messages in the minibuffer.
+;; This will move the parse message into the modeline."
+;;   :group 'semantic
+;;   :type 'boolean)
+
+(defvar semantic-before-idle-scheduler-reparse-hooks nil
+  "Hooks run before option `semantic-idle-scheduler' begins parsing.
+If any hook throws an error, this variable is reset to nil.
+This hook is not protected from lexical errors.")
+
+(defvar semantic-after-idle-scheduler-reparse-hooks nil
+  "Hooks run after option `semantic-idle-scheduler' has parsed.
+If any hook throws an error, this variable is reset to nil.
+This hook is not protected from lexical errors.")
+
+(defun semantic-idle-scheduler-refresh-tags ()
+  "Refreshes the current buffer's tags.
+This is called by `semantic-idle-scheduler-function' to update the
+tags in the current buffer.
+
+Return non-nil if the refresh was successful.
+Return nil if there is some sort of syntax error preventing a full
+reparse.
+
+Does nothing if the current buffer doesn't need reparsing."
+
+  (prog1
+      ;; These checks actually occur in `semantic-fetch-tags', but if we
+      ;; do them here, then all the bovination hooks are not run, and
+      ;; we save lots of time.
+      (cond
+       ;; If the buffer was previously marked unparseable,
+       ;; then don't waste our time.
+       ((semantic-parse-tree-unparseable-p)
+       nil)
+       ;; The parse tree is already ok.
+       ((semantic-parse-tree-up-to-date-p)
+       t)
+       (t
+       ;; If the buffer might need a reparse and it is safe to do so,
+       ;; give it a try.
+       (let* (;(semantic-working-type nil)
+              (inhibit-quit nil)
+              ;; (working-use-echo-area-p
+              ;;       (not semantic-idle-scheduler-working-in-modeline-flag))
+              ;; (working-status-dynamic-type
+              ;;       (if semantic-idle-scheduler-no-working-message
+              ;;           nil
+              ;;         working-status-dynamic-type))
+              ;; (working-status-percentage-type
+              ;;       (if semantic-idle-scheduler-no-working-message
+              ;;           nil
+              ;;         working-status-percentage-type))
+              (lexically-safe t)
+              )
+         ;; Let people hook into this, but don't let them hose
+         ;; us over!
+         (condition-case nil
+             (run-hooks 'semantic-before-idle-scheduler-reparse-hooks)
+           (error (setq semantic-before-idle-scheduler-reparse-hooks nil)))
+
+         (unwind-protect
+             ;; Perform the parsing.
+             (progn
+               (when semantic-idle-scheduler-verbose-flag
+                 (message "IDLE: reparse %s..." (buffer-name)))
+               (when (semantic-lex-catch-errors idle-scheduler
+                       (save-excursion (semantic-fetch-tags))
+                       nil)
+                 ;; If we are here, it is because the lexical step failed,
+                 ;; proably due to unterminated lists or something like that.
+
+                 ;; We do nothing, and just wait for the next idle timer
+                 ;; to go off.  In the meantime, remember this, and make sure
+                 ;; no other idle services can get executed.
+                 (setq lexically-safe nil))
+               (when semantic-idle-scheduler-verbose-flag
+                 (message "IDLE: reparse %s...done" (buffer-name))))
+           ;; Let people hook into this, but don't let them hose
+           ;; us over!
+           (condition-case nil
+               (run-hooks 'semantic-after-idle-scheduler-reparse-hooks)
+             (error (setq semantic-after-idle-scheduler-reparse-hooks nil))))
+         ;; Return if we are lexically safe (from prog1)
+         lexically-safe)))
+
+    ;; After updating the tags, handle any pending decorations for this
+    ;; buffer.
+    (semantic-decorate-flush-pending-decorations (current-buffer))
+    ))
+
+\f
+;;; IDLE SERVICES
+;;
+;; Idle Services are minor modes which enable or disable a services in
+;; the idle scheduler.  Creating a new services only requires calling
+;; `semantic-create-idle-services' which does all the setup
+;; needed to create the minor mode that will enable or disable
+;; a services.  The services must provide a single function.
+
+(defmacro define-semantic-idle-service (name doc &rest forms)
+  "Create a new idle services with NAME.
+DOC will be a documentation string describing FORMS.
+FORMS will be called during idle time after the current buffer's
+semantic tag information has been updated.
+This routines creates the following functions and variables:"
+  (let ((global (intern (concat "global-" (symbol-name name) "-mode")))
+       (mode   (intern (concat (symbol-name name) "-mode")))
+       (hook   (intern (concat (symbol-name name) "-mode-hook")))
+       (map    (intern (concat (symbol-name name) "-mode-map")))
+       (setup  (intern (concat (symbol-name name) "-mode-setup")))
+       (func   (intern (concat (symbol-name name) "-idle-function")))
+       )
+
+    `(eval-and-compile
+       (defun ,global (&optional arg)
+        ,(concat "Toggle global use of option `" (symbol-name mode) "'.
+If ARG is positive, enable, if it is negative, disable.
+If ARG is nil, then toggle.")
+        (interactive "P")
+        (setq ,global
+              (semantic-toggle-minor-mode-globally
+               ',mode arg)))
+
+       (defcustom ,global nil
+        (concat "*If non-nil, enable global use of `" (symbol-name ',mode) "'.
+" ,doc)
+        :group 'semantic
+        :group 'semantic-modes
+        :type 'boolean
+        :require 'semantic/idle
+        :initialize 'custom-initialize-default
+        :set (lambda (sym val)
+               (,global (if val 1 -1))))
+
+       (defcustom ,hook nil
+        (concat "*Hook run at the end of function `" (symbol-name ',mode) "'.")
+        :group 'semantic
+        :type 'hook)
+
+       (defvar ,map
+        (let ((km (make-sparse-keymap)))
+          km)
+        (concat "Keymap for `" (symbol-name ',mode) "'."))
+
+       (defvar ,mode nil
+        (concat "Non-nil if summary minor mode is enabled.
+Use the command `" (symbol-name ',mode) "' to change this variable."))
+       (make-variable-buffer-local ',mode)
+
+       (defun ,setup ()
+        ,(concat "Setup option `" (symbol-name mode) "'.
+The minor mode can be turned on only if semantic feature is available
+and the idle scheduler is active.
+Return non-nil if the minor mode is enabled.")
+        (if ,mode
+            (if (not (and (featurep 'semantic) (semantic-active-p)))
+                (progn
+                  ;; Disable minor mode if semantic stuff not available
+                  (setq ,mode nil)
+                  (error "Buffer %s was not set up for parsing"
+                         (buffer-name)))
+              ;; Enable the mode mode
+              (semantic-idle-scheduler-add #',func)
+              )
+          ;; Disable the mode mode
+          (semantic-idle-scheduler-remove #',func)
+          )
+        ,mode)
+
+;;;###autoload
+       (defun ,mode (&optional arg)
+        ,(concat doc "
+This is a minor mode which performs actions during idle time.
+With prefix argument ARG, turn on if positive, otherwise off.  The
+minor mode can be turned on only if semantic feature is available and
+the current buffer was set up for parsing.  Return non-nil if the
+minor mode is enabled.")
+        (interactive
+         (list (or current-prefix-arg
+                   (if ,mode 0 1))))
+        (setq ,mode
+              (if arg
+                  (>
+                   (prefix-numeric-value arg)
+                   0)
+                (not ,mode)))
+        (,setup)
+        (run-hooks ,hook)
+        (if (interactive-p)
+            (message "%s %sabled"
+                     (symbol-name ',mode)
+                     (if ,mode "en" "dis")))
+        (semantic-mode-line-update)
+        ,mode)
+
+       (semantic-add-minor-mode ',mode
+                               ""      ; idle schedulers are quiet?
+                               ,map)
+
+       (defun ,func ()
+        ,doc
+        ,@forms)
+
+       )))
+(put 'define-semantic-idle-service 'lisp-indent-function 1)
+
+\f
+;;; SUMMARY MODE
+;;
+;; A mode similar to eldoc using semantic
+(require 'semantic/ctxt)
+
+(defcustom semantic-idle-summary-function
+  'semantic-format-tag-summarize-with-file
+  "*Function to use when displaying tag information during idle time.
+Some useful functions are found in `semantic-format-tag-functions'."
+  :group 'semantic
+  :type semantic-format-tag-custom-list)
+
+(defsubst semantic-idle-summary-find-current-symbol-tag (sym)
+  "Search for a semantic tag with name SYM in database tables.
+Return the tag found or nil if not found.
+If semanticdb is not in use, use the current buffer only."
+  (car (if (and (featurep 'semantic/db) semanticdb-current-database)
+           (cdar (semanticdb-deep-find-tags-by-name sym))
+         (semantic-deep-find-tags-by-name sym (current-buffer)))))
+
+(defun semantic-idle-summary-current-symbol-info-brutish ()
+  "Return a string message describing the current context.
+Gets a symbol with `semantic-ctxt-current-thing' and then
+trys to find it with a deep targetted search."
+  ;; Try the current "thing".
+  (let ((sym (car (semantic-ctxt-current-thing))))
+    (when sym
+      (semantic-idle-summary-find-current-symbol-tag sym))))
+
+(defun semantic-idle-summary-current-symbol-keyword ()
+  "Return a string message describing the current symbol.
+Returns a value only if it is a keyword."
+  ;; Try the current "thing".
+  (let ((sym (car (semantic-ctxt-current-thing))))
+    (if (and sym (semantic-lex-keyword-p sym))
+       (semantic-lex-keyword-get sym 'summary))))
+
+(defun semantic-idle-summary-current-symbol-info-context ()
+  "Return a string message describing the current context.
+Use the semantic analyzer to find the symbol information."
+  (let ((analysis (condition-case nil
+                     (semantic-analyze-current-context (point))
+                   (error nil))))
+    (when analysis
+      (semantic-analyze-interesting-tag analysis))))
+
+(defun semantic-idle-summary-current-symbol-info-default ()
+  "Return a string message describing the current context.
+This functin will disable loading of previously unloaded files
+by semanticdb as a time-saving measure."
+  (let (
+       (semanticdb-find-default-throttle
+        (if (featurep 'semantic/db-find)
+            (remq 'unloaded semanticdb-find-default-throttle)
+          nil))
+       )
+    (save-excursion
+      ;; use whicever has success first.
+      (or
+       (semantic-idle-summary-current-symbol-keyword)
+
+       (semantic-idle-summary-current-symbol-info-context)
+
+       (semantic-idle-summary-current-symbol-info-brutish)
+       ))))
+
+(defvar semantic-idle-summary-out-of-context-faces
+  '(
+    font-lock-comment-face
+    font-lock-string-face
+    font-lock-doc-string-face           ; XEmacs.
+    font-lock-doc-face                  ; Emacs 21 and later.
+    )
+  "List of font-lock faces that indicate a useless summary context.
+Those are generally faces used to highlight comments.
+
+It might be useful to override this variable to add comment faces
+specific to a major mode.  For example, in jde mode:
+
+\(defvar-mode-local jde-mode semantic-idle-summary-out-of-context-faces
+   (append (default-value 'semantic-idle-summary-out-of-context-faces)
+          '(jde-java-font-lock-doc-tag-face
+            jde-java-font-lock-link-face
+            jde-java-font-lock-bold-face
+            jde-java-font-lock-underline-face
+            jde-java-font-lock-pre-face
+            jde-java-font-lock-code-face)))")
+
+(defun semantic-idle-summary-useful-context-p ()
+  "Non-nil of we should show a summary based on context."
+  (if (and (boundp 'font-lock-mode)
+          font-lock-mode
+          (memq (get-text-property (point) 'face)
+                semantic-idle-summary-out-of-context-faces))
+      ;; The best I can think of at the moment is to disable
+      ;; in comments by detecting with font-lock.
+      nil
+    t))
+
+(define-overloadable-function semantic-idle-summary-current-symbol-info ()
+  "Return a string message describing the current context.")
+
+(make-obsolete-overload 'semantic-eldoc-current-symbol-info
+                        'semantic-idle-summary-current-symbol-info)
+
+(define-semantic-idle-service semantic-idle-summary
+  "Display a tag summary of the lexical token under the cursor.
+Call `semantic-idle-summary-current-symbol-info' for getting the
+current tag to display information."
+  (or (eq major-mode 'emacs-lisp-mode)
+      (not (semantic-idle-summary-useful-context-p))
+      (let* ((found (semantic-idle-summary-current-symbol-info))
+             (str (cond ((stringp found) found)
+                        ((semantic-tag-p found)
+                         (funcall semantic-idle-summary-function
+                                  found nil t))))
+            )
+       ;; Show the message with eldoc functions
+        (require 'eldoc)
+        (unless (and str (boundp 'eldoc-echo-area-use-multiline-p)
+                     eldoc-echo-area-use-multiline-p)
+          (let ((w (1- (window-width (minibuffer-window)))))
+            (if (> (length str) w)
+                (setq str (substring str 0 w)))))
+        (eldoc-message str))))
+
+(semantic-alias-obsolete 'semantic-summary-mode
+                        'semantic-idle-summary-mode)
+(semantic-alias-obsolete 'global-semantic-summary-mode
+                        'global-semantic-idle-summary-mode)
+\f
+;;; Current symbol highlight
+;;
+;; This mode will use context analysis to perform highlighting
+;; of all uses of the symbol that is under the cursor.
+;;
+;; This is to mimic the Eclipse tool of a similar nature.
+(defvar semantic-idle-summary-highlight-face 'region
+  "Face used for the summary highlight.")
+
+(defun semantic-idle-summary-maybe-highlight (tag)
+  "Perhaps add highlighting onto TAG.
+TAG was found as the thing under point.  If it happens to be
+visible, then highlight it."
+  (let* ((region (when (and (semantic-tag-p tag)
+                           (semantic-tag-with-position-p tag))
+                  (semantic-tag-overlay tag)))
+        (file (when (and (semantic-tag-p tag)
+                         (semantic-tag-with-position-p tag))
+                (semantic-tag-file-name tag)))
+        (buffer (when file (get-file-buffer file)))
+        ;; We use pulse, but we don't want the flashy version,
+        ;; just the stable version.
+        (pulse-flag nil)
+        )
+    (cond ((semantic-overlay-p region)
+          (save-excursion
+            (set-buffer (semantic-overlay-buffer region))
+            (goto-char (semantic-overlay-start region))
+            (when (pos-visible-in-window-p
+                   (point) (get-buffer-window (current-buffer) 'visible))
+              (if (< (semantic-overlay-end region) (point-at-eol))
+                  (pulse-momentary-highlight-overlay
+                   region semantic-idle-summary-highlight-face)
+                ;; Not the same
+                (pulse-momentary-highlight-region
+                 (semantic-overlay-start region)
+                 (point-at-eol)
+                 semantic-idle-summary-highlight-face)))
+            ))
+         ((vectorp region)
+          (let ((start (aref region 0))
+                (end (aref region 1)))
+            (save-excursion
+              (when buffer (set-buffer buffer))
+              ;; As a vector, we have no filename.  Perhaps it is a
+              ;; local variable?
+              (when (and (<= end (point-max))
+                         (pos-visible-in-window-p
+                          start (get-buffer-window (current-buffer) 'visible)))
+                (goto-char start)
+                (when (re-search-forward
+                       (regexp-quote (semantic-tag-name tag))
+                       end t)
+                  ;; This is likely it, give it a try.
+                  (pulse-momentary-highlight-region
+                   start (if (<= end (point-at-eol)) end
+                           (point-at-eol))
+                   semantic-idle-summary-highlight-face)))
+              ))))
+    nil))
+
+(define-semantic-idle-service semantic-idle-tag-highlight
+  "Highlight the tag, and references of the symbol under point.
+Call `semantic-analyze-current-context' to find the reference tag.
+Call `semantic-symref-hits-in-region' to identify local references."
+  (when (semantic-idle-summary-useful-context-p)
+    (let* ((ctxt (semantic-analyze-current-context))
+          (Hbounds (when ctxt (oref ctxt bounds)))
+          (target (when ctxt (car (reverse (oref ctxt prefix)))))
+          (tag (semantic-current-tag))
+          ;; We use pulse, but we don't want the flashy version,
+          ;; just the stable version.
+          (pulse-flag nil))
+      (when ctxt
+       ;; Highlight the original tag?  Protect against problems.
+       (condition-case nil
+           (semantic-idle-summary-maybe-highlight target)
+         (error nil))
+       ;; Identify all hits in this current tag.
+       (when (semantic-tag-p target)
+         (semantic-symref-hits-in-region
+          target (lambda (start end prefix)
+                   (when (/= start (car Hbounds))
+                     (pulse-momentary-highlight-region
+                      start end))
+                   (semantic-throw-on-input 'symref-highlight)
+                   )
+          (semantic-tag-start tag)
+          (semantic-tag-end tag)))
+       ))))
+
+\f
+;;; Completion Popup Mode
+;;
+;; This mode uses tooltips to display a (hopefully) short list of possible
+;; completions available for the text under point.  It provides
+;; NO provision for actually filling in the values from those completions.
+
+(defun semantic-idle-completion-list-default ()
+  "Calculate and display a list of completions."
+  (when (semantic-idle-summary-useful-context-p)
+    ;; This mode can be fragile.  Ignore problems.
+    ;; If something doesn't do what you expect, run
+    ;; the below command by hand instead.
+    (condition-case nil
+       (let (
+             ;; Don't go loading in oodles of header libraries in
+             ;; IDLE time.
+             (semanticdb-find-default-throttle
+              (if (featurep 'semantic/db-find)
+                  (remq 'unloaded semanticdb-find-default-throttle)
+                nil))
+             )
+         ;; Use idle version.
+         (semantic-complete-analyze-inline-idle)
+         )
+      (error nil))
+    ))
+
+(define-semantic-idle-service semantic-idle-completions
+  "Display a list of possible completions in a tooltip."
+  ;; Add the ability to override sometime.
+  (semantic-idle-completion-list-default))
+
+(provide 'semantic/idle)
+
+;;; semantic-idle.el ends here
index c9029a3e98b85469f2bb0f3bc524ed5191b6dc87..9768a1e992c1af3c86a39f3cb00084b2826a41a0 100644 (file)
@@ -315,6 +315,42 @@ PROPERTY set."
      #'(lambda (symbol) (setq keywords (cons symbol keywords)))
      property)
     keywords))
+
+;;; Inline functions:
+
+(defvar semantic-lex-unterminated-syntax-end-function)
+(defvar semantic-lex-analysis-bounds)
+(defvar semantic-lex-end-point)
+
+(defsubst semantic-lex-token-bounds (token)
+  "Fetch the start and end locations of the lexical token TOKEN.
+Return a pair (START . END)."
+  (if (not (numberp (car (cdr token))))
+      (cdr (cdr token))
+    (cdr token)))
+
+(defsubst semantic-lex-token-start (token)
+  "Fetch the start position of the lexical token TOKEN.
+See also the function `semantic-lex-token'."
+  (car (semantic-lex-token-bounds token)))
+
+(defsubst semantic-lex-token-end (token)
+  "Fetch the end position of the lexical token TOKEN.
+See also the function `semantic-lex-token'."
+  (cdr (semantic-lex-token-bounds token)))
+
+(defsubst semantic-lex-unterminated-syntax-detected (syntax)
+  "Inside a lexical analyzer, use this when unterminated syntax was found.
+Argument SYNTAX indicates the type of syntax that is unterminated.
+The job of this function is to move (point) to a new logical location
+so that analysis can continue, if possible."
+  (goto-char
+   (funcall semantic-lex-unterminated-syntax-end-function
+           syntax
+           (car semantic-lex-analysis-bounds)
+           (cdr semantic-lex-analysis-bounds)
+           ))
+  (setq semantic-lex-end-point (point)))
 \f
 ;;; Type table handling.
 ;;
@@ -1012,23 +1048,6 @@ variable after calling `semantic-lex-push-token'."
 See also the function `semantic-lex-token'."
   (car token))
 
-(defsubst semantic-lex-token-bounds (token)
-  "Fetch the start and end locations of the lexical token TOKEN.
-Return a pair (START . END)."
-  (if (not (numberp (car (cdr token))))
-      (cdr (cdr token))
-    (cdr token)))
-
-(defsubst semantic-lex-token-start (token)
-  "Fetch the start position of the lexical token TOKEN.
-See also the function `semantic-lex-token'."
-  (car (semantic-lex-token-bounds token)))
-
-(defsubst semantic-lex-token-end (token)
-  "Fetch the end position of the lexical token TOKEN.
-See also the function `semantic-lex-token'."
-  (cdr (semantic-lex-token-bounds token)))
-
 (defsubst semantic-lex-token-text (token)
   "Fetch the text associated with the lexical token TOKEN.
 See also the function `semantic-lex-token'."
@@ -1084,19 +1103,6 @@ Optional argument DEPTH is the depth to scan into lists."
 ;; Created analyzers become variables with the code associated with them
 ;; as the symbol value.  These analyzers are assembled into a lexer
 ;; to create new lexical analyzers.
-;;
-(defsubst semantic-lex-unterminated-syntax-detected (syntax)
-  "Inside a lexical analyzer, use this when unterminated syntax was found.
-Argument SYNTAX indicates the type of syntax that is unterminated.
-The job of this function is to move (point) to a new logical location
-so that analysis can continue, if possible."
-  (goto-char
-   (funcall semantic-lex-unterminated-syntax-end-function
-           syntax
-           (car semantic-lex-analysis-bounds)
-           (cdr semantic-lex-analysis-bounds)
-           ))
-  (setq semantic-lex-end-point (point)))
 
 (defcustom semantic-lex-debug-analyzers nil
   "Non nil means to debug analyzers with syntax protection.
diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el
new file mode 100644 (file)
index 0000000..1115ef7
--- /dev/null
@@ -0,0 +1,677 @@
+;;; texi.el --- Semantic details for Texinfo files
+
+;;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Parse Texinfo buffers using regular expressions.  The core parser
+;; engine is the function `semantic-texi-parse-headings'.  The
+;; parser plug-in is the function `semantic-texi-parse-region' that
+;; overrides `semantic-parse-region'.
+
+(require 'semantic)
+(require 'semantic/format)
+(require 'texinfo)
+
+(eval-when-compile
+  (require 'semantic/db)
+  (require 'semantic/db-find)
+  (require 'semantic/ctxt)
+  (require 'semantic/imenu)
+  (require 'semantic/doc)
+  (require 'senator))
+
+(defvar semantic-texi-super-regex
+  "^@\\(top\\|chapter\\|\\(sub\\)*section\\|unnumbered\\(\\(sub\\)*sec\\)?\\|\
+\\(chap\\|\\(sub\\)+\\|major\\)?heading\\|appendix\\(\\(sub\\)*sec\\)?\\|\
+centerchap\\|def\\(var\\|un\\|fn\\|opt\\)x?\\)"
+  "Regular expression used to find special sections in a Texinfo file.")
+
+(defvar semantic-texi-name-field-list
+  '( ("defvar" . 1)
+     ("defvarx" . 1)
+     ("defun" . 1)
+     ("defunx" . 1)
+     ("defopt" . 1)
+     ("deffn" . 2)
+     ("deffnx" . 2)
+     )
+  "List of definition commands, and the field position.
+The field position is the field number (based at 1) where the
+name of this section is.")
+
+;;; Code:
+(defun semantic-texi-parse-region (&rest ignore)
+  "Parse the current texinfo buffer for semantic tags.
+IGNORE any arguments, always parse the whole buffer.
+Each tag returned is of the form:
+ (\"NAME\" section (:members CHILDREN))
+or
+ (\"NAME\" def)
+
+It is an override of 'parse-region and must be installed by the
+function `semantic-install-function-overrides'."
+  (mapcar 'semantic-texi-expand-tag
+          (semantic-texi-parse-headings)))
+
+(defun semantic-texi-parse-changes ()
+  "Parse changes in the current texinfo buffer."
+  ;; NOTE: For now, just schedule a full reparse.
+  ;;       To be implemented later.
+  (semantic-parse-tree-set-needs-rebuild))
+
+(defun semantic-texi-expand-tag (tag)
+  "Expand the texinfo tag TAG."
+  (let ((chil (semantic-tag-components tag)))
+    (if chil
+        (semantic-tag-put-attribute
+         tag :members (mapcar 'semantic-texi-expand-tag chil)))
+    (car (semantic--tag-expand tag))))
+
+(defun semantic-texi-parse-headings ()
+  "Parse the current texinfo buffer for all semantic tags now."
+  (let ((pass1 nil))
+    ;; First search and snarf.
+    (save-excursion
+      (goto-char (point-min))
+      (let ((semantic--progress-reporter
+            (make-progress-reporter
+             (format "Parsing %s..."
+                     (file-name-nondirectory buffer-file-name))
+             (point-min) (point-max))))
+       (while (re-search-forward semantic-texi-super-regex nil t)
+         (setq pass1 (cons (match-beginning 0) pass1))
+         (progress-reporter-update semantic--progress-reporter (point)))
+       (progress-reporter-done semantic--progress-reporter)))
+    (setq pass1 (nreverse pass1))
+    ;; Now, make some tags while creating a set of children.
+    (car (semantic-texi-recursive-combobulate-list pass1 0))
+    ))
+
+(defsubst semantic-texi-new-section-tag (name members start end)
+  "Create a semantic tag of class section.
+NAME is the name of this section.
+MEMBERS is a list of semantic tags representing the elements that make
+up this section.
+START and END define the location of data described by the tag."
+  (append (semantic-tag name 'section :members members)
+          (list start end)))
+
+(defsubst semantic-texi-new-def-tag (name start end)
+  "Create a semantic tag of class def.
+NAME is the name of this definition.
+START and END define the location of data described by the tag."
+  (append (semantic-tag name 'def)
+          (list start end)))
+
+(defun semantic-texi-set-endpoint (metataglist pnt)
+  "Set the end point of the first section tag in METATAGLIST to PNT.
+METATAGLIST is a list of tags in the intermediate tag format used by the
+texinfo parser.  PNT is the new point to set."
+  (let ((metatag nil))
+    (while (and metataglist
+               (not (eq (semantic-tag-class (car metataglist)) 'section)))
+      (setq metataglist (cdr metataglist)))
+    (setq metatag (car metataglist))
+    (when metatag
+      (setcar (nthcdr (1- (length metatag)) metatag) pnt)
+      metatag)))
+
+(defun semantic-texi-recursive-combobulate-list (sectionlist level)
+  "Rearrange SECTIONLIST to be a hierarchical tag list starting at LEVEL.
+Return the rearranged new list, with all remaining tags from
+SECTIONLIST starting at ELT 2.  Sections not are not dealt with as soon as a
+tag with greater section value than LEVEL is found."
+  (let ((newl nil)
+       (oldl sectionlist)
+        tag
+       )
+    (save-excursion
+      (catch 'level-jump
+       (while oldl
+         (goto-char (car oldl))
+         (if (looking-at "@\\(\\w+\\)")
+             (let* ((word (match-string 1))
+                    (levelmatch (assoc word texinfo-section-list))
+                    text begin tmp
+                    )
+               ;; Set begin to the right location
+               (setq begin (point))
+               ;; Get out of here if there if we made it that far.
+               (if (and levelmatch (<= (car (cdr levelmatch)) level))
+                   (progn
+                     (when newl
+                       (semantic-texi-set-endpoint newl begin))
+                     (throw 'level-jump t)))
+               ;; Recombobulate
+               (if levelmatch
+                   (let ((end (match-end 1)))
+                     ;; Levels sometimes have a @node just in front.
+                     ;; That node statement should be included in the space
+                     ;; for this entry.
+                     (save-excursion
+                       (skip-chars-backward "\n \t")
+                       (beginning-of-line)
+                       (when (looking-at "@node\\>")
+                         (setq begin (point))))
+                     ;; When there is a match, the descriptive text
+                     ;; consists of the rest of the line.
+                     (goto-char end)
+                     (skip-chars-forward " \t")
+                     (setq text (buffer-substring-no-properties
+                                 (point)
+                                 (progn (end-of-line) (point))))
+                     ;; Next, recurse into the body to find the end.
+                     (setq tmp (semantic-texi-recursive-combobulate-list
+                                (cdr oldl) (car (cdr levelmatch))))
+                     ;; Build a tag
+                      (setq tag (semantic-texi-new-section-tag
+                                 text (car tmp) begin (point)))
+                     ;; Before appending the newtag, update the previous tag
+                     ;; if it is a section tag.
+                     (when newl
+                       (semantic-texi-set-endpoint newl begin))
+                     ;; Append new tag to our master list.
+                     (setq newl (cons tag newl))
+                     ;; continue
+                     (setq oldl (cdr tmp))
+                     )
+                 ;; No match means we have a def*, so get the name from
+                 ;; it based on the type of thingy we found.
+                 (setq levelmatch (assoc word semantic-texi-name-field-list)
+                       tmp (or (cdr levelmatch) 1))
+                 (forward-sexp tmp)
+                 (skip-chars-forward " \t")
+                 (setq text (buffer-substring-no-properties
+                             (point)
+                             (progn (forward-sexp 1) (point))))
+                 ;; Seek the end of this definition
+                 (goto-char begin)
+                 (semantic-texi-forward-deffn)
+                  (setq tag (semantic-texi-new-def-tag text begin (point))
+                        newl (cons tag newl))
+                 ;; continue
+                 (setq oldl (cdr oldl)))
+               )
+           (error "Problem finding section in semantic/texi parser"))
+         ;; (setq oldl (cdr oldl))
+         )
+       ;; When oldl runs out, force a new endpoint as point-max
+       (when (not oldl)
+         (semantic-texi-set-endpoint newl (point-max)))
+       ))
+    (cons (nreverse newl) oldl)))
+
+(defun semantic-texi-forward-deffn ()
+  "Move forward over one deffn type definition.
+The cursor should be on the @ sign."
+  (when (looking-at "@\\(\\w+\\)")
+    (let* ((type (match-string 1))
+          (seek (concat "^@end\\s-+" (regexp-quote type))))
+      (re-search-forward seek nil t))))
+
+(define-mode-local-override semantic-tag-components
+  texinfo-mode (tag)
+  "Return components belonging to TAG."
+  (semantic-tag-get-attribute tag :members))
+
+\f
+;;; Overrides: Context Parsing
+;;
+;; How to treat texi as a language?
+;;
+(defvar semantic-texi-environment-regexp
+  (if (string-match texinfo-environment-regexp "@menu")
+      ;; Make sure our Emacs has menus in it.
+      texinfo-environment-regexp
+    ;; If no menus, then merge in the menu concept.
+    (when (string-match "cartouche" texinfo-environment-regexp)
+      (concat (substring texinfo-environment-regexp
+                        0 (match-beginning 0))
+             "menu\\|"
+              (substring texinfo-environment-regexp
+                        (match-beginning 0)))))
+  "Regular expression for matching texinfo enviroments.
+uses `texinfo-environment-regexp', but makes sure that it
+can handle the @menu environment.")
+
+(define-mode-local-override semantic-up-context texinfo-mode ()
+  "Handle texinfo constructs which do not use parenthetical nesting."
+  (let ((done nil))
+    (save-excursion
+      (let ((parenthetical (semantic-up-context-default))
+           )
+       (when (not parenthetical)
+         ;; We are in parenthises.  Are they the types of parens
+         ;; belonging to a texinfo construct?
+         (forward-word -1)
+         (when (looking-at "@\\w+{")
+           (setq done (point))))))
+    ;; If we are not in a parenthetical node, then find a block instead.
+    ;; Use the texinfo support to find block start/end constructs.
+    (save-excursion
+      (while (and (not done)
+                 (re-search-backward  semantic-texi-environment-regexp nil t))
+       ;; For any hit, if we find an @end foo, then jump to the
+       ;; matching @foo.  If it is not an end, then we win!
+       (if (not (looking-at "@end\\s-+\\(\\w+\\)"))
+           (setq done (point))
+         ;; Skip over this block
+         (let ((env (match-string 1)))
+           (re-search-backward (concat "@" env))))
+       ))
+    ;; All over, post what we find.
+    (if done
+       ;; We found something, so use it.
+       (progn (goto-char done)
+              nil)
+      t)))
+
+(define-mode-local-override semantic-beginning-of-context texinfo-mode (&optional point)
+  "Move to the beginning of the context surrounding POINT."
+  (if (semantic-up-context point)
+      ;; If we can't go up, we can't do this either.
+      t
+    ;; We moved, so now we need to skip into whatever this thing is.
+    (forward-word 1) ;; skip the command
+    (if (looking-at "\\s-*{")
+       ;; In a short command.  Go in.
+       (down-list 1)
+      ;; An environment.  Go to the next line.
+      (end-of-line)
+      (forward-char 1))
+    nil))
+
+(define-mode-local-override semantic-ctxt-current-class-list
+  texinfo-mode (&optional point)
+  "Determine the class of tags that can be used at POINT.
+For texinfo, there two possibilities returned.
+1) 'function - for a call to a texinfo function
+2) 'word     - indicates an english word.
+It would be nice to know function arguments too, but not today."
+  (let ((sym (semantic-ctxt-current-symbol)))
+    (if (and sym (= (aref (car sym) 0) ?@))
+       '(function)
+      '(word))))
+
+\f
+;;; Overrides : Formatting
+;;
+;; Various override to better format texi tags.
+;;
+
+(define-mode-local-override semantic-format-tag-abbreviate
+  texinfo-mode  (tag &optional parent color)
+  "Texinfo tags abbreviation."
+  (let ((class (semantic-tag-class tag))
+       (name (semantic-format-tag-name tag parent color))
+       )
+    (cond ((eq class 'function)
+          (concat name "{ }"))
+         (t (semantic-format-tag-abbreviate-default tag parent color)))
+    ))
+
+(define-mode-local-override semantic-format-tag-prototype
+  texinfo-mode  (tag &optional parent color)
+  "Texinfo tags abbreviation."
+  (semantic-format-tag-abbreviate tag parent color))
+
+\f
+;;; Texi Unique Features
+;;
+(defun semantic-tag-texi-section-text-bounds (tag)
+  "Get the bounds to the text of TAG.
+The text bounds is the text belonging to this node excluding
+the text of any child nodes, but including any defuns."
+  (let ((memb (semantic-tag-components tag)))
+    ;; Members.. if one is a section, check it out.
+    (while (and memb (not (semantic-tag-of-class-p (car memb) 'section)))
+      (setq memb (cdr memb)))
+    ;; No members? ... then a simple problem!
+    (if (not memb)
+       (semantic-tag-bounds tag)
+      ;; Our end is their beginning...
+      (list (semantic-tag-start tag) (semantic-tag-start (car memb))))))
+
+(defun semantic-texi-current-environment (&optional point)
+  "Return as a string the type of the current environment.
+Optional argument POINT is where to look for the environment."
+  (save-excursion
+    (when point (goto-char (point)))
+    (while (and (or (not (looking-at  semantic-texi-environment-regexp))
+                   (looking-at "@end"))
+               (not (semantic-up-context)))
+      )
+    (when (looking-at  semantic-texi-environment-regexp)
+      (match-string 1))))
+
+\f
+;;; Analyzer
+;;
+(eval-when-compile
+  (require 'semantic/analyze))
+
+(define-mode-local-override semantic-analyze-current-context
+  texinfo-mode (point)
+  "Analysis context makes no sense for texinfo.  Return nil."
+  (let* ((prefixandbounds (semantic-ctxt-current-symbol-and-bounds (point)))
+        (prefix (car prefixandbounds))
+        (bounds (nth 2 prefixandbounds))
+        (prefixclass (semantic-ctxt-current-class-list))
+        )
+    (when prefix
+      (require 'semantic-analyze)
+      (semantic-analyze-context
+       "Context-for-texinfo"
+       :buffer (current-buffer)
+       :scope nil
+       :bounds bounds
+       :prefix prefix
+       :prefixtypes nil
+       :prefixclass prefixclass)
+      )
+    ))
+
+(defvar semantic-texi-command-completion-list
+  (append (mapcar (lambda (a) (car a)) texinfo-section-list)
+         (condition-case nil
+             texinfo-environments
+           (error
+            ;; XEmacs doesn't use the above.  Split up its regexp
+            (split-string texinfo-environment-regexp "\\\\|\\|\\^@\\\\(\\|\\\\)")
+            ))
+         ;; Is there a better list somewhere?  Here are few
+         ;; of the top of my head.
+         "anchor" "asis"
+         "bullet"
+         "code" "copyright"
+         "defun" "deffn" "defoption" "defvar" "dfn"
+         "emph" "end"
+         "ifinfo" "iftex" "inforef" "item" "itemx"
+         "kdb"
+         "node"
+         "ref"
+         "set" "setfilename" "settitle"
+         "value" "var"
+         "xref"
+         )
+  "List of commands that we might bother completing.")
+
+(define-mode-local-override semantic-analyze-possible-completions
+  texinfo-mode (context)
+  "List smart completions at point.
+Since texinfo is not a programming language the default version is not
+useful.  Insted, look at the current symbol.  If it is a command
+do primitive texinfo built ins.  If not, use ispell to lookup words
+that start with that symbol."
+  (let ((prefix (car (oref context :prefix)))
+       )
+    (cond ((member 'function (oref context :prefixclass))
+          ;; Do completion for texinfo commands
+          (let* ((cmd (substring prefix 1))
+                 (lst (all-completions
+                       cmd semantic-texi-command-completion-list)))
+            (mapcar (lambda (f) (semantic-tag (concat "@" f) 'function))
+                    lst))
+          )
+         ((member 'word (oref context :prefixclass))
+          ;; Do completion for words via ispell.
+          (require 'ispell)
+          (let ((word-list (lookup-words prefix)))
+            (mapcar (lambda (f) (semantic-tag f 'word)) word-list))
+          )
+         (t nil))
+    ))
+
+\f
+;;; Parser Setup
+;;
+(defun semantic-default-texi-setup ()
+  "Set up a buffer for parsing of Texinfo files."
+  ;; This will use our parser.
+  (semantic-install-function-overrides
+   '((parse-region . semantic-texi-parse-region)
+     (parse-changes . semantic-texi-parse-changes)))
+  (setq semantic-parser-name "TEXI"
+        ;; Setup a dummy parser table to enable parsing!
+        semantic--parse-table t
+        imenu-create-index-function 'semantic-create-imenu-index
+       semantic-command-separation-character "@"
+       semantic-type-relation-separator-character '(":")
+       semantic-symbol->name-assoc-list '((section . "Section")
+                                          (def . "Definition")
+                                          )
+       semantic-imenu-expandable-tag-classes '(section)
+       semantic-imenu-bucketize-file nil
+       semantic-imenu-bucketize-type-members nil
+       senator-step-at-start-end-tag-classes '(section)
+       semantic-stickyfunc-sticky-classes '(section)
+       )
+  (local-set-key [(f9)] 'semantic-texi-update-doc-from-texi)
+  )
+
+(add-hook 'texinfo-mode-hook 'semantic-default-texi-setup)
+
+\f
+;;; Special features of Texinfo tag streams
+;;
+;; This section provides specialized access into texinfo files.
+;; Because texinfo files often directly refer to functions and programs
+;; it is useful to access the texinfo file from the C code for document
+;; maintainance.
+(defun semantic-texi-associated-files (&optional buffer)
+  "Find texinfo files associated with BUFFER."
+  (save-excursion
+    (if buffer (set-buffer buffer))
+    (cond ((and (fboundp 'ede-documentation-files)
+                ede-minor-mode (ede-current-project))
+          ;; When EDE is active, ask it.
+          (ede-documentation-files)
+          )
+         ((and (featurep 'semanticdb) (semanticdb-minor-mode-p))
+          ;; See what texinfo files we have loaded in the database
+          (let ((tabs (semanticdb-get-database-tables
+                       semanticdb-current-database))
+                (r nil))
+            (while tabs
+              (if (eq (oref (car tabs) major-mode) 'texinfo-mode)
+                  (setq r (cons (oref (car tabs) file) r)))
+              (setq tabs (cdr tabs)))
+            r))
+         (t
+          (directory-files default-directory nil "\\.texi$"))
+         )))
+
+;; Turns out this might not be useful.
+;; Delete later if that is true.
+(defun semantic-texi-find-documentation (name &optional type)
+  "Find the function or variable NAME of TYPE in the texinfo source.
+NAME is a string representing some functional symbol.
+TYPE is a string, such as \"variable\" or \"Command\" used to find
+the correct definition in case NAME qualifies as several things.
+When this function exists, POINT is at the definition.
+If the doc was not found, an error is thrown.
+Note: TYPE not yet implemented."
+  (let ((f (semantic-texi-associated-files))
+       stream match)
+    (while (and f (not match))
+      (unless stream
+       (with-current-buffer (find-file-noselect (car f))
+         (setq stream (semantic-fetch-tags))))
+      (setq match (semantic-find-first-tag-by-name name stream))
+      (when match
+       (set-buffer (semantic-tag-buffer match))
+       (goto-char (semantic-tag-start match)))
+      (setq f (cdr f)))))
+
+(defun semantic-texi-update-doc-from-texi (&optional tag)
+  "Update the documentation in the texinfo deffn class tag TAG.
+The current buffer must be a texinfo file containing TAG.
+If TAG is nil, determine a tag based on the current position."
+  (interactive)
+  (unless (or (featurep 'semanticdb) (semanticdb-minor-mode-p))
+    (error "Texinfo updating only works when `semanticdb' is being used"))
+  (semantic-fetch-tags)
+  (unless tag
+    (beginning-of-line)
+    (setq tag (semantic-current-tag)))
+  (unless (semantic-tag-of-class-p tag 'def)
+    (error "Only deffns (or defun or defvar) can be updated"))
+  (let* ((name (semantic-tag-name tag))
+        (tags (semanticdb-strip-find-results
+               (semanticdb-with-match-any-mode
+                 (semanticdb-brute-deep-find-tags-by-name name))
+               'name))
+        (docstring nil)
+        (docstringproto nil)
+        (docstringvar nil)
+        (doctag nil)
+        (doctagproto nil)
+        (doctagvar nil)
+        )
+    (save-excursion
+      (while (and tags (not docstring))
+       (let ((sourcetag (car tags)))
+         ;; There could be more than one!  Come up with a better
+         ;; solution someday.
+         (when (semantic-tag-buffer sourcetag)
+           (set-buffer (semantic-tag-buffer sourcetag))
+           (unless (eq major-mode 'texinfo-mode)
+           (cond ((semantic-tag-get-attribute sourcetag :prototype-flag)
+                  ;; If we found a match with doc that is a prototype, then store
+                  ;; that, but don't exit till we find the real deal.
+                  (setq docstringproto (semantic-documentation-for-tag sourcetag)
+                        doctagproto sourcetag))
+                 ((eq (semantic-tag-class sourcetag) 'variable)
+                  (setq docstringvar (semantic-documentation-for-tag sourcetag)
+                        doctagvar sourcetag))
+                 ((semantic-tag-get-attribute sourcetag :override-function-flag)
+                  nil)
+                 (t
+                  (setq docstring (semantic-documentation-for-tag sourcetag))))
+           (setq doctag (if docstring sourcetag nil))))
+         (setq tags (cdr tags)))))
+    ;; If we found a prototype of the function that has some doc, but not the
+    ;; actual function, lets make due with that.
+    (if (not docstring)
+       (cond ((stringp docstringvar)
+              (setq docstring docstringvar
+                    doctag doctagvar))
+             ((stringp docstringproto)
+              (setq docstring docstringproto
+                    doctag doctagproto))))
+    ;; Test for doc string
+    (unless docstring
+      (error "Could not find documentation for %s" (semantic-tag-name tag)))
+    ;; If we have a string, do the replacement.
+    (delete-region (semantic-tag-start tag)
+                  (semantic-tag-end tag))
+    ;; Use useful functions from the docaument library.
+    (require 'document)
+    (document-insert-texinfo doctag (semantic-tag-buffer doctag))
+    ))
+
+(defun semantic-texi-update-doc-from-source (&optional tag)
+  "Update the documentation for the source TAG.
+The current buffer must be a non-texinfo source file containing TAG.
+If TAG is nil, determine the tag based on the current position.
+The current buffer must include TAG."
+  (interactive)
+  (when (eq major-mode 'texinfo-mode)
+    (error "Not a source file"))
+  (semantic-fetch-tags)
+  (unless tag
+    (setq tag (semantic-current-tag)))
+  (unless (semantic-documentation-for-tag tag)
+    (error "Cannot find interesting documentation to use for %s"
+          (semantic-tag-name tag)))
+  (let* ((name (semantic-tag-name tag))
+        (texi (semantic-texi-associated-files))
+        (doctag nil)
+        (docbuff nil))
+    (while (and texi (not doctag))
+      (set-buffer (find-file-noselect (car texi)))
+      (setq doctag (car (semantic-deep-find-tags-by-name
+                        name (semantic-fetch-tags)))
+           docbuff (if doctag (current-buffer) nil))
+      (setq texi (cdr texi)))
+    (unless doctag
+      (error "Tag %s is not yet documented.  Use the `document' command"
+             name))
+    ;; Ok, we should have everything we need.  Do the deed.
+    (if (get-buffer-window docbuff)
+       (set-buffer docbuff)
+      (switch-to-buffer docbuff))
+    (goto-char (semantic-tag-start doctag))
+    (delete-region (semantic-tag-start doctag)
+                  (semantic-tag-end doctag))
+    ;; Use useful functions from the document library.
+    (require 'document)
+    (document-insert-texinfo tag (semantic-tag-buffer tag))
+    ))
+
+(defun semantic-texi-update-doc (&optional tag)
+  "Update the documentation for TAG.
+If the current buffer is a texinfo file, then find the source doc, and
+update it.  If the current buffer is a source file, then get the
+documentation for this item, find the existing doc in the associated
+manual, and update that."
+  (interactive)
+  (cond ((eq major-mode 'texinfo-mode)
+        (semantic-texi-update-doc-from-texi tag))
+       (t
+        (semantic-texi-update-doc-from-source tag))))
+
+(defun semantic-texi-goto-source (&optional tag)
+  "Jump to the source for the definition in the texinfo file TAG.
+If TAG is nil, it is derived from the deffn under POINT."
+  (interactive)
+  (unless (or (featurep 'semanticdb) (semanticdb-minor-mode-p))
+    (error "Texinfo updating only works when `semanticdb' is being used"))
+  (semantic-fetch-tags)
+  (unless tag
+    (beginning-of-line)
+    (setq tag (semantic-current-tag)))
+  (unless (semantic-tag-of-class-p tag 'def)
+    (error "Only deffns (or defun or defvar) can be updated"))
+  (let* ((name (semantic-tag-name tag))
+        (tags (semanticdb-fast-strip-find-results
+               (semanticdb-with-match-any-mode
+                 (semanticdb-brute-deep-find-tags-by-name name nil 'name))
+               ))
+
+        (done nil)
+        )
+    (save-excursion
+      (while (and tags (not done))
+       (set-buffer (semantic-tag-buffer (car tags)))
+       (unless (eq major-mode 'texinfo-mode)
+         (switch-to-buffer (semantic-tag-buffer (car tags)))
+         (goto-char (semantic-tag-start (car tags)))
+         (setq done t))
+       (setq tags (cdr tags)))
+      (if (not done)
+         (error "Could not find tag for %s" (semantic-tag-name tag)))
+      )))
+
+(provide 'semantic/texi)
+
+;;; semantic-texi.el ends here