From 1551885d929463723748b81e9bfab07bde0d1f47 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Sat, 8 Jun 2013 16:01:01 +0200
Subject: 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.
---
 scheme/racket/geiser/modules.rkt | 37 +++++++++++++++++++++----------------
 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))
-- 
cgit v1.2.3