From a2d5fff7fb7bd6fced44d613be48df6a81570534 Mon Sep 17 00:00:00 2001
From: Jay Xu <jay.xu.krfantasy@gmail.com>
Date: Wed, 22 Jul 2020 22:04:41 +0800
Subject: make autodoc support the procedure defined by case-lambda.

---
 src/geiser/geiser.ss | 57 ++++++++++++++++++++++++++++------------------------
 1 file changed, 31 insertions(+), 26 deletions(-)

diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss
index 33d1b39..478b9af 100644
--- a/src/geiser/geiser.ss
+++ b/src/geiser/geiser.ss
@@ -98,39 +98,44 @@
       (if s
           (let ((form (s 'value)))
             (if (and (list? form)
-                     (> (length form) 2)
-                     (eq? (car form) 'lambda))
-                (cadr form)
+                     (> (length form) 2))
+                (case (car form)
+                  [(lambda) (list (cadr form))]
+                  [(case-lambda) (map car (cdr form))]
+                  [else #f])
                 #f))
           #f)))
 
   (define (operator-arglist operator)
-    (let ((binding (eval operator)))
+    (define (make-autodoc-arglist arglist)
+      (let loop ([arglist arglist]
+                 [optionals? #f]
+                 [required '()]
+                 [optional '()])
+        (cond ((null? arglist)
+               `(("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))))))
+    (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))))))
+          (let ([arglists (procedure-parameter-list binding)])
+            `(,operator ("args" ,@(map make-autodoc-arglist arglists))))
           '())))
 
+
   (define (geiser:autodoc ids . rest)
     (cond ((null? ids) '())
           ((not (list? ids))
-- 
cgit v1.2.3