diff options
| -rw-r--r-- | scheme/guile/geiser/doc.scm | 7 | ||||
| -rw-r--r-- | scheme/guile/geiser/xref.scm | 30 |
2 files changed, 35 insertions, 2 deletions
diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index 01b9ce3..f655fd6 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/geiser/doc.scm @@ -26,7 +26,8 @@ (define-module (geiser doc) #:export (autodoc - symbol-documentation) + symbol-documentation + object-signature) #:use-module (geiser utils) #:use-module (geiser modules) #:use-module (system vm program) @@ -51,6 +52,10 @@ (else (describe-application form))))) (else #f))) +(define (object-signature name obj) + (let ((args (obj-args obj))) + (and args (signature name args)))) + (define (describe-application form) (let* ((fun (car form)) (args (obj-args (symbol->object fun)))) diff --git a/scheme/guile/geiser/xref.scm b/scheme/guile/geiser/xref.scm index 2cd4d80..232d692 100644 --- a/scheme/guile/geiser/xref.scm +++ b/scheme/guile/geiser/xref.scm @@ -28,10 +28,38 @@ #:export (symbol-location generic-methods) #:use-module (geiser utils) - #:use-module (geiser modules)) + #:use-module (geiser modules) + #:use-module (geiser doc) + #:use-module (oop goops) + #:use-module (system vm program)) (define (symbol-location sym) (cond ((symbol-module sym) => module-location) (else '()))) +(define (generic-methods sym) + (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)))) + +(define (describe-method name m) + (let ((proc (method-procedure m))) + (if proc + `((location . ,(program-location proc)) + (signature . ,(object-signature name proc))) + '()))) + +(define (program-location p) + (cond ((program-source p 0) => + (lambda (s) (make-location (program-path p) (source:line s)))) + ((program-path p) => + (lambda (s) (make-location (program-path p) #f))) + (else '()))) + +(define (program-path p) + (let* ((mod (program-module p)) + (name (and mod (module-name mod)))) + (and name (module-filename name)))) + ;;; xref.scm ends here |