code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/symref/filter.el

   1 ;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy.
   2
   3 ;;; Copyright (C) 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 ;; 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 (declare-function srecode-active-template-region "srecode/fields")
  38 (declare-function srecode-delete "srecode/fields")
  39 (declare-function srecode-field "srecode/fields")
  40 (declare-function srecode-template-inserted-region "srecode/fields")
  41 (declare-function srecode-overlaid-activate "srecode/fields")
  42
  43 ;;; FILTERS
  44 ;;
  45 (defun semantic-symref-filter-hit (target &optional position)
  46   "Determine if the tag TARGET is used at POSITION in the current buffer.
  47 Return non-nil for a match."
  48   (semantic-analyze-current-symbol
  49    (lambda (start end prefix)
  50      (let ((tag (car (nreverse prefix))))
  51        (and (semantic-tag-p tag)
  52             (semantic-equivalent-tag-p target tag))))
  53    position))
  54
  55 ;;; IN-BUFFER FILTERING
  56
  57 ;; The following does filtering in-buffer only, and not against
  58 ;; a symref results object.
  59
  60 (defun semantic-symref-hits-in-region (target hookfcn start end)
  61   "Find all occurances of the symbol TARGET that match TARGET the tag.
  62 For each match, call HOOKFCN.
  63 HOOKFCN takes three arguments that match
  64 `semantic-analyze-current-symbol's use of HOOKfCN.
  65   ( START END PREFIX )
  66
  67 Search occurs in the current buffer between START and END."
  68   (save-excursion
  69     (goto-char start)
  70     (let* ((str (semantic-tag-name target))
  71            (case-fold-search semantic-case-fold)
  72            (regexp (concat "\\<" (regexp-quote str) "\\>")))
  73       (while (re-search-forward regexp end t)
  74         (when (semantic-idle-summary-useful-context-p)
  75           (semantic-analyze-current-symbol
  76            (lambda (start end prefix)
  77              (let ((tag (car (nreverse prefix))))
  78                ;; check for semantic match on the text match.
  79                (when (and (semantic-tag-p tag)
  80                           (semantic-equivalent-tag-p target tag))
  81                  (save-excursion
  82                    (funcall hookfcn start end prefix)))))
  83            (point)))))))
  84
  85 (defun semantic-symref-rename-local-variable ()
  86   "Fancy way to rename the local variable under point.
  87 Depends on the SRecode Field editing API."
  88   (interactive)
  89   ;; Do the replacement as needed.
  90   (let* ((ctxt (semantic-analyze-current-context))
  91          (target (car (reverse (oref ctxt prefix))))
  92          (tag (semantic-current-tag))
  93          )
  94
  95     (when (or (not target)
  96               (not (semantic-tag-with-position-p target)))
  97       (error "Cannot identify symbol under point"))
  98
  99     (when (not (semantic-tag-of-class-p target 'variable))
 100       (error "Can only rename variables"))
 101
 102     (when (or (< (semantic-tag-start target) (semantic-tag-start tag))
 103               (> (semantic-tag-end target) (semantic-tag-end tag)))
 104       (error "Can only rename variables declared in %s"
 105              (semantic-tag-name tag)))
 106
 107     ;; I think we're good for this example.  Give it a go through
 108     ;; our fancy interface from SRecode.
 109     (require 'srecode/fields)
 110
 111     ;; Make sure there is nothing active.
 112     (let ((ar (srecode-active-template-region)))
 113       (when ar (srecode-delete ar)))
 114
 115     (let ((srecode-field-archive nil)
 116           (region nil)
 117           )
 118       (semantic-symref-hits-in-region
 119        target (lambda (start end prefix)
 120                 ;; For every valid hit, create one field.
 121                 (srecode-field "LOCAL" :name "LOCAL" :start start :end end))
 122        (semantic-tag-start tag) (semantic-tag-end tag))
 123
 124       ;; Now that the fields are setup, create the region.
 125       (setq region (srecode-template-inserted-region
 126                     "REGION" :start (semantic-tag-start tag)
 127                     :end (semantic-tag-end tag)))
 128
 129       ;; Activate the region.
 130       (srecode-overlaid-activate region)
 131
 132       )
 133     ))
 134
 135 (provide 'semantic/symref/filter)
 136
 137 ;;; semantic/symref/filter.el ends here