PLT: M-. is also able to locate modules. Refactorings.

5 files changed, 107 insertions, 61 deletions

diff --git a/scheme/plt/geiser/autodoc.ss b/scheme/plt/geiser/autodoc.ss
index d7f3a0e..423f52e 100644
--- a/scheme/plt/geiser/autodoc.ss
+++ b/scheme/plt/geiser/autodoc.ss
@@ -24,7 +24,7 @@
 
 (provide autodoc update-module-cache)
 
-(require geiser/utils geiser/locations)
+(require geiser/utils geiser/modules geiser/locations)
 
 (define (autodoc form)
   (cond ((null? form) #f)
diff --git a/scheme/plt/geiser/eval.ss b/scheme/plt/geiser/eval.ss
index 694802a..56a321e 100644
--- a/scheme/plt/geiser/eval.ss
+++ b/scheme/plt/geiser/eval.ss
@@ -33,38 +33,9 @@
          macroexpand
          make-repl-reader)
 
-(require scheme/enter geiser/utils geiser/autodoc)
+(require scheme/enter geiser/modules geiser/autodoc)
 
 (define last-result (void))
-(define nowhere (open-output-nowhere))
-
-(define (ensure-spec spec)
-  (cond ((symbol? spec) spec)
-        ((not (string? spec)) #f)
-        ((not (file-exists? spec)) #f)
-        ((absolute-path? spec) `(file ,spec))
-        (else spec)))
-
-(define (load-module spec . port)
-  (parameterize ((current-error-port (if (null? port) nowhere (car port))))
-    (eval #`(enter! #,spec))))
-
-(define (ensure-namespace mod-spec)
-  (letrec ((spec (ensure-spec mod-spec))
-           (handler (lambda (e)
-                      (load-module spec)
-                      (enter! #f)
-                      (module->namespace spec))))
-    (if spec
-        (with-handlers ((exn:fail:contract? handler))
-          (module->namespace spec))
-        (current-namespace))))
-
-(define (namespace->module-path-name ns)
-  (let ((rmp (variable-reference->resolved-module-path
-              (eval '(#%variable-reference) ns))))
-    (and (resolved-module-path? rmp)
-         (resolved-module-path-name rmp))))
 
 (define namespace->module-name
   (compose module-path-name->name namespace->module-path-name))
@@ -87,7 +58,7 @@
   (with-handlers ((exn? set-last-error))
     (update-module-cache spec form)
     (call-with-values
-        (lambda () (eval form (ensure-namespace spec)))
+        (lambda () (eval form (module-spec->namespace spec)))
       set-last-result))
   last-result)
 
@@ -100,11 +71,10 @@
       (set-last-result
        (string-append (with-output-to-string
                         (lambda ()
-                          (load-module (ensure-spec file)
-                                       (current-output-port))))
+                          (load-module file (current-output-port))))
                       "done."))
       (load-module (and (path? current-path)
-                        (ensure-spec (path->string current-path))))))
+                        (path->string current-path)))))
   last-result)
 
 (define compile-file load-file)
diff --git a/scheme/plt/geiser/locations.ss b/scheme/plt/geiser/locations.ss
index d1c5cb7..87a643d 100644
--- a/scheme/plt/geiser/locations.ss
+++ b/scheme/plt/geiser/locations.ss
@@ -28,10 +28,11 @@
 
 (provide symbol-location
          symbol-location*
+         module-location
          symbol-module-name
          symbol-module-path-name)
 
-(require geiser/utils)
+(require geiser/utils geiser/modules)
 
 (define (symbol-location* sym)
   (let* ((id (namespace-symbol->identifier sym))
@@ -43,16 +44,26 @@
           (module-path-index-resolve (car binding))))
         (cons sym #f))))
 
+(define (make-location name path line)
+  (list (cons 'name name)
+        (cons 'file (if (path? path) (path->string path) '()))
+        (cons 'line (or line '()))))
+
 (define (symbol-location sym)
   (let* ((loc (symbol-location* sym))
          (name (car loc))
          (path (cdr loc)))
-    (list (cons 'name name)
-          (cons 'file (if (path? path) (path->string path) '())))))
+    (if path
+        (make-location name path #f)
+        (module-location sym))))
 
 (define symbol-module-path-name (compose cdr symbol-location*))
 
 (define symbol-module-name
   (compose module-path-name->name symbol-module-path-name))
 
+(define (module-location sym)
+  (make-location sym (module-spec->path-name sym) 1))
+
+
 ;;; locations.ss ends here
diff --git a/scheme/plt/geiser/modules.ss b/scheme/plt/geiser/modules.ss
new file mode 100644
index 0000000..3bed19e
--- /dev/null
+++ b/scheme/plt/geiser/modules.ss
@@ -0,0 +1,87 @@
+;; modules.ss -- module metadata
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Wed May 06, 2009 02:35
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+#lang scheme
+
+(provide load-module
+         module-spec->namespace
+         namespace->module-path-name
+         module-path-name->name
+         module-spec->path-name)
+
+(require srfi/13 scheme/enter)
+
+(define nowhere (open-output-nowhere))
+
+(define (ensure-module-spec spec)
+  (cond ((symbol? spec) spec)
+        ((not (string? spec)) #f)
+        ((not (file-exists? spec)) #f)
+        ((absolute-path? spec) `(file ,spec))
+        (else spec)))
+
+(define (module-spec->namespace mod-spec)
+  (letrec ((spec (ensure-module-spec mod-spec))
+           (handler (lambda (e)
+                      (load-module spec)
+                      (enter! #f)
+                      (module->namespace spec))))
+    (if spec
+        (with-handlers ((exn:fail:contract? handler))
+          (module->namespace spec))
+        (current-namespace))))
+
+(define (load-module spec . port)
+  (parameterize ((current-error-port (if (null? port) nowhere (car port))))
+    (eval #`(enter! #,(ensure-module-spec spec)))))
+
+(define (namespace->module-path-name ns)
+  (let ((rmp (variable-reference->resolved-module-path
+              (eval '(#%variable-reference) ns))))
+    (and (resolved-module-path? rmp)
+         (resolved-module-path-name rmp))))
+
+(define (module-spec->path-name spec)
+  (with-handlers ((exn? (lambda (_) #f)))
+    (let ((ns (module->namespace (ensure-module-spec spec))))
+      (namespace->module-path-name (eval '(current-namespace) ns)))))
+
+(define (module-path-name->name path)
+  (cond ((path? path)
+         (let* ((path (path->string path))
+                (cpaths (map (compose 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)
+               (call-with-values (lambda () (split-path path))
+                 (lambda (_ basename __) (path->string basename)))
+               (regexp-replace "\\.[^./]*$" real-path ""))))
+        ((eq? path '#%kernel) "(kernel)")
+        ((string? path) path)
+        ((symbol? path) (symbol->string path))
+        (else "<top>")))
+
+;;; modules.ss ends here
diff --git a/scheme/plt/geiser/utils.ss b/scheme/plt/geiser/utils.ss
index 557cf26..84c6964 100644
--- a/scheme/plt/geiser/utils.ss
+++ b/scheme/plt/geiser/utils.ss
@@ -26,32 +26,10 @@
 
 #lang scheme
 
-(provide module-path-name->name
-         pair->list
+(provide pair->list
          keyword->symbol
          symbol->keyword)
 
-(require srfi/13)
-
-(define (module-path-name->name path)
-  (cond ((path? path)
-         (let* ((path (path->string path))
-                (cpaths (map (compose 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)
-               (call-with-values (lambda () (split-path path))
-                 (lambda (_ basename __) (path->string basename)))
-               (regexp-replace "\\.[^./]*$" real-path ""))))
-        ((eq? path '#%kernel) "(kernel)")
-        ((string? path) path)
-        ((symbol? path) (symbol->string path))
-        (else "<top>")))
-
 (define (pair->list pair)
   (let loop ((d pair) (s '()))
     (cond ((null? d) (reverse s))