lisp/cedet/semantic/symref.el

   1 ;;; semantic/symref.el --- Symbol Reference API
   2
   3 ;;; Copyright (C) 2008, 2009 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 apropriate 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, sublcass `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 ;; (require 'ede)
  69
  70 (defvar ede-minor-mode)
  71 (declare-function data-debug-new-buffer "data-debug")
  72 (declare-function data-debug-insert-object-slots "eieio-datadebug")
  73 (declare-function ede-toplevel "ede/files")
  74 (declare-function ede-project-root-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-detect-symref-tool ()
 103   "Detect the symref tool to use for the current buffer."
 104   (if (not (eq semantic-symref-tool 'detect))
 105       semantic-symref-tool
 106     ;; We are to perform a detection for the right tool to use.
 107     (let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
 108                        (ede-toplevel)))
 109            (rootdir (if rootproj
 110                         (ede-project-root-directory rootproj)
 111                       default-directory))
 112            (tools semantic-symref-tool-alist))
 113       (while (and tools (eq semantic-symref-tool 'detect))
 114         (when (funcall (car (car tools)) rootdir)
 115           (setq semantic-symref-tool (cdr (car tools))))
 116         (setq tools (cdr tools)))
 117
 118       (when (eq semantic-symref-tool 'detect)
 119         (setq semantic-symref-tool 'grep))
 120
 121       semantic-symref-tool)))
 122
 123 (defun semantic-symref-instantiate (&rest args)
 124   "Instantiate a new symref search object.
 125 ARGS are the initialization arguments to pass to the created class."
 126   (let* ((srt (symbol-name (semantic-symref-detect-symref-tool)))
 127          (class (intern-soft (concat "semantic-symref-tool-" srt)))
 128          (inst nil)
 129          )
 130     (when (not (class-p class))
 131       (error "Unknown symref tool %s" semantic-symref-tool))
 132     (setq inst (apply 'make-instance class args))
 133     inst))
 134
 135 (defvar semantic-symref-last-result nil
 136   "The last calculated symref result.")
 137
 138 (defun semantic-symref-data-debug-last-result ()
 139   "Run the last symref data result in Data Debug."
 140   (interactive)
 141   (require 'eieio-datadebug)
 142   (if semantic-symref-last-result
 143       (progn
 144         (data-debug-new-buffer "*Symbol Reference ADEBUG*")
 145         (data-debug-insert-object-slots semantic-symref-last-result "]"))
 146     (message "Empty results.")))
 147
 148 ;;; EXTERNAL API
 149 ;;
 150
 151 ;;;###autoload
 152 (defun semantic-symref-find-references-by-name (name &optional scope tool-return)
 153   "Find a list of references to NAME in the current project.
 154 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 155 Refers to `semantic-symref-tool', to determine the reference tool to use
 156 for the current buffer.
 157 Returns an object of class `semantic-symref-result'.
 158 TOOL-RETURN is an optional symbol, which will be assigned the tool used
 159 to perform the search.  This was added for use by a test harness."
 160   (interactive "sName: ")
 161   (let* ((inst (semantic-symref-instantiate
 162                 :searchfor name
 163                 :searchtype 'symbol
 164                 :searchscope (or scope 'project)
 165                 :resulttype 'line))
 166          (result (semantic-symref-get-result inst)))
 167     (when tool-return
 168       (set tool-return inst))
 169     (prog1
 170         (setq semantic-symref-last-result result)
 171       (when (interactive-p)
 172         (semantic-symref-data-debug-last-result))))
 173   )
 174
 175 ;;;###autoload
 176 (defun semantic-symref-find-tags-by-name (name &optional scope)
 177   "Find a list of references to NAME in the current project.
 178 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 179 Refers to `semantic-symref-tool', to determine the reference tool to use
 180 for the current buffer.
 181 Returns an object of class `semantic-symref-result'."
 182   (interactive "sName: ")
 183   (let* ((inst (semantic-symref-instantiate
 184                 :searchfor name
 185                 :searchtype 'tagname
 186                 :searchscope (or scope 'project)
 187                 :resulttype 'line))
 188          (result (semantic-symref-get-result inst)))
 189     (prog1
 190         (setq semantic-symref-last-result result)
 191       (when (interactive-p)
 192         (semantic-symref-data-debug-last-result))))
 193   )
 194
 195 ;;;###autoload
 196 (defun semantic-symref-find-tags-by-regexp (name &optional scope)
 197   "Find a list of references to NAME in the current project.
 198 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 199 Refers to `semantic-symref-tool', to determine the reference tool to use
 200 for the current buffer.
 201 Returns an object of class `semantic-symref-result'."
 202   (interactive "sName: ")
 203   (let* ((inst (semantic-symref-instantiate
 204                 :searchfor name
 205                 :searchtype 'tagregexp
 206                 :searchscope (or scope 'project)
 207                 :resulttype 'line))
 208          (result (semantic-symref-get-result inst)))
 209     (prog1
 210         (setq semantic-symref-last-result result)
 211       (when (interactive-p)
 212         (semantic-symref-data-debug-last-result))))
 213   )
 214
 215 ;;;###autoload
 216 (defun semantic-symref-find-tags-by-completion (name &optional scope)
 217   "Find a list of references to NAME in the current project.
 218 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 219 Refers to `semantic-symref-tool', to determine the reference tool to use
 220 for the current buffer.
 221 Returns an object of class `semantic-symref-result'."
 222   (interactive "sName: ")
 223   (let* ((inst (semantic-symref-instantiate
 224                 :searchfor name
 225                 :searchtype 'tagcompletions
 226                 :searchscope (or scope 'project)
 227                 :resulttype 'line))
 228          (result (semantic-symref-get-result inst)))
 229     (prog1
 230         (setq semantic-symref-last-result result)
 231       (when (interactive-p)
 232         (semantic-symref-data-debug-last-result))))
 233   )
 234
 235 ;;;###autoload
 236 (defun semantic-symref-find-file-references-by-name (name &optional scope)
 237   "Find a list of references to NAME in the current project.
 238 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 239 Refers to `semantic-symref-tool', to determine the reference tool to use
 240 for the current buffer.
 241 Returns an object of class `semantic-symref-result'."
 242   (interactive "sName: ")
 243   (let* ((inst (semantic-symref-instantiate
 244                 :searchfor name
 245                 :searchtype 'regexp
 246                 :searchscope (or scope 'project)
 247                 :resulttype 'file))
 248          (result (semantic-symref-get-result inst)))
 249     (prog1
 250         (setq semantic-symref-last-result result)
 251       (when (interactive-p)
 252         (semantic-symref-data-debug-last-result))))
 253   )
 254
 255 ;;;###autoload
 256 (defun semantic-symref-find-text (text &optional scope)
 257   "Find a list of occurances of TEXT in the current project.
 258 TEXT is a regexp formatted for use with egrep.
 259 Optional SCOPE specifies which file set to search.  Defaults to 'project.
 260 Refers to `semantic-symref-tool', to determine the reference tool to use
 261 for the current buffer.
 262 Returns an object of class `semantic-symref-result'."
 263   (interactive "sEgrep style Regexp: ")
 264   (let* ((inst (semantic-symref-instantiate
 265                 :searchfor text
 266                 :searchtype 'regexp
 267                 :searchscope (or scope 'project)
 268                 :resulttype 'line))
 269          (result (semantic-symref-get-result inst)))
 270     (prog1
 271         (setq semantic-symref-last-result result)
 272       (when (interactive-p)
 273         (semantic-symref-data-debug-last-result))))
 274   )
 275
 276 ;;; RESULTS
 277 ;;
 278 ;; The results class and methods provide features for accessing hits.
 279 (defclass semantic-symref-result ()
 280   ((created-by :initarg :created-by
 281                :type semantic-symref-tool-baseclass
 282                :documentation
 283                "Back-pointer to the symref tool creating these results.")
 284    (hit-files :initarg :hit-files
 285               :type list
 286               :documentation
 287               "The list of files hit.")
 288    (hit-text :initarg :hit-text
 289              :type list
 290              :documentation
 291              "If the result doesn't provide full lines, then fill in hit-text.
 292 GNU Global does completion search this way.")
 293    (hit-lines :initarg :hit-lines
 294               :type list
 295               :documentation
 296               "The list of line hits.
 297 Each element is a cons cell of the form (LINE . FILENAME).")
 298    (hit-tags :initarg :hit-tags
 299              :type list
 300              :documentation
 301              "The list of tags with hits in them.
 302 Use the  `semantic-symref-hit-tags' method to get this list.")
 303    )
 304   "The results from a symbol reference search.")
 305
 306 (defmethod semantic-symref-result-get-files ((result semantic-symref-result))
 307   "Get the list of files from the symref result RESULT."
 308   (if (slot-boundp result :hit-files)
 309       (oref result hit-files)
 310     (let* ((lines  (oref result :hit-lines))
 311            (files (mapcar (lambda (a) (cdr a)) lines))
 312            (ans nil))
 313       (setq ans (list (car files))
 314             files (cdr files))
 315       (dolist (F files)
 316         ;; This algorithm for uniqing the file list depends on the
 317         ;; tool in question providing all the hits in the same file
 318         ;; grouped together.
 319         (when (not (string= F (car ans)))
 320           (setq ans (cons F ans))))
 321       (oset result hit-files (nreverse ans))
 322       )
 323     ))
 324
 325 (defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
 326                                             &optional open-buffers)
 327   "Get the list of tags from the symref result RESULT.
 328 Optional OPEN-BUFFERS indicates that the buffers that the hits are
 329 in should remain open after scanning.
 330 Note: This can be quite slow if most of the hits are not in buffers
 331 already."
 332   (if (and (slot-boundp result :hit-tags) (oref result hit-tags))
 333       (oref result hit-tags)
 334     ;; Calculate the tags.
 335     (let ((lines (oref result :hit-lines))
 336           (txt (oref (oref result :created-by) :searchfor))
 337           (searchtype (oref (oref result :created-by) :searchtype))
 338           (ans nil)
 339           (out nil)
 340           (buffs-to-kill nil))
 341       (save-excursion
 342         (setq
 343          ans
 344          (mapcar
 345           (lambda (hit)
 346             (let* ((line (car hit))
 347                    (file (cdr hit))
 348                    (buff (get-file-buffer file))
 349                    (tag nil)
 350                    )
 351               (cond
 352                ;; We have a buffer already.  Check it out.
 353                (buff
 354                 (set-buffer buff))
 355
 356                ;; We have a table, but it needs a refresh.
 357                ;; This means we should load in that buffer.
 358                (t
 359                 (let ((kbuff
 360                        (if open-buffers
 361                            ;; Even if we keep the buffers open, don't
 362                            ;; let EDE ask lots of questions.
 363                            (let ((ede-auto-add-method 'never))
 364                              (find-file-noselect file t))
 365                          ;; When not keeping the buffers open, then
 366                          ;; don't setup all the fancy froo-froo features
 367                          ;; either.
 368                          (semantic-find-file-noselect file t))))
 369                   (set-buffer kbuff)
 370                   (setq buffs-to-kill (cons kbuff buffs-to-kill))
 371                   (semantic-fetch-tags)
 372                   ))
 373                )
 374
 375               ;; Too much baggage in goto-line
 376               ;; (goto-line line)
 377               (goto-char (point-min))
 378               (forward-line (1- line))
 379
 380               ;; Search forward for the matching text
 381               (re-search-forward (regexp-quote txt)
 382                                  (point-at-eol)
 383                                  t)
 384
 385               (setq tag (semantic-current-tag))
 386
 387               ;; If we are searching for a tag, but bound the tag we are looking
 388               ;; for, see if it resides in some other parent tag.
 389               ;;
 390               ;; If there is no parent tag, then we still need to hang the originator
 391               ;; in our list.
 392               (when (and (eq searchtype 'symbol)
 393                          (string= (semantic-tag-name tag) txt))
 394                 (setq tag (or (semantic-current-tag-parent) tag)))
 395
 396               ;; Copy the tag, which adds a :filename property.
 397               (when tag
 398                 (setq tag (semantic-tag-copy tag nil t))
 399                 ;; Ad this hit to the tag.
 400                 (semantic--tag-put-property tag :hit (list line)))
 401               tag))
 402           lines)))
 403       ;; Kill off dead buffers, unless we were requested to leave them open.
 404       (when (not open-buffers)
 405         (mapc 'kill-buffer buffs-to-kill))
 406       ;; Strip out duplicates.
 407       (dolist (T ans)
 408         (if (and T (not (semantic-equivalent-tag-p (car out) T)))
 409             (setq out (cons T out))
 410           (when T
 411             ;; Else, add this line into the existing list of lines.
 412             (let ((lines (append (semantic--tag-get-property (car out) :hit)
 413                                  (semantic--tag-get-property T :hit))))
 414               (semantic--tag-put-property (car out) :hit lines)))
 415           ))
 416       ;; Out is reversed... twice
 417       (oset result :hit-tags (nreverse out)))))
 418
 419 ;;; SYMREF TOOLS
 420 ;;
 421 ;; The base symref tool provides something to hang new tools off of
 422 ;; for finding symbol references.
 423 (defclass semantic-symref-tool-baseclass ()
 424   ((searchfor :initarg :searchfor
 425               :type string
 426               :documentation "The thing to search for.")
 427    (searchtype :initarg :searchtype
 428                 :type symbol
 429                 :documentation "The type of search to do.
 430 Values could be `symbol, `regexp, 'tagname, or 'completion.")
 431    (searchscope :initarg :searchscope
 432                 :type symbol
 433                 :documentation
 434                 "The scope to search for.
 435 Can be 'project, 'target, or 'file.")
 436    (resulttype :initarg :resulttype
 437                :type symbol
 438                :documentation
 439                "The kind of search results desired.
 440 Can be 'line, 'file, or 'tag.
 441 The type of result can be converted from 'line to 'file, or 'line to 'tag,
 442 but not from 'file to 'line or 'tag.")
 443    )
 444   "Baseclass for all symbol references tools.
 445 A symbol reference tool supplies functionality to identify the locations of
 446 where different symbols are used.
 447
 448 Subclasses should be named `semantic-symref-tool-NAME', where
 449 NAME is the name of the tool used in the configuration variable
 450 `semantic-symref-tool'"
 451   :abstract t)
 452
 453 (defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
 454   "Calculate the results of a search based on TOOL.
 455 The symref TOOL should already contain the search criteria."
 456   (let ((answer (semantic-symref-perform-search tool))
 457         )
 458     (when answer
 459       (let ((answersym (if (eq (oref tool :resulttype) 'file)
 460                            :hit-files
 461                          (if (stringp (car answer))
 462                              :hit-text
 463                            :hit-lines))))
 464         (semantic-symref-result (oref tool searchfor)
 465                                 answersym
 466                                 answer
 467                                 :created-by tool))
 468       )
 469     ))
 470
 471 (defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
 472   "Base search for symref tools should throw an error."
 473   (error "Symref tool objects must implement `semantic-symref-perform-search'"))
 474
 475 (defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
 476                                               outputbuffer)
 477   "Parse the entire OUTPUTBUFFER of a symref tool.
 478 Calls the method `semantic-symref-parse-tool-output-one-line' over and
 479 over until it returns nil."
 480   (save-excursion
 481     (set-buffer outputbuffer)
 482     (goto-char (point-min))
 483     (let ((result nil)
 484           (hit nil))
 485       (while (setq hit (semantic-symref-parse-tool-output-one-line tool))
 486         (setq result (cons hit result)))
 487       (nreverse result)))
 488   )
 489
 490 (defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
 491   "Base tool output parser is not implemented."
 492   (error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'"))
 493
 494 (provide 'semantic/symref)
 495
 496 ;; Local variables:
 497 ;; generated-autoload-file: "loaddefs.el"
 498 ;; generated-autoload-feature: semantic/loaddefs
 499 ;; generated-autoload-load-name: "semantic/symref"
 500 ;; End:
 501
 502 ;;; semantic/symref.el ends here