]> code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/find.el
Update copyright notices for 2013.
[gnu-emacs] / lisp / cedet / semantic / find.el
1 ;;; semantic/find.el --- Search routines for Semantic
2
3 ;; Copyright (C) 1999-2005, 2008-2013 Free Software Foundation, Inc.
4
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
6 ;; Keywords: syntax
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24 ;;
25 ;; Routines for searching through lists of tags.
26 ;; There are several groups of tag search routines:
27 ;;
28 ;; 1) semantic-brute-find-tag-by-*
29 ;; These routines use brute force hierarchical search to scan
30 ;; through lists of tags. They include some parameters
31 ;; used for compatibility with the semantic 1.x search routines.
32 ;;
33 ;; 1.5) semantic-brute-find-first-tag-by-*
34 ;; Like 1, except searching stops on the first match for the given
35 ;; information.
36 ;;
37 ;; 2) semantic-find-tag-by-*
38 ;; These preferred search routines attempt to scan through lists
39 ;; in an intelligent way based on questions asked.
40 ;;
41 ;; 3) semantic-find-*-overlay
42 ;; These routines use overlays to return tags based on a buffer position.
43 ;;
44 ;; 4) ...
45
46 ;;; Code:
47
48 (require 'semantic)
49 (require 'semantic/tag)
50
51 (declare-function semantic-tag-protected-p "semantic/tag-ls")
52 (declare-function semantic-tag-package-protected-p "semantic/tag-ls")
53
54 ;;; Overlay Search Routines
55 ;;
56 ;; These routines provide fast access to tokens based on a buffer that
57 ;; has parsed tokens in it. Uses overlays to perform the hard work.
58 ;;
59 ;;;###autoload
60 (defun semantic-find-tag-by-overlay (&optional positionormarker buffer)
61 "Find all tags covering POSITIONORMARKER by using overlays.
62 If POSITIONORMARKER is nil, use the current point.
63 Optional BUFFER is used if POSITIONORMARKER is a number, otherwise the current
64 buffer is used. This finds all tags covering the specified position
65 by checking for all overlays covering the current spot. They are then sorted
66 from largest to smallest via the start location."
67 (save-excursion
68 (when positionormarker
69 (if (markerp positionormarker)
70 (set-buffer (marker-buffer positionormarker))
71 (if (bufferp buffer)
72 (set-buffer buffer))))
73 (let ((ol (semantic-overlays-at (or positionormarker (point))))
74 (ret nil))
75 (while ol
76 (let ((tmp (semantic-overlay-get (car ol) 'semantic)))
77 (when (and tmp
78 ;; We don't need with-position because no tag w/out
79 ;; a position could exist in an overlay.
80 (semantic-tag-p tmp))
81 (setq ret (cons tmp ret))))
82 (setq ol (cdr ol)))
83 (sort ret (lambda (a b) (< (semantic-tag-start a)
84 (semantic-tag-start b)))))))
85
86 ;;;###autoload
87 (defun semantic-find-tag-by-overlay-in-region (start end &optional buffer)
88 "Find all tags which exist in whole or in part between START and END.
89 Uses overlays to determine position.
90 Optional BUFFER argument specifies the buffer to use."
91 (save-excursion
92 (if buffer (set-buffer buffer))
93 (let ((ol (semantic-overlays-in start end))
94 (ret nil))
95 (while ol
96 (let ((tmp (semantic-overlay-get (car ol) 'semantic)))
97 (when (and tmp
98 ;; See above about position
99 (semantic-tag-p tmp))
100 (setq ret (cons tmp ret))))
101 (setq ol (cdr ol)))
102 (sort ret (lambda (a b) (< (semantic-tag-start a)
103 (semantic-tag-start b)))))))
104
105 ;;;###autoload
106 (defun semantic-find-tag-by-overlay-next (&optional start buffer)
107 "Find the next tag after START in BUFFER.
108 If START is in an overlay, find the tag which starts next,
109 not the current tag."
110 (save-excursion
111 (if buffer (set-buffer buffer))
112 (if (not start) (setq start (point)))
113 (let ((os start) (ol nil))
114 (while (and os (< os (point-max)) (not ol))
115 (setq os (semantic-overlay-next-change os))
116 (when os
117 ;; Get overlays at position
118 (setq ol (semantic-overlays-at os))
119 ;; find the overlay that belongs to semantic
120 ;; and starts at the found position.
121 (while (and ol (listp ol))
122 (if (and (semantic-overlay-get (car ol) 'semantic)
123 (semantic-tag-p
124 (semantic-overlay-get (car ol) 'semantic))
125 (= (semantic-overlay-start (car ol)) os))
126 (setq ol (car ol)))
127 (when (listp ol) (setq ol (cdr ol))))))
128 ;; convert ol to a tag
129 (when (and ol (semantic-tag-p (semantic-overlay-get ol 'semantic)))
130 (semantic-overlay-get ol 'semantic)))))
131
132 ;;;###autoload
133 (defun semantic-find-tag-by-overlay-prev (&optional start buffer)
134 "Find the next tag before START in BUFFER.
135 If START is in an overlay, find the tag which starts next,
136 not the current tag."
137 (save-excursion
138 (if buffer (set-buffer buffer))
139 (if (not start) (setq start (point)))
140 (let ((os start) (ol nil))
141 (while (and os (> os (point-min)) (not ol))
142 (setq os (semantic-overlay-previous-change os))
143 (when os
144 ;; Get overlays at position
145 (setq ol (semantic-overlays-at (1- os)))
146 ;; find the overlay that belongs to semantic
147 ;; and ENDS at the found position.
148 ;;
149 ;; Use end because we are going backward.
150 (while (and ol (listp ol))
151 (if (and (semantic-overlay-get (car ol) 'semantic)
152 (semantic-tag-p
153 (semantic-overlay-get (car ol) 'semantic))
154 (= (semantic-overlay-end (car ol)) os))
155 (setq ol (car ol)))
156 (when (listp ol) (setq ol (cdr ol))))))
157 ;; convert ol to a tag
158 (when (and ol
159 (semantic-tag-p (semantic-overlay-get ol 'semantic)))
160 (semantic-overlay-get ol 'semantic)))))
161
162 ;;;###autoload
163 (defun semantic-find-tag-parent-by-overlay (tag)
164 "Find the parent of TAG by overlays.
165 Overlays are a fast way of finding this information for active buffers."
166 (let ((tag (nreverse (semantic-find-tag-by-overlay
167 (semantic-tag-start tag)))))
168 ;; This is a lot like `semantic-current-tag-parent', but
169 ;; it uses a position to do it's work. Assumes two tags don't share
170 ;; the same start unless they are siblings.
171 (car (cdr tag))))
172
173 ;;;###autoload
174 (defun semantic-current-tag ()
175 "Return the current tag in the current buffer.
176 If there are more than one in the same location, return the
177 smallest tag. Return nil if there is no tag here."
178 (car (nreverse (semantic-find-tag-by-overlay))))
179
180 ;;;###autoload
181 (defun semantic-current-tag-parent ()
182 "Return the current tags parent in the current buffer.
183 A tag's parent would be a containing structure, such as a type
184 containing a field. Return nil if there is no parent."
185 (car (cdr (nreverse (semantic-find-tag-by-overlay)))))
186
187 (defun semantic-current-tag-of-class (class)
188 "Return the current (smallest) tags of CLASS in the current buffer.
189 If the smallest tag is not of type CLASS, keep going upwards until one
190 is found.
191 Uses `semantic-tag-class' for classification."
192 (let ((tags (nreverse (semantic-find-tag-by-overlay))))
193 (while (and tags
194 (not (eq (semantic-tag-class (car tags)) class)))
195 (setq tags (cdr tags)))
196 (car tags)))
197 \f
198 ;;; Search Routines
199 ;;
200 ;; These are routines that search a single tags table.
201 ;;
202 ;; The original API (see COMPATIBILITY section below) in semantic 1.4
203 ;; had these usage statistics:
204 ;;
205 ;; semantic-find-nonterminal-by-name 17
206 ;; semantic-find-nonterminal-by-name-regexp 8 - Most doing completion
207 ;; semantic-find-nonterminal-by-position 13
208 ;; semantic-find-nonterminal-by-token 21
209 ;; semantic-find-nonterminal-by-type 2
210 ;; semantic-find-nonterminal-standard 1
211 ;;
212 ;; semantic-find-nonterminal-by-function (not in other searches) 1
213 ;;
214 ;; New API: As above w/out `search-parts' or `search-includes' arguments.
215 ;; Extra fcn: Specific to completion which is what -name-regexp is
216 ;; mostly used for
217 ;;
218 ;; As for the sarguments "search-parts" and "search-includes" here
219 ;; are stats:
220 ;;
221 ;; search-parts: 4 - charting x2, find-doc, senator (sans db)
222 ;;
223 ;; Implement command to flatten a tag table. Call new API Fcn w/
224 ;; flattened table for same results.
225 ;;
226 ;; search-include: 2 - analyze x2 (sans db)
227 ;;
228 ;; Not used effectively. Not to be re-implemented here.
229
230 (defsubst semantic--find-tags-by-function (predicate &optional table)
231 "Find tags for which PREDICATE is non-nil in TABLE.
232 PREDICATE is a lambda expression which accepts on TAG.
233 TABLE is a semantic tags table. See `semantic-something-to-tag-table'."
234 (let ((tags (semantic-something-to-tag-table table))
235 (result nil))
236 ; (mapc (lambda (tag) (and (funcall predicate tag)
237 ; (setq result (cons tag result))))
238 ; tags)
239 ;; A while loop is actually faster. Who knew
240 (while tags
241 (and (funcall predicate (car tags))
242 (setq result (cons (car tags) result)))
243 (setq tags (cdr tags)))
244 (nreverse result)))
245
246 ;; I can shave off some time by removing the funcall (see above)
247 ;; and having the question be inlined in the while loop.
248 ;; Strangely turning the upper level fcns into macros had a larger
249 ;; impact.
250 (defmacro semantic--find-tags-by-macro (form &optional table)
251 "Find tags for which FORM is non-nil in TABLE.
252 TABLE is a semantic tags table. See `semantic-something-to-tag-table'."
253 `(let ((tags (semantic-something-to-tag-table ,table))
254 (result nil))
255 (while tags
256 (and ,form
257 (setq result (cons (car tags) result)))
258 (setq tags (cdr tags)))
259 (nreverse result)))
260
261 ;;; Top level Searches
262 ;;
263 ;;;###autoload
264 (defun semantic-find-first-tag-by-name (name &optional table)
265 "Find the first tag with NAME in TABLE.
266 NAME is a string.
267 TABLE is a semantic tags table. See `semantic-something-to-tag-table'.
268 This routine uses `assoc' to quickly find the first matching entry."
269 (funcall (if semantic-case-fold 'assoc-ignore-case 'assoc)
270 name (semantic-something-to-tag-table table)))
271
272 (defmacro semantic-find-tags-by-name (name &optional table)
273 "Find all tags with NAME in TABLE.
274 NAME is a string.
275 TABLE is a tag table. See `semantic-something-to-tag-table'."
276 `(let ((case-fold-search semantic-case-fold))
277 (semantic--find-tags-by-macro
278 (string= ,name (semantic-tag-name (car tags)))
279 ,table)))
280
281 (defmacro semantic-find-tags-for-completion (prefix &optional table)
282 "Find all tags whose name begins with PREFIX in TABLE.
283 PREFIX is a string.
284 TABLE is a tag table. See `semantic-something-to-tag-table'.
285 While it would be nice to use `try-completion' or `all-completions',
286 those functions do not return the tags, only a string.
287 Uses `compare-strings' for fast comparison."
288 `(let ((l (length ,prefix)))
289 (semantic--find-tags-by-macro
290 (eq (compare-strings ,prefix 0 nil
291 (semantic-tag-name (car tags)) 0 l
292 semantic-case-fold)
293 t)
294 ,table)))
295
296 (defmacro semantic-find-tags-by-name-regexp (regexp &optional table)
297 "Find all tags with name matching REGEXP in TABLE.
298 REGEXP is a string containing a regular expression,
299 TABLE is a tag table. See `semantic-something-to-tag-table'.
300 Consider using `semantic-find-tags-for-completion' if you are
301 attempting to do completions."
302 `(let ((case-fold-search semantic-case-fold))
303 (semantic--find-tags-by-macro
304 (string-match ,regexp (semantic-tag-name (car tags)))
305 ,table)))
306
307 (defmacro semantic-find-tags-by-class (class &optional table)
308 "Find all tags of class CLASS in TABLE.
309 CLASS is a symbol representing the class of the token, such as
310 'variable, of 'function..
311 TABLE is a tag table. See `semantic-something-to-tag-table'."
312 `(semantic--find-tags-by-macro
313 (eq ,class (semantic-tag-class (car tags)))
314 ,table))
315
316 (defmacro semantic-find-tags-by-type (type &optional table)
317 "Find all tags of with a type TYPE in TABLE.
318 TYPE is a string or tag representing a data type as defined in the
319 language the tags were parsed from, such as \"int\", or perhaps
320 a tag whose name is that of a struct or class.
321 TABLE is a tag table. See `semantic-something-to-tag-table'."
322 `(semantic--find-tags-by-macro
323 (semantic-tag-of-type-p (car tags) ,type)
324 ,table))
325
326 (defmacro semantic-find-tags-of-compound-type (&optional table)
327 "Find all tags which are a compound type in TABLE.
328 Compound types are structures, or other data type which
329 is not of a primitive nature, such as int or double.
330 Used in completion."
331 `(semantic--find-tags-by-macro
332 (semantic-tag-type-compound-p (car tags))
333 ,table))
334
335 ;;;###autoload
336 (define-overloadable-function semantic-find-tags-by-scope-protection (scopeprotection parent &optional table)
337 "Find all tags accessible by SCOPEPROTECTION.
338 SCOPEPROTECTION is a symbol which can be returned by the method
339 `semantic-tag-protection'. A hard-coded order is used to determine a match.
340 PARENT is a tag representing the PARENT slot needed for
341 `semantic-tag-protection'.
342 TABLE is a list of tags (a subset of PARENT members) to scan. If TABLE is nil,
343 the type members of PARENT are used.
344 See `semantic-tag-protected-p' for details on which tags are returned."
345 (if (not (eq (semantic-tag-class parent) 'type))
346 (signal 'wrong-type-argument '(semantic-find-tags-by-scope-protection
347 parent
348 semantic-tag-class type))
349 (:override)))
350
351 (defun semantic-find-tags-by-scope-protection-default
352 (scopeprotection parent &optional table)
353 "Find all tags accessible by SCOPEPROTECTION.
354 SCOPEPROTECTION is a symbol which can be returned by the method
355 `semantic-tag-protection'. A hard-coded order is used to determine a match.
356 PARENT is a tag representing the PARENT slot needed for
357 `semantic-tag-protection'.
358 TABLE is a list of tags (a subset of PARENT members) to scan. If TABLE is nil,
359 the type members of PARENT are used.
360 See `semantic-tag-protected-p' for details on which tags are returned."
361 (if (not table) (setq table (semantic-tag-type-members parent)))
362 (if (null scopeprotection)
363 table
364 (require 'semantic/tag-ls)
365 (semantic--find-tags-by-macro
366 (not (and (semantic-tag-protected-p (car tags) scopeprotection parent)
367 (semantic-tag-package-protected-p (car tags) parent)))
368 table)))
369
370 ;;;###autoload
371 (define-overloadable-function semantic-find-tags-included (&optional table)
372 "Find all tags in TABLE that are of the 'include class.
373 TABLE is a tag table. See `semantic-something-to-tag-table'.")
374
375 (defun semantic-find-tags-included-default (&optional table)
376 "Find all tags in TABLE that are of the 'include class.
377 TABLE is a tag table. See `semantic-something-to-tag-table'.
378 By default, just call `semantic-find-tags-by-class'."
379 (semantic-find-tags-by-class 'include table))
380
381 ;;; Deep Searches
382
383 (defmacro semantic-deep-find-tags-by-name (name &optional table)
384 "Find all tags with NAME in TABLE.
385 Search in top level tags, and their components, in TABLE.
386 NAME is a string.
387 TABLE is a tag table. See `semantic-flatten-tags-table'.
388 See also `semantic-find-tags-by-name'."
389 `(semantic-find-tags-by-name
390 ,name (semantic-flatten-tags-table ,table)))
391
392 (defmacro semantic-deep-find-tags-for-completion (prefix &optional table)
393 "Find all tags whose name begins with PREFIX in TABLE.
394 Search in top level tags, and their components, in TABLE.
395 TABLE is a tag table. See `semantic-flatten-tags-table'.
396 See also `semantic-find-tags-for-completion'."
397 `(semantic-find-tags-for-completion
398 ,prefix (semantic-flatten-tags-table ,table)))
399
400 (defmacro semantic-deep-find-tags-by-name-regexp (regexp &optional table)
401 "Find all tags with name matching REGEXP in TABLE.
402 Search in top level tags, and their components, in TABLE.
403 REGEXP is a string containing a regular expression,
404 TABLE is a tag table. See `semantic-flatten-tags-table'.
405 See also `semantic-find-tags-by-name-regexp'.
406 Consider using `semantic-deep-find-tags-for-completion' if you are
407 attempting to do completions."
408 `(semantic-find-tags-by-name-regexp
409 ,regexp (semantic-flatten-tags-table ,table)))
410
411 ;;; Specialty Searches
412
413 (defun semantic-find-tags-external-children-of-type (type &optional table)
414 "Find all tags in whose parent is TYPE in TABLE.
415 These tags are defined outside the scope of the original TYPE declaration.
416 TABLE is a tag table. See `semantic-something-to-tag-table'."
417 (semantic--find-tags-by-macro
418 (equal (semantic-tag-external-member-parent (car tags))
419 type)
420 table))
421
422 (defun semantic-find-tags-subclasses-of-type (type &optional table)
423 "Find all tags of class type in whose parent is TYPE in TABLE.
424 These tags are defined outside the scope of the original TYPE declaration.
425 TABLE is a tag table. See `semantic-something-to-tag-table'."
426 (semantic--find-tags-by-macro
427 (and (eq (semantic-tag-class (car tags)) 'type)
428 (or (member type (semantic-tag-type-superclasses (car tags)))
429 (member type (semantic-tag-type-interfaces (car tags)))))
430 table))
431 \f
432 ;;
433 ;; ************************** Compatibility ***************************
434 ;;
435
436 ;;; Old Style Brute Force Search Routines
437 ;;
438 ;; These functions will search through tags lists explicitly for
439 ;; desired information.
440
441 ;; The -by-name nonterminal search can use the built in fcn
442 ;; `assoc', which is faster than looping ourselves, so we will
443 ;; not use `semantic-brute-find-tag-by-function' to do this,
444 ;; instead erroring on the side of speed.
445
446 (defun semantic-brute-find-first-tag-by-name
447 (name streamorbuffer &optional search-parts search-include)
448 "Find a tag NAME within STREAMORBUFFER. NAME is a string.
449 If SEARCH-PARTS is non-nil, search children of tags.
450 If SEARCH-INCLUDE was never implemented.
451
452 Use `semantic-find-first-tag-by-name' instead."
453 (let* ((stream (semantic-something-to-tag-table streamorbuffer))
454 (assoc-fun (if semantic-case-fold
455 #'assoc-ignore-case
456 #'assoc))
457 (m (funcall assoc-fun name stream)))
458 (if m
459 m
460 (let ((toklst stream)
461 (children nil))
462 (while (and (not m) toklst)
463 (if search-parts
464 (progn
465 (setq children (semantic-tag-components-with-overlays
466 (car toklst)))
467 (if children
468 (setq m (semantic-brute-find-first-tag-by-name
469 name children search-parts search-include)))))
470 (setq toklst (cdr toklst)))
471 (if (not m)
472 ;; Go to dependencies, and search there.
473 nil)
474 m))))
475
476 (defmacro semantic-brute-find-tag-by-class
477 (class streamorbuffer &optional search-parts search-includes)
478 "Find all tags with a class CLASS within STREAMORBUFFER.
479 CLASS is a symbol representing the class of the tags to find.
480 See `semantic-tag-class'.
481 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
482 `semantic-brute-find-tag-by-function'.
483
484 Use `semantic-find-tag-by-class' instead."
485 `(semantic-brute-find-tag-by-function
486 (lambda (tag) (eq ,class (semantic-tag-class tag)))
487 ,streamorbuffer ,search-parts ,search-includes))
488
489 (defmacro semantic-brute-find-tag-standard
490 (streamorbuffer &optional search-parts search-includes)
491 "Find all tags in STREAMORBUFFER which define simple class types.
492 See `semantic-tag-class'.
493 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
494 `semantic-brute-find-tag-by-function'."
495 `(semantic-brute-find-tag-by-function
496 (lambda (tag) (member (semantic-tag-class tag)
497 '(function variable type)))
498 ,streamorbuffer ,search-parts ,search-includes))
499
500 (defun semantic-brute-find-tag-by-type
501 (type streamorbuffer &optional search-parts search-includes)
502 "Find all tags with type TYPE within STREAMORBUFFER.
503 TYPE is a string which is the name of the type of the tags returned.
504 See `semantic-tag-type'.
505 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
506 `semantic-brute-find-tag-by-function'."
507 (semantic-brute-find-tag-by-function
508 (lambda (tag)
509 (let ((ts (semantic-tag-type tag)))
510 (if (and (listp ts)
511 (or (= (length ts) 1)
512 (eq (semantic-tag-class ts) 'type)))
513 (setq ts (semantic-tag-name ts)))
514 (equal type ts)))
515 streamorbuffer search-parts search-includes))
516
517 (defun semantic-brute-find-tag-by-type-regexp
518 (regexp streamorbuffer &optional search-parts search-includes)
519 "Find all tags with type matching REGEXP within STREAMORBUFFER.
520 REGEXP is a regular expression which matches the name of the type of the
521 tags returned. See `semantic-tag-type'.
522 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
523 `semantic-brute-find-tag-by-function'."
524 (semantic-brute-find-tag-by-function
525 (lambda (tag)
526 (let ((ts (semantic-tag-type tag)))
527 (if (listp ts)
528 (setq ts
529 (if (eq (semantic-tag-class ts) 'type)
530 (semantic-tag-name ts)
531 (car ts))))
532 (and ts (string-match regexp ts))))
533 streamorbuffer search-parts search-includes))
534
535 (defun semantic-brute-find-tag-by-name-regexp
536 (regex streamorbuffer &optional search-parts search-includes)
537 "Find all tags whose name match REGEX in STREAMORBUFFER.
538 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
539 `semantic-brute-find-tag-by-function'."
540 (semantic-brute-find-tag-by-function
541 (lambda (tag) (string-match regex (semantic-tag-name tag)))
542 streamorbuffer search-parts search-includes)
543 )
544
545 (defun semantic-brute-find-tag-by-property
546 (property value streamorbuffer &optional search-parts search-includes)
547 "Find all tags with PROPERTY equal to VALUE in STREAMORBUFFER.
548 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
549 `semantic-brute-find-tag-by-function'."
550 (semantic-brute-find-tag-by-function
551 (lambda (tag) (equal (semantic--tag-get-property tag property) value))
552 streamorbuffer search-parts search-includes)
553 )
554
555 (defun semantic-brute-find-tag-by-attribute
556 (attr streamorbuffer &optional search-parts search-includes)
557 "Find all tags with a given ATTR in STREAMORBUFFER.
558 ATTR is a symbol key into the attributes list.
559 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
560 `semantic-brute-find-tag-by-function'."
561 (semantic-brute-find-tag-by-function
562 (lambda (tag) (semantic-tag-get-attribute tag attr))
563 streamorbuffer search-parts search-includes)
564 )
565
566 (defun semantic-brute-find-tag-by-attribute-value
567 (attr value streamorbuffer &optional search-parts search-includes)
568 "Find all tags with a given ATTR equal to VALUE in STREAMORBUFFER.
569 ATTR is a symbol key into the attributes list.
570 VALUE is the value that ATTR should match.
571 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
572 `semantic-brute-find-tag-by-function'."
573 (semantic-brute-find-tag-by-function
574 (lambda (tag) (equal (semantic-tag-get-attribute tag attr) value))
575 streamorbuffer search-parts search-includes)
576 )
577
578 (defun semantic-brute-find-tag-by-function
579 (function streamorbuffer &optional search-parts search-includes)
580 "Find all tags for which FUNCTION's value is non-nil within STREAMORBUFFER.
581 FUNCTION must return non-nil if an element of STREAM will be included
582 in the new list.
583
584 If optional argument SEARCH-PARTS is non-nil, all sub-parts of tags
585 are searched. The overloadable function `semantic-tag-components' is
586 used for the searching child lists. If SEARCH-PARTS is the symbol
587 'positiononly, then only children that have positional information are
588 searched.
589
590 If SEARCH-INCLUDES has not been implemented.
591 This parameter hasn't be active for a while and is obsolete."
592 (let ((stream (semantic-something-to-tag-table streamorbuffer))
593 (sl nil) ;list of tag children
594 (nl nil) ;new list
595 (case-fold-search semantic-case-fold))
596 (dolist (tag stream)
597 (if (not (semantic-tag-p tag))
598 ;; `semantic-tag-components-with-overlays' can return invalid
599 ;; tags if search-parts is not equal to 'positiononly
600 nil ;; Ignore them!
601 (if (funcall function tag)
602 (setq nl (cons tag nl)))
603 (and search-parts
604 (setq sl (if (eq search-parts 'positiononly)
605 (semantic-tag-components-with-overlays tag)
606 (semantic-tag-components tag))
607 )
608 (setq nl (nconc nl
609 (semantic-brute-find-tag-by-function
610 function sl
611 search-parts))))))
612 (setq nl (nreverse nl))
613 nl))
614
615 (defun semantic-brute-find-first-tag-by-function
616 (function streamorbuffer &optional search-parts search-includes)
617 "Find the first tag which FUNCTION match within STREAMORBUFFER.
618 FUNCTION must return non-nil if an element of STREAM will be included
619 in the new list.
620
621 The following parameters were never implemented.
622
623 If optional argument SEARCH-PARTS, all sub-parts of tags are searched.
624 The overloadable function `semantic-tag-components' is used for
625 searching.
626 If SEARCH-INCLUDES is non-nil, then all include files are also
627 searched for matches."
628 (let ((stream (semantic-something-to-tag-table streamorbuffer))
629 (found nil)
630 (case-fold-search semantic-case-fold))
631 (while (and (not found) stream)
632 (if (funcall function (car stream))
633 (setq found (car stream)))
634 (setq stream (cdr stream)))
635 found))
636
637
638 ;;; Old Positional Searches
639 ;;
640 ;; Are these useful anymore?
641 ;;
642 (defun semantic-brute-find-tag-by-position (position streamorbuffer
643 &optional nomedian)
644 "Find a tag covering POSITION within STREAMORBUFFER.
645 POSITION is a number, or marker. If NOMEDIAN is non-nil, don't do
646 the median calculation, and return nil."
647 (save-excursion
648 (if (markerp position) (set-buffer (marker-buffer position)))
649 (let* ((stream (if (bufferp streamorbuffer)
650 (with-current-buffer streamorbuffer
651 (semantic-fetch-tags))
652 streamorbuffer))
653 (prev nil)
654 (found nil))
655 (while (and stream (not found))
656 ;; perfect fit
657 (if (and (>= position (semantic-tag-start (car stream)))
658 (<= position (semantic-tag-end (car stream))))
659 (setq found (car stream))
660 ;; Median between to objects.
661 (if (and prev (not nomedian)
662 (>= position (semantic-tag-end prev))
663 (<= position (semantic-tag-start (car stream))))
664 (let ((median (/ (+ (semantic-tag-end prev)
665 (semantic-tag-start (car stream)))
666 2)))
667 (setq found
668 (if (> position median)
669 (car stream)
670 prev)))))
671 ;; Next!!!
672 (setq prev (car stream)
673 stream (cdr stream)))
674 found)))
675
676 (defun semantic-brute-find-innermost-tag-by-position
677 (position streamorbuffer &optional nomedian)
678 "Find a list of tags covering POSITION within STREAMORBUFFER.
679 POSITION is a number, or marker. If NOMEDIAN is non-nil, don't do
680 the median calculation, and return nil.
681 This function will find the topmost item, and recurse until no more
682 details are available of findable."
683 (let* ((returnme nil)
684 (current (semantic-brute-find-tag-by-position
685 position streamorbuffer nomedian))
686 (nextstream (and current
687 (if (eq (semantic-tag-class current) 'type)
688 (semantic-tag-type-members current)
689 nil))))
690 (while nextstream
691 (setq returnme (cons current returnme))
692 (setq current (semantic-brute-find-tag-by-position
693 position nextstream nomedian))
694 (setq nextstream (and current
695 ;; NOTE TO SELF:
696 ;; Looking at this after several years away,
697 ;; what does this do???
698 (if (eq (semantic-tag-class current) 'token)
699 (semantic-tag-type-members current)
700 nil))))
701 (nreverse (cons current returnme))))
702
703 (provide 'semantic/find)
704
705 ;; Local variables:
706 ;; generated-autoload-file: "loaddefs.el"
707 ;; generated-autoload-load-name: "semantic/find"
708 ;; End:
709
710 ;;; semantic/find.el ends here