cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/semanticdb-find.el

   1 ;;; semanticdb-find.el --- Searching through semantic databases.
   2
   3 ;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: tags
   7 ;; X-RCS: $Id: semanticdb-find.el,v 1.1 2007-11-26 15:10:47 michaels Exp $
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; Semanticdb is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This software is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25 ;;
  26 ;;; Commentary:
  27 ;;
  28 ;; Databases of various forms can all be searched.
  29 ;; There are a few types of searches that can be done:
  30 ;;
  31 ;;   Basic Name Search:
  32 ;;    These searches scan a database table  collection for tags based
  33 ;;    on name.
  34 ;;
  35 ;;   Basic Attribute Search:
  36 ;;    These searches allow searching on specific attributes of tags,
  37 ;;    such as name, type, or other attribute.
  38 ;;
  39 ;;   Advanced Search:
  40 ;;    These are searches that were needed to accomplish some
  41 ;;    specialized tasks as discovered in utilities.  Advanced searches
  42 ;;    include matching methods defined outside some parent class.
  43 ;;
  44 ;;    The reason for advanced searches are so that external
  45 ;;    repositories such as the Emacs obarray, or java .class files can
  46 ;;    quickly answer these needed questions without dumping the entire
  47 ;;    symbol list into Emacs for additional refinement searches via
  48 ;;    regular semanticdb search.
  49 ;;
  50 ;; How databases are decided upon is another important aspect of a
  51 ;; database search.  When it comes to searching for a name, there are
  52 ;; these types of searches:
  53 ;;
  54 ;;   Basic Search:
  55 ;;    Basic search means that tags looking for a given name start
  56 ;;    with a specific search path.  Names are sought on that path
  57 ;;    until it is empty or items on the path can no longer be found.
  58 ;;    Use `semanticdb-dump-all-table-summary' to test this list.
  59 ;;    Use `semanticdb-find-throttle-custom-list' to refine this list.
  60 ;;
  61 ;;   Deep Search:
  62 ;;    A deep search will search more than just the global namespace.
  63 ;;    It will recurse into tags that contain more tags, and search
  64 ;;    those too.
  65 ;;
  66 ;;   Brute Search:
  67 ;;    Brute search means that all tables in all databases in a given
  68 ;;    project are searched.  Brute searches are the search style as
  69 ;;    written for semantic version 1.x.
  70 ;;
  71 ;; How does the search path work?
  72 ;;
  73 ;;  A basic search starts with three parameters:
  74 ;;
  75 ;;     (FINDME &optional PATH FIND-FILE-MATCH)
  76 ;;
  77 ;;  FINDME is key to be searched for dependent on the type of search.
  78 ;;  PATH is an indicator of which tables are to be searched.
  79 ;;  FIND-FILE-MATCH indicates that any time a match is found, the
  80 ;;  file associated with the tag should be read into a file.
  81 ;;
  82 ;;  The PATH argument is then the most interesting argument.  It can
  83 ;;  have these values:
  84 ;;
  85 ;;    nil - Take the current buffer, and use it's include list
  86 ;;    buffer - Use that buffer's include list.
  87 ;;    filename - Use that file's include list.  If the file is not
  88 ;;        in a buffer, see of there is a semanticdb table for it.  If
  89 ;;        not, read that file into a buffer.
  90 ;;    tag - Get that tag's buffer of file file.  See above.
  91 ;;    table - Search that table, and it's include list.
  92 ;;
  93 ;; Search Results:
  94 ;;
  95 ;;   Semanticdb returns the results in a specific format.  There are a
  96 ;;   series of routines for using those results, and results can be
  97 ;;   passed in as a search-path for refinement searches with
  98 ;;   semanticdb.  Apropos for semanticdb.*find-result for more.
  99 ;;
 100 ;; Application:
 101 ;;
 102 ;; Here are applications where different searches are needed which
 103 ;; exist as of semantic 1.4.x
 104 ;;
 105 ;; eldoc - popup help
 106 ;;   => Requires basic search using default path.  (Header files ok)
 107 ;; tag jump - jump to a named tag
 108 ;;   => Requires a brute search useing whole project.  (Source files only)
 109 ;; completion - Completing symbol names in a smart way
 110 ;;   => Basic search (headers ok)
 111 ;; type analysis - finding type definitions for variables & fcns
 112 ;;   => Basic search (headers ok)
 113 ;; Class browser - organize types into some structure
 114 ;;   => Brute search, or custom navigation.
 115
 116 ;; TODO:
 117 ;;  During a search, load any unloaded DB files based on paths in the
 118 ;;  current project.
 119
 120 (require 'semanticdb)
 121 (eval-when-compile
 122   (require 'eieio)
 123   )
 124
 125 ;;; Code:
 126 ;;;###autoload
 127 (defvar semanticdb-find-throttle-custom-list
 128   '(repeat (radio (const 'local)
 129                   (const 'project)
 130                   (const 'unloaded)
 131                   (const 'system)
 132                   (const 'recursive)
 133                   (const 'omniscience)))
 134   "Customization values for semanticdb find throttle.
 135 See `semanticdb-find-throttle' for details.")
 136
 137 ;;;###autoload
 138 (defcustom semanticdb-find-default-throttle '(project unloaded system recursive)
 139   "The default throttle for `semanticdb-find' routines.
 140 The throttle controls how detailed the list of database
 141 tables is for a symbol lookup.  The value is a list with
 142 the following keys:
 143   `file'       - The file the search is being performed from.
 144                  This option is here for completeness only, and
 145                  is assumed to always be on.
 146   `local'      - Tables from the same local directory are included.
 147                  This includes files directly referenced by a file name
 148                  which might be in a different directory.
 149   `project'    - Tables from the same local project are included
 150                  If `project' is specified, then `local' is assumed.
 151   `unloaded'   - If a table is not in memory, load it.  If it is not cached
 152                  on disk either, get the source, parse it, and create
 153                  the table.
 154   `system'     - Tables from system databases.  These are specifically
 155                  tables from system header files, or language equivalent.
 156   `recursive'  - For include based searches, includes tables referenced
 157                  by included files.
 158   `omniscience' - Included system databases which are omniscience, or
 159                  somehow know everything.  Omniscience databases are found
 160                  in `semanticdb-project-system-databases'.
 161                  The Emacs Lisp system DB is an omniscience database."
 162   :group 'semanticdb
 163   :type semanticdb-find-throttle-custom-list)
 164
 165 (defun semanticdb-find-throttle-active-p (access-type)
 166   "Non-nil if ACCESS-TYPE is an active throttle type."
 167   (or (memq access-type semanticdb-find-default-throttle)
 168       (eq access-type 'file)
 169       (and (eq access-type 'local)
 170            (memq 'project semanticdb-find-default-throttle))
 171       ))
 172
 173 ;;; Path Translations
 174 ;;
 175 ;;; OVERLOAD Functions
 176 ;;
 177 ;; These routines needed to be overloaded by specific language modes.
 178 ;; They are needed for translating an INCLUDE tag into a semanticdb
 179 ;; TABLE object.
 180 (define-overload semanticdb-find-translate-path (path brutish)
 181   "Translate PATH into a list of semantic tables.
 182 Path translation involves identifying the PATH input argument
 183 in one of the following ways:
 184   nil - Take the current buffer, and use it's include list
 185   buffer - Use that buffer's include list.
 186   filename - Use that file's include list.  If the file is not
 187       in a buffer, see of there is a semanticdb table for it.  If
 188       not, read that file into a buffer.
 189   tag - Get that tag's buffer of file file.  See above.
 190   table - Search that table, and it's include list.
 191   find result - Search the results of a previous find.
 192
 193 In addition, once the base path is found, there is the possibility of
 194 each added table adding yet more tables to the path, so this routine
 195 can return a lengthy list.
 196
 197 If argument BRUTISH is non-nil, then instead of using the include
 198 list, use all tables found in the parent project of the table
 199 identified by translating PATH.  Such searches use brute force to
 200 scan every available table.
 201
 202 The return value is a list of objects of type `semanticdb-table' or
 203 it's children.  In the case of passing in a find result, the result
 204 is returned unchanged.
 205
 206 This routine uses `semanticdb-find-table-for-include' to translate
 207 specific include tags into a semanticdb table."
 208   )
 209
 210 ;;;###autoload
 211 (defun semanticdb-find-translate-path-default (path brutish)
 212   "Translate PATH into a list of semantic tables.
 213 If BRUTISH is non nil, return all tables associated with PATH.
 214 Default action as described in `semanticdb-find-translate-path'."
 215   (if (semanticdb-find-results-p path)
 216       ;; Perform the search over these results.
 217       nil
 218     (if brutish
 219         (semanticdb-find-translate-path-brutish-default path)
 220       (semanticdb-find-translate-path-includes-default path))))
 221
 222 (defun semanticdb-find-translate-path-brutish-default (path)
 223   "Translate PATH into a list of semantic tables.
 224 Default action as described in `semanticdb-find-translate-path'."
 225   (let ((basedb
 226          (cond ((null path) semanticdb-current-database)
 227                ((semanticdb-table-p path) (oref path parent-db))
 228                (t (let ((tt (semantic-something-to-tag-table path)))
 229                     (save-excursion
 230                       (set-buffer (semantic-tag-buffer (car tt)))
 231                       semanticdb-current-database))))))
 232     (apply
 233      #'append
 234      (mapcar
 235       (lambda (db)
 236         (let ((tabs (semanticdb-get-database-tables db))
 237               (ret nil))
 238           ;; Only return tables of the same language (major-mode)
 239           ;; as the current search environment.
 240           (while tabs
 241             (if (semanticdb-equivalent-mode-for-search (car tabs)
 242                                                        (current-buffer))
 243                 (setq ret (cons (car tabs) ret)))
 244             (setq tabs (cdr tabs)))
 245           ret))
 246       ;; FIXME:
 247       ;; This should scan the current project directory list for all
 248       ;; semanticdb files, perhaps handling proxies for them.
 249       (semanticdb-current-database-list
 250        (if basedb (oref basedb reference-directory)
 251          default-directory))))
 252     ))
 253
 254 (defun semanticdb-find-translate-path-includes-default (path)
 255   "Translate PATH into a list of semantic tables.
 256 Default action as described in `semanticdb-find-translate-path'."
 257   (let ((includetags
 258          (cond ((null path)
 259                 (semantic-find-tags-included (current-buffer)))
 260                ((semanticdb-table-p path)
 261                 (semantic-find-tags-included (semanticdb-get-tags path)))
 262                (t (semantic-find-tags-included path))))
 263         (matchedtables (list semanticdb-current-table))
 264         nexttable)
 265     ;; Loop over all include tags adding to matchedtables
 266     (while includetags
 267       (semantic-throw-on-input 'semantic-find-translate-path-includes-default)
 268       (setq nexttable (semanticdb-find-table-for-include (car includetags)))
 269       ;; (message "Scanning %s" (semantic-tag-name (car includetags)))
 270       (when (and nexttable
 271                  (not (memq nexttable matchedtables))
 272                  (semanticdb-equivalent-mode-for-search nexttable
 273                                                         (current-buffer))
 274                  )
 275         ;; Add to list of tables
 276         (push nexttable matchedtables)
 277         ;; Queue new includes to list
 278         (if (semanticdb-find-throttle-active-p 'recursive)
 279             (let ((newtags
 280                    (cond
 281                     ((semanticdb-table-p nexttable)
 282                      ;; Use the method directly, or we will recurse
 283                      ;; into ourselves here.
 284                      (semanticdb-find-tags-by-class-method
 285                       nexttable 'include))
 286                     (t
 287                      (semantic-find-tags-included
 288                       (semanticdb-get-tags nexttable))))))
 289               (setq includetags (append includetags newtags)))))
 290       (setq includetags (cdr includetags)))
 291     ;; Find all the omniscient databases for this major mode, and
 292     ;; add them if needed
 293     (when (and (semanticdb-find-throttle-active-p 'omniscience)
 294                semanticdb-search-system-databases)
 295       ;; We can append any mode-specific omniscience databases into
 296       ;; our search list here.
 297       (let ((systemdb semanticdb-project-system-databases)
 298             (ans nil))
 299         (while systemdb
 300           (setq ans (semanticdb-file-table
 301                      (car systemdb)
 302                      ;; I would expect most omniscient to return the same
 303                      ;; thing reguardless of filename, but we may have
 304                      ;; one that can return a table of all things the
 305                      ;; current file needs.
 306                      (buffer-file-name (current-buffer))))
 307           (when (not (memq ans matchedtables))
 308             (setq matchedtables (cons ans matchedtables)))
 309           (setq systemdb (cdr systemdb))))
 310       )
 311     (nreverse matchedtables)))
 312
 313 (define-overload semanticdb-find-load-unloaded (filename)
 314   "Create a database table for FILENAME if it hasn't been parsed yet.
 315 Assumes that FILENAME exists as a source file.
 316 Assumes that a preexisting table does not exist, even if it
 317 isn't in memory yet."
 318   (when (semanticdb-find-throttle-active-p 'unloaded)
 319     (:override)))
 320
 321 (defun semanticdb-find-load-unloaded-default (filename)
 322   "Load an unloaded file in FILENAME using the default semanticdb loader."
 323   (semanticdb-file-table-object filename))
 324
 325 ;;;###autoload
 326 (define-overload semanticdb-find-table-for-include (includetag &optional table)
 327   "For a single INCLUDETAG found in TABLE, find a `semanticdb-table' object
 328 INCLUDETAG is a semantic TAG of class 'include.
 329 TABLE as defined by `semantic-something-to-tag-table' to identify
 330 where the tag came from.  TABLE is optional if INCLUDETAG has an
 331 overlay of :filename attribute."
 332   )
 333
 334 (defun semanticdb-find-table-for-include-default (includetag &optional table)
 335   "Default implementation of `semanticdb-find-table-for-include'.
 336 Uses `semanticdb-current-database-list' as the search path.
 337 INCLUDETAG and TABLE are documented in `semanticdb-find-table-for-include'.
 338 Included databases are filtered based on `semanticdb-find-default-throttle'."
 339   (if (not (eq (semantic-tag-class includetag) 'include))
 340       (signal 'wrong-type-argument (list includetag 'include)))
 341
 342   ;; Note, some languages (like Emacs or Java) use include tag names
 343   ;; that don't represent files!  We want to have file names.
 344   (let ((name (semantic-tag-include-filename includetag))
 345         (roots (semanticdb-current-database-list))
 346         (tmp nil)
 347         (ans nil))
 348     (cond
 349      ;; Relative path name
 350      ;;
 351      ((and (file-exists-p (expand-file-name name))
 352            (semanticdb-find-throttle-active-p 'local))
 353
 354       (setq ans (semanticdb-file-table-object
 355                  name
 356                  (not (semanticdb-find-throttle-active-p 'unloaded))))
 357       )
 358      ;; On the path somewhere
 359      ;; NOTES: Separate system includes from local includes.
 360      ;;        Use only system databases for system includes.
 361      ((and (setq tmp (semantic-dependency-tag-file includetag))
 362            (semanticdb-find-throttle-active-p 'system))
 363       (let ((db (semanticdb-directory-loaded-p (file-name-directory tmp))))
 364         (if db
 365             ;; We have a database, but perhaps not a table?
 366             (setq ans (semanticdb-file-table db tmp))
 367           ;; ELSE: we could load a cache if it isn't already loaded
 368           ;; based on another throttle value.
 369           )
 370         (if ans
 371             ;; We are A-ok!
 372             nil
 373           ;; The file is not in memory!
 374           ;; Should we force it to be loaded in?
 375           (setq ans (semanticdb-find-load-unloaded tmp))
 376           )))
 377
 378      ;; Somewhere in our project hierarchy
 379      ;; Remember: Roots includes system databases which can create
 380      ;; specialized tables we can search.
 381      ((semanticdb-find-throttle-active-p 'project)
 382
 383       ;; @TODO - This needs the same treatment as 'local'
 384       ;;         above with the various phases.  We should also
 385       ;;         not use the existing DBs, but instead recurse
 386       ;;         through our current project.
 387
 388       (while (and (not ans) roots)
 389         (let* ((ref (if (slot-boundp (car roots) 'reference-directory)
 390                         (oref (car roots) reference-directory)))
 391                (fname (cond ((null ref) nil)
 392                             ((file-exists-p (expand-file-name name ref))
 393                              (expand-file-name name ref))
 394                             ((file-exists-p (expand-file-name (file-name-nondirectory name) ref))
 395                              (expand-file-name (file-name-nondirectory name) ref)))))
 396           (when (and ref fname)
 397             ;; There is an actual file.  Grab it.
 398             (setq ans (semanticdb-file-table-object fname)))
 399
 400           ;; ELSE
 401           ;;
 402           ;; NOTE: We used to look up omniscient databases here, but that
 403           ;; is now handled one layer up.
 404           ;;
 405           ;; Missing: a database that knows where missing files are.  Hmm.
 406           ;; perhaps I need an override function for that?
 407
 408           )
 409
 410         (setq roots (cdr roots))))
 411      )
 412     ans))
 413
 414 \f
 415 ;;; Perform interactive tests on the path/search mechanisms.
 416 ;;
 417 ;;;###autoload
 418 (defun semanticdb-find-test-translate-path (&optional arg)
 419   "Call and output results of `semanticdb-find-translate-path'.
 420 With ARG non-nil, specify a BRUTISH translation.
 421 See `semanticdb-find-default-throttle' and `semanticdb-project-roots'
 422 for details on how this list is derived."
 423   (interactive "P")
 424   (require 'semantic-adebug)
 425   (let ((start (current-time))
 426         (p (semanticdb-find-translate-path nil arg))
 427         (end (current-time))
 428         (ab (semantic-adebug-new-buffer "*SEMANTICDB FTP ADEBUG*"))
 429         )
 430     (message "Search of tags took %.2f seconds."
 431              (semantic-elapsed-time start end))
 432
 433     (semantic-adebug-insert-stuff-list p "*")))
 434
 435 ;;    ;; Output the result
 436 ;;    (message "%d paths found." (length p))
 437 ;;    (with-output-to-temp-buffer "*Translated Path*"
 438 ;;      (while p
 439 ;;      (condition-case nil
 440 ;;          (progn
 441 ;;            (princ (semanticdb-full-filename (car p)))
 442 ;;            (princ ": ")
 443 ;;            (prin1 (condition-case nil
 444 ;;                       (length (oref (car p) tags))
 445 ;;                     (error "--")))
 446 ;;            (princ " tags")
 447 ;;            (let ((parent (oref (car p) parent-db)))
 448 ;;              (when parent
 449 ;;                (princ " : ")
 450 ;;                (princ (object-name parent))))
 451 ;;            )
 452 ;;        (no-method-definition
 453 ;;         (princ (semanticdb-printable-name (car p)))))
 454 ;;      (princ "\n")
 455 ;;      (setq p (cdr p)))
 456 ;;      )
 457 ;;    ))
 458
 459 \f
 460 ;;; FIND results and edebug
 461 ;;
 462 (eval-after-load "cedet-edebug"
 463   '(progn
 464      (cedet-edebug-add-print-override
 465       '(semanticdb-find-results-p object)
 466       '(semanticdb-find-result-prin1-to-string object) )
 467      ))
 468
 469
 470 \f
 471 ;;; API Functions
 472 ;;
 473 ;; Once you have a search result, use these routines to operate
 474 ;; on the search results at a higher level
 475
 476 ;;;###autoload
 477 (defun semanticdb-strip-find-results (results &optional find-file-match)
 478   "Strip a semanticdb search RESULTS to exclude objects.
 479 This makes it appear more like the results of a `semantic-find-' call.
 480 Optional FIND-FILE-MATCH loads all files associated with RESULTS
 481 into buffers.  This has the side effect of enabling `semantic-tag-buffer' to
 482 return a value."
 483   (if find-file-match
 484       ;; Load all files associated with RESULTS.
 485       (let ((tmp results)
 486             (output nil))
 487         (while tmp
 488           (let ((tab (car (car tmp)))
 489                 (tags (cdr (car tmp))))
 490             (semanticdb-get-buffer tab)
 491             (setq output (append output
 492                                  (semanticdb-normalize-tags tab tags))))
 493           (setq tmp (cdr tmp)))
 494         output)
 495     (apply #'append (mapcar #'cdr results))))
 496
 497 ;;;###autoload
 498 (defun semanticdb-find-results-p (resultp)
 499   "Non-nil if RESULTP is in the form of a semanticdb search result.
 500 This query only really tests the first entry in the list that is RESULTP,
 501 but should be good enough for debugging assertions."
 502   (and (listp resultp)
 503        (listp (car resultp))
 504        (semanticdb-abstract-table-child-p (car (car resultp)))
 505        (or (semantic-tag-p (car (cdr (car resultp))))
 506            (null (car (cdr (car resultp)))))))
 507
 508 (defun semanticdb-find-result-prin1-to-string (result)
 509   "Presuming RESULT satisfies `semanticdb-find-results-p', provide a short PRIN1 output."
 510   (concat "#<FIND RESULT "
 511           (mapconcat (lambda (a)
 512                        (concat "(" (object-name (car a) ) " . "
 513                                "#<TAG LIST " (number-to-string (length (cdr a))) ">)"))
 514                      result
 515                      " ")
 516           ">"))
 517
 518 ;;;###autoload
 519 (defun semanticdb-find-result-with-nil-p (resultp)
 520   "Non-nil of RESULTP is in the form of a semanticdb search result.
 521 nil is a valid value where a TABLE usually is, but only if the TAG
 522 results include overlays.
 523 This query only really tests the first entry in the list that is RESULTP,
 524 but should be good enough for debugging assertions."
 525   (and (listp resultp)
 526        (listp (car resultp))
 527        (let ((tag-to-test (car-safe (cdr (car resultp)))))
 528          (or (and (semanticdb-abstract-table-child-p (car (car resultp)))
 529                   (or (semantic-tag-p tag-to-test)
 530                       (null tag-to-test)))
 531              (and (null (car (car resultp)))
 532                   (or (semantic-tag-with-position-p tag-to-test)
 533                       (null tag-to-test))))
 534          )))
 535
 536 (defun semanticdb-find-result-length (result)
 537   "Number of tags found in RESULT."
 538   (let ((count 0))
 539     (mapc (lambda (onetable)
 540             (setq count (+ count (1- (length onetable)))))
 541           result)
 542     count))
 543
 544 ;;;###autoload
 545 (defun semanticdb-find-result-nth (result n)
 546   "In RESULT, return the Nth search result.
 547 This is a 0 based search result, with the first match being element 0.
 548
 549 The returned value is a cons cell: (TAG . TABLE) where TAG
 550 is the tag at the Nth position.  TABLE is the semanticdb table where
 551 the TAG was found.  Sometimes TABLE can be nil."
 552   (let ((ans nil)
 553         (anstable nil))
 554     ;; Loop over each single table hit.
 555     (while (and (not ans) result)
 556       ;; For each table result, get local length, and modify
 557       ;; N to be that much less.
 558       (let ((ll (length (cdr (car result))))) ;; local length
 559         (if (> ll n)
 560             ;; We have a local match.
 561             (setq ans (nth n (cdr (car result)))
 562                   anstable (car (car result)))
 563           ;; More to go.  Decrement N.
 564           (setq n (- n ll))))
 565       ;; Keep moving.
 566       (setq result (cdr result)))
 567     (cons ans anstable)))
 568
 569 (defun semanticdb-find-result-test (result)
 570   "Test RESULT by accessing all the tags in the list."
 571   (if (not (semanticdb-find-results-p result))
 572       (error "Does not pass `semanticdb-find-results-p.\n"))
 573   (let ((len (semanticdb-find-result-length result))
 574         (i 0))
 575     (while (< i len)
 576       (let ((tag (semanticdb-find-result-nth result i)))
 577         (if (not (semantic-tag-p (car tag)))
 578             (error "%d entry is not a tag" i)))
 579       (setq i (1+ i)))))
 580
 581 ;;;###autoload
 582 (defun semanticdb-find-result-nth-in-buffer (result n)
 583   "In RESULT, return the Nth search result.
 584 Like `semanticdb-find-result-nth', except that only the TAG
 585 is returned, and the buffer it is found it will be made current.
 586 If the result tag has no position information, the originating buffer
 587 is still made current."
 588   (let* ((ret (semanticdb-find-result-nth result n))
 589          (ans (car ret))
 590          (anstable (cdr ret)))
 591     ;; If we have a hit, double-check the find-file
 592     ;; entry.  If the file must be loaded, then gat that table's
 593     ;; source file into a buffer.
 594     (if anstable (semanticdb-set-buffer anstable))
 595     ;; Return the tag.
 596     ans))
 597
 598 ;;; Search Logging
 599 ;;
 600 ;; Basic logging to see what the search routines are doing.
 601 (defvar semanticdb-find-log-flag nil
 602   "Non-nil means log the process of searches.")
 603
 604 (defvar semanticdb-find-log-buffer-name "*SemanticDB Find Log*"
 605   "The name of the logging buffer.")
 606
 607 (defun semanticdb-find-toggle-logging ()
 608   "Toggle sematnicdb logging."
 609   (interactive)
 610   (setq semanticdb-find-log-flag (null semanticdb-find-log-flag))
 611   (message "Semanticdb find logging is %sabled"
 612            (if semanticdb-find-log-flag "en" "dis")))
 613
 614 (defun semanticdb-reset-log ()
 615   "Reset the log buffer."
 616   (interactive)
 617   (when semanticdb-find-log-flag
 618     (save-excursion
 619       (set-buffer (get-buffer-create semanticdb-find-log-buffer-name))
 620       (erase-buffer)
 621       )))
 622
 623 (defun semanticdb-find-log-move-to-end ()
 624   "Move to the end of the semantic log."
 625   (let ((cb (current-buffer))
 626         (cw (selected-window)))
 627     (unwind-protect
 628         (progn
 629           (set-buffer semanticdb-find-log-buffer-name)
 630           (if (get-buffer-window (current-buffer) 'visible)
 631               (select-window (get-buffer-window (current-buffer) 'visible)))
 632           (goto-char (point-max)))
 633       (if cw (select-window cw))
 634       (set-buffer cb))))
 635
 636 (defun semanticdb-find-log-new-search (forwhat)
 637   "Start a new search FORWHAT."
 638   (when semanticdb-find-log-flag
 639     (save-excursion
 640       (set-buffer (get-buffer-create semanticdb-find-log-buffer-name))
 641       (insert (format "New Search: %S\n" forwhat))
 642       )
 643     (semanticdb-find-log-move-to-end)))
 644
 645 (defun semanticdb-find-log-activity (table result)
 646   "Log that TABLE has been searched and RESULT was found."
 647   (when semanticdb-find-log-flag
 648     (save-excursion
 649       (set-buffer semanticdb-find-log-buffer-name)
 650       (insert "Table: " (object-print table)
 651               " Result: " (int-to-string (length result)) " tags"
 652               "\n")
 653       )
 654     (semanticdb-find-log-move-to-end)))
 655
 656 ;;; Semanticdb find API functions
 657 ;;
 658 ;; These are the routines actually used to perform searches.
 659 ;;
 660 ;;;###autoload
 661 (defun semanticdb-find-tags-collector (function &optional path find-file-match
 662                                                 brutish)
 663   "Search for all tags returned by FUNCTION over PATH.
 664 See `semanticdb-find-translate-path' for details on PATH.
 665 FIND-FILE-MATCH indicates that any time a match is found, the file
 666 associated with that tag should be loaded into a buffer.
 667 If optional argument BRUTISH is non-nil, then ignore include statements,
 668 and search all tables in this project tree."
 669   (let (found match)
 670     (save-excursion
 671       ;; If path is a buffer, set ourselves up in that buffer
 672       ;; so that the override methods work correctly.
 673       (when (bufferp path) (set-buffer path))
 674       (if (semanticdb-find-results-p path)
 675           ;; When we get find results, loop over that.
 676           (dolist (tableandtags path)
 677             (semantic-throw-on-input 'semantic-find-translate-path)
 678             ;; If FIND-FILE-MATCH is non-nil, skip tables of class
 679             ;; `semanticdb-search-results-table', since those are system
 680             ;; databases and not associated with a file.
 681             (unless (and find-file-match
 682                          (obj-of-class-p
 683                           (car tableandtags) semanticdb-search-results-table))
 684               (when (setq match (funcall function
 685                                          (car tableandtags) (cdr tableandtags)))
 686                 (when find-file-match
 687                   (save-excursion (semanticdb-set-buffer (car tableandtags))))
 688                 (push (cons (car tableandtags) match) found)))
 689             )
 690         ;; Only log searches across data bases.
 691         (semanticdb-find-log-new-search nil)
 692         ;; If we get something else, scan the list of tables resulting
 693         ;; from translating it into a list of objects.
 694         (dolist (table (semanticdb-find-translate-path path brutish))
 695           (semantic-throw-on-input 'semantic-find-translate-path)
 696           ;; If FIND-FILE-MATCH is non-nil, skip tables of class
 697           ;; `semanticdb-search-results-table', since those are system
 698           ;; databases and not associated with a file.
 699           (unless (and find-file-match
 700                        (obj-of-class-p table semanticdb-search-results-table))
 701             (when (and table (setq match (funcall function table nil)))
 702               (semanticdb-find-log-activity table match)
 703               (when find-file-match
 704                 (save-excursion (semanticdb-set-buffer table)))
 705               (push (cons table match) found))))))
 706     ;; At this point, FOUND has had items pushed onto it.
 707     ;; This means items are being returned in REVERSE order
 708     ;; of the tables searched, so if you just get th CAR, then
 709     ;; too-bad, you may have some system-tag that has no
 710     ;; buffer associated with it.
 711
 712     ;; It must be reversed.
 713     (nreverse found)))
 714
 715 ;;;###autoload
 716 (defun semanticdb-find-tags-by-name (name &optional path find-file-match)
 717   "Search for all tags matching NAME on PATH.
 718 See `semanticdb-find-translate-path' for details on PATH.
 719 FIND-FILE-MATCH indicates that any time a match is found, the file
 720 associated with that tag should be loaded into a buffer."
 721   (semanticdb-find-tags-collector
 722    (lambda (table tags)
 723      (semanticdb-find-tags-by-name-method table name tags))
 724    path find-file-match))
 725
 726 ;;;###autoload
 727 (defun semanticdb-find-tags-by-name-regexp (regexp &optional path find-file-match)
 728   "Search for all tags matching REGEXP on PATH.
 729 See `semanticdb-find-translate-path' for details on PATH.
 730 FIND-FILE-MATCH indicates that any time a match is found, the file
 731 associated with that tag should be loaded into a buffer."
 732   (semanticdb-find-tags-collector
 733    (lambda (table tags)
 734      (semanticdb-find-tags-by-name-regexp-method table regexp tags))
 735    path find-file-match))
 736
 737 ;;;###autoload
 738 (defun semanticdb-find-tags-for-completion (prefix &optional path find-file-match)
 739   "Search for all tags matching PREFIX on PATH.
 740 See `semanticdb-find-translate-path' for details on PATH.
 741 FIND-FILE-MATCH indicates that any time a match is found, the file
 742 associated with that tag should be loaded into a buffer."
 743   (semanticdb-find-tags-collector
 744    (lambda (table tags)
 745      (semanticdb-find-tags-for-completion-method table prefix tags))
 746    path find-file-match))
 747
 748 ;;;###autoload
 749 (defun semanticdb-find-tags-by-class (class &optional path find-file-match)
 750   "Search for all tags of CLASS on PATH.
 751 See `semanticdb-find-translate-path' for details on PATH.
 752 FIND-FILE-MATCH indicates that any time a match is found, the file
 753 associated with that tag should be loaded into a buffer."
 754   (semanticdb-find-tags-collector
 755    (lambda (table tags)
 756      (semanticdb-find-tags-by-class-method table class tags))
 757    path find-file-match))
 758
 759 ;;; Deep Searches
 760 ;;
 761 ;;;###autoload
 762 (defun semanticdb-deep-find-tags-by-name (name &optional path find-file-match)
 763   "Search for all tags matching NAME on PATH.
 764 Search also in all components of top level tags founds.
 765 See `semanticdb-find-translate-path' for details on PATH.
 766 FIND-FILE-MATCH indicates that any time a match is found, the file
 767 associated with that tag should be loaded into a buffer."
 768   (semanticdb-find-tags-collector
 769    (lambda (table tags)
 770      (semanticdb-deep-find-tags-by-name-method table name tags))
 771    path find-file-match))
 772
 773 ;;;###autoload
 774 (defun semanticdb-deep-find-tags-by-name-regexp (regexp &optional path find-file-match)
 775   "Search for all tags matching REGEXP on PATH.
 776 Search also in all components of top level tags founds.
 777 See `semanticdb-find-translate-path' for details on PATH.
 778 FIND-FILE-MATCH indicates that any time a match is found, the file
 779 associated with that tag should be loaded into a buffer."
 780   (semanticdb-find-tags-collector
 781    (lambda (table tags)
 782      (semanticdb-deep-find-tags-by-name-regexp-method table regexp tags))
 783    path find-file-match))
 784
 785 ;;;###autoload
 786 (defun semanticdb-deep-find-tags-for-completion (prefix &optional path find-file-match)
 787   "Search for all tags matching PREFIX on PATH.
 788 Search also in all components of top level tags founds.
 789 See `semanticdb-find-translate-path' for details on PATH.
 790 FIND-FILE-MATCH indicates that any time a match is found, the file
 791 associated with that tag should be loaded into a buffer."
 792   (semanticdb-find-tags-collector
 793    (lambda (table tags)
 794      (semanticdb-deep-find-tags-for-completion-method table prefix tags))
 795    path find-file-match))
 796
 797 ;;; Brutish Search Routines
 798 ;;
 799 ;;;###autoload
 800 (defun semanticdb-brute-deep-find-tags-by-name (name &optional path find-file-match)
 801   "Search for all tags matching NAME on PATH.
 802 See `semanticdb-find-translate-path' for details on PATH.
 803 The argument BRUTISH will be set so that searching includes all tables
 804 in the current project.
 805 FIND-FILE-MATCH indicates that any time a matchi is found, the file
 806 associated wit that tag should be loaded into a buffer."
 807   (semanticdb-find-tags-collector
 808    (lambda (table tags)
 809      (semanticdb-deep-find-tags-by-name-method table name tags))
 810    path find-file-match t))
 811
 812 ;;;###autoload
 813 (defun semanticdb-brute-deep-find-tags-for-completion (prefix &optional path find-file-match)
 814   "Search for all tags matching PREFIX on PATH.
 815 See `semanticdb-find-translate-path' for details on PATH.
 816 The argument BRUTISH will be set so that searching includes all tables
 817 in the current project.
 818 FIND-FILE-MATCH indicates that any time a matchi is found, the file
 819 associated wit that tag should be loaded into a buffer."
 820   (semanticdb-find-tags-collector
 821    (lambda (table tags)
 822      (semanticdb-deep-find-tags-for-completion-method table prefix tags))
 823    path find-file-match t))
 824
 825 ;;;###autoload
 826 (defun semanticdb-brute-find-tags-by-class (class &optional path find-file-match)
 827   "Search for all tags of CLASS on PATH.
 828 See `semanticdb-find-translate-path' for details on PATH.
 829 The argument BRUTISH will be set so that searching includes all tables
 830 in the current project.
 831 FIND-FILE-MATCH indicates that any time a match is found, the file
 832 associated with that tag should be loaded into a buffer."
 833   (semanticdb-find-tags-collector
 834    (lambda (table tags)
 835      (semanticdb-find-tags-by-class-method table class tags))
 836    path find-file-match t))
 837
 838 ;;; Specialty Search Routines
 839 ;;
 840 ;;;###autoload
 841 (defun semanticdb-find-tags-external-children-of-type
 842   (type &optional path find-file-match)
 843   "Search for all tags defined outside of TYPE w/ TYPE as a parent.
 844 See `semanticdb-find-translate-path' for details on PATH.
 845 FIND-FILE-MATCH indicates that any time a match is found, the file
 846 associated with that tag should be loaded into a buffer."
 847   (semanticdb-find-tags-collector
 848    (lambda (table tags)
 849      (semanticdb-find-tags-external-children-of-type-method table type tags))
 850    path find-file-match))
 851 \f
 852 ;;; METHODS
 853 ;;
 854 ;; Default methods for semanticdb database and table objects.
 855 ;; Override these with system databases to as new types of back ends.
 856
 857 ;;; Top level Searches
 858 (defmethod semanticdb-find-tags-by-name-method ((table semanticdb-table) name &optional tags)
 859   "In TABLE, find all occurances of tags with NAME.
 860 Optional argument TAGS is a list of tags to search.
 861 Returns a table of all matching tags."
 862   (semantic-find-tags-by-name name (or tags (semanticdb-get-tags table))))
 863
 864 (defmethod semanticdb-find-tags-by-name-regexp-method ((table semanticdb-table) regexp &optional tags)
 865   "In TABLE, find all occurances of tags matching REGEXP.
 866 Optional argument TAGS is a list of tags to search.
 867 Returns a table of all matching tags."
 868   (semantic-find-tags-by-name-regexp regexp (or tags (semanticdb-get-tags table))))
 869
 870 (defmethod semanticdb-find-tags-for-completion-method ((table semanticdb-table) prefix &optional tags)
 871   "In TABLE, find all occurances of tags matching PREFIX.
 872 Optional argument TAGS is a list of tags to search.
 873 Returns a table of all matching tags."
 874   (semantic-find-tags-for-completion prefix (or tags (semanticdb-get-tags table))))
 875
 876 (defmethod semanticdb-find-tags-by-class-method ((table semanticdb-table) class &optional tags)
 877   "In TABLE, find all occurances of tags of CLASS.
 878 Optional argument TAGS is a list of tags to search.
 879 Returns a table of all matching tags."
 880   (semantic-find-tags-by-class class (or tags (semanticdb-get-tags table))))
 881
 882 (defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-table) parent &optional tags)
 883    "In TABLE, find all occurances of tags whose TYPE is PARENT.
 884 Optional argument TAGS is a list of tags to search.
 885 Returns a table of all matching tags."
 886    (semantic-find-tags-external-children-of-type parent (or tags (semanticdb-get-tags table))))
 887
 888 ;;; Deep Searches
 889 (defmethod semanticdb-deep-find-tags-by-name-method ((table semanticdb-table) name &optional tags)
 890   "In TABLE, find all occurances of tags with NAME.
 891 Search in all tags in TABLE, and all components of top level tags in
 892 TABLE.
 893 Optional argument TAGS is a list of tags to search.
 894 Return a table of all matching tags."
 895   (semantic-find-tags-by-name name (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
 896
 897 (defmethod semanticdb-deep-find-tags-by-name-regexp-method ((table semanticdb-table) regexp &optional tags)
 898   "In TABLE, find all occurances of tags matching REGEXP.
 899 Search in all tags in TABLE, and all components of top level tags in
 900 TABLE.
 901 Optional argument TAGS is a list of tags to search.
 902 Return a table of all matching tags."
 903   (semantic-find-tags-by-name-regexp regexp (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
 904
 905 (defmethod semanticdb-deep-find-tags-for-completion-method ((table semanticdb-table) prefix &optional tags)
 906   "In TABLE, find all occurances of tags matching PREFIX.
 907 Search in all tags in TABLE, and all components of top level tags in
 908 TABLE.
 909 Optional argument TAGS is a list of tags to search.
 910 Return a table of all matching tags."
 911   (semantic-find-tags-for-completion prefix (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
 912
 913 (provide 'semanticdb-find)
 914
 915 ;;; semanticdb-find.el ends here