diff options
Diffstat (limited to 'scheme/guile')
| -rw-r--r-- | scheme/guile/geiser/emacs.scm | 4 | ||||
| -rw-r--r-- | scheme/guile/geiser/xref.scm | 34 |
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 |