Mercurial > emacs
changeset 104422:36f56620b2ae
cedet/semantic/symref.el, cedet/semantic/symref/cscope.el.
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.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 29 Aug 2009 20:12:41 +0000 |
parents | b66bb908c129 |
children | 24150c0540ae |
files | lisp/cedet/semantic/db-ebrowse.el lisp/cedet/semantic/symref.el lisp/cedet/semantic/symref/cscope.el lisp/cedet/semantic/symref/global.el lisp/cedet/semantic/symref/idutils.el lisp/cedet/semantic/symref/list.el |
diffstat | 6 files changed, 1042 insertions(+), 5 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/cedet/semantic/db-ebrowse.el Sat Aug 29 19:45:47 2009 +0000 +++ b/lisp/cedet/semantic/db-ebrowse.el Sat Aug 29 20:12:41 2009 +0000 @@ -115,11 +115,11 @@ ;; 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*"))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/symref.el Sat Aug 29 20:12:41 2009 +0000 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/symref/cscope.el Sat Aug 29 20:12:41 2009 +0000 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/symref/global.el Sat Aug 29 20:12:41 2009 +0000 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/symref/idutils.el Sat Aug 29 20:12:41 2009 +0000 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/symref/list.el Sat Aug 29 20:12:41 2009 +0000 @@ -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