summaryrefslogtreecommitdiff
path: root/scheme/racket/geiser
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-11-21 16:12:41 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-11-21 16:12:41 +0100
commitf531c3e0f5afda77ada497d3932ea10502e22bdb (patch)
tree72194f6eef587e6f99f45f81ec168b561056233b /scheme/racket/geiser
parentde6b4addba49abbb43f07c8e153356308bcd8709 (diff)
downloadgeiser-chez-f531c3e0f5afda77ada497d3932ea10502e22bdb.tar.gz
geiser-chez-f531c3e0f5afda77ada497d3932ea10502e22bdb.tar.bz2
Racket: showing submodules in module help
Diffstat (limited to 'scheme/racket/geiser')
-rw-r--r--scheme/racket/geiser/autodoc.rkt5
-rw-r--r--scheme/racket/geiser/completions.rkt2
-rw-r--r--scheme/racket/geiser/modules.rkt71
-rw-r--r--scheme/racket/geiser/startup.rkt23
-rw-r--r--scheme/racket/geiser/user.rkt4
5 files changed, 83 insertions, 22 deletions
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/startup.rkt b/scheme/racket/geiser/startup.rkt
new file mode 100644
index 0000000..6af06da
--- /dev/null
+++ b/scheme/racket/geiser/startup.rkt
@@ -0,0 +1,23 @@
+;;; startup.rkt -- entry point
+
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sat Apr 25, 2009 22:36
+
+;;; Code:
+
+(require version/utils)
+(unless (version<=? "5.0" (version))
+ (error 'geiser
+ "Racket version 5.0 or better required (found ~a)"
+ (version)))
+
+(require errortrace)
+(require geiser/user)
+
+(init-geiser-repl)
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)])