summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-03-06 00:47:05 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-03-06 00:47:05 +0100
commit754aa7a194c412f52b4733142566ed5e33a04f4f (patch)
tree7296e1cfde7208e5c244e72355eab820c6de2470
parent9e91cef8b3d10e7eab88cc16d425fefc36c7321d (diff)
downloadgeiser-guile-754aa7a194c412f52b4733142566ed5e33a04f4f.tar.gz
geiser-guile-754aa7a194c412f52b4733142566ed5e33a04f4f.tar.bz2
New command to display generic methods (C-cC-dg) implemented.
-rw-r--r--README3
-rw-r--r--elisp/geiser-base.el6
-rw-r--r--elisp/geiser-edit.el14
-rw-r--r--elisp/geiser-mode.el1
-rw-r--r--elisp/geiser-xref.el132
-rw-r--r--elisp/geiser.el1
-rw-r--r--scheme/guile/geiser/xref.scm3
7 files changed, 152 insertions, 8 deletions
diff --git a/README b/README
index 98ddf77..b7e8776 100644
--- a/README
+++ b/README
@@ -41,7 +41,8 @@
| C-cC-l | Load current file |
|------------------+-------------------------------------------------|
| C-cC-dd | See documentation for symbol at point |
- | C-cC-dm | See module documentation |
+ | C-cC-dm | See module symbols documentation |
+ | C-cC-dg | See generic methods |
| C-cC-da | Toggle autodoc mode |
|------------------+-------------------------------------------------|
| M-TAB | Complete symbol at point |
diff --git a/elisp/geiser-base.el b/elisp/geiser-base.el
index 2a8d5a9..362930d 100644
--- a/elisp/geiser-base.el
+++ b/elisp/geiser-base.el
@@ -91,6 +91,12 @@
(let* ((str (buffer-substring-no-properties begin end))
(pieces (split-string str nil t)))
(mapconcat 'identity pieces " ")))))
+
+(defun geiser--insert-with-face (str face)
+ (let ((p (point)))
+ (insert str)
+ (put-text-property p (point) 'face face)))
+
(provide 'geiser-base)
;;; geiser-base.el ends here
diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el
index e504b30..e5c30eb 100644
--- a/elisp/geiser-edit.el
+++ b/elisp/geiser-edit.el
@@ -44,7 +44,7 @@
(geiser-edit--define-custom-visit
geiser-edit-symbol-method geiser-mode
- "How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point]")
+ "How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point].")
;;; Auxiliar functions:
@@ -83,15 +83,17 @@
(re-search-forward (geiser-edit--symbol-re symbol) nil t))
(goto-char (match-beginning 0)))))
-(defun geiser-edit--try-edit (symbol ret)
- (let* ((loc (geiser-eval--retort-result ret))
- (file (geiser-edit--location-file loc))
- (line (geiser-edit--location-line loc)))
+(defun geiser-edit--try-edit-location (symbol loc &optional method)
+ (let ((file (geiser-edit--location-file loc))
+ (line (geiser-edit--location-line loc)))
(unless file (error "Couldn't find edit location for '%s'" symbol))
(unless (file-readable-p file) (error "Couldn't open '%s' for read" file))
- (geiser-edit--visit-file file geiser-edit-symbol-method)
+ (geiser-edit--visit-file file (or method geiser-edit-symbol-method))
(geiser-edit--goto-line symbol line)))
+(defsubst geiser-edit--try-edit (symbol ret)
+ (geiser-edit--try-edit-location symbol (geiser-eval--retort-result ret)))
+
;;; Commands:
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index f85b530..3520925 100644
--- a/elisp/geiser-mode.el
+++ b/elisp/geiser-mode.el
@@ -194,6 +194,7 @@ interacting with the Geiser REPL is at your disposal.
(geiser-mode--triple-chord ?d ?a 'geiser-autodoc-mode)
(geiser-mode--triple-chord ?d ?d 'geiser-doc-symbol-at-point)
+(geiser-mode--triple-chord ?d ?g 'geiser-xref-generic-methods)
(geiser-mode--triple-chord ?d ?m 'geiser-doc-module)
(geiser-mode--triple-chord ?e ?m 'geiser-edit-module)
diff --git a/elisp/geiser-xref.el b/elisp/geiser-xref.el
new file mode 100644
index 0000000..62375e0
--- /dev/null
+++ b/elisp/geiser-xref.el
@@ -0,0 +1,132 @@
+;; geiser-xref.el -- utilities for cross-referencing
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Thu Mar 05, 2009 23:03
+
+;; This file 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.
+
+;; This file 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. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Comentary:
+
+;; Obtaining cross-reference information (generic's methods, callers, etc.)
+
+;;; Code:
+
+(require' geiser-edit)
+(require 'geiser-eval)
+(require 'geiser-popup)
+(require 'geiser-custom)
+(require 'geiser-base)
+
+(require 'button)
+
+
+;;; Customization:
+(defgroup geiser-xref nil
+ "Options for cross-referencing commands."
+ :group 'geiser)
+
+(geiser-edit--define-custom-visit
+ geiser-xref-follow-link-method geiser-xref
+ "How to visit buffers when following xrefs.")
+
+(geiser-custom--defface xref-link
+ 'link geiser-xref "links in cross-reference buffers")
+
+(geiser-custom--defface xref-header
+ 'bold geiser-xref "headers in cross-reference buffers")
+
+
+;;; Ref button:
+
+(define-button-type 'geiser-xref--button
+ 'action 'geiser-xref--button-action
+ 'face 'geiser-font-lock-xref-link
+ 'follow-link t)
+
+(defun geiser-xref--button-action (button)
+ (let ((location (button-get button 'location))
+ (name (button-get button 'name)))
+ (when location
+ (geiser-edit--try-edit-location name location geiser-xref-follow-link-method))))
+
+(defun geiser-xref--insert-button (xref)
+ (let ((location (cdr (assoc 'location xref)))
+ (signature (cdr (assoc 'signature xref))))
+ (when signature
+ (insert "\t")
+ (if location
+ (insert-text-button (format "%s" signature)
+ :type 'geiser-xref--button
+ 'location location
+ 'name (car signature)
+ 'help-echo (format "%s in %s"
+ (car signature)
+ (geiser-edit--location-file location)))
+ (insert (format "%s" signature)))
+ (newline))))
+
+
+;;; Buffer and mode:
+
+(geiser-popup--define xref "*Geiser xref*" geiser-xref-mode)
+
+(defvar geiser-xref-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (set-keymap-parent map button-buffer-map)
+ map))
+
+(defun geiser-xref-mode ()
+ "Major mode for displaying cross-references.
+\\{geiser-xref-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (use-local-map geiser-xref-mode-map)
+ (set-syntax-table scheme-mode-syntax-table)
+ (setq mode-name "Geiser Xref")
+ (setq major-mode 'geiser-xref-mode)
+ (setq buffer-read-only t))
+
+
+;;; Generic's methods:
+
+(defun geiser-xref--display-generic-methods (generic res)
+ (geiser-xref--with-buffer
+ (erase-buffer)
+ (geiser--insert-with-face (format "Methods for generic '%s'" generic)
+ 'geiser-font-lock-xref-header)
+ (newline 2)
+ (mapc 'geiser-xref--insert-button res))
+ (geiser-xref--pop-to-buffer))
+
+(defun geiser-xref-generic-methods (&optional arg)
+ "Display information about known methods of a given generic.
+With prefix, ask for the name of the generic."
+ (interactive "P")
+ (let* ((name (or (and (not arg) (symbol-at-point))
+ (read-string "Generic: " nil nil (symbol-at-point))))
+ (name (and name (format "%s" name)))
+ (res (geiser-eval--send/result
+ `(:eval ((:ge generic-methods) (quote (:scm ,name)))))))
+ (if (or (not res) (not (listp res)))
+ (message "No methods found for '%s'" name)
+ (geiser-xref--display-generic-methods name res))))
+
+
+
+(provide 'geiser-xref)
+;;; geiser-xref.el ends here
diff --git a/elisp/geiser.el b/elisp/geiser.el
index 8a62ea5..7415390 100644
--- a/elisp/geiser.el
+++ b/elisp/geiser.el
@@ -86,6 +86,7 @@
geiser-mode
geiser-repl
geiser-doc
+ geiser-xref
geiser-edit
geiser-completion
geiser-autodoc
diff --git a/scheme/guile/geiser/xref.scm b/scheme/guile/geiser/xref.scm
index 232d692..c94835a 100644
--- a/scheme/guile/geiser/xref.scm
+++ b/scheme/guile/geiser/xref.scm
@@ -51,7 +51,8 @@
'())))
(define (program-location p)
- (cond ((program-source p 0) =>
+ (cond ((not (program? p)) '())
+ ((program-source p 0) =>
(lambda (s) (make-location (program-path p) (source:line s))))
((program-path p) =>
(lambda (s) (make-location (program-path p) #f)))