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