diff options
author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-03-01 01:09:16 +0100 |
---|---|---|
committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-03-01 01:09:16 +0100 |
commit | 1376e6ca4919396ff94c78374d816f86556f395e (patch) | |
tree | 4015ec500a55a66107d69816b55b31b879051ccd /scheme/guile | |
parent | 04652644b47528d0a3ab00c6475a6752e7a1dbb5 (diff) | |
download | geiser-guile-1376e6ca4919396ff94c78374d816f86556f395e.tar.gz geiser-guile-1376e6ca4919396ff94c78374d816f86556f395e.tar.bz2 |
Fix for autodoc when point in a rest formal arg in define.
Diffstat (limited to 'scheme/guile')
-rw-r--r-- | scheme/guile/geiser/introspection.scm | 16 |
1 files changed, 9 insertions, 7 deletions
diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm index 0a724f2..cab11fd 100644 --- a/scheme/guile/geiser/introspection.scm +++ b/scheme/guile/geiser/introspection.scm @@ -41,11 +41,12 @@ (define (autodoc form) (cond ((null? form) #f) ((symbol? form) (describe-application (list form))) + ((and (pair? form) (not (list? form))) (autodoc (pair->list form))) ((list? form) (let ((lst (last form))) (cond ((symbol? lst) (or (describe-application (list lst)) (describe-application form))) - ((list? lst) + ((pair? lst) (or (autodoc lst) (autodoc (map (lambda (s) (if (list? s) (gensym) s)) form)))) (else (describe-application form))))) @@ -59,6 +60,12 @@ (cons 'position (find-position args form)) (cons 'module (symbol-module fun)))))) +(define (pair->list pair) + (let loop ((d pair) (s '())) + (cond ((null? d) (reverse! s)) + ((symbol? d) (reverse! (cons d s))) + (else (loop (cdr d) (cons (car d) s)))))) + (define (arglst args kind) (let ((args (assq-ref args kind))) (cond ((or (not args) (null? args)) '()) @@ -159,18 +166,13 @@ (define (local-bindings form) (define (body f) (if (> (length f) 2) (cddr f) '())) - (define (decl-list d) - (let loop ((d d) (s '())) - (cond ((null? d) s) - ((symbol? d) (cons d s)) - (else (loop (cdr d) (cons (car d) s)))))) (let loop ((form form) (bindings '())) (cond ((not (pair? form)) bindings) ((list? (car form)) (loop (cdr form) (append (local-bindings (car form)) bindings))) ((and (list? form) (< (length form) 2)) bindings) ((memq (car form) '(define define* lambda)) - (loop (body form) (append (decl-list (cadr form)) bindings))) + (loop (body form) (append (pair->list (cadr form)) bindings))) ((and (memq (car form) '(let let* letrec letrec*)) (list? (cadr form))) (loop (body form) (append (map car (cadr form)) bindings))) |