From 052e7fb476f018e1426e1bd9394d4fe63db33f45 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 10 Feb 2009 01:08:04 +0100 Subject: Optionally show procedure modules in autodoc. --- scheme/geiser/introspection.scm | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to 'scheme') 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)))) -- cgit v1.2.3