lisp/cedet/semantic/find.el

   1 ;;; semantic/find.el --- Search routines for Semantic
   2
   3 ;; Copyright (C) 1999-2005, 2008-2012  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
  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 position.
  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 (defun semantic-current-tag-of-class (class)
 187   "Return the current (smallest) tags of CLASS in the current buffer.
 188 If the smallest tag is not of type CLASS, keep going upwards until one
 189 is found.
 190 Uses `semantic-tag-class' for classification."
 191   (let ((tags (nreverse (semantic-find-tag-by-overlay))))
 192     (while (and tags
 193                 (not (eq (semantic-tag-class (car tags)) class)))
 194       (setq tags (cdr tags)))
 195     (car tags)))
 196 \f
 197 ;;; Search Routines
 198 ;;
 199 ;; These are routines that search a single tags table.
 200 ;;
 201 ;; The original API (see COMPATIBILITY section below) in semantic 1.4
 202 ;; had these usage statistics:
 203 ;;
 204 ;; semantic-find-nonterminal-by-name 17
 205 ;; semantic-find-nonterminal-by-name-regexp 8  - Most doing completion
 206 ;; semantic-find-nonterminal-by-position 13
 207 ;; semantic-find-nonterminal-by-token 21
 208 ;; semantic-find-nonterminal-by-type 2
 209 ;; semantic-find-nonterminal-standard 1
 210 ;;
 211 ;; semantic-find-nonterminal-by-function (not in other searches)  1
 212 ;;
 213 ;; New API: As above w/out `search-parts' or `search-includes' arguments.
 214 ;; Extra fcn: Specific to completion which is what -name-regexp is
 215 ;;            mostly used for
 216 ;;
 217 ;; As for the sarguments "search-parts" and "search-includes" here
 218 ;; are stats:
 219 ;;
 220 ;; search-parts: 4  - charting x2, find-doc, senator (sans db)
 221 ;;
 222 ;; Implement command to flatten a tag table.  Call new API Fcn w/
 223 ;; flattened table for same results.
 224 ;;
 225 ;; search-include: 2 - analyze x2 (sans db)
 226 ;;
 227 ;; Not used effectively.  Not to be re-implemented here.
 228
 229 (defsubst semantic--find-tags-by-function (predicate &optional table)
 230   "Find tags for which PREDICATE is non-nil in TABLE.
 231 PREDICATE is a lambda expression which accepts on TAG.
 232 TABLE is a semantic tags table.  See `semantic-something-to-tag-table'."
 233   (let ((tags (semantic-something-to-tag-table table))
 234         (result nil))
 235 ;    (mapc (lambda (tag) (and (funcall predicate tag)
 236 ;                            (setq result (cons tag result))))
 237 ;         tags)
 238     ;; A while loop is actually faster.  Who knew
 239     (while tags
 240       (and (funcall predicate (car tags))
 241            (setq result (cons (car tags) result)))
 242       (setq tags (cdr tags)))
 243     (nreverse result)))
 244
 245 ;; I can shave off some time by removing the funcall (see above)
 246 ;; and having the question be inlined in the while loop.
 247 ;; Strangely turning the upper level fcns into macros had a larger
 248 ;; impact.
 249 (defmacro semantic--find-tags-by-macro (form &optional table)
 250   "Find tags for which FORM is non-nil in TABLE.
 251 TABLE is a semantic tags table.  See `semantic-something-to-tag-table'."
 252   `(let ((tags (semantic-something-to-tag-table ,table))
 253          (result nil))
 254      (while tags
 255        (and ,form
 256             (setq result (cons (car tags) result)))
 257        (setq tags (cdr tags)))
 258      (nreverse result)))
 259
 260 ;;; Top level Searches
 261 ;;
 262 ;;;###autoload
 263 (defun semantic-find-first-tag-by-name (name &optional table)
 264   "Find the first tag with NAME in TABLE.
 265 NAME is a string.
 266 TABLE is a semantic tags table.  See `semantic-something-to-tag-table'.
 267 This routine uses `assoc' to quickly find the first matching entry."
 268   (funcall (if semantic-case-fold 'assoc-ignore-case 'assoc)
 269            name (semantic-something-to-tag-table table)))
 270
 271 (defmacro semantic-find-tags-by-name (name &optional table)
 272   "Find all tags with NAME in TABLE.
 273 NAME is a string.
 274 TABLE is a tag table.  See `semantic-something-to-tag-table'."
 275   `(let ((case-fold-search semantic-case-fold))
 276      (semantic--find-tags-by-macro
 277       (string= ,name (semantic-tag-name (car tags)))
 278       ,table)))
 279
 280 (defmacro semantic-find-tags-for-completion (prefix &optional table)
 281   "Find all tags whose name begins with PREFIX in TABLE.
 282 PREFIX is a string.
 283 TABLE is a tag table.  See `semantic-something-to-tag-table'.
 284 While it would be nice to use `try-completion' or `all-completions',
 285 those functions do not return the tags, only a string.
 286 Uses `compare-strings' for fast comparison."
 287   `(let ((l (length ,prefix)))
 288      (semantic--find-tags-by-macro
 289       (eq (compare-strings ,prefix 0 nil
 290                            (semantic-tag-name (car tags)) 0 l
 291                            semantic-case-fold)
 292           t)
 293       ,table)))
 294
 295 (defmacro semantic-find-tags-by-name-regexp (regexp &optional table)
 296   "Find all tags with name matching REGEXP in TABLE.
 297 REGEXP is a string containing a regular expression,
 298 TABLE is a tag table.  See `semantic-something-to-tag-table'.
 299 Consider using `semantic-find-tags-for-completion' if you are
 300 attempting to do completions."
 301   `(let ((case-fold-search semantic-case-fold))
 302      (semantic--find-tags-by-macro
 303       (string-match ,regexp (semantic-tag-name (car tags)))
 304       ,table)))
 305
 306 (defmacro semantic-find-tags-by-class (class &optional table)
 307   "Find all tags of class CLASS in TABLE.
 308 CLASS is a symbol representing the class of the token, such as
 309 'variable, of 'function..
 310 TABLE is a tag table.  See `semantic-something-to-tag-table'."
 311   `(semantic--find-tags-by-macro
 312     (eq ,class (semantic-tag-class (car tags)))
 313     ,table))
 314
 315 (defmacro semantic-find-tags-by-type (type &optional table)
 316   "Find all tags of with a type TYPE in TABLE.
 317 TYPE is a string or tag representing a data type as defined in the
 318 language the tags were parsed from, such as \"int\", or perhaps
 319 a tag whose name is that of a struct or class.
 320 TABLE is a tag table.  See `semantic-something-to-tag-table'."
 321   `(semantic--find-tags-by-macro
 322     (semantic-tag-of-type-p (car tags) ,type)
 323     ,table))
 324
 325 (defmacro semantic-find-tags-of-compound-type (&optional table)
 326   "Find all tags which are a compound type in TABLE.
 327 Compound types are structures, or other data type which
 328 is not of a primitive nature, such as int or double.
 329 Used in completion."
 330   `(semantic--find-tags-by-macro
 331     (semantic-tag-type-compound-p (car tags))
 332     ,table))
 333
 334 ;;;###autoload
 335 (define-overloadable-function semantic-find-tags-by-scope-protection (scopeprotection parent &optional table)
 336   "Find all tags accessible by SCOPEPROTECTION.
 337 SCOPEPROTECTION is a symbol which can be returned by the method
 338 `semantic-tag-protection'.  A hard-coded order is used to determine a match.
 339 PARENT is a tag representing the PARENT slot needed for
 340 `semantic-tag-protection'.
 341 TABLE is a list of tags (a subset of PARENT members) to scan.  If TABLE is nil,
 342 the type members of PARENT are used.
 343 See `semantic-tag-protected-p' for details on which tags are returned."
 344   (if (not (eq (semantic-tag-class parent) 'type))
 345       (signal 'wrong-type-argument '(semantic-find-tags-by-scope-protection
 346                                      parent
 347                                      semantic-tag-class type))
 348     (:override)))
 349
 350 (defun semantic-find-tags-by-scope-protection-default
 351   (scopeprotection parent &optional table)
 352   "Find all tags accessible by SCOPEPROTECTION.
 353 SCOPEPROTECTION is a symbol which can be returned by the method
 354 `semantic-tag-protection'.  A hard-coded order is used to determine a match.
 355 PARENT is a tag representing the PARENT slot needed for
 356 `semantic-tag-protection'.
 357 TABLE is a list of tags (a subset of PARENT members) to scan.  If TABLE is nil,
 358 the type members of PARENT are used.
 359 See `semantic-tag-protected-p' for details on which tags are returned."
 360     (if (not table) (setq table (semantic-tag-type-members parent)))
 361     (if (null scopeprotection)
 362         table
 363       (require 'semantic/tag-ls)
 364       (semantic--find-tags-by-macro
 365        (not (semantic-tag-protected-p (car tags) scopeprotection parent))
 366        table)))
 367
 368 (defsubst semantic-find-tags-included (&optional table)
 369   "Find all tags in TABLE that are of the 'include class.
 370 TABLE is a tag table.  See `semantic-something-to-tag-table'."
 371   (semantic-find-tags-by-class 'include table))
 372
 373 ;;; Deep Searches
 374
 375 (defmacro semantic-deep-find-tags-by-name (name &optional table)
 376   "Find all tags with NAME in TABLE.
 377 Search in top level tags, and their components, in TABLE.
 378 NAME is a string.
 379 TABLE is a tag table.  See `semantic-flatten-tags-table'.
 380 See also `semantic-find-tags-by-name'."
 381   `(semantic-find-tags-by-name
 382     ,name (semantic-flatten-tags-table ,table)))
 383
 384 (defmacro semantic-deep-find-tags-for-completion (prefix &optional table)
 385   "Find all tags whose name begins with PREFIX in TABLE.
 386 Search in top level tags, and their components, in TABLE.
 387 TABLE is a tag table.  See `semantic-flatten-tags-table'.
 388 See also `semantic-find-tags-for-completion'."
 389   `(semantic-find-tags-for-completion
 390     ,prefix (semantic-flatten-tags-table ,table)))
 391
 392 (defmacro semantic-deep-find-tags-by-name-regexp (regexp &optional table)
 393   "Find all tags with name matching REGEXP in TABLE.
 394 Search in top level tags, and their components, in TABLE.
 395 REGEXP is a string containing a regular expression,
 396 TABLE is a tag table.  See `semantic-flatten-tags-table'.
 397 See also `semantic-find-tags-by-name-regexp'.
 398 Consider using `semantic-deep-find-tags-for-completion' if you are
 399 attempting to do completions."
 400   `(semantic-find-tags-by-name-regexp
 401     ,regexp (semantic-flatten-tags-table ,table)))
 402
 403 ;;; Specialty Searches
 404
 405 (defun semantic-find-tags-external-children-of-type (type &optional table)
 406   "Find all tags in whose parent is TYPE in TABLE.
 407 These tags are defined outside the scope of the original TYPE declaration.
 408 TABLE is a tag table.  See `semantic-something-to-tag-table'."
 409   (semantic--find-tags-by-macro
 410    (equal (semantic-tag-external-member-parent (car tags))
 411           type)
 412    table))
 413
 414 (defun semantic-find-tags-subclasses-of-type (type &optional table)
 415   "Find all tags of class type in whose parent is TYPE in TABLE.
 416 These tags are defined outside the scope of the original TYPE declaration.
 417 TABLE is a tag table.  See `semantic-something-to-tag-table'."
 418   (semantic--find-tags-by-macro
 419    (and (eq (semantic-tag-class (car tags)) 'type)
 420         (or (member type (semantic-tag-type-superclasses (car tags)))
 421             (member type (semantic-tag-type-interfaces (car tags)))))
 422    table))
 423 \f
 424 ;;
 425 ;; ************************** Compatibility ***************************
 426 ;;
 427
 428 ;;; Old Style Brute Force Search Routines
 429 ;;
 430 ;; These functions will search through tags lists explicitly for
 431 ;; desired information.
 432
 433 ;; The -by-name nonterminal search can use the built in fcn
 434 ;; `assoc', which is faster than looping ourselves, so we will
 435 ;; not use `semantic-brute-find-tag-by-function' to do this,
 436 ;; instead erroring on the side of speed.
 437
 438 (defun semantic-brute-find-first-tag-by-name
 439   (name streamorbuffer &optional search-parts search-include)
 440   "Find a tag NAME within STREAMORBUFFER.  NAME is a string.
 441 If SEARCH-PARTS is non-nil, search children of tags.
 442 If SEARCH-INCLUDE was never implemented.
 443
 444 Use `semantic-find-first-tag-by-name' instead."
 445   (let* ((stream (semantic-something-to-tag-table streamorbuffer))
 446          (assoc-fun (if semantic-case-fold
 447                         #'assoc-ignore-case
 448                       #'assoc))
 449          (m (funcall assoc-fun name stream)))
 450     (if m
 451         m
 452       (let ((toklst stream)
 453             (children nil))
 454         (while (and (not m) toklst)
 455           (if search-parts
 456               (progn
 457                 (setq children (semantic-tag-components-with-overlays
 458                                 (car toklst)))
 459                 (if children
 460                     (setq m (semantic-brute-find-first-tag-by-name
 461                              name children search-parts search-include)))))
 462           (setq toklst (cdr toklst)))
 463         (if (not m)
 464             ;; Go to dependencies, and search there.
 465             nil)
 466         m))))
 467
 468 (defmacro semantic-brute-find-tag-by-class
 469   (class streamorbuffer &optional search-parts search-includes)
 470   "Find all tags with a class CLASS within STREAMORBUFFER.
 471 CLASS is a symbol representing the class of the tags to find.
 472 See `semantic-tag-class'.
 473 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
 474 `semantic-brute-find-tag-by-function'.
 475
 476 Use `semantic-find-tag-by-class' instead."
 477   `(semantic-brute-find-tag-by-function
 478     (lambda (tag) (eq ,class (semantic-tag-class tag)))
 479     ,streamorbuffer ,search-parts ,search-includes))
 480
 481 (defmacro semantic-brute-find-tag-standard
 482   (streamorbuffer &optional search-parts search-includes)
 483   "Find all tags in STREAMORBUFFER which define simple class types.
 484 See `semantic-tag-class'.
 485 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
 486 `semantic-brute-find-tag-by-function'."
 487   `(semantic-brute-find-tag-by-function
 488     (lambda (tag) (member (semantic-tag-class tag)
 489                           '(function variable type)))
 490     ,streamorbuffer ,search-parts ,search-includes))
 491
 492 (defun semantic-brute-find-tag-by-type
 493   (type streamorbuffer &optional search-parts search-includes)
 494   "Find all tags with type TYPE within STREAMORBUFFER.
 495 TYPE is a string which is the name of the type of the tags returned.
 496 See `semantic-tag-type'.
 497 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
 498 `semantic-brute-find-tag-by-function'."
 499   (semantic-brute-find-tag-by-function
 500    (lambda (tag)
 501      (let ((ts (semantic-tag-type tag)))
 502        (if (and (listp ts)
 503                 (or (= (length ts) 1)
 504                     (eq (semantic-tag-class ts) 'type)))
 505            (setq ts (semantic-tag-name ts)))
 506        (equal type ts)))
 507    streamorbuffer search-parts search-includes))
 508
 509 (defun semantic-brute-find-tag-by-type-regexp
 510   (regexp streamorbuffer &optional search-parts search-includes)
 511   "Find all tags with type matching REGEXP within STREAMORBUFFER.
 512 REGEXP is a regular expression  which matches the  name of the type of the
 513 tags returned.  See `semantic-tag-type'.
 514 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
 515 `semantic-brute-find-tag-by-function'."
 516   (semantic-brute-find-tag-by-function
 517    (lambda (tag)
 518      (let ((ts (semantic-tag-type tag)))
 519        (if (listp ts)
 520            (setq ts
 521                  (if (eq (semantic-tag-class ts) 'type)
 522                      (semantic-tag-name ts)
 523                    (car ts))))
 524        (and ts (string-match regexp ts))))
 525    streamorbuffer search-parts search-includes))
 526
 527 (defun semantic-brute-find-tag-by-name-regexp
 528   (regex streamorbuffer &optional search-parts search-includes)
 529   "Find all tags whose name match REGEX in STREAMORBUFFER.
 530 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
 531 `semantic-brute-find-tag-by-function'."
 532   (semantic-brute-find-tag-by-function
 533    (lambda (tag) (string-match regex (semantic-tag-name tag)))
 534     streamorbuffer search-parts search-includes)
 535   )
 536
 537 (defun semantic-brute-find-tag-by-property
 538   (property value streamorbuffer &optional search-parts search-includes)
 539   "Find all tags with PROPERTY equal to VALUE in STREAMORBUFFER.
 540 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
 541 `semantic-brute-find-tag-by-function'."
 542   (semantic-brute-find-tag-by-function
 543    (lambda (tag) (equal (semantic--tag-get-property tag property) value))
 544    streamorbuffer search-parts search-includes)
 545   )
 546
 547 (defun semantic-brute-find-tag-by-attribute
 548   (attr streamorbuffer &optional search-parts search-includes)
 549   "Find all tags with a given ATTR in STREAMORBUFFER.
 550 ATTR is a symbol key into the attributes list.
 551 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
 552 `semantic-brute-find-tag-by-function'."
 553   (semantic-brute-find-tag-by-function
 554    (lambda (tag) (semantic-tag-get-attribute tag attr))
 555    streamorbuffer search-parts search-includes)
 556   )
 557
 558 (defun semantic-brute-find-tag-by-attribute-value
 559   (attr value streamorbuffer &optional search-parts search-includes)
 560   "Find all tags with a given ATTR equal to VALUE in STREAMORBUFFER.
 561 ATTR is a symbol key into the attributes list.
 562 VALUE is the value that ATTR should match.
 563 Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
 564 `semantic-brute-find-tag-by-function'."
 565   (semantic-brute-find-tag-by-function
 566    (lambda (tag) (equal (semantic-tag-get-attribute tag attr) value))
 567    streamorbuffer search-parts search-includes)
 568   )
 569
 570 (defun semantic-brute-find-tag-by-function
 571   (function streamorbuffer &optional search-parts search-includes)
 572   "Find all tags for which FUNCTION's value is non-nil within STREAMORBUFFER.
 573 FUNCTION must return non-nil if an element of STREAM will be included
 574 in the new list.
 575
 576 If optional argument SEARCH-PARTS is non-nil, all sub-parts of tags
 577 are searched.  The overloadable function `semantic-tag-components' is
 578 used for the searching child lists.  If SEARCH-PARTS is the symbol
 579 'positiononly, then only children that have positional information are
 580 searched.
 581
 582 If SEARCH-INCLUDES has not been implemented.
 583 This parameter hasn't be active for a while and is obsolete."
 584   (let ((stream (semantic-something-to-tag-table streamorbuffer))
 585         (sl nil)                        ;list of tag children
 586         (nl nil)                        ;new list
 587         (case-fold-search semantic-case-fold))
 588     (dolist (tag stream)
 589       (if (not (semantic-tag-p tag))
 590           ;; `semantic-tag-components-with-overlays' can return invalid
 591           ;; tags if search-parts is not equal to 'positiononly
 592           nil ;; Ignore them!
 593         (if (funcall function tag)
 594             (setq nl (cons tag nl)))
 595         (and search-parts
 596              (setq sl (if (eq search-parts 'positiononly)
 597                           (semantic-tag-components-with-overlays tag)
 598                         (semantic-tag-components tag))
 599                    )
 600              (setq nl (nconc nl
 601                              (semantic-brute-find-tag-by-function
 602                               function sl
 603                               search-parts))))))
 604     (setq nl (nreverse nl))
 605     nl))
 606
 607 (defun semantic-brute-find-first-tag-by-function
 608   (function streamorbuffer &optional search-parts search-includes)
 609   "Find the first tag which FUNCTION match within STREAMORBUFFER.
 610 FUNCTION must return non-nil if an element of STREAM will be included
 611 in the new list.
 612
 613 The following parameters were never implemented.
 614
 615 If optional argument SEARCH-PARTS, all sub-parts of tags are searched.
 616 The overloadable function `semantic-tag-components' is used for
 617 searching.
 618 If SEARCH-INCLUDES is non-nil, then all include files are also
 619 searched for matches."
 620   (let ((stream (semantic-something-to-tag-table streamorbuffer))
 621         (found nil)
 622         (case-fold-search semantic-case-fold))
 623     (while (and (not found) stream)
 624       (if (funcall function (car stream))
 625           (setq found (car stream)))
 626       (setq stream (cdr stream)))
 627     found))
 628
 629
 630 ;;; Old Positional Searches
 631 ;;
 632 ;; Are these useful anymore?
 633 ;;
 634 (defun semantic-brute-find-tag-by-position (position streamorbuffer
 635                                                      &optional nomedian)
 636   "Find a tag covering POSITION within STREAMORBUFFER.
 637 POSITION is a number, or marker.  If NOMEDIAN is non-nil, don't do
 638 the median calculation, and return nil."
 639   (save-excursion
 640     (if (markerp position) (set-buffer (marker-buffer position)))
 641     (let* ((stream (if (bufferp streamorbuffer)
 642                        (with-current-buffer streamorbuffer
 643                          (semantic-fetch-tags))
 644                      streamorbuffer))
 645            (prev nil)
 646            (found nil))
 647       (while (and stream (not found))
 648         ;; perfect fit
 649         (if (and (>= position (semantic-tag-start (car stream)))
 650                  (<= position (semantic-tag-end (car stream))))
 651             (setq found (car stream))
 652           ;; Median between to objects.
 653           (if (and prev (not nomedian)
 654                    (>= position (semantic-tag-end prev))
 655                    (<= position (semantic-tag-start (car stream))))
 656               (let ((median (/ (+ (semantic-tag-end prev)
 657                                   (semantic-tag-start (car stream)))
 658                                2)))
 659                 (setq found
 660                       (if (> position median)
 661                           (car stream)
 662                         prev)))))
 663         ;; Next!!!
 664         (setq prev (car stream)
 665               stream (cdr stream)))
 666       found)))
 667
 668 (defun semantic-brute-find-innermost-tag-by-position
 669   (position streamorbuffer &optional nomedian)
 670   "Find a list of tags covering POSITION within STREAMORBUFFER.
 671 POSITION is a number, or marker.  If NOMEDIAN is non-nil, don't do
 672 the median calculation, and return nil.
 673 This function will find the topmost item, and recurse until no more
 674 details are available of findable."
 675   (let* ((returnme nil)
 676          (current (semantic-brute-find-tag-by-position
 677                    position streamorbuffer nomedian))
 678          (nextstream (and current
 679                           (if (eq (semantic-tag-class current) 'type)
 680                               (semantic-tag-type-members current)
 681                             nil))))
 682     (while nextstream
 683       (setq returnme (cons current returnme))
 684       (setq current (semantic-brute-find-tag-by-position
 685                      position nextstream nomedian))
 686       (setq nextstream (and current
 687                             ;; NOTE TO SELF:
 688                             ;; Looking at this after several years away,
 689                             ;; what does this do???
 690                             (if (eq (semantic-tag-class current) 'token)
 691                                 (semantic-tag-type-members current)
 692                               nil))))
 693     (nreverse (cons current returnme))))
 694
 695 (provide 'semantic/find)
 696
 697 ;; Local variables:
 698 ;; generated-autoload-file: "loaddefs.el"
 699 ;; generated-autoload-load-name: "semantic/find"
 700 ;; End:
 701
 702 ;;; semantic/find.el ends here