summaryrefslogtreecommitdiff
path: root/geiser/xref.scm
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-03-18 23:59:12 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-03-18 23:59:12 +0100
commit33b8c5311efda6d0b1aaaad0465f59415f5540c4 (patch)
treed8e208b8de851d461025c0af8e7fceebf7dce73e /geiser/xref.scm
parente912bbf664f7199a702a01993be6a6aa70c3c6da (diff)
downloadgeiser-guile-33b8c5311efda6d0b1aaaad0465f59415f5540c4.tar.gz
geiser-guile-33b8c5311efda6d0b1aaaad0465f59415f5540c4.tar.bz2
Callers/callees (C-c <, C-c >).
Diffstat (limited to 'geiser/xref.scm')
-rw-r--r--geiser/xref.scm34
1 files changed, 26 insertions, 8 deletions
diff --git a/geiser/xref.scm b/geiser/xref.scm
index cb39c5d..ec86d7c 100644
--- a/geiser/xref.scm
+++ b/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