]> git.eshelyaron.com Git - emacs.git/commitdiff
cedet/semantic/adebug.el, cedet/semantic/chart.el,
authorChong Yidong <cyd@stupidchicken.com>
Sat, 29 Aug 2009 19:32:33 +0000 (19:32 +0000)
committerChong Yidong <cyd@stupidchicken.com>
Sat, 29 Aug 2009 19:32:33 +0000 (19:32 +0000)
cedet/semantic/db-debug.el, cedet/semantic/db-ebrowse.el,
cedet/semantic/db-el.el, cedet/semantic/db-file.el,
cedet/semantic/db-javascript.el, cedet/semantic/db-search.el,
cedet/semantic/db-typecache.el, cedet/semantic/dep.el,
cedet/semantic/ia.el, cedet/semantic/tag-file.el,
cedet/semantic/tag-ls.el: New files.

13 files changed:
lisp/cedet/semantic/adebug.el [new file with mode: 0644]
lisp/cedet/semantic/chart.el [new file with mode: 0644]
lisp/cedet/semantic/db-debug.el [new file with mode: 0644]
lisp/cedet/semantic/db-ebrowse.el [new file with mode: 0644]
lisp/cedet/semantic/db-el.el [new file with mode: 0644]
lisp/cedet/semantic/db-file.el [new file with mode: 0644]
lisp/cedet/semantic/db-javascript.el [new file with mode: 0644]
lisp/cedet/semantic/db-search.el [new file with mode: 0644]
lisp/cedet/semantic/db-typecache.el [new file with mode: 0644]
lisp/cedet/semantic/dep.el [new file with mode: 0644]
lisp/cedet/semantic/ia.el [new file with mode: 0644]
lisp/cedet/semantic/tag-file.el [new file with mode: 0644]
lisp/cedet/semantic/tag-ls.el [new file with mode: 0644]

diff --git a/lisp/cedet/semantic/adebug.el b/lisp/cedet/semantic/adebug.el
new file mode 100644 (file)
index 0000000..fe8e71b
--- /dev/null
@@ -0,0 +1,423 @@
+;;; adebug.el --- Semantic Application Debugger
+
+;;; Copyright (C) 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 datastructure debugger for semantic applications.
+;; Uses data-debug for core implementation.
+;;
+;; Goals:
+;;
+;; Inspect all known details of a TAG in a buffer.
+;;
+;; Analyze the list of active semantic databases, and the tags therin.
+;;
+;; Allow interactive navigation of the analysis process, tags, etc.
+
+(require 'data-debug)
+(require 'eieio-datadebug)
+(require 'semantic/analyze)
+
+;;; Code:
+
+;;; SEMANTIC TAG STUFF
+;;
+(defun data-debug-insert-tag-parts (tag prefix &optional parent)
+  "Insert all the parts of TAG.
+PREFIX specifies what to insert at the start of each line.
+PARENT specifires any parent tag."
+  (data-debug-insert-thing (semantic-tag-name tag)
+                          prefix
+                          "Name: "
+                          parent)
+  (insert prefix "Class: '" (format "%S" (semantic-tag-class tag)) "\n")
+  (when (semantic-tag-with-position-p tag)
+    (let ((ol (semantic-tag-overlay tag))
+         (file (semantic-tag-file-name tag))
+         (start (semantic-tag-start tag))
+         (end (semantic-tag-end tag))
+         )
+      (insert prefix "Position: "
+             (if (and (numberp start) (numberp end))
+                 (format "%d -> %d in " start end)
+               "")
+             (if file (file-name-nondirectory file) "unknown-file")
+             (if (semantic-overlay-p ol)
+                 " <live tag>"
+               "")
+             "\n")
+      (data-debug-insert-thing ol prefix
+                              "Position Data: "
+                              parent)
+      ))
+  (let ((attrprefix (concat (make-string (length prefix) ? ) "# ")))
+    (insert prefix "Attributes:\n")
+    (data-debug-insert-property-list
+     (semantic-tag-attributes tag) attrprefix tag)
+    (insert prefix "Properties:\n")
+    (data-debug-insert-property-list
+     (semantic-tag-properties tag) attrprefix tag)
+    )
+
+  )
+
+(defun data-debug-insert-tag-parts-from-point (point)
+  "Call `data-debug-insert-tag-parts' based on text properties at POINT."
+  (let ((tag (get-text-property point 'ddebug))
+       (parent (get-text-property point 'ddebug-parent))
+       (indent (get-text-property point 'ddebug-indent))
+       start
+       )
+    (end-of-line)
+    (setq start (point))
+    (forward-char 1)
+    (data-debug-insert-tag-parts tag
+                                (concat (make-string indent ? )
+                                        "| ")
+                                parent)
+    (goto-char start)
+    ))
+
+(defun data-debug-insert-tag (tag prefix prebuttontext &optional parent)
+  "Insert TAG into the current buffer at the current point.
+PREFIX specifies text to insert in front of TAG.
+PREBUTTONTEXT is text appearing btewen the prefix and TAG.
+Optional PARENT is the parent tag containing TAG.
+Add text properties needed to allow tag expansion later."
+  (let ((start (point))
+       (end nil)
+       (str (semantic-format-tag-uml-abbreviate tag parent t))
+       (tip (semantic-format-tag-prototype tag parent t))
+       )
+    (insert prefix prebuttontext str "\n")
+    (setq end (point))
+    (put-text-property start end 'ddebug tag)
+    (put-text-property start end 'ddebug-parent parent)
+    (put-text-property start end 'ddebug-indent(length prefix))
+    (put-text-property start end 'ddebug-prefix prefix)
+    (put-text-property start end 'help-echo tip)
+    (put-text-property start end 'ddebug-function
+                      'data-debug-insert-tag-parts-from-point)
+
+    ))
+
+;;; TAG LISTS
+;;
+(defun data-debug-insert-tag-list (taglist prefix &optional parent)
+  "Insert the tag list TAGLIST with PREFIX.
+Optional argument PARENT specifies the part of TAGLIST."
+  (condition-case nil
+      (while taglist
+       (cond ((and (consp taglist) (semantic-tag-p (car taglist)))
+              (data-debug-insert-tag (car taglist) prefix "" parent))
+             ((consp taglist)
+              (data-debug-insert-thing (car taglist) prefix "" parent))
+             (t (data-debug-insert-thing taglist prefix "" parent)))
+       (setq taglist (cdr taglist)))
+    (error nil)))
+
+(defun data-debug-insert-taglist-from-point (point)
+  "Insert the taglist found at the taglist button at POINT."
+  (let ((taglist (get-text-property point 'ddebug))
+       (parent (get-text-property point 'ddebug-parent))
+       (indent (get-text-property point 'ddebug-indent))
+       start
+       )
+    (end-of-line)
+    (setq start (point))
+    (forward-char 1)
+    (data-debug-insert-tag-list taglist
+                               (concat (make-string indent ? )
+                                       "* ")
+                               parent)
+    (goto-char start)
+
+    ))
+
+(defun data-debug-insert-tag-list-button (taglist prefix prebuttontext &optional parent)
+  "Insert a single summary of a TAGLIST.
+PREFIX is the text that preceeds the button.
+PREBUTTONTEXT is some text between PREFIX and the taglist button.
+PARENT is the tag that represents the parent of all the tags."
+  (let ((start (point))
+       (end nil)
+       (str (format "#<TAG LIST: %d entries>" (safe-length taglist)))
+       (tip nil))
+    (insert prefix prebuttontext str)
+    (setq end (point))
+    (put-text-property (- end (length str)) end 'face 'font-lock-function-name-face)
+    (put-text-property start end 'ddebug taglist)
+    (put-text-property start end 'ddebug-parent parent)
+    (put-text-property start end 'ddebug-indent(length prefix))
+    (put-text-property start end 'ddebug-prefix prefix)
+    (put-text-property start end 'help-echo tip)
+    (put-text-property start end 'ddebug-function
+                      'data-debug-insert-taglist-from-point)
+    (insert "\n")
+    ))
+
+;;; SEMANTICDB FIND RESULTS
+;;
+(defun data-debug-insert-find-results (findres prefix)
+  "Insert the find results FINDRES with PREFIX."
+  ;; ( (DBOBJ TAG TAG TAG) (DBOBJ TAG TAG TAG) ... )
+  (let ((cnt 1))
+    (while findres
+      (let* ((dbhit (car findres))
+            (db (car dbhit))
+            (tags (cdr dbhit)))
+       (data-debug-insert-thing db prefix (format "DB %d: " cnt))
+       (data-debug-insert-thing tags prefix (format "HITS %d: " cnt))
+       )
+      (setq findres (cdr findres)
+           cnt (1+ cnt)))))
+
+(defun data-debug-insert-find-results-from-point (point)
+  "Insert the find results found at the find results button at POINT."
+  (let ((findres (get-text-property point 'ddebug))
+       (indent (get-text-property point 'ddebug-indent))
+       start
+       )
+    (end-of-line)
+    (setq start (point))
+    (forward-char 1)
+    (data-debug-insert-find-results findres
+                                   (concat (make-string indent ? )
+                                           "!* ")
+                                   )
+    (goto-char start)
+    ))
+
+(defun data-debug-insert-find-results-button (findres prefix prebuttontext)
+  "Insert a single summary of a find results FINDRES.
+PREFIX is the text that preceeds the button.
+PREBUTTONTEXT is some text between prefix and the find results button."
+  (let ((start (point))
+       (end nil)
+       (str (semanticdb-find-result-prin1-to-string findres))
+       (tip nil))
+    (insert prefix prebuttontext str)
+    (setq end (point))
+    (put-text-property (- end (length str)) end 'face 'font-lock-function-name-face)
+    (put-text-property start end 'ddebug findres)
+    (put-text-property start end 'ddebug-indent(length prefix))
+    (put-text-property start end 'ddebug-prefix prefix)
+    (put-text-property start end 'help-echo tip)
+    (put-text-property start end 'ddebug-function
+                      'data-debug-insert-find-results-from-point)
+    (insert "\n")
+    ))
+
+(defun data-debug-insert-db-and-tag-button (dbtag prefix prebuttontext)
+  "Insert a single summary of short list DBTAG of format (DB . TAG).
+PREFIX is the text that preceeds the button.
+PREBUTTONTEXT is some text between prefix and the find results button."
+  (let ((start (point))
+       (end nil)
+       (str (concat "(#<db/tag "
+                    (object-name-string (car dbtag))
+                    " / "
+                    (semantic-format-tag-name (cdr dbtag) nil t)
+                    ")"))
+       (tip nil))
+    (insert prefix prebuttontext str)
+    (setq end (point))
+    (put-text-property (- end (length str)) end 'face 'font-lock-function-name-face)
+    (put-text-property start end 'ddebug dbtag)
+    (put-text-property start end 'ddebug-indent(length prefix))
+    (put-text-property start end 'ddebug-prefix prefix)
+    (put-text-property start end 'help-echo tip)
+    (put-text-property start end 'ddebug-function
+                      'data-debug-insert-db-and-tag-from-point)
+    (insert "\n")
+    ))
+
+(defun data-debug-insert-db-and-tag-from-point (point)
+  "Insert the find results found at the find results button at POINT."
+  (let ((dbtag (get-text-property point 'ddebug))
+       (indent (get-text-property point 'ddebug-indent))
+       start
+       )
+    (end-of-line)
+    (setq start (point))
+    (forward-char 1)
+    (data-debug-insert-thing (car dbtag) (make-string indent ? )
+                            "| DB ")
+    (data-debug-insert-tag (cdr dbtag) (concat (make-string indent ? )
+                                              "| ")
+                          "TAG ")
+    (goto-char start)
+    ))
+
+;;; DEBUG COMMANDS
+;;
+;; Various commands to output aspects of the current semantic environment.
+(defun semantic-adebug-bovinate ()
+  "The same as `bovinate'.  Display the results in a debug buffer."
+  (interactive)
+  (let* ((start (current-time))
+        (out (semantic-fetch-tags))
+        (end (current-time)))
+
+    (message "Retrieving tags took %.2f seconds."
+            (semantic-elapsed-time start end))
+
+    (data-debug-new-buffer (concat "*" (buffer-name) " ADEBUG*"))
+    (data-debug-insert-tag-list out "* "))
+  )
+
+(defun semantic-adebug-searchdb (regex)
+  "Search the semanticdb for REGEX for the current buffer.
+Display the results as a debug list."
+  (interactive "sSymbol Regex: ")
+  (let ((start (current-time))
+       (fr (semanticdb-find-tags-by-name-regexp regex))
+       (end (current-time)))
+
+    (data-debug-new-buffer (concat "*SEMANTICDB SEARCH: "
+                                  regex
+                                  " ADEBUG*"))
+    (message "Search of tags took %.2f seconds."
+            (semantic-elapsed-time start end))
+
+    (data-debug-insert-find-results fr "*")))
+
+(defun semantic-adebug-analyze (&optional ctxt)
+  "Perform `semantic-analyze-current-context'.
+Display the results as a debug list.
+Optional argument CTXT is the context to show."
+  (interactive)
+  (let ((start (current-time))
+       (ctxt (or ctxt (semantic-analyze-current-context)))
+       (end (current-time)))
+    (if (not ctxt)
+       (message "No Analyzer Results")
+      (message "Analysis  took %.2f seconds."
+              (semantic-elapsed-time start end))
+      (semantic-analyze-pulse ctxt)
+      (if ctxt
+         (progn
+           (data-debug-new-buffer "*Analyzer ADEBUG*")
+           (data-debug-insert-object-slots ctxt "]"))
+       (message "No Context to analyze here.")))))
+
+(defun semantic-adebug-edebug-expr (expr)
+  "Dump out the contets of some expression EXPR in edebug with adebug."
+  (interactive "sExpression: ")
+  (let ((v (eval (read expr))))
+    (if (not v)
+       (message "Expression %s is nil." expr)
+      (data-debug-new-buffer "*expression ADEBUG*")
+      (data-debug-insert-thing v "?" "")
+      )))
+
+(defun semanticdb-debug-file-tag-check (startfile)
+  "Report debug info for checking STARTFILE for up-to-date tags."
+  (interactive "FFile to Check (default = current-buffer): ")
+  (let* ((file (file-truename startfile))
+        (default-directory (file-name-directory file))
+        (db (or
+             ;; This line will pick up system databases.
+             (semanticdb-directory-loaded-p default-directory)
+             ;; this line will make a new one if needed.
+             (semanticdb-get-database default-directory)))
+        (tab (semanticdb-file-table db file))
+        )
+    (with-output-to-temp-buffer "*DEBUG STUFF*"
+      (princ "Starting file is: ")
+      (princ startfile)
+      (princ "\nTrueName is: ")
+      (princ file)
+      (when (not (file-exists-p file))
+       (princ "\nFile does not exist!"))
+      (princ "\nDirectory Part is: ")
+      (princ default-directory)
+      (princ "\nFound Database is: ")
+      (princ (object-print db))
+      (princ "\nFound Table is: ")
+      (if tab (princ (object-print tab)) (princ "nil"))
+      (princ "\n\nAction Summary: ")
+      (cond
+       ((and tab
+            ;; Is this in a buffer?
+            (find-buffer-visiting (semanticdb-full-filename tab))
+            )
+       (princ "Found Buffer: ")
+       (prin1 (find-buffer-visiting (semanticdb-full-filename tab)))
+       )
+       ((and tab
+            ;; Is table fully loaded, or just a proxy?
+            (number-or-marker-p (oref tab pointmax))
+            ;; Is this table up to date with the file?
+            (not (semanticdb-needs-refresh-p tab)))
+       (princ "Found table, no refresh needed.\n   Pointmax is: ")
+       (prin1 (oref tab pointmax))
+       )
+       (t
+       (princ "Found table that needs refresh.")
+       (if (not tab)
+           (princ "\n   No Saved Point.")
+         (princ "\n  Saved pointmax: ")
+         (prin1 (oref tab pointmax))
+         (princ "  Needs Refresh: ")
+         (prin1 (semanticdb-needs-refresh-p tab))
+         )
+       ))
+      ;; Buffer isn't loaded.  The only clue we have is if the file
+      ;; is somehow different from our mark in the semanticdb table.
+      (let* ((stats (file-attributes file))
+            (actualsize (nth 7 stats))
+            (actualmod (nth 5 stats))
+            )
+
+       (if (or  (not tab)
+                (not (slot-boundp tab 'tags))
+                (not (oref tab tags)))
+           (princ "\n   No tags in table.")
+         (princ "\n   Number of known tags: ")
+         (prin1 (length (oref tab tags))))
+
+       (princ "\n   File Size is: ")
+       (prin1 actualsize)
+       (princ "\n   File Mod Time is: ")
+       (princ (format-time-string "%Y-%m-%d %T" actualmod))
+       (when tab
+         (princ "\n   Saved file size is: ")
+         (prin1 (oref tab fsize))
+         (princ "\n   Saved Mod time is: ")
+         (princ (format-time-string "%Y-%m-%d %T"
+                                    (oref tab lastmodtime)))
+         )
+       )
+      )
+    ;; Force load
+    (semanticdb-file-table-object file)
+    nil
+    ))
+
+;; (semanticdb-debug-file-tag-check "/usr/lib/gcc/i486-linux-gnu/4.2/include/stddef.h")
+;; (semanticdb-debug-file-tag-check "/usr/include/stdlib.h")
+
+
+
+(provide 'semantic/adebug)
+
+;;; semantic-adebug.el ends here
diff --git a/lisp/cedet/semantic/chart.el b/lisp/cedet/semantic/chart.el
new file mode 100644 (file)
index 0000000..95c60a5
--- /dev/null
@@ -0,0 +1,167 @@
+;;; chart.el --- Utilities for use with semantic tag tables
+
+;;; Copyright (C) 1999, 2000, 2001, 2003, 2005, 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:
+;;
+;; A set of simple functions for charting details about a file based on
+;; the output of the semantic parser.
+;;
+
+(require 'semantic)
+(require 'chart)
+
+;;; Code:
+
+(defun semantic-chart-tags-by-class (&optional tagtable)
+  "Create a bar chart representing the number of tags for a given tag class.
+Each bar represents how many toplevel tags in TAGTABLE
+exist with a given class.  See `semantic-symbol->name-assoc-list'
+for tokens which will be charted.
+TAGTABLE is passedto `semantic-something-to-tag-table'."
+  (interactive)
+  (let* ((stream (semantic-something-to-tag-table
+                 (or tagtable (current-buffer))))
+        (names (mapcar 'cdr semantic-symbol->name-assoc-list))
+        (nums (mapcar
+               (lambda (symname)
+                 (length
+                  (semantic-brute-find-tag-by-class (car symname)
+                                                    stream)
+                  ))
+               semantic-symbol->name-assoc-list)))
+    (chart-bar-quickie 'vertical
+                      "Semantic Toplevel Tag Volume"
+                      names "Tag Class"
+                      nums "Volume")
+    ))
+
+(defun semantic-chart-database-size (&optional tagtable)
+  "Create a bar chart representing the size of each file in semanticdb.
+Each bar represents how many toplevel tags in TAGTABLE
+exist in each database entry.
+TAGTABLE is passed to `semantic-something-to-tag-table'."
+  (interactive)
+  (if (or (not (fboundp 'semanticdb-minor-mode-p))
+         (not (semanticdb-minor-mode-p)))
+      (error "Semanticdb is not enabled"))
+  (let* ((db semanticdb-current-database)
+        (dbt (semanticdb-get-database-tables db))
+        (names (mapcar 'car
+                       (object-assoc-list
+                        'file
+                        dbt)))
+        (numnuts (mapcar (lambda (dba)
+                           (prog1
+                               (cons
+                                (if (slot-boundp dba 'tags)
+                                    (length (oref dba tags))
+                                  1)
+                                (car names))
+                             (setq names (cdr names))))
+                         dbt))
+        (nums nil)
+        (fh (/ (- (frame-height) 7) 4)))
+    (setq numnuts (sort numnuts (lambda (a b) (> (car a) (car b)))))
+    (setq names (mapcar 'cdr numnuts)
+         nums (mapcar 'car numnuts))
+    (if (> (length names) fh)
+       (progn
+         (setcdr (nthcdr fh names) nil)
+         (setcdr (nthcdr fh nums) nil)))
+    (chart-bar-quickie 'horizontal
+                      "Semantic DB Toplevel Tag Volume"
+                      names "File"
+                      nums "Volume")
+    ))
+
+(defun semantic-chart-token-complexity (tok)
+  "Calculate the `complexity' of token TOK."
+  (count-lines
+   (semantic-tag-end tok)
+   (semantic-tag-start tok)))
+
+(defun semantic-chart-tag-complexity
+  (&optional class tagtable)
+  "Create a bar chart representing the complexity of some tags.
+Complexity is calculated for tags of CLASS.  Each bar represents
+the complexity of some tag in TAGTABLE.  Only the most complex
+items are charted.  TAGTABLE is passedto
+`semantic-something-to-tag-table'."
+  (interactive)
+  (let* ((sym (if (not class) 'function))
+        (stream
+         (semantic-find-tags-by-class
+          sym (semantic-something-to-tag-table (or tagtable
+                                                   (current-buffer)))
+          ))
+        (name (cond ((semantic-tag-with-position-p (car stream))
+                     (buffer-name (semantic-tag-buffer (car stream))))
+                    (t "")))
+        (cplx (mapcar (lambda (tok)
+                        (cons tok (semantic-chart-token-complexity tok)))
+                      stream))
+        (namelabel (cdr (assoc 'function semantic-symbol->name-assoc-list)))
+        (names nil)
+        (nums nil))
+    (setq cplx (sort cplx (lambda (a b) (> (cdr a) (cdr b)))))
+    (while (and cplx (<= (length names) (/ (- (frame-height) 7) 4)))
+      (setq names (cons (semantic-tag-name (car (car cplx)))
+                       names)
+           nums (cons (cdr (car cplx)) nums)
+           cplx (cdr cplx)))
+;; ;;     (setq names (mapcar (lambda (str)
+;; ;;                    (substring str (- (length str) 10)))
+;; ;;                  names))
+    (chart-bar-quickie 'horizontal
+                      (format "%s Complexity in %s"
+                              (capitalize (symbol-name sym))
+                              name)
+                      names namelabel
+                      nums "Complexity (Lines of code)")
+    ))
+
+(defun semantic-chart-analyzer ()
+  "Chart the extent of the context analysis."
+  (interactive)
+  (let* ((p (semanticdb-find-translate-path nil nil))
+        (plen (length p))
+        (tab semanticdb-current-table)
+        (tc (semanticdb-get-typecache tab))
+        (tclen (+ (length (oref tc filestream))
+                  (length (oref tc includestream))))
+        (scope (semantic-calculate-scope))
+        (fslen (length (oref scope fullscope)))
+        (lvarlen (length (oref scope localvar)))
+        )
+    (chart-bar-quickie 'vertical
+                      (format "Analyzer Overhead in %s" (buffer-name))
+                      '("includes" "typecache" "scopelen" "localvar")
+                      "Overhead Entries"
+                      (list plen tclen fslen lvarlen)
+                      "Number of tags")
+    ))
+
+
+
+(provide 'semantic/chart)
+
+;;; semantic-chart.el ends here
diff --git a/lisp/cedet/semantic/db-debug.el b/lisp/cedet/semantic/db-debug.el
new file mode 100644 (file)
index 0000000..6db1cbf
--- /dev/null
@@ -0,0 +1,108 @@
+;;; db-debug.el --- Extra level debugging routines for Semantic
+
+;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <eric@siege-engine.com>
+
+;; 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:
+;;
+;; Various routines for debugging SemanticDB issues, or viewing
+;; semanticdb state.
+
+(require 'semantic/db)
+
+;;; Code:
+;;
+(defun semanticdb-dump-all-table-summary ()
+  "Dump a list of all databases in Emacs memory."
+  (interactive)
+  (require 'data-debug)
+  (let ((db semanticdb-database-list))
+    (data-debug-new-buffer "*SEMANTICDB*")
+    (data-debug-insert-stuff-list db "*")))
+
+(defalias 'semanticdb-adebug-database-list 'semanticdb-dump-all-table-summary)
+
+(defun semanticdb-adebug-current-database ()
+  "Run ADEBUG on the current database."
+  (interactive)
+  (require 'data-debug)
+  (let ((p semanticdb-current-database)
+       )
+    (data-debug-new-buffer "*SEMANTICDB ADEBUG*")
+    (data-debug-insert-stuff-list p "*")))
+
+(defun semanticdb-adebug-current-table ()
+  "Run ADEBUG on the current database."
+  (interactive)
+  (require 'data-debug)
+  (let ((p semanticdb-current-table))
+    (data-debug-new-buffer "*SEMANTICDB ADEBUG*")
+    (data-debug-insert-stuff-list p "*")))
+
+
+(defun semanticdb-adebug-project-database-list ()
+  "Run ADEBUG on the current database."
+  (interactive)
+  (require 'data-debug)
+  (let ((p (semanticdb-current-database-list)))
+    (data-debug-new-buffer "*SEMANTICDB ADEBUG*")
+    (data-debug-insert-stuff-list p "*")))
+
+
+\f
+;;; Sanity Checks
+;;
+
+(defun semanticdb-table-oob-sanity-check (cache)
+  "Validate that CACHE tags do not have any overlays in them."
+  (while cache
+    (when (semantic-overlay-p (semantic-tag-overlay cache))
+      (message "Tag %s has an erroneous overlay!"
+              (semantic-format-tag-summarize (car cache))))
+    (semanticdb-table-oob-sanity-check
+     (semantic-tag-components-with-overlays (car cache)))
+    (setq cache (cdr cache))))
+
+(defun semanticdb-table-sanity-check (&optional table)
+  "Validate the current semanticdb TABLE."
+  (interactive)
+  (if (not table) (setq table semanticdb-current-table))
+  (let* ((full-filename (semanticdb-full-filename table))
+        (buff (find-buffer-visiting full-filename)))
+    (if buff
+       (save-excursion
+         (set-buffer buff)
+         (semantic-sanity-check))
+      ;; We can't use the usual semantic validity check, so hack our own.
+      (semanticdb-table-oob-sanity-check (semanticdb-get-tags table)))))
+
+(defun semanticdb-database-sanity-check ()
+  "Validate the current semantic database."
+  (interactive)
+  (let ((tables (semanticdb-get-database-tables
+                semanticdb-current-database)))
+    (while tables
+      (semanticdb-table-sanity-check (car tables))
+      (setq tables (cdr tables)))
+    ))
+
+
+
+(provide 'semantic/db-debug)
+;;; semanticdb-debug.el ends here
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
new file mode 100644 (file)
index 0000000..3302afd
--- /dev/null
@@ -0,0 +1,706 @@
+;;; db-ebrowse.el --- Semanticdb backend using ebrowse.
+
+;;; Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Authors: Eric M. Ludlam <zappo@gnu.org>, Joakim Verona
+;; 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:
+;;
+;; This program was started by Eric Ludlam, and Joakim Verona finished
+;; the implementation by adding searches and fixing bugs.
+;;
+;; Read in custom-created ebrowse BROWSE files into a semanticdb back
+;; end.
+;;
+;; Add these databases to the 'system' search.
+;; Possibly use ebrowse for local parsing too.
+;;
+;; When real details are needed out of the tag system from ebrowse,
+;; we will need to delve into the originating source and parse those
+;; files the usual way.
+;;
+;; COMMANDS:
+;; `semanticdb-create-ebrowse-database' - Call EBROWSE to create a
+;;       system database for some directory.  In general, use this for
+;;       system libraries, such as /usr/include, or include directories
+;;       large software projects.
+;;       Customize `semanticdb-ebrowse-file-match' to make sure the correct
+;;       file extensions are matched.
+;;
+;; `semanticdb-load-ebrowse-caches' - Load all the EBROWSE caches from
+;;       your semanticdb system database directory.  Once they are
+;;       loaded, they become searchable as omnipotent databases for
+;;       all C++ files.  This is called automatically by semantic-load.
+;;       Call it a second time to refresh the Emacs DB with the file.
+;;
+
+(eval-when-compile
+  ;; For generic function searching.
+  (require 'eieio)
+  (require 'eieio-opt)
+  )
+(require 'semantic/db-file)
+
+(eval-and-compile
+  ;; Hopefully, this will allow semanticdb-ebrowse to compile under
+  ;; XEmacs, it just won't run if a user attempts to use it.
+  (condition-case nil
+      (require 'ebrowse)
+    (error nil)))
+
+;;; Code:
+(defvar semanticdb-ebrowse-default-file-name "BROWSE"
+  "The EBROWSE file name used for system caches.")
+
+(defcustom semanticdb-ebrowse-file-match "\\.\\(hh?\\|HH?\\|hpp\\)"
+  "Regular expression matching file names for ebrowse to parse.
+This expression should exclude C++ headers that have no extension.
+By default, include only headers since the semantic use of EBrowse
+is only for searching via semanticdb, and thus only headers would
+be searched."
+  :group 'semanticdb
+  :type 'string)
+
+(defun semanticdb-ebrowse-C-file-p (file)
+  "Is FILE a C or C++ file?"
+  (or (string-match semanticdb-ebrowse-file-match file)
+      (and (string-match "/\\w+$" file)
+          (not (file-directory-p file))
+          (let ((tmp (get-buffer-create "*semanticdb-ebrowse-tmp*")))
+            (save-excursion
+              (set-buffer tmp)
+              (condition-case nil
+                  (insert-file-contents file nil 0 100 t)
+                (error (insert-file-contents file nil nil nil t)))
+              (goto-char (point-min))
+              (looking-at "\\s-*/\\(\\*\\|/\\)")
+              ))
+          )))
+
+(defun semanticdb-create-ebrowse-database (dir)
+  "Create an EBROSE database for directory DIR.
+The database file is stored in ~/.semanticdb, or whichever directory
+is specified by `semanticdb-default-save-directory'."
+  (interactive "DDirectory: ")
+  (setq dir (file-name-as-directory dir)) ;; for / on end
+  (let* ((savein (semanticdb-ebrowse-file-for-directory dir))
+        (filebuff (get-buffer-create "*SEMANTICDB EBROWSE TMP*"))
+        (files (directory-files (expand-file-name dir) t))
+        (mma auto-mode-alist)
+        (regexp nil)
+        )
+    ;; Create the input to the ebrowse command
+    (save-excursion
+      (set-buffer filebuff)
+      (buffer-disable-undo filebuff)
+      (setq default-directory (expand-file-name dir))
+
+      ;;; @TODO - convert to use semanticdb-collect-matching-filenames
+      ;; to get the file names.
+
+
+      (mapcar (lambda (f)
+               (when (semanticdb-ebrowse-C-file-p f)
+                 (insert f)
+                 (insert "\n")))
+             files)
+      ;; Cleanup the ebrowse output buffer.
+      (save-excursion
+       (set-buffer (get-buffer-create "*EBROWSE OUTPUT*"))
+       (erase-buffer))
+      ;; Call the EBROWSE command.
+      (message "Creating ebrowse file: %s ..." savein)
+      (call-process-region (point-min) (point-max)
+                          "ebrowse" nil "*EBROWSE OUTPUT*" nil
+                          (concat "--output-file=" savein)
+                          "--very-verbose")
+      )
+    ;; Create a short LOADER program for loading in this database.
+    (let* ((lfn (concat savein "-load.el"))
+          (lf (find-file-noselect lfn)))
+      (save-excursion
+       (set-buffer lf)
+       (erase-buffer)
+       (insert "(semanticdb-ebrowse-load-helper \""
+               (expand-file-name dir)
+               "\")\n")
+       (save-buffer)
+       (kill-buffer (current-buffer)))
+      (message "Creating ebrowse file: %s ... done" savein)
+      ;; Reload that database
+      (load lfn nil t)
+      )))
+
+(defun semanticdb-load-ebrowse-caches ()
+  "Load all semanticdb controlled EBROWSE caches."
+  (interactive)
+  (let ((f (directory-files semanticdb-default-save-directory
+                           t (concat semanticdb-ebrowse-default-file-name "-load.el$") t)))
+    (while f
+      (load (car f) nil t)
+      (setq f (cdr f)))
+    ))
+
+(defun semanticdb-ebrowse-load-helper (directory)
+  "Create the semanticdb database via ebrowse for directory.
+If DIRECTORY is found to be defunct, it won't load the DB, and will
+warn instead."
+  (if (file-directory-p directory)
+      (semanticdb-create-database semanticdb-project-database-ebrowse
+                                 directory)
+    (let* ((BF (semanticdb-ebrowse-file-for-directory directory))
+          (BFL (concat BF "-load.el"))
+          (BFLB (concat BF "-load.el~")))
+      (save-window-excursion
+       (with-output-to-temp-buffer "*FILES TO DELETE*"
+         (princ "The following BROWSE files are obsolete.\n\n")
+         (princ BF)
+         (princ "\n")
+         (princ BFL)
+         (princ "\n")
+         (when (file-exists-p BFLB)
+           (princ BFLB)
+           (princ "\n"))
+         )
+       (when (y-or-n-p (format
+                        "Warning: Obsolete BROWSE file for: %s\nDelete? "
+                        directory))
+         (delete-file BF)
+         (delete-file BFL)
+         (when (file-exists-p BFLB)
+           (delete-file BFLB))
+         )))))
+
+;;; SEMANTIC Database related Code
+;;; Classes:
+(defclass semanticdb-table-ebrowse (semanticdb-table)
+  ((major-mode :initform c++-mode)
+   (ebrowse-tree :initform nil
+                :initarg :ebrowse-tree
+                :documentation
+                "The raw ebrowse tree for this file."
+                )
+   (global-extract :initform nil
+                  :initarg :global-extract
+                  :documentation
+                  "Table of ebrowse tags specific to this file.
+This table is compisited from the ebrowse *Globals* section.")
+   )
+  "A table for returning search results from ebrowse.")
+
+(defclass semanticdb-project-database-ebrowse
+  (semanticdb-project-database)
+  ((new-table-class :initform semanticdb-table-ebrowse
+                   :type class
+                   :documentation
+                   "New tables created for this database are of this class.")
+   (system-include-p :initform nil
+                    :initarg :system-include
+                    :documentation
+                    "Flag indicating this database represents a system include directory.")
+   (ebrowse-struct :initform nil
+                  :initarg :ebrowse-struct
+                  )
+   )
+  "Semantic Database deriving tags using the EBROWSE tool.
+EBROWSE is a C/C++ parser for use with `ebrowse' Emacs program.")
+
+;JAVE this just instantiates a default empty ebrowse struct?
+; how would new instances wind up here?
+; the ebrowse class isnt singleton, unlike the emacs lisp one
+(defvar-mode-local c++-mode semanticdb-project-system-databases
+  ()
+  "Search Ebrowse for symbols.")
+
+(defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
+  "EBROWSE database do not need to be refreshed.
+
+JAVE: stub for needs-refresh, because, how do we know if BROWSE files
+      are out of date?
+
+EML: Our database should probably remember the timestamp/checksum of
+     the most recently read EBROWSE file, and use that."
+  nil
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+;;; EBROWSE code
+;;
+;; These routines deal with part of the ebrowse interface.
+(defun semanticdb-ebrowse-file-for-directory (dir)
+  "Return the file name for DIR where the ebrowse BROWSE file is.
+This file should reside in `semanticdb-default-save-directory'."
+  (let* ((semanticdb-default-save-directory
+         semanticdb-default-save-directory)
+        (B (semanticdb-file-name-directory
+            'semanticdb-project-database-file
+            (concat (expand-file-name dir)
+                    semanticdb-ebrowse-default-file-name)))
+        )
+    B))
+
+(defun semanticdb-ebrowse-get-ebrowse-structure (dir)
+  "Return the ebrowse structure for directory DIR.
+This assumes semantic manages the BROWSE files, so they are assumed to live
+where semantic cache files live, depending on your settings.
+
+For instance: /home/<username>/.semanticdb/!usr!include!BROWSE"
+  (let* ((B (semanticdb-ebrowse-file-for-directory dir))
+        (buf (get-buffer-create "*semanticdb ebrowse*")))
+    (message "semanticdb-ebrowse %s" B)
+    (when (file-exists-p B)
+      (set-buffer buf)
+      (buffer-disable-undo buf)
+      (erase-buffer)
+      (insert-file-contents B)
+      (let ((ans nil)
+           (efcn (symbol-function 'ebrowse-show-progress)))
+       (fset 'ebrowse-show-progress #'(lambda (&rest junk) nil))
+       (unwind-protect ;; Protect against errors w/ ebrowse
+           (setq ans (list B (ebrowse-read)))
+         ;; These items must always happen
+         (erase-buffer)
+         (fset 'ebrowse-show-fcn efcn)
+         )
+       ans))))
+
+;;; Methods for creating a database or tables
+;;
+(defmethod semanticdb-create-database :STATIC ((dbeC semanticdb-project-database-ebrowse)
+                                              directory)
+  "Create a new semantic database for DIRECTORY based on ebrowse.
+If there is no database for DIRECTORY available, then
+{not implemented yet} create one.  Return nil if that is not possible."
+  ;; MAKE SURE THAT THE FILE LOADED DOESN'T ALREADY EXIST.
+  (let ((dbs semanticdb-database-list)
+       (found nil))
+    (while (and (not found) dbs)
+      (when (semanticdb-project-database-ebrowse-p (car dbs))
+       (when (string= (oref (car dbs) reference-directory) directory)
+         (setq found (car dbs))))
+      (setq dbs (cdr dbs)))
+    ;;STATIC means DBE cant be used as object, only as a class
+    (let* ((ebrowse-data (semanticdb-ebrowse-get-ebrowse-structure directory))
+          (dat (car (cdr ebrowse-data)))
+          (ebd (car dat))
+          (db nil)
+          (default-directory directory)
+          )
+      (if found
+         (setq db found)
+       (setq db (make-instance
+                 dbeC
+                 directory
+                 :ebrowse-struct ebd
+                 ))
+       (oset db reference-directory directory))
+
+      ;; Once we recycle or make a new DB, refresh the
+      ;; contents from the BROWSE file.
+      (oset db tables nil)
+      ;; only possible after object creation, tables inited to nil.
+      (semanticdb-ebrowse-strip-trees db dat)
+
+      ;; Once our database is loaded, if we are a system DB, we
+      ;; add ourselves to the include list for C++.
+      (semantic-add-system-include directory 'c++-mode)
+      (semantic-add-system-include directory 'c-mode)
+
+      db)))
+
+(defmethod semanticdb-ebrowse-strip-trees  ((dbe semanticdb-project-database-ebrowse)
+                                                   data)
+  "For the ebrowse database DBE, strip all tables from DATA."
+;JAVE what it actually seems to do is split the original tree in "tables" associated with files
+; im not sure it actually works:
+;   the filename slot sometimes gets to be nil,
+;      apparently for classes which definition cant be found, yet needs to be included in the tree
+;      like library baseclasses
+;   a file can define several classes
+  (let ((T (car (cdr data))));1st comes a header, then the tree
+    (while T
+
+      (let* ((tree (car T))
+            (class (ebrowse-ts-class tree)); root class of tree
+            ;; Something funny going on with this file thing...
+             (filename (or (ebrowse-cs-source-file class)
+                          (ebrowse-cs-file class)))
+            )
+       (cond
+        ((ebrowse-globals-tree-p tree)
+         ;; We have the globals tree.. save this special.
+         (semanticdb-ebrowse-add-globals-to-table dbe tree)
+         )
+        (t
+         ;; ebrowse will collect all the info from multiple files
+         ;; into one tree.  Semantic wants all the bits to be tied
+         ;; into different files.  We need to do a full dissociation
+         ;; into semantic parsable tables.
+         (semanticdb-ebrowse-add-tree-to-table dbe tree)
+         ))
+      (setq T (cdr T))))
+    ))
+
+;;; Filename based methods
+;;
+(defun semanticdb-ebrowse-add-globals-to-table (dbe tree)
+  "For database DBE, add the ebrowse TREE into the table."
+  (if (or (not (ebrowse-ts-p tree))
+         (not (ebrowse-globals-tree-p tree)))
+      (signal 'wrong-type-argument (list 'ebrowse-ts-p tree)))
+
+  (let* ((class (ebrowse-ts-class tree))
+        (fname (or (ebrowse-cs-source-file class)
+                   (ebrowse-cs-file class)
+                   ;; Not def'd here, assume our current
+                   ;; file
+                   (concat default-directory "/unknown-proxy.hh")))
+        (vars (ebrowse-ts-member-functions tree))
+        (fns (ebrowse-ts-member-variables tree))
+        (toks nil)
+        )
+    (while vars
+      (let ((nt (semantic-tag (ebrowse-ms-name (car vars))
+                             'variable))
+           (defpoint (ebrowse-bs-point class)))
+       (when defpoint
+         (semantic--tag-set-overlay nt
+                                    (vector defpoint defpoint)))
+       (setq toks (cons nt toks)))
+      (setq vars (cdr vars)))
+    (while fns
+      (let ((nt (semantic-tag (ebrowse-ms-name (car fns))
+                             'function))
+           (defpoint (ebrowse-bs-point class)))
+       (when defpoint
+         (semantic--tag-set-overlay nt
+                                    (vector defpoint defpoint)))
+       (setq toks (cons nt toks)))
+      (setq fns (cdr fns)))
+
+    ))
+
+(defun semanticdb-ebrowse-add-tree-to-table (dbe tree &optional fname baseclasses)
+  "For database DBE, add the ebrowse TREE into the table for FNAME.
+Optional argument BASECLASSES specifyies a baseclass to the tree being provided."
+  (if (not (ebrowse-ts-p tree))
+      (signal 'wrong-type-argument (list 'ebrowse-ts-p tree)))
+
+  ;; Strategy overview:
+  ;; 1) Calculate the filename for this tree.
+  ;; 2) Find a matching namespace in TAB, or create a new one.
+  ;; 3) Fabricate a tag proxy for CLASS
+  ;; 4) Add it to the namespace
+  ;; 5) Add subclasses
+
+  ;; 1 - Find the filename
+  (if (not fname)
+      (setq fname (or (ebrowse-cs-source-file (ebrowse-ts-class tree))
+                     (ebrowse-cs-file (ebrowse-ts-class tree))
+                     ;; Not def'd here, assume our current
+                     ;; file
+                     (concat default-directory "/unknown-proxy.hh"))))
+
+  (let* ((tab (or (semanticdb-file-table dbe fname)
+                 (semanticdb-create-table dbe fname)))
+        (class (ebrowse-ts-class tree))
+        (scope (ebrowse-cs-scope class))
+        (ns (when scope (cedet-split-string scope ":" t)))
+        (nst nil)
+        (cls nil)
+        )
+
+    ;; 2 - Get the namespace tag
+    (when ns
+      (let ((taglst (if (slot-boundp tab 'tags) (oref tab tags) nil)))
+       (setq nst (semantic-find-first-tag-by-name (car ns) taglst))
+       (when (not nst)
+         (setq nst (semantic-tag (car ns) 'type :type "namespace"))
+         (oset tab tags (cons nst taglst))
+         )))
+
+    ;; 3 - Create a proxy tg.
+    (setq cls (semantic-tag (ebrowse-cs-name class)
+                           'type
+                           :type "class"
+                           :superclasses baseclasses
+                           :faux t
+                           :filename fname
+                           ))
+    (let ((defpoint (ebrowse-bs-point class)))
+      (when defpoint
+       (semantic--tag-set-overlay cls
+                                  (vector defpoint defpoint))))
+
+    ;; 4 - add to namespace
+    (if nst
+       (semantic-tag-put-attribute
+        nst :members (cons cls (semantic-tag-get-attribute nst :members)))
+      (oset tab tags (cons cls (when (slot-boundp tab 'tags)
+                                (oref tab tags)))))
+
+    ;; 5 - Subclasses
+    (let* ((subclass (ebrowse-ts-subclasses tree))
+          (pname (ebrowse-cs-name class)))
+      (when (ebrowse-cs-scope class)
+       (setq pname (concat (mapconcat (lambda (a) a) (cdr ns) "::") "::" pname)))
+
+      (while subclass
+       (let* ((scc (ebrowse-ts-class (car subclass)))
+              (fname (or (ebrowse-cs-source-file scc)
+                         (ebrowse-cs-file scc)
+                         ;; Not def'd here, assume our current
+                         ;; file
+                         fname
+                         )))
+         (when fname
+           (semanticdb-ebrowse-add-tree-to-table
+            dbe (car subclass) fname pname)))
+       (setq subclass (cdr subclass))))
+    ))
+
+;;;
+;; Overload for converting the simple faux tag into something better.
+;;
+(defmethod semanticdb-normalize-tags ((obj semanticdb-table-ebrowse) tags)
+  "Convert in Ebrowse database OBJ a list of TAGS into a complete tag.
+The default tag provided by searches exclude many features of a
+semantic parsed tag.  Look up the file for OBJ, and match TAGS
+against a semantic parsed tag that has all the info needed, and
+return that."
+  (let ((tagret nil)
+       )
+    ;; SemanticDB will automatically create a regular database
+    ;; on top of the file just loaded by ebrowse during the set
+    ;; buffer.  Fetch that table, and use it's tag list to look
+    ;; up the tag we just got, and thus turn it into a full semantic
+    ;; tag.
+    (while tags
+      (let ((tag (car tags)))
+       (save-excursion
+         (semanticdb-set-buffer obj)
+         (let ((ans nil))
+           ;; Gee, it would be nice to do this, but ebrowse LIES.  Oi.
+           (when (semantic-tag-with-position-p tag)
+             (goto-char (semantic-tag-start tag))
+             (let ((foundtag (semantic-current-tag)))
+               ;; Make sure the discovered tag is the same as what we started with.
+               (when (string= (semantic-tag-name tag)
+                              (semantic-tag-name foundtag))
+                 ;; We have a winner!
+                 (setq ans foundtag))))
+           ;; Sometimes ebrowse lies.  Do a generic search
+           ;; to find it within this file.
+           (when (not ans)
+             ;; We might find multiple hits for this tag, and we have no way
+             ;; of knowing which one the user wanted.  Return the first one.
+             (setq ans (semantic-deep-find-tags-by-name
+                        (semantic-tag-name tag)
+                        (semantic-fetch-tags))))
+           (if (semantic-tag-p ans)
+               (setq tagret (cons ans tagret))
+             (setq tagret (append ans tagret)))
+           ))
+       (setq tags (cdr tags))))
+    tagret))
+
+(defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-ebrowse) tag)
+  "Convert in Ebrowse database OBJ one TAG into a complete tag.
+The default tag provided by searches exclude many features of a
+semantic parsed tag.  Look up the file for OBJ, and match TAG
+against a semantic parsed tag that has all the info needed, and
+return that."
+  (let ((tagret nil)
+       (objret nil))
+    ;; SemanticDB will automatically create a regular database
+    ;; on top of the file just loaded by ebrowse during the set
+    ;; buffer.  Fetch that table, and use it's tag list to look
+    ;; up the tag we just got, and thus turn it into a full semantic
+    ;; tag.
+    (save-excursion
+      (semanticdb-set-buffer obj)
+      (setq objret semanticdb-current-table)
+      (when (not objret)
+       ;; What to do??
+       (debug))
+      (let ((ans nil))
+       ;; Gee, it would be nice to do this, but ebrowse LIES.  Oi.
+       (when (semantic-tag-with-position-p tag)
+         (goto-char (semantic-tag-start tag))
+         (let ((foundtag (semantic-current-tag)))
+           ;; Make sure the discovered tag is the same as what we started with.
+           (when (string= (semantic-tag-name tag)
+                          (semantic-tag-name foundtag))
+             ;; We have a winner!
+             (setq ans foundtag))))
+       ;; Sometimes ebrowse lies.  Do a generic search
+       ;; to find it within this file.
+       (when (not ans)
+         ;; We might find multiple hits for this tag, and we have no way
+         ;; of knowing which one the user wanted.  Return the first one.
+         (setq ans (semantic-deep-find-tags-by-name
+                    (semantic-tag-name tag)
+                    (semantic-fetch-tags))))
+       (if (semantic-tag-p ans)
+           (setq tagret ans)
+         (setq tagret (car ans)))
+       ))
+    (cons objret tagret)))
+
+;;; Search Overrides
+;;
+;; NOTE WHEN IMPLEMENTING: Be sure to add doc-string updates explaining
+;; how your new search routines are implemented.
+;;
+(defmethod semanticdb-find-tags-by-name-method
+  ((table semanticdb-table-ebrowse) name &optional tags)
+  "Find all tags named NAME in TABLE.
+Return a list of tags."
+  ;;(message "semanticdb-find-tags-by-name-method name -- %s" name)
+  (if tags
+      ;; If TAGS are passed in, then we don't need to do work here.
+      (call-next-method)
+    ;; If we ever need to do something special, add here.
+    ;; Since ebrowse tags are converted into semantic tags, we can
+    ;; get away with this sort of thing.
+    (call-next-method)
+    )
+  )
+
+(defmethod semanticdb-find-tags-by-name-regexp-method
+  ((table semanticdb-table-ebrowse) 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
+    (call-next-method)
+    ))
+
+(defmethod semanticdb-find-tags-for-completion-method
+  ((table semanticdb-table-ebrowse) 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)
+    ;; YOUR IMPLEMENTATION HERE
+    (call-next-method)
+    ))
+
+(defmethod semanticdb-find-tags-by-class-method
+  ((table semanticdb-table-ebrowse) class &optional tags)
+  "In TABLE, find all occurances of tags of CLASS.
+Optional argument TAGS is a list of tags to search.
+Returns a table of all matching tags."
+  (if tags (call-next-method)
+    (call-next-method)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; 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-ebrowse) 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 ebrowse."
+  ;;(semanticdb-find-tags-by-name-method table name tags)
+  (call-next-method))
+
+(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+  ((table semanticdb-table-ebrowse) 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 ebrowse."
+  ;;(semanticdb-find-tags-by-name-regexp-method table regex tags)
+  (call-next-method))
+
+(defmethod semanticdb-deep-find-tags-for-completion-method
+  ((table semanticdb-table-ebrowse) 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 ebrowse."
+  ;;(semanticdb-find-tags-for-completion-method table prefix tags)
+  (call-next-method))
+
+;;; Advanced Searches
+;;
+(defmethod semanticdb-find-tags-external-children-of-type-method
+  ((table semanticdb-table-ebrowse) type &optional tags)
+  "Find all nonterminals which are child elements of TYPE
+Optional argument TAGS is a list of tags to search.
+Return a list of tags."
+  (if tags (call-next-method)
+    ;; Ebrowse collects all this type of stuff together for us.
+    ;; but we can't use it.... yet.
+    nil
+    ))
+
+;;; TESTING
+;;
+;; This is a complex bit of stuff.  Here are some tests for the
+;; system.
+
+(defun semanticdb-ebrowse-run-tests ()
+  "Run some tests of the semanticdb-ebrowse system.
+All systems are different.  Ask questions along the way."
+  (interactive)
+  (let ((doload nil))
+    (when (y-or-n-p "Create a system database to test with? ")
+      (call-interactively 'semanticdb-create-ebrowse-database)
+      (setq doload t))
+    ;;  Should we load in caches
+    (when (if doload
+             (y-or-n-p "New database created.  Reload system databases? ")
+           (y-or-n-p "Load in all system databases? "))
+      (semanticdb-load-ebrowse-caches)))
+  ;; Ok, databases were creatd.  Lets try some searching.
+  (when (not (or (eq major-mode 'c-mode)
+                (eq major-mode 'c++-mode)))
+    (error "Please make your default buffer be a C or C++ file, then
+run the test again..")
+    )
+
+  )
+
+(defun semanticdb-ebrowse-dump ()
+  "Find the first loaded ebrowse table, and dump out the contents."
+  (interactive)
+  (let ((db semanticdb-database-list)
+       (ab nil))
+    (while db
+      (when (semanticdb-project-database-ebrowse-p (car db))
+       (setq ab (data-debug-new-buffer "*EBROWSE Database*"))
+       (data-debug-insert-thing (car db) "*" "")
+       (setq db nil)
+       )
+      (setq db (cdr db)))))
+
+(provide 'semantic/db-ebrowse)
+
+;;; semanticdb-ebrowse.el ends here
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
new file mode 100644 (file)
index 0000000..3db6c15
--- /dev/null
@@ -0,0 +1,343 @@
+;;; db-el.el --- Semantic database extensions for Emacs Lisp
+
+;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; 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:
+;;
+;; There are a lot of Emacs Lisp functions and variables available for
+;; the asking.  This adds on to the semanticdb programming interface to
+;; allow all loaded Emacs Lisp functions to be queried via semanticdb.
+;;
+;; This allows you to use programs written for Semantic using the database
+;; to also work in Emacs Lisp with no compromises.
+;;
+
+(require 'semantic/db-search)
+(eval-when-compile
+  ;; For generic function searching.
+  (require 'eieio)
+  (require 'eieio-opt)
+  (require 'eieio-base)
+  )
+;;; Code:
+
+;;; Classes:
+(defclass semanticdb-table-emacs-lisp (semanticdb-abstract-table)
+  ((major-mode :initform emacs-lisp-mode)
+   )
+  "A table for returning search results from Emacs.")
+
+(defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force)
+  "Do not refresh Emacs Lisp table.
+It does not need refreshing."
+  nil)
+
+(defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp))
+  "Return nil, we never need a refresh."
+  nil)
+
+(defclass semanticdb-project-database-emacs-lisp
+  (semanticdb-project-database eieio-singleton)
+  ((new-table-class :initform semanticdb-table-emacs-lisp
+                   :type class
+                   :documentation
+                   "New tables created for this database are of this class.")
+   )
+  "Database representing Emacs core.")
+
+;; Create the database, and add it to searchable databases for Emacs Lisp mode.
+(defvar-mode-local emacs-lisp-mode semanticdb-project-system-databases
+  (list
+   (semanticdb-project-database-emacs-lisp "Emacs"))
+  "Search Emacs core for symbols.")
+
+(defvar-mode-local emacs-lisp-mode semanticdb-find-default-throttle
+  '(project omniscience)
+  "Search project files, then search this omniscience database.
+It is not necessary to to system or recursive searching because of
+the omniscience database.")
+
+;;; Filename based methods
+;;
+(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp))
+  "For an Emacs Lisp database, there are no explicit tables.
+Create one of our special tables that can act as an intermediary."
+  ;; 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-emacs-lisp "Emacs System 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-emacs-lisp) filename)
+  "From OBJ, return FILENAME's associated table object.
+For Emacs Lisp, creates a specialized table."
+  (car (semanticdb-get-database-tables obj))
+  )
+
+(defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp ))
+  "Return the list of tags belonging to TABLE."
+  ;; specialty table ?  Probably derive tags at request time.
+  nil)
+
+(defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer)
+  "Return non-nil if TABLE's mode is equivalent to BUFFER.
+Equivalent modes are specified by by `semantic-equivalent-major-modes'
+local variable."
+  (save-excursion
+    (set-buffer buffer)
+    (eq (or mode-local-active-mode major-mode) 'emacs-lisp-mode)))
+
+(defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp))
+  "Fetch the full filename that OBJ refers to.
+For Emacs Lisp system DB, there isn't one."
+  nil)
+
+;;; Conversion
+;;
+(defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags)
+  "Convert tags, originating from Emacs OBJ, into standardized form."
+  (let ((newtags nil))
+    (dolist (T tags)
+      (let* ((ot (semanticdb-normalize-one-tag obj T))
+            (tag (cdr ot)))
+       (setq newtags (cons tag newtags))))
+    ;; There is no promise to have files associated.
+    (nreverse newtags)))
+
+(defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-emacs-lisp) tag)
+  "Convert one TAG, originating from Emacs OBJ, into standardized form.
+If Emacs cannot resolve this symbol to a particular file, then return nil."
+  ;; Here's the idea.  For each tag, get the name, then use
+  ;; Emacs' `symbol-file' to get the source.  Once we have that,
+  ;; we can use more typical semantic searching techniques to
+  ;; get a regularly parsed tag.
+  (let* ((type (cond ((semantic-tag-of-class-p tag 'function)
+                     'defun)
+                    ((semantic-tag-of-class-p tag 'variable)
+                     'defvar)
+                    ))
+        (sym (intern (semantic-tag-name tag)))
+        (file (condition-case err
+                  (symbol-file sym type)
+                ;; Older [X]Emacs don't have a 2nd argument.
+                (error (symbol-file sym))))
+        )
+    (if (or (not file) (not (file-exists-p file)))
+       ;; The file didn't exist.  Return nil.
+       ;; We can't normalize this tag.  Fake it out.
+       (cons obj tag)
+      (when (string-match "\\.elc" file)
+       (setq file (concat (file-name-sans-extension file)
+                          ".el"))
+       (when (and (not (file-exists-p file))
+                  (file-exists-p (concat file ".gz")))
+         ;; Is it a .gz file?
+         (setq file (concat file ".gz"))))
+
+      (let* ((tab (semanticdb-file-table-object file))
+            (alltags (semanticdb-get-tags tab))
+            (newtags (semanticdb-find-tags-by-name-method
+                      tab (semantic-tag-name tag)))
+            (match nil))
+       ;; Find the best match.
+       (dolist (T newtags)
+         (when (semantic-tag-similar-p T tag)
+           (setq match T)))
+       ;; Backup system.
+       (when (not match)
+           (setq match (car newtags)))
+       ;; Return it.
+       (cons tab match)))))
+
+(defun semanticdb-elisp-sym-function-arglist (sym)
+  "Get the argument list for SYM.
+Deal with all different forms of function.
+This was snarfed out of eldoc."
+  (let* ((prelim-def
+         (let ((sd (and (fboundp sym)
+                        (symbol-function sym))))
+           (and (symbolp sd)
+                (condition-case err
+                    (setq sd (indirect-function sym))
+                  (error (setq sd nil))))
+           sd))
+         (def (if (eq (car-safe prelim-def) 'macro)
+                  (cdr prelim-def)
+                prelim-def))
+         (arglist (cond ((null def) nil)
+                       ((byte-code-function-p def)
+                        ;; This is an eieio compatibility function.
+                        ;; We depend on EIEIO, so use this.
+                        (eieio-compiled-function-arglist def))
+                        ((eq (car-safe def) 'lambda)
+                         (nth 1 def))
+                        (t nil))))
+    arglist))
+
+(defun semanticdb-elisp-sym->tag (sym &optional toktype)
+  "Convert SYM into a semantic tag.
+TOKTYPE is a hint to the type of tag desired."
+  (if (stringp sym)
+      (setq sym (intern-soft sym)))
+  (when sym
+    (cond ((and (eq toktype 'function) (fboundp sym))
+          (semantic-tag-new-function
+           (symbol-name sym)
+           nil ;; return type
+           (semantic-elisp-desymbolify
+            (semanticdb-elisp-sym-function-arglist sym)) ;; arg-list
+           :user-visible-flag (condition-case nil
+                                  (interactive-form sym)
+                                (error nil))
+           ))
+         ((and (eq toktype 'variable) (boundp sym))
+          (semantic-tag-new-variable
+           (symbol-name sym)
+           nil ;; type
+           nil ;; value - ignore for now
+           ))
+         ((and (eq toktype 'type) (class-p sym))
+          (semantic-tag-new-type
+           (symbol-name sym)
+           "class"
+           (semantic-elisp-desymbolify
+            (aref (class-v semanticdb-project-database)
+                  class-public-a)) ;; slots
+           (semantic-elisp-desymbolify (class-parents sym)) ;; parents
+           ))
+         ((not toktype)
+          ;; Figure it out on our own.
+          (cond ((class-p sym)
+                 (semanticdb-elisp-sym->tag sym 'type))
+                ((fboundp sym)
+                 (semanticdb-elisp-sym->tag sym 'function))
+                ((boundp sym)
+                 (semanticdb-elisp-sym->tag sym 'variable))
+                (t nil))
+          )
+         (t nil))))
+
+;;; Search Overrides
+;;
+(defvar semanticdb-elisp-mapatom-collector nil
+  "Variable used to collect mapatoms output.")
+
+(defmethod semanticdb-find-tags-by-name-method
+  ((table semanticdb-table-emacs-lisp) name &optional tags)
+  "Find all tags name NAME in TABLE.
+Uses `inter-soft' to match NAME to emacs symbols.
+Return a list of tags."
+  (if tags (call-next-method)
+    ;; No need to search.  Use `intern-soft' which does the same thing for us.
+    (let* ((sym (intern-soft name))
+          (fun (semanticdb-elisp-sym->tag sym 'function))
+          (var (semanticdb-elisp-sym->tag sym 'variable))
+          (typ (semanticdb-elisp-sym->tag sym 'type))
+          (taglst nil)
+          )
+      (when (or fun var typ)
+       ;; If the symbol is any of these things, build the search table.
+       (when var       (setq taglst (cons var taglst)))
+       (when typ       (setq taglst (cons typ taglst)))
+       (when fun       (setq taglst (cons fun taglst)))
+       taglst
+       ))))
+
+(defmethod semanticdb-find-tags-by-name-regexp-method
+  ((table semanticdb-table-emacs-lisp) regex &optional tags)
+  "Find all tags with name matching REGEX in TABLE.
+Optional argument TAGS is a list of tags to search.
+Uses `apropos-internal' to find matches.
+Return a list of tags."
+  (if tags (call-next-method)
+    (delq nil (mapcar 'semanticdb-elisp-sym->tag
+                     (apropos-internal regex)))))
+
+(defmethod semanticdb-find-tags-for-completion-method
+  ((table semanticdb-table-emacs-lisp) 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)
+    (delq nil (mapcar 'semanticdb-elisp-sym->tag
+                     (all-completions prefix obarray)))))
+
+(defmethod semanticdb-find-tags-by-class-method
+  ((table semanticdb-table-emacs-lisp) class &optional tags)
+  "In TABLE, find all occurances of tags of CLASS.
+Optional argument TAGS is a list of tags to search.
+Returns a table of all matching tags."
+  (if tags (call-next-method)
+    ;; We could implement this, but it could be messy.
+    nil))
+
+;;; Deep Searches
+;;
+;; For Emacs Lisp deep searches are like top level searches.
+(defmethod semanticdb-deep-find-tags-by-name-method
+  ((table semanticdb-table-emacs-lisp) name &optional tags)
+  "Find all tags name NAME in TABLE.
+Optional argument TAGS is a list of tags to search.
+Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
+  (semanticdb-find-tags-by-name-method table name tags))
+
+(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+  ((table semanticdb-table-emacs-lisp) 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 Emacs Lisp."
+  (semanticdb-find-tags-by-name-regexp-method table regex tags))
+
+(defmethod semanticdb-deep-find-tags-for-completion-method
+  ((table semanticdb-table-emacs-lisp) 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 Emacs Lisp."
+  (semanticdb-find-tags-for-completion-method table prefix tags))
+
+;;; Advanced Searches
+;;
+(defmethod semanticdb-find-tags-external-children-of-type-method
+  ((table semanticdb-table-emacs-lisp) type &optional tags)
+  "Find all nonterminals which are child elements of TYPE
+Optional argument TAGS is a list of tags to search.
+Return a list of tags."
+  (if tags (call-next-method)
+    ;; EIEIO is the only time this matters
+    (when (featurep 'eieio)
+      (let* ((class (intern-soft type))
+            (taglst (when class
+                      (delq nil
+                            (mapcar 'semanticdb-elisp-sym->tag
+                                    ;; Fancy eieio function that knows all about
+                                    ;; built in methods belonging to CLASS.
+                                    (eieio-all-generic-functions class)))))
+            )
+       taglst))))
+
+(provide 'semantic/db-el)
+
+;;; semanticdb-el.el ends here
diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el
new file mode 100644 (file)
index 0000000..a16f9bb
--- /dev/null
@@ -0,0 +1,438 @@
+;;; db-file.el --- Save a semanticdb to a cache file.
+
+;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; 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:
+;;
+;; A set of semanticdb classes for persistently saving caches on disk.
+;;
+
+(require 'semantic)
+(require 'semantic/db)
+(require 'cedet-files)
+
+(defvar semanticdb-file-version semantic-version
+  "Version of semanticdb we are writing files to disk with.")
+(defvar semanticdb-file-incompatible-version "1.4"
+  "Version of semanticdb we are not reverse compatible with.")
+
+;;; Settings
+;;
+(defcustom semanticdb-default-file-name "semantic.cache"
+  "*File name of the semantic tag cache."
+  :group 'semanticdb
+  :type 'string)
+
+(defcustom semanticdb-default-save-directory (expand-file-name "~/.semanticdb")
+  "*Directory name where semantic cache files are stored.
+If this value is nil, files are saved in the current directory.  If the value
+is a valid directory, then it overrides `semanticdb-default-file-name' and
+stores caches in a coded file name in this directory."
+  :group 'semanticdb
+  :type '(choice :tag "Default-Directory"
+                 :menu-tag "Default-Directory"
+                 (const :tag "Use current directory" :value nil)
+                 (directory)))
+
+(defcustom semanticdb-persistent-path '(always)
+  "*List of valid paths that semanticdb will cache tags to.
+When `global-semanticdb-minor-mode' is active, tag lists will
+be saved to disk when Emacs exits.  Not all directories will have
+tags that should be saved.
+The value should be a list of valid paths.  A path can be a string,
+indicating a directory in which to save a variable.  An element in the
+list can also be a symbol.  Valid symbols are `never', which will
+disable any saving anywhere, `always', which enables saving
+everywhere, or `project', which enables saving in any directory that
+passes a list of predicates in `semanticdb-project-predicate-functions'."
+  :group 'semanticdb
+  :type nil)
+
+(defcustom semanticdb-save-database-hooks nil
+  "*Hooks run after a database is saved.
+Each function is called with one argument, the object representing
+the database recently written."
+  :group 'semanticdb
+  :type 'hook)
+
+(defvar semanticdb-dir-sep-char (if (boundp 'directory-sep-char)
+                                   (symbol-value 'directory-sep-char)
+                                 ?/)
+  "Character used for directory separation.
+Obsoleted in some versions of Emacs.  Needed in others.
+NOTE: This should get deleted from semantic soon.")
+
+(defun semanticdb-fix-pathname (dir)
+  "If DIR is broken, fix it.
+Force DIR to end with a /.
+Note: Same as `file-name-as-directory'.
+NOTE: This should get deleted from semantic soon."
+  (file-name-as-directory dir))
+;; I didn't initially know about the above fcn.  Keep the below as a
+;; reference.  Delete it someday once I've proven everything is the same.
+;;  (if (not (= semanticdb-dir-sep-char (aref path (1- (length path)))))
+;;      (concat path (list semanticdb-dir-sep-char))
+;;    path))
+
+;;; Classes
+;;
+(defclass semanticdb-project-database-file (semanticdb-project-database
+                                           eieio-persistent)
+  ((file-header-line :initform ";; SEMANTICDB Tags save file")
+   (do-backups :initform nil)
+   (semantic-tag-version :initarg :semantic-tag-version
+                        :initform "1.4"
+                        :documentation
+                        "The version of the tags saved.
+The default value is 1.4.  In semantic 1.4 there was no versioning, so
+when those files are loaded, this becomes the version number.
+To save the version number, we must hand-set this version string.")
+   (semanticdb-version :initarg :semanticdb-version
+                      :initform "1.4"
+                      :documentation
+                      "The version of the object system saved.
+The default value is 1.4.  In semantic 1.4, there was no versioning,
+so when those files are loaded, this becomes the version number.
+To save the version number, we must hand-set this version string.")
+   )
+  "Database of file tables saved to disk.")
+
+;;; Code:
+;;
+(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database-file)
+                                              directory)
+  "Create a new semantic database for DIRECTORY and return it.
+If a database for DIRECTORY has already been loaded, return it.
+If a database for DIRECTORY exists, then load that database, and return it.
+If DIRECTORY doesn't exist, create a new one."
+  ;; Make sure this is fully expanded so we don't get duplicates.
+  (setq directory (file-truename directory))
+  (let* ((fn (semanticdb-cache-filename dbc directory))
+        (db (or (semanticdb-file-loaded-p fn)
+                (if (file-exists-p fn)
+                    (progn
+                      (semanticdb-load-database fn))))))
+    (unless db
+      (setq db (make-instance
+               dbc  ; Create the database requested.  Perhaps
+               (concat (file-name-nondirectory
+                        (directory-file-name
+                         directory))
+                       "/")
+               :file fn :tables nil
+               :semantic-tag-version semantic-version
+               :semanticdb-version semanticdb-file-version)))
+    ;; Set this up here.   We can't put it in the constructor because it
+    ;; would be saved, and we want DB files to be portable.
+    (oset db reference-directory directory)
+    db))
+
+;;; File IO
+(defun semanticdb-load-database (filename)
+  "Load the database FILENAME."
+  (require 'inversion)
+  (condition-case foo
+      (let* ((r (eieio-persistent-read filename))
+            (c (semanticdb-get-database-tables r))
+            (tv (oref r semantic-tag-version))
+            (fv (oref r semanticdb-version))
+            )
+       ;; Restore the parent-db connection
+       (while c
+         (oset (car c) parent-db r)
+         (setq c (cdr c)))
+       (if (not (inversion-test 'semanticdb-file fv))
+           (when (inversion-test 'semantic-tag tv)
+             ;; Incompatible version.  Flush tables.
+             (semanticdb-flush-database-tables r)
+             ;; Reset the version to new version.
+             (oset r semantic-tag-version semantic-tag-version)
+             ;; Warn user
+             (message "Semanticdb file is old.  Starting over for %s"
+                      filename)
+             )
+         ;; Version is not ok.  Flush whole system
+         (message "semanticdb file is old.  Starting over for %s"
+                  filename)
+         ;; This database is so old, we need to replace it.
+         ;; We also need to delete it from the instance tracker.
+         (delete-instance r)
+         (setq r nil))
+       r)
+    (error (message "Cache Error: [%s] %s, Restart"
+                   filename foo)
+          nil)))
+
+(defun semanticdb-file-loaded-p (filename)
+  "Return the project belonging to FILENAME if it was already loaded."
+  (eieio-instance-tracker-find filename 'file 'semanticdb-database-list))
+
+(defmethod semanticdb-file-directory-exists-p ((DB semanticdb-project-database-file)
+                                              &optional supress-questions)
+  "Does the directory the database DB needs to write to exist?
+If SUPRESS-QUESTIONS, then do not ask to create the directory."
+  (let ((dest (file-name-directory (oref DB file)))
+       )
+    (cond ((null dest)
+          ;; @TODO - If it was never set up... what should we do ?
+          nil)
+         ((file-exists-p dest) t)
+         (supress-questions nil)
+         ((y-or-n-p (format "Create directory %s for SemanticDB? "
+                            dest))
+          (make-directory dest t)
+          t)
+         (t nil))
+    ))
+
+(defmethod semanticdb-save-db ((DB semanticdb-project-database-file)
+                              &optional
+                              supress-questions)
+  "Write out the database DB to its file.
+If DB is not specified, then use the current database."
+  (let ((objname (oref DB file)))
+    (when (and (semanticdb-dirty-p DB)
+              (semanticdb-live-p DB)
+              (semanticdb-file-directory-exists-p DB supress-questions)
+              (semanticdb-write-directory-p DB)
+              )
+      ;;(message "Saving tag summary for %s..." objname)
+      (condition-case foo
+         (eieio-persistent-save (or DB semanticdb-current-database))
+       (file-error                 ; System error saving?  Ignore it.
+        (message "%S: %s" foo objname))
+       (error
+        (cond
+         ((and (listp foo)
+               (stringp (nth 1 foo))
+               (string-match "write[- ]protected" (nth 1 foo)))
+          (message (nth 1 foo)))
+         ((and (listp foo)
+               (stringp (nth 1 foo))
+               (string-match "no such directory" (nth 1 foo)))
+          (message (nth 1 foo)))
+         (t
+          ;; @todo - It should ask if we are not called from a hook.
+          ;;         How?
+          (if (or supress-questions
+                  (y-or-n-p (format "Skip Error: %S ?" (car (cdr foo)))))
+              (message "Save Error: %S: %s" (car (cdr foo))
+                       objname)
+            (error "%S" (car (cdr foo))))))))
+      (run-hook-with-args 'semanticdb-save-database-hooks
+                         (or DB semanticdb-current-database))
+      ;;(message "Saving tag summary for %s...done" objname)
+      )
+    ))
+
+(defmethod semanticdb-live-p ((obj semanticdb-project-database))
+  "Return non-nil if the file associated with OBJ is live.
+Live databases are objects associated with existing directories."
+  (and (slot-boundp obj 'reference-directory)
+       (file-exists-p (oref obj reference-directory))))
+
+(defmethod semanticdb-live-p ((obj semanticdb-table))
+  "Return non-nil if the file associated with OBJ is live.
+Live files are either buffers in Emacs, or files existing on the filesystem."
+  (let ((full-filename (semanticdb-full-filename obj)))
+    (or (find-buffer-visiting full-filename)
+       (file-exists-p full-filename))))
+
+(defvar semanticdb-data-debug-on-write-error nil
+  "Run the data debugger on tables that issue errors.
+This variable is set to nil after the first error is encountered
+to prevent overload.")
+
+(defmethod object-write ((obj semanticdb-table))
+  "When writing a table, we have to make sure we deoverlay it first.
+Restore the overlays after writting.
+Argument OBJ is the object to write."
+  (when (semanticdb-live-p obj)
+    (when (semanticdb-in-buffer-p obj)
+      (save-excursion
+       (set-buffer (semanticdb-in-buffer-p obj))
+
+       ;; Make sure all our tag lists are up to date.
+       (semantic-fetch-tags)
+
+       ;; Try to get an accurate unmatched syntax table.
+       (when (and (boundp semantic-show-unmatched-syntax-mode)
+                  semantic-show-unmatched-syntax-mode)
+         ;; Only do this if the user runs unmatched syntax
+         ;; mode display enties.
+         (oset obj unmatched-syntax
+               (semantic-show-unmatched-lex-tokens-fetch))
+         )
+
+       ;; Make sure pointmax is up to date
+       (oset obj pointmax (point-max))
+       ))
+
+    ;; Make sure that the file size and other attributes are
+    ;; up to date.
+    (let ((fattr (file-attributes (semanticdb-full-filename obj))))
+      (oset obj fsize (nth 7 fattr))
+      (oset obj lastmodtime (nth 5 fattr))
+      )
+
+    ;; Do it!
+    (condition-case tableerror
+       (call-next-method)
+      (error
+       (when semanticdb-data-debug-on-write-error
+        (require 'data-debug)
+        (data-debug-new-buffer (concat "*SEMANTICDB ERROR*"))
+        (data-debug-insert-thing obj "*" "")
+        (setq semanticdb-data-debug-on-write-error nil))
+       (message "Error Writing Table: %s" (object-name obj))
+       (error "%S" (car (cdr tableerror)))))
+
+    ;; Clear the dirty bit.
+    (oset obj dirty nil)
+    ))
+
+;;; State queries
+;;
+(defmethod semanticdb-write-directory-p ((obj semanticdb-project-database-file))
+  "Return non-nil if OBJ should be written to disk.
+Uses `semanticdb-persistent-path' to determine the return value."
+  (let ((path semanticdb-persistent-path))
+    (catch 'found
+      (while path
+       (cond ((stringp (car path))
+              (if (string= (oref obj reference-directory) (car path))
+                  (throw 'found t)))
+             ((eq (car path) 'project)
+              ;; @TODO - EDE causes us to go in here and disable
+              ;; the old default 'always save' setting.
+              ;;
+              ;; With new default 'always' should I care?
+              (if semanticdb-project-predicate-functions
+                  (if (run-hook-with-args-until-success
+                       'semanticdb-project-predicate-functions
+                       (oref obj reference-directory))
+                      (throw 'found t))
+                ;; If the mode is 'project, and there are no project
+                ;; modes, then just always save the file.  If users
+                ;; wish to restrict the search, modify
+                ;; `semanticdb-persistent-path' to include desired paths.
+                (if (= (length semanticdb-persistent-path) 1)
+                    (throw 'found t))
+                ))
+             ((eq (car path) 'never)
+              (throw 'found nil))
+             ((eq (car path) 'always)
+              (throw 'found t))
+             (t (error "Invalid path %S" (car path))))
+       (setq path (cdr path)))
+      (call-next-method))
+    ))
+
+;;; Filename manipulation
+;;
+(defmethod semanticdb-file-table ((obj semanticdb-project-database-file) filename)
+  "From OBJ, return FILENAME's associated table object."
+  ;; Cheater option.  In this case, we always have files directly
+  ;; under ourselves.  The main project type may not.
+  (object-assoc (file-name-nondirectory filename) 'file (oref obj tables)))
+
+(defmethod semanticdb-file-name-non-directory :STATIC
+  ((dbclass semanticdb-project-database-file))
+  "Return the file name DBCLASS will use.
+File name excludes any directory part."
+  semanticdb-default-file-name)
+
+(defmethod semanticdb-file-name-directory :STATIC
+  ((dbclass semanticdb-project-database-file) directory)
+  "Return the relative directory to where DBCLASS will save its cache file.
+The returned path is related to DIRECTORY."
+  (if semanticdb-default-save-directory
+      (let ((file (cedet-directory-name-to-file-name directory)))
+        ;; Now create a filename for the cache file in
+        ;; ;`semanticdb-default-save-directory'.
+       (expand-file-name
+        file (file-name-as-directory semanticdb-default-save-directory)))
+    directory))
+
+(defmethod semanticdb-cache-filename :STATIC
+  ((dbclass semanticdb-project-database-file) path)
+  "For DBCLASS, return a file to a cache file belonging to PATH.
+This could be a cache file in the current directory, or an encoded file
+name in a secondary directory."
+  ;; Use concat and not expand-file-name, because the dir part
+  ;; may include some of the file name.
+  (concat (semanticdb-file-name-directory dbclass path)
+         (semanticdb-file-name-non-directory dbclass)))
+
+(defmethod semanticdb-full-filename ((obj semanticdb-project-database-file))
+  "Fetch the full filename that OBJ refers to."
+  (oref obj file))
+
+;;; FLUSH OLD FILES
+;;
+(defun semanticdb-cleanup-cache-files (&optional noerror)
+  "Cleanup any cache files associated with directories that no longer exist.
+Optional NOERROR prevents errors from being displayed."
+  (interactive)
+  (when (and (not semanticdb-default-save-directory)
+            (not noerror))
+    (error "No default save directory for semantic-save files"))
+
+  (when semanticdb-default-save-directory
+
+    ;; Calculate all the cache files we have.
+    (let* ((regexp (regexp-quote semanticdb-default-file-name))
+          (files (directory-files semanticdb-default-save-directory
+                                  t regexp))
+          (orig nil)
+          (to-delete nil))
+      (dolist (F files)
+       (setq orig (cedet-file-name-to-directory-name
+                   (file-name-nondirectory F)))
+       (when (not (file-exists-p (file-name-directory orig)))
+         (setq to-delete (cons F to-delete))
+         ))
+      (if to-delete
+       (save-window-excursion
+         (let ((buff (get-buffer-create "*Semanticdb Delete*")))
+           (with-current-buffer buff
+             (erase-buffer)
+             (insert "The following Cache files appear to be obsolete.\n\n")
+             (dolist (F to-delete)
+               (insert F "\n")))
+           (pop-to-buffer buff t t)
+           (fit-window-to-buffer (get-buffer-window buff) nil 1)
+           (when (y-or-n-p "Delete Old Cache Files? ")
+             (mapc (lambda (F)
+                     (message "Deleting to %s..." F)
+                     (delete-file F))
+                   to-delete)
+             (message "done."))
+           ))
+       ;; No files to delete
+       (when (not noerror)
+         (message "No obsolete semanticdb.cache files."))
+       ))))
+
+(provide 'semantic/db-file)
+
+;;; semanticdb-file.el ends here
diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el
new file mode 100644 (file)
index 0000000..dca2c38
--- /dev/null
@@ -0,0 +1,310 @@
+;;; db-javascript.el --- Semantic database extensions for javascript
+
+;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;;; Free Software Foundation, Inc.
+
+;; Author: Joakim Verona
+
+;; 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:
+;;
+;; Semanticdb database for Javascript.
+;;
+;; This is an omniscient database with a hard-coded list of symbols for
+;; Javascript.  See the doc at the end of this file for adding or modifying
+;; the list of tags.
+;;
+
+(require 'semantic/db-search)
+(eval-when-compile
+  ;; For generic function searching.
+  (require 'eieio)
+  (require 'eieio-opt)
+  )
+;;; Code:
+(defvar semanticdb-javascript-tags
+  '(("eval" function
+     (:arguments
+      (("x" variable nil nil nil)))
+     nil nil)
+    ("parseInt" function
+     (:arguments
+      (("string" variable nil nil nil)
+       ("radix" variable nil nil nil)))
+     nil nil)
+    ("parseFloat" function
+     (:arguments
+      (("string" variable nil nil nil)))
+     nil nil)
+    ("isNaN" function
+     (:arguments
+      (("number" variable nil nil nil)))
+     nil nil)
+    ("isFinite" function
+     (:arguments
+      (("number" variable nil nil nil)))
+     nil nil)
+    ("decodeURI" function
+     (:arguments
+      (("encodedURI" variable nil nil nil)))
+     nil nil)
+    ("decodeURIComponent" function
+     (:arguments
+      (("encodedURIComponent" variable nil nil nil)))
+     nil nil)
+    ("encodeURI" function
+     (:arguments
+      (("uri" variable nil nil nil)))
+     nil nil)
+    ("encodeURIComponent" function
+     (:arguments
+      (("uriComponent" variable nil nil nil)))
+     nil nil))
+  "Hard-coded list of javascript tags for semanticdb.
+See bottom of this file for instruction on managing this list.")
+
+;;; Classes:
+(defclass semanticdb-table-javascript (semanticdb-search-results-table)
+  ((major-mode :initform javascript-mode)
+   )
+  "A table for returning search results from javascript.")
+
+(defclass semanticdb-project-database-javascript
+  (semanticdb-project-database
+   eieio-singleton ;this db is for js globals, so singleton is apropriate
+   )
+  ((new-table-class :initform semanticdb-table-javascript
+                   :type class
+                   :documentation
+                   "New tables created for this database are of this class.")
+   )
+  "Database representing javascript.")
+
+;; Create the database, and add it to searchable databases for javascript mode.
+(defvar-mode-local javascript-mode semanticdb-project-system-databases
+  (list
+   (semanticdb-project-database-javascript "Javascript"))
+  "Search javascript for symbols.")
+
+;; NOTE: Be sure to modify this to the best advantage of your
+;;       language.
+(defvar-mode-local javascript-mode semanticdb-find-default-throttle
+  '(project omniscience)
+  "Search project files, then search this omniscience database.
+It is not necessary to to system or recursive searching because of
+the omniscience database.")
+
+;;; Filename based methods
+;;
+(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-javascript))
+  "For a javascript database, there are no explicit tables.
+Create one of our special tables that can act as an intermediary."
+  ;; NOTE: This method overrides an accessor for the `tables' slot in
+  ;;       a database.  You can either construct your own (like tmp here
+  ;;       or you can manage any number of tables.
+
+  ;; 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-javascript "tmp")))
+      (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-javascript) filename)
+  "From OBJ, return FILENAME's associated table object."
+  ;; NOTE: See not for `semanticdb-get-database-tables'.
+  (car (semanticdb-get-database-tables obj))
+  )
+
+(defmethod semanticdb-get-tags ((table semanticdb-table-javascript ))
+  "Return the list of tags belonging to TABLE."
+  ;; NOTE: Omniscient databases probably don't want to keep large tabes
+  ;;       lolly-gagging about.  Keep internal Emacs tables empty and
+  ;;       refer to alternate databases when you need something.
+  semanticdb-javascript-tags)
+
+(defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
+  "Return non-nil if TABLE's mode is equivalent to BUFFER.
+Equivalent modes are specified by by `semantic-equivalent-major-modes'
+local variable."
+  (save-excursion
+    (set-buffer buffer)
+    (eq (or mode-local-active-mode major-mode) 'javascript-mode)))
+
+;;; Usage
+;;
+;; Unlike other tables, an omniscent database does not need to
+;; be associated with a path.  Use this routine to always add ourselves
+;; to a search list.
+(define-mode-local-override semanticdb-find-translate-path javascript-mode
+  (path brutish)
+  "Return a list of semanticdb tables asociated with PATH.
+If brutish, do the default action.
+If not brutish, do the default action, and append the system
+database (if available.)"
+  (let ((default
+         ;; When we recurse, disable searching of system databases
+         ;; so that our Javascript database only shows up once when
+         ;; we append it in this iteration.
+         (let ((semanticdb-search-system-databases nil)
+               )
+           (semanticdb-find-translate-path-default path brutish))))
+    ;; Don't add anything if BRUTISH is on (it will be added in that fcn)
+    ;; or if we aren't supposed to search the system.
+    (if (or brutish (not semanticdb-search-system-databases))
+       default
+      (let ((tables (apply #'append
+                          (mapcar
+                           (lambda (db) (semanticdb-get-database-tables db))
+                           semanticdb-project-system-databases))))
+       (append default tables)))))
+
+;;; Search Overrides
+;;
+;; NOTE WHEN IMPLEMENTING: Be sure to add doc-string updates explaining
+;; how your new search routines are implemented.
+;;
+(defun semanticdb-javascript-regexp-search (regexp)
+  "Search for REGEXP in our fixed list of javascript tags."
+  (let* ((tags semanticdb-javascript-tags)
+        (result nil))
+    (while tags
+      (if (string-match regexp (caar tags))
+         (setq result (cons (car tags) result)))
+      (setq tags (cdr tags)))
+    result))
+
+(defmethod semanticdb-find-tags-by-name-method
+  ((table semanticdb-table-javascript) 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)
+    (assoc-string name  semanticdb-javascript-tags)
+    ))
+
+(defmethod semanticdb-find-tags-by-name-regexp-method
+  ((table semanticdb-table-javascript) 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
+    (semanticdb-javascript-regexp-search regex)
+
+    ))
+
+(defmethod semanticdb-find-tags-for-completion-method
+  ((table semanticdb-table-javascript) 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)
+    ;; YOUR IMPLEMENTATION HERE
+    (semanticdb-javascript-regexp-search (concat "^" prefix ".*"))
+    ))
+
+(defmethod semanticdb-find-tags-by-class-method
+  ((table semanticdb-table-javascript) class &optional tags)
+  "In TABLE, find all occurances of tags of CLASS.
+Optional argument TAGS is a list of tags to search.
+Returns a table of all matching tags."
+  (if tags (call-next-method)
+    ;; YOUR IMPLEMENTATION HERE
+    ;;
+    ;; Note: This search method could be considered optional in an
+    ;;       omniscient database.  It may be unwise to return all tags
+    ;;       that exist for a language that are a variable or function.
+    ;;
+    ;; If it is optional, you can just delete this method.
+    nil))
+
+;;; 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-javascript) 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 javascript."
+  (semanticdb-find-tags-by-name-method table name tags))
+
+(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+  ((table semanticdb-table-javascript) 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 javascript."
+  (semanticdb-find-tags-by-name-regexp-method table regex tags))
+
+(defmethod semanticdb-deep-find-tags-for-completion-method
+  ((table semanticdb-table-javascript) 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 javascript."
+  (semanticdb-find-tags-for-completion-method table prefix tags))
+
+;;; Advanced Searches
+;;
+(defmethod semanticdb-find-tags-external-children-of-type-method
+  ((table semanticdb-table-javascript) type &optional tags)
+  "Find all nonterminals which are child elements of TYPE
+Optional argument TAGS is a list of tags to search.
+Return a list of tags."
+  (if tags (call-next-method)
+    ;; YOUR IMPLEMENTATION HERE
+    ;;
+    ;; OPTIONAL: This could be considered an optional function.  It is
+    ;;       used for `semantic-adopt-external-members' and may not
+    ;;       be possible to do in your language.
+    ;;
+    ;; If it is optional, you can just delete this method.
+    ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun semanticdb-javascript-strip-tags (tags)
+  "Strip TAGS from overlays and reparse symbols."
+  (cond ((and (consp tags) (eq 'reparse-symbol (car tags)))
+        nil)
+       ((overlayp tags) nil)
+       ((atom tags) tags)
+       (t (cons (semanticdb-javascript-strip-tags
+                 (car tags)) (semanticdb-javascript-strip-tags
+                              (cdr tags))))))
+
+;this list was made from a javascript file, and the above function
+;; function eval(x){}
+;; function parseInt(string,radix){}
+;; function parseFloat(string){}
+;; function isNaN(number){}
+;; function isFinite(number){}
+;; function decodeURI(encodedURI){}
+;; function decodeURIComponent (encodedURIComponent){}
+;; function encodeURI (uri){}
+;; function encodeURIComponent (uriComponent){}
+
+
+(provide 'semantic/db-el)
+
+;;; semanticdb-el.el ends here
diff --git a/lisp/cedet/semantic/db-search.el b/lisp/cedet/semantic/db-search.el
new file mode 100644 (file)
index 0000000..acfb788
--- /dev/null
@@ -0,0 +1,451 @@
+;;; db-search.el --- Searching through semantic databases.
+
+;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 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:
+;;
+;; NOTE: THESE APIs ARE OBSOLETE:
+;;
+;; Databases of various forms can all be searched.  These routines
+;; cover many common forms of searching.
+;;
+;; There are three types of searches that can be implemented:
+;;
+;; Basic Search:
+;;  These searches allow searching on specific attributes of tags,
+;;  such as name or type.
+;;
+;; Advanced Search:
+;;  These are searches that were needed to accomplish some tasks
+;;  during in utilities.  Advanced searches include matching methods
+;;  defined outside some parent class.
+;;
+;;  The reason for advanced searches are so that external
+;;  repositories such as the Emacs obarray, or java .class files can
+;;  quickly answer these needed questions without dumping the entire
+;;  symbol list into Emacs for a regular semanticdb search.
+;;
+;; Generic Search:
+;;  The generic search, `semanticdb-find-nonterminal-by-function'
+;;  accepts a Emacs Lisp predicate that tests tags in Semantic
+;;  format.  Most external searches cannot perform this search.
+
+(require 'semantic/db)
+(require 'semantic/find)
+
+;;; Code:
+;;
+;;; Classes:
+
+;; @TODO MOVE THIS CLASS?
+(defclass semanticdb-search-results-table (semanticdb-abstract-table)
+  (
+   )
+  "Table used for search results when there is no file or table association.
+Examples include search results from external sources such as from
+Emacs' own symbol table, or from external libraries.")
+
+(defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force)
+  "If the tag list associated with OBJ is loaded, refresh it.
+This will call `semantic-fetch-tags' if that file is in memory."
+  nil)
+
+;;; Utils
+;;
+;; Convenience routines for searches
+(defun semanticdb-collect-find-results (result-in-databases
+                                       result-finding-function
+                                       ignore-system
+                                       find-file-on-match)
+  "OBSOLETE:
+Collect results across RESULT-IN-DATABASES for RESULT-FINDING-FUNCTION.
+If RESULT-IN-DATABASES is nil, search a range of associated databases
+calculated by `semanticdb-current-database-list'.
+RESULT-IN-DATABASES is a list of variable `semanticdb-project-database'
+objects.
+RESULT-FINDING-FUNCTION should accept one argument, the database being searched.
+Argument IGNORE-SYSTEM specifies if any available system databases should
+be ignored, or searched.
+Argument FIND-FILE-ON-MATCH indicates that the found databases
+should be capable of doing so."
+  (if (not (listp result-in-databases))
+      (signal 'wrong-type-argument (list 'listp result-in-databases)))
+  (let* ((semanticdb-search-system-databases
+         (if ignore-system
+             nil
+           semanticdb-search-system-databases))
+        (dbs (or result-in-databases
+                 ;; Calculate what database to use.
+                 ;; Something simple and dumb for now.
+                 (or (semanticdb-current-database-list)
+                     (list (semanticdb-current-database)))))
+        (case-fold-search semantic-case-fold)
+        (res (mapcar
+              (lambda (db)
+                (if (or (not find-file-on-match)
+                        (not (child-of-class-p
+                              (oref db new-table-class)
+                              semanticdb-search-results-table)))
+                    (funcall result-finding-function db)))
+              dbs))
+        out)
+    ;; Flatten the list.  The DB is unimportant at this stage.
+    (setq res (apply 'append res))
+    (setq out nil)
+    ;; Move across results, and throw out empties.
+    (while res
+      (if (car res)
+         (setq out (cons (car res) out)))
+      (setq res (cdr res)))
+    ;; Results
+    out))
+
+;;; Programatic interfaces
+;;
+;; These routines all perform different types of searches, and are
+;; interfaces to the database methods used to also perform those searches.
+
+(defun semanticdb-find-nonterminal-by-token
+  (token &optional databases search-parts search-includes diff-mode find-file-match ignore-system)
+  "OBSOLETE:
+Find all occurances of nonterminals with token TOKEN in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES, DIFF-MODE, FIND-FILE-MATCH and IGNORE-SYSTEM.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-collect-find-results
+   databases
+   (lambda (db)
+     (semanticdb-find-nonterminal-by-token-method
+      db token search-parts search-includes diff-mode find-file-match))
+   ignore-system
+   find-file-match))
+(make-obsolete 'semanticdb-find-nonterminal-by-token
+              "Please don't use this function")
+
+(defun semanticdb-find-nonterminal-by-name
+  (name &optional databases search-parts search-includes diff-mode find-file-match ignore-system)
+  "OBSOLETE:
+Find all occurances of nonterminals with name NAME in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES, DIFF-MODE, FIND-FILE-MATCH and IGNORE-SYSTEM.
+Return a list ((DB-TABLE . TOKEN) ...)."
+  (semanticdb-collect-find-results
+   databases
+   (lambda (db)
+     (semanticdb-find-nonterminal-by-name-method
+      db name search-parts search-includes diff-mode find-file-match))
+   ignore-system
+   find-file-match))
+(make-obsolete 'semanticdb-find-nonterminal-by-name
+              "Please don't use this function")
+
+(defun semanticdb-find-nonterminal-by-name-regexp
+  (regex &optional databases search-parts search-includes diff-mode find-file-match ignore-system)
+  "OBSOLETE:
+Find all occurances of nonterminals with name matching REGEX in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, FIND-FILE-MATCH and IGNORE-SYSTEM.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-collect-find-results
+   databases
+   (lambda (db)
+     (semanticdb-find-nonterminal-by-name-regexp-method
+      db regex search-parts search-includes diff-mode find-file-match))
+   ignore-system
+   find-file-match))
+(make-obsolete 'semanticdb-find-nonterminal-by-name-regexp
+              "Please don't use this function")
+
+
+(defun semanticdb-find-nonterminal-by-type
+  (type &optional databases search-parts search-includes diff-mode find-file-match ignore-system)
+  "OBSOLETE:
+Find all nonterminals with a type of TYPE in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, FIND-FILE-MATCH and IGNORE-SYSTEM.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-collect-find-results
+   databases
+   (lambda (db)
+     (semanticdb-find-nonterminal-by-type-method
+      db type search-parts search-includes diff-mode find-file-match))
+   ignore-system
+   find-file-match))
+(make-obsolete 'semanticdb-find-nonterminal-by-type
+              "Please don't use this function")
+
+
+(defun semanticdb-find-nonterminal-by-property
+  (property value &optional databases search-parts search-includes diff-mode find-file-match ignore-system)
+  "OBSOLETE:
+Find all nonterminals with a PROPERTY equal to VALUE in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, FIND-FILE-MATCH and IGNORE-SYSTEM.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-collect-find-results
+   databases
+   (lambda (db)
+     (semanticdb-find-nonterminal-by-property-method
+      db property value search-parts search-includes diff-mode find-file-match))
+   ignore-system
+   find-file-match))
+(make-obsolete 'semanticdb-find-nonterminal-by-property
+              "Please don't use this function")
+
+(defun semanticdb-find-nonterminal-by-extra-spec
+  (spec &optional databases search-parts search-includes diff-mode find-file-match ignore-system)
+  "OBSOLETE:
+Find all nonterminals with a SPEC in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, FIND-FILE-MATCH and IGNORE-SYSTEM.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-collect-find-results
+   databases
+   (lambda (db)
+     (semanticdb-find-nonterminal-by-extra-spec-method
+      db spec search-parts search-includes diff-mode find-file-match))
+   ignore-system
+   find-file-match))
+(make-obsolete 'semanticdb-find-nonterminal-by-extra-spec
+              "Please don't use this function")
+
+(defun semanticdb-find-nonterminal-by-extra-spec-value
+  (spec value &optional databases search-parts search-includes diff-mode find-file-match ignore-system)
+  "OBSOLETE:
+Find all nonterminals with a SPEC equal to VALUE in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, FIND-FILE-MATCH and IGNORE-SYSTEM.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-collect-find-results
+   databases
+   (lambda (db)
+     (semanticdb-find-nonterminal-by-extra-spec-value-method
+      db spec value search-parts search-includes diff-mode find-file-match))
+   ignore-system
+   find-file-match))
+(make-obsolete 'semanticdb-find-nonterminal-by-extra-spec-value
+              "Please don't use this function")
+
+;;; Advanced Search Routines
+;;
+(defun semanticdb-find-nonterminal-external-children-of-type
+  (type &optional databases search-parts search-includes diff-mode find-file-match ignore-system)
+  "OBSOLETE:
+Find all nonterminals which are child elements of TYPE.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, FIND-FILE-MATCH and IGNORE-SYSTEM.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-collect-find-results
+   databases
+   (lambda (db)
+     (semanticdb-find-nonterminal-external-children-of-type-method
+      db type search-parts search-includes diff-mode find-file-match))
+   ignore-system
+   find-file-match))
+
+;;; Generic Search routine
+;;
+
+(defun semanticdb-find-nonterminal-by-function
+  (function &optional databases search-parts search-includes diff-mode find-file-match ignore-system)
+  "OBSOLETE:
+Find all occurances of nonterminals which match FUNCTION.
+Search in all DATABASES.  If DATABASES is nil, search a range of
+associated databases calculated `semanticdb-current-database-list' and
+DATABASES is a list of variable `semanticdb-project-database' objects.
+When SEARCH-PARTS is non-nil the search will include children of tags.
+When SEARCH-INCLUDES is non-nil, the search will include dependency files.
+When DIFF-MODE is non-nil, search databases which are of a different mode.
+A Mode is the `major-mode' that file was in when it was last parsed.
+When FIND-FILE-MATCH is non-nil, the make sure any found token's file is
+in an Emacs buffer.
+When IGNORE-SYSTEM is non-nil, system libraries are not searched.
+Return a list ((DB-TABLE . TOKEN-OR-TOKEN-LIST) ...)."
+  (semanticdb-collect-find-results
+   databases
+   (lambda (db)
+     (semanticdb-find-nonterminal-by-function-method
+      db function search-parts search-includes diff-mode find-file-match))
+   ignore-system
+   find-file-match))
+
+;;; Search Methods
+;;
+;; These are the base routines for searching semantic databases.
+;; Overload these with your subclasses to participate in the searching
+;; mechanism.
+(defmethod semanticdb-find-nonterminal-by-token-method
+  ((database semanticdb-project-database) token search-parts search-includes diff-mode find-file-match)
+  "OBSOLETE:
+In DB, find all occurances of nonterminals with token TOKEN in databases.
+See `semanticdb-find-nonterminal-by-function-method' for details on,
+SEARCH-PARTS, SEARCH-INCLUDES, DIFF-MODE, and FIND-FILE-MATCH.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (let ((goofy-token-name token))
+    (semanticdb-find-nonterminal-by-function-method
+     database (lambda (stream sp si)
+               (semantic-brute-find-tag-by-class goofy-token-name stream sp si))
+     search-parts search-includes diff-mode find-file-match)))
+
+(defmethod semanticdb-find-nonterminal-by-name-method
+  ((database semanticdb-project-database) name search-parts search-includes diff-mode find-file-match)
+  "OBSOLETE:
+Find all occurances of nonterminals with name NAME in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES, DIFF-MODE, and FIND-FILE-MATCH.
+Return a list ((DB-TABLE . TOKEN) ...)."
+  (semanticdb-find-nonterminal-by-function-method
+   database
+   (lambda (stream sp si)
+     (semantic-brute-find-first-tag-by-name name stream sp si))
+   search-parts search-includes diff-mode find-file-match))
+
+(defmethod semanticdb-find-nonterminal-by-name-regexp-method
+  ((database semanticdb-project-database) regex search-parts search-includes diff-mode find-file-match)
+  "OBSOLETE:
+Find all occurances of nonterminals with name matching REGEX in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, and FIND-FILE-MATCH.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-find-nonterminal-by-function-method
+   database
+   (lambda (stream sp si)
+     (semantic-brute-find-tag-by-name-regexp regex stream sp si))
+   search-parts search-includes diff-mode find-file-match))
+
+(defmethod semanticdb-find-nonterminal-by-type-method
+  ((database semanticdb-project-database) type search-parts search-includes diff-mode find-file-match)
+  "OBSOLETE:
+Find all nonterminals with a type of TYPE in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, and FIND-FILE-MATCH.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-find-nonterminal-by-function-method
+   database
+   (lambda (stream sp si)
+     (semantic-brute-find-tag-by-type type stream sp si))
+   search-parts search-includes diff-mode find-file-match))
+
+(defmethod semanticdb-find-nonterminal-by-property-method
+  ((database semanticdb-project-database) property value search-parts search-includes diff-mode find-file-match)
+  "OBSOLETE:
+Find all nonterminals with a PROPERTY equal to VALUE in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, and FIND-FILE-MATCH.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-find-nonterminal-by-function-method
+   database
+   (lambda (stream sp si)
+     (semantic-brute-find-tag-by-property property value stream sp si))
+   search-parts search-includes diff-mode find-file-match))
+
+(defmethod semanticdb-find-nonterminal-by-extra-spec-method
+  ((database semanticdb-project-database) spec search-parts search-includes diff-mode find-file-match)
+  "OBSOLETE:
+Find all nonterminals with a SPEC in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, and FIND-FILE-MATCH.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-find-nonterminal-by-function-method
+   database
+   (lambda (stream sp si)
+     (semantic-brute-find-tag-by-attribute spec stream sp si))
+   search-parts search-includes diff-mode find-file-match))
+
+(defmethod semanticdb-find-nonterminal-by-extra-spec-value-method
+  ((database semanticdb-project-database) spec value search-parts search-includes diff-mode find-file-match)
+  "OBSOLETE:
+Find all nonterminals with a SPEC equal to VALUE in databases.
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, and FIND-FILE-MATCH.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-find-nonterminal-by-function-method
+   database
+   (lambda (stream sp si)
+     (semantic-brute-find-tag-by-attribute-value spec value stream sp si))
+   search-parts search-includes diff-mode find-file-match))
+
+;;; Advanced Searches
+;;
+(defmethod semanticdb-find-nonterminal-external-children-of-type-method
+  ((database semanticdb-project-database) type search-parts search-includes diff-mode find-file-match)
+  "OBSOLETE:
+Find all nonterminals which are child elements of TYPE
+See `semanticdb-find-nonterminal-by-function' for details on DATABASES,
+SEARCH-PARTS, SEARCH-INCLUDES DIFF-MODE, FIND-FILE-MATCH and IGNORE-SYSTEM.
+Return a list ((DB-TABLE . TOKEN-LIST) ...)."
+  (semanticdb-find-nonterminal-by-function-method
+   database
+   `(lambda (stream sp si)
+      (semantic-brute-find-tag-by-function
+       (lambda (tok)
+        (let ((p (semantic-nonterminal-external-member-parent tok)))
+          (and (stringp p) (string= ,type p)))
+        )
+       stream sp si))
+   nil nil t))
+
+;;; Generic Search
+;;
+(defmethod semanticdb-find-nonterminal-by-function-method
+  ((database semanticdb-project-database)
+   function &optional search-parts search-includes diff-mode find-file-match)
+  "OBSOLETE:
+In DATABASE, find all occurances of nonterminals which match FUNCTION.
+When SEARCH-PARTS is non-nil the search will include children of tags.
+When SEARCH-INCLUDES is non-nil, the search will include dependency files.
+When DIFF-MODE is non-nil, search databases which are of a different mode.
+A mode is the `major-mode' that file was in when it was last parsed.
+When FIND-FILE-MATCH is non-nil, the make sure any found token's file is
+in an Emacs buffer.
+Return a list of matches."
+  (let* ((ret nil)
+        (files (semanticdb-get-database-tables database))
+        (found nil)
+        (orig-buffer (current-buffer)))
+    (while files
+      (when (or diff-mode
+               (semanticdb-equivalent-mode (car files) orig-buffer))
+       ;; This can cause unneeded refreshes while typing with
+       ;; senator-eldoc mode.
+       ;;(semanticdb-refresh-table (car files))
+       (setq found (funcall function
+                            (semanticdb-get-tags (car files))
+                            search-parts
+                            search-includes
+                            )))
+      (if found
+         (progn
+           ;; When something is found, make sure we read in that buffer if it
+           ;; had not already been loaded.
+           (if find-file-match
+               (save-excursion (semanticdb-set-buffer (car files))))
+           ;; In theory, the database is up-to-date with what is in the file, and
+           ;; these tags are ready to go.
+           ;; There is a bug lurking here I don't have time to fix.
+           (setq ret (cons (cons (car files) found) ret))
+           (setq found nil)))
+      (setq files (cdr files)))
+    (nreverse ret)))
+
+(provide 'semantic/db-search)
+
+;;; semanticdb-search.el ends here
diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el
new file mode 100644 (file)
index 0000000..689e6d9
--- /dev/null
@@ -0,0 +1,585 @@
+;;; db-typecache.el --- Manage Datatypes
+
+;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <eric@siege-engine.com>
+
+;; 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:
+;;
+;; Manage a datatype cache.
+;;
+;; For typed languages like C++ collect all known types from various
+;; headers, merge namespaces, and expunge duplicates.
+;;
+;; It is likely this feature will only be needed for C/C++.
+
+(require 'semantic/db)
+(require 'semantic/db-find)
+
+;;; Code:
+
+\f
+;;; TABLE TYPECACHE
+(defclass semanticdb-typecache ()
+  ((filestream :initform nil
+              :documentation
+              "Fully sorted/merged list of tags within this buffer.")
+   (includestream :initform nil
+                 :documentation
+                 "Fully sorted/merged list of tags from this file's includes list.")
+   (stream :initform nil
+          :documentation
+          "The searchable tag stream for this cache.
+NOTE: Can I get rid of this?  Use a hashtable instead?")
+   (dependants :initform nil
+              :documentation
+              "Any other object that is dependent on typecache results.
+Said object must support `semantic-reset' methods.")
+   ;; @todo - add some sort of fast-hash.
+   ;; @note - Rebuilds in large projects already take a while, and the
+   ;;     actual searches are pretty fast.  Really needed?
+   )
+  "Structure for maintaining a typecache.")
+
+(defmethod semantic-reset ((tc semanticdb-typecache))
+  "Reset the object IDX."
+  (oset tc filestream nil)
+  (oset tc includestream nil)
+
+  (oset tc stream nil)
+
+  (mapc 'semantic-reset (oref tc dependants))
+  (oset tc dependants nil)
+  )
+
+(defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache))
+  "Do a reset from a notify from a table we depend on."
+  (oset tc includestream nil)
+  (mapc 'semantic-reset (oref tc dependants))
+  (oset tc dependants nil)
+  )
+
+(defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache)
+                                          new-tags)
+  "Reset the typecache based on a partial reparse."
+  (when (semantic-find-tags-by-class 'include new-tags)
+    (oset tc includestream nil)
+    (mapc 'semantic-reset (oref tc dependants))
+    (oset tc dependants nil)
+    )
+
+  (when (semantic-find-tags-by-class 'type new-tags)
+    ;; Reset our index
+    (oset tc filestream nil)
+    t ;; Return true, our core file tags have changed in a relavant way.
+    )
+
+  ;; NO CODE HERE
+  )
+
+(defun semanticdb-typecache-add-dependant (dep)
+  "Add into the local typecache a dependant DEP."
+  (let* ((table semanticdb-current-table)
+        ;;(idx (semanticdb-get-table-index table))
+        (cache (semanticdb-get-typecache table))
+        )
+    (object-add-to-list cache 'dependants dep)))
+
+(defun semanticdb-typecache-length(thing)
+  "How long is THING?
+Debugging function."
+  (cond ((semanticdb-typecache-child-p thing)
+        (length (oref thing stream)))
+       ((semantic-tag-p thing)
+        (length (semantic-tag-type-members thing)))
+       ((and (listp thing) (semantic-tag-p (car thing)))
+        (length thing))
+       ((null thing)
+        0)
+       (t -1)  ))
+
+
+(defmethod semanticdb-get-typecache ((table semanticdb-abstract-table))
+  "Retrieve the typecache from the semanticdb TABLE.
+If there is no table, create one, and fill it in."
+  (semanticdb-refresh-table table)
+  (let* ((idx (semanticdb-get-table-index table))
+        (cache (oref idx type-cache))
+        )
+
+    ;; Make sure we have a cache object in the DB index.
+    (when (not cache)
+      ;; The object won't change as we fill it with stuff.
+      (setq cache (semanticdb-typecache (semanticdb-full-filename table)))
+      (oset idx type-cache cache))
+
+    cache))
+
+(defmethod semanticdb-have-typecache-p ((table semanticdb-abstract-table))
+  "Return non-nil (the typecache) if TABLE has a pre-calculated typecache."
+  (let* ((idx (semanticdb-get-table-index table)))
+    (oref idx type-cache)))
+
+\f
+;;; DATABASE TYPECACHE
+;;
+;; A full database can cache the types across its files.
+;;
+;; Unlike file based caches, this one is a bit simpler, and just needs
+;; to get reset when a table gets updated.
+
+(defclass semanticdb-database-typecache (semanticdb-abstract-db-cache)
+  ((stream :initform nil
+          :documentation
+          "The searchable tag stream for this cache.")
+   )
+  "Structure for maintaining a typecache.")
+
+(defmethod semantic-reset ((tc semanticdb-database-typecache))
+  "Reset the object IDX."
+  (oset tc stream nil)
+  )
+
+(defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
+                                  new-tags)
+  "Synchronize a CACHE with some NEW-TAGS."
+  )
+
+(defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache)
+                                          new-tags)
+  "Synchronize a CACHE with some changed NEW-TAGS."
+  )
+
+(defmethod semanticdb-get-typecache ((db semanticdb-project-database))
+  "Retrieve the typecache from the semantic database DB.
+If there is no table, create one, and fill it in."
+  (semanticdb-cache-get db semanticdb-database-typecache)
+  )
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; MERGING
+;;
+;; Managing long streams of tags representing data types.
+;;
+(defun semanticdb-typecache-apply-filename (file stream)
+  "Apply the filename FILE to all tags in STREAM."
+  (let ((new nil))
+    (while stream
+      (setq new (cons (semantic-tag-copy (car stream) nil file)
+                     new))
+      ;The below is handled by the tag-copy fcn.
+      ;(semantic--tag-put-property (car new) :filename file)
+      (setq stream (cdr stream)))
+    (nreverse new)))
+
+
+(defsubst semanticdb-typecache-safe-tag-members (tag)
+  "Return a list of members for TAG that are safe to permute."
+  (let ((mem (semantic-tag-type-members tag))
+       (fname (semantic-tag-file-name tag)))
+    (if fname
+       (setq mem (semanticdb-typecache-apply-filename fname mem))
+      (copy-sequence mem))))
+
+(defsubst semanticdb-typecache-safe-tag-list (tags table)
+  "Make the tag list TAGS found in TABLE safe for the typecache.
+Adds a filename and copies the tags."
+  (semanticdb-typecache-apply-filename
+   (semanticdb-full-filename table)
+   tags))
+
+(defun semanticdb-typecache-merge-streams (cache1 cache2)
+  "Merge into CACHE1 and CACHE2 together.  The Caches will be merged in place."
+  (if (or (and (not cache1) (not cache2))
+         (and (not (cdr cache1)) (not cache2))
+         (and (not cache1) (not (cdr cache2))))
+      ;; If all caches are empty OR
+      ;; cache1 is length 1 and no cache2 OR
+      ;; no cache1 and length 1 cache2
+      ;;
+      ;; then just return the cache, and skip all this merging stuff.
+      (or cache1 cache2)
+
+    ;; Assume we always have datatypes, as this typecache isn't really
+    ;; useful without a typed language.
+    (let ((S (semantic-sort-tags-by-name-then-type-increasing
+             ;; I used to use append, but it copied cache1 but not cache2.
+             ;; Since sort was permuting cache2, I already had to make sure
+             ;; the caches were permute-safe.  Might as well use nconc here.
+             (nconc cache1 cache2)))
+         (ans nil)
+         (next nil)
+         (prev nil)
+         (type nil))
+      ;; With all the tags in order, we can loop over them, and when
+      ;; two have the same name, we can either throw one away, or construct
+      ;; a fresh new tag merging the items together.
+      (while S
+       (setq prev (car ans))
+       (setq next (car S))
+       (if (or
+            ;; CASE 1 - First item
+            (null prev)
+            ;; CASE 2 - New name
+            (not (string= (semantic-tag-name next)
+                          (semantic-tag-name prev))))
+           (setq ans (cons next ans))
+         ;; ELSE - We have a NAME match.
+         (setq type (semantic-tag-type next))
+         (if (semantic-tag-of-type-p prev type) ; Are they the same datatype
+             ;; Same Class, we can do a merge.
+             (cond
+              ((and (semantic-tag-of-class-p next 'type)
+                    (string= type "namespace"))
+               ;; Namespaces - merge the children together.
+               (setcar ans
+                       (semantic-tag-new-type
+                        (semantic-tag-name prev) ; - they are the same
+                        "namespace"    ; - we know this as fact
+                        (semanticdb-typecache-merge-streams
+                         (semanticdb-typecache-safe-tag-members prev)
+                         (semanticdb-typecache-safe-tag-members next))
+                        nil            ; - no attributes
+                        ))
+               ;; Make sure we mark this as a fake tag.
+               (semantic-tag-set-faux (car ans))
+               )
+              ((semantic-tag-prototype-p next)
+               ;; NEXT is a prototype... so keep previous.
+               nil                     ; - keep prev, do nothing
+               )
+              ((semantic-tag-prototype-p prev)
+               ;; PREV is a prototype, but not next.. so keep NEXT.
+               ;; setcar - set by side-effect on top of prev
+               (setcar ans next)
+               )
+              (t
+               ;;(message "Don't know how to merge %s.  Keeping first entry." (semantic-tag-name next))
+               ))
+           ;; Not same class... but same name
+                                       ;(message "Same name, different type: %s, %s!=%s"
+                                       ;          (semantic-tag-name next)
+                                       ;          (semantic-tag-type next)
+                                       ;        (semantic-tag-type prev))
+           (setq ans (cons next ans))
+           ))
+       (setq S (cdr S)))
+      (nreverse ans))))
+\f
+;;; Refresh / Query API
+;;
+;; Queries that can be made for the typecache.
+(defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table))
+  "No tags available from non-file based tables."
+  nil)
+
+(defmethod semanticdb-typecache-file-tags ((table semanticdb-table))
+  "Update the typecache for TABLE, and return the file-tags.
+File-tags are those that belong to this file only, and excludes
+all included files."
+  (let* (;(idx (semanticdb-get-table-index table))
+        (cache (semanticdb-get-typecache table))
+        )
+
+    ;; Make sure our file-tags list is up to date.
+    (when (not (oref cache filestream))
+      (let ((tags  (semantic-find-tags-by-class 'type table)))
+       (when tags
+         (setq tags (semanticdb-typecache-safe-tag-list tags table))
+         (oset cache filestream (semanticdb-typecache-merge-streams tags nil)))))
+
+    ;; Return our cache.
+    (oref cache filestream)
+    ))
+
+(defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table))
+  "No tags available from non-file based tables."
+  nil)
+
+(defmethod semanticdb-typecache-include-tags ((table semanticdb-table))
+  "Update the typecache for TABLE, and return the merged types from the include tags.
+Include-tags are the tags brought in via includes, all merged together into
+a master list."
+  (let* ((cache (semanticdb-get-typecache table))
+        )
+
+    ;; Make sure our file-tags list is up to date.
+    (when (not (oref cache includestream))
+      (let (;; Calc the path first.  This will have a nice side -effect of
+           ;; getting the cache refreshed if a refresh is needed.  Most of the
+           ;; time this value is itself cached, so the query is fast.
+           (incpath (semanticdb-find-translate-path table nil))
+           (incstream nil))
+       ;; Get the translated path, and extract all the type tags, then merge
+       ;; them all together.
+       (dolist (i incpath)
+         ;; don't include ourselves in this crazy list.
+         (when (and i (not (eq i table))
+                    ;; @todo - This eieio fcn can be slow!  Do I need it?
+                    ;; (semanticdb-table-child-p i)
+                    )
+           (setq incstream
+                 (semanticdb-typecache-merge-streams
+                  incstream
+                  ;; Getting the cache from this table will also cause this
+                  ;; file to update it's cache from it's decendants.
+                  ;;
+                  ;; In theory, caches are only built for most includes
+                  ;; only once (in the loop before this one), so this ends
+                  ;; up being super fast as we edit our file.
+                  (copy-sequence
+                   (semanticdb-typecache-file-tags i))))
+           ))
+
+       ;; Save...
+       (oset cache includestream incstream)))
+
+    ;; Return our cache.
+    (oref cache includestream)
+    ))
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Search Routines
+;;
+(define-overloadable-function semanticdb-typecache-find (type &optional path find-file-match)
+  "Search the typecache for TYPE in PATH.
+If type is a string, split the string, and search for the parts.
+If type is a list, treat the type as a pre-split string.
+PATH can be nil for the current buffer, or a semanticdb table.
+FIND-FILE-MATCH is non-nil to force all found tags to be loaded into a buffer.")
+
+(defun semanticdb-typecache-find-default (type &optional path find-file-match)
+  "Default implementation of `semanticdb-typecache-find'.
+TYPE is the datatype to find.
+PATH is the search path.. which should be one table object.
+If FIND-FILE-MATCH is non-nil, then force the file belonging to the
+found tag to be loaded."
+  (semanticdb-typecache-find-method (or path semanticdb-current-table)
+                                   type find-file-match))
+
+(defun semanticdb-typecache-find-by-name-helper (name table)
+  "Find the tag with NAME in TABLE, which is from a typecache.
+If more than one tag has NAME in TABLE, we will prefer the tag that
+is of class 'type."
+  (let* ((names (semantic-find-tags-by-name name table))
+        (types (semantic-find-tags-by-class 'type names)))
+    (or (car-safe types) (car-safe names))))
+
+(defmethod semanticdb-typecache-find-method ((table semanticdb-abstract-table)
+                                            type find-file-match)
+  "Search the typecache in TABLE for the datatype TYPE.
+If type is a string, split the string, and search for the parts.
+If type is a list, treat the type as a pre-split string.
+If FIND-FILE-MATCH is non-nil, then force the file belonging to the
+found tag to be loaded."
+  ;; convert string to a list.
+  (when (stringp type) (setq type (semantic-analyze-split-name type)))
+  (when (stringp type) (setq type (list type)))
+
+  ;; Search for the list in our typecache.
+  (let* ((file (semanticdb-typecache-file-tags table))
+        (inc (semanticdb-typecache-include-tags table))
+        (stream nil)
+        (f-ans nil)
+        (i-ans nil)
+        (ans nil)
+        (notdone t)
+        (lastfile nil)
+        (thisfile nil)
+        (lastans nil)
+        (calculated-scope nil)
+        )
+    ;; 1) Find first symbol in the two master lists and then merge
+    ;;    the found streams.
+
+    ;; We stripped duplicates, so these will be super-fast!
+    (setq f-ans (semantic-find-first-tag-by-name (car type) file))
+    (setq i-ans (semantic-find-first-tag-by-name (car type) inc))
+    (if (and f-ans i-ans)
+       (progn
+         ;; This trick merges the two identified tags, making sure our lists are
+         ;; complete.  The second find then gets the new 'master' from the list of 2.
+         (setq ans (semanticdb-typecache-merge-streams (list f-ans) (list i-ans)))
+         (setq ans (semantic-find-first-tag-by-name (car type) ans))
+         )
+
+      ;; The answers are already sorted and merged, so if one misses,
+      ;; no need to do any special work.
+      (setq ans (or f-ans i-ans)))
+
+    ;; 2) Loop over the remaining parts.
+    (while (and type notdone)
+
+      ;; For pass > 1, stream will be non-nil, so do a search, otherwise
+      ;; ans is from outside the loop.
+      (when stream
+       (setq ans (semanticdb-typecache-find-by-name-helper (car type) stream))
+
+       ;; NOTE: The below test to make sure we get a type is only relevant
+       ;;       for the SECOND pass or later.  The first pass can only ever
+       ;;       find a type/namespace because everything else is excluded.
+
+       ;; If this is not the last entry from the list, then it
+       ;; must be a type or a namespace.  Lets double check.
+       (when (cdr type)
+
+         ;; From above, there is only one tag in ans, and we prefer
+         ;; types.
+         (when (not (semantic-tag-of-class-p ans 'type))
+
+           (setq ans nil)))
+       )
+
+      (push ans calculated-scope)
+
+      ;; Track most recent file.
+      (setq thisfile (semantic-tag-file-name ans))
+      (when (and thisfile (stringp thisfile))
+       (setq lastfile thisfile))
+
+      ;; If we have a miss, exit, otherwise, update the stream to
+      ;; the next set of members.
+      (if (not ans)
+         (setq notdone nil)
+       (setq stream (semantic-tag-type-members ans)))
+
+      (setq lastans ans
+           ans nil
+           type (cdr type)))
+
+    (if (or type (not notdone))
+       ;; If there is stuff left over, then we failed.  Just return
+       ;; nothing.
+       nil
+
+      ;; We finished, so return everything.
+
+      (if (and find-file-match lastfile)
+         ;; This won't liven up the tag since we have a copy, but
+         ;; we ought to be able to get there and go to the right line.
+         (find-file-noselect lastfile)
+       ;; We don't want to find-file match, so instead lets
+       ;; push the filename onto the return tag.
+       (when lastans
+         (setq lastans (semantic-tag-copy lastans nil lastfile))
+         ;; We used to do the below, but we would erroneously be putting
+         ;; attributes on tags being shred with other lists.
+         ;;(semantic--tag-put-property lastans :filename lastfile)
+         )
+       )
+
+      (if (and lastans calculated-scope)
+
+         ;; Put our discovered scope into the tag if we have a tag
+         (semantic-scope-tag-clone-with-scope
+          lastans (reverse (cdr calculated-scope)))
+
+       ;; Else, just return
+       lastans
+       ))))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; BRUTISH Typecache
+;;
+;; Routines for a typecache that crosses all tables in a given database
+;; for a matching major-mode.
+(defmethod semanticdb-typecache-for-database ((db semanticdb-project-database)
+                                             &optional mode)
+  "Return the typecache for the project database DB.
+If there isn't one, create it.
+"
+  (let ((lmode (or mode major-mode))
+       (cache (semanticdb-get-typecache db))
+       (stream nil)
+       )
+    (dolist (table (semanticdb-get-database-tables db))
+      (when (eq lmode (oref table :major-mode))
+       (setq stream
+             (semanticdb-typecache-merge-streams
+              stream
+              (copy-sequence
+               (semanticdb-typecache-file-tags table))))
+       ))
+    (oset cache stream stream)
+    cache))
+
+(defun semanticdb-typecache-refresh-for-buffer (buffer)
+  "Refresh the typecache for BUFFER."
+  (save-excursion
+    (set-buffer buffer)
+    (let* ((tab semanticdb-current-table)
+          ;(idx (semanticdb-get-table-index tab))
+          (tc (semanticdb-get-typecache tab)))
+      (semanticdb-typecache-file-tags tab)
+      (semanticdb-typecache-include-tags tab)
+      tc)))
+
+\f
+;;; DEBUG
+;;
+(defun semanticdb-typecache-complete-flush ()
+  "Flush all typecaches referenced by the current buffer."
+  (interactive)
+  (let* ((path (semanticdb-find-translate-path nil nil)))
+    (dolist (P path)
+      (oset P pointmax nil)
+      (semantic-reset (semanticdb-get-typecache P)))))
+
+(defun semanticdb-typecache-dump ()
+  "Dump the typecache for the current buffer."
+  (interactive)
+  (require 'data-debug)
+  (let* ((start (current-time))
+        (tc (semanticdb-typecache-refresh-for-buffer (current-buffer)))
+        (end (current-time))
+        )
+    (data-debug-new-buffer "*TypeCache ADEBUG*")
+    (message "Calculating Cache took %.2f seconds."
+            (semantic-elapsed-time start end))
+
+    (data-debug-insert-thing tc "]" "")
+
+    ))
+
+(defun semanticdb-db-typecache-dump ()
+  "Dump the typecache for the current buffer's database."
+  (interactive)
+  (require 'data-debug)
+  (let* ((tab semanticdb-current-table)
+        (idx (semanticdb-get-table-index tab))
+        (junk (oset idx type-cache nil)) ;; flush!
+        (start (current-time))
+        (tc (semanticdb-typecache-for-database (oref tab parent-db)))
+        (end (current-time))
+        )
+    (data-debug-new-buffer "*TypeCache ADEBUG*")
+    (message "Calculating Cache took %.2f seconds."
+            (semantic-elapsed-time start end))
+
+    (data-debug-insert-thing tc "]" "")
+
+    ))
+
+
+(provide 'semantic/db-typecache)
+;;; semanticdb-typecache.el ends here
diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el
new file mode 100644 (file)
index 0000000..4c67c66
--- /dev/null
@@ -0,0 +1,228 @@
+;;; dep.el --- Methods for tracking dependencies (include files)
+
+;;; Copyright (C) 2006, 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:
+;;
+;; Include tags (dependencies for a given source file) usually have
+;; some short name.  The target file that it is dependent on is
+;; generally found on some sort of path controlled by the compiler or
+;; project.
+;;
+;; EDE or even ECB can control our project dependencies, and help us
+;; find file within the setting of a given project.  For system
+;; dependencies, we need to depend on user supplied lists, which can
+;; manifest themselves in the form of system datatabases (from
+;; semanticdb.)
+;;
+;; Provide ways to track these different files here.
+
+(require 'semantic/tag)
+
+;;; Code:
+
+(defvar semantic-dependency-include-path nil
+  "Defines the include path used when searching for files.
+This should be a list of directories to search which is specific
+to the file being included.
+
+If `semantic-dependency-tag-file' is overridden for a given
+language, this path is most likely ignored.
+
+The above function, reguardless of being overriden, caches the
+located dependency file location in the tag property
+`dependency-file'.  If you override this function, you do not
+need to implement your own cache.  Each time the buffer is fully
+reparsed, the cache will be reset.
+
+TODO: use ffap.el to locate such items?
+
+NOTE: Obsolete this, or use as special user")
+(make-variable-buffer-local `semantic-dependency-include-path)
+
+(defvar semantic-dependency-system-include-path nil
+  "Defines the system include path.
+This should be set with either `defvar-mode-local', or with
+`semantic-add-system-include'.
+
+For mode authors, use
+`defcustom-mode-local-semantic-dependency-system-include-path'
+to create a mode-specific variable to control this.
+
+When searching for a file associated with a name found in an tag of
+class include, this path will be inspected for includes of type
+`system'.  Some include tags are agnostic to this setting and will
+check both the project and system directories.")
+(make-variable-buffer-local `semantic-dependency-system-include-path)
+
+(defmacro defcustom-mode-local-semantic-dependency-system-include-path
+  (mode name value &optional docstring)
+  "Create a mode-local value of the system-dependency include path.
+MODE is the `major-mode' this name/value pairs is for.
+NAME is the name of the customizable value users will use.
+VALUE is the path (a list of strings) to add.
+DOCSTRING is a documentation string applied to the variable NAME
+users will customize.
+
+Creates a customizable variable users can customize that will
+keep semantic data structures up to date."
+  `(progn
+     ;; Create a variable users can customize.
+     (defcustom ,name ,value
+       ,docstring
+       :group (quote ,(intern (car (split-string (symbol-name mode) "-"))))
+       :group 'semantic
+       :type '(repeat (directory :tag "Directory"))
+       :set (lambda (sym val)
+             (set-default sym val)
+             (setq-mode-local ,mode
+                              semantic-dependency-system-include-path
+                              val)
+             (when (fboundp
+                    'semantic-decoration-unparsed-include-do-reset)
+               (mode-local-map-mode-buffers
+                'semantic-decoration-unparsed-include-do-reset
+                (quote ,mode))))
+       )
+     ;; Set the variable to the default value.
+     (defvar-mode-local ,mode semantic-dependency-system-include-path
+       ,name
+       "System path to search for include files.")
+     ;; Bind NAME onto our variable so tools can customize it
+     ;; without knowing about it.
+     (put 'semantic-dependency-system-include-path
+         (quote ,mode) (quote ,name))
+     ))
+
+;;; PATH MANAGEMENT
+;;
+;; Some fcns to manage paths for a give mode.
+(defun semantic-add-system-include (dir &optional mode)
+  "Add a system include DIR to path for MODE.
+Modifies a mode-local version of `semantic-dependency-system-include-path'.
+
+Changes made by this function are not persistent."
+  (interactive "DNew Include Directory: ")
+  (if (not mode) (setq mode major-mode))
+  (let ((dirtmp (file-name-as-directory dir))
+       (value
+        (mode-local-value mode 'semantic-dependency-system-include-path))
+       )
+    (add-to-list 'value dirtmp t)
+    (eval `(setq-mode-local ,mode
+                           semantic-dependency-system-include-path value))
+    ))
+
+(defun semantic-remove-system-include (dir &optional mode)
+  "Add a system include DIR to path for MODE.
+Modifies a mode-local version of`semantic-dependency-system-include-path'.
+
+Changes made by this function are not persistent."
+  (interactive (list
+                (completing-read
+                 "Include Directory to Remove: "
+                 semantic-dependency-system-include-path))
+              )
+  (if (not mode) (setq mode major-mode))
+  (let ((dirtmp (file-name-as-directory dir))
+       (value
+        (mode-local-value mode 'semantic-dependency-system-include-path))
+       )
+    (setq value (delete dirtmp value))
+    (eval `(setq-mode-local ,mode semantic-dependency-system-include-path
+                           value))
+    ))
+
+(defun semantic-reset-system-include (&optional mode)
+  "Reset the system include list to empty for MODE.
+Modifies a mode-local version of
+`semantic-dependency-system-include-path'."
+  (interactive)
+  (if (not mode) (setq mode major-mode))
+  (eval `(setq-mode-local ,mode semantic-dependency-system-include-path
+                         nil))
+  )
+
+(defun semantic-customize-system-include-path (&optional mode)
+  "Customize the include path for this `major-mode'.
+To create a customizable include path for a major MODE, use the
+macro `defcustom-mode-local-semantic-dependency-system-include-path'."
+  (interactive)
+  (let ((ips (get 'semantic-dependency-system-include-path
+                 (or mode major-mode))))
+    ;; Do we have one?
+    (when (not ips)
+      (error "There is no customizable includepath variable for %s"
+            (or mode major-mode)))
+    ;; Customize it.
+    (customize-variable ips)))
+
+;;; PATH SEARCH
+;;
+;; methods for finding files on a provided path.
+(if (fboundp 'locate-file)
+    (defsubst semantic--dependency-find-file-on-path (file path)
+      "Return an expanded file name for FILE on PATH."
+      (locate-file file path))
+
+  ;; Else, older version of Emacs.
+
+  (defsubst semantic--dependency-find-file-on-path (file path)
+    "Return an expanded file name for FILE on PATH."
+    (let ((p path)
+         (found nil))
+      (while (and p (not found))
+        (let ((f (expand-file-name file (car p))))
+         (if (file-exists-p f)
+             (setq found f)))
+        (setq p (cdr p)))
+      found))
+
+  )
+
+(defun semantic-dependency-find-file-on-path (file systemp &optional mode)
+  "Return an expanded file name for FILE on available paths.
+If SYSTEMP is true, then only search system paths.
+If optional argument MODE is non-nil, then derive paths from the
+provided mode, not from the current major mode."
+  (if (not mode) (setq mode major-mode))
+  (let ((sysp (mode-local-value
+              mode 'semantic-dependency-system-include-path))
+       (edesys (when (and (featurep 'ede) ede-minor-mode
+                          ede-object)
+                 (ede-system-include-path ede-object)))
+       (locp (mode-local-value
+              mode 'semantic-dependency-include-path))
+       (found nil))
+    (when (file-exists-p file)
+      (setq found file))
+    (when (and (not found) (not systemp))
+      (setq found (semantic--dependency-find-file-on-path file locp)))
+    (when (and (not found) edesys)
+      (setq found (semantic--dependency-find-file-on-path file edesys)))
+    (when (not found)
+      (setq found (semantic--dependency-find-file-on-path file sysp)))
+    (if found (expand-file-name found))))
+
+
+(provide 'semantic/dep)
+
+;;; semantic-dep.el ends here
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
new file mode 100644 (file)
index 0000000..eadf894
--- /dev/null
@@ -0,0 +1,439 @@
+;;; ia.el --- Interactive Analysis functions
+
+;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 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:
+;;
+;; Interactive access to `semantic-analyze'.
+;;
+;; These routines are fairly simple, and show how to use the Semantic
+;; analyzer to provide things such as completion lists, summaries,
+;; locations, or documentation.
+;;
+
+;;; TODO
+;;
+;; fast-jump.  For a virtual method, offer some of the possible
+;; implementations in various sub-classes.
+
+(require 'senator)
+(require 'semantic/analyze)
+(require 'pulse)
+(eval-when-compile
+  (require 'semantic/analyze)
+  (require 'semantic/analyze/refs))
+
+;;; Code:
+
+;;; COMPLETION
+;;
+;; This set of routines provides some simplisting completion
+;; functions.
+
+(defcustom semantic-ia-completion-format-tag-function
+  'semantic-prototype-nonterminal
+  "*Function used to convert a tag to a string during completion."
+  :group 'semantic
+  :type semantic-format-tag-custom-list)
+
+(defvar semantic-ia-cache nil
+  "Cache of the last completion request.
+Of the form ( POINT . COMPLETIONS ) where POINT is a location in the
+buffer where the completion was requested.  COMPLETONS is the list
+of semantic tag names that provide logical completions from that
+location.")
+(make-variable-buffer-local 'semantic-ia-cache)
+
+(defun semantic-ia-get-completions (context point)
+  "Fetch the completion of CONTEXT at POINT.
+Supports caching."
+  ;; Cache the current set of symbols so that we can get at
+  ;; them quickly the second time someone presses the
+  ;; complete button.
+  (let ((symbols
+        (if (and semantic-ia-cache
+                 (= point (car semantic-ia-cache)))
+            (cdr semantic-ia-cache)
+          (semantic-analyze-possible-completions context))))
+    ;; Set the cache
+    (setq semantic-ia-cache (cons point symbols))
+    symbols))
+
+(defun semantic-ia-complete-symbol (point)
+  "Complete the current symbol at POINT.
+Completion options are calculated with `semantic-analyze-possible-completions'."
+  (interactive "d")
+  ;; Calculating completions is a two step process.
+  ;;
+  ;; The first analyzer the current context, which finds tags
+  ;; for all the stuff that may be references by the code around
+  ;; POINT.
+  ;;
+  ;; The second step derives completions from that context.
+  (let* ((a (semantic-analyze-current-context point))
+        (syms (semantic-ia-get-completions a point))
+        (pre (car (reverse (oref a prefix))))
+        )
+    ;; If PRE was actually an already completed symbol, it doesn't
+    ;; come in as a string, but as a tag instead.
+    (if (semantic-tag-p pre)
+       ;; We will try completions on it anyway.
+       (setq pre (semantic-tag-name pre)))
+    ;; Complete this symbol.
+    (if (null syms)
+       (progn
+         ;(message "No smart completions found.  Trying senator-complete-symbol.")
+         (if (semantic-analyze-context-p a)
+             ;; This is a clever hack.  If we were unable to find any
+             ;; smart completions, lets divert to how senator derives
+             ;; completions.
+             ;;
+             ;; This is a way of making this fcn more useful since the
+             ;; smart completion engine sometimes failes.
+             (senator-complete-symbol)
+             ))
+      ;; Use try completion to seek a common substring.
+      (let ((tc (try-completion (or pre "")  syms)))
+       (if (and (stringp tc) (not (string= tc (or pre ""))))
+           (let ((tok (semantic-find-first-tag-by-name
+                       tc syms)))
+             ;; Delete what came before...
+             (when (and (car (oref a bounds)) (cdr (oref a bounds)))
+               (delete-region (car (oref a bounds))
+                              (cdr (oref a bounds)))
+               (goto-char (car (oref a bounds))))
+             ;; We have some new text.  Stick it in.
+             (if tok
+                 (semantic-ia-insert-tag tok)
+               (insert tc)))
+         ;; We don't have new text.  Show all completions.
+         (when (cdr (oref a bounds))
+           (goto-char (cdr (oref a bounds))))
+         (with-output-to-temp-buffer "*Completions*"
+           (display-completion-list
+            (mapcar semantic-ia-completion-format-tag-function syms))
+           ))))))
+
+(defcustom semantic-ia-completion-menu-format-tag-function
+  'semantic-uml-concise-prototype-nonterminal
+  "*Function used to convert a tag to a string during completion."
+  :group 'semantic
+  :type semantic-format-tag-custom-list)
+
+(defun semantic-ia-complete-symbol-menu (point)
+  "Complete the current symbol via a menu based at POINT.
+Completion options are calculated with `semantic-analyze-possible-completions'."
+  (interactive "d")
+  (let* ((a (semantic-analyze-current-context point))
+        (syms (semantic-ia-get-completions a point))
+        )
+    ;; Complete this symbol.
+    (if (not syms)
+       (progn
+         (message "No smart completions found.  Trying Senator.")
+         (when (semantic-analyze-context-p a)
+           ;; This is a quick way of getting a nice completion list
+           ;; in the menu if the regular context mechanism fails.
+           (senator-completion-menu-popup)))
+
+      (let* ((menu
+             (mapcar
+              (lambda (tag)
+                (cons
+                 (funcall semantic-ia-completion-menu-format-tag-function tag)
+                 (vector tag)))
+              syms))
+            (ans
+             (imenu--mouse-menu
+              ;; XEmacs needs that the menu has at least 2 items.  So,
+              ;; include a nil item that will be ignored by imenu.
+              (cons nil menu)
+              (senator-completion-menu-point-as-event)
+              "Completions")))
+       (when ans
+         (if (not (semantic-tag-p ans))
+             (setq ans (aref (cdr ans) 0)))
+         (delete-region (car (oref a bounds)) (cdr (oref a bounds)))
+         (semantic-ia-insert-tag ans))
+       ))))
+
+;;; COMPLETION HELPER
+;;
+;; This overload function handles inserting a tag
+;; into a buffer for these local completion routines.
+;;
+;; By creating the functions as overloadable, it can be
+;; customized.  For example, the default will put a paren "("
+;; character after function names.  For Lisp, it might check
+;; to put a "(" in front of a function name.
+
+(define-overloadable-function semantic-ia-insert-tag (tag)
+  "Insert TAG into the current buffer based on completion.")
+
+(defun semantic-ia-insert-tag-default (tag)
+  "Insert TAG into the current buffer based on completion."
+  (insert (semantic-tag-name tag))
+  (let ((tt (semantic-tag-class tag)))
+    (cond ((eq tt 'function)
+          (insert "("))
+         (t nil))))
+
+;;; Completions Tip
+;;
+;; This functions shows how to get the list of completions,
+;; to place in a tooltip.  It doesn't actually do any completion.
+
+(defun semantic-ia-complete-tip (point)
+  "Pop up a tooltip for completion at POINT."
+  (interactive "d")
+  (let* ((a (semantic-analyze-current-context point))
+        (syms (semantic-ia-get-completions a point))
+         (x (mod (- (current-column) (window-hscroll))
+                 (window-width)))
+         (y (save-excursion
+              (save-restriction
+                (widen)
+                (narrow-to-region (window-start) (point))
+                (goto-char (point-min))
+                (1+ (vertical-motion (buffer-size))))))
+        (str (mapconcat #'semantic-tag-name
+                        syms
+                        "\n"))
+        )
+    (cond ((fboundp 'x-show-tip)
+          (x-show-tip str
+                      (selected-frame)
+                      nil
+                      nil
+                      x y)
+          )
+         (t (message str))
+         )))
+
+;;; Summary
+;;
+;; Like idle-summary-mode, this shows how to get something to
+;; show a summary on.
+
+(defun semantic-ia-show-summary (point)
+  "Display a summary for the symbol under POINT."
+  (interactive "P")
+  (let* ((ctxt (semantic-analyze-current-context point))
+        (pf (when ctxt
+              ;; The CTXT is an EIEIO object.  The below
+              ;; method will attempt to pick the most interesting
+              ;; tag associated with the current context.
+              (semantic-analyze-interesting-tag ctxt)))
+       )
+    (when pf
+      (message "%s" (semantic-format-tag-summarize pf nil t)))))
+
+;;; FAST Jump
+;;
+;; Jump to a destination based on the local context.
+;;
+;; This shows how to use the analyzer context, and the
+;; analyer references objects to choose a good destination.
+
+(defun semantic-ia--fast-jump-helper (dest)
+  "Jump to DEST, a Semantic tag.
+This helper manages the mark, buffer switching, and pulsing."
+  ;; We have a tag, but in C++, we usually get a prototype instead
+  ;; because of header files.  Lets try to find the actual
+  ;; implementaion instead.
+  (when (semantic-tag-prototype-p dest)
+    (let* ((refs (semantic-analyze-tag-references dest))
+          (impl (semantic-analyze-refs-impl refs t))
+          )
+      (when impl (setq dest (car impl)))))
+
+  ;; Make sure we have a place to go...
+  (if (not (and (or (semantic-tag-with-position-p dest)
+                   (semantic-tag-get-attribute dest :line))
+               (semantic-tag-file-name dest)))
+      (error "Tag %s has no buffer information"
+            (semantic-format-tag-name dest)))
+
+  ;; Once we have the tag, we can jump to it.  Here
+  ;; are the key bits to the jump:
+
+  ;; 1) Push the mark, so you can pop global mark back, or
+  ;;    use semantic-mru-bookmark mode to do so.
+  (push-mark)
+  (when (fboundp 'push-tag-mark)
+    (push-tag-mark))
+  ;; 2) Visits the tag.
+  (semantic-go-to-tag dest)
+  ;; 3) go-to-tag doesn't switch the buffer in the current window,
+  ;;    so it is like find-file-noselect.  Bring it forward.
+  (switch-to-buffer (current-buffer))
+  ;; 4) Fancy pulsing.
+  (pulse-momentary-highlight-one-line (point))
+  )
+
+(defun semantic-ia-fast-jump (point)
+  "Jump to the tag referred to by the code at POINT.
+Uses `semantic-analyze-current-context' output to identify an accurate
+origin of the code at point."
+  (interactive "d")
+  (let* ((ctxt (semantic-analyze-current-context point))
+        (pf (and ctxt (reverse (oref ctxt prefix))))
+        ;; In the analyzer context, the PREFIX is the list of items
+        ;; that makes up the code context at point.  Thus the c++ code
+        ;; this.that().theothe
+        ;; would make a list:
+        ;; ( ("this" variable ..) ("that" function ...) "theothe")
+        ;; Where the first two elements are the semantic tags of the prefix.
+        ;;
+        ;; PF is the reverse of this list.  If the first item is a string,
+        ;; then it is an incomplete symbol, thus we pick the second.
+        ;; The second cannot be a string, as that would have been an error.
+        (first (car pf))
+        (second (nth 1 pf))
+        )
+    (cond
+     ((semantic-tag-p first)
+      ;; We have a match.  Just go there.
+      (semantic-ia--fast-jump-helper first))
+
+     ((semantic-tag-p second)
+      ;; Because FIRST failed, we should visit our second tag.
+      ;; HOWEVER, the tag we actually want that was only an unfound
+      ;; string may be related to some take in the datatype that belongs
+      ;; to SECOND.  Thus, instead of visiting second directly, we
+      ;; can offer to find the type of SECOND, and go there.
+      (let ((secondclass (car (reverse (oref ctxt prefixtypes)))))
+       (cond
+        ((and (semantic-tag-with-position-p secondclass)
+              (y-or-n-p (format "Could not find `%s'.  Jump to %s? "
+                                first (semantic-tag-name secondclass))))
+         (semantic-ia--fast-jump-helper secondclass)
+         )
+        ;; If we missed out on the class of the second item, then
+        ;; just visit SECOND.
+        ((and (semantic-tag-p second)
+              (y-or-n-p (format "Could not find `%s'.  Jump to %s? "
+                                first (semantic-tag-name second))))
+         (semantic-ia--fast-jump-helper second)
+         ))))
+
+     ((semantic-tag-of-class-p (semantic-current-tag) 'include)
+      ;; Just borrow this cool fcn.
+      (semantic-decoration-include-visit)
+      )
+
+     (t
+      (error "Could not find suitable jump point for %s"
+            first))
+     )))
+
+(defun semantic-ia-fast-mouse-jump (evt)
+  "Jump to the tag referred to by the point clicked on.
+See `semantic-ia-fast-jump' for details on how it works.
+ This command is meant to be bound to a mouse event."
+  (interactive "e")
+  (semantic-ia-fast-jump
+   (save-excursion
+     (posn-set-point (event-end evt))
+     (point))))
+
+;;; DOC/DESCRIBE
+;;
+;; These routines show how to get additional information about a tag
+;; for purposes of describing or showing documentation about them.
+(defun semantic-ia-show-doc (point)
+  "Display the code-level documentation for the symbol at POINT."
+  (interactive "d")
+  (let* ((ctxt (semantic-analyze-current-context point))
+        (pf (reverse (oref ctxt prefix)))
+        )
+    ;; If PF, the prefix is non-nil, then the last element is either
+    ;; a string (incomplete type), or a semantic TAG.  If it is a TAG
+    ;; then we should be able to find DOC for it.
+    (cond
+     ((stringp (car pf))
+      (message "Incomplete symbol name."))
+     ((semantic-tag-p (car pf))
+      ;; The `semantic-documentation-for-tag' fcn is language
+      ;; specific.  If it doesn't return what you expect, you may
+      ;; need to implement something for your language.
+      ;;
+      ;; The default tries to find a comment in front of the tag
+      ;; and then strings off comment prefixes.
+      (let ((doc (semantic-documentation-for-tag (car pf))))
+       (with-output-to-temp-buffer "*TAG DOCUMENTATION*"
+         (princ "Tag: ")
+         (princ (semantic-format-tag-prototype (car pf)))
+         (princ "\n")
+         (princ "\n")
+         (princ "Snarfed Documentation: ")
+         (princ "\n")
+         (princ "\n")
+         (if doc
+             (princ doc)
+           (princ "  Documentation unavailable."))
+         )))
+     (t
+      (message "Unknown tag.")))
+    ))
+
+(defun semantic-ia-describe-class (typename)
+  "Display all known parts for the datatype TYPENAME.
+If the type in question is a class, all methods and other accessible
+parts of the parent classes are displayed."
+  ;; @todo - use a fancy completing reader.
+  (interactive "sType Name: ")
+
+  ;; When looking for a tag of any name there are a couple ways to do
+  ;; it.  The simple `semanticdb-find-tag-by-...' are simple, and
+  ;; you need to pass it the exact name you want.
+  ;;
+  ;; The analyzer function `semantic-analyze-tag-name' will take
+  ;; more complex names, such as the cpp symbol foo::bar::baz,
+  ;; and break it up, and dive through the namespaces.
+  (let ((class (semantic-analyze-find-tag typename)))
+
+    (when (not (semantic-tag-p class))
+      (error "Cannot find class %s" class))
+    (with-output-to-temp-buffer "*TAG DOCUMENTATION*"
+      ;; There are many semantic-format-tag-* fcns.
+      ;; The summarize routine is a fairly generic one.
+      (princ (semantic-format-tag-summarize class))
+      (princ "\n")
+      (princ "  Type Members:\n")
+      ;; The type tag contains all the parts of the type.
+      ;; In complex languages with inheritance, not all the
+      ;; parts are in the tag.  This analyzer fcn will traverse
+      ;; the inheritance tree, and find all the pieces that
+      ;; are inherited.
+      (let ((parts (semantic-analyze-scoped-type-parts class)))
+       (while parts
+         (princ "    ")
+         (princ (semantic-format-tag-summarize (car parts)))
+         (princ "\n")
+         (setq parts (cdr parts)))
+       )
+      )))
+
+(provide 'semantic/ia)
+
+;;; semantic-ia.el ends here
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
new file mode 100644 (file)
index 0000000..4187d3c
--- /dev/null
@@ -0,0 +1,202 @@
+;;; tag-file.el --- Routines that find files based on tags.
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 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:
+;;
+;; A tag, by itself, can have representations in several files.
+;; These routines will find those files.
+
+(require 'semantic/tag)
+
+;;; Code:
+
+;;; Location a TAG came from.
+;;
+(define-overloadable-function semantic-go-to-tag (tag &optional parent)
+  "Go to the location of TAG.
+TAG may be a stripped element, in which case PARENT specifies a
+parent tag that has position information.
+PARENT can also be a `semanticdb-table' object."
+  (:override
+   (cond ((semantic-tag-in-buffer-p tag)
+         ;; We have a linked tag, go to that buffer.
+         (set-buffer (semantic-tag-buffer tag)))
+        ((semantic-tag-file-name tag)
+         ;; If it didn't have a buffer, but does have a file
+         ;; name, then we need to get to that file so the tag
+         ;; location is made accurate.
+         (set-buffer (find-file-noselect (semantic-tag-file-name tag))))
+        ((and parent (semantic-tag-p parent) (semantic-tag-in-buffer-p parent))
+         ;; The tag had nothing useful, but we have a parent with
+         ;; a buffer, then go there.
+         (set-buffer (semantic-tag-buffer parent)))
+        ((and parent (semantic-tag-p parent) (semantic-tag-file-name parent))
+         ;; Tag had nothing, and the parent only has a file-name, then
+         ;; find that file, and switch to that buffer.
+         (set-buffer (find-file-noselect (semantic-tag-file-name parent))))
+        ((and parent (semanticdb-table-child-p parent))
+         (set-buffer (semanticdb-get-buffer parent)))
+        (t
+         ;; Well, just assume things are in the current buffer.
+         nil
+         ))
+   ;; We should be in the correct buffer now, try and figure out
+   ;; where the tag is.
+   (cond ((semantic-tag-with-position-p tag)
+         ;; If it's a number, go there
+         (goto-char (semantic-tag-start tag)))
+        ((semantic-tag-with-position-p parent)
+         ;; Otherwise, it's a trimmed vector, such as a parameter,
+         ;; or a structure part.  If there is a parent, we can use it
+         ;; as a bounds for searching.
+         (goto-char (semantic-tag-start parent))
+         ;; Here we make an assumption that the text returned by
+         ;; the parser and concocted by us actually exists
+         ;; in the buffer.
+         (re-search-forward (semantic-tag-name tag)
+                            (semantic-tag-end parent)
+                            t))
+        ((semantic-tag-get-attribute tag :line)
+         ;; The tag has a line number in it.  Go there.
+         (goto-line (semantic-tag-get-attribute tag :line)))
+        ((and (semantic-tag-p parent) (semantic-tag-get-attribute parent :line))
+         ;; The tag has a line number in it.  Go there.
+         (goto-line (semantic-tag-get-attribute parent :line))
+         (re-search-forward (semantic-tag-name tag) nil t)
+         )
+        (t
+         ;; Take a guess that the tag has a unique name, and just
+         ;; search for it from the beginning of the buffer.
+         (goto-char (point-min))
+         (re-search-forward (semantic-tag-name tag) nil t)))
+   )
+  )
+
+(make-obsolete-overload 'semantic-find-nonterminal
+                        'semantic-go-to-tag)
+
+;;; Dependencies
+;;
+;; A tag which is of type 'include specifies a dependency.
+;; Dependencies usually represent a file of some sort.
+;; Find the file described by a dependency.
+
+(define-overloadable-function semantic-dependency-tag-file (&optional tag)
+  "Find the filename represented from TAG.
+Depends on `semantic-dependency-include-path' for searching.  Always searches
+`.' first, then searches additional paths."
+  (or tag (setq tag (car (semantic-find-tag-by-overlay nil))))
+  (unless (semantic-tag-of-class-p tag 'include)
+    (signal 'wrong-type-argument (list tag 'include)))
+  (save-excursion
+    (let ((result nil)
+         (default-directory default-directory)
+         (edefind nil)
+         (tag-fname nil))
+      (cond ((semantic-tag-in-buffer-p tag)
+            ;; If the tag has an overlay and buffer associated with it,
+            ;; switch to that buffer so that we get the right override metohds.
+            (set-buffer (semantic-tag-buffer tag)))
+           ((semantic-tag-file-name tag)
+            ;; If it didn't have a buffer, but does have a file
+            ;; name, then we need to get to that file so the tag
+            ;; location is made accurate.
+            ;;(set-buffer (find-file-noselect (semantic-tag-file-name tag)))
+            ;;
+            ;; 2/3/08
+            ;; The above causes unnecessary buffer loads all over the place. Ick!
+            ;; All we really need is for 'default-directory' to be set correctly.
+            (setq default-directory (file-name-directory (semantic-tag-file-name tag)))
+            ))
+      ;; Setup the filename represented by this include
+      (setq tag-fname (semantic-tag-include-filename tag))
+
+      ;; First, see if this file exists in the current EDE project
+      (if (and (fboundp 'ede-expand-filename) ede-minor-mode
+              (setq edefind
+                    (condition-case nil
+                        (let ((proj  (ede-toplevel)))
+                          (when proj
+                            (ede-expand-filename proj tag-fname)))
+                      (error nil))))
+         (setq result edefind))
+      (if (not result)
+         (setq result
+               ;; I don't have a plan for refreshing tags with a dependency
+               ;; stuck on them somehow.  I'm thinking that putting a cache
+               ;; onto the dependancy finding with a hash table might be best.
+               ;;(if (semantic--tag-get-property tag 'dependency-file)
+               ;;  (semantic--tag-get-property tag 'dependency-file)
+               (:override
+                (save-excursion
+                  (semantic-dependency-find-file-on-path
+                   tag-fname (semantic-tag-include-system-p tag))))
+               ;; )
+               ))
+      (if (stringp result)
+         (progn
+           (semantic--tag-put-property tag 'dependency-file result)
+           result)
+       ;; @todo: Do something to make this get flushed w/
+       ;;        when the path is changed.
+       ;; @undo: Just eliminate
+       ;; (semantic--tag-put-property tag 'dependency-file 'none)
+       nil)
+      )))
+
+(make-obsolete-overload 'semantic-find-dependency
+                        'semantic-dependency-tag-file)
+
+;;; PROTOTYPE FILE
+;;
+;; In C, a function in the .c file often has a representation in a
+;; corresponding .h file.  This routine attempts to find the
+;; prototype file a given source file would be associated with.
+;; This can be used by prototype manager programs.
+(define-overloadable-function semantic-prototype-file (buffer)
+  "Return a file in which prototypes belonging to BUFFER should be placed.
+Default behavior (if not overridden) looks for a token specifying the
+prototype file, or the existence of an EDE variable indicating which
+file prototypes belong in."
+  (:override
+   ;; Perform some default behaviors
+   (if (and (fboundp 'ede-header-file) ede-minor-mode)
+       (save-excursion
+         (set-buffer buffer)
+         (ede-header-file))
+     ;; No EDE options for a quick answer.  Search.
+     (save-excursion
+       (set-buffer buffer)
+       (if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t)
+           (match-string 1))))))
+
+(semantic-alias-obsolete 'semantic-find-nonterminal
+                         'semantic-go-to-tag)
+
+(semantic-alias-obsolete 'semantic-find-dependency
+                         'semantic-dependency-tag-file)
+
+
+(provide 'semantic/tag-file)
+
+;;; semantic-tag-file.el ends here
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
new file mode 100644 (file)
index 0000000..634c41c
--- /dev/null
@@ -0,0 +1,276 @@
+;;; tag-ls.el --- Language Specific override functions for tags
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2006, 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:
+;;
+;; There are some features of tags that are too langauge dependent to
+;; put in the core `semantic-tag' functionality.  For instance, the
+;; protection of a tag (as specified by UML) could be almost anything.
+;; In Java, it is a type specifier.  In C, there is a label.  This
+;; informatin can be derived, and thus should not be stored in the tag
+;; itself.  These are the functions that languages can use to derive
+;; the information.
+
+(require 'semantic/tag)
+
+;;; Code:
+
+;;; UML features:
+;;
+;; UML can represent several types of features of a tag
+;; such as the `protection' of a symbol, or if it is abstract,
+;; leaf, etc.  Learn about UML to catch onto the lingo.
+
+(define-overloadable-function semantic-tag-calculate-parent (tag)
+  "Attempt to calculate the parent of TAG.
+The default behavior (if not overriden with `tag-calculate-parent')
+is to search a buffer found with TAG, and if externally defined,
+search locally, then semanticdb for that tag (when enabled.)")
+
+(defun semantic-tag-calculate-parent-default (tag)
+  "Attempt to calculate the parent of TAG."
+  (when (semantic-tag-in-buffer-p tag)
+    (save-excursion
+      (set-buffer (semantic-tag-buffer tag))
+      (save-excursion
+       (goto-char (semantic-tag-start tag))
+       (semantic-current-tag-parent))
+      )))
+
+(define-overloadable-function semantic-tag-protection (tag &optional parent)
+  "Return protection information about TAG with optional PARENT.
+This function returns on of the following symbols:
+   nil        - No special protection.  Language dependent.
+   'public    - Anyone can access this TAG.
+   'private   - Only methods in the local scope can access TAG.
+   'protected - Like private for outside scopes, like public for child
+                classes.
+Some languages may choose to provide additional return symbols specific
+to themselves.  Use of this function should allow for this.
+
+The default behavior (if not overridden with `tag-protection'
+is to return a symbol based on type modifiers."
+  (and (not parent)
+       (semantic-tag-overlay tag)
+       (semantic-tag-in-buffer-p tag)
+       (setq parent (semantic-tag-calculate-parent tag)))
+  (:override))
+
+(make-obsolete-overload 'semantic-nonterminal-protection
+                        'semantic-tag-protection)
+
+(defun semantic-tag-protection-default (tag &optional parent)
+  "Return the protection of TAG as a child of PARENT default action.
+See `semantic-tag-protection'."
+  (let ((mods (semantic-tag-modifiers tag))
+       (prot nil))
+    (while (and (not prot) mods)
+      (if (stringp (car mods))
+         (let ((s (car mods)))
+           (setq prot
+                 ;; A few silly defaults to get things started.
+                 (cond ((or (string= s "public")
+                            (string= s "extern")
+                            (string= s "export"))
+                        'public)
+                       ((string= s "private")
+                        'private)
+                       ((string= s "protected")
+                        'protected)))))
+      (setq mods (cdr mods)))
+    prot))
+
+(defun semantic-tag-protected-p (tag protection &optional parent)
+  "Non-nil if TAG is is protected.
+PROTECTION is a symbol which can be returned by the method
+`semantic-tag-protection'.
+PARENT is the parent data type which contains TAG.
+
+For these PROTECTIONs, true is returned if TAG is:
+@table @asis
+@item nil
+  Always true
+@item  private
+  True if nil.
+@item protected
+  True if private or nil.
+@item public
+  True if private, protected, or nil.
+@end table"
+  (if (null protection)
+      t
+    (let ((tagpro (semantic-tag-protection tag parent)))
+      (or (and (eq protection 'private)
+              (null tagpro))
+         (and (eq protection 'protected)
+              (or (null tagpro)
+                  (eq tagpro 'private)))
+         (and (eq protection 'public)
+              (not (eq tagpro 'public)))))
+    ))
+
+(define-overloadable-function semantic-tag-abstract-p (tag &optional parent)
+  "Return non nil if TAG is abstract.
+Optional PARENT is the parent tag of TAG.
+In UML, abstract methods and classes have special meaning and behavior
+in how methods are overridden.  In UML, abstract methods are italicized.
+
+The default behavior (if not overridden with `tag-abstract-p'
+is to return true if `abstract' is in the type modifiers.")
+
+(make-obsolete-overload 'semantic-nonterminal-abstract
+                        'semantic-tag-abstract-p)
+
+(defun semantic-tag-abstract-p-default (tag &optional parent)
+  "Return non-nil if TAG is abstract as a child of PARENT default action.
+See `semantic-tag-abstract-p'."
+  (let ((mods (semantic-tag-modifiers tag))
+       (abs nil))
+    (while (and (not abs) mods)
+      (if (stringp (car mods))
+         (setq abs (or (string= (car mods) "abstract")
+                       (string= (car mods) "virtual"))))
+      (setq mods (cdr mods)))
+    abs))
+
+(define-overloadable-function semantic-tag-leaf-p (tag &optional parent)
+  "Return non nil if TAG is leaf.
+Optional PARENT is the parent tag of TAG.
+In UML, leaf methods and classes have special meaning and behavior.
+
+The default behavior (if not overridden with `tag-leaf-p'
+is to return true if `leaf' is in the type modifiers.")
+
+(make-obsolete-overload 'semantic-nonterminal-leaf
+                        'semantic-tag-leaf-p)
+
+(defun semantic-tag-leaf-p-default (tag &optional parent)
+  "Return non-nil if TAG is leaf as a child of PARENT default action.
+See `semantic-tag-leaf-p'."
+  (let ((mods (semantic-tag-modifiers tag))
+       (leaf nil))
+    (while (and (not leaf) mods)
+      (if (stringp (car mods))
+         ;; Use java FINAL as example default.  There is none
+         ;; for C/C++
+         (setq leaf (string= (car mods) "final")))
+      (setq mods (cdr mods)))
+    leaf))
+
+(define-overloadable-function semantic-tag-static-p (tag &optional parent)
+  "Return non nil if TAG is static.
+Optional PARENT is the parent tag of TAG.
+In UML, static methods and attributes mean that they are allocated
+in the parent class, and are not instance specific.
+UML notation specifies that STATIC entries are underlined.")
+
+(defun semantic-tag-static-p-default (tag &optional parent)
+  "Return non-nil if TAG is static as a child of PARENT default action.
+See `semantic-tag-static-p'."
+  (let ((mods (semantic-tag-modifiers tag))
+       (static nil))
+    (while (and (not static) mods)
+      (if (stringp (car mods))
+         (setq static (string= (car mods) "static")))
+      (setq mods (cdr mods)))
+    static))
+
+(define-overloadable-function semantic-tag-prototype-p (tag)
+  "Return non nil if TAG is a prototype.
+For some laguages, such as C, a prototype is a declaration of
+something without an implementation."
+  )
+
+(defun semantic-tag-prototype-p-default (tag)
+  "Non-nil if TAG is a prototype."
+  (let ((p (semantic-tag-get-attribute tag :prototype-flag)))
+    (cond
+     ;; Trust the parser author.
+     (p p)
+     ;; Empty types might be a prototype.
+     ;; @todo - make this better.
+     ((eq (semantic-tag-class tag) 'type)
+      (not (semantic-tag-type-members tag)))
+     ;; No other heuristics.
+     (t nil))
+    ))
+
+;;; FULL NAMES
+;;
+;; For programmer convenience, a full name is not specified in source
+;; code.  Instead some abbreviation is made, and the local environment
+;; will contain the info needed to determine the full name.
+
+(define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer)
+  "Return the fully qualified name of TAG in the package hierarchy.
+STREAM-OR-BUFFER can be anything convertable by `semantic-something-to-stream',
+but must be a toplevel semantic tag stream that contains TAG.
+A Package Hierarchy is defined in UML by the way classes and methods
+are organized on disk.  Some language use this concept such that a
+class can be accessed via it's fully qualified name, (such as Java.)
+Other languages qualify names within a Namespace (such as C++) which
+result in a different package like structure.  Languages which do not
+override this function with `tag-full-name' will use
+`semantic-tag-name'.  Override functions only need to handle
+STREAM-OR-BUFFER with a tag stream value, or nil."
+  (let ((stream (semantic-something-to-tag-table
+                 (or stream-or-buffer tag))))
+    (:override-with-args (tag stream))))
+
+(make-obsolete-overload 'semantic-nonterminal-full-name
+                        'semantic-tag-full-name)
+
+(defun semantic-tag-full-name-default (tag stream)
+  "Default method for `semantic-tag-full-name'.
+Return the name of TAG found in the toplevel STREAM."
+  (semantic-tag-name tag))
+
+;;; Compatibility aliases.
+;;
+(semantic-alias-obsolete 'semantic-nonterminal-protection
+                        'semantic-tag-protection)
+(semantic-alias-obsolete 'semantic-nonterminal-protection-default
+                        'semantic-tag-protection-default)
+(semantic-alias-obsolete 'semantic-nonterminal-abstract
+                        'semantic-tag-abstract-p)
+(semantic-alias-obsolete 'semantic-nonterminal-abstract-default
+                        'semantic-tag-abstract-p-default)
+(semantic-alias-obsolete 'semantic-nonterminal-leaf
+                        'semantic-tag-leaf-p)
+(semantic-alias-obsolete 'semantic-nonterminal-leaf-default
+                        'semantic-tag-leaf-p-default)
+(semantic-alias-obsolete 'semantic-nonterminal-static-default
+                        'semantic-tag-static-p-default)
+(semantic-alias-obsolete 'semantic-nonterminal-full-name
+                        'semantic-tag-full-name)
+(semantic-alias-obsolete 'semantic-nonterminal-full-name-default
+                        'semantic-tag-full-name-default)
+
+;; TEMPORARY within betas of CEDET 1.0
+(semantic-alias-obsolete 'semantic-tag-static 'semantic-tag-static-p)
+(semantic-alias-obsolete 'semantic-tag-leaf 'semantic-tag-leaf-p)
+(semantic-alias-obsolete 'semantic-tag-abstract 'semantic-tag-abstract-p)
+
+
+(provide 'semantic/tag-ls)
+
+;;; semantic-tag-ls.el ends here