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