1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
| | ;;; semantic/symref.el --- Symbol Reference API -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2023 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Semantic Symbol Reference API.
;;
;; Semantic's native parsing tools do not handle symbol references.
;; Tracking such information is a task that requires a huge amount of
;; space and processing not appropriate for an Emacs Lisp program.
;;
;; Many desired tools used in refactoring, however, need to have
;; such references available to them. This API aims to provide a
;; range of functions that can be used to identify references. The
;; API is backed by an OO system that is used to allow multiple
;; external tools to provide the information.
;;
;; The default implementation uses a find/grep combination to do a
;; search. This works ok in small projects. For larger projects, it
;; is important to find an alternate tool to use as a back-end to
;; symref.
;;
;; See the command: `semantic-symref' for an example app using this api.
;;
;; TO USE THIS TOOL
;;
;; The following functions can be used to find different kinds of
;; references.
;;
;; `semantic-symref-find-references-by-name'
;; `semantic-symref-find-file-references-by-name'
;; `semantic-symref-find-text'
;;
;; All the search routines return a class of type
;; `semantic-symref-result'. You can reference the various slots, but
;; you will need the following methods to get extended information.
;;
;; `semantic-symref-result-get-files'
;; `semantic-symref-result-get-tags'
;;
;; ADD A NEW EXTERNAL TOOL
;;
;; To support a new external tool, subclass `semantic-symref-tool-baseclass'
;; and implement the methods. The baseclass provides support for
;; managing external processes that produce parsable output.
;;
;; Your tool should then create an instance of `semantic-symref-result'.
(require 'semantic)
(eval-when-compile (require 'semantic/find)) ;For semantic-find-tags-*
(eval-when-compile (require 'ede/proj)) ;For `metasubproject' warning.
(defvar ede-minor-mode)
(declare-function data-debug-new-buffer "data-debug")
(declare-function data-debug-insert-object-slots "eieio-datadebug")
(declare-function ede-toplevel "ede/base")
(declare-function ede-project-root-directory "ede/files")
(declare-function ede-up-directory "ede/files")
;;; Code:
(defcustom semantic-symref-tool 'detect
"The active symbol reference tool name.
The tool symbol can be `detect', or a symbol that is the name of
a tool that can be used for symbol referencing."
:type 'symbol
:group 'semantic)
(make-variable-buffer-local 'semantic-symref-tool)
;;; TOOL SETUP
;;
(defvar semantic-symref-tool-alist
'( ( (lambda (rootdir) (file-exists-p (expand-file-name "GPATH" rootdir))) .
global)
( (lambda (rootdir) (file-exists-p (expand-file-name "ID" rootdir))) .
idutils)
( (lambda (rootdir) (file-exists-p (expand-file-name "cscope.out" rootdir))) .
cscope )
)
"Alist of tools usable by `semantic-symref'.
Each entry is of the form:
( PREDICATE . KEY )
Where PREDICATE is a function that takes a directory name for the
root of a project, and returns non-nil if the tool represented by KEY
is supported.
If no tools are supported, then `grep' is assumed.")
(defun semantic-symref-calculate-rootdir ()
"Calculate the root directory for a symref search.
Start with an EDE project, or use the default directory."
(let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
(ede-toplevel)))
(rootdirbase (if rootproj
(ede-project-root-directory rootproj)
default-directory)))
(if (and rootproj (condition-case nil
;; Hack for subprojects.
(oref rootproj metasubproject)
(error nil)))
(ede-up-directory rootdirbase)
rootdirbase)))
(defun semantic-symref-detect-symref-tool ()
"Detect the symref tool to use for the current buffer."
(if (not (eq semantic-symref-tool 'detect))
semantic-symref-tool
;; We are to perform a detection for the right tool to use.
(let* ((rootdir (semantic-symref-calculate-rootdir))
(tools semantic-symref-tool-alist))
(while (and tools (eq semantic-symref-tool 'detect))
(when (funcall (car (car tools)) rootdir)
(setq semantic-symref-tool (cdr (car tools))))
(setq tools (cdr tools)))
(when (eq semantic-symref-tool 'detect)
(setq semantic-symref-tool 'grep))
semantic-symref-tool)))
(defun semantic-symref-instantiate (&rest args)
"Instantiate a new symref search object.
ARGS are the initialization arguments to pass to the created class."
(let* ((srt (symbol-name (semantic-symref-detect-symref-tool)))
(class (intern-soft (concat "semantic-symref-tool-" srt)))
(inst nil)
)
(when (not (class-p class))
(error "Unknown symref tool %s" semantic-symref-tool))
(setq inst (apply #'make-instance class args))
inst))
(defvar semantic-symref-last-result nil
"The last calculated symref result.")
(defun semantic-symref-data-debug-last-result ()
"Run the last symref data result in Data Debug."
(interactive)
(require 'eieio-datadebug)
(if semantic-symref-last-result
(progn
(data-debug-new-buffer "*Symbol Reference ADEBUG*")
(data-debug-insert-object-slots semantic-symref-last-result "]"))
(message "Empty results.")))
;;; EXTERNAL API
;;
;;;###autoload
(defun semantic-symref-find-references-by-name (name &optional scope tool-return)
"Find a list of references to NAME in the current project.
Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'.
TOOL-RETURN is an optional symbol, which will be assigned the tool used
to perform the search. This was added for use by a test harness."
(interactive "sName: ")
(let* ((inst (semantic-symref-instantiate
:searchfor name
:searchtype 'symbol
:searchscope (or scope 'project)
:resulttype 'line))
(result (semantic-symref-get-result inst)))
(when tool-return
(set tool-return inst))
(prog1
(setq semantic-symref-last-result result)
(when (called-interactively-p 'interactive)
(semantic-symref-data-debug-last-result))))
)
;;;###autoload
(defun semantic-symref-find-tags-by-name (name &optional scope)
"Find a list of tags by NAME in the current project.
Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'."
(interactive "sName: ")
(let* ((inst (semantic-symref-instantiate
:searchfor name
:searchtype 'tagname
:searchscope (or scope 'project)
:resulttype 'line))
(result (semantic-symref-get-result inst)))
(prog1
(setq semantic-symref-last-result result)
(when (called-interactively-p 'interactive)
(semantic-symref-data-debug-last-result))))
)
;;;###autoload
(defun semantic-symref-find-tags-by-regexp (name &optional scope)
"Find a list of references to NAME in the current project.
Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'."
(interactive "sName: ")
(let* ((inst (semantic-symref-instantiate
:searchfor name
:searchtype 'tagregexp
:searchscope (or scope 'project)
:resulttype 'line))
(result (semantic-symref-get-result inst)))
(prog1
(setq semantic-symref-last-result result)
(when (called-interactively-p 'interactive)
(semantic-symref-data-debug-last-result))))
)
;;;###autoload
(defun semantic-symref-find-tags-by-completion (name &optional scope)
"Find a list of references to NAME in the current project.
Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'."
(interactive "sName: ")
(let* ((inst (semantic-symref-instantiate
:searchfor name
:searchtype 'tagcompletions
:searchscope (or scope 'project)
:resulttype 'line))
(result (semantic-symref-get-result inst)))
(prog1
(setq semantic-symref-last-result result)
(when (called-interactively-p 'interactive)
(semantic-symref-data-debug-last-result))))
)
;;;###autoload
(defun semantic-symref-find-file-references-by-name (name &optional scope)
"Find a list of references to NAME in the current project.
Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'."
(interactive "sName: ")
(let* ((inst (semantic-symref-instantiate
:searchfor name
:searchtype 'regexp
:searchscope (or scope 'project)
:resulttype 'file))
(result (semantic-symref-get-result inst)))
(prog1
(setq semantic-symref-last-result result)
(when (called-interactively-p 'interactive)
(semantic-symref-data-debug-last-result))))
)
;;;###autoload
(defun semantic-symref-find-text (text &optional scope)
"Find a list of occurrences of TEXT in the current project.
TEXT is a regexp formatted for use with grep -E.
Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'."
(interactive "sGrep -E style Regexp: ")
(let* ((inst (semantic-symref-instantiate
:searchfor text
:searchtype 'regexp
:searchscope (or scope 'project)
:resulttype 'line))
(result (semantic-symref-get-result inst)))
(prog1
(setq semantic-symref-last-result result)
(when (called-interactively-p 'interactive)
(semantic-symref-data-debug-last-result))))
)
;;; SYMREF TOOLS
;;
;; The base symref tool provides something to hang new tools off of
;; for finding symbol references.
(defclass semantic-symref-tool-baseclass ()
((searchfor :initarg :searchfor
:type string
:documentation "The thing to search for.")
(searchtype :initarg :searchtype
:type symbol
:documentation "The type of search to do.
Values could be 'symbol, 'regexp, 'tagname, or 'completion.")
(searchscope :initarg :searchscope
:type symbol
:documentation
"The scope to search for.
Can be 'project, 'target, or 'file.")
(resulttype :initarg :resulttype
:type symbol
:documentation
"The kind of search results desired.
Can be `line', `file', or `tag'.
The type of result can be converted from `line' to `file', or `line' to `tag',
but not from `file' to `line' or `tag'.")
)
"Baseclass for all symbol references tools.
A symbol reference tool supplies functionality to identify the locations of
where different symbols are used.
Subclasses should be named `semantic-symref-tool-NAME', where
NAME is the name of the tool used in the configuration variable
`semantic-symref-tool'."
:abstract t)
(cl-defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
"Calculate the results of a search based on TOOL.
The symref TOOL should already contain the search criteria."
(let ((answer (semantic-symref-perform-search tool))
)
(when answer
(let ((answersym (if (eq (oref tool resulttype) 'file)
:hit-files
(if (stringp (car answer))
:hit-text
:hit-lines))))
(semantic-symref-result (oref tool searchfor)
answersym
answer
:created-by tool))
)
))
(cl-defmethod semantic-symref-perform-search ((_tool semantic-symref-tool-baseclass))
"Base search for symref tools should throw an error."
(error "Symref tool objects must implement `semantic-symref-perform-search'"))
(cl-defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
outputbuffer)
"Parse the entire OUTPUTBUFFER of a symref tool.
Calls the method `semantic-symref-parse-tool-output-one-line' over and
over until it returns nil."
(with-current-buffer outputbuffer
(goto-char (point-min))
(let ((result nil)
(hit nil))
(while (setq hit (semantic-symref-parse-tool-output-one-line tool))
(setq result (cons hit result)))
(nreverse result)))
)
(cl-defmethod semantic-symref-parse-tool-output-one-line ((_tool semantic-symref-tool-baseclass))
"Base tool output parser is not implemented."
(error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'"))
;;; RESULTS
;;
;; The results class and methods provide features for accessing hits.
(defclass semantic-symref-result ()
((created-by :initarg :created-by
:type semantic-symref-tool-baseclass
:documentation
"Back-pointer to the symref tool creating these results.")
(hit-files :initarg :hit-files
:type list
:documentation
"The list of files hit.")
(hit-text :initarg :hit-text
:type list
:documentation
"If the result doesn't provide full lines, then fill in hit-text.
GNU Global does completion search this way.")
(hit-lines :initarg :hit-lines
:type list
:documentation
"The list of line hits.
Each element is a cons cell of the form (LINE . FILENAME).")
(hit-tags :initarg :hit-tags
:type list
:documentation
"The list of tags with hits in them.
Use the `semantic-symref-hit-to-tag-via-buffer' method to get
this list.")
)
"The results from a symbol reference search.")
(cl-defmethod semantic-symref-result-get-files ((result semantic-symref-result))
"Get the list of files from the symref result RESULT."
(if (slot-boundp result 'hit-files)
(oref result hit-files)
(let* ((lines (oref result hit-lines))
(files (mapcar #'cdr lines))
(ans nil))
(setq ans (list (car files))
files (cdr files))
(dolist (F files)
;; This algorithm for uniquifying the file list depends on the
;; tool in question providing all the hits in the same file
;; grouped together.
(when (not (string= F (car ans)))
(setq ans (cons F ans))))
(oset result hit-files (nreverse ans))
)
))
(defvar semantic-symref-recently-opened-buffers nil
"List of buffers opened by `semantic-symref-result-get-tags'.")
(defun semantic-symref-cleanup-recent-buffers-fcn ()
"Hook function to be used in `post-command-hook' to cleanup buffers.
Buffers collected during symref can result in some files being
opened multiple times for one operation. This will keep buffers open
until the next command is executed."
;;(message "To Clean Up: %S" semantic-symref-recently-opened-buffers)
(mapc (lambda (buff)
;; Don't delete any buffers which are being used
;; upon completion of some command.
(when (not (get-buffer-window buff))
(kill-buffer buff)))
semantic-symref-recently-opened-buffers)
(setq semantic-symref-recently-opened-buffers nil)
(remove-hook 'post-command-hook #'semantic-symref-cleanup-recent-buffers-fcn)
)
(cl-defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
&optional open-buffers)
"Get the list of tags from the symref result RESULT.
Optional OPEN-BUFFERS indicates that the buffers that the hits are
in should remain open after scanning.
Note: This can be quite slow if most of the hits are not in buffers
already."
(if (and (slot-boundp result 'hit-tags) (oref result hit-tags))
(oref result hit-tags)
;; Calculate the tags.
(let ((lines (oref result hit-lines))
(txt (oref (oref result created-by) searchfor))
(searchtype (oref (oref result created-by) searchtype))
(ans nil)
(out nil))
(save-excursion
(setq ans (mapcar
(lambda (hit)
(semantic-symref-hit-to-tag-via-buffer
hit txt searchtype open-buffers))
lines)))
;; Kill off dead buffers, unless we were requested to leave them open.
(if (not open-buffers)
(add-hook 'post-command-hook #'semantic-symref-cleanup-recent-buffers-fcn)
;; Else, just clear the saved buffers so they aren't deleted later.
(setq semantic-symref-recently-opened-buffers nil)
)
;; Strip out duplicates.
(dolist (T ans)
(if (and T (not (semantic-equivalent-tag-p (car out) T)))
(setq out (cons T out))
(when T
;; Else, add this line into the existing list of lines.
(let ((lines (append (semantic--tag-get-property (car out) :hit)
(semantic--tag-get-property T :hit))))
(semantic--tag-put-property (car out) :hit lines)))
))
;; Out is reversed... twice
(oset result hit-tags (nreverse out)))))
(defun semantic-symref-hit-to-tag-via-db (hit searchtxt searchtype)
"Convert the symref HIT into a TAG by looking up the tag via a database.
Return the Semantic tag associated with HIT.
SEARCHTXT is the text that is being searched for.
Used to narrow the in-buffer search.
SEARCHTYPE is the type of search (such as `symbol' or `tagname').
If there is no database, or if the searchtype is wrong, return nil."
;; Allowed search types for this mechanism:
;; tagname, tagregexp, tagcompletions
(if (not (memq searchtype '(tagname tagregexp tagcompletions)))
nil
(let* ((file (cdr hit))
;; FAIL here vv - don't load is not obeyed if no table found.
(db (semanticdb-file-table-object file t))
(found
(cond ((eq searchtype 'tagname)
(semantic-find-tags-by-name searchtxt db))
((eq searchtype 'tagregexp)
(semantic-find-tags-by-name-regexp searchtxt db))
((eq searchtype 'tagcompletions)
(semantic-find-tags-for-completion searchtxt db))))
(hit nil)
)
;; Loop over FOUND to see if we can line up a match with a line number.
(when (= (length found) 1)
(setq hit (car found)))
;; FAIL here ^^ - symref finds line numbers, but our DB uses character locations.
;; as such, this is a cheat and we will need to give up.
hit)))
(defun semantic-symref-hit-to-tag-via-buffer (hit searchtxt searchtype &optional open-buffers)
"Convert the symref HIT into a TAG by looking up the tag via a buffer.
Return the Semantic tag associated with HIT.
SEARCHTXT is the text that is being searched for.
Used to narrow the in-buffer search.
SEARCHTYPE is the type of search (such as `symbol' or `tagname').
Optional OPEN-BUFFERS, when nil will use a faster version of
`find-file' when a file needs to be opened. If non-nil, then
normal buffer initialization will be used.
This function will leave buffers loaded from a file open, but
will add buffers that must be opened to
`semantic-symref-recently-opened-buffers'.
Any caller MUST deal with that variable, either clearing it, or
deleting the buffers that were opened."
(let* ((line (car hit))
(file (cdr hit))
(buff (find-buffer-visiting file))
(tag nil)
)
(cond
;; We have a buffer already. Check it out.
(buff
(set-buffer buff))
;; We have a table, but it needs a refresh.
;; This means we should load in that buffer.
(t
(let ((kbuff
(if open-buffers
;; Even if we keep the buffers open, don't
;; let EDE ask lots of questions.
(let ((ede-auto-add-method 'never))
(find-file-noselect file t))
;; When not keeping the buffers open, then
;; don't setup all the fancy froo-froo features
;; either.
(semantic-find-file-noselect file t))))
(set-buffer kbuff)
(push kbuff semantic-symref-recently-opened-buffers)
(semantic-fetch-tags)
))
)
;; Too much baggage in goto-line
;; (goto-line line)
(goto-char (point-min))
(forward-line (1- line))
;; Search forward for the matching text.
;; FIXME: This still fails if the regexp uses something specific
;; to the extended syntax, like grouping.
(when (re-search-forward (if (memq searchtype '(regexp tagregexp))
searchtxt
(regexp-quote searchtxt))
(line-end-position)
t)
(goto-char (match-beginning 0))
)
(setq tag (semantic-current-tag))
;; If we are searching for a tag, but bound the tag we are looking
;; for, see if it resides in some other parent tag.
;;
;; If there is no parent tag, then we still need to hang the originator
;; in our list.
(when (and (eq searchtype 'symbol)
(string= (semantic-tag-name tag) searchtxt))
(setq tag (or (semantic-current-tag-parent) tag)))
;; Copy the tag, which adds a :filename property.
(when tag
(setq tag (semantic-tag-copy tag nil t))
;; Ad this hit to the tag.
(semantic--tag-put-property tag :hit (list line)))
tag))
(provide 'semantic/symref)
;; Local variables:
;; generated-autoload-file: "loaddefs.el"
;; generated-autoload-load-name: "semantic/symref"
;; End:
;;; semantic/symref.el ends here
|