From f36778f5367d73a519b56f48a79875a424db35fe Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Fri, 6 Mar 2009 23:33:38 +0100
Subject: Some tidy up.

---
 geiser/doc.scm | 41 +++++++++++++++++++----------------------
 1 file 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))
-- 
cgit v1.2.3