Many a bug fix in multiple implementation support.

5 files changed, 49 insertions, 35 deletions

diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index 34ed832..60800f4 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -151,7 +151,7 @@
       (newline))
     (newline)))
 
-(make-local-variable
+(make-variable-buffer-local
  (defvar geiser-doc--buffer-link nil))
 
 
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index 847a198..a22428a 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -99,15 +99,10 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported."))
 
 (defvar geiser-eval--default-proc-function nil)
 
-(defsubst geiser-eval--default-proc ()
+(defsubst geiser-eval--proc ()
   (and geiser-eval--default-proc-function
        (funcall geiser-eval--default-proc-function)))
 
-(defvar geiser-eval--proc nil)
-
-(defsubst geiser-eval--proc ()
-  (or geiser-eval--proc (geiser-eval--default-proc)))
-
 (defsubst geiser-eval--log (s)
   (geiser-log--info "RETORT: %S" s)
   s)
diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el
index 20b648e..2cec381 100644
--- a/elisp/geiser-impl.el
+++ b/elisp/geiser-impl.el
@@ -67,7 +67,7 @@
 
 ;;; Installing Scheme implementations:
 
-(make-local-variable
+(make-variable-buffer-local
  (defvar geiser-impl--implementation nil))
 
 (defsubst geiser-impl--impl-feature (impl)
@@ -159,12 +159,32 @@
 
 ;;; Access to implementation guessing function:
 
+(make-variable-buffer-local
+ (defvar geiser-scheme-implementation nil
+   "Set this buffer local variable to specify the Scheme
+implementation to be used by Geiser."))
+
 (defun geiser-impl--guess ()
-  (catch 'impl
-    (dolist (impl geiser-impl--impls)
-      (when (geiser-impl--call-if-bound impl "guess")
-        (throw 'impl impl)))
-    (geiser-impl--default-implementation)))
+  (or geiser-impl--implementation
+      geiser-scheme-implementation
+      (catch 'impl
+        (dolist (impl geiser-impl--impls)
+          (when (geiser-impl--call-if-bound impl "guess")
+            (throw 'impl impl))))
+      (geiser-impl--default-implementation)))
+
+
+;;; User commands:
+(defvar geiser-impl--impl-prompt-history nil)
+
+(defun geiser-impl--read-impl (&optional prompt impls)
+  (let* ((impls (or impls geiser-impl--impls))
+         (impls (mapcar (lambda (s) (format "%s" s)) impls))
+         (prompt (or prompt "Scheme implementation: ")))
+    (intern (completing-read prompt impls nil t nil
+                             geiser-impl--impl-prompt-history
+                             (and (car geiser-impl--impls)
+                                  (symbol-name (car geiser-impl--impls)))))))
 
 
 ;;; Unload support
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index 57fb84e..3e9e3c1 100644
--- a/elisp/geiser-mode.el
+++ b/elisp/geiser-mode.el
@@ -131,6 +131,13 @@ With prefix, recursively macro-expand the resulting expression."
   (interactive "P")
   (geiser-expand-region (save-excursion (backward-sexp) (point)) (point) all))
 
+(defun geiser-set-scheme ()
+  "Associates current buffer with a given Scheme implementation."
+  (interactive)
+  (let ((impl (geiser-impl--read-impl)))
+    (geiser-impl--set-buffer-implementation impl)
+    (geiser-repl--get-repl impl)))
+
 
 ;;; Geiser mode:
 
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index 62fbcdf..d4471b8 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -90,7 +90,7 @@ REPL buffer."
           (throw 'repl repl))))))
 
 (defun geiser-repl--get-repl (&optional impl)
-  (or geiser-repl--repl
+  (or (and (not impl) geiser-repl--repl)
       (setq geiser-repl--repl
             (let ((impl (or impl
                             geiser-impl--implementation
@@ -111,8 +111,8 @@ REPL buffer."
                (not (get-buffer-process (current-buffer))))
     (pop-to-buffer
      (generate-new-buffer (format "* %s *" (geiser-repl--repl-name impl)))))
-  (geiser-impl--set-buffer-implementation impl)
-  (geiser-repl-mode))
+  (geiser-repl-mode)
+  (geiser-impl--set-buffer-implementation impl))
 
 (defun geiser-repl--start-repl (impl)
   (message "Starting Geiser REPL for %s ..." impl)
@@ -132,7 +132,7 @@ REPL buffer."
     (geiser-repl--set-this-buffer-repl (current-buffer))))
 
 (defun geiser-repl--process ()
-  (let ((buffer (geiser-repl--get-repl)))
+  (let ((buffer (geiser-repl--get-repl geiser-impl--implementation)))
     (or (and (buffer-live-p buffer) (get-buffer-process buffer))
         (error "No Geiser REPL for this buffer (try M-x run-geiser)"))))
 
@@ -151,19 +151,8 @@ REPL buffer."
 
 ;;; Interface: starting and interacting with geiser REPL:
 
-(defvar geiser-repl--impl-prompt-history nil)
-
 (defun geiser-repl--read-impl (prompt &optional active)
-  (car (read-from-string
-        (completing-read prompt
-                         (mapcar 'symbol-name
-                                 (if active
-                                     (geiser-repl--active-impls)
-                                   geiser-impl--impls))
-                         nil nil nil
-                         geiser-repl--impl-prompt-history
-                         (and (car geiser-impl--impls)
-                              (symbol-name (car geiser-impl--impls)))))))
+  (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls))))
 
 (defsubst geiser-repl--only-impl-p ()
   (and (null (cdr geiser-impl--impls))
@@ -201,25 +190,28 @@ If no REPL is running, execute `run-geiser' to start a fresh one."
   (goto-char (point-max))
   (comint-kill-region comint-last-input-start (point))
   (comint-redirect-cleanup)
-  (geiser-con--setup-connection geiser-repl--buffer geiser-repl--prompt-regex))
+  (geiser-con--setup-connection (current-buffer)
+                                comint-prompt-regexp))
 
 
 ;;; REPL history and clean-up:
 
 (defun geiser-repl--on-quit ()
   (comint-write-input-ring)
-  (let ((cb (current-buffer)))
+  (let ((cb (current-buffer))
+        (impl geiser-impl--implementation))
     (setq geiser-repl--repls (remove cb geiser-repl--repls))
     (dolist (buffer (buffer-list))
       (with-current-buffer buffer
-        (when (equal cb (geiser-repl--this-buffer-repl))
-          (geiser-repl--set-this-buffer-repl nil)
-          (geiser-repl--get-repl))))))
+        (when (and (eq geiser-impl--implementation impl)
+                   (equal cb (geiser-repl--this-buffer-repl)))
+          (geiser-repl--get-repl geiser-impl--implementation))))))
 
 (defun geiser-repl--sentinel (proc event)
   (when (string= event "finished\n")
     (with-current-buffer (process-buffer proc)
-      (let ((comint-input-ring-file-name geiser-repl-history-filename))
+      (let ((comint-prompt-read-only nil)
+            (comint-input-ring-file-name geiser-repl-history-filename))
         (geiser-repl--on-quit)
         (when (buffer-name (current-buffer))
           (insert "\nIt's been nice interacting with you!\n")