diff options
Diffstat (limited to 'scheme/racket/geiser')
| -rw-r--r-- | scheme/racket/geiser/modules.rkt | 37 | ||||
| -rw-r--r-- | scheme/racket/geiser/user.rkt | 18 |
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)) |