summaryrefslogtreecommitdiff
path: root/scheme
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2013-06-08 16:01:01 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2013-06-08 16:01:01 +0200
commit1551885d929463723748b81e9bfab07bde0d1f47 (patch)
tree41dadc76630261ee1c904ca064c875a209f43e34 /scheme
parentbb38fa9c5cae5095a629c6cbb4ea570d47adeb62 (diff)
downloadgeiser-chez-1551885d929463723748b81e9bfab07bde0d1f47.tar.gz
geiser-chez-1551885d929463723748b81e9bfab07bde0d1f47.tar.bz2
racket: ,enter submodules
It is now possible to ,enter racket submodules. This is only the first part of the story, because evalations should take place in the submodule, not in its top level module, as it happens now.
Diffstat (limited to 'scheme')
-rw-r--r--scheme/racket/geiser/modules.rkt37
-rw-r--r--scheme/racket/geiser/user.rkt18
2 files changed, 33 insertions, 22 deletions
diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt
index befe2bc..a4fbd6f 100644
--- a/scheme/racket/geiser/modules.rkt
+++ b/scheme/racket/geiser/modules.rkt
@@ -1,6 +1,6 @@
;;; modules.rkt -- module metadata
-;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010, 2011, 2012, 2013 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
@@ -74,25 +74,30 @@
(define (unix-path->string path)
(regexp-replace* "\\\\" (path->string path) "/"))
+(define (path->name path)
+ (if (path-string? path)
+ (let* ([cpaths (map (compose unix-path->string path->directory-path)
+ (current-library-collection-paths))]
+ [prefix-len (lambda (p)
+ (let ((pl (string-length p)))
+ (if (= pl (string-prefix-length p path))
+ pl
+ 0)))]
+ [lens (map prefix-len cpaths)]
+ [real-path (substring path (apply max lens))])
+ (if (absolute-path? real-path)
+ (let-values ([(_ base __) (split-path path)])
+ (unix-path->string base))
+ (regexp-replace "\\.[^./]*$" real-path "")))
+ path))
+
(define (module-path-name->name path)
(cond [(path? path) (module-path-name->name (unix-path->string path))]
;; [(eq? path '#%kernel) "(kernel)"]
- [(string? path)
- (let* ([cpaths (map (compose unix-path->string path->directory-path)
- (current-library-collection-paths))]
- [prefix-len (lambda (p)
- (let ((pl (string-length p)))
- (if (= pl (string-prefix-length p path))
- pl
- 0)))]
- [lens (map prefix-len cpaths)]
- [real-path (substring path (apply max lens))])
- (if (absolute-path? real-path)
- (let-values ([(_ base __) (split-path path)])
- (unix-path->string base))
- (regexp-replace "\\.[^./]*$" real-path "")))]
+ [(path-string? path) (path->name path)]
[(symbol? path) (symbol->string path)]
- [else unknown-module-name]))
+ [(list? path) (string-join (map (compose path->name ~a) path) "/")]
+ [else (~a path)]))
(define (module-path-index->name mpi)
(let ([rmp (module-path-index-resolve mpi)])
diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt
index b3112f2..753f353 100644
--- a/scheme/racket/geiser/user.rkt
+++ b/scheme/racket/geiser/user.rkt
@@ -32,21 +32,27 @@
(current-namespace (module->namespace mod))
(last-entered name))
+(define (submod-path mod)
+ (and (list? mod)
+ (eq? 'submod (car mod))
+ (> (length mod) 1)
+ (let ([parent (cadr mod)])
+ (cond [(path-string? parent) `(submod (file ,parent) ,@(cddr mod))]
+ [(symbol? parent) mod]
+ [else #f]))))
+
(define (enter! mod stx)
(cond [(not mod)
(current-namespace top-namespace)
(last-entered "")]
[(symbol? mod) (do-enter mod (symbol->string mod))]
+ [(path-string? mod) (do-enter `(file ,mod) mod)]
[(and (list? mod)
(= 2 (length mod))
(eq? 'file (car mod))
(path-string? (cadr mod))) (do-enter mod (cadr mod))]
- [(path-string? mod) (do-enter `(file ,mod) mod)]
- [else (raise-syntax-error
- #f
- "not a valid module path, and not #f"
- stx
- mod)]))
+ [(submod-path mod) => (lambda (m) (do-enter m m))]
+ [else (raise-syntax-error #f "Invalid module path" stx mod)]))
(define orig-loader (current-load/use-compiled))
(define geiser-loader (module-loader orig-loader))