diff options
| -rw-r--r-- | scheme/chez/geiser/geiser.ss | 49 |
1 files changed, 48 insertions, 1 deletions
diff --git a/scheme/chez/geiser/geiser.ss b/scheme/chez/geiser/geiser.ss index 3dbed7f..2fa648c 100644 --- a/scheme/chez/geiser/geiser.ss +++ b/scheme/chez/geiser/geiser.ss @@ -52,8 +52,55 @@ (substring? prefix el)) (map write-to-string (library-list)))) + (define (procedure-parameter-list p) + ;; same as (inspect object), then hitting c + (let ((s (((inspect/object p) 'code) 'source))) + (if s + (let ((form (s 'value))) + (if (and (list? form) + (> (length form) 2) + (eq? (car form) 'lambda)) + (cadr form) + #f)) + #f))) + + (define (operator-arglist operator) + (let ((binding (eval operator))) + (if binding + (let ((arglist (procedure-parameter-list binding))) + (let loop ((arglist arglist) + (optionals? #f) + (required '()) + (optional '())) + (cond ((null? arglist) + `(,operator ("args" (("required" ,@(reverse required)) + ("optional" ,@(reverse optional)) + ("key") + ;; ("module" ,module) + )))) + ((symbol? arglist) + (loop '() + #t + required + (cons "..." (cons arglist optional)))) + (else + (loop + (cdr arglist) + optionals? + (if optionals? required (cons (car arglist) required)) + (if optionals? (cons (car arglist) optional) optional)))))) + '()))) + (define (geiser:autodoc ids . rest) - '()) + (cond ((null? ids) '()) + ((not (list? ids)) + (geiser:autodoc (list ids))) + ((not (symbol? (car ids))) + (geiser:autodoc (cdr ids))) + (else + (map (lambda (id) + (operator-arglist id)) + ids)))) (define (geiser:no-values) #f) |