summaryrefslogtreecommitdiff
path: root/scheme/guile
diff options
context:
space:
mode:
Diffstat (limited to 'scheme/guile')
-rw-r--r--scheme/guile/geiser/emacs.scm4
-rw-r--r--scheme/guile/geiser/xref.scm34
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