lisp/cedet/semantic/symref.el

   1 ;;; semantic/symref.el --- Symbol Reference API
   2
   3 ;; Copyright (C) 2008-2012  Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; Semantic Symbol Reference API.
  25 ;;
  26 ;; Semantic's native parsing tools do not handle symbol references.
  27 ;; Tracking such information is a task that requires a huge amount of
  28 ;; space and processing not appropriate for an Emacs Lisp program.
  29 ;;
  30 ;; Many desired tools used in refactoring, however, need to have
  31 ;; such references available to them.  This API aims to provide a
  32 ;; range of functions that can be used to identify references.  The
  33 ;; API is backed by an OO system that is used to allow multiple
  34 ;; external tools to provide the information.
  35 ;;
  36 ;; The default implementation uses a find/grep combination to do a
  37 ;; search.  This works ok in small projects.  For larger projects, it
  38 ;; is important to find an alternate tool to use as a back-end to
  39 ;; symref.
  40 ;;
  41 ;; See the command: `semantic-symref' for an example app using this api.
  42 ;;
  43 ;; TO USE THIS TOOL
  44 ;;
  45 ;; The following functions can be used to find different kinds of
  46 ;; references.
  47 ;;
  48 ;;  `semantic-symref-find-references-by-name'
  49 ;;  `semantic-symref-find-file-references-by-name'
  50 ;;  `semantic-symref-find-text'
  51 ;;
  52 ;; All the search routines return a class of type
  53 ;; `semantic-symref-result'.  You can reference the various slots, but
  54 ;; you will need the following methods to get extended information.
  55 ;;
  56 ;;  `semantic-symref-result-get-files'
  57 ;;  `semantic-symref-result-get-tags'
  58 ;;
  59 ;; ADD A NEW EXTERNAL TOOL
  60 ;;
  61 ;; To support a new external tool, subclass `semantic-symref-tool-baseclass'
  62 ;; and implement the methods.  The baseclass provides support for
  63 ;; managing external processes that produce parsable output.
  64 ;;
  65 ;; Your tool should then create an instance of `semantic-symref-result'.
  66
  67 (require 'semantic)
  68
  69 (defvar ede-minor-mode)
  70 (declare-function data-debug-new-buffer "data-debug")
  71 (declare-function data-debug-insert-object-slots "eieio-datadebug")
  72 (declare-function ede-toplevel "ede/base")
  73 (declare-function ede-project-root-directory "ede/files")
  74 (declare-function ede-up-directory "ede/files")
  75
  76 ;;; Code:
  77 (defvar semantic-symref-tool 'detect
  78   "*The active symbol reference tool name.
  79 The tool symbol can be 'detect, or a symbol that is the name of
  80 a tool that can be used for symbol referencing.")
  81 (make-variable-buffer-local 'semantic-symref-tool)
  82
  83 ;;; TOOL SETUP
  84 ;;
  85 (defvar semantic-symref-tool-alist
  86   '( ( (lambda (rootdir) (file-exists-p (expand-file-name "GPATH" rootdir))) .
  87        global)
  88      ( (lambda (rootdir) (file-exists-p (expand-file-name "ID" rootdir))) .
  89        idutils)
  90      ( (lambda (rootdir) (file-exists-p (expand-file-name "cscope.out" rootdir))) .
  91        cscope )
  92     )
  93   "Alist of tools usable by `semantic-symref'.
  94 Each entry is of the form:
  95    ( PREDICATE . KEY )
  96 Where PREDICATE is a function that takes a directory name for the
  97 root of a project, and returns non-nil if the tool represented by KEY
  98 is supported.
  99
 100 If no tools are supported, then 'grep is assumed.")
 101
 102 (defun semantic-symref-calculate-rootdir ()
 103   "Calculate the root directory for a symref search.
 104 Start with and EDE project, or use the default directory."
 105   (let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
 106                      (ede-toplevel)))
 107          (rootdirbase (if rootproj
 108                           (ede-project-root-directory rootproj)
 109                         default-directory)))
 110     (if (and rootproj (condition-case nil
 111                           ;; Hack for subprojects.
 112                           (oref rootproj :metasubproject)
 113                         (error nil)))
 114         (ede-up-directory rootdirbase)
 115       rootdirbase)))
 116
 117 (defun semantic-symref-detect-symref-tool ()
 118   "Detect the symref tool to use for the current buffer."
 119   (if (not (eq semantic-symref-tool 'detect))
 120       semantic-symref-tool
 121     ;; We are to perform a detection for the right tool to use.
 122     (let* ((rootdir (semantic-symref-calculate-rootdir))
 123            (tools semantic-symref-tool-alist))
 124       (while (and tools (eq semantic-symref-tool 'detect))
 125         (when (funcall (car (car tools)) rootdir)
 126           (setq semantic-symref-tool (cdr (car tools))))
 127         (setq tools (cdr tools)))
 128
 129       (when (eq semantic-symref-tool 'detect)
 130         (setq semantic-symref-tool 'grep))
 131
 132       semantic-symref-tool)))
 133
 134 (defun semantic-symref-instantiate (&rest args)
 135   "Instantiate a new symref search object.
 136 ARGS are the initialization arguments to pass to the created class."
 137   (let* ((srt (symbol-name (semantic-symref-detect-symref-tool)))
 138          (class (intern-soft (concat "semantic-symref-tool-" srt)))
 139          (inst nil)
 140          )
 141     (when (not (class-p class))
 142       (error "Unknown symref tool %s" semantic-symref-tool))
 143     (setq inst (apply 'make-instance class args))
 144     inst))
 145
 146 (defvar semantic-symref-last-result nil
 147   "The last calculated symref result.")
 148
 149 (defun semantic-symref-data-debug-last-result ()
 150   "Run the last symref data result in Data Debug."
 151   (interactive)
 152   (require 'eieio-datadebug)
 153   (if semantic-symref-last-result
 154       (progn
 155         (data-debug-new-buffer "*Symbol Reference ADEBUG*")
 156         (data-debug-insert-object-slots semantic-symref-last-result "]"))
 157     (message "Empty results.")))
 158
 159 ;;; EXTERNAL API
 160 ;;
 161
 162 ;;;###autoload
 163 (defun semantic-symref-find-references-by-name (name &optional scope tool-return)
 164   "Find a list of references to NAME in the current project.
 165 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 166 Refers to `semantic-symref-tool', to determine the reference tool to use
 167 for the current buffer.
 168 Returns an object of class `semantic-symref-result'.
 169 TOOL-RETURN is an optional symbol, which will be assigned the tool used
 170 to perform the search.  This was added for use by a test harness."
 171   (interactive "sName: ")
 172   (let* ((inst (semantic-symref-instantiate
 173                 :searchfor name
 174                 :searchtype 'symbol
 175                 :searchscope (or scope 'project)
 176                 :resulttype 'line))
 177          (result (semantic-symref-get-result inst)))
 178     (when tool-return
 179       (set tool-return inst))
 180     (prog1
 181         (setq semantic-symref-last-result result)
 182       (when (called-interactively-p 'interactive)
 183         (semantic-symref-data-debug-last-result))))
 184   )
 185
 186 ;;;###autoload
 187 (defun semantic-symref-find-tags-by-name (name &optional scope)
 188   "Find a list of references to NAME in the current project.
 189 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 190 Refers to `semantic-symref-tool', to determine the reference tool to use
 191 for the current buffer.
 192 Returns an object of class `semantic-symref-result'."
 193   (interactive "sName: ")
 194   (let* ((inst (semantic-symref-instantiate
 195                 :searchfor name
 196                 :searchtype 'tagname
 197                 :searchscope (or scope 'project)
 198                 :resulttype 'line))
 199          (result (semantic-symref-get-result inst)))
 200     (prog1
 201         (setq semantic-symref-last-result result)
 202       (when (called-interactively-p 'interactive)
 203         (semantic-symref-data-debug-last-result))))
 204   )
 205
 206 ;;;###autoload
 207 (defun semantic-symref-find-tags-by-regexp (name &optional scope)
 208   "Find a list of references to NAME in the current project.
 209 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 210 Refers to `semantic-symref-tool', to determine the reference tool to use
 211 for the current buffer.
 212 Returns an object of class `semantic-symref-result'."
 213   (interactive "sName: ")
 214   (let* ((inst (semantic-symref-instantiate
 215                 :searchfor name
 216                 :searchtype 'tagregexp
 217                 :searchscope (or scope 'project)
 218                 :resulttype 'line))
 219          (result (semantic-symref-get-result inst)))
 220     (prog1
 221         (setq semantic-symref-last-result result)
 222       (when (called-interactively-p 'interactive)
 223         (semantic-symref-data-debug-last-result))))
 224   )
 225
 226 ;;;###autoload
 227 (defun semantic-symref-find-tags-by-completion (name &optional scope)
 228   "Find a list of references to NAME in the current project.
 229 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 230 Refers to `semantic-symref-tool', to determine the reference tool to use
 231 for the current buffer.
 232 Returns an object of class `semantic-symref-result'."
 233   (interactive "sName: ")
 234   (let* ((inst (semantic-symref-instantiate
 235                 :searchfor name
 236                 :searchtype 'tagcompletions
 237                 :searchscope (or scope 'project)
 238                 :resulttype 'line))
 239          (result (semantic-symref-get-result inst)))
 240     (prog1
 241         (setq semantic-symref-last-result result)
 242       (when (called-interactively-p 'interactive)
 243         (semantic-symref-data-debug-last-result))))
 244   )
 245
 246 ;;;###autoload
 247 (defun semantic-symref-find-file-references-by-name (name &optional scope)
 248   "Find a list of references to NAME in the current project.
 249 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 250 Refers to `semantic-symref-tool', to determine the reference tool to use
 251 for the current buffer.
 252 Returns an object of class `semantic-symref-result'."
 253   (interactive "sName: ")
 254   (let* ((inst (semantic-symref-instantiate
 255                 :searchfor name
 256                 :searchtype 'regexp
 257                 :searchscope (or scope 'project)
 258                 :resulttype 'file))
 259          (result (semantic-symref-get-result inst)))
 260     (prog1
 261         (setq semantic-symref-last-result result)
 262       (when (called-interactively-p 'interactive)
 263         (semantic-symref-data-debug-last-result))))
 264   )
 265
 266 ;;;###autoload
 267 (defun semantic-symref-find-text (text &optional scope)
 268   "Find a list of occurrences of TEXT in the current project.
 269 TEXT is a regexp formatted for use with egrep.
 270 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 271 Refers to `semantic-symref-tool', to determine the reference tool to use
 272 for the current buffer.
 273 Returns an object of class `semantic-symref-result'."
 274   (interactive "sEgrep style Regexp: ")
 275   (let* ((inst (semantic-symref-instantiate
 276                 :searchfor text
 277                 :searchtype 'regexp
 278                 :searchscope (or scope 'project)
 279                 :resulttype 'line))
 280          (result (semantic-symref-get-result inst)))
 281     (prog1
 282         (setq semantic-symref-last-result result)
 283       (when (called-interactively-p 'interactive)
 284         (semantic-symref-data-debug-last-result))))
 285   )
 286
 287 ;;; RESULTS
 288 ;;
 289 ;; The results class and methods provide features for accessing hits.
 290 (defclass semantic-symref-result ()
 291   ((created-by :initarg :created-by
 292                :type semantic-symref-tool-baseclass
 293                :documentation
 294                "Back-pointer to the symref tool creating these results.")
 295    (hit-files :initarg :hit-files
 296               :type list
 297               :documentation
 298               "The list of files hit.")
 299    (hit-text :initarg :hit-text
 300              :type list
 301              :documentation
 302              "If the result doesn't provide full lines, then fill in hit-text.
 303 GNU Global does completion search this way.")
 304    (hit-lines :initarg :hit-lines
 305               :type list
 306               :documentation
 307               "The list of line hits.
 308 Each element is a cons cell of the form (LINE . FILENAME).")
 309    (hit-tags :initarg :hit-tags
 310              :type list
 311              :documentation
 312              "The list of tags with hits in them.
 313 Use the  `semantic-symref-hit-tags' method to get this list.")
 314    )
 315   "The results from a symbol reference search.")
 316
 317 (defmethod semantic-symref-result-get-files ((result semantic-symref-result))
 318   "Get the list of files from the symref result RESULT."
 319   (if (slot-boundp result :hit-files)
 320       (oref result hit-files)
 321     (let* ((lines  (oref result :hit-lines))
 322            (files (mapcar (lambda (a) (cdr a)) lines))
 323            (ans nil))
 324       (setq ans (list (car files))
 325             files (cdr files))
 326       (dolist (F files)
 327         ;; This algorithm for uniquifying the file list depends on the
 328         ;; tool in question providing all the hits in the same file
 329         ;; grouped together.
 330         (when (not (string= F (car ans)))
 331           (setq ans (cons F ans))))
 332       (oset result hit-files (nreverse ans))
 333       )
 334     ))
 335
 336 (defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
 337                                             &optional open-buffers)
 338   "Get the list of tags from the symref result RESULT.
 339 Optional OPEN-BUFFERS indicates that the buffers that the hits are
 340 in should remain open after scanning.
 341 Note: This can be quite slow if most of the hits are not in buffers
 342 already."
 343   (if (and (slot-boundp result :hit-tags) (oref result hit-tags))
 344       (oref result hit-tags)
 345     ;; Calculate the tags.
 346     (let ((lines (oref result :hit-lines))
 347           (txt (oref (oref result :created-by) :searchfor))
 348           (searchtype (oref (oref result :created-by) :searchtype))
 349           (ans nil)
 350           (out nil)
 351           (buffs-to-kill nil))
 352       (save-excursion
 353         (setq
 354          ans
 355          (mapcar
 356           (lambda (hit)
 357             (let* ((line (car hit))
 358                    (file (cdr hit))
 359                    (buff (get-file-buffer file))
 360                    (tag nil)
 361                    )
 362               (cond
 363                ;; We have a buffer already.  Check it out.
 364                (buff
 365                 (set-buffer buff))
 366
 367                ;; We have a table, but it needs a refresh.
 368                ;; This means we should load in that buffer.
 369                (t
 370                 (let ((kbuff
 371                        (if open-buffers
 372                            ;; Even if we keep the buffers open, don't
 373                            ;; let EDE ask lots of questions.
 374                            (let ((ede-auto-add-method 'never))
 375                              (find-file-noselect file t))
 376                          ;; When not keeping the buffers open, then
 377                          ;; don't setup all the fancy froo-froo features
 378                          ;; either.
 379                          (semantic-find-file-noselect file t))))
 380                   (set-buffer kbuff)
 381                   (setq buffs-to-kill (cons kbuff buffs-to-kill))
 382                   (semantic-fetch-tags)
 383                   ))
 384                )
 385
 386               ;; Too much baggage in goto-line
 387               ;; (goto-line line)
 388               (goto-char (point-min))
 389               (forward-line (1- line))
 390
 391               ;; Search forward for the matching text
 392               (re-search-forward (regexp-quote txt)
 393                                  (point-at-eol)
 394                                  t)
 395
 396               (setq tag (semantic-current-tag))
 397
 398               ;; If we are searching for a tag, but bound the tag we are looking
 399               ;; for, see if it resides in some other parent tag.
 400               ;;
 401               ;; If there is no parent tag, then we still need to hang the originator
 402               ;; in our list.
 403               (when (and (eq searchtype 'symbol)
 404                          (string= (semantic-tag-name tag) txt))
 405                 (setq tag (or (semantic-current-tag-parent) tag)))
 406
 407               ;; Copy the tag, which adds a :filename property.
 408               (when tag
 409                 (setq tag (semantic-tag-copy tag nil t))
 410                 ;; Ad this hit to the tag.
 411                 (semantic--tag-put-property tag :hit (list line)))
 412               tag))
 413           lines)))
 414       ;; Kill off dead buffers, unless we were requested to leave them open.
 415       (when (not open-buffers)
 416         (mapc 'kill-buffer buffs-to-kill))
 417       ;; Strip out duplicates.
 418       (dolist (T ans)
 419         (if (and T (not (semantic-equivalent-tag-p (car out) T)))
 420             (setq out (cons T out))
 421           (when T
 422             ;; Else, add this line into the existing list of lines.
 423             (let ((lines (append (semantic--tag-get-property (car out) :hit)
 424                                  (semantic--tag-get-property T :hit))))
 425               (semantic--tag-put-property (car out) :hit lines)))
 426           ))
 427       ;; Out is reversed... twice
 428       (oset result :hit-tags (nreverse out)))))
 429
 430 ;;; SYMREF TOOLS
 431 ;;
 432 ;; The base symref tool provides something to hang new tools off of
 433 ;; for finding symbol references.
 434 (defclass semantic-symref-tool-baseclass ()
 435   ((searchfor :initarg :searchfor
 436               :type string
 437               :documentation "The thing to search for.")
 438    (searchtype :initarg :searchtype
 439                 :type symbol
 440                 :documentation "The type of search to do.
 441 Values could be `symbol, `regexp, 'tagname, or 'completion.")
 442    (searchscope :initarg :searchscope
 443                 :type symbol
 444                 :documentation
 445                 "The scope to search for.
 446 Can be 'project, 'target, or 'file.")
 447    (resulttype :initarg :resulttype
 448                :type symbol
 449                :documentation
 450                "The kind of search results desired.
 451 Can be 'line, 'file, or 'tag.
 452 The type of result can be converted from 'line to 'file, or 'line to 'tag,
 453 but not from 'file to 'line or 'tag.")
 454    )
 455   "Baseclass for all symbol references tools.
 456 A symbol reference tool supplies functionality to identify the locations of
 457 where different symbols are used.
 458
 459 Subclasses should be named `semantic-symref-tool-NAME', where
 460 NAME is the name of the tool used in the configuration variable
 461 `semantic-symref-tool'"
 462   :abstract t)
 463
 464 (defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
 465   "Calculate the results of a search based on TOOL.
 466 The symref TOOL should already contain the search criteria."
 467   (let ((answer (semantic-symref-perform-search tool))
 468         )
 469     (when answer
 470       (let ((answersym (if (eq (oref tool :resulttype) 'file)
 471                            :hit-files
 472                          (if (stringp (car answer))
 473                              :hit-text
 474                            :hit-lines))))
 475         (semantic-symref-result (oref tool searchfor)
 476                                 answersym
 477                                 answer
 478                                 :created-by tool))
 479       )
 480     ))
 481
 482 (defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
 483   "Base search for symref tools should throw an error."
 484   (error "Symref tool objects must implement `semantic-symref-perform-search'"))
 485
 486 (defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
 487                                               outputbuffer)
 488   "Parse the entire OUTPUTBUFFER of a symref tool.
 489 Calls the method `semantic-symref-parse-tool-output-one-line' over and
 490 over until it returns nil."
 491   (with-current-buffer outputbuffer
 492     (goto-char (point-min))
 493     (let ((result nil)
 494           (hit nil))
 495       (while (setq hit (semantic-symref-parse-tool-output-one-line tool))
 496         (setq result (cons hit result)))
 497       (nreverse result)))
 498   )
 499
 500 (defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
 501   "Base tool output parser is not implemented."
 502   (error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'"))
 503
 504 (provide 'semantic/symref)
 505
 506 ;; Local variables:
 507 ;; generated-autoload-file: "loaddefs.el"
 508 ;; generated-autoload-load-name: "semantic/symref"
 509 ;; End:
 510
 511 ;;; semantic/symref.el ends here