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