From d56dfe6f1505b99f90a4978dffd0b592fef72a68 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Thu, 15 Oct 2009 02:29:58 +0200
Subject: PLT: autodoc: parsing of definitions with more than one form fixed.

---
 scheme/plt/geiser/autodoc.ss | 36 ++++++++++++++++++++++--------------
 1 file changed, 22 insertions(+), 14 deletions(-)

(limited to 'scheme/plt/geiser')

diff --git a/scheme/plt/geiser/autodoc.ss b/scheme/plt/geiser/autodoc.ss
index 34dd997..b0e77c5 100644
--- a/scheme/plt/geiser/autodoc.ss
+++ b/scheme/plt/geiser/autodoc.ss
@@ -78,24 +78,27 @@
     (match datum
       (`(module ,name ,lang . ,forms)
        (for-each (lambda (f) (parse-datum! f store)) forms))
-      (`(define ((,name . ,formals) ,_) ,_)
+      (`(define ((,name . ,formals) . ,_) . ,_)
        (add-signature! name formals store))
-      (`(define (,name . ,formals) ,_)
+      (`(define (,name . ,formals) . ,_)
        (add-signature! name formals store))
-      (`(define ,name (lambda ,formals ,_))
+      (`(define ,name (lambda ,formals . ,_))
        (add-signature! name formals store))
       (`(define ,name (case-lambda ,clauses ...))
-       (for-each (lambda (c) (add-signature! name (car c) store)) (reverse clauses)))
-      (`(define-for-syntax (,name . ,formals) ,_)
+       (for-each (lambda (c) (add-signature! name (car c) store))
+                 (reverse clauses)))
+      (`(define-for-syntax (,name . ,formals) . ,_)
        (add-signature! name formals store))
-      (`(define-for-syntax ,name (lambda ,formals ,_))
+      (`(define-for-syntax ,name (lambda ,formals . ,_))
        (add-signature! name formals store))
-      (`(define-syntax-rule (,name . ,formals) ,_)
+      (`(define-syntax-rule (,name . ,formals) . ,_)
        (add-signature! name formals store))
       (`(define-syntax ,name (syntax-rules ,specials . ,clauses))
-       (for-each (lambda (c) (add-signature! name (cdar c) store)) (reverse clauses)))
+       (for-each (lambda (c) (add-signature! name (cdar c) store))
+                 (reverse clauses)))
       (`(define-syntax ,name (lambda ,_ (syntax-case ,_ . ,clauses)))
-       (for-each (lambda (c) (add-signature! name (cdar c) store)) (reverse clauses)))
+       (for-each (lambda (c) (add-signature! name (cdar c) store))
+                 (reverse clauses)))
       (_ void))))
 
 (define (add-signature! name formals store)
@@ -110,15 +113,18 @@
     (cond ((null? formals)
            (make-signature (reverse req) (reverse opt) (reverse keys) #f))
           ((symbol? formals)
-           (make-signature (reverse req) (reverse opt) (reverse keys) formals))
+           (make-signature (reverse req) (reverse opt)
+                           (reverse keys) formals))
           ((pair? (car formals)) (loop (cdr formals)
                                        req
                                        (cons (car formals) opt)
                                        keys))
-          ((keyword? (car formals)) (let* ((kname (keyword->symbol (car formals)))
+          ((keyword? (car formals)) (let* ((kname
+                                            (keyword->symbol (car formals)))
                                            (arg-id (cadr formals))
                                            (name (if (pair? arg-id)
-                                                     (list kname (cadr arg-id))
+                                                     (list kname
+                                                           (cadr arg-id))
                                                      kname)))
                                       (loop (cddr formals)
                                             req
@@ -131,7 +137,8 @@
   (define error-tag (cons 1 1))
   (define generic-signature (make-signature '(...) '() '() #f))
   (let ((value (with-handlers ((exn:fail:syntax? (lambda (_) syntax-tag))
-                               (exn:fail:contract:variable? (lambda (_) error-tag)))
+                               (exn:fail:contract:variable? (lambda (_)
+                                                              error-tag)))
                  (namespace-variable-value name))))
     (cond ((procedure? value) (arity->signatures (procedure-arity value)))
           ((eq? value syntax-tag) (list generic-signature))
@@ -149,7 +156,8 @@
     (cond ((number? arity)
            (make-signature (args 0 arity) '() '() #f))
           ((arity-at-least? arity)
-           (make-signature (args 0 (arity-at-least-value arity)) '() '() 'rest))))
+           (make-signature (args 0 (arity-at-least-value arity))
+                           '() '() 'rest))))
   (define (conseq? lst)
     (cond ((< (length lst) 2) (number? (car lst)))
           ((and (number? (car lst))
-- 
cgit v1.2.3