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

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