1 ;;; semantic/symref.el --- Symbol Reference API
3 ;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
24 ;; Semantic Symbol Reference API.
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.
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.
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
41 ;; See the command: `semantic-symref' for an example app using this api.
45 ;; The following functions can be used to find different kinds of
48 ;; `semantic-symref-find-references-by-name'
49 ;; `semantic-symref-find-file-references-by-name'
50 ;; `semantic-symref-find-text'
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.
56 ;; `semantic-symref-result-get-files'
57 ;; `semantic-symref-result-get-tags'
59 ;; ADD A NEW EXTERNAL TOOL
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.
65 ;; Your tool should then create an instance of `semantic-symref-result'.
68 (eval-when-compile (require 'semantic/find)) ;For semantic-find-tags-*
69 (eval-when-compile (require 'ede/proj)) ;For `metasubproject' warning.
71 (defvar ede-minor-mode)
72 (declare-function data-debug-new-buffer "data-debug")
73 (declare-function data-debug-insert-object-slots "eieio-datadebug")
74 (declare-function ede-toplevel "ede/base")
75 (declare-function ede-project-root-directory "ede/files")
76 (declare-function ede-up-directory "ede/files")
79 (defvar semantic-symref-tool 'detect
80 "*The active symbol reference tool name.
81 The tool symbol can be 'detect, or a symbol that is the name of
82 a tool that can be used for symbol referencing.")
83 (make-variable-buffer-local 'semantic-symref-tool)
87 (defvar semantic-symref-tool-alist
88 '( ( (lambda (rootdir) (file-exists-p (expand-file-name "GPATH" rootdir))) .
90 ( (lambda (rootdir) (file-exists-p (expand-file-name "ID" rootdir))) .
92 ( (lambda (rootdir) (file-exists-p (expand-file-name "cscope.out" rootdir))) .
95 "Alist of tools usable by `semantic-symref'.
96 Each entry is of the form:
98 Where PREDICATE is a function that takes a directory name for the
99 root of a project, and returns non-nil if the tool represented by KEY
102 If no tools are supported, then 'grep is assumed.")
104 (defun semantic-symref-calculate-rootdir ()
105 "Calculate the root directory for a symref search.
106 Start with an EDE project, or use the default directory."
107 (let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
109 (rootdirbase (if rootproj
110 (ede-project-root-directory rootproj)
112 (if (and rootproj (condition-case nil
113 ;; Hack for subprojects.
114 (oref rootproj metasubproject)
116 (ede-up-directory rootdirbase)
119 (defun semantic-symref-detect-symref-tool ()
120 "Detect the symref tool to use for the current buffer."
121 (if (not (eq semantic-symref-tool 'detect))
123 ;; We are to perform a detection for the right tool to use.
124 (let* ((rootdir (semantic-symref-calculate-rootdir))
125 (tools semantic-symref-tool-alist))
126 (while (and tools (eq semantic-symref-tool 'detect))
127 (when (funcall (car (car tools)) rootdir)
128 (setq semantic-symref-tool (cdr (car tools))))
129 (setq tools (cdr tools)))
131 (when (eq semantic-symref-tool 'detect)
132 (setq semantic-symref-tool 'grep))
134 semantic-symref-tool)))
136 (defun semantic-symref-instantiate (&rest args)
137 "Instantiate a new symref search object.
138 ARGS are the initialization arguments to pass to the created class."
139 (let* ((srt (symbol-name (semantic-symref-detect-symref-tool)))
140 (class (intern-soft (concat "semantic-symref-tool-" srt)))
143 (when (not (class-p class))
144 (error "Unknown symref tool %s" semantic-symref-tool))
145 (setq inst (apply 'make-instance class args))
148 (defvar semantic-symref-last-result nil
149 "The last calculated symref result.")
151 (defun semantic-symref-data-debug-last-result ()
152 "Run the last symref data result in Data Debug."
154 (require 'eieio-datadebug)
155 (if semantic-symref-last-result
157 (data-debug-new-buffer "*Symbol Reference ADEBUG*")
158 (data-debug-insert-object-slots semantic-symref-last-result "]"))
159 (message "Empty results.")))
165 (defun semantic-symref-find-references-by-name (name &optional scope tool-return)
166 "Find a list of references to NAME in the current project.
167 Optional SCOPE specifies which file set to search. Defaults to `project'.
168 Refers to `semantic-symref-tool', to determine the reference tool to use
169 for the current buffer.
170 Returns an object of class `semantic-symref-result'.
171 TOOL-RETURN is an optional symbol, which will be assigned the tool used
172 to perform the search. This was added for use by a test harness."
173 (interactive "sName: ")
174 (let* ((inst (semantic-symref-instantiate
177 :searchscope (or scope 'project)
179 (result (semantic-symref-get-result inst)))
181 (set tool-return inst))
183 (setq semantic-symref-last-result result)
184 (when (called-interactively-p 'interactive)
185 (semantic-symref-data-debug-last-result))))
189 (defun semantic-symref-find-tags-by-name (name &optional scope)
190 "Find a list of tags by NAME in the current project.
191 Optional SCOPE specifies which file set to search. Defaults to `project'.
192 Refers to `semantic-symref-tool', to determine the reference tool to use
193 for the current buffer.
194 Returns an object of class `semantic-symref-result'."
195 (interactive "sName: ")
196 (let* ((inst (semantic-symref-instantiate
199 :searchscope (or scope 'project)
201 (result (semantic-symref-get-result inst)))
203 (setq semantic-symref-last-result result)
204 (when (called-interactively-p 'interactive)
205 (semantic-symref-data-debug-last-result))))
209 (defun semantic-symref-find-tags-by-regexp (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
218 :searchtype 'tagregexp
219 :searchscope (or scope 'project)
221 (result (semantic-symref-get-result inst)))
223 (setq semantic-symref-last-result result)
224 (when (called-interactively-p 'interactive)
225 (semantic-symref-data-debug-last-result))))
229 (defun semantic-symref-find-tags-by-completion (name &optional scope)
230 "Find a list of references to NAME in the current project.
231 Optional SCOPE specifies which file set to search. Defaults to `project'.
232 Refers to `semantic-symref-tool', to determine the reference tool to use
233 for the current buffer.
234 Returns an object of class `semantic-symref-result'."
235 (interactive "sName: ")
236 (let* ((inst (semantic-symref-instantiate
238 :searchtype 'tagcompletions
239 :searchscope (or scope 'project)
241 (result (semantic-symref-get-result inst)))
243 (setq semantic-symref-last-result result)
244 (when (called-interactively-p 'interactive)
245 (semantic-symref-data-debug-last-result))))
249 (defun semantic-symref-find-file-references-by-name (name &optional scope)
250 "Find a list of references to NAME in the current project.
251 Optional SCOPE specifies which file set to search. Defaults to `project'.
252 Refers to `semantic-symref-tool', to determine the reference tool to use
253 for the current buffer.
254 Returns an object of class `semantic-symref-result'."
255 (interactive "sName: ")
256 (let* ((inst (semantic-symref-instantiate
259 :searchscope (or scope 'project)
261 (result (semantic-symref-get-result inst)))
263 (setq semantic-symref-last-result result)
264 (when (called-interactively-p 'interactive)
265 (semantic-symref-data-debug-last-result))))
269 (defun semantic-symref-find-text (text &optional scope)
270 "Find a list of occurrences of TEXT in the current project.
271 TEXT is a regexp formatted for use with grep -E.
272 Optional SCOPE specifies which file set to search. Defaults to `project'.
273 Refers to `semantic-symref-tool', to determine the reference tool to use
274 for the current buffer.
275 Returns an object of class `semantic-symref-result'."
276 (interactive "sGrep -E style Regexp: ")
277 (let* ((inst (semantic-symref-instantiate
280 :searchscope (or scope 'project)
282 (result (semantic-symref-get-result inst)))
284 (setq semantic-symref-last-result result)
285 (when (called-interactively-p 'interactive)
286 (semantic-symref-data-debug-last-result))))
291 ;; The base symref tool provides something to hang new tools off of
292 ;; for finding symbol references.
293 (defclass semantic-symref-tool-baseclass ()
294 ((searchfor :initarg :searchfor
296 :documentation "The thing to search for.")
297 (searchtype :initarg :searchtype
299 :documentation "The type of search to do.
300 Values could be 'symbol, 'regexp, 'tagname, or 'completion.")
301 (searchscope :initarg :searchscope
304 "The scope to search for.
305 Can be 'project, 'target, or 'file.")
306 (resulttype :initarg :resulttype
309 "The kind of search results desired.
310 Can be 'line, 'file, or 'tag.
311 The type of result can be converted from 'line to 'file, or 'line to 'tag,
312 but not from 'file to 'line or 'tag.")
314 "Baseclass for all symbol references tools.
315 A symbol reference tool supplies functionality to identify the locations of
316 where different symbols are used.
318 Subclasses should be named `semantic-symref-tool-NAME', where
319 NAME is the name of the tool used in the configuration variable
320 `semantic-symref-tool'"
323 (cl-defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
324 "Calculate the results of a search based on TOOL.
325 The symref TOOL should already contain the search criteria."
326 (let ((answer (semantic-symref-perform-search tool))
329 (let ((answersym (if (eq (oref tool resulttype) 'file)
331 (if (stringp (car answer))
334 (semantic-symref-result (oref tool searchfor)
341 (cl-defmethod semantic-symref-perform-search ((_tool semantic-symref-tool-baseclass))
342 "Base search for symref tools should throw an error."
343 (error "Symref tool objects must implement `semantic-symref-perform-search'"))
345 (cl-defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
347 "Parse the entire OUTPUTBUFFER of a symref tool.
348 Calls the method `semantic-symref-parse-tool-output-one-line' over and
349 over until it returns nil."
350 (with-current-buffer outputbuffer
351 (goto-char (point-min))
354 (while (setq hit (semantic-symref-parse-tool-output-one-line tool))
355 (setq result (cons hit result)))
359 (cl-defmethod semantic-symref-parse-tool-output-one-line ((_tool semantic-symref-tool-baseclass))
360 "Base tool output parser is not implemented."
361 (error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'"))
365 ;; The results class and methods provide features for accessing hits.
366 (defclass semantic-symref-result ()
367 ((created-by :initarg :created-by
368 :type semantic-symref-tool-baseclass
370 "Back-pointer to the symref tool creating these results.")
371 (hit-files :initarg :hit-files
374 "The list of files hit.")
375 (hit-text :initarg :hit-text
378 "If the result doesn't provide full lines, then fill in hit-text.
379 GNU Global does completion search this way.")
380 (hit-lines :initarg :hit-lines
383 "The list of line hits.
384 Each element is a cons cell of the form (LINE . FILENAME).")
385 (hit-tags :initarg :hit-tags
388 "The list of tags with hits in them.
389 Use the `semantic-symref-hit-tags' method to get this list.")
391 "The results from a symbol reference search.")
393 (cl-defmethod semantic-symref-result-get-files ((result semantic-symref-result))
394 "Get the list of files from the symref result RESULT."
395 (if (slot-boundp result 'hit-files)
396 (oref result hit-files)
397 (let* ((lines (oref result hit-lines))
398 (files (mapcar (lambda (a) (cdr a)) lines))
400 (setq ans (list (car files))
403 ;; This algorithm for uniquifying the file list depends on the
404 ;; tool in question providing all the hits in the same file
406 (when (not (string= F (car ans)))
407 (setq ans (cons F ans))))
408 (oset result hit-files (nreverse ans))
412 (defvar semantic-symref-recently-opened-buffers nil
413 "List of buffers opened by `semantic-symref-result-get-tags'.")
415 (defun semantic-symref-cleanup-recent-buffers-fcn ()
416 "Hook function to be used in `post-command-hook' to cleanup buffers.
417 Buffers collected during symref can result in some files being
418 opened multiple times for one operation. This will keep buffers open
419 until the next command is executed."
420 ;;(message "To Clean Up: %S" semantic-symref-recently-opened-buffers)
422 ;; Don't delete any buffers which are being used
423 ;; upon completion of some command.
424 (when (not (get-buffer-window buff))
426 semantic-symref-recently-opened-buffers)
427 (setq semantic-symref-recently-opened-buffers nil)
428 (remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
431 (cl-defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
432 &optional open-buffers)
433 "Get the list of tags from the symref result RESULT.
434 Optional OPEN-BUFFERS indicates that the buffers that the hits are
435 in should remain open after scanning.
436 Note: This can be quite slow if most of the hits are not in buffers
438 (if (and (slot-boundp result 'hit-tags) (oref result hit-tags))
439 (oref result hit-tags)
440 ;; Calculate the tags.
441 (let ((lines (oref result hit-lines))
442 (txt (oref (oref result created-by) searchfor))
443 (searchtype (oref (oref result created-by) searchtype))
449 (semantic-symref-hit-to-tag-via-buffer
450 hit txt searchtype open-buffers))
452 ;; Kill off dead buffers, unless we were requested to leave them open.
453 (if (not open-buffers)
454 (add-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
455 ;; Else, just clear the saved buffers so they aren't deleted later.
456 (setq semantic-symref-recently-opened-buffers nil)
458 ;; Strip out duplicates.
460 (if (and T (not (semantic-equivalent-tag-p (car out) T)))
461 (setq out (cons T out))
463 ;; Else, add this line into the existing list of lines.
464 (let ((lines (append (semantic--tag-get-property (car out) :hit)
465 (semantic--tag-get-property T :hit))))
466 (semantic--tag-put-property (car out) :hit lines)))
468 ;; Out is reversed... twice
469 (oset result hit-tags (nreverse out)))))
471 (defun semantic-symref-hit-to-tag-via-db (hit searchtxt searchtype)
472 "Convert the symref HIT into a TAG by looking up the tag via a database.
473 Return the Semantic tag associated with HIT.
474 SEARCHTXT is the text that is being searched for.
475 Used to narrow the in-buffer search.
476 SEARCHTYPE is the type of search (such as 'symbol or 'tagname).
477 If there is no database, of if the searchtype is wrong, return nil."
478 ;; Allowed search types for this mechanism:
479 ;; tagname, tagregexp, tagcompletions
480 (if (not (memq searchtype '(tagname tagregexp tagcompletions)))
482 (let* ((file (cdr hit))
483 ;; FAIL here vv - don't load is not obeyed if no table found.
484 (db (semanticdb-file-table-object file t))
486 (cond ((eq searchtype 'tagname)
487 (semantic-find-tags-by-name searchtxt db))
488 ((eq searchtype 'tagregexp)
489 (semantic-find-tags-by-name-regexp searchtxt db))
490 ((eq searchtype 'tagcompletions)
491 (semantic-find-tags-for-completion searchtxt db))))
494 ;; Loop over FOUND to see if we can line up a match with a line number.
495 (when (= (length found) 1)
496 (setq hit (car found)))
498 ;; FAIL here ^^ - symref finds line numbers, but our DB uses character locations.
499 ;; as such, this is a cheat and we will need to give up.
502 (defun semantic-symref-hit-to-tag-via-buffer (hit searchtxt searchtype &optional open-buffers)
503 "Convert the symref HIT into a TAG by looking up the tag via a buffer.
504 Return the Semantic tag associated with HIT.
505 SEARCHTXT is the text that is being searched for.
506 Used to narrow the in-buffer search.
507 SEARCHTYPE is the type of search (such as 'symbol or 'tagname).
508 Optional OPEN-BUFFERS, when nil will use a faster version of
509 `find-file' when a file needs to be opened. If non-nil, then
510 normal buffer initialization will be used.
511 This function will leave buffers loaded from a file open, but
512 will add buffers that must be opened to `semantic-symref-recently-opened-buffers'.
513 Any caller MUST deal with that variable, either clearing it, or deleting the
514 buffers that were opened."
515 (let* ((line (car hit))
517 (buff (find-buffer-visiting file))
521 ;; We have a buffer already. Check it out.
525 ;; We have a table, but it needs a refresh.
526 ;; This means we should load in that buffer.
530 ;; Even if we keep the buffers open, don't
531 ;; let EDE ask lots of questions.
532 (let ((ede-auto-add-method 'never))
533 (find-file-noselect file t))
534 ;; When not keeping the buffers open, then
535 ;; don't setup all the fancy froo-froo features
537 (semantic-find-file-noselect file t))))
539 (push kbuff semantic-symref-recently-opened-buffers)
540 (semantic-fetch-tags)
544 ;; Too much baggage in goto-line
546 (goto-char (point-min))
547 (forward-line (1- line))
549 ;; Search forward for the matching text.
550 ;; FIXME: This still fails if the regexp uses something specific
551 ;; to the extended syntax, like grouping.
552 (when (re-search-forward (if (memq searchtype '(regexp tagregexp))
554 (regexp-quote searchtxt))
557 (goto-char (match-beginning 0))
560 (setq tag (semantic-current-tag))
562 ;; If we are searching for a tag, but bound the tag we are looking
563 ;; for, see if it resides in some other parent tag.
565 ;; If there is no parent tag, then we still need to hang the originator
567 (when (and (eq searchtype 'symbol)
568 (string= (semantic-tag-name tag) searchtxt))
569 (setq tag (or (semantic-current-tag-parent) tag)))
571 ;; Copy the tag, which adds a :filename property.
573 (setq tag (semantic-tag-copy tag nil t))
574 ;; Ad this hit to the tag.
575 (semantic--tag-put-property tag :hit (list line)))
578 (provide 'semantic/symref)
581 ;; generated-autoload-file: "loaddefs.el"
582 ;; generated-autoload-load-name: "semantic/symref"
585 ;;; semantic/symref.el ends here