lisp/cedet/semantic/symref/filter.el

   1 ;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy.
   2
   3 ;; Copyright (C) 2009-2014 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 ;; Filter symbol reference hits for accuracy.
  25 ;;
  26 ;; Most symbol referencing tools, such as find/grep only find matching
  27 ;; strings, but cannot determine the difference between an actual use,
  28 ;; and something else with a similar name, or even a string in a comment.
  29 ;;
  30 ;; This file provides utilities for filtering down to accurate matches
  31 ;; starting at a basic filter level that doesn't use symref, up to filters
  32 ;; across symref results.
  33
  34 ;;; Code:
  35
  36 (require 'semantic)
  37 (require 'semantic/analyze)
  38 (declare-function srecode-active-template-region "srecode/fields")
  39 (declare-function srecode-delete "srecode/fields")
  40 (declare-function srecode-field "srecode/fields")
  41 (declare-function srecode-template-inserted-region "srecode/fields")
  42 (declare-function srecode-overlaid-activate "srecode/fields")
  43 (declare-function semantic-idle-summary-useful-context-p "semantic/idle")
  44
  45 ;;; FILTERS
  46 ;;
  47 (defun semantic-symref-filter-hit (target &optional position)
  48   "Determine if the tag TARGET is used at POSITION in the current buffer.
  49 Return non-nil for a match."
  50   (semantic-analyze-current-symbol
  51    (lambda (start end prefix)
  52      (let ((tag (car (nreverse prefix))))
  53        (and (semantic-tag-p tag)
  54             (semantic-equivalent-tag-p target tag))))
  55    position))
  56
  57 ;;; IN-BUFFER FILTERING
  58
  59 ;; The following does filtering in-buffer only, and not against
  60 ;; a symref results object.
  61
  62 (defun semantic-symref-hits-in-region (target hookfcn start end)
  63   "Find all occurrences of the symbol TARGET that match TARGET the tag.
  64 For each match, call HOOKFCN.
  65 HOOKFCN takes three arguments that match
  66 `semantic-analyze-current-symbol's use of HOOKFCN.
  67   ( START END PREFIX )
  68
  69 Search occurs in the current buffer between START and END."
  70   (require 'semantic/idle)
  71   (save-excursion
  72     (goto-char start)
  73     (let* ((str (semantic-tag-name target))
  74            (case-fold-search semantic-case-fold)
  75            (regexp (concat "\\<" (regexp-quote str) "\\>")))
  76       (while (re-search-forward regexp end t)
  77         (when (semantic-idle-summary-useful-context-p)
  78           (semantic-analyze-current-symbol
  79            (lambda (start end prefix)
  80              (let ((tag (car (nreverse prefix))))
  81                ;; check for semantic match on the text match.
  82                (when (and (semantic-tag-p tag)
  83                           (semantic-equivalent-tag-p target tag))
  84                  (save-excursion
  85                    (funcall hookfcn start end prefix)))))
  86            (point)))))))
  87
  88 (defun semantic-symref-test-count-hits-in-tag ()
  89   "Lookup in the current tag the symbol under point.
  90 the count all the other references to the same symbol within the
  91 tag that contains point, and return that."
  92   (interactive)
  93   (let* ((ctxt (semantic-analyze-current-context))
  94          (target (car (reverse (oref ctxt prefix))))
  95          (tag (semantic-current-tag))
  96          (start (current-time))
  97          (Lcount 0))
  98     (when (semantic-tag-p target)
  99       (semantic-symref-hits-in-region
 100        target (lambda (start end prefix) (setq Lcount (1+ Lcount)))
 101        (semantic-tag-start tag)
 102        (semantic-tag-end tag))
 103       (when (called-interactively-p 'interactive)
 104         (message "Found %d occurrences of %s in %.2f seconds"
 105                  Lcount (semantic-tag-name target)
 106                  (semantic-elapsed-time start (current-time))))
 107       Lcount)))
 108
 109 (defun semantic-symref-rename-local-variable ()
 110   "Fancy way to rename the local variable under point.
 111 Depends on the SRecode Field editing API."
 112   (interactive)
 113   ;; Do the replacement as needed.
 114   (let* ((ctxt (semantic-analyze-current-context))
 115          (target (car (reverse (oref ctxt prefix))))
 116          (tag (semantic-current-tag))
 117          )
 118
 119     (when (or (not target)
 120               (not (semantic-tag-with-position-p target)))
 121       (error "Cannot identify symbol under point"))
 122
 123     (when (not (semantic-tag-of-class-p target 'variable))
 124       (error "Can only rename variables"))
 125
 126     (when (or (< (semantic-tag-start target) (semantic-tag-start tag))
 127               (> (semantic-tag-end target) (semantic-tag-end tag)))
 128       (error "Can only rename variables declared in %s"
 129              (semantic-tag-name tag)))
 130
 131     ;; I think we're good for this example.  Give it a go through
 132     ;; our fancy interface from SRecode.
 133     (require 'srecode/fields)
 134
 135     ;; Make sure there is nothing active.
 136     (let ((ar (srecode-active-template-region)))
 137       (when ar (srecode-delete ar)))
 138
 139     (let ((srecode-field-archive nil)
 140           (region nil)
 141           )
 142       (semantic-symref-hits-in-region
 143        target (lambda (start end prefix)
 144                 ;; For every valid hit, create one field.
 145                 (srecode-field "LOCAL" :name "LOCAL" :start start :end end))
 146        (semantic-tag-start tag) (semantic-tag-end tag))
 147
 148       ;; Now that the fields are setup, create the region.
 149       (setq region (srecode-template-inserted-region
 150                     "REGION" :start (semantic-tag-start tag)
 151                     :end (semantic-tag-end tag)))
 152
 153       ;; Activate the region.
 154       (srecode-overlaid-activate region)
 155
 156       )
 157     ))
 158
 159 (provide 'semantic/symref/filter)
 160
 161 ;;; semantic/symref/filter.el ends here