[nongnu] elpa/geiser-racket e855c05 135/191: racket: , enter submodules

[Philip Kaludercic]

branch: elpa/geiser-racket
commit e855c05bf9b30aeea0624b82a303ae5162c62ddf
Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
Commit: Jose Antonio Ortega Ruiz <jao@gnu.org>

    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.
---
 geiser/modules.rkt | 37 +++++++++++++++++++++----------------
 geiser/user.rkt    | 18 ++++++++++++------
 2 files changed, 33 insertions(+), 22 deletions(-)

diff --git a/geiser/modules.rkt b/geiser/modules.rkt
index befe2bc..a4fbd6f 100644
--- a/geiser/modules.rkt
+++ b/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/geiser/user.rkt b/geiser/user.rkt
index b3112f2..753f353 100644
--- a/geiser/user.rkt
+++ b/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))