Callers/callees (C-c <, C-c >).

2 files changed, 29 insertions, 9 deletions

diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm
index 0c99216..13bd8db 100644
--- a/scheme/guile/geiser/emacs.scm
+++ b/scheme/guile/geiser/emacs.scm
@@ -37,7 +37,9 @@
                ge:symbol-documentation
                ge:all-modules
                ge:module-children
-               ge:module-location)
+               ge:module-location
+               ge:callers
+               ge:callees)
   #:use-module (geiser evaluation)
   #:use-module ((geiser modules) :renamer (symbol-prefix-proc 'ge:))
   #:use-module ((geiser completion) :renamer (symbol-prefix-proc 'ge:))
diff --git a/scheme/guile/geiser/xref.scm b/scheme/guile/geiser/xref.scm
index cb39c5d..ec86d7c 100644
--- a/scheme/guile/geiser/xref.scm
+++ b/scheme/guile/geiser/xref.scm
@@ -26,11 +26,14 @@
 
 (define-module (geiser xref)
   #:export (symbol-location
-            generic-methods)
+            generic-methods
+            callers
+            callees)
   #:use-module (geiser utils)
   #:use-module (geiser modules)
   #:use-module (geiser doc)
   #:use-module (oop goops)
+  #:use-module (system xref)
   #:use-module (system vm program))
 
 (define (symbol-location sym)
@@ -41,14 +44,15 @@
   (let* ((gen (symbol->object sym))
          (methods (if (is-a? gen <generic>) (generic-function-methods gen) '())))
     (filter (lambda (x) (not (null? x)))
-            (map (lambda (m) (describe-method sym m)) methods))))
+            (map (lambda (m)
+                   (make-xref (method-procedure m) sym (symbol-module sym)))
+                 methods))))
 
-(define (describe-method name m)
-  (let ((proc (method-procedure m)))
-    (if proc
-        `((location . ,(or (program-location proc) (symbol-location name)))
-          (signature . ,(object-signature name proc)))
-        '())))
+(define (make-xref proc name module)
+  (and proc
+       `((location . ,(or (program-location proc) (symbol-location name)))
+         (signature . ,(object-signature name proc))
+         (module . ,module))))
 
 (define (program-location p)
   (cond ((not (program? p)) #f)
@@ -63,4 +67,18 @@
          (name (and mod (module-name mod))))
     (and name (module-filename name))))
 
+(define (procedure-xref proc)
+  (let ((name (procedure-name proc)))
+    (make-xref proc name (symbol-module name))))
+
+(define (callers sym)
+  (let ((mod (symbol-module sym)))
+    (and mod
+         (map procedure-xref (procedure-callers (cons mod sym))))))
+
+(define (callees sym)
+  (let ((obj (symbol->object sym)))
+    (and obj
+         (map procedure-xref (procedure-callees obj)))))
+
 ;;; xref.scm ends here