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