From ddf6ce8db51ab270faee5edb723f91c827e62a57 Mon Sep 17 00:00:00 2001
From: Peter <craven@gmx.net>
Date: Sun, 1 May 2016 10:44:06 +0200
Subject: geiser-chibi: Implement autodoc for procedures in known modules

---
 scheme/chibi/geiser/geiser.scm | 45 +++++++++++++++++++++++++++++++++++++++++-
 scheme/chibi/geiser/geiser.sld |  2 +-
 2 files changed, 45 insertions(+), 2 deletions(-)

(limited to 'scheme/chibi/geiser')

diff --git a/scheme/chibi/geiser/geiser.scm b/scheme/chibi/geiser/geiser.scm
index fe0569e..79a1b4e 100644
--- a/scheme/chibi/geiser/geiser.scm
+++ b/scheme/chibi/geiser/geiser.scm
@@ -40,8 +40,51 @@
                         (string-contains prefix (write-to-string module))))
                   modules)))))
 
+(define (procedure-arglist id fun)
+  (let ((arglist (lambda-params (procedure-analysis fun))))
+    (if (pair? arglist)
+        (let loop ((arglist arglist)
+                   (optionals? #f)
+                   (required '())
+                   (optional '()))
+          (cond ((null? arglist)
+                 `(,id ("args" (("required" ,@(reverse required))
+                                ("optional" ,@(reverse optional))
+                                ("key")
+                                ("module" ,(let ((mod (containing-module fun))) (if mod (car mod) #f)))))))
+                ((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)))))
+        '())))
+
+(define (geiser:operator-arglist id)
+  (let ((binding (eval id)))
+    (cond ((procedure? binding)
+           (if (opcode? binding)
+               '()
+               (procedure-arglist id binding)))
+          (else
+           '()))))
+
 (define (geiser:autodoc ids . rest)
-  '())
+  rest
+  (cond ((null? ids) '())
+        ((not (list? ids))
+         (geiser:autodoc (list ids)))
+        ((not (symbol? (car ids)))
+         (geiser:autodoc (cdr ids)))
+        (else
+         (map (lambda (id)
+                (geiser:operator-arglist id))
+              ids))))
 
 (define (geiser:no-values)
   #f)
diff --git a/scheme/chibi/geiser/geiser.sld b/scheme/chibi/geiser/geiser.sld
index a6e2704..56abab3 100644
--- a/scheme/chibi/geiser/geiser.sld
+++ b/scheme/chibi/geiser/geiser.sld
@@ -5,5 +5,5 @@
           geiser:module-completions
           geiser:no-values
           geiser:newline)
-  (import (scheme small) (chibi modules) (chibi) (meta) (chibi string) (srfi 1) (srfi 95))
+  (import (scheme small) (chibi modules) (chibi) (meta) (chibi ast) (chibi string) (srfi 1) (srfi 95))
   (include "geiser.scm"))
-- 
cgit v1.2.3