diff options
author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-02-10 01:08:04 +0100 |
---|---|---|
committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-02-10 01:08:04 +0100 |
commit | 052e7fb476f018e1426e1bd9394d4fe63db33f45 (patch) | |
tree | c10c7c5bc02be35e43a61dd0bfd91b9794a1e0ee /scheme | |
parent | 0490e6d2047aa97be3a0b3e34075557666336679 (diff) | |
download | geiser-guile-052e7fb476f018e1426e1bd9394d4fe63db33f45.tar.gz geiser-guile-052e7fb476f018e1426e1bd9394d4fe63db33f45.tar.bz2 |
Optionally show procedure modules in autodoc.
Diffstat (limited to 'scheme')
-rw-r--r-- | scheme/geiser/introspection.scm | 19 |
1 files changed, 11 insertions, 8 deletions
diff --git a/scheme/geiser/introspection.scm b/scheme/geiser/introspection.scm index ae2b0d3..991b62d 100644 --- a/scheme/geiser/introspection.scm +++ b/scheme/geiser/introspection.scm @@ -44,28 +44,31 @@ (let* ((arity (program-arity program)) (arg-no (first arity)) (opt (> (second arity) 0)) - (args (map first (take (program-bindings program) arg-no)))) - (format-args (if opt (drop-right args 1) args) (and opt (last args))))) + (args (map first (take (program-bindings program) arg-no))) + (module (program-module program))) + (format-args (if opt (drop-right args 1) args) (and opt (last args)) module))) (define (procedure-args proc) (let* ((arity (procedure-property proc 'arity)) (req (first arity)) - (opt (third arity))) + (opt (third arity)) + (env (procedure-environment proc))) (format-args (map (lambda (n) (string->symbol (format "arg~A" (+ 1 n)))) (iota req)) - (and opt 'rest)))) + (and opt 'rest) + (and (not (null? env)) env)))) (define (macro-args macro) (let ((prog (macro-transformer macro))) (if prog (program-args prog) - (format-args '(...) #f)))) + (format-args '(...) #f #f)))) -(define (foobar) 6) -(define (format-args args opt) +(define (format-args args opt module) (list (cons 'required args) - (cons 'optional (or opt '())))) + (cons 'optional (or opt '())) + (cons 'module (if module (module-name module) '())))) (define (completions prefix) (map symbol->string (apropos-internal (string-append "^" prefix)))) |