diff options
author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-03-18 23:59:12 +0100 |
---|---|---|
committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-03-18 23:59:12 +0100 |
commit | 33b8c5311efda6d0b1aaaad0465f59415f5540c4 (patch) | |
tree | d8e208b8de851d461025c0af8e7fceebf7dce73e /geiser/xref.scm | |
parent | e912bbf664f7199a702a01993be6a6aa70c3c6da (diff) | |
download | geiser-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.scm | 34 |
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 |