Racket: showing submodules in module help

7 files changed, 66 insertions, 27 deletions

diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el
index ac2e1f6..616c3af 100644
--- a/elisp/geiser-racket.el
+++ b/elisp/geiser-racket.el
@@ -79,13 +79,14 @@ This executable is used by `run-gracket', and, if
 This function uses `geiser-racket-init-file' if it exists."
   (let ((init-file (and (stringp geiser-racket-init-file)
                         (expand-file-name geiser-racket-init-file)))
-        (binary (geiser-racket--real-binary)))
+        (binary (geiser-racket--real-binary))
+        (rackdir (expand-file-name "racket/" geiser-scheme-dir)))
     `("-i" "-q"
-      "-S" ,(expand-file-name "racket/" geiser-scheme-dir)
+      "-S" ,rackdir
       ,@(apply 'append (mapcar (lambda (p) (list "-S" p)) geiser-racket-collects))
       ,@(and (listp binary) (cdr binary))
       ,@(and init-file (file-readable-p init-file) (list "-f" init-file))
-      "-f" ,(expand-file-name "racket/geiser.rkt" geiser-scheme-dir))))
+      "-f" ,(expand-file-name "geiser/startup.rkt" rackdir))))
 
 (defconst geiser-racket--prompt-regexp "\\(mzscheme\\|racket\\)@[^ ]*?> ")
 
diff --git a/scheme/Makefile.am b/scheme/Makefile.am
index 3c8908e..e1b6559 100644
--- a/scheme/Makefile.am
+++ b/scheme/Makefile.am
@@ -7,7 +7,6 @@ nobase_dist_pkgdata_DATA = \
   guile/geiser/modules.scm \
   guile/geiser/utils.scm \
   guile/geiser/xref.scm \
-  racket/geiser.rkt \
   racket/geiser/autodoc.rkt \
   racket/geiser/completions.rkt \
   racket/geiser/enter.rkt \
@@ -16,5 +15,6 @@ nobase_dist_pkgdata_DATA = \
   racket/geiser/main.rkt \
   racket/geiser/modules.rkt \
   racket/geiser/server.rkt \
+  racket/geiser/startup.rkt \
   racket/geiser/user.rkt \
   racket/geiser/utils.rkt
diff --git a/scheme/racket/geiser/autodoc.rkt b/scheme/racket/geiser/autodoc.rkt
index e9c6a07..54cac24 100644
--- a/scheme/racket/geiser/autodoc.rkt
+++ b/scheme/racket/geiser/autodoc.rkt
@@ -229,5 +229,6 @@
                 (module-compiled-exports
                  (get-module-code (resolve-module-path mod #f)))])
     (let ([syn (map contracted (extract-ids syn))]
-          [reg (extract-ids reg)])
-      `((syntax ,@syn) ,@(classify-ids reg)))))
+          [reg (extract-ids reg)]
+          [subm (map list (or (submodules mod) '()))])
+      `((syntax ,@syn) ,@(classify-ids reg) (modules ,@subm)))))
diff --git a/scheme/racket/geiser/completions.rkt b/scheme/racket/geiser/completions.rkt
index 4cbc09f..0ed18d1 100644
--- a/scheme/racket/geiser/completions.rkt
+++ b/scheme/racket/geiser/completions.rkt
@@ -27,5 +27,3 @@
 
 (define (module-completions prefix)
   (filter-prefix prefix (module-list) #f))
-
-;;; completions.rkt ends here
diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt
index 8e85570..02fd460 100644
--- a/scheme/racket/geiser/modules.rkt
+++ b/scheme/racket/geiser/modules.rkt
@@ -18,7 +18,8 @@
          namespace->module-path-name
          module-path-name->name
          module-spec->path-name
-         module-list)
+         module-list
+         submodules)
 
 (require srfi/13 geiser/enter)
 
@@ -71,8 +72,8 @@
                 [lens (map prefix-len cpaths)]
                 [real-path (substring path (apply max lens))])
            (if (absolute-path? real-path)
-               (call-with-values (lambda () (split-path path))
-                 (lambda (_ basename __) (path->string basename)))
+               (let-values ([(_ base __) (split-path path)])
+                 (path->string base))
                (regexp-replace "\\.[^./]*$" real-path "")))]
         ;; [(eq? path '#%kernel) "(kernel)"]
         [(string? path) path]
@@ -98,37 +99,75 @@
                 [len (- (string-length path) (bytes-length ext) 1)])
            (substring path 0 len)))))
 
-(define (visit-module-path path kind acc)
+(define main-rkt (build-path "main.rkt"))
+(define main-ss (build-path "main.ss"))
+
+(define ((visit-module-path reg?) path kind acc)
   (define (register e p)
-    (register-path (string->symbol e) (build-path (current-directory) p))
-    (cons e acc))
-  (define (find-main ext)
-    (let ([m (build-path path (string-append "main." ext))])
-      (and (file-exists? m) m)))
+    (when reg?
+      (register-path (string->symbol e) (build-path (current-directory) p)))
+    (values (cons e acc) reg?))
+  (define (get-main path main)
+    (and (file-exists? main) (build-path path main)))
+  (define (find-main path)
+    (parameterize ([current-directory path])
+      (or (get-main path main-rkt) (get-main path main-ss))))
   (case kind
     [(file) (let ([entry (path->entry path)])
               (if (not entry) acc (register entry path)))]
     [(dir) (cond [(skippable-dir? path) (values acc #f)]
-                 [(or (find-main "rkt") (find-main "ss")) =>
-                  (curry register (path->string path))]
-                 [else acc])]
+                 [(find-main path) => (curry register (path->string path))]
+                 [else (values acc reg?)])]
     [else acc]))
 
-(define (find-modules path acc)
+(define ((find-modules reg?) path acc)
   (if (directory-exists? path)
       (parameterize ([current-directory path])
-        (fold-files visit-module-path acc))
+        (fold-files (visit-module-path reg?) acc))
       acc))
 
+(define (take-while pred lst)
+  (let loop ([lst lst] [acc '()])
+    (cond [(null? lst) (reverse acc)]
+          [(pred (car lst)) (loop (cdr lst) (cons (car lst) acc))]
+          [else (reverse acc)])))
+
+(define (submodules mod)
+  (let* ([mod-name (if (symbol? mod) mod (get-mod mod))]
+         [mod-str (and (symbol? mod-name) (symbol->string mod-name))])
+    (if mod-str
+        (let ([ms (member mod-str (module-list))])
+          (and ms
+               (take-while (lambda (m) (string-prefix? mod-str m))
+                           (cdr ms))))
+        (find-submodules mod))))
+
+(define (find-submodules path)
+  (and (path-string? path)
+       (let-values ([(dir base ign) (split-path path)])
+         (and (or (equal? base main-rkt)
+                  (equal? base main-ss))
+              (map (lambda (m) (path->string (build-path dir m)))
+                   (remove "main" ((find-modules #f) dir '())))))))
+
 (define (known-modules)
-  (sort (foldl find-modules '() (current-library-collection-paths)) string<?))
+  (sort (foldl (find-modules #t)
+               '()
+               (current-library-collection-paths))
+        string<?))
 
 (define registered (make-hash))
+(define registered-paths (make-hash))
+
+(define (get-path mod)
+  (hash-ref registered mod #f))
 
-(define (get-path mod) (hash-ref registered mod #f))
+(define (get-mod path)
+  (hash-ref registered-paths path #f))
 
 (define (register-path mod path)
   (hash-set! registered mod path)
+  (hash-set! registered-paths path mod)
   path)
 
 (define module-cache #f)
diff --git a/scheme/racket/geiser.rkt b/scheme/racket/geiser/startup.rkt
index 3d75157..6af06da 100644
--- a/scheme/racket/geiser.rkt
+++ b/scheme/racket/geiser/startup.rkt
@@ -1,4 +1,4 @@
-;;; geiser.rkt -- entry point
+;;; startup.rkt -- entry point
 
 ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
 
diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt
index 4dc13e4..70defd4 100644
--- a/scheme/racket/geiser/user.rkt
+++ b/scheme/racket/geiser/user.rkt
@@ -16,7 +16,7 @@
 (require (for-syntax racket/base)
          mzlib/thread
          racket/tcp
-         geiser/main
+         geiser
          geiser/enter
          geiser/eval
          geiser/modules)
@@ -38,7 +38,7 @@
 (define geiser-loader (module-loader orig-loader))
 
 (define (geiser-eval)
-  (define geiser-main (module->namespace 'geiser/main))
+  (define geiser-main (module->namespace 'geiser))
   (let* ([mod (read)]
          [lang (read)]
          [form (read)])