summaryrefslogtreecommitdiff
path: root/scheme/racket
diff options
context:
space:
mode:
Diffstat (limited to 'scheme/racket')
-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))