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.

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))))))))))