summaryrefslogtreecommitdiff
path: root/lisp/cedet/semantic/symref/filter.el
blob: 7ef3cd90d67c8fe3973662e4b56474ccc52c3563 (plain)
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
;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy  -*- lexical-binding: t; -*-

;; Copyright (C) 2009-2021 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:
;;
;; Filter symbol reference hits for accuracy.
;;
;; Most symbol referencing tools, such as find/grep only find matching
;; strings, but cannot determine the difference between an actual use,
;; and something else with a similar name, or even a string in a comment.
;;
;; This file provides utilities for filtering down to accurate matches
;; starting at a basic filter level that doesn't use symref, up to filters
;; across symref results.

;;; Code:

(require 'semantic)
(require 'semantic/analyze)
(declare-function srecode-active-template-region "srecode/fields")
(declare-function srecode-delete "srecode/fields")
(declare-function srecode-field "srecode/fields")
(declare-function srecode-template-inserted-region "srecode/fields")
(declare-function srecode-overlaid-activate "srecode/fields")
(declare-function semantic-idle-summary-useful-context-p "semantic/idle")

;;; FILTERS
;;
(defun semantic-symref-filter-hit (target &optional position)
  "Determine if the tag TARGET is used at POSITION in the current buffer.
Return non-nil for a match."
  (semantic-analyze-current-symbol
   (lambda (_start _end prefix)
     (let ((tag (car (nreverse prefix))))
       (and (semantic-tag-p tag)
	    (semantic-equivalent-tag-p target tag))))
   position))

;;; IN-BUFFER FILTERING

;; The following does filtering in-buffer only, and not against
;; a symref results object.

(defun semantic-symref-hits-in-region (target hookfcn start end)
  "Find all occurrences of the symbol TARGET that match TARGET the tag.
For each match, call HOOKFCN.
HOOKFCN takes three arguments that match
`semantic-analyze-current-symbol's use of HOOKFCN.
  ( START END PREFIX )

Search occurs in the current buffer between START and END."
  (require 'semantic/idle)
  (save-excursion
    (goto-char start)
    (let* ((str (semantic-tag-name target))
	   (case-fold-search semantic-case-fold)
	   (regexp (concat "\\<" (regexp-quote str) "\\>")))
      (while (re-search-forward regexp end t)
	(when (semantic-idle-summary-useful-context-p)
	  (semantic-analyze-current-symbol
	   (lambda (start end prefix)
	     (let ((tag (car (nreverse prefix))))
	       ;; check for semantic match on the text match.
	       (when (and (semantic-tag-p tag)
			  (semantic-equivalent-tag-p target tag))
		 (save-excursion
		   (funcall hookfcn start end prefix)))))
	   (point)))))))

(defun semantic-symref-test-count-hits-in-tag ()
  "Lookup in the current tag the symbol under point.
the count all the other references to the same symbol within the
tag that contains point, and return that."
  (interactive)
  (let* ((ctxt (semantic-analyze-current-context))
	 (target (car (reverse (oref ctxt prefix))))
	 (tag (semantic-current-tag))
	 (start (current-time))
	 (Lcount 0))
    (when (semantic-tag-p target)
      (semantic-symref-hits-in-region
       target (lambda (_start _end _prefix) (setq Lcount (1+ Lcount)))
       (semantic-tag-start tag)
       (semantic-tag-end tag))
      (when (called-interactively-p 'interactive)
	(message "Found %d occurrences of %s in %.2f seconds"
		 Lcount (semantic-tag-name target)
		 (semantic-elapsed-time start nil)))
      Lcount)))

(defvar srecode-field-archive)

(defun semantic-symref-rename-local-variable ()
  "Fancy way to rename the local variable under point.
Depends on the SRecode Field editing API."
  (interactive)
  ;; Do the replacement as needed.
  (let* ((ctxt (semantic-analyze-current-context))
	 (target (car (reverse (oref ctxt prefix))))
	 (tag (semantic-current-tag))
	 )

    (when (or (not target)
	      (not (semantic-tag-with-position-p target)))
      (error "Cannot identify symbol under point"))

    (when (not (semantic-tag-of-class-p target 'variable))
      (error "Can only rename variables"))

    (when (or (< (semantic-tag-start target) (semantic-tag-start tag))
	      (> (semantic-tag-end target) (semantic-tag-end tag)))
      (error "Can only rename variables declared in %s"
	     (semantic-tag-name tag)))

    ;; I think we're good for this example.  Give it a go through
    ;; our fancy interface from SRecode.
    (require 'srecode/fields)

    ;; Make sure there is nothing active.
    (let ((ar (srecode-active-template-region)))
      (when ar (srecode-delete ar)))

    (let ((srecode-field-archive nil)
	  (region nil)
	  )
      (semantic-symref-hits-in-region
       target (lambda (start end _prefix)
		;; For every valid hit, create one field.
		(srecode-field "LOCAL" :name "LOCAL" :start start :end end))
       (semantic-tag-start tag) (semantic-tag-end tag))

      ;; Now that the fields are setup, create the region.
      (setq region (srecode-template-inserted-region
		    "REGION" :start (semantic-tag-start tag)
		    :end (semantic-tag-end tag)))

      ;; Activate the region.
      (srecode-overlaid-activate region)

      )
    ))

(provide 'semantic/symref/filter)

;;; semantic/symref/filter.el ends here