summaryrefslogtreecommitdiff
path: root/scheme/plt/geiser
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-05-06 03:11:27 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-05-06 03:11:27 +0200
commit4d9ac1be1f1c5357c2f590e24ec8ef97ebb01e27 (patch)
tree72e45ba7a9bd40f37c343612d50ead2c2dcbb323 /scheme/plt/geiser
parenta7cde6cd6c4677c4618ece3602890d6f6782cd48 (diff)
downloadgeiser-chez-4d9ac1be1f1c5357c2f590e24ec8ef97ebb01e27.tar.gz
geiser-chez-4d9ac1be1f1c5357c2f590e24ec8ef97ebb01e27.tar.bz2
PLT: M-. is also able to locate modules. Refactorings.
Diffstat (limited to 'scheme/plt/geiser')
-rw-r--r--scheme/plt/geiser/autodoc.ss2
-rw-r--r--scheme/plt/geiser/eval.ss38
-rw-r--r--scheme/plt/geiser/locations.ss17
-rw-r--r--scheme/plt/geiser/modules.ss87
-rw-r--r--scheme/plt/geiser/utils.ss24
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))