From aa3b4233fd2ce19bd3de6759173172e014ef2f63 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Mon, 11 Oct 2010 02:25:34 +0200
Subject: Guile: remote REPLs (connect-to-guile)
geiser-connect (or its specialisation, connect-to-guile) working for
Guile, where the external process is started with the new --listen
flag.
---
elisp/geiser-guile.el | 12 +++++++++++-
elisp/geiser.el | 3 +++
scheme/guile/geiser/evaluation.scm | 23 +++++++++++++----------
3 files changed, 27 insertions(+), 11 deletions(-)
diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index 7dfb9ad..d831bbf 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -101,7 +101,7 @@ This function uses `geiser-guile-init-file' if it exists."
(let ((init-file (and (stringp geiser-guile-init-file)
(expand-file-name geiser-guile-init-file))))
`(,@(and (listp geiser-guile-binary) (cdr geiser-guile-binary))
- "-q" "-L" ,(expand-file-name "guile/" geiser-scheme-dir)
+ "-q"
,@(apply 'append (mapcar (lambda (p) (list "-L" p)) geiser-guile-load-path))
,@(and init-file (file-readable-p init-file) (list "-l" init-file)))))
@@ -223,6 +223,13 @@ The new level is set using the value of `geiser-guile-warning-level'."
(geiser evaluation))))
(geiser-eval--send/result code)))
+(defun connect-to-guile ()
+ "Start a Guile REPL connected to a remote process.
+
+Start the external Guile process with the flag --listen to make
+it spawn a server thread."
+ (geiser-connect 'guile))
+
(defun geiser-guile--startup ()
(set (make-local-variable 'compilation-error-regexp-alist)
`((,geiser-guile--path-rx geiser-guile--resolve-file-x)
@@ -232,6 +239,9 @@ The new level is set using the value of `geiser-guile-warning-level'."
(font-lock-add-keywords nil
`((,geiser-guile--path-rx 1
compilation-error-face)))
+ (geiser-eval--send/result
+ `(:scm ,(format "(set! %%load-path (cons %S %%load-path))"
+ (expand-file-name "guile/" geiser-scheme-dir))))
(geiser-guile-update-warning-level))
diff --git a/elisp/geiser.el b/elisp/geiser.el
index a64a20d..d40b6a8 100644
--- a/elisp/geiser.el
+++ b/elisp/geiser.el
@@ -48,6 +48,9 @@
(autoload 'switch-to-guile "geiser-guile"
"Start a Geiser Guile REPL, or switch to a running one." t)
+(autoload 'connect-to-guile "geiser-guile"
+ "Connect to a remote Geiser Guile REPL." t)
+
(autoload 'run-racket "geiser-racket" "Start a Geiser Racket REPL." t)
(autoload 'run-gracket "geiser-racket" "Start a Geiser GRacket REPL." t)
diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm
index 6b8df8f..1cc21a7 100644
--- a/scheme/guile/geiser/evaluation.scm
+++ b/scheme/guile/geiser/evaluation.scm
@@ -40,8 +40,8 @@
(write (list (cons 'result result) (cons 'output output)))
(newline))
-(define compile-opts (make-fluid))
-(define compile-file-opts (make-fluid))
+(define compile-opts '())
+(define compile-file-opts '())
(define default-warnings '(arity-mismatch unbound-variable))
(define verbose-warnings `(unused-variable ,@default-warnings))
@@ -51,13 +51,14 @@
((symbol? wl) (case wl
((none nil null) '())
((medium default) default-warnings)
- ((high verbose) verbose-warnings)))
+ ((high verbose) verbose-warnings)
+ (else '())))
(else '())))
(fwarns (if (memq 'unused-variable warns)
(cons 'unused-toplevel warns)
warns)))
- (fluid-set! compile-opts (list #:warnings warns))
- (fluid-set! compile-file-opts (list #:warnings fwarns))))
+ (set! compile-opts (list #:warnings warns))
+ (set! compile-file-opts (list #:warnings fwarns))))
(ge:set-warnings 'none)
@@ -71,10 +72,12 @@
(write-result result output)))
(define (compile/no-warns form module)
- (with-fluids ((compile-opts '()))
- (compile/warns form module)))
+ (compile* form module '()))
-(define (compile/warns form module-name)
+(define (compile/warns form module)
+ (compile* form module compile-opts))
+
+(define (compile* form module-name opts)
(let* ((module (or (find-module module-name) (current-module)))
(ev (lambda ()
(call-with-values
@@ -82,7 +85,7 @@
(let* ((o (compile form
#:to 'objcode
#:env module
- #:opts (fluid-ref compile-opts)))
+ #:opts opts))
(thunk (make-program o)))
(start-stack 'geiser-evaluation-stack
(eval `(,thunk) module))))
@@ -94,7 +97,7 @@
(lambda ()
(let ((cr (compile-file path
#:canonicalization 'absolute
- #:opts (fluid-ref compile-file-opts))))
+ #:opts compile-file-opts)))
(and cr
(list (object->string (save-module-excursion
(lambda () (load-compiled cr))))))))))
--
cgit v1.2.3