From 54e80a001c937953625d5156c35b7769c2f6ba7a Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Wed, 18 Mar 2009 23:59:12 +0100
Subject: Callers/callees (C-c <, C-c >).

---
 elisp/geiser-eval.el |  2 +-
 elisp/geiser-mode.el |  2 ++
 elisp/geiser-xref.el | 57 ++++++++++++++++++++++++++++++++++------------------
 3 files changed, 41 insertions(+), 20 deletions(-)

(limited to 'elisp')

diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index a22428a..b8f971b 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -76,7 +76,7 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported."))
 
 (defsubst geiser-eval--comp (code)
   (geiser-eval--scheme-str
-   `(,(geiser-eval--form 'compile (quote ,(nth 0 code)) (:module ,(nth 1 code))))))
+   `(,(geiser-eval--form 'compile) (quote ,(nth 0 code)) (:module ,(nth 1 code)))))
 
 (defsubst geiser-eval--load-file (file)
   (geiser-eval--scheme-str `(,(geiser-eval--form 'load-file) ,file)))
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index 3a57ec7..0bfe25d 100644
--- a/elisp/geiser-mode.el
+++ b/elisp/geiser-mode.el
@@ -199,6 +199,8 @@ interacting with the Geiser REPL is at your disposal.
 (define-key geiser-mode-map (kbd "C-.") 'geiser-completion--complete-module)
 (define-key geiser-mode-map "\M-." 'geiser-edit-symbol-at-point)
 (define-key geiser-mode-map "\M-," 'geiser-edit-pop-edit-symbol-stack)
+(define-key geiser-mode-map (kbd "C-c <") 'geiser-xref-callers)
+(define-key geiser-mode-map (kbd "C-c >") 'geiser-xref-callees)
 
 (define-key geiser-mode-map "\M-\C-x" 'geiser-eval-definition)
 (define-key geiser-mode-map "\C-x\C-e" 'geiser-eval-last-sexp)
diff --git a/elisp/geiser-xref.el b/elisp/geiser-xref.el
index f0920d8..40f2a5d 100644
--- a/elisp/geiser-xref.el
+++ b/elisp/geiser-xref.el
@@ -65,7 +65,8 @@
 (defun geiser-xref--insert-button (xref)
   (let* ((location (cdr (assoc 'location xref)))
          (file (geiser-edit--location-file location))
-         (signature (cdr (assoc 'signature xref))))
+         (signature (cdr (assoc 'signature xref)))
+         (module (cdr (assoc 'module xref))))
     (when signature
       (insert "\t")
       (if (stringp file)
@@ -75,8 +76,31 @@
                               'name (car signature)
                               'help-echo (format "%s in %s" (car signature) file))
         (insert (format "%s" signature)))
+      (when (and (not (null module)) (not (eq '\#f module)))
+        (insert (format " in module %s" module)))
       (newline))))
 
+(defun geiser-xref--display-xrefs (header xrefs)
+  (geiser-xref--with-buffer
+   (erase-buffer)
+   (geiser--insert-with-face header 'geiser-font-lock-xref-header)
+   (newline 2)
+   (mapc 'geiser-xref--insert-button xrefs))
+  (geiser-xref--pop-to-buffer))
+
+(defun geiser-xref--read-name (ask prompt)
+  (let ((name (or (and (not prompt) (symbol-at-point))
+                  (read-string prompt nil nil (symbol-at-point)))))
+    (and name (format "%s" name))))
+
+(defun geiser-xref--fetch-xrefs (ask kind rkind proc)
+  (let* ((name (geiser-xref--read-name (format "%s: " (capitalize kind)) ask))
+         (res (and name (geiser-eval--send/result
+                         `(:eval ((:ge ,proc) (quote (:scm ,name))))))))
+    (if (or (not res) (not (listp res)))
+        (message "No %ss found for '%s'" rkind name)
+      (geiser-xref--display-xrefs (format "%ss for %s" rkind name) res))))
+
 
 ;;; Buffer and mode:
 
@@ -101,30 +125,25 @@
   (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))
+;;; Commands:
 
 (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))))
+  (geiser-xref--fetch-xrefs arg "generic" "method" 'generic-methods))
+
+(defun geiser-xref-callers (&optional arg)
+  "Display list of callers for procedure at point.
+With prefix, ask for the procedure."
+  (interactive "P")
+  (geiser-xref--fetch-xrefs arg "procedure" "caller" 'callers))
 
+(defun geiser-xref-callees (&optional arg)
+  "Display list of callees for procedure at point.
+With prefix, ask for the procedure."
+  (interactive "P")
+  (geiser-xref--fetch-xrefs arg "procedure" "callee" 'callees))
 
 
 (provide 'geiser-xref)
-- 
cgit v1.2.3