lisp/cedet/semantic/find.el

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