diff options
| author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-03-06 23:33:38 +0100 | 
|---|---|---|
| committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-03-06 23:33:38 +0100 | 
| commit | f36778f5367d73a519b56f48a79875a424db35fe (patch) | |
| tree | 858d7aea0e25392d623747749ec7ad434d42eeb0 /geiser | |
| parent | d71825cd8e95d4b17631d4f2ce0a26a12f67b199 (diff) | |
| download | geiser-guile-f36778f5367d73a519b56f48a79875a424db35fe.tar.gz geiser-guile-f36778f5367d73a519b56f48a79875a424db35fe.tar.bz2 | |
Some tidy up.
Diffstat (limited to 'geiser')
| -rw-r--r-- | geiser/doc.scm | 41 | 
1 files changed, 19 insertions, 22 deletions
| diff --git a/geiser/doc.scm b/geiser/doc.scm index a58f1d9..b128434 100644 --- a/geiser/doc.scm +++ b/geiser/doc.scm @@ -37,34 +37,27 @@    #:use-module (oop goops)    #:use-module (srfi srfi-1)) -(define placeholder (gensym)) -  (define (autodoc form) -  (cond ((or (eq? form placeholder) (null? form)) #f) +  (cond ((null? form) #f)          ((symbol? form) (describe-application (list form)))          ((not (pair? form)) #f)          ((not (list? form)) (autodoc (pair->list form)))          ((define-head? form) => autodoc) -        (else -         (let ((lst (last form))) -           (cond ((and (symbol? lst) (describe-application (list lst)))) -                 ((and (pair? lst) (not (memq (car lst) '(quote))) (autodoc lst))) -                 ((pair? lst) (autodoc (flatten-last form))) -                 (else (describe-application form))))))) +        (else (autodoc/list form)))) -(define (flatten-last form) -  (reverse! (cons placeholder (cdr (reverse! form))))) +(define (autodoc/list form) +  (let ((lst (last form))) +    (cond ((and (symbol? lst) (describe-application (list lst)))) +          ((and (pair? lst) (not (memq (car lst) '(quote))) (autodoc lst))) +          (else (describe-application form)))))  (define (define-head? form) -  (define def-heads '(define define* define-macro define-macro* define-method)) +  (define defforms '(define define* define-macro define-macro* +                      define-method define-class define-generic))    (and (= 2 (length form)) -       (memq (car form) def-heads) +       (memq (car form) defforms)         (car form))) -(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)))) @@ -73,11 +66,9 @@                 (cons 'position (find-position args form))                 (cons 'module (symbol-module fun)))))) -(define (arglst args kind) -  (let ((args (assq-ref args kind))) -    (cond ((or (not args) (null? args)) '()) -          ((list? args) args) -          (else (list args))))) +(define (object-signature name obj) +  (let ((args (obj-args obj))) +    (and args (signature name args))))  (define (signature fun args)    (let ((req (arglst args 'required)) @@ -111,6 +102,12 @@                           (if (null? keys) 0 (+ 1 (length keys)))                           (if rest 2 0)))))))) +(define (arglst args kind) +  (let ((args (assq-ref args kind))) +    (cond ((or (not args) (null? args)) '()) +          ((list? args) args) +          (else (list args))))) +  (define (obj-args obj)    (cond ((not obj) #f)          ((or (procedure? obj) (program? obj)) (arguments obj)) | 
