New command to display generic methods (C-cC-dg) implemented.

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)))