Commit | Line | Data |
---|---|---|
aa8724ae | 1 | ;;; semantic/db-find.el --- Searching through semantic databases. |
1bd95535 CY |
2 | |
3 | ;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, | |
4 | ;;; 2008, 2009 Free Software Foundation, Inc. | |
5 | ||
6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 | ;; Keywords: tags | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs 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 3 of the License, or | |
14 | ;; (at your option) any later version. | |
15 | ||
16 | ;; GNU Emacs 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. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | ;;; Commentary: | |
25 | ;; | |
26 | ;; Databases of various forms can all be searched. | |
27 | ;; There are a few types of searches that can be done: | |
28 | ;; | |
29 | ;; Basic Name Search: | |
30 | ;; These searches scan a database table collection for tags based | |
31 | ;; on name. | |
32 | ;; | |
33 | ;; Basic Attribute Search: | |
34 | ;; These searches allow searching on specific attributes of tags, | |
35 | ;; such as name, type, or other attribute. | |
36 | ;; | |
37 | ;; Advanced Search: | |
38 | ;; These are searches that were needed to accomplish some | |
39 | ;; specialized tasks as discovered in utilities. Advanced searches | |
40 | ;; include matching methods defined outside some parent class. | |
41 | ;; | |
42 | ;; The reason for advanced searches are so that external | |
43 | ;; repositories such as the Emacs obarray, or java .class files can | |
44 | ;; quickly answer these needed questions without dumping the entire | |
45 | ;; symbol list into Emacs for additional refinement searches via | |
46 | ;; regular semanticdb search. | |
47 | ;; | |
48 | ;; How databases are decided upon is another important aspect of a | |
49 | ;; database search. When it comes to searching for a name, there are | |
50 | ;; these types of searches: | |
51 | ;; | |
52 | ;; Basic Search: | |
53 | ;; Basic search means that tags looking for a given name start | |
54 | ;; with a specific search path. Names are sought on that path | |
55 | ;; until it is empty or items on the path can no longer be found. | |
56 | ;; Use `semanticdb-dump-all-table-summary' to test this list. | |
57 | ;; Use `semanticdb-find-throttle-custom-list' to refine this list. | |
58 | ;; | |
59 | ;; Deep Search: | |
60 | ;; A deep search will search more than just the global namespace. | |
61 | ;; It will recurse into tags that contain more tags, and search | |
62 | ;; those too. | |
63 | ;; | |
64 | ;; Brute Search: | |
65 | ;; Brute search means that all tables in all databases in a given | |
66 | ;; project are searched. Brute searches are the search style as | |
67 | ;; written for semantic version 1.x. | |
68 | ;; | |
69 | ;; How does the search path work? | |
70 | ;; | |
71 | ;; A basic search starts with three parameters: | |
72 | ;; | |
73 | ;; (FINDME &optional PATH FIND-FILE-MATCH) | |
74 | ;; | |
75 | ;; FINDME is key to be searched for dependent on the type of search. | |
76 | ;; PATH is an indicator of which tables are to be searched. | |
77 | ;; FIND-FILE-MATCH indicates that any time a match is found, the | |
78 | ;; file associated with the tag should be read into a file. | |
79 | ;; | |
80 | ;; The PATH argument is then the most interesting argument. It can | |
81 | ;; have these values: | |
82 | ;; | |
83 | ;; nil - Take the current buffer, and use it's include list | |
84 | ;; buffer - Use that buffer's include list. | |
85 | ;; filename - Use that file's include list. If the file is not | |
86 | ;; in a buffer, see of there is a semanticdb table for it. If | |
87 | ;; not, read that file into a buffer. | |
88 | ;; tag - Get that tag's buffer of file file. See above. | |
89 | ;; table - Search that table, and it's include list. | |
90 | ;; | |
91 | ;; Search Results: | |
92 | ;; | |
93 | ;; Semanticdb returns the results in a specific format. There are a | |
94 | ;; series of routines for using those results, and results can be | |
95 | ;; passed in as a search-path for refinement searches with | |
96 | ;; semanticdb. Apropos for semanticdb.*find-result for more. | |
97 | ;; | |
98 | ;; Application: | |
99 | ;; | |
100 | ;; Here are applications where different searches are needed which | |
101 | ;; exist as of semantic 1.4.x | |
102 | ;; | |
103 | ;; eldoc - popup help | |
104 | ;; => Requires basic search using default path. (Header files ok) | |
105 | ;; tag jump - jump to a named tag | |
106 | ;; => Requires a brute search useing whole project. (Source files only) | |
107 | ;; completion - Completing symbol names in a smart way | |
108 | ;; => Basic search (headers ok) | |
109 | ;; type analysis - finding type definitions for variables & fcns | |
110 | ;; => Basic search (headers ok) | |
111 | ;; Class browser - organize types into some structure | |
112 | ;; => Brute search, or custom navigation. | |
113 | ||
114 | ;; TODO: | |
115 | ;; During a search, load any unloaded DB files based on paths in the | |
116 | ;; current project. | |
117 | ||
118 | (require 'semantic/db) | |
119 | (require 'semantic/db-ref) | |
120 | (eval-when-compile | |
121 | (require 'eieio) | |
122 | ) | |
123 | ||
691a065e CY |
124 | (require 'semantic/find) |
125 | ||
126 | (require 'semantic/tag-file) | |
127 | (require 'semantic/sort) | |
128 | ||
1bd95535 | 129 | ;;; Code: |
691a065e CY |
130 | |
131 | (defvar data-debug-thing-alist) | |
132 | (declare-function data-debug-insert-stuff-list "data-debug") | |
133 | (declare-function data-debug-insert-tag-list "data-debug") | |
134 | (declare-function semantic-scope-reset-cache "semantic/scope") | |
135 | (declare-function semanticdb-typecache-notify-reset "semantic/db-typecache") | |
136 | (declare-function ede-current-project "ede") | |
137 | ||
1bd95535 CY |
138 | (defvar semanticdb-find-throttle-custom-list |
139 | '(repeat (radio (const 'local) | |
140 | (const 'project) | |
141 | (const 'unloaded) | |
142 | (const 'system) | |
143 | (const 'recursive) | |
144 | (const 'omniscience))) | |
145 | "Customization values for semanticdb find throttle. | |
146 | See `semanticdb-find-throttle' for details.") | |
147 | ||
691a065e | 148 | ;;;###autoload |
1bd95535 CY |
149 | (defcustom semanticdb-find-default-throttle |
150 | '(local project unloaded system recursive) | |
151 | "The default throttle for `semanticdb-find' routines. | |
152 | The throttle controls how detailed the list of database | |
153 | tables is for a symbol lookup. The value is a list with | |
154 | the following keys: | |
155 | `file' - The file the search is being performed from. | |
156 | This option is here for completeness only, and | |
157 | is assumed to always be on. | |
158 | `local' - Tables from the same local directory are included. | |
159 | This includes files directly referenced by a file name | |
160 | which might be in a different directory. | |
161 | `project' - Tables from the same local project are included | |
162 | If `project' is specified, then `local' is assumed. | |
163 | `unloaded' - If a table is not in memory, load it. If it is not cached | |
164 | on disk either, get the source, parse it, and create | |
165 | the table. | |
166 | `system' - Tables from system databases. These are specifically | |
167 | tables from system header files, or language equivalent. | |
168 | `recursive' - For include based searches, includes tables referenced | |
169 | by included files. | |
170 | `omniscience' - Included system databases which are omniscience, or | |
171 | somehow know everything. Omniscience databases are found | |
172 | in `semanticdb-project-system-databases'. | |
173 | The Emacs Lisp system DB is an omniscience database." | |
174 | :group 'semanticdb | |
175 | :type semanticdb-find-throttle-custom-list) | |
176 | ||
177 | (defun semanticdb-find-throttle-active-p (access-type) | |
178 | "Non-nil if ACCESS-TYPE is an active throttle type." | |
179 | (or (memq access-type semanticdb-find-default-throttle) | |
180 | (eq access-type 'file) | |
181 | (and (eq access-type 'local) | |
182 | (memq 'project semanticdb-find-default-throttle)) | |
183 | )) | |
184 | ||
185 | ;;; Index Class | |
186 | ;; | |
187 | ;; The find routines spend a lot of time looking stuff up. | |
188 | ;; Use this handy search index to cache data between searches. | |
189 | ;; This should allow searches to start running faster. | |
190 | (defclass semanticdb-find-search-index (semanticdb-abstract-search-index) | |
191 | ((include-path :initform nil | |
192 | :documentation | |
193 | "List of semanticdb tables from the include path.") | |
194 | (type-cache :initform nil | |
195 | :documentation | |
196 | "Cache of all the data types accessible from this file. | |
197 | Includes all types from all included files, merged namespaces, and | |
198 | expunge duplicates.") | |
199 | ) | |
200 | "Concrete search index for `semanticdb-find'. | |
201 | This class will cache data derived during various searches.") | |
202 | ||
203 | (defmethod semantic-reset ((idx semanticdb-find-search-index)) | |
204 | "Reset the object IDX." | |
691a065e | 205 | (require 'semantic/scope) |
1bd95535 CY |
206 | ;; Clear the include path. |
207 | (oset idx include-path nil) | |
208 | (when (oref idx type-cache) | |
209 | (semantic-reset (oref idx type-cache))) | |
210 | ;; Clear the scope. Scope doesn't have the data it needs to track | |
211 | ;; it's own reset. | |
212 | (semantic-scope-reset-cache) | |
213 | ) | |
214 | ||
215 | (defmethod semanticdb-synchronize ((idx semanticdb-find-search-index) | |
216 | new-tags) | |
217 | "Synchronize the search index IDX with some NEW-TAGS." | |
218 | ;; Reset our parts. | |
219 | (semantic-reset idx) | |
220 | ;; Notify dependants by clearning their indicies. | |
221 | (semanticdb-notify-references | |
222 | (oref idx table) | |
223 | (lambda (tab me) | |
224 | (semantic-reset (semanticdb-get-table-index tab)))) | |
225 | ) | |
226 | ||
227 | (defmethod semanticdb-partial-synchronize ((idx semanticdb-find-search-index) | |
228 | new-tags) | |
229 | "Synchronize the search index IDX with some changed NEW-TAGS." | |
230 | ;; Only reset if include statements changed. | |
231 | (if (semantic-find-tags-by-class 'include new-tags) | |
232 | (progn | |
233 | (semantic-reset idx) | |
234 | ;; Notify dependants by clearning their indicies. | |
235 | (semanticdb-notify-references | |
236 | (oref idx table) | |
237 | (lambda (tab me) | |
238 | (semantic-reset (semanticdb-get-table-index tab)))) | |
239 | ) | |
240 | ;; Else, not an include, by just a type. | |
241 | (when (oref idx type-cache) | |
242 | (when (semanticdb-partial-synchronize (oref idx type-cache) new-tags) | |
243 | ;; If the synchronize returns true, we need to notify. | |
244 | ;; Notify dependants by clearning their indicies. | |
245 | (semanticdb-notify-references | |
246 | (oref idx table) | |
247 | (lambda (tab me) | |
248 | (let ((tab-idx (semanticdb-get-table-index tab))) | |
249 | ;; Not a full reset? | |
250 | (when (oref tab-idx type-cache) | |
691a065e | 251 | (require 'db-typecache) |
1bd95535 CY |
252 | (semanticdb-typecache-notify-reset |
253 | (oref tab-idx type-cache))) | |
254 | ))) | |
255 | )) | |
256 | )) | |
257 | ||
258 | ||
259 | ;;; Path Translations | |
260 | ;; | |
261 | ;;; OVERLOAD Functions | |
262 | ;; | |
263 | ;; These routines needed to be overloaded by specific language modes. | |
264 | ;; They are needed for translating an INCLUDE tag into a semanticdb | |
265 | ;; TABLE object. | |
266 | (define-overloadable-function semanticdb-find-translate-path (path brutish) | |
267 | "Translate PATH into a list of semantic tables. | |
268 | Path translation involves identifying the PATH input argument | |
269 | in one of the following ways: | |
270 | nil - Take the current buffer, and use it's include list | |
271 | buffer - Use that buffer's include list. | |
272 | filename - Use that file's include list. If the file is not | |
273 | in a buffer, see of there is a semanticdb table for it. If | |
274 | not, read that file into a buffer. | |
275 | tag - Get that tag's buffer of file file. See above. | |
276 | table - Search that table, and it's include list. | |
277 | find result - Search the results of a previous find. | |
278 | ||
279 | In addition, once the base path is found, there is the possibility of | |
280 | each added table adding yet more tables to the path, so this routine | |
281 | can return a lengthy list. | |
282 | ||
283 | If argument BRUTISH is non-nil, then instead of using the include | |
284 | list, use all tables found in the parent project of the table | |
285 | identified by translating PATH. Such searches use brute force to | |
286 | scan every available table. | |
287 | ||
288 | The return value is a list of objects of type `semanticdb-table' or | |
289 | it's children. In the case of passing in a find result, the result | |
290 | is returned unchanged. | |
291 | ||
292 | This routine uses `semanticdb-find-table-for-include' to translate | |
293 | specific include tags into a semanticdb table. | |
294 | ||
295 | Note: When searching using a non-brutish method, the list of | |
296 | included files will be cached between runs. Database-references | |
297 | are used to track which files need to have their include lists | |
298 | refreshed when things change. See `semanticdb-ref-test'. | |
299 | ||
300 | Note for overloading: If you opt to overload this function for your | |
301 | major mode, and your routine takes a long time, be sure to call | |
302 | ||
303 | (semantic-throw-on-input 'your-symbol-here) | |
304 | ||
305 | so that it can be called from the idle work handler." | |
306 | ) | |
307 | ||
308 | (defun semanticdb-find-translate-path-default (path brutish) | |
309 | "Translate PATH into a list of semantic tables. | |
310 | If BRUTISH is non nil, return all tables associated with PATH. | |
311 | Default action as described in `semanticdb-find-translate-path'." | |
312 | (if (semanticdb-find-results-p path) | |
313 | ;; nil means perform the search over these results. | |
314 | nil | |
315 | (if brutish | |
316 | (semanticdb-find-translate-path-brutish-default path) | |
317 | (semanticdb-find-translate-path-includes-default path)))) | |
318 | ||
691a065e CY |
319 | (define-overloadable-function semanticdb-find-table-for-include (includetag &optional table) |
320 | "For a single INCLUDETAG found in TABLE, find a `semanticdb-table' object | |
321 | INCLUDETAG is a semantic TAG of class 'include. | |
322 | TABLE is a semanticdb table that identifies where INCLUDETAG came from. | |
323 | TABLE is optional if INCLUDETAG has an overlay of :filename attribute." | |
324 | ) | |
325 | ||
1bd95535 CY |
326 | (defun semanticdb-find-translate-path-brutish-default (path) |
327 | "Translate PATH into a list of semantic tables. | |
328 | Default action as described in `semanticdb-find-translate-path'." | |
329 | (let ((basedb | |
330 | (cond ((null path) semanticdb-current-database) | |
331 | ((semanticdb-table-p path) (oref path parent-db)) | |
332 | (t (let ((tt (semantic-something-to-tag-table path))) | |
333 | (save-excursion | |
334 | ;; @todo - What does this DO ??!?! | |
335 | (set-buffer (semantic-tag-buffer (car tt))) | |
336 | semanticdb-current-database)))))) | |
337 | (apply | |
338 | #'nconc | |
339 | (mapcar | |
340 | (lambda (db) | |
341 | (let ((tabs (semanticdb-get-database-tables db)) | |
342 | (ret nil)) | |
343 | ;; Only return tables of the same language (major-mode) | |
344 | ;; as the current search environment. | |
345 | (while tabs | |
346 | ||
347 | (semantic-throw-on-input 'translate-path-brutish) | |
348 | ||
349 | (if (semanticdb-equivalent-mode-for-search (car tabs) | |
350 | (current-buffer)) | |
351 | (setq ret (cons (car tabs) ret))) | |
352 | (setq tabs (cdr tabs))) | |
353 | ret)) | |
354 | ;; FIXME: | |
355 | ;; This should scan the current project directory list for all | |
356 | ;; semanticdb files, perhaps handling proxies for them. | |
357 | (semanticdb-current-database-list | |
358 | (if basedb (oref basedb reference-directory) | |
359 | default-directory)))) | |
360 | )) | |
361 | ||
362 | (defun semanticdb-find-incomplete-cache-entries-p (cache) | |
363 | "Are there any incomplete entries in CACHE?" | |
364 | (let ((ans nil)) | |
365 | (dolist (tab cache) | |
366 | (when (and (semanticdb-table-child-p tab) | |
367 | (not (number-or-marker-p (oref tab pointmax)))) | |
368 | (setq ans t)) | |
369 | ) | |
370 | ans)) | |
371 | ||
372 | (defun semanticdb-find-need-cache-update-p (table) | |
373 | "Non nil if the semanticdb TABLE cache needs to be updated." | |
374 | ;; If we were passed in something related to a TABLE, | |
375 | ;; do a caching lookup. | |
376 | (let* ((index (semanticdb-get-table-index table)) | |
377 | (cache (when index (oref index include-path))) | |
378 | (incom (semanticdb-find-incomplete-cache-entries-p cache)) | |
379 | (unl (semanticdb-find-throttle-active-p 'unloaded)) | |
380 | ) | |
381 | (if (and | |
382 | cache ;; Must have a cache | |
383 | (or | |
384 | ;; If all entries are "full", or if 'unloaded | |
385 | ;; OR | |
386 | ;; is not in the throttle, it is ok to use the cache. | |
387 | (not incom) (not unl) | |
388 | )) | |
389 | nil | |
390 | ;;cache | |
391 | ;; ELSE | |
392 | ;; | |
393 | ;; We need an update. | |
394 | t)) | |
395 | ) | |
396 | ||
397 | (defun semanticdb-find-translate-path-includes-default (path) | |
398 | "Translate PATH into a list of semantic tables. | |
399 | Default action as described in `semanticdb-find-translate-path'." | |
400 | (let ((table (cond ((null path) | |
401 | semanticdb-current-table) | |
402 | ((bufferp path) | |
403 | (semantic-buffer-local-value 'semanticdb-current-table path)) | |
404 | ((and (stringp path) (file-exists-p path)) | |
405 | (semanticdb-file-table-object path t)) | |
406 | ((semanticdb-abstract-table-child-p path) | |
407 | path) | |
408 | (t nil)))) | |
409 | (if table | |
410 | ;; If we were passed in something related to a TABLE, | |
411 | ;; do a caching lookup. | |
412 | (let ((index (semanticdb-get-table-index table))) | |
413 | (if (semanticdb-find-need-cache-update-p table) | |
414 | ;; Lets go look up our indicies | |
415 | (let ((ans (semanticdb-find-translate-path-includes--internal path))) | |
416 | (oset index include-path ans) | |
417 | ;; Once we have our new indicies set up, notify those | |
418 | ;; who depend on us if we found something for them to | |
419 | ;; depend on. | |
420 | (when ans (semanticdb-refresh-references table)) | |
421 | ans) | |
422 | ;; ELSE | |
423 | ;; | |
424 | ;; Just return the cache. | |
425 | (oref index include-path))) | |
426 | ;; If we were passed in something like a tag list, or other boring | |
427 | ;; searchable item, then instead do the regular thing without caching. | |
428 | (semanticdb-find-translate-path-includes--internal path)))) | |
429 | ||
430 | (defvar semanticdb-find-lost-includes nil | |
431 | "Include files that we cannot find associated with this buffer.") | |
432 | (make-variable-buffer-local 'semanticdb-find-lost-includes) | |
433 | ||
434 | (defvar semanticdb-find-scanned-include-tags nil | |
435 | "All include tags scanned, plus action taken on the tag. | |
436 | Each entry is an alist: | |
437 | (ACTION . TAG) | |
438 | where ACTION is one of 'scanned, 'duplicate, 'lost. | |
439 | and TAG is a clone of the include tag that was found.") | |
440 | (make-variable-buffer-local 'semanticdb-find-scanned-include-tags) | |
441 | ||
442 | (defvar semanticdb-implied-include-tags nil | |
443 | "Include tags implied for all files of a given mode. | |
444 | Set this variable with `defvar-mode-local' for a particular mode so | |
445 | that any symbols that exist for all files for that mode are included. | |
446 | ||
447 | Note: This could be used as a way to write a file in a langauge | |
448 | to declare all the built-ins for that language.") | |
449 | ||
450 | (defun semanticdb-find-translate-path-includes--internal (path) | |
451 | "Internal implementation of `semanticdb-find-translate-path-includes-default'. | |
452 | This routine does not depend on the cache, but will always derive | |
453 | a new path from the provided PATH." | |
454 | (let ((includetags nil) | |
455 | (curtable nil) | |
456 | (matchedtables (list semanticdb-current-table)) | |
457 | (matchedincludes nil) | |
458 | (lostincludes nil) | |
459 | (scannedincludes nil) | |
460 | (incfname nil) | |
461 | nexttable) | |
462 | (cond ((null path) | |
463 | (semantic-refresh-tags-safe) | |
464 | (setq includetags (append | |
465 | (semantic-find-tags-included (current-buffer)) | |
466 | semanticdb-implied-include-tags) | |
467 | curtable semanticdb-current-table | |
468 | incfname (buffer-file-name)) | |
469 | ) | |
470 | ((semanticdb-table-p path) | |
471 | (setq includetags (semantic-find-tags-included path) | |
472 | curtable path | |
473 | incfname (semanticdb-full-filename path)) | |
474 | ) | |
475 | ((bufferp path) | |
476 | (save-excursion | |
477 | (set-buffer path) | |
478 | (semantic-refresh-tags-safe)) | |
479 | (setq includetags (semantic-find-tags-included path) | |
480 | curtable (save-excursion (set-buffer path) | |
481 | semanticdb-current-table) | |
482 | incfname (buffer-file-name path))) | |
483 | (t | |
484 | (setq includetags (semantic-find-tags-included path)) | |
485 | (when includetags | |
486 | ;; If we have some tags, derive a table from them. | |
487 | ;; else we will do nothing, so the table is useless. | |
488 | ||
489 | ;; @todo - derive some tables | |
490 | (message "Need to derive tables for %S in translate-path-includes--default." | |
491 | path) | |
492 | ))) | |
493 | ||
494 | ;; Make sure each found include tag has an originating file name associated | |
495 | ;; with it. | |
496 | (when incfname | |
497 | (dolist (it includetags) | |
498 | (semantic--tag-put-property it :filename incfname))) | |
499 | ||
500 | ;; Loop over all include tags adding to matchedtables | |
501 | (while includetags | |
502 | (semantic-throw-on-input 'semantic-find-translate-path-includes-default) | |
503 | ||
504 | ;; If we've seen this include string before, lets skip it. | |
505 | (if (member (semantic-tag-name (car includetags)) matchedincludes) | |
506 | (progn | |
507 | (setq nexttable nil) | |
508 | (push (cons 'duplicate (semantic-tag-clone (car includetags))) | |
509 | scannedincludes) | |
510 | ) | |
511 | (setq nexttable (semanticdb-find-table-for-include (car includetags) curtable)) | |
512 | (when (not nexttable) | |
513 | ;; Save the lost include. | |
514 | (push (car includetags) lostincludes) | |
515 | (push (cons 'lost (semantic-tag-clone (car includetags))) | |
516 | scannedincludes) | |
517 | ) | |
518 | ) | |
519 | ||
520 | ;; Push the include file, so if we can't find it, we only | |
521 | ;; can't find it once. | |
522 | (push (semantic-tag-name (car includetags)) matchedincludes) | |
523 | ||
524 | ;; (message "Scanning %s" (semantic-tag-name (car includetags))) | |
525 | (when (and nexttable | |
526 | (not (memq nexttable matchedtables)) | |
527 | (semanticdb-equivalent-mode-for-search nexttable | |
528 | (current-buffer)) | |
529 | ) | |
530 | ;; Add to list of tables | |
531 | (push nexttable matchedtables) | |
532 | ||
533 | ;; Queue new includes to list | |
534 | (if (semanticdb-find-throttle-active-p 'recursive) | |
535 | ;; @todo - recursive includes need to have the originating | |
536 | ;; buffer's location added to the path. | |
537 | (let ((newtags | |
538 | (cond | |
539 | ((semanticdb-table-p nexttable) | |
540 | (semanticdb-refresh-table nexttable) | |
541 | ;; Use the method directly, or we will recurse | |
542 | ;; into ourselves here. | |
543 | (semanticdb-find-tags-by-class-method | |
544 | nexttable 'include)) | |
545 | (t ;; @todo - is this ever possible??? | |
546 | (message "semanticdb-ftp - how did you do that?") | |
547 | (semantic-find-tags-included | |
548 | (semanticdb-get-tags nexttable))) | |
549 | )) | |
550 | (newincfname (semanticdb-full-filename nexttable)) | |
551 | ) | |
552 | ||
553 | (push (cons 'scanned (semantic-tag-clone (car includetags))) | |
554 | scannedincludes) | |
555 | ||
556 | ;; Setup new tags so we know where they are. | |
557 | (dolist (it newtags) | |
558 | (semantic--tag-put-property it :filename | |
559 | newincfname)) | |
560 | ||
561 | (setq includetags (nconc includetags newtags))) | |
562 | ;; ELSE - not recursive throttle | |
563 | (push (cons 'scanned-no-recurse | |
564 | (semantic-tag-clone (car includetags))) | |
565 | scannedincludes) | |
566 | ) | |
567 | ) | |
568 | (setq includetags (cdr includetags))) | |
569 | ||
570 | (setq semanticdb-find-lost-includes lostincludes) | |
571 | (setq semanticdb-find-scanned-include-tags (reverse scannedincludes)) | |
572 | ||
573 | ;; Find all the omniscient databases for this major mode, and | |
574 | ;; add them if needed | |
575 | (when (and (semanticdb-find-throttle-active-p 'omniscience) | |
576 | semanticdb-search-system-databases) | |
577 | ;; We can append any mode-specific omniscience databases into | |
578 | ;; our search list here. | |
579 | (let ((systemdb semanticdb-project-system-databases) | |
580 | (ans nil)) | |
581 | (while systemdb | |
582 | (setq ans (semanticdb-file-table | |
583 | (car systemdb) | |
584 | ;; I would expect most omniscient to return the same | |
585 | ;; thing reguardless of filename, but we may have | |
586 | ;; one that can return a table of all things the | |
587 | ;; current file needs. | |
588 | (buffer-file-name (current-buffer)))) | |
589 | (when (not (memq ans matchedtables)) | |
590 | (setq matchedtables (cons ans matchedtables))) | |
591 | (setq systemdb (cdr systemdb)))) | |
592 | ) | |
593 | (nreverse matchedtables))) | |
594 | ||
595 | (define-overloadable-function semanticdb-find-load-unloaded (filename) | |
596 | "Create a database table for FILENAME if it hasn't been parsed yet. | |
597 | Assumes that FILENAME exists as a source file. | |
598 | Assumes that a preexisting table does not exist, even if it | |
599 | isn't in memory yet." | |
600 | (if (semanticdb-find-throttle-active-p 'unloaded) | |
601 | (:override) | |
602 | (semanticdb-file-table-object filename t))) | |
603 | ||
604 | (defun semanticdb-find-load-unloaded-default (filename) | |
605 | "Load an unloaded file in FILENAME using the default semanticdb loader." | |
606 | (semanticdb-file-table-object filename)) | |
607 | ||
1bd95535 CY |
608 | (defun semanticdb-find-table-for-include-default (includetag &optional table) |
609 | "Default implementation of `semanticdb-find-table-for-include'. | |
610 | Uses `semanticdb-current-database-list' as the search path. | |
611 | INCLUDETAG and TABLE are documented in `semanticdb-find-table-for-include'. | |
612 | Included databases are filtered based on `semanticdb-find-default-throttle'." | |
613 | (if (not (eq (semantic-tag-class includetag) 'include)) | |
614 | (signal 'wrong-type-argument (list includetag 'include))) | |
615 | ||
616 | (let ((name | |
617 | ;; Note, some languages (like Emacs or Java) use include tag names | |
618 | ;; that don't represent files! We want to have file names. | |
619 | (semantic-tag-include-filename includetag)) | |
620 | (originfiledir nil) | |
621 | (roots nil) | |
622 | (tmp nil) | |
623 | (ans nil)) | |
624 | ||
625 | ;; INCLUDETAG should have some way to reference where it came | |
626 | ;; from! If not, TABLE should provide the way. Each time we | |
627 | ;; look up a tag, we may need to find it in some relative way | |
628 | ;; and must set our current buffer eto the origin of includetag | |
629 | ;; or nothing may work. | |
630 | (setq originfiledir | |
631 | (cond ((semantic-tag-file-name includetag) | |
632 | ;; A tag may have a buffer, or a :filename property. | |
633 | (file-name-directory (semantic-tag-file-name includetag))) | |
634 | (table | |
635 | (file-name-directory (semanticdb-full-filename table))) | |
636 | (t | |
637 | ;; @todo - what to do here? Throw an error maybe | |
638 | ;; and fix usage bugs? | |
639 | default-directory))) | |
640 | ||
641 | (cond | |
642 | ;; Step 1: Relative path name | |
643 | ;; | |
644 | ;; If the name is relative, then it should be findable as relative | |
645 | ;; to the source file that this tag originated in, and be fast. | |
646 | ;; | |
647 | ((and (semanticdb-find-throttle-active-p 'local) | |
648 | (file-exists-p (expand-file-name name originfiledir))) | |
649 | ||
650 | (setq ans (semanticdb-find-load-unloaded | |
651 | (expand-file-name name originfiledir))) | |
652 | ) | |
653 | ;; Step 2: System or Project level includes | |
654 | ;; | |
655 | ((or | |
656 | ;; First, if it a system include, we can investigate that tags | |
657 | ;; dependency file | |
658 | (and (semanticdb-find-throttle-active-p 'system) | |
659 | ||
660 | ;; Sadly, not all languages make this distinction. | |
661 | ;;(semantic-tag-include-system-p includetag) | |
662 | ||
663 | ;; Here, we get local and system files. | |
664 | (setq tmp (semantic-dependency-tag-file includetag)) | |
665 | ) | |
666 | ;; Second, project files are active, we and we have EDE, | |
667 | ;; we can find it using the same tool. | |
668 | (and (semanticdb-find-throttle-active-p 'project) | |
669 | ;; Make sure EDE is available, and we have a project | |
670 | (featurep 'ede) (ede-current-project originfiledir) | |
671 | ;; The EDE query is hidden in this call. | |
672 | (setq tmp (semantic-dependency-tag-file includetag)) | |
673 | ) | |
674 | ) | |
675 | (setq ans (semanticdb-find-load-unloaded tmp)) | |
676 | ) | |
677 | ;; Somewhere in our project hierarchy | |
678 | ;; | |
679 | ;; Remember: Roots includes system databases which can create | |
680 | ;; specialized tables we can search. | |
681 | ;; | |
682 | ;; NOTE: Not used if EDE is active! | |
683 | ((and (semanticdb-find-throttle-active-p 'project) | |
684 | ;; And dont do this if it is a system include. Not supported by all languages, | |
685 | ;; but when it is, this is a nice fast way to skip this step. | |
686 | (not (semantic-tag-include-system-p includetag)) | |
687 | ;; Don't do this if we have an EDE project. | |
688 | (not (and (featurep 'ede) | |
689 | ;; Note: We don't use originfiledir here because | |
690 | ;; we want to know about the source file we are | |
691 | ;; starting from. | |
692 | (ede-current-project))) | |
693 | ) | |
694 | ||
695 | (setq roots (semanticdb-current-database-list)) | |
696 | ||
697 | (while (and (not ans) roots) | |
698 | (let* ((ref (if (slot-boundp (car roots) 'reference-directory) | |
699 | (oref (car roots) reference-directory))) | |
700 | (fname (cond ((null ref) nil) | |
701 | ((file-exists-p (expand-file-name name ref)) | |
702 | (expand-file-name name ref)) | |
703 | ((file-exists-p (expand-file-name (file-name-nondirectory name) ref)) | |
704 | (expand-file-name (file-name-nondirectory name) ref))))) | |
705 | (when (and ref fname) | |
706 | ;; There is an actual file. Grab it. | |
707 | (setq ans (semanticdb-find-load-unloaded fname))) | |
708 | ||
709 | ;; ELSE | |
710 | ;; | |
711 | ;; NOTE: We used to look up omniscient databases here, but that | |
712 | ;; is now handled one layer up. | |
713 | ;; | |
714 | ;; Missing: a database that knows where missing files are. Hmm. | |
715 | ;; perhaps I need an override function for that? | |
716 | ||
717 | ) | |
718 | ||
719 | (setq roots (cdr roots)))) | |
720 | ) | |
721 | ans)) | |
722 | ||
723 | \f | |
724 | ;;; Perform interactive tests on the path/search mechanisms. | |
725 | ;; | |
726 | (defun semanticdb-find-test-translate-path (&optional arg) | |
727 | "Call and output results of `semanticdb-find-translate-path'. | |
728 | With ARG non-nil, specify a BRUTISH translation. | |
729 | See `semanticdb-find-default-throttle' and `semanticdb-project-roots' | |
730 | for details on how this list is derived." | |
731 | (interactive "P") | |
732 | (semantic-fetch-tags) | |
733 | (require 'data-debug) | |
734 | (let ((start (current-time)) | |
735 | (p (semanticdb-find-translate-path nil arg)) | |
736 | (end (current-time)) | |
737 | ) | |
738 | (data-debug-new-buffer "*SEMANTICDB FTP ADEBUG*") | |
739 | (message "Search of tags took %.2f seconds." | |
740 | (semantic-elapsed-time start end)) | |
741 | ||
742 | (data-debug-insert-stuff-list p "*"))) | |
743 | ||
744 | (defun semanticdb-find-test-translate-path-no-loading (&optional arg) | |
745 | "Call and output results of `semanticdb-find-translate-path'. | |
746 | With ARG non-nil, specify a BRUTISH translation. | |
747 | See `semanticdb-find-default-throttle' and `semanticdb-project-roots' | |
748 | for details on how this list is derived." | |
749 | (interactive "P") | |
750 | (semantic-fetch-tags) | |
751 | (require 'data-debug) | |
752 | (let* ((semanticdb-find-default-throttle | |
753 | (if (featurep 'semanticdb-find) | |
754 | (remq 'unloaded semanticdb-find-default-throttle) | |
755 | nil)) | |
756 | (start (current-time)) | |
757 | (p (semanticdb-find-translate-path nil arg)) | |
758 | (end (current-time)) | |
759 | ) | |
760 | (data-debug-new-buffer "*SEMANTICDB FTP ADEBUG*") | |
761 | (message "Search of tags took %.2f seconds." | |
762 | (semantic-elapsed-time start end)) | |
763 | ||
764 | (data-debug-insert-stuff-list p "*"))) | |
765 | ||
766 | (defun semanticdb-find-adebug-lost-includes () | |
767 | "Translate the current path, then display the lost includes. | |
768 | Examines the variable `semanticdb-find-lost-includes'." | |
769 | (interactive) | |
770 | (require 'data-debug) | |
771 | (semanticdb-find-translate-path nil nil) | |
772 | (let ((lost semanticdb-find-lost-includes) | |
773 | ) | |
774 | ||
775 | (if (not lost) | |
776 | (message "There are no unknown includes for %s" | |
777 | (buffer-name)) | |
778 | ||
779 | (data-debug-new-buffer "*SEMANTICDB lost-includes ADEBUG*") | |
780 | (data-debug-insert-tag-list lost "*") | |
781 | ))) | |
782 | ||
783 | (defun semanticdb-find-adebug-insert-scanned-tag-cons (consdata prefix prebuttontext) | |
784 | "Insert a button representing scanned include CONSDATA. | |
785 | PREFIX is the text that preceeds the button. | |
786 | PREBUTTONTEXT is some text between prefix and the overlay button." | |
787 | (let* ((start (point)) | |
788 | (end nil) | |
789 | (mode (car consdata)) | |
790 | (tag (cdr consdata)) | |
791 | (name (semantic-tag-name tag)) | |
792 | (file (semantic-tag-file-name tag)) | |
793 | (str1 (format "%S %s" mode name)) | |
794 | (str2 (format " : %s" file)) | |
795 | (tip nil)) | |
796 | (insert prefix prebuttontext str1) | |
797 | (setq end (point)) | |
798 | (insert str2) | |
799 | (put-text-property start end 'face | |
800 | (cond ((eq mode 'scanned) | |
801 | 'font-lock-function-name-face) | |
802 | ((eq mode 'duplicate) | |
803 | 'font-lock-comment-face) | |
804 | ((eq mode 'lost) | |
805 | 'font-lock-variable-name-face) | |
806 | ((eq mode 'scanned-no-recurse) | |
807 | 'font-lock-type-face))) | |
808 | (put-text-property start end 'ddebug (cdr consdata)) | |
809 | (put-text-property start end 'ddebug-indent(length prefix)) | |
810 | (put-text-property start end 'ddebug-prefix prefix) | |
811 | (put-text-property start end 'help-echo tip) | |
812 | (put-text-property start end 'ddebug-function | |
813 | 'data-debug-insert-tag-parts-from-point) | |
814 | (insert "\n") | |
815 | ) | |
816 | ) | |
817 | ||
818 | (defun semanticdb-find-adebug-scanned-includes () | |
819 | "Translate the current path, then display the lost includes. | |
820 | Examines the variable `semanticdb-find-lost-includes'." | |
821 | (interactive) | |
822 | (require 'data-debug) | |
823 | (semanticdb-find-translate-path nil nil) | |
824 | (let ((scanned semanticdb-find-scanned-include-tags) | |
825 | (data-debug-thing-alist | |
826 | (cons | |
827 | '((lambda (thing) (and (consp thing) | |
828 | (symbolp (car thing)) | |
829 | (memq (car thing) | |
830 | '(scanned scanned-no-recurse | |
831 | lost duplicate)))) | |
832 | . semanticdb-find-adebug-insert-scanned-tag-cons) | |
833 | data-debug-thing-alist)) | |
834 | ) | |
835 | ||
836 | (if (not scanned) | |
837 | (message "There are no includes scanned %s" | |
838 | (buffer-name)) | |
839 | ||
840 | (data-debug-new-buffer "*SEMANTICDB scanned-includes ADEBUG*") | |
841 | (data-debug-insert-stuff-list scanned "*") | |
842 | ))) | |
843 | \f | |
844 | ;;; FIND results and edebug | |
845 | ;; | |
846 | (eval-after-load "cedet-edebug" | |
847 | '(progn | |
848 | (cedet-edebug-add-print-override | |
849 | '(semanticdb-find-results-p object) | |
850 | '(semanticdb-find-result-prin1-to-string object) ) | |
851 | )) | |
852 | ||
853 | ||
854 | \f | |
855 | ;;; API Functions | |
856 | ;; | |
857 | ;; Once you have a search result, use these routines to operate | |
858 | ;; on the search results at a higher level | |
859 | ||
860 | (defun semanticdb-strip-find-results (results &optional find-file-match) | |
861 | "Strip a semanticdb search RESULTS to exclude objects. | |
862 | This makes it appear more like the results of a `semantic-find-' call. | |
863 | Optional FIND-FILE-MATCH loads all files associated with RESULTS | |
864 | into buffers. This has the side effect of enabling `semantic-tag-buffer' to | |
865 | return a value. | |
866 | If FIND-FILE-MATCH is 'name, then only the filename is stored | |
867 | in each tag instead of loading each file into a buffer. | |
868 | If the input RESULTS are not going to be used again, and if | |
869 | FIND-FILE-MATCH is nil, you can use `semanticdb-fast-strip-find-results' | |
870 | instead." | |
871 | (if find-file-match | |
872 | ;; Load all files associated with RESULTS. | |
873 | (let ((tmp results) | |
874 | (output nil)) | |
875 | (while tmp | |
876 | (let ((tab (car (car tmp))) | |
877 | (tags (cdr (car tmp)))) | |
878 | (dolist (T tags) | |
879 | ;; Normilzation gives specialty database tables a chance | |
880 | ;; to convert into a more stable tag format. | |
881 | (let* ((norm (semanticdb-normalize-one-tag tab T)) | |
882 | (ntab (car norm)) | |
883 | (ntag (cdr norm)) | |
884 | (nametable ntab)) | |
885 | ||
886 | ;; If it didn't normalize, use what we had. | |
887 | (if (not norm) | |
888 | (setq nametable tab) | |
889 | (setq output (append output (list ntag)))) | |
890 | ||
891 | ;; Find-file-match allows a tool to make sure the tag is | |
892 | ;; 'live', somewhere in a buffer. | |
893 | (cond ((eq find-file-match 'name) | |
894 | (let ((f (semanticdb-full-filename nametable))) | |
895 | (semantic--tag-put-property ntag :filename f))) | |
896 | ((and find-file-match ntab) | |
897 | (semanticdb-get-buffer ntab)) | |
898 | ) | |
899 | )) | |
900 | ) | |
901 | (setq tmp (cdr tmp))) | |
902 | output) | |
903 | ;; @todo - I could use nconc, but I don't know what the caller may do with | |
904 | ;; RESULTS after this is called. Right now semantic-complete will | |
905 | ;; recycling the input after calling this routine. | |
906 | (apply #'append (mapcar #'cdr results)))) | |
907 | ||
908 | (defun semanticdb-fast-strip-find-results (results) | |
909 | "Destructively strip a semanticdb search RESULTS to exclude objects. | |
910 | This makes it appear more like the results of a `semantic-find-' call. | |
911 | This is like `semanticdb-strip-find-results', except the input list RESULTS | |
912 | will be changed." | |
913 | (apply #'nconc (mapcar #'cdr results))) | |
914 | ||
915 | (defun semanticdb-find-results-p (resultp) | |
916 | "Non-nil if RESULTP is in the form of a semanticdb search result. | |
917 | This query only really tests the first entry in the list that is RESULTP, | |
918 | but should be good enough for debugging assertions." | |
919 | (and (listp resultp) | |
920 | (listp (car resultp)) | |
921 | (semanticdb-abstract-table-child-p (car (car resultp))) | |
922 | (or (semantic-tag-p (car (cdr (car resultp)))) | |
923 | (null (car (cdr (car resultp))))))) | |
924 | ||
925 | (defun semanticdb-find-result-prin1-to-string (result) | |
926 | "Presuming RESULT satisfies `semanticdb-find-results-p', provide a short PRIN1 output." | |
927 | (if (< (length result) 2) | |
928 | (concat "#<FIND RESULT " | |
929 | (mapconcat (lambda (a) | |
930 | (concat "(" (object-name (car a) ) " . " | |
931 | "#<TAG LIST " (number-to-string (length (cdr a))) ">)")) | |
932 | result | |
933 | " ") | |
934 | ">") | |
935 | ;; Longer results should have an abreviated form. | |
936 | (format "#<FIND RESULT %d TAGS in %d FILES>" | |
937 | (semanticdb-find-result-length result) | |
938 | (length result)))) | |
939 | ||
940 | (defun semanticdb-find-result-with-nil-p (resultp) | |
941 | "Non-nil of RESULTP is in the form of a semanticdb search result. | |
942 | nil is a valid value where a TABLE usually is, but only if the TAG | |
943 | results include overlays. | |
944 | This query only really tests the first entry in the list that is RESULTP, | |
945 | but should be good enough for debugging assertions." | |
946 | (and (listp resultp) | |
947 | (listp (car resultp)) | |
948 | (let ((tag-to-test (car-safe (cdr (car resultp))))) | |
949 | (or (and (semanticdb-abstract-table-child-p (car (car resultp))) | |
950 | (or (semantic-tag-p tag-to-test) | |
951 | (null tag-to-test))) | |
952 | (and (null (car (car resultp))) | |
953 | (or (semantic-tag-with-position-p tag-to-test) | |
954 | (null tag-to-test)))) | |
955 | ))) | |
956 | ||
957 | (defun semanticdb-find-result-length (result) | |
958 | "Number of tags found in RESULT." | |
959 | (let ((count 0)) | |
960 | (mapc (lambda (onetable) | |
961 | (setq count (+ count (1- (length onetable))))) | |
962 | result) | |
963 | count)) | |
964 | ||
965 | (defun semanticdb-find-result-nth (result n) | |
966 | "In RESULT, return the Nth search result. | |
967 | This is a 0 based search result, with the first match being element 0. | |
968 | ||
969 | The returned value is a cons cell: (TAG . TABLE) where TAG | |
970 | is the tag at the Nth position. TABLE is the semanticdb table where | |
971 | the TAG was found. Sometimes TABLE can be nil." | |
972 | (let ((ans nil) | |
973 | (anstable nil)) | |
974 | ;; Loop over each single table hit. | |
975 | (while (and (not ans) result) | |
976 | ;; For each table result, get local length, and modify | |
977 | ;; N to be that much less. | |
978 | (let ((ll (length (cdr (car result))))) ;; local length | |
979 | (if (> ll n) | |
980 | ;; We have a local match. | |
981 | (setq ans (nth n (cdr (car result))) | |
982 | anstable (car (car result))) | |
983 | ;; More to go. Decrement N. | |
984 | (setq n (- n ll)))) | |
985 | ;; Keep moving. | |
986 | (setq result (cdr result))) | |
987 | (cons ans anstable))) | |
988 | ||
989 | (defun semanticdb-find-result-test (result) | |
990 | "Test RESULT by accessing all the tags in the list." | |
991 | (if (not (semanticdb-find-results-p result)) | |
992 | (error "Does not pass `semanticdb-find-results-p.\n")) | |
993 | (let ((len (semanticdb-find-result-length result)) | |
994 | (i 0)) | |
995 | (while (< i len) | |
996 | (let ((tag (semanticdb-find-result-nth result i))) | |
997 | (if (not (semantic-tag-p (car tag))) | |
998 | (error "%d entry is not a tag" i))) | |
999 | (setq i (1+ i))))) | |
1000 | ||
1001 | (defun semanticdb-find-result-nth-in-buffer (result n) | |
1002 | "In RESULT, return the Nth search result. | |
1003 | Like `semanticdb-find-result-nth', except that only the TAG | |
1004 | is returned, and the buffer it is found it will be made current. | |
1005 | If the result tag has no position information, the originating buffer | |
1006 | is still made current." | |
1007 | (let* ((ret (semanticdb-find-result-nth result n)) | |
1008 | (ans (car ret)) | |
1009 | (anstable (cdr ret))) | |
1010 | ;; If we have a hit, double-check the find-file | |
1011 | ;; entry. If the file must be loaded, then gat that table's | |
1012 | ;; source file into a buffer. | |
1013 | ||
1014 | (if anstable | |
1015 | (let ((norm (semanticdb-normalize-one-tag anstable ans))) | |
1016 | (when norm | |
1017 | ;; The normalized tags can now be found based on that | |
1018 | ;; tags table. | |
1019 | (semanticdb-set-buffer (car norm)) | |
1020 | ;; Now reset ans | |
1021 | (setq ans (cdr norm)) | |
1022 | )) | |
1023 | ) | |
1024 | ;; Return the tag. | |
1025 | ans)) | |
1026 | ||
1027 | (defun semanticdb-find-result-mapc (fcn result) | |
1028 | "Apply FCN to each element of find RESULT for side-effects only. | |
1029 | FCN takes two arguments. The first is a TAG, and the | |
1030 | second is a DB from wence TAG originated. | |
1031 | Returns result." | |
1032 | (mapc (lambda (sublst) | |
1033 | (mapc (lambda (tag) | |
1034 | (funcall fcn tag (car sublst))) | |
1035 | (cdr sublst))) | |
1036 | result) | |
1037 | result) | |
1038 | ||
1039 | ;;; Search Logging | |
1040 | ;; | |
1041 | ;; Basic logging to see what the search routines are doing. | |
1042 | (defvar semanticdb-find-log-flag nil | |
1043 | "Non-nil means log the process of searches.") | |
1044 | ||
1045 | (defvar semanticdb-find-log-buffer-name "*SemanticDB Find Log*" | |
1046 | "The name of the logging buffer.") | |
1047 | ||
1048 | (defun semanticdb-find-toggle-logging () | |
1049 | "Toggle sematnicdb logging." | |
1050 | (interactive) | |
1051 | (setq semanticdb-find-log-flag (null semanticdb-find-log-flag)) | |
1052 | (message "Semanticdb find logging is %sabled" | |
1053 | (if semanticdb-find-log-flag "en" "dis"))) | |
1054 | ||
1055 | (defun semanticdb-reset-log () | |
1056 | "Reset the log buffer." | |
1057 | (interactive) | |
1058 | (when semanticdb-find-log-flag | |
1059 | (save-excursion | |
1060 | (set-buffer (get-buffer-create semanticdb-find-log-buffer-name)) | |
1061 | (erase-buffer) | |
1062 | ))) | |
1063 | ||
1064 | (defun semanticdb-find-log-move-to-end () | |
1065 | "Move to the end of the semantic log." | |
1066 | (let ((cb (current-buffer)) | |
1067 | (cw (selected-window))) | |
1068 | (unwind-protect | |
1069 | (progn | |
1070 | (set-buffer semanticdb-find-log-buffer-name) | |
1071 | (if (get-buffer-window (current-buffer) 'visible) | |
1072 | (select-window (get-buffer-window (current-buffer) 'visible))) | |
1073 | (goto-char (point-max))) | |
1074 | (if cw (select-window cw)) | |
1075 | (set-buffer cb)))) | |
1076 | ||
1077 | (defun semanticdb-find-log-new-search (forwhat) | |
1078 | "Start a new search FORWHAT." | |
1079 | (when semanticdb-find-log-flag | |
1080 | (save-excursion | |
1081 | (set-buffer (get-buffer-create semanticdb-find-log-buffer-name)) | |
1082 | (insert (format "New Search: %S\n" forwhat)) | |
1083 | ) | |
1084 | (semanticdb-find-log-move-to-end))) | |
1085 | ||
1086 | (defun semanticdb-find-log-activity (table result) | |
1087 | "Log that TABLE has been searched and RESULT was found." | |
1088 | (when semanticdb-find-log-flag | |
1089 | (save-excursion | |
1090 | (set-buffer semanticdb-find-log-buffer-name) | |
1091 | (insert "Table: " (object-print table) | |
1092 | " Result: " (int-to-string (length result)) " tags" | |
1093 | "\n") | |
1094 | ) | |
1095 | (semanticdb-find-log-move-to-end))) | |
1096 | ||
1097 | ;;; Semanticdb find API functions | |
1bd95535 CY |
1098 | ;; These are the routines actually used to perform searches. |
1099 | ;; | |
1100 | (defun semanticdb-find-tags-collector (function &optional path find-file-match | |
1101 | brutish) | |
1102 | "Collect all tags returned by FUNCTION over PATH. | |
1103 | The FUNCTION must take two arguments. The first is TABLE, | |
1104 | which is a semanticdb table containing tags. The second argument | |
1105 | to FUNCTION is TAGS. TAGS may be a list of tags. If TAGS is non-nil, then | |
1106 | FUNCTION should search the TAG list, not through TABLE. | |
1107 | ||
1108 | See `semanticdb-find-translate-path' for details on PATH. | |
1109 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1110 | associated with that tag should be loaded into a buffer. | |
1111 | ||
1112 | Note: You should leave FIND-FILE-MATCH as nil. It is far more | |
1113 | efficient to take the results from any search and use | |
1114 | `semanticdb-strip-find-results' instead. This argument is here | |
1115 | for backward compatibility. | |
1116 | ||
1117 | If optional argument BRUTISH is non-nil, then ignore include statements, | |
1118 | and search all tables in this project tree." | |
1119 | (let (found match) | |
1120 | (save-excursion | |
1121 | ;; If path is a buffer, set ourselves up in that buffer | |
1122 | ;; so that the override methods work correctly. | |
1123 | (when (bufferp path) (set-buffer path)) | |
1124 | (if (semanticdb-find-results-p path) | |
1125 | ;; When we get find results, loop over that. | |
1126 | (dolist (tableandtags path) | |
1127 | (semantic-throw-on-input 'semantic-find-translate-path) | |
1128 | ;; If FIND-FILE-MATCH is non-nil, skip tables of class | |
1129 | ;; `semanticdb-search-results-table', since those are system | |
1130 | ;; databases and not associated with a file. | |
1131 | (unless (and find-file-match | |
1132 | (obj-of-class-p | |
1133 | (car tableandtags) semanticdb-search-results-table)) | |
1134 | (when (setq match (funcall function | |
1135 | (car tableandtags) (cdr tableandtags))) | |
1136 | (when find-file-match | |
1137 | (save-excursion (semanticdb-set-buffer (car tableandtags)))) | |
1138 | (push (cons (car tableandtags) match) found))) | |
1139 | ) | |
1140 | ;; Only log searches across data bases. | |
1141 | (semanticdb-find-log-new-search nil) | |
1142 | ;; If we get something else, scan the list of tables resulting | |
1143 | ;; from translating it into a list of objects. | |
1144 | (dolist (table (semanticdb-find-translate-path path brutish)) | |
1145 | (semantic-throw-on-input 'semantic-find-translate-path) | |
1146 | ;; If FIND-FILE-MATCH is non-nil, skip tables of class | |
1147 | ;; `semanticdb-search-results-table', since those are system | |
1148 | ;; databases and not associated with a file. | |
1149 | (unless (and find-file-match | |
1150 | (obj-of-class-p table semanticdb-search-results-table)) | |
1151 | (when (and table (setq match (funcall function table nil))) | |
1152 | (semanticdb-find-log-activity table match) | |
1153 | (when find-file-match | |
1154 | (save-excursion (semanticdb-set-buffer table))) | |
1155 | (push (cons table match) found)))))) | |
1156 | ;; At this point, FOUND has had items pushed onto it. | |
1157 | ;; This means items are being returned in REVERSE order | |
1158 | ;; of the tables searched, so if you just get th CAR, then | |
1159 | ;; too-bad, you may have some system-tag that has no | |
1160 | ;; buffer associated with it. | |
1161 | ||
1162 | ;; It must be reversed. | |
1163 | (nreverse found))) | |
1164 | ||
1165 | (defun semanticdb-find-tags-by-name (name &optional path find-file-match) | |
1166 | "Search for all tags matching NAME on PATH. | |
1167 | See `semanticdb-find-translate-path' for details on PATH. | |
1168 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1169 | associated with that tag should be loaded into a buffer." | |
1170 | (semanticdb-find-tags-collector | |
1171 | (lambda (table tags) | |
1172 | (semanticdb-find-tags-by-name-method table name tags)) | |
1173 | path find-file-match)) | |
1174 | ||
1175 | (defun semanticdb-find-tags-by-name-regexp (regexp &optional path find-file-match) | |
1176 | "Search for all tags matching REGEXP on PATH. | |
1177 | See `semanticdb-find-translate-path' for details on PATH. | |
1178 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1179 | associated with that tag should be loaded into a buffer." | |
1180 | (semanticdb-find-tags-collector | |
1181 | (lambda (table tags) | |
1182 | (semanticdb-find-tags-by-name-regexp-method table regexp tags)) | |
1183 | path find-file-match)) | |
1184 | ||
1185 | (defun semanticdb-find-tags-for-completion (prefix &optional path find-file-match) | |
1186 | "Search for all tags matching PREFIX on PATH. | |
1187 | See `semanticdb-find-translate-path' for details on PATH. | |
1188 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1189 | associated with that tag should be loaded into a buffer." | |
1190 | (semanticdb-find-tags-collector | |
1191 | (lambda (table tags) | |
1192 | (semanticdb-find-tags-for-completion-method table prefix tags)) | |
1193 | path find-file-match)) | |
1194 | ||
1195 | (defun semanticdb-find-tags-by-class (class &optional path find-file-match) | |
1196 | "Search for all tags of CLASS on PATH. | |
1197 | See `semanticdb-find-translate-path' for details on PATH. | |
1198 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1199 | associated with that tag should be loaded into a buffer." | |
1200 | (semanticdb-find-tags-collector | |
1201 | (lambda (table tags) | |
1202 | (semanticdb-find-tags-by-class-method table class tags)) | |
1203 | path find-file-match)) | |
1204 | ||
1205 | ;;; Deep Searches | |
1206 | (defun semanticdb-deep-find-tags-by-name (name &optional path find-file-match) | |
1207 | "Search for all tags matching NAME on PATH. | |
1208 | Search also in all components of top level tags founds. | |
1209 | See `semanticdb-find-translate-path' for details on PATH. | |
1210 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1211 | associated with that tag should be loaded into a buffer." | |
1212 | (semanticdb-find-tags-collector | |
1213 | (lambda (table tags) | |
1214 | (semanticdb-deep-find-tags-by-name-method table name tags)) | |
1215 | path find-file-match)) | |
1216 | ||
1217 | (defun semanticdb-deep-find-tags-by-name-regexp (regexp &optional path find-file-match) | |
1218 | "Search for all tags matching REGEXP on PATH. | |
1219 | Search also in all components of top level tags founds. | |
1220 | See `semanticdb-find-translate-path' for details on PATH. | |
1221 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1222 | associated with that tag should be loaded into a buffer." | |
1223 | (semanticdb-find-tags-collector | |
1224 | (lambda (table tags) | |
1225 | (semanticdb-deep-find-tags-by-name-regexp-method table regexp tags)) | |
1226 | path find-file-match)) | |
1227 | ||
1228 | (defun semanticdb-deep-find-tags-for-completion (prefix &optional path find-file-match) | |
1229 | "Search for all tags matching PREFIX on PATH. | |
1230 | Search also in all components of top level tags founds. | |
1231 | See `semanticdb-find-translate-path' for details on PATH. | |
1232 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1233 | associated with that tag should be loaded into a buffer." | |
1234 | (semanticdb-find-tags-collector | |
1235 | (lambda (table tags) | |
1236 | (semanticdb-deep-find-tags-for-completion-method table prefix tags)) | |
1237 | path find-file-match)) | |
1238 | ||
1239 | ;;; Brutish Search Routines | |
1240 | (defun semanticdb-brute-deep-find-tags-by-name (name &optional path find-file-match) | |
1241 | "Search for all tags matching NAME on PATH. | |
1242 | See `semanticdb-find-translate-path' for details on PATH. | |
1243 | The argument BRUTISH will be set so that searching includes all tables | |
1244 | in the current project. | |
1245 | FIND-FILE-MATCH indicates that any time a matchi is found, the file | |
1246 | associated wit that tag should be loaded into a buffer." | |
1247 | (semanticdb-find-tags-collector | |
1248 | (lambda (table tags) | |
1249 | (semanticdb-deep-find-tags-by-name-method table name tags)) | |
1250 | path find-file-match t)) | |
1251 | ||
1252 | (defun semanticdb-brute-deep-find-tags-for-completion (prefix &optional path find-file-match) | |
1253 | "Search for all tags matching PREFIX on PATH. | |
1254 | See `semanticdb-find-translate-path' for details on PATH. | |
1255 | The argument BRUTISH will be set so that searching includes all tables | |
1256 | in the current project. | |
1257 | FIND-FILE-MATCH indicates that any time a matchi is found, the file | |
1258 | associated wit that tag should be loaded into a buffer." | |
1259 | (semanticdb-find-tags-collector | |
1260 | (lambda (table tags) | |
1261 | (semanticdb-deep-find-tags-for-completion-method table prefix tags)) | |
1262 | path find-file-match t)) | |
1263 | ||
1264 | (defun semanticdb-brute-find-tags-by-class (class &optional path find-file-match) | |
1265 | "Search for all tags of CLASS on PATH. | |
1266 | See `semanticdb-find-translate-path' for details on PATH. | |
1267 | The argument BRUTISH will be set so that searching includes all tables | |
1268 | in the current project. | |
1269 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1270 | associated with that tag should be loaded into a buffer." | |
1271 | (semanticdb-find-tags-collector | |
1272 | (lambda (table tags) | |
1273 | (semanticdb-find-tags-by-class-method table class tags)) | |
1274 | path find-file-match t)) | |
1275 | ||
1276 | ;;; Specialty Search Routines | |
1277 | (defun semanticdb-find-tags-external-children-of-type | |
1278 | (type &optional path find-file-match) | |
1279 | "Search for all tags defined outside of TYPE w/ TYPE as a parent. | |
1280 | See `semanticdb-find-translate-path' for details on PATH. | |
1281 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1282 | associated with that tag should be loaded into a buffer." | |
1283 | (semanticdb-find-tags-collector | |
1284 | (lambda (table tags) | |
1285 | (semanticdb-find-tags-external-children-of-type-method table type tags)) | |
1286 | path find-file-match)) | |
1287 | ||
1288 | (defun semanticdb-find-tags-subclasses-of-type | |
1289 | (type &optional path find-file-match) | |
1290 | "Search for all tags of class type defined that subclass TYPE. | |
1291 | See `semanticdb-find-translate-path' for details on PATH. | |
1292 | FIND-FILE-MATCH indicates that any time a match is found, the file | |
1293 | associated with that tag should be loaded into a buffer." | |
1294 | (semanticdb-find-tags-collector | |
1295 | (lambda (table tags) | |
1296 | (semanticdb-find-tags-subclasses-of-type-method table type tags)) | |
1297 | path find-file-match t)) | |
1298 | \f | |
1299 | ;;; METHODS | |
1300 | ;; | |
1301 | ;; Default methods for semanticdb database and table objects. | |
1302 | ;; Override these with system databases to as new types of back ends. | |
1303 | ||
1304 | ;;; Top level Searches | |
1305 | (defmethod semanticdb-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags) | |
1306 | "In TABLE, find all occurances of tags with NAME. | |
1307 | Optional argument TAGS is a list of tags to search. | |
1308 | Returns a table of all matching tags." | |
1309 | (semantic-find-tags-by-name name (or tags (semanticdb-get-tags table)))) | |
1310 | ||
1311 | (defmethod semanticdb-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags) | |
1312 | "In TABLE, find all occurances of tags matching REGEXP. | |
1313 | Optional argument TAGS is a list of tags to search. | |
1314 | Returns a table of all matching tags." | |
1315 | (semantic-find-tags-by-name-regexp regexp (or tags (semanticdb-get-tags table)))) | |
1316 | ||
1317 | (defmethod semanticdb-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags) | |
1318 | "In TABLE, find all occurances of tags matching PREFIX. | |
1319 | Optional argument TAGS is a list of tags to search. | |
1320 | Returns a table of all matching tags." | |
1321 | (semantic-find-tags-for-completion prefix (or tags (semanticdb-get-tags table)))) | |
1322 | ||
1323 | (defmethod semanticdb-find-tags-by-class-method ((table semanticdb-abstract-table) class &optional tags) | |
1324 | "In TABLE, find all occurances of tags of CLASS. | |
1325 | Optional argument TAGS is a list of tags to search. | |
1326 | Returns a table of all matching tags." | |
1327 | (semantic-find-tags-by-class class (or tags (semanticdb-get-tags table)))) | |
1328 | ||
1329 | (defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags) | |
1330 | "In TABLE, find all occurances of tags whose parent is the PARENT type. | |
1331 | Optional argument TAGS is a list of tags to search. | |
1332 | Returns a table of all matching tags." | |
1333 | (semantic-find-tags-external-children-of-type parent (or tags (semanticdb-get-tags table)))) | |
1334 | ||
1335 | (defmethod semanticdb-find-tags-subclasses-of-type-method ((table semanticdb-abstract-table) parent &optional tags) | |
1336 | "In TABLE, find all occurances of tags whose parent is the PARENT type. | |
1337 | Optional argument TAGS is a list of tags to search. | |
1338 | Returns a table of all matching tags." | |
1339 | (semantic-find-tags-subclasses-of-type parent (or tags (semanticdb-get-tags table)))) | |
1340 | ||
1341 | ;;; Deep Searches | |
1342 | (defmethod semanticdb-deep-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags) | |
1343 | "In TABLE, find all occurances of tags with NAME. | |
1344 | Search in all tags in TABLE, and all components of top level tags in | |
1345 | TABLE. | |
1346 | Optional argument TAGS is a list of tags to search. | |
1347 | Return a table of all matching tags." | |
1348 | (semantic-find-tags-by-name name (semantic-flatten-tags-table (or tags (semanticdb-get-tags table))))) | |
1349 | ||
1350 | (defmethod semanticdb-deep-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags) | |
1351 | "In TABLE, find all occurances of tags matching REGEXP. | |
1352 | Search in all tags in TABLE, and all components of top level tags in | |
1353 | TABLE. | |
1354 | Optional argument TAGS is a list of tags to search. | |
1355 | Return a table of all matching tags." | |
1356 | (semantic-find-tags-by-name-regexp regexp (semantic-flatten-tags-table (or tags (semanticdb-get-tags table))))) | |
1357 | ||
1358 | (defmethod semanticdb-deep-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags) | |
1359 | "In TABLE, find all occurances of tags matching PREFIX. | |
1360 | Search in all tags in TABLE, and all components of top level tags in | |
1361 | TABLE. | |
1362 | Optional argument TAGS is a list of tags to search. | |
1363 | Return a table of all matching tags." | |
1364 | (semantic-find-tags-for-completion prefix (semantic-flatten-tags-table (or tags (semanticdb-get-tags table))))) | |
1365 | ||
1366 | (provide 'semantic/db-find) | |
1367 | ||
aa8724ae | 1368 | ;;; semantic/db-find.el ends here |