[nongnu] elpa/geiser-gauche 3fee273 027/119: Get autodoc info from all modules

[Philip Kaludercic]

branch: elpa/geiser-gauche
commit 3fee273fbaef214651b4ac81dbb3ae8619eda739
Author: András Simonyi <andras.simonyi@gmail.com>
Commit: András Simonyi <andras.simonyi@gmail.com>

    Get autodoc info from all modules
---
 geiser.scm | 42 ++++++++++++++++++++++++++----------------
 1 file changed, 26 insertions(+), 16 deletions(-)

diff --git a/geiser.scm b/geiser.scm
index 7d8e758..4a0fc2e 100644
--- a/geiser.scm
+++ b/geiser.scm
@@ -45,19 +45,25 @@
   (if (string-prefix? ":" (symbol->string sym))
       sym
       (symbol-append ': sym)))
+
+;; Return the id of a module as symbol
+(define (module-id module)
+  (let ((module-repr (write-to-string module)))
+    (string->symbol
+     (substring module-repr 9 (- (string-length module-repr) 1)))))
 
 
 (define (geiser:macroexpand form . rest)
   (with-output-to-string
     (cut pprint (macroexpand form))))
 
-
 (define (geiser:eval module-name form . rest)
   rest
   (let* ((output (open-output-string))
          (module (or (and (symbol? module-name )
-                        (find-module module-name))
-                   (find-module 'user)))
+                         (find-module module-name))
+                    ;; TODO or should we eval in the currently selected module?
+                    (find-module 'user)))
          (result (with-output-to-port output
                    (lambda ()
                      (eval form module)))))
@@ -100,27 +106,31 @@
 ;;; Autodoc
 
 (define (geiser:autodoc ids . rest)
-  (map (cut gauche-info <>)
-       ids))
+  (concatenate
+   (map (cut gauche-info <>)
+       ids)))
 
 (define (gauche-info id)
-  (let ((module (find-module 'user)))
-    (if (global-variable-bound? 'user id)
-       (let1 obj (global-variable-ref (find-module 'user) id)
-             (if (is-a? obj <procedure>)
-                 (process-info (~ obj 'info))
-                 `(,id ("args" (("required" "...")))
-                       ("module" gauche))))
-       `(,id))))
-
-(define (process-info info)
+  (filter-map (cut gauche-info-in-module id <>)
+             (all-modules)))
+
+(define (gauche-info-in-module id module)
+  (if (hash-table-get (module-table module) id #f)
+      (let1 obj (global-variable-ref module id)
+           (if (is-a? obj <procedure>)
+               (process-info (~ obj 'info) module)
+               `(,id ("args" (("required" "...")))
+                     ("module" ,(module-id module)))))
+      #f))
+
+(define (process-info info module)
   `(,(car info)
     ("args"
      ,((if (list? info)
           process-normal-arg-info
           process-dotted-arg-info)
        (cdr info)))
-    ("module" user)))
+    ("module" ,(module-id module))))
 
 (define (process-normal-arg-info arg-info)
   (let ((required '("required"))