From c09f5bbaa836d04a9babdff0943dc596dbc68e38 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz 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/plt') 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 ""))) + +(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