From c09f5bbaa836d04a9babdff0943dc596dbc68e38 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Fri, 8 May 2009 01:48:52 +0200
Subject: Module completion generalized and implemented for PLT.

---
 scheme/plt/geiser.ss         |  8 +++++++-
 scheme/plt/geiser/modules.ss | 42 +++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 48 insertions(+), 2 deletions(-)

(limited to 'scheme')

diff --git a/scheme/plt/geiser.ss b/scheme/plt/geiser.ss
index 767b13b..89de51e 100644
--- a/scheme/plt/geiser.ss
+++ b/scheme/plt/geiser.ss
@@ -31,12 +31,17 @@
            geiser/compile-file
            geiser/macroexpand
            geiser/completions
+           geiser/all-modules
            geiser/symbol-location
            geiser/autodoc
            geiser/make-repl-reader)
 
   (compile-enforce-module-constants #f)
-  (require geiser/eval geiser/completions geiser/locations geiser/autodoc)
+  (require geiser/eval
+           geiser/modules
+           geiser/completions
+           geiser/locations
+           geiser/autodoc)
 
   (define geiser/eval eval-in)
   (define geiser/compile compile-in)
@@ -44,6 +49,7 @@
   (define geiser/compile-file compile-file)
   (define geiser/autodoc autodoc)
   (define geiser/completions completions)
+  (define geiser/all-modules module-list)
   (define geiser/symbol-location symbol-location)
   (define geiser/macroexpand macroexpand)
 
diff --git a/scheme/plt/geiser/modules.ss b/scheme/plt/geiser/modules.ss
index 9ccb421..a1094af 100644
--- a/scheme/plt/geiser/modules.ss
+++ b/scheme/plt/geiser/modules.ss
@@ -26,7 +26,8 @@
          module-spec->namespace
          namespace->module-path-name
          module-path-name->name
-         module-spec->path-name)
+         module-spec->path-name
+         module-list)
 
 (require srfi/13 scheme/enter)
 
@@ -84,4 +85,43 @@
         ((symbol? path) (symbol->string path))
         (else "<top>")))
 
+
+(define (skippable-dir? path)
+  (call-with-values (lambda () (split-path path))
+    (lambda (_ basename __)
+      (member (path->string basename) '(".svn" "compiled")))))
+
+(define path->symbol (compose string->symbol path->string))
+
+(define (path->entry path)
+  (and (bytes=? (or (filename-extension path) #"") #"ss")
+       (let ((path (path->string path)))
+         (substring path 0 (- (string-length path) 3)))))
+
+(define (visit-module-path path kind acc)
+  (case kind
+    ((file) (let ((entry (path->entry path)))
+              (if entry (cons entry acc) acc)))
+    ((dir) (cond ((skippable-dir? path) (values acc #f))
+                 ((file-exists? (build-path path "main.ss"))
+                  (cons (path->string path) acc))
+                 (else acc)))
+    (else acc)))
+
+(define (find-modules path acc)
+  (if (directory-exists? path)
+      (parameterize ((current-directory path))
+        (fold-files visit-module-path acc))
+      acc))
+
+(define module-cache #f)
+
+(define (module-list)
+  (when (not module-cache)
+    (set! module-cache
+          (sort (foldl find-modules '() (current-library-collection-paths))
+                string<?)))
+  module-cache)
+
+
 ;;; modules.ss ends here
-- 
cgit v1.2.3