changeset 104435:52067a6bf088

semantic/cedet/db-global.el, semantic/cedet/ia-sb.el, semantic/cedet/sb.el, semantic/cedet/scope.el: New files.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/semantic/db-global.el	Sun Aug 30 14:36:00 2009 +0000
@@ -0,0 +1,248 @@
+;;; semantic/db-global.el --- Semantic database extensions for GLOBAL
+
+;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <[e-mail]>
+;; Keywords: tags
+
+;; 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:
+;;
+;; Use GNU Global for by-name database searches.
+;;
+;; This will work as an "omniscient" database for a given project.
+;;
+
+(require 'cedet-global)
+(require 'semantic/db-search)
+(require 'semantic/symref/global)
+
+(eval-when-compile
+  ;; For generic function searching.
+  (require 'eieio)
+  (require 'eieio-opt)
+  )
+;;; Code:
+(defun semanticdb-enable-gnu-global-databases (mode)
+  "Enable the use of the GNU Global SemanticDB back end for all files of MODE.
+This will add an instance of a GNU Global database to each buffer
+in a GNU Global supported hierarchy."
+  (interactive
+   (list (completing-read
+          "Emable in Mode: " obarray
+          #'(lambda (s) (get s 'mode-local-symbol-table))
+          t (symbol-name major-mode))))
+
+  ;; First, make sure the version is ok.
+  (cedet-gnu-global-version-check)
+
+  ;; Make sure mode is a symbol.
+  (when (stringp mode)
+    (setq mode (intern mode)))
+
+  (let ((ih (mode-local-value mode 'semantic-init-mode-hooks)))
+    (eval `(setq-mode-local
+	    ,mode semantic-init-mode-hooks
+	    (cons 'semanticdb-enable-gnu-global-hook ih))))
+
+  )
+
+(defun semanticdb-enable-gnu-global-hook ()
+  "Add support for GNU Global in the current buffer via semantic-init-hook.
+MODE is the major mode to support."
+  (semanticdb-enable-gnu-global-in-buffer t))
+
+(defun semanticdb-enable-gnu-global-in-buffer (&optional dont-err-if-not-available)
+  "Enable a GNU Global database in the current buffer.
+Argument DONT-ERR-IF-NOT-AVAILABLE will throw an error if GNU Global
+is not available for this directory."
+  (interactive "P")
+  (if (cedet-gnu-global-root)
+      (setq
+       ;; Add to the system database list.
+       semanticdb-project-system-databases
+       (cons (semanticdb-project-database-global "global")
+	     semanticdb-project-system-databases)
+       ;; Apply the throttle.
+       semanticdb-find-default-throttle
+       (append semanticdb-find-default-throttle
+	       '(omniscience))
+       )
+    (if dont-err-if-not-available
+	(message "No Global support in %s" default-directory)
+      (error "No Global support in %s" default-directory))
+    ))
+
+;;; Classes:
+(defclass semanticdb-table-global (semanticdb-search-results-table)
+  ((major-mode :initform nil)
+   )
+  "A table for returning search results from GNU Global.")
+
+(defclass semanticdb-project-database-global
+  ;; @todo - convert to one DB per directory.
+  (semanticdb-project-database eieio-instance-tracker)
+  ()
+  "Database representing a GNU Global tags file.")
+
+(defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
+  "Return t, pretend that this table's mode is equivalent to BUFFER.
+Equivalent modes are specified by by `semantic-equivalent-major-modes'
+local variable."
+  ;; @todo - hack alert!
+  t)
+
+;;; Filename based methods
+;;
+(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-global))
+  "For a global database, there are no explicit tables.
+For each file hit, get the traditional semantic table from that file."
+  ;; We need to return something since there is always the "master table"
+  ;; The table can then answer file name type questions.
+  (when (not (slot-boundp obj 'tables))
+    (let ((newtable (semanticdb-table-global "GNU Global Search Table")))
+      (oset obj tables (list newtable))
+      (oset newtable parent-db obj)
+      (oset newtable tags nil)
+      ))
+
+  (call-next-method))
+
+(defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
+  "From OBJ, return FILENAME's associated table object."
+  ;; We pass in "don't load".  I wonder if we need to avoid that or not?
+  (car (semanticdb-get-database-tables obj))
+  )
+
+;;; Search Overrides
+;;
+;; Only NAME based searches work with GLOBAL as that is all it tracks.
+;;
+(defmethod semanticdb-find-tags-by-name-method
+  ((table semanticdb-table-global) name &optional tags)
+  "Find all tags named NAME in TABLE.
+Return a list of tags."
+  (if tags
+      ;; If TAGS are passed in, then we don't need to do work here.
+      (call-next-method)
+    ;; Call out to GNU Global for some results.
+    (let* ((semantic-symref-tool 'global)
+	   (result (semantic-symref-find-tags-by-name name 'project))
+	   )
+      (when result
+	;; We could ask to keep the buffer open, but that annoys
+	;; people.
+	(semantic-symref-result-get-tags result))
+      )))
+
+(defmethod semanticdb-find-tags-by-name-regexp-method
+  ((table semanticdb-table-global) regex &optional tags)
+  "Find all tags with name matching REGEX in TABLE.
+Optional argument TAGS is a list of tags to search.
+Return a list of tags."
+  (if tags (call-next-method)
+    ;; YOUR IMPLEMENTATION HERE
+    (let* ((semantic-symref-tool 'global)
+	   (result (semantic-symref-find-tags-by-regexp regex 'project))
+	   )
+      (when result
+	(semantic-symref-result-get-tags result))
+      )))
+
+(defmethod semanticdb-find-tags-for-completion-method
+  ((table semanticdb-table-global) prefix &optional tags)
+  "In TABLE, find all occurances of tags matching PREFIX.
+Optional argument TAGS is a list of tags to search.
+Returns a table of all matching tags."
+  (if tags (call-next-method)
+    (let* ((semantic-symref-tool 'global)
+	   (result (semantic-symref-find-tags-by-completion prefix 'project))
+	   (faketags nil)
+	   )
+      (when result
+	(dolist (T (oref result :hit-text))
+	  ;; We should look up each tag one at a time, but I'm lazy!
+	  ;; Doing this may be good enough.
+	  (setq faketags (cons
+			  (semantic-tag T 'function :faux t)
+			  faketags))
+	  )
+	faketags))))
+
+;;; Deep Searches
+;;
+;; If your language does not have a `deep' concept, these can be left
+;; alone, otherwise replace with implementations similar to those
+;; above.
+;;
+(defmethod semanticdb-deep-find-tags-by-name-method
+  ((table semanticdb-table-global) name &optional tags)
+  "Find all tags name NAME in TABLE.
+Optional argument TAGS is a list of tags t
+Like `semanticdb-find-tags-by-name-method' for global."
+  (semanticdb-find-tags-by-name-method table name tags))
+
+(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+  ((table semanticdb-table-global) regex &optional tags)
+  "Find all tags with name matching REGEX in TABLE.
+Optional argument TAGS is a list of tags to search.
+Like `semanticdb-find-tags-by-name-method' for global."
+  (semanticdb-find-tags-by-name-regexp-method table regex tags))
+
+(defmethod semanticdb-deep-find-tags-for-completion-method
+  ((table semanticdb-table-global) prefix &optional tags)
+  "In TABLE, find all occurances of tags matching PREFIX.
+Optional argument TAGS is a list of tags to search.
+Like `semanticdb-find-tags-for-completion-method' for global."
+  (semanticdb-find-tags-for-completion-method table prefix tags))
+
+;;; TEST
+;;
+;; Here is a testing fcn to try out searches via the GNU Global database.
+(defvar semanticdb-test-gnu-global-startfile "~/src/global-5.7.3/global/global.c"
+  "File to use for testing.")
+
+(defun semanticdb-test-gnu-global (searchfor &optional standardfile)
+  "Test the GNU Global semanticdb.
+Argument SEARCHFOR is the text to search for.
+If optional arg STANDARDFILE is non nil, use a standard file w/ global enabled."
+  (interactive "sSearch For Tag: \nP")
+
+  (require 'data-debug)
+  (save-excursion
+    (when standardfile
+      (set-buffer (find-file-noselect semanticdb-test-gnu-global-startfile)))
+
+    (condition-case err
+	(semanticdb-enable-gnu-global-in-buffer)
+      (error (if standardfile
+		 (error err)
+	       (set-buffer (find-file-noselect semanticdb-test-gnu-global-startfile))
+	       (semanticdb-enable-gnu-global-in-buffer))))
+
+    (let* ((db (semanticdb-project-database-global "global"))
+	   (tab (semanticdb-file-table db (buffer-file-name)))
+	   (result (semanticdb-deep-find-tags-for-completion-method tab searchfor))
+	   )
+      (data-debug-new-buffer "*SemanticDB Gnu Global Result*")
+      (data-debug-insert-thing result "?" "")
+      )))
+
+(provide 'semantic/db-global)
+
+;;; semantic/db-global.el ends here

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/semantic/ia-sb.el	Sun Aug 30 14:36:00 2009 +0000
@@ -0,0 +1,367 @@
+;;; semantic/ia-sb.el --- Speedbar analysis display interactor
+
+;;; Copyright (C) 2002, 2003, 2004, 2006, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <[e-mail]>
+;; 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:
+;;
+;; Speedbar node for displaying derived context information.
+;;
+
+(require 'semantic/analyze)
+(require 'speedbar)
+
+;;; Code:
+(defvar semantic-ia-sb-key-map nil
+  "Keymap used when in semantic analysis display mode.")
+
+(if semantic-ia-sb-key-map
+    nil
+  (setq semantic-ia-sb-key-map (speedbar-make-specialized-keymap))
+
+  ;; Basic featuers.
+  (define-key semantic-ia-sb-key-map "\C-m" 'speedbar-edit-line)
+  (define-key semantic-ia-sb-key-map "I" 'semantic-ia-sb-show-tag-info)
+  )
+
+(defvar semantic-ia-sb-easymenu-definition
+  '( "---"
+;     [ "Expand" speedbar-expand-line nil ]
+;     [ "Contract" speedbar-contract-line nil ]
+     [ "Tag Information" semantic-ia-sb-show-tag-info t ]
+     [ "Jump to Tag" speedbar-edit-line t ]
+     [ "Complete" speedbar-edit-line t ]
+     )
+  "Extra menu items Analysis mode.")
+
+;; Make sure our special speedbar major mode is loaded
+(speedbar-add-expansion-list '("Analyze"
+			       semantic-ia-sb-easymenu-definition
+			       semantic-ia-sb-key-map
+			       semantic-ia-speedbar))
+
+(speedbar-add-mode-functions-list
+ (list "Analyze"
+       ;;'(speedbar-item-info . eieio-speedbar-item-info)
+       '(speedbar-line-directory . semantic-ia-sb-line-path)))
+
+(defun semantic-speedbar-analysis ()
+  "Start Speedbar in semantic analysis mode.
+The analyzer displays information about the current context, plus a smart
+list of possible completions."
+  (interactive)
+  ;; Make sure that speedbar is active
+  (speedbar-frame-mode 1)
+  ;; Now, throw us into Analyze  mode on speedbar.
+  (speedbar-change-initial-expansion-list "Analyze")
+  )
+
+(defun semantic-ia-speedbar (directory zero)
+  "Create buttons in speedbar which define the current analysis at POINT.
+DIRECTORY is the current directory, which is ignored, and ZERO is 0."
+  (let ((analysis nil)
+	(scope nil)
+	(buffer nil)
+	(completions nil)
+	(cf (selected-frame))
+	(cnt nil)
+	(mode-local-active-mode nil)
+	)
+    ;; Try and get some sort of analysis
+    (condition-case nil
+	(progn
+	  (speedbar-select-attached-frame)
+	  (setq buffer (current-buffer))
+	  (setq mode-local-active-mode major-mode)
+	  (save-excursion
+	    ;; Get the current scope
+	    (setq scope (semantic-calculate-scope (point)))
+	    ;; Get the analysis
+	    (setq analysis (semantic-analyze-current-context (point)))
+	    (setq cnt (semantic-find-tag-by-overlay))
+	    (when analysis
+	      (setq completions (semantic-analyze-possible-completions analysis))
+	      )
+	    ))
+      (error nil))
+    (select-frame cf)
+    (save-excursion
+      (set-buffer speedbar-buffer)
+      ;; If we have something, do something spiff with it.
+      (erase-buffer)
+      (speedbar-insert-separator "Buffer/Function")
+      ;; Note to self: Turn this into an expandable file name.
+      (speedbar-make-tag-line 'bracket ?  nil nil
+			      (buffer-name buffer)
+			      nil nil 'speedbar-file-face 0)
+
+      (when cnt
+	(semantic-ia-sb-string-list cnt
+				    'speedbar-tag-face
+				    'semantic-sb-token-jump))
+      (when analysis
+	;; If this analyzer happens to point at a complete symbol, then
+	;; see if we can dig up some documentation for it.
+	(semantic-ia-sb-show-doc analysis))
+
+      (when analysis
+	;; Let different classes draw more buttons.
+	(semantic-ia-sb-more-buttons analysis)
+	(when completions
+	  (speedbar-insert-separator "Completions")
+	  (semantic-ia-sb-completion-list completions
+					  'speedbar-tag-face
+					  'semantic-ia-sb-complete))
+	)
+
+      ;; Show local variables
+      (when scope
+	(semantic-ia-sb-show-scope scope))
+
+      )))
+
+(defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context))
+  "Show documentation about CONTEXT iff CONTEXT points at a complete symbol."
+  (let ((sym (car (reverse (oref context prefix))))
+	(doc nil))
+    (when (semantic-tag-p sym)
+      (setq doc (semantic-documentation-for-tag sym))
+      (when doc
+	(speedbar-insert-separator "Documentation")
+	(insert doc)
+	(insert "\n")
+	))
+    ))
+
+(defun semantic-ia-sb-show-scope (scope)
+  "Show SCOPE information."
+  (let ((localvars (when scope
+		     (oref scope localvar)))
+	)
+    (when localvars
+      (speedbar-insert-separator "Local Variables")
+      (semantic-ia-sb-string-list localvars
+				  'speedbar-tag-face
+				  ;; This is from semantic-sb
+				  'semantic-sb-token-jump))))
+
+(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context))
+  "Show a set of speedbar buttons specific to CONTEXT."
+  (let ((prefix (oref context prefix)))
+    (when prefix
+      (speedbar-insert-separator "Prefix")
+      (semantic-ia-sb-string-list prefix
+				  'speedbar-tag-face
+				  'semantic-sb-token-jump))
+    ))
+
+(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment))
+  "Show a set of speedbar buttons specific to CONTEXT."
+  (call-next-method)
+  (let ((assignee (oref context assignee)))
+    (when assignee
+      (speedbar-insert-separator "Assignee")
+      (semantic-ia-sb-string-list assignee
+				  'speedbar-tag-face
+				  'semantic-sb-token-jump))))
+
+(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg))
+  "Show a set of speedbar buttons specific to CONTEXT."
+  (call-next-method)
+  (let ((func (oref context function)))
+    (when func
+      (speedbar-insert-separator "Function")
+      (semantic-ia-sb-string-list func
+				  'speedbar-tag-face
+				  'semantic-sb-token-jump)
+      ;; An index for the argument the prefix is in:
+      (let ((arg (oref context argument))
+	    (args (semantic-tag-function-arguments (car func)))
+	    (idx 0)
+	    )
+	(speedbar-insert-separator
+	 (format "Argument #%d" (oref context index)))
+	(if args
+	    (semantic-ia-sb-string-list args
+					'speedbar-tag-face
+					'semantic-sb-token-jump
+					(oref context index)
+					'speedbar-selected-face)
+	  ;; Else, no args list, so use what the context had.
+	  (semantic-ia-sb-string-list arg
+				      'speedbar-tag-face
+				      'semantic-sb-token-jump))
+	))))
+
+(defun semantic-ia-sb-string-list (list face function &optional idx idxface)
+  "Create some speedbar buttons from LIST.
+Each button will use FACE, and be activated with FUNCTION.
+Optional IDX is an index into LIST to apply IDXFACE instead."
+  (let ((count 1))
+    (while list
+      (let* ((usefn nil)
+	     (string (cond ((stringp (car list))
+			    (car list))
+			   ((semantic-tag-p (car list))
+			    (setq usefn (semantic-tag-with-position-p (car list)))
+			    (semantic-format-tag-uml-concise-prototype (car list)))
+			   (t "<No Tag>")))
+	     (localface (if (or (not idx) (/= idx count))
+			    face
+			  idxface))
+	     )
+	(if (semantic-tag-p (car list))
+	    (speedbar-make-tag-line 'angle ?i
+				    'semantic-ia-sb-tag-info (car list)
+				    string (if usefn function) (car list) localface
+				    0)
+	  (speedbar-make-tag-line 'statictag ??
+				  nil nil
+				  string (if usefn function) (car list) localface
+				  0))
+	(setq list (cdr list)
+	      count (1+ count)))
+      )))
+
+(defun semantic-ia-sb-completion-list (list face function)
+  "Create some speedbar buttons from LIST.
+Each button will use FACE, and be activated with FUNCTION."
+  (while list
+    (let* ((documentable nil)
+	   (string (cond ((stringp (car list))
+			  (car list))
+			 ((semantic-tag-p (car list))
+			  (setq documentable t)
+			  (semantic-format-tag-uml-concise-prototype (car list)))
+			(t "foo"))))
+      (if documentable
+	  (speedbar-make-tag-line 'angle ?i
+				  'semantic-ia-sb-tag-info
+				  (car list)
+				  string function (car list) face
+				  0)
+	(speedbar-make-tag-line 'statictag ?  nil nil
+				string function (car list) face
+				0))
+      (setq list (cdr list)))))
+
+(defun semantic-ia-sb-show-tag-info ()
+  "Display information about the tag on the current line.
+Same as clicking on the <i> button.
+See `semantic-ia-sb-tag-info' for more."
+  (interactive)
+  (let ((tok nil))
+    (save-excursion
+      (end-of-line)
+      (forward-char -1)
+      (setq tok (get-text-property (point) 'speedbar-token)))
+    (semantic-ia-sb-tag-info nil tok 0)))
+
+(defun semantic-ia-sb-tag-info (text tag indent)
+  "Display as much information as we can about tag.
+Show the information in a shrunk split-buffer and expand
+out as many details as possible.
+TEXT, TAG, and INDENT are speedbar function arguments."
+  (when (semantic-tag-p tag)
+    (unwind-protect
+	(let ((ob nil))
+	  (speedbar-select-attached-frame)
+	  (setq ob (current-buffer))
+	  (with-output-to-temp-buffer "*Tag Information*"
+	    ;; Output something about this tag:
+	    (save-excursion
+	      (set-buffer "*Tag Information*")
+	      (goto-char (point-max))
+	      (insert
+	       (semantic-format-tag-prototype tag nil t)
+	       "\n")
+	      (let ((typetok
+		     (condition-case nil
+			 (save-excursion
+			   (set-buffer ob)
+			   ;; @todo - We need a context to derive a scope from.
+			   (semantic-analyze-tag-type tag nil))
+		       (error nil))))
+		(if typetok
+		    (insert (semantic-format-tag-prototype
+			     typetok nil t))
+		  ;; No type found by the analyzer
+		  ;; The below used to try and select the buffer from the last
+		  ;; analysis, but since we are already in the correct buffer, I
+		  ;; don't think that is needed.
+		  (let ((type (semantic-tag-type tag)))
+		    (cond ((semantic-tag-p type)
+			   (setq type (semantic-tag-name type)))
+			  ((listp type)
+			   (setq type (car type))))
+		    (if (semantic-lex-keyword-p type)
+			(setq typetok
+			      (semantic-lex-keyword-get type 'summary))))
+		  (if typetok
+		      (insert typetok))
+		  ))
+	      ))
+	  ;; Make it small
+	  (shrink-window-if-larger-than-buffer
+	   (get-buffer-window "*Tag Information*")))
+      (select-frame speedbar-frame))))
+
+(defun semantic-ia-sb-line-path (&optional depth)
+  "Return the file name associated with DEPTH."
+  (save-match-data
+    (let* ((tok (speedbar-line-token))
+	   (buff (if (semantic-tag-buffer tok)
+		     (semantic-tag-buffer tok)
+		   (current-buffer))))
+      (buffer-file-name buff))))
+
+(defun semantic-ia-sb-complete (text tag indent)
+  "At point in the attached buffer, complete the symbol clicked on.
+TEXT TAG and INDENT are the details."
+  ;; Find the specified bounds from the current analysis.
+  (speedbar-select-attached-frame)
+  (unwind-protect
+      (let* ((a (semantic-analyze-current-context (point)))
+	     (bounds (oref a bounds))
+	     (movepoint nil)
+	     )
+	(save-excursion
+	  (if (and (<= (point) (cdr bounds)) (>= (point) (car bounds)))
+	      (setq movepoint t))
+	  (goto-char (car bounds))
+	  (delete-region (car bounds) (cdr bounds))
+	  (insert (semantic-tag-name tag))
+	  (if movepoint (setq movepoint (point)))
+	  ;; I'd like to use this to add fancy () or what not at the end
+	  ;; but we need the parent file whih requires an upgrade to the
+	  ;; analysis tool.
+	  ;;(semantic-insert-foreign-tag tag ??))
+	  )
+	(if movepoint
+	    (let ((cf (selected-frame)))
+	      (speedbar-select-attached-frame)
+	      (goto-char movepoint)
+	      (select-frame cf))))
+    (select-frame speedbar-frame)))
+
+(provide 'semantic/ia-sb)
+
+;;; semantic/ia-sb.el ends here

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/semantic/sb.el	Sun Aug 30 14:36:00 2009 +0000
@@ -0,0 +1,419 @@
+;;; semantic/sb.el --- Semantic tag display for speedbar
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;;; 2007, 2008 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <[e-mail]>
+;; 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:
+;;
+;; Convert a tag table into speedbar buttons.
+
+;;; TODO:
+
+;; Use semanticdb to find which semanticdb-table is being used for each
+;; file/tag.  Replace `semantic-sb-with-tag-buffer' to instead call
+;; children with the new `with-mode-local' instead.
+
+(require 'semantic)
+(require 'semantic/util)
+(require 'speedbar)
+;; (require 'inversion)
+;; (eval-and-compile
+;;   (inversion-require 'speedbar "0.15beta1"))
+
+(defcustom semantic-sb-autoexpand-length 1
+  "*Length of a semantic bucket to autoexpand in place.
+This will replace the named bucket that would have usually occured here."
+  :group 'speedbar
+  :type 'integer)
+
+(defcustom semantic-sb-button-format-tag-function 'semantic-format-tag-abbreviate
+  "*Function called to create the text for a but from a token."
+  :group 'speedbar
+  :type semantic-format-tag-custom-list)
+
+(defcustom semantic-sb-info-format-tag-function 'semantic-format-tag-summarize
+  "*Function called to create the text for info display from a token."
+  :group 'speedbar
+  :type semantic-format-tag-custom-list)
+
+;;; Code:
+;;
+
+;;; Buffer setting for correct mode manipulation.
+(defun semantic-sb-tag-set-buffer (tag)
+  "Set the current buffer to something associated with TAG.
+use the `speedbar-line-file' to get this info if needed."
+  (if (semantic-tag-buffer tag)
+      (set-buffer (semantic-tag-buffer tag))
+    (let ((f (speedbar-line-file)))
+      (set-buffer (find-file-noselect f)))))
+
+(defmacro semantic-sb-with-tag-buffer (tag &rest forms)
+  "Set the current buffer to the origin of TAG and execute FORMS.
+Restore the old current buffer when completed."
+  `(save-excursion
+     (semantic-sb-tag-set-buffer ,tag)
+     ,@forms))
+(put 'semantic-sb-with-tag-buffer 'lisp-indent-function 1)
+
+;;; Button Generation
+;;
+;;  Here are some button groups:
+;;
+;;  +> Function ()
+;;     @ return_type
+;;    +( arg1
+;;    +| arg2
+;;    +) arg3
+;;
+;;  +> Variable[1] =
+;;    @ type
+;;    = default value
+;;
+;;  +> keywrd Type
+;;   +> type part
+;;
+;;  +>  -> click to see additional information
+
+(define-overloadable-function semantic-sb-tag-children-to-expand (tag)
+  "For TAG, return a list of children that TAG expands to.
+If this returns a value, then a +> icon is created.
+If it returns nil, then a => icon is created.")
+
+(defun semantic-sb-tag-children-to-expand-default (tag)
+  "For TAG, the children for type, variable, and function classes."
+  (semantic-sb-with-tag-buffer tag
+    (semantic-tag-components tag)))
+
+(defun semantic-sb-one-button (tag depth &optional prefix)
+  "Insert TAG as a speedbar button at DEPTH.
+Optional PREFIX is used to specify special marker characters."
+  (let* ((class (semantic-tag-class tag))
+	 (edata (semantic-sb-tag-children-to-expand tag))
+	 (type (semantic-tag-type tag))
+	 (abbrev (semantic-sb-with-tag-buffer tag
+		   (funcall semantic-sb-button-format-tag-function tag)))
+	 (start (point))
+	 (end (progn
+		(insert (int-to-string depth) ":")
+		(point))))
+    (insert-char ?  (1- depth) nil)
+    (put-text-property end (point) 'invisible nil)
+    ;; take care of edata = (nil) -- a yucky but hard to clean case
+    (if (and edata (listp edata) (and (<= (length edata) 1) (not (car edata))))
+	(setq edata nil))
+    (if (and (not edata)
+	     (member class '(variable function))
+	     type)
+	(setq edata t))
+    ;; types are a bit unique.  Variable types can have special meaning.
+    (if edata
+	(speedbar-insert-button (if prefix (concat " +" prefix) " +>")
+				'speedbar-button-face
+				'speedbar-highlight-face
+				'semantic-sb-show-extra
+				tag t)
+      (speedbar-insert-button (if prefix (concat "  " prefix) " =>")
+			      nil nil nil nil t))
+    (speedbar-insert-button abbrev
+			    'speedbar-tag-face
+			    'speedbar-highlight-face
+			    'semantic-sb-token-jump
+			    tag t)
+    ;; This is very bizarre.  When this was just after the insertion
+    ;; of the depth: text, the : would get erased, but only for the
+    ;; auto-expanded short- buckets.  Move back for a later version
+    ;; version of Emacs 21 CVS
+    (put-text-property start end 'invisible t)
+    ))
+
+(defun semantic-sb-speedbar-data-line (depth button text &optional
+					     text-fun text-data)
+  "Insert a semantic token data element.
+DEPTH is the current depth.  BUTTON is the text for the button.
+TEXT is the actual info with TEXT-FUN to occur when it happens.
+Argument TEXT-DATA is the token data to pass to TEXT-FUN."
+  (let ((start (point))
+	(end (progn
+	       (insert (int-to-string depth) ":")
+	       (point))))
+    (put-text-property start end 'invisible t)
+    (insert-char ?  depth nil)
+    (put-text-property end (point) 'invisible nil)
+    (speedbar-insert-button button nil nil nil nil t)
+    (speedbar-insert-button text
+			    'speedbar-tag-face
+			    (if text-fun 'speedbar-highlight-face)
+			    text-fun text-data t)
+    ))
+
+(defun semantic-sb-maybe-token-to-button (obj indent &optional
+					      prefix modifiers)
+  "Convert OBJ, which was returned from the semantic parser, into a button.
+This OBJ might be a plain string (simple type or untyped variable)
+or a complete tag.
+Argument INDENT is the indentation used when making the button.
+Optional PREFIX is the character to use when marking the line.
+Optional MODIFIERS is additional text needed for variables."
+  (let ((myprefix (or prefix ">")))
+    (if (stringp obj)
+	(semantic-sb-speedbar-data-line indent myprefix obj)
+      (if (listp obj)
+	  (progn
+	    (if (and (stringp (car obj))
+		     (= (length obj) 1))
+		(semantic-sb-speedbar-data-line indent myprefix
+						(concat
+						 (car obj)
+						 (or modifiers "")))
+	      (semantic-sb-one-button obj indent prefix)))))))
+
+(defun semantic-sb-insert-details (tag indent)
+  "Insert details about TAG at level INDENT."
+  (let ((tt (semantic-tag-class tag))
+	(type (semantic-tag-type tag)))
+    (cond ((eq tt 'type)
+	   (let ((parts (semantic-tag-type-members tag))
+		 (newparts nil))
+	     ;; Lets expect PARTS to be a list of either strings,
+	     ;; or variable tokens.
+	     (when (semantic-tag-p (car parts))
+	       ;; Bucketize into groups
+	       (semantic-sb-with-tag-buffer (car parts)
+		 (setq newparts (semantic-bucketize parts)))
+	       (when (> (length newparts) semantic-sb-autoexpand-length)
+		 ;; More than one bucket, insert inline
+		 (semantic-sb-insert-tag-table (1- indent) newparts)
+		 (setq parts nil))
+	       ;; Dump the strings in.
+	       (while parts
+		 (semantic-sb-maybe-token-to-button (car parts) indent)
+		 (setq parts (cdr parts))))))
+	  ((eq tt 'variable)
+	   (if type
+	       (semantic-sb-maybe-token-to-button type indent "@"))
+	   (let ((default (semantic-tag-variable-default tag)))
+	     (if default
+		 (semantic-sb-maybe-token-to-button default indent "=")))
+	   )
+	  ((eq tt 'function)
+	   (if type
+	       (semantic-sb-speedbar-data-line
+		indent "@"
+		(if (stringp type) type
+		  (semantic-tag-name type))))
+	   ;; Arguments to the function
+	   (let ((args (semantic-tag-function-arguments tag)))
+	     (if (and args (car args))
+		 (progn
+		   (semantic-sb-maybe-token-to-button (car args) indent "(")
+		   (setq args (cdr args))
+		   (while (> (length args) 1)
+		     (semantic-sb-maybe-token-to-button (car args)
+							indent
+							"|")
+		     (setq args (cdr args)))
+		   (if args
+		       (semantic-sb-maybe-token-to-button
+			(car args) indent ")"))
+		   ))))
+	  (t
+	   (let ((components
+		  (save-excursion
+		    (when (and (semantic-tag-overlay tag)
+			       (semantic-tag-buffer tag))
+		      (set-buffer (semantic-tag-buffer tag)))
+		    (semantic-sb-tag-children-to-expand tag))))
+	     ;; Well, it wasn't one of the many things we expect.
+	     ;; Lets just insert them in with no decoration.
+	     (while components
+	       (semantic-sb-one-button (car components) indent)
+	       (setq components (cdr components)))
+	     ))
+	  )
+    ))
+
+(defun semantic-sb-detail-parent ()
+  "Return the first parent token of the current line that includes a location."
+  (save-excursion
+    (beginning-of-line)
+    (let ((dep (if (looking-at "[0-9]+:")
+		   (1- (string-to-number (match-string 0)))
+		 0)))
+      (re-search-backward (concat "^"
+				  (int-to-string dep)
+				  ":")
+			  nil t))
+    (beginning-of-line)
+    (if (looking-at "[0-9]+: +[-+][>()@|] \\([^\n]+\\)$")
+	(let ((prop nil))
+	  (goto-char (match-beginning 1))
+	  (setq prop (get-text-property (point) 'speedbar-token))
+	  (if (semantic-tag-with-position-p prop)
+	      prop
+	    (semantic-sb-detail-parent)))
+      nil)))
+
+(defun semantic-sb-show-extra (text token indent)
+  "Display additional information about the token as an expansion.
+TEXT TOKEN and INDENT are the details."
+  (cond ((string-match "+" text)	;we have to expand this file
+	 (speedbar-change-expand-button-char ?-)
+	 (speedbar-with-writable
+	   (save-excursion
+	     (end-of-line) (forward-char 1)
+	     (save-restriction
+	       (narrow-to-region (point) (point))
+	       ;; Add in stuff specific to this type of token.
+	       (semantic-sb-insert-details token (1+ indent))))))
+	((string-match "-" text)	;we have to contract this node
+	 (speedbar-change-expand-button-char ?+)
+	 (speedbar-delete-subblock indent))
+	(t (error "Ooops...  not sure what to do")))
+  (speedbar-center-buffer-smartly))
+
+(defun semantic-sb-token-jump (text token indent)
+  "Jump to the location specified in token.
+TEXT TOKEN and INDENT are the details."
+  (let ((file
+	 (or
+	  (cond ((fboundp 'speedbar-line-path)
+		 (speedbar-line-directory indent))
+		((fboundp 'speedbar-line-directory)
+		 (speedbar-line-directory indent)))
+	  ;; If speedbar cannot figure this out, extract the filename from
+	  ;; the token.  True for Analysis mode.
+	  (semantic-tag-file-name token)))
+	(parent (semantic-sb-detail-parent)))
+    (let ((f (selected-frame)))
+      (dframe-select-attached-frame speedbar-frame)
+      (run-hooks 'speedbar-before-visiting-tag-hook)
+      (select-frame f))
+    ;; Sometimes FILE may be nil here.  If you are debugging a problem
+    ;; when this happens, go back and figure out why FILE is nil and try
+    ;; and fix the source.
+    (speedbar-find-file-in-frame file)
+    (save-excursion (speedbar-stealthy-updates))
+    (semantic-go-to-tag token parent)
+    (switch-to-buffer (current-buffer))
+    ;; Reset the timer with a new timeout when cliking a file
+    ;; in case the user was navigating directories, we can cancel
+    ;; that other timer.
+    ;; (speedbar-set-timer dframe-update-speed)
+    ;;(recenter)
+    (speedbar-maybee-jump-to-attached-frame)
+    (run-hooks 'speedbar-visiting-tag-hook)))
+
+(defun semantic-sb-expand-group (text token indent)
+  "Expand a group which has semantic tokens.
+TEXT TOKEN and INDENT are the details."
+  (cond ((string-match "+" text)	;we have to expand this file
+	 (speedbar-change-expand-button-char ?-)
+	 (speedbar-with-writable
+	   (save-excursion
+	     (end-of-line) (forward-char 1)
+	     (save-restriction
+	       (narrow-to-region (point-min) (point))
+	       (semantic-sb-buttons-plain (1+ indent) token)))))
+	((string-match "-" text)	;we have to contract this node
+	 (speedbar-change-expand-button-char ?+)
+	 (speedbar-delete-subblock indent))
+	(t (error "Ooops...  not sure what to do")))
+  (speedbar-center-buffer-smartly))
+
+(defun semantic-sb-buttons-plain (level tokens)
+  "Create buttons at LEVEL using TOKENS."
+  (let ((sordid (speedbar-create-tag-hierarchy tokens)))
+    (while sordid
+      (cond ((null (car-safe sordid)) nil)
+	    ((consp (car-safe (cdr-safe (car-safe sordid))))
+	     ;; A group!
+	     (speedbar-make-tag-line 'curly ?+ 'semantic-sb-expand-group
+				     (cdr (car sordid))
+				     (car (car sordid))
+				     nil nil 'speedbar-tag-face
+				     level))
+	    (t ;; Assume that this is a token.
+	     (semantic-sb-one-button (car sordid) level)))
+      (setq sordid (cdr sordid)))))
+
+(defun semantic-sb-insert-tag-table (level table)
+  "At LEVEL, insert the tag table TABLE.
+Use arcane knowledge about the semantic tokens in the tagged elements
+to create much wiser decisions about how to sort and group these items."
+  (semantic-sb-buttons level table))
+
+(defun semantic-sb-buttons (level lst)
+  "Create buttons at LEVEL using LST sorting into type buckets."
+  (save-restriction
+    (narrow-to-region (point-min) (point))
+    (let (tmp)
+      (while lst
+	(setq tmp (car lst))
+	(if (cdr tmp)
+	    (if (<= (length (cdr tmp)) semantic-sb-autoexpand-length)
+		(semantic-sb-buttons-plain (1+ level) (cdr tmp))
+	      (speedbar-make-tag-line 'curly ?+ 'semantic-sb-expand-group
+				      (cdr tmp)
+				      (car (car lst))
+				      nil nil 'speedbar-tag-face
+				      (1+ level))))
+	(setq lst (cdr lst))))))
+
+(defun semantic-sb-fetch-tag-table (file)
+  "Load FILE into a buffer, and generate tags using the Semantic parser.
+Returns the tag list, or t for an error."
+  (let ((out nil))
+    (if (and (featurep 'semanticdb) (semanticdb-minor-mode-p)
+	     (not speedbar-power-click)
+	     ;; If the database is loaded and running, try to get
+	     ;; tokens from it.
+	     (setq out (semanticdb-file-stream file)))
+	;; Successful DB query.
+	nil
+      ;; No database, do it the old way.
+      (save-excursion
+	(set-buffer (find-file-noselect file))
+	(if (or (not (featurep 'semantic))
+		(not semantic--parse-table))
+	    (setq out t)
+	  (if speedbar-power-click (semantic-clear-toplevel-cache))
+	  (setq out (semantic-fetch-tags)))))
+    (if (listp out)
+	(condition-case nil
+	    (progn
+	      ;; This brings externally defind methods into
+	      ;; their classes, and creates meta classes for
+	      ;; orphans.
+	      (setq out (semantic-adopt-external-members out))
+	      ;; Dump all the tokens into buckets.
+	      (semantic-sb-with-tag-buffer (car out)
+		(semantic-bucketize out)))
+	  (error t))
+      t)))
+
+;; Link ourselves into the tagging process.
+(add-to-list 'speedbar-dynamic-tags-function-list
+	     '(semantic-sb-fetch-tag-table  . semantic-sb-insert-tag-table))
+
+(provide 'semantic/sb)
+
+;;; semantic/sb.el ends here

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/semantic/scope.el	Sun Aug 30 14:36:00 2009 +0000
@@ -0,0 +1,796 @@
+;;; semantic/scope.el --- Analyzer Scope Calculations
+
+;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <[e-mail]>
+
+;; 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:
+;;
+;; Calculate information about the current scope.
+;;
+;; Manages the current scope as a structure that can be cached on a
+;; per-file basis and recycled between different occurances of
+;; analysis on different parts of a file.
+;;
+;; Pattern for Scope Calculation
+;;
+;; Step 1: Calculate DataTypes in Scope:
+;;
+;; a) What is in scope via using statements or local namespaces
+;; b) Lineage of current context.  Some names drawn from step 1.
+;;
+;; Step 2: Convert type names into lists of concrete tags
+;;
+;; a) Convert each datatype into the real datatype tag
+;; b) Convert namespaces into the list of contents of the namespace.
+;; c) Merge all existing scopes together into one search list.
+;;
+;; Step 3: Local variables
+;;
+;; a) Local variables are in the master search list.
+;;
+
+(require 'semantic/db)
+(require 'semantic/analyze/fcn)
+(require 'semantic/ctxt)
+
+
+;;; Code:
+
+(defclass semantic-scope-cache (semanticdb-abstract-cache)
+  ((tag :initform nil
+	:documentation
+	"The tag this scope was calculated for.")
+   (scopetypes :initform nil
+	       :documentation
+	       "The list of types currently in scope.
+For C++, this would contain anonymous namespaces known, and
+anything labled by a `using' statement.")
+   (parents :initform nil
+	    :documentation
+	    "List of parents in scope w/in the body of this function.
+Presumably, the members of these parent classes are available for access
+based on private:, or public: style statements.")
+   (parentinheritance :initform nil
+		      :documentation "Alist of parents by inheritance.
+Each entry is ( PARENT . PROTECTION ), where PARENT is a type, and
+PROTECTION is a symbol representing the level of inheritance, such as 'private, or 'protected.")
+   (scope :initform nil
+	  :documentation
+	  "Items in scope due to the scopetypes or parents.")
+   (fullscope :initform nil
+	      :documentation
+	      "All the other stuff on one master list you can search.")
+   (localargs :initform nil
+	      :documentation
+	      "The arguments to the function tag.")
+   (localvar :initform nil
+	     :documentation
+	     "The local variables.")
+   (typescope :initform nil
+	      :documentation
+	      "Slot to save intermediate scope while metatypes are dereferenced.")
+   )
+  "Cache used for storage of the current scope by the Semantic Analyzer.
+Saves scoping information between runs of the analyzer.")
+
+;;; METHODS
+;;
+;; Methods for basic management of the structure in semanticdb.
+;;
+(defmethod semantic-reset ((obj semantic-scope-cache))
+  "Reset OBJ back to it's empty settings."
+  (oset obj tag nil)
+  (oset obj scopetypes nil)
+  (oset obj parents nil)
+  (oset obj parentinheritance nil)
+  (oset obj scope nil)
+  (oset obj fullscope nil)
+  (oset obj localargs nil)
+  (oset obj localvar nil)
+  (oset obj typescope nil)
+  )
+
+(defmethod semanticdb-synchronize ((cache semantic-scope-cache)
+				   new-tags)
+  "Synchronize a CACHE with some NEW-TAGS."
+  (semantic-reset cache))
+
+
+(defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
+					   new-tags)
+  "Synchronize a CACHE with some changed NEW-TAGS."
+  ;; If there are any includes or datatypes changed, then clear.
+  (if (or (semantic-find-tags-by-class 'include new-tags)
+	  (semantic-find-tags-by-class 'type new-tags)
+	  (semantic-find-tags-by-class 'using new-tags))
+      (semantic-reset cache))
+  )
+
+(defun semantic-scope-reset-cache ()
+  "Get the current cached scope, and reset it."
+  (when semanticdb-current-table
+    (let ((co (semanticdb-cache-get semanticdb-current-table
+				    semantic-scope-cache)))
+      (semantic-reset co))))
+
+(defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
+					 types-in-scope)
+  "Set the :typescope property on CACHE to some types.
+TYPES-IN-SCOPE is a list of type tags whos members are
+currently in scope.  For each type in TYPES-IN-SCOPE,
+add those members to the types list.
+If nil, then the typescope is reset."
+  (let ((newts nil)) ;; New Type Scope
+    (dolist (onetype types-in-scope)
+      (setq newts (append (semantic-tag-type-members onetype)
+			  newts))
+      )
+    (oset cache typescope newts)))
+
+;;; TAG SCOPES
+;;
+;; These fcns should be used by search routines that return a single
+;; tag which, in turn, may have come from a deep scope.  The scope
+;; will be attached to the tag.  Thus, in future scope based calls, a
+;; tag can be passed in and a scope derived from it.
+
+(defun semantic-scope-tag-clone-with-scope (tag scopetags)
+  "Close TAG, and return it.  Add SCOPETAGS as a tag-local scope.
+Stores the SCOPETAGS as a set of tag properties on the cloned tag."
+  (let ((clone (semantic-tag-clone tag))
+	)
+    (semantic--tag-put-property clone 'scope scopetags)
+    ))
+
+(defun semantic-scope-tag-get-scope (tag)
+  "Get from TAG the list of tags comprising the scope from TAG."
+  (semantic--tag-get-property tag 'scope))
+
+;;; SCOPE UTILITIES
+;;
+;; Functions that do the main scope calculations
+
+
+(define-overloadable-function semantic-analyze-scoped-types (position)
+  "Return a list of types currently in scope at POSITION.
+This is based on what tags exist at POSITION, and any associated
+types available.")
+
+(defun semantic-analyze-scoped-types-default (position)
+  "Return a list of types currently in scope at POSITION.
+Use `semantic-ctxt-scoped-types' to find types."
+  (save-excursion
+    (goto-char position)
+    (let ((code-scoped-types nil))
+      ;; Lets ask if any types are currently scoped.  Scoped
+      ;; classes and types provide their public methods and types
+      ;; in source code, but are unrelated hierarchically.
+      (let ((sp (semantic-ctxt-scoped-types)))
+	(while sp
+	  ;; Get this thing as a tag
+	  (let ((tmp (cond
+		      ((stringp (car sp))
+		       (semanticdb-typecache-find (car sp)))
+		       ;(semantic-analyze-find-tag (car sp) 'type))
+		      ((semantic-tag-p (car sp))
+		       (if (semantic-analyze-tag-prototype-p (car sp))
+			   (semanticdb-typecache-find (semantic-tag-name (car sp)))
+			   ;;(semantic-analyze-find-tag (semantic-tag-name (car sp)) 'type)
+			 (car sp)))
+		      (t nil))))
+	    (when tmp
+	      (setq code-scoped-types
+		    (cons tmp code-scoped-types))))
+	  (setq  sp (cdr sp))))
+      (setq code-scoped-types (nreverse code-scoped-types))
+
+      (when code-scoped-types
+	(semanticdb-typecache-merge-streams code-scoped-types nil))
+
+      )))
+
+;;------------------------------------------------------------
+(define-overloadable-function semantic-analyze-scope-nested-tags (position scopedtypes)
+  "Return a list of types in order of nesting for the context of POSITION.
+If POSITION is in a method with a named parent, find that parent, and
+identify it's scope via overlay instead.
+Optional SCOPETYPES are additional scoped entities in which our parent might
+be found.")
+
+(defun semantic-analyze-scope-nested-tags-default (position scopetypes)
+  "Return a list of types in order of nesting for the context of POSITION.
+If POSITION is in a method with a named parent, find that parent, and
+identify it's scope via overlay instead.
+Optional SCOPETYPES are additional scoped entities in which our parent might
+be found.
+This only finds ONE immediate parent by name.  All other parents returned
+are from nesting data types."
+  (save-excursion
+    (if position (goto-char position))
+    (let* ((stack (reverse (semantic-find-tag-by-overlay (point))))
+	   (tag (car stack))
+	   (pparent (car (cdr stack)))
+	   (returnlist nil)
+	   )
+      ;; In case of arg lists or some-such, throw out non-types.
+      (while (and stack (not (semantic-tag-of-class-p pparent 'type)))
+	(setq stack (cdr stack)
+	            pparent (car (cdr stack))))
+
+      ;; Step 1:
+      ;;    Analyze the stack of tags we are nested in as parents.
+      ;;
+
+      ;; If we have a pparent tag, lets go there
+      ;; an analyze that stack of tags.
+      (when (and pparent (semantic-tag-with-position-p pparent))
+	(semantic-go-to-tag pparent)
+	(setq stack (semantic-find-tag-by-overlay (point)))
+	;; Step one, find the merged version of stack in the typecache.
+	(let* ((stacknames (reverse (mapcar 'semantic-tag-name stack)))
+	       (tc nil)
+	       )
+	  ;; @todo - can we use the typecache ability to
+	  ;;         put a scope into a tag to do this?
+	  (while (and stacknames
+		      (setq tc (semanticdb-typecache-find
+				(reverse stacknames))))
+	    (setq returnlist (cons tc returnlist)
+		  stacknames (cdr stacknames)))
+	  (when (not returnlist)
+	    ;; When there was nothing from the typecache, then just
+	    ;; use what's right here.
+	    (setq stack (reverse stack))
+	    ;; Add things to STACK until we cease finding tags of class type.
+	    (while (and stack (eq (semantic-tag-class (car stack)) 'type))
+	      ;; Otherwise, just add this to the returnlist.
+	      (setq returnlist (cons (car stack) returnlist))
+	      (setq stack (cdr stack)))
+
+	    (setq returnlist (nreverse returnlist))
+	    ))
+	)
+
+      ;; Only do this level of analysis for functions.
+      (when (eq (semantic-tag-class tag) 'function)
+	;; Step 2:
+	;;   If the function tag itself has a "parent" by name, then that
+	;;   parent will exist in the scope we just calculated, so look it
+	;;   up now.
+	;;
+	(let ((p (semantic-tag-function-parent tag)))
+	  (when p
+	    ;; We have a parent, search for it.
+	    (let* ((searchnameraw (cond ((stringp p) p)
+					((semantic-tag-p p)
+					 (semantic-tag-name p))
+					((and (listp p) (stringp (car p)))
+					 (car p))))
+		   (searchname (semantic-analyze-split-name searchnameraw))
+		   (snlist (if (consp searchname)
+			       searchname
+			     (list searchname)))
+		   (fullsearchname nil)
+
+		   (miniscope (semantic-scope-cache "mini"))
+		   ptag)
+
+	      ;; Find the next entry in the refereneced type for
+	      ;; our function, and append to return list till our
+	      ;; returnlist is empty.
+	      (while snlist
+		(setq fullsearchname
+		      (append (mapcar 'semantic-tag-name returnlist)
+			      (list (car snlist)))) ;; Next one
+		(setq ptag
+		      (semanticdb-typecache-find fullsearchname))
+
+		(when (or (not ptag)
+			  (not (semantic-tag-of-class-p ptag 'type)))
+		  (let ((rawscope
+			 (apply 'append
+				(mapcar 'semantic-tag-type-members
+					(cons (car returnlist) scopetypes)
+					)))
+			)
+		    (oset miniscope parents returnlist) ;; Not really accurate, but close
+		    (oset miniscope scope rawscope)
+		    (oset miniscope fullscope rawscope)
+		    (setq ptag
+			  (semantic-analyze-find-tag searchnameraw
+						     'type
+						     miniscope
+						     ))
+		    ))
+
+		(when ptag
+		  (when (and (not (semantic-tag-p ptag))
+			     (semantic-tag-p (car ptag)))
+		    (setq ptag (car ptag)))
+		  (setq returnlist (append returnlist (list ptag)))
+		  )
+
+		(setq snlist (cdr snlist)))
+	      (setq returnlist returnlist)
+	      )))
+	)
+      returnlist
+      )))
+
+(define-overloadable-function semantic-analyze-scope-lineage-tags (parents scopedtypes)
+  "Return the full lineage of tags from PARENTS.
+The return list is of the form ( TAG . PROTECTION ), where TAG is a tag,
+and PROTECTION is the level of protection offered by the relationship.
+Optional SCOPETYPES are additional scoped entities in which our parent might
+be found.")
+
+(defun semantic-analyze-scope-lineage-tags-default (parents scopetypes)
+  "Return the full lineage of tags from PARENTS.
+The return list is of the form ( TAG . PROTECTION ), where TAG is a tag,
+and PROTECTION is the level of protection offered by the relationship.
+Optional SCOPETYPES are additional scoped entities in which our parent might
+be found."
+  (let ((lineage nil)
+	(miniscope (semantic-scope-cache "mini"))
+	)
+    (oset miniscope parents parents)
+    (oset miniscope scope scopetypes)
+    (oset miniscope fullscope scopetypes)
+
+    (dolist (slp parents)
+      (semantic-analyze-scoped-inherited-tag-map
+       slp (lambda (newparent)
+	     (let* ((pname (semantic-tag-name newparent))
+		    (prot (semantic-tag-type-superclass-protection slp pname))
+		    (effectiveprot (cond ((eq prot 'public)
+					  ;; doesn't provide access to private slots?
+					  'protected)
+					 (t prot))))
+	       (push (cons newparent effectiveprot) lineage)
+	       ))
+       miniscope))
+
+    lineage))
+
+
+;;------------------------------------------------------------
+
+(define-overloadable-function semantic-analyze-scoped-tags (typelist parentlist)
+  "Return accessable tags when TYPELIST and PARENTLIST is in scope.
+Tags returned are not in the global name space, but are instead
+scoped inside a class or namespace.  Such items can be referenced
+without use of \"object.function()\" style syntax due to an
+implicit \"object\".")
+
+(defun semantic-analyze-scoped-tags-default (typelist halfscope)
+  "Return accessable tags when TYPELIST and HALFSCOPE is in scope.
+HALFSCOPE is the current scope partially initialized.
+Tags returned are not in the global name space, but are instead
+scoped inside a class or namespace.  Such items can be referenced
+without use of \"object.function()\" style syntax due to an
+implicit \"object\"."
+  (let ((typelist2 nil)
+	(currentscope nil)
+	(parentlist (oref halfscope parents))
+	(miniscope halfscope)
+	)
+    ;; Loop over typelist, and find and merge all namespaces matching
+    ;; the names in typelist.
+    (while typelist
+      (let ((tt (semantic-tag-type (car typelist))))
+	(when (and (stringp tt) (string= tt "namespace"))
+	  ;; By using the typecache, our namespaces are pre-merged.
+	  (setq typelist2 (cons (car typelist) typelist2))
+	  ))
+      (setq typelist (cdr typelist)))
+
+    ;; Loop over the types (which should be sorted by postion
+    ;; adding to the scopelist as we go, and using the scopelist
+    ;; for additional searching!
+    (while typelist2
+      (oset miniscope scope currentscope)
+      (oset miniscope fullscope currentscope)
+      (setq currentscope (append
+			  (semantic-analyze-scoped-type-parts (car typelist2)
+							      miniscope)
+			  currentscope))
+      (setq typelist2 (cdr typelist2)))
+
+    ;; Collect all the types (class, etc) that are in our heratage.
+    ;; These are types that we can extract members from, not those
+    ;; delclared in using statements, or the like.
+    ;; Get the PARENTS including nesting scope for this location.
+    (while parentlist
+      (oset miniscope scope currentscope)
+      (oset miniscope fullscope currentscope)
+      (setq currentscope (append
+			  (semantic-analyze-scoped-type-parts (car parentlist)
+							      miniscope)
+			  currentscope))
+      (setq parentlist (cdr parentlist)))
+
+    ;; Loop over all the items, and collect any type constants.
+    (let ((constants nil))
+      (dolist (T currentscope)
+	(setq constants (append constants
+				(semantic-analyze-type-constants T)))
+	)
+
+      (setq currentscope (append currentscope constants)))
+
+    currentscope))
+
+;;------------------------------------------------------------
+(define-overloadable-function  semantic-analyze-scope-calculate-access (type scope)
+  "Calculate the access class for TYPE as defined by the current SCOPE.
+Access is related to the :parents in SCOPE.  If type is a member of SCOPE
+then access would be 'private.  If TYPE is inherited by a member of SCOPE,
+the access would be 'protected.  Otherwise, access is 'public")
+
+(defun semantic-analyze-scope-calculate-access-default (type scope)
+  "Calculate the access class for TYPE as defined by the current SCOPE."
+  (cond ((semantic-scope-cache-p scope)
+	 (let ((parents (oref scope parents))
+	       (parentsi (oref scope parentinheritance))
+	       )
+	   (catch 'moose
+	     ;; Investigate the parent, and see how it relates to type.
+	     ;; If these tags are basically the same, then we have full access.
+	     (dolist (p parents)
+	       (when (semantic-tag-similar-p type p)
+		 (throw 'moose 'private))
+	       )
+	     ;; Look to see if type is in our list of inherited parents.
+	     (dolist (pi parentsi)
+	       ;; pi is a cons cell ( PARENT . protection)
+	       (let ((pip (car pi))
+		     (piprot (cdr pi)))
+		 (when (semantic-tag-similar-p type pip)
+		   (throw 'moose
+			  ;; protection via inheritance means to pull out different
+			  ;; bits based on protection labels in an opposite way.
+			  (cdr (assoc piprot
+				      '((public . private)
+					(protected . protected)
+					(private . public))))
+			  )))
+	       )
+	     ;; Not in our parentage.  Is type a FRIEND?
+	     (let ((friends (semantic-find-tags-by-class 'friend (semantic-tag-type-members type))))
+	       (dolist (F friends)
+		 (dolist (pi parents)
+		   (if (string= (semantic-tag-name F) (semantic-tag-name pi))
+		       (throw 'moose 'private))
+		   )))
+	     ;; Found nothing, return public
+	     'public)
+	   ))
+	(t 'public)))
+
+(defun semantic-completable-tags-from-type (type)
+  "Return a list of slots that are valid completions from the list of SLOTS.
+If a tag in SLOTS has a named parent, then that implies that the
+tag is not something you can complete from within TYPE."
+  (let ((allslots (semantic-tag-components type))
+	(leftover nil)
+	)
+    (dolist (S allslots)
+      (when (or (not (semantic-tag-of-class-p S 'function))
+		(not (semantic-tag-function-parent S)))
+	(setq leftover (cons S leftover)))
+      )
+    (nreverse leftover)))
+
+(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit protection)
+  "Return all parts of TYPE, a tag representing a TYPE declaration.
+SCOPE is the scope object.
+NOINHERIT turns off searching of inherited tags.
+PROTECTION specifies the type of access requested, such as 'public or 'private."
+  (if (not type)
+      nil
+    (let* ((access (semantic-analyze-scope-calculate-access type scope))
+	   ;; SLOTS are the slots directly a part of TYPE.
+	   (allslots (semantic-completable-tags-from-type type))
+	   (slots (semantic-find-tags-by-scope-protection
+		   access
+		   type allslots))
+	   (fname (semantic-tag-file-name type))
+	   ;; EXTMETH are externally defined methods that are still
+	   ;; a part of this class.
+
+	   ;; @TODO - is this line needed??  Try w/out for a while
+	   ;; @note - I think C++ says no.  elisp might, but methods
+	   ;;         look like defuns, so it makes no difference.
+	   (extmeth nil) ; (semantic-tag-external-member-children type t))
+
+	   ;; INHERITED are tags found in classes that our TYPE tag
+	   ;; inherits from.  Do not do this if it was not requested.
+	   (inherited (when (not noinherit)
+			(semantic-analyze-scoped-inherited-tags type scope
+								access)))
+	   )
+      (when (not (semantic-tag-in-buffer-p type))
+	(let ((copyslots nil))
+	  (dolist (TAG slots)
+	    ;;(semantic--tag-put-property TAG :filename fname)
+	    (if (semantic-tag-file-name TAG)
+		;; If it has a filename, just go with it...
+		(setq copyslots (cons TAG copyslots))
+	      ;; Otherwise, copy the tag w/ the guessed filename.
+	      (setq copyslots (cons (semantic-tag-copy TAG nil fname)
+				    copyslots)))
+	    )
+	  (setq slots (nreverse copyslots))
+	  ))
+      ;; Flatten the database output.
+      (append slots extmeth inherited)
+      )))
+
+(defun semantic-analyze-scoped-inherited-tags (type scope access)
+  "Return all tags that TYPE inherits from.
+Argument SCOPE specify additional tags that are in scope
+whose tags can be searched when needed, OR it may be a scope object.
+ACCESS is the level of access we filter on child supplied tags.
+For langauges with protection on specific methods or slots,
+it should strip out those not accessable by methods of TYPE.
+An ACCESS of 'public means not in a method of a subclass of type.
+A value of 'private means we can access private parts of the originating
+type."
+  (let ((ret nil))
+    (semantic-analyze-scoped-inherited-tag-map
+     type (lambda (p)
+	    (let* ((pname (semantic-tag-name p))
+		   (protection (semantic-tag-type-superclass-protection
+				type pname))
+		   )
+	      (if (and (eq access 'public) (not (eq protection 'public)))
+		  nil ;; Don't do it.
+
+		;; We can get some parts of this type.
+		(setq ret (nconc ret
+				 ;; Do not pull in inherited parts here.  Those
+				 ;; will come via the inherited-tag-map fcn
+				 (semantic-analyze-scoped-type-parts
+				  p scope t protection))
+		      ))))
+     scope)
+    ret))
+
+(defun semantic-analyze-scoped-inherited-tag-map (type fcn scope)
+  "Map all parents of TYPE to FCN.  Return tags of all the types.
+Argument SCOPE specify additional tags that are in scope
+whose tags can be searched when needed, OR it may be a scope object."
+  (let* (;; PARENTS specifies only the superclasses and not
+	 ;; interfaces.  Inheriting from an interfaces implies
+	 ;; you have a copy of all methods locally.  I think.
+	 (parents (semantic-tag-type-superclasses type))
+	 ps pt
+	 (tmpscope scope)
+	 )
+    (save-excursion
+
+      ;; Create a SCOPE just for looking up the parent based on where
+      ;; the parent came from.
+      ;;
+      ;; @TODO - Should we cache these mini-scopes around in Emacs
+      ;;         for recycling later?  Should this become a helpful
+      ;;         extra routine?
+      (when (and parents (semantic-tag-with-position-p type))
+	;; If TYPE has a position, go there and get the scope.
+	(semantic-go-to-tag type)
+
+	;; We need to make a mini scope, and only include the misc bits
+	;; that will help in finding the parent.  We don't really need
+	;; to do any of the stuff related to variables and what-not.
+	(setq tmpscope (semantic-scope-cache "mini"))
+	(let* (;; Step 1:
+	       (scopetypes (semantic-analyze-scoped-types (point)))
+	       (parents (semantic-analyze-scope-nested-tags (point) scopetypes))
+	       ;;(parentinherited (semantic-analyze-scope-lineage-tags parents scopetypes))
+	       (lscope nil)
+	       )
+	  (oset tmpscope scopetypes scopetypes)
+	  (oset tmpscope parents parents)
+	  ;;(oset tmpscope parentinheritance parentinherited)
+
+	  (when (or scopetypes parents)
+	    (setq lscope (semantic-analyze-scoped-tags scopetypes tmpscope))
+	    (oset tmpscope scope lscope))
+	  (oset tmpscope fullscope (append scopetypes lscope parents))
+	  ))
+      ;; END creating tmpscope
+
+      ;; Look up each parent one at a time.
+      (dolist (p parents)
+	(setq ps (cond ((stringp p) p)
+		       ((and (semantic-tag-p p) (semantic-tag-prototype-p p))
+			(semantic-tag-name p))
+		       ((and (listp p) (stringp (car p)))
+			p))
+	      pt (condition-case nil
+		     (or (semantic-analyze-find-tag ps 'type tmpscope)
+			 ;; A backup hack.
+			 (semantic-analyze-find-tag ps 'type scope))
+		   (error nil)))
+
+	(when pt
+	  (funcall fcn pt)
+	  ;; Note that we pass the original SCOPE in while recursing.
+	  ;; so that the correct inheritance model is passed along.
+	  (semantic-analyze-scoped-inherited-tag-map pt fcn scope)
+	  )))
+    nil))
+
+;;; ANALYZER
+;;
+;; Create the scope structure for use in the Analyzer.
+;;
+(defun semantic-calculate-scope (&optional point)
+  "Calculate the scope at POINT.
+If POINT is not provided, then use the current location of point.
+The class returned from the scope calculation is variable
+`semantic-scope-cache'."
+  (interactive)
+  (if (not (and (featurep 'semanticdb) semanticdb-current-database))
+      nil ;; Don't do anything...
+    (if (not point) (setq point (point)))
+    (when (interactive-p)
+      (semantic-fetch-tags)
+      (semantic-scope-reset-cache)
+      )
+    (save-excursion
+      (goto-char point)
+      (let* ((TAG  (semantic-current-tag))
+	     (scopecache
+	      (semanticdb-cache-get semanticdb-current-table
+				    semantic-scope-cache))
+	     )
+	(when (not (semantic-equivalent-tag-p TAG (oref scopecache tag)))
+	  (semantic-reset scopecache))
+	(if (oref scopecache tag)
+	    ;; Even though we can recycle most of the scope, we
+	    ;; need to redo the local variables since those change
+	    ;; as you move about the tag.
+	    (condition-case nil
+		(oset scopecache localvar (semantic-get-all-local-variables))
+	      (error nil))
+
+	  (let* (;; Step 1:
+		 (scopetypes (semantic-analyze-scoped-types point))
+		 (parents (semantic-analyze-scope-nested-tags point scopetypes))
+		 (parentinherited (semantic-analyze-scope-lineage-tags
+				   parents scopetypes))
+		 )
+	    (oset scopecache tag TAG)
+	    (oset scopecache scopetypes scopetypes)
+	    (oset scopecache parents parents)
+	    (oset scopecache parentinheritance parentinherited)
+
+	    (let* (;; Step 2:
+		   (scope (when (or scopetypes parents)
+			    (semantic-analyze-scoped-tags scopetypes scopecache))
+			  )
+		   ;; Step 3:
+		   (localargs (semantic-get-local-arguments))
+		   (localvar (condition-case nil
+				 (semantic-get-all-local-variables)
+			       (error nil)))
+		   )
+
+	      ;; Try looking for parents again.
+	      (when (not parentinherited)
+		(setq parentinherited (semantic-analyze-scope-lineage-tags
+				       parents (append scopetypes scope)))
+		(when parentinherited
+		  (oset scopecache parentinheritance parentinherited)
+		  ;; Try calculating the scope again with the new inherited parent list.
+		  (setq scope (when (or scopetypes parents)
+				(semantic-analyze-scoped-tags scopetypes scopecache))
+			)))
+
+	      ;; Fill out the scope.
+	      (oset scopecache scope scope)
+	      (oset scopecache fullscope (append scopetypes scope parents))
+	      (oset scopecache localargs localargs)
+	      (oset scopecache localvar localvar)
+	      )))
+	;; Make sure we become dependant on the typecache.
+	(semanticdb-typecache-add-dependant scopecache)
+	;; Handy debug output.
+	(when (interactive-p)
+	  (data-debug-show scopecache)
+	  )
+	;; Return ourselves
+	scopecache))))
+
+(defun semantic-scope-find (name &optional class scope-in)
+  "Find the tag with NAME, and optinal CLASS in the current SCOPE-IN.
+Searches various elements of the scope for NAME.  Return ALL the
+hits in order, with the first tag being in the closest scope."
+  (let ((scope (or scope-in (semantic-calculate-scope)))
+	(ans nil))
+    ;; Is the passed in scope really a scope?  if so, look through
+    ;; the options in that scope.
+    (if (semantic-scope-cache-p scope)
+	(let* ((la
+		;; This should be first, but bugs in the
+		;; C parser will turn function calls into
+		;; assumed int return function prototypes.  Yuck!
+		(semantic-find-tags-by-name name (oref scope localargs)))
+	       (lv
+		(semantic-find-tags-by-name name (oref scope localvar)))
+	       (fullscoperaw (oref scope fullscope))
+	       (sc (semantic-find-tags-by-name name fullscoperaw))
+	       (typescoperaw  (oref scope typescope))
+	       (tsc (semantic-find-tags-by-name name typescoperaw))
+	       )
+	  (setq ans
+		(if class
+		    ;; Scan out things not of the right class.
+		    (semantic-find-tags-by-class class (append la lv sc tsc))
+		  (append la lv sc tsc))
+		)
+
+	  (when (and (not ans) (or typescoperaw fullscoperaw))
+	    (let ((namesplit (semantic-analyze-split-name name)))
+	      (when (consp namesplit)
+		;; It may be we need to hack our way through type typescope.
+		(while namesplit
+		  (setq ans (append
+			     (semantic-find-tags-by-name (car namesplit)
+							 typescoperaw)
+			     (semantic-find-tags-by-name (car namesplit)
+							 fullscoperaw)
+			     ))
+		  (if (not ans)
+		      (setq typescoperaw nil)
+		    (when (cdr namesplit)
+		      (setq typescoperaw (semantic-tag-type-members
+					  (car ans)))))
+
+		  (setq namesplit (cdr namesplit)))
+		;; Once done, store the current typecache lookup
+		(oset scope typescope
+		      (append typescoperaw (oref scope typescope)))
+		)))
+	  ;; Return it.
+	  ans)
+      ;; Not a real scope.  Our scope calculation analyze parts of
+      ;; what it finds, and needs to pass lists through to do it's work.
+      ;; Tread that list as a singly entry.
+      (if class
+	  (semantic-find-tags-by-class class scope)
+	scope)
+      )))
+
+;;; DUMP
+;;
+(defmethod semantic-analyze-show ((context semantic-scope-cache))
+  "Insert CONTEXT into the current buffer in a nice way."
+  (semantic-analyze-princ-sequence (oref context scopetypes) "-> ScopeTypes: " )
+  (semantic-analyze-princ-sequence (oref context parents) "-> Parents: " )
+  (semantic-analyze-princ-sequence (oref context scope) "-> Scope: " )
+  ;;(semantic-analyze-princ-sequence (oref context fullscope) "Fullscope:  " )
+  (semantic-analyze-princ-sequence (oref context localargs) "-> Local Args: " )
+  (semantic-analyze-princ-sequence (oref context localvar) "-> Local Vars: " )
+  )
+
+(provide 'semantic/scope)
+
+;;; semantic/scope.el ends here