mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-27 16:51:06 -07:00
Code Issues Projects Releases Wiki Activity

cedet/semantic/symref.el, cedet/semantic/symref/cscope.el.

Browse source 
cedet/semantic/symref/global.el, cedet/semantic/symref/idutils.el,
cedet/semantic/symref/list.el: New files.
cedet/semantic/db-ebrowse.el: Use mapc instead of mapcar.
This commit is contained in:
Chong Yidong 2009-08-29 20:12:41 +00:00
parent a6de3d1a73
commit a4bdf71574
6 changed files with 1042 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

10
lisp/cedet/semantic/db-ebrowse.el
View file

@ -115,11 +115,11 @@ is specified by `semanticdb-default-save-directory'."
;; to get the file names.
(mapcar (lambda (f)
(when (semanticdb-ebrowse-C-file-p f)
(insert f)
(insert "\n")))
files)
(mapc (lambda (f)
(when (semanticdb-ebrowse-C-file-p f)
(insert f)
(insert "\n")))
files)
;; Cleanup the ebrowse output buffer.
(save-excursion
(set-buffer (get-buffer-create "*EBROWSE OUTPUT*"))

485
lisp/cedet/semantic/symref.el Normal file
View file

@ -0,0 +1,485 @@
;;; semantic/symref.el --- Symbol Reference API
;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; 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 <http://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 apropriate 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, sublcass `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/fw)
(require 'ede)
(eval-when-compile (require 'data-debug)
(require 'eieio-datadebug))
;;; Code:
(defvar 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.")
(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-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* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
(ede-toplevel)))
(rootdir (if rootproj
(ede-project-root-directory rootproj)
default-directory))
(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)
(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
;;
(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 (interactive-p)
(semantic-symref-data-debug-last-result))))
)
(defun semantic-symref-find-tags-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 'tagname
:searchscope (or scope 'project)
:resulttype 'line))
(result (semantic-symref-get-result inst)))
(prog1
(setq semantic-symref-last-result result)
(when (interactive-p)
(semantic-symref-data-debug-last-result))))
)
(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 (interactive-p)
(semantic-symref-data-debug-last-result))))
)
(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 (interactive-p)
(semantic-symref-data-debug-last-result))))
)
(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 (interactive-p)
(semantic-symref-data-debug-last-result))))
)
(defun semantic-symref-find-text (text &optional scope)
"Find a list of occurances of TEXT in the current project.
TEXT is a regexp formatted for use with egrep.
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 "sEgrep 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 (interactive-p)
(semantic-symref-data-debug-last-result))))
)
;;; 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-tags' method to get this list.")
)
"The results from a symbol reference search.")
(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 (lambda (a) (cdr a)) lines))
(ans nil))
(setq ans (list (car files))
files (cdr files))
(dolist (F files)
;; This algorithm for uniqing 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))
)
))
(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)
(buffs-to-kill nil))
(save-excursion
(setq
ans
(mapcar
(lambda (hit)
(let* ((line (car hit))
(file (cdr hit))
(buff (get-file-buffer 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)
(setq buffs-to-kill (cons kbuff buffs-to-kill))
(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
(re-search-forward (regexp-quote txt)
(point-at-eol)
t)
(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) txt))
(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))
lines)))
;; Kill off dead buffers, unless we were requested to leave them open.
(when (not open-buffers)
(mapc 'kill-buffer buffs-to-kill))
;; 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)))))
;;; 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)
(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))
)
))
(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'"))
(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."
(save-excursion
(set-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)))
)
(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'"))
(provide 'semantic/symref)
;;; semantic/symref.el ends here

84
lisp/cedet/semantic/symref/cscope.el Normal file
View file

@ -0,0 +1,84 @@
;;; semantic/symref/cscope.el --- Semantic-symref support via cscope.
;;; Copyright (C) 2009 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Semantic symref support via cscope.
(require 'cedet-cscope)
(require 'semantic/symref)
;;; Code:
(defclass semantic-symref-tool-cscope (semantic-symref-tool-baseclass)
(
)
"A symref tool implementation using CScope.
The CScope command can be used to generate lists of tags in a way
similar to that of `grep'. This tool will parse the output to generate
the hit list.
See the function `cedet-cscope-search' for more details.")
(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-cscope))
"Perform a search with GNU Global."
(let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
(ede-toplevel)))
(default-directory (if rootproj
(ede-project-root-directory rootproj)
default-directory))
;; CScope has to be run from the project root where
;; cscope.out is.
(b (cedet-cscope-search (oref tool :searchfor)
(oref tool :searchtype)
(oref tool :resulttype)
(oref tool :searchscope)
))
)
(semantic-symref-parse-tool-output tool b)
))
(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
;; Search for files
(when (re-search-forward "^\\([^\n]+\\)$" nil t)
(match-string 1)))
((eq (oref tool :searchtype) 'tagcompletions)
;; Search for files
(when (re-search-forward "^[^ ]+ [^ ]+ [^ ]+ \\(.*\\)$" nil t)
(let ((subtxt (match-string 1))
(searchtxt (oref tool :searchfor)))
(if (string-match (concat "\\<" searchtxt "\\(\\w\\|\\s_\\)*\\>")
subtxt)
(match-string 0 subtxt)
;; We have to return something at this point.
subtxt)))
)
(t
(when (re-search-forward "^\\([^ ]+\\) [^ ]+ \\([0-9]+\\) " nil t)
(cons (string-to-number (match-string 2))
(expand-file-name (match-string 1)))
))))
(provide 'semantic/symref/cscope)
;;; semantic/symref/cscope.el ends here

69
lisp/cedet/semantic/symref/global.el Normal file
View file

@ -0,0 +1,69 @@
;;; semantic/symref/global.el --- Use GNU Global for symbol references
;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
;; Author: Eric Ludlam <eludlam@mathworks.com>
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; GNU Global use with the semantic-symref system.
(require 'cedet-global)
(require 'semantic/symref)
;;; Code:
(defclass semantic-symref-tool-global (semantic-symref-tool-baseclass)
(
)
"A symref tool implementation using GNU Global.
The GNU Global command can be used to generate lists of tags in a way
similar to that of `grep'. This tool will parse the output to generate
the hit list.
See the function `cedet-gnu-global-search' for more details.")
(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-global))
"Perform a search with GNU Global."
(let ((b (cedet-gnu-global-search (oref tool :searchfor)
(oref tool :searchtype)
(oref tool :resulttype)
(oref tool :searchscope)
))
)
(semantic-symref-parse-tool-output tool b)
))
(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((or (eq (oref tool :resulttype) 'file)
(eq (oref tool :searchtype) 'tagcompletions))
;; Search for files
(when (re-search-forward "^\\([^\n]+\\)$" nil t)
(match-string 1)))
(t
(when (re-search-forward "^\\([^ ]+\\) +\\([0-9]+\\) \\([^ ]+\\) " nil t)
(cons (string-to-number (match-string 2))
(match-string 3))
))))
(provide 'semantic/symref/global)
;;; semantic/symref/global.el ends here

71
lisp/cedet/semantic/symref/idutils.el Normal file
View file

@ -0,0 +1,71 @@
;;; semantic/symref/idutils.el --- Symref implementation for idutils
;;; Copyright (C) 2009 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; This file is part of GNU Emacs.
;; This program 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 2, or (at
;; your option) any later version.
;; This program 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 this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; Support IDUtils use in the Semantic Symref tool.
(require 'cedet-idutils)
(require 'semantic-symref)
;;; Code:
(defclass semantic-symref-tool-idutils (semantic-symref-tool-baseclass)
(
)
"A symref tool implementation using ID Utils.
The udutils command set can be used to generate lists of tags in a way
similar to that of `grep'. This tool will parse the output to generate
the hit list.
See the function `cedet-idutils-search' for more details.")
(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-idutils))
"Perform a search with IDUtils."
(let ((b (cedet-idutils-search (oref tool :searchfor)
(oref tool :searchtype)
(oref tool :resulttype)
(oref tool :searchscope)
))
)
(semantic-symref-parse-tool-output tool b)
))
(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
;; Search for files
(when (re-search-forward "^\\([^\n]+\\)$" nil t)
(match-string 1)))
((eq (oref tool :searchtype) 'tagcompletions)
(when (re-search-forward "^\\([^ ]+\\) " nil t)
(match-string 1)))
(t
(when (re-search-forward "^\\([^ :]+\\):+\\([0-9]+\\):" nil t)
(cons (string-to-number (match-string 2))
(expand-file-name (match-string 1) default-directory))
))))
(provide 'semantic/symref/idutils)
;;; semantic/symref/idutils.el ends here

328
lisp/cedet/semantic/symref/list.el Normal file
View file

@ -0,0 +1,328 @@
;;; semantic/symref/list.el --- Symref Output List UI.
;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; This file is part of GNU Emacs.
;; This program 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 2, or (at
;; your option) any later version.
;; This program 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 this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; Provide a simple user facing API to finding symbol references.
;;
;; This UI will is the base of some refactoring tools. For any
;; refactor, the user will execture `semantic-symref' in a tag. Once
;; that data is collected, the output will be listed in a buffer. In
;; the output buffer, the user can then initiate different refactoring
;; operations.
;;
;; NOTE: Need to add some refactoring tools.
(require 'semantic/symref)
(require 'pulse)
;;; Code:
(defun semantic-symref ()
"Find references to the current tag.
This command uses the currently configured references tool within the
current project to find references to the current tag. The
references are the organized by file and the name of the function
they are used in.
Display the references in`semantic-symref-results-mode'"
(interactive)
(semantic-fetch-tags)
(let ((ct (semantic-current-tag))
(res nil)
)
;; Must have a tag...
(when (not ct) (error "Place cursor inside tag to be searched for"))
;; Check w/ user.
(when (not (y-or-n-p (format "Find references for %s? " (semantic-tag-name ct))))
(error "Quit"))
;; Gather results and tags
(message "Gathering References...")
(setq res (semantic-symref-find-references-by-name (semantic-tag-name ct)))
(semantic-symref-produce-list-on-results res (semantic-tag-name ct))))
(defun semantic-symref-symbol (sym)
"Find references to the symbol SYM.
This command uses the currently configured references tool within the
current project to find references to the input SYM. The
references are the organized by file and the name of the function
they are used in.
Display the references in`semantic-symref-results-mode'"
(interactive (list (car (senator-jump-interactive "Symrefs for: " nil nil t)))
)
(semantic-fetch-tags)
(let ((res nil)
)
;; Gather results and tags
(message "Gathering References...")
(setq res (semantic-symref-find-references-by-name sym))
(semantic-symref-produce-list-on-results res sym)))
(defun semantic-symref-produce-list-on-results (res str)
"Produce a symref list mode buffer on the results RES."
(when (not res) (error "No references found"))
(semantic-symref-result-get-tags res t)
(message "Gathering References...done")
;; Build a refrences buffer.
(let ((buff (get-buffer-create
(format "*Symref %s" str)))
)
(switch-to-buffer-other-window buff)
(set-buffer buff)
(semantic-symref-results-mode res))
)
;;; RESULTS MODE
;;
(defgroup semantic-symref-results-mode nil
"Symref Results group."
:group 'semantic)
(defvar semantic-symref-results-mode-map
(let ((km (make-sparse-keymap)))
(define-key km "\C-i" 'forward-button)
(define-key km "\M-C-i" 'backward-button)
(define-key km " " 'push-button)
(define-key km "-" 'semantic-symref-list-toggle-showing)
(define-key km "=" 'semantic-symref-list-toggle-showing)
(define-key km "+" 'semantic-symref-list-toggle-showing)
(define-key km "n" 'semantic-symref-list-next-line)
(define-key km "p" 'semantic-symref-list-prev-line)
(define-key km "q" 'semantic-symref-hide-buffer)
km)
"Keymap used in `semantic-symref-results-mode'.")
(defcustom semantic-symref-results-mode-hook nil
"*Hook run when `semantic-symref-results-mode' starts."
:group 'semantic-symref
:type 'hook)
(defvar semantic-symref-current-results nil
"The current results in a results mode buffer.")
(defun semantic-symref-results-mode (results)
"Major-mode for displaying Semantic Symbol Reference RESULTS.
RESULTS is an object of class `semantic-symref-results'."
(interactive)
(kill-all-local-variables)
(setq major-mode 'semantic-symref-results-mode
mode-name "Symref"
)
(use-local-map semantic-symref-results-mode-map)
(set (make-local-variable 'semantic-symref-current-results)
results)
(semantic-symref-results-dump results)
(goto-char (point-min))
(buffer-disable-undo)
(set (make-local-variable 'font-lock-global-modes) nil)
(font-lock-mode -1)
(run-hooks 'semantic-symref-results-mode-hook)
)
(defun semantic-symref-hide-buffer ()
"Hide buffer with sematinc-symref results"
(interactive)
(bury-buffer))
(defcustom semantic-symref-results-summary-function 'semantic-format-tag-prototype
"*Function to use when creating items in Imenu.
Some useful functions are found in `semantic-format-tag-functions'."
:group 'semantic-symref
:type semantic-format-tag-custom-list)
(defun semantic-symref-results-dump (results)
"Dump the RESULTS into the current buffer."
;; Get ready for the insert.
(toggle-read-only -1)
(erase-buffer)
;; Insert the contents.
(let ((lastfile nil)
)
(dolist (T (oref results :hit-tags))
(when (not (equal lastfile (semantic-tag-file-name T)))
(setq lastfile (semantic-tag-file-name T))
(insert-button lastfile
'mouse-face 'custom-button-pressed-face
'action 'semantic-symref-rb-goto-file
'tag T
)
(insert "\n"))
(insert " ")
(insert-button "[+]"
'mouse-face 'highlight
'face nil
'action 'semantic-symref-rb-toggle-expand-tag
'tag T
'state 'closed)
(insert " ")
(insert-button (funcall semantic-symref-results-summary-function
T nil t)
'mouse-face 'custom-button-pressed-face
'face nil
'action 'semantic-symref-rb-goto-tag
'tag T)
(insert "\n")
))
;; Clean up the mess
(toggle-read-only 1)
(set-buffer-modified-p nil)
)
;;; Commands for semantic-symref-results
;;
(defun semantic-symref-list-toggle-showing ()
"Toggle showing the contents below the current line."
(interactive)
(beginning-of-line)
(when (re-search-forward "\\[[-+]\\]" (point-at-eol) t)
(forward-char -1)
(push-button)))
(defun semantic-symref-rb-toggle-expand-tag (&optional button)
"Go to the file specified in the symref results buffer.
BUTTON is the button that was clicked."
(interactive)
(let* ((tag (button-get button 'tag))
(buff (semantic-tag-buffer tag))
(hits (semantic--tag-get-property tag :hit))
(state (button-get button 'state))
(text nil)
)
(cond
((eq state 'closed)
(toggle-read-only -1)
(save-excursion
(set-buffer buff)
(dolist (H hits)
(goto-char (point-min))
(forward-line (1- H))
(beginning-of-line)
(back-to-indentation)
(setq text (cons (buffer-substring (point) (point-at-eol)) text)))
(setq text (nreverse text))
)
(goto-char (button-start button))
(forward-char 1)
(delete-char 1)
(insert "-")
(button-put button 'state 'open)
(save-excursion
(end-of-line)
(while text
(insert "\n")
(insert " ")
(insert-button (car text)
'mouse-face 'highlight
'face nil
'action 'semantic-symref-rb-goto-match
'tag tag
'line (car hits))
(setq text (cdr text)
hits (cdr hits))))
(toggle-read-only 1)
)
((eq state 'open)
(toggle-read-only -1)
(button-put button 'state 'closed)
;; Delete the various bits.
(goto-char (button-start button))
(forward-char 1)
(delete-char 1)
(insert "+")
(save-excursion
(end-of-line)
(forward-char 1)
(delete-region (point)
(save-excursion
(forward-char 1)
(forward-line (length hits))
(point))))
(toggle-read-only 1)
)
))
)
(defun semantic-symref-rb-goto-file (&optional button)
"Go to the file specified in the symref results buffer.
BUTTON is the button that was clicked."
(let* ((tag (button-get button 'tag))
(buff (semantic-tag-buffer tag))
(win (selected-window))
)
(switch-to-buffer-other-window buff)
(pulse-momentary-highlight-one-line (point))
(when (eq last-command-char ? ) (select-window win))
))
(defun semantic-symref-rb-goto-tag (&optional button)
"Go to the file specified in the symref results buffer.
BUTTON is the button that was clicked."
(interactive)
(let* ((tag (button-get button 'tag))
(buff (semantic-tag-buffer tag))
(win (selected-window))
)
(switch-to-buffer-other-window buff)
(semantic-go-to-tag tag)
(pulse-momentary-highlight-one-line (point))
(when (eq last-command-char ? ) (select-window win))
)
)
(defun semantic-symref-rb-goto-match (&optional button)
"Go to the file specified in the symref results buffer.
BUTTON is the button that was clicked."
(interactive)
(let* ((tag (button-get button 'tag))
(line (button-get button 'line))
(buff (semantic-tag-buffer tag))
(win (selected-window))
)
(switch-to-buffer-other-window buff)
(goto-line line)
(pulse-momentary-highlight-one-line (point))
(when (eq last-command-char ? ) (select-window win))
)
)
(defun semantic-symref-list-next-line ()
"Next line in `semantic-symref-results-mode'."
(interactive)
(forward-line 1)
(back-to-indentation))
(defun semantic-symref-list-prev-line ()
"Next line in `semantic-symref-results-mode'."
(interactive)
(forward-line -1)
(back-to-indentation))
(provide 'semantic/symref/list)
;;; semantic/symref/list.el ends here