Superior schemes

Inferior schemes weren't really a good idea, were they? With remote
connections one can launch an external scheme to debug Geiser anyway.
And everything is (ahem, will be) simpler when we add new
implementations.

5 files changed, 76 insertions, 164 deletions

diff --git a/elisp/Makefile.am b/elisp/Makefile.am
index d98751b..1f1ca76 100644
--- a/elisp/Makefile.am
+++ b/elisp/Makefile.am
@@ -15,7 +15,6 @@ dist_lisp_LISP = \
    geiser-eval.el \
    geiser-guile.el \
    geiser-impl.el \
-   geiser-inf.el \
    geiser-log.el \
    geiser-menu.el \
    geiser-mode.el \
diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index 687bf34..a53395d 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -262,18 +262,9 @@ it spawn a server thread."
                           `((,geiser-guile--path-rx 1
                                                     compilation-error-face)))
   (when remote
-    (geiser-repl--send-silent (geiser-guile--load-path-string))
-    (geiser-repl--send-silent ",use (geiser emacs)"))
-  (geiser-guile-update-warning-level)
-  )
-
-(defun geiser-guile--init-server-command ()
-  (comint-kill-region (point-min) (point-max))
-  (setq comint-prompt-regexp "inferior-guile> ")
-  (comint-send-string nil ",option prompt \"inferior-guile> \"\n")
-  (comint-send-string nil ",use (geiser emacs)\n")
-  (geiser-inf--wait-for-prompt 10000)
-  ",geiser-start-server")
+    (geiser-repl--send-silent (geiser-guile--load-path-string)))
+  (geiser-repl--send-silent ",use (geiser emacs)")
+  (geiser-guile-update-warning-level))
 
 
 ;;; Implementation definition:
@@ -283,8 +274,6 @@ it spawn a server thread."
   (arglist geiser-guile--parameters)
   (repl-startup geiser-guile--startup)
   (prompt-regexp geiser-guile--prompt-regexp)
-  (inferior-prompt-regexp geiser-guile--prompt-regexp)
-  (init-server-command geiser-guile--init-server-command)
   (debugger-prompt-regexp geiser-guile--debugger-prompt-regexp)
   (enter-debugger geiser-guile--enter-debugger)
   (marshall-procedure geiser-guile--geiser-procedure)
diff --git a/elisp/geiser-inf.el b/elisp/geiser-inf.el
deleted file mode 100644
index 329beea..0000000
--- a/elisp/geiser-inf.el
+++ /dev/null
@@ -1,89 +0,0 @@
-;;; geiser-inf.el -- inferior scheme processes
-
-;; Copyright (c) 2010 Jose Antonio Ortega Ruiz
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the Modified BSD License. You should
-;; have received a copy of the license along with this program. If
-;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-
-;; Start date: Thu Nov 11, 2010 01:04
-
-
-(require 'geiser-impl)
-(require 'geiser-base)
-
-(require 'cmuscheme)
-
-
-;; Implementation-dependent parameters
-
-(geiser-impl--define-caller geiser-inf--binary binary ()
-  "A variable or function returning the path to the scheme binary
-for this implementation.")
-
-(geiser-impl--define-caller geiser-inf--arglist arglist ()
-  "A function taking no arguments and returning a list of
-arguments to be used when invoking the scheme binary.")
-
-(geiser-impl--define-caller geiser-inf--prompt-re inferior-prompt-regexp ()
-  "A variable (or thunk returning a value) giving the regular
-expression for this implementation's inferior scheme prompt. By default,
-cmuscheme's prompt regexp will be used.")
-
-(geiser-impl--define-caller geiser-inf--init-server-cmd init-server-command ()
-  "A variable (or thunk returning a value) giving the REPL server
-initialization command for local processes. The command must return a
-list of the form (server PORT).")
-
-
-;; Auxiliary functions
-
-(defun geiser-inf--wait-for-prompt (timeout)
-  (let ((p (point)) (seen) (buffer (current-buffer)))
-    (while (and (not seen)
-                (> timeout 0)
-                (get-buffer-process buffer))
-      (sleep-for 0.1)
-      (setq timeout (- timeout 100))
-      (goto-char p)
-      (setq seen (re-search-forward comint-prompt-regexp nil t)))
-    (goto-char (point-max))
-    (unless seen (error "%s" "No prompt found!"))))
-
-(defun geiser-inf--make-buffer (impl)
-  (with-current-buffer (generate-new-buffer (format " * inferior %s *" impl))
-    (inferior-scheme-mode)
-    (current-buffer)))
-
-(defun geiser-inf--sentinel (proc evnt)
-  (let ((buff (process-buffer proc)))
-    (when (buffer-live-p buff) (kill-buffer buff))))
-
-
-;; Starting an inferior REPL
-
-(defun geiser-inf--run-scheme (impl)
-  (let ((bin (geiser-inf--binary impl))
-        (args (geiser-inf--arglist impl))
-        (prompt-rx (geiser-inf--prompt-re impl)))
-    (unless (and bin args)
-      (error "Sorry, I don't know how to start %s" impl))
-    (with-current-buffer (geiser-inf--make-buffer impl)
-      (when prompt-rx comint-prompt-regexp prompt-rx)
-      (condition-case err
-          (apply 'make-comint-in-buffer
-             `(,(buffer-name) ,(current-buffer) ,bin nil ,@args))
-        (error (error "Error starting inferior %s REPL: %s"
-                      impl (error-message-string err))))
-      (geiser-inf--wait-for-prompt 10000)
-      (set-process-sentinel (get-buffer-process (current-buffer))
-                            'geiser-inf--sentinel)
-      (cons (current-buffer)
-            (comint-redirect-results-list (geiser-inf--init-server-cmd impl)
-                                          "(port \\([0-9]+\\))"
-                                          1)))))
-
-
-(provide 'geiser-inf)
-
diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el
index 3ab181b..b348732 100644
--- a/elisp/geiser-racket.el
+++ b/elisp/geiser-racket.el
@@ -84,8 +84,6 @@ This function uses `geiser-racket-init-file' if it exists."
 
 (defconst geiser-racket--prompt-regexp "\\(mzscheme\\|racket\\)@[^ ]*?> ")
 
-(defconst geiser-racket--init-server-command ",start-geiser")
-
 
 ;;; Evaluation support:
 
@@ -243,7 +241,6 @@ using start-geiser, a procedure in the geiser/server module."
   (unsupported-procedures '(callers callees generic-methods))
   (binary geiser-racket--binary)
   (arglist geiser-racket--parameters)
-  (init-server-command geiser-racket--init-server-command)
   (prompt-regexp geiser-racket--prompt-regexp)
   (marshall-procedure geiser-racket--geiser-procedure)
   (find-module geiser-racket--get-module)
@@ -268,4 +265,3 @@ using start-geiser, a procedure in the geiser/server module."
 
 
 (provide 'geiser-racket)
-;;; geiser-racket.el ends here
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index e6f01d4..fd1da7f 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -13,7 +13,6 @@
 (require 'geiser-autodoc)
 (require 'geiser-edit)
 (require 'geiser-completion)
-(require 'geiser-inf)
 (require 'geiser-impl)
 (require 'geiser-eval)
 (require 'geiser-connection)
@@ -109,6 +108,14 @@ expression, if any."
 
 ;;; Implementation-dependent parameters
 
+(geiser-impl--define-caller geiser-repl--binary binary ()
+  "A variable or function returning the path to the scheme binary
+for this implementation.")
+
+(geiser-impl--define-caller geiser-repl--arglist arglist ()
+  "A function taking no arguments and returning a list of
+arguments to be used when invoking the scheme binary.")
+
 (geiser-impl--define-caller geiser-repl--prompt-regexp prompt-regexp ()
   "A variable (or thunk returning a value) giving the regular
 expression for this implementation's geiser scheme prompt.")
@@ -211,16 +218,12 @@ module command as a string")
 (make-variable-buffer-local
  (defvar geiser-repl--connection nil))
 
-(make-variable-buffer-local
- (defvar geiser-repl--remote-p nil))
-
-(make-variable-buffer-local
- (defvar geiser-repl--inferior-buffer nil))
+(defun geiser-repl--remote-p () geiser-repl--address)
 
 (defsubst geiser-repl--host () (car geiser-repl--address))
 (defsubst geiser-repl--port () (cdr geiser-repl--address))
 
-(defun geiser-repl--get-address (&optional host port)
+(defun geiser-repl--read-address (&optional host port)
   (let ((defhost (or (geiser-repl--host) geiser-repl-default-host))
         (defport (or (geiser-repl--port) geiser-repl-default-port)))
     (cons (or host
@@ -232,35 +235,26 @@ module command as a string")
   (when (or geiser-repl-autodoc-p (< n 0))
     (geiser--save-msg (geiser-autodoc-mode n))))
 
-(defun geiser-repl--save-remote-data (address remote)
+(defun geiser-repl--save-remote-data (address)
   (setq geiser-repl--address address)
-  (setq geiser-repl--remote-p remote)
-  (setq header-line-format (and remote
+  (setq header-line-format (and address
                                 (format "Host: %s   Port: %s"
                                         (geiser-repl--host)
                                         (geiser-repl--port)))))
 
-(defun geiser-repl--start-repl (impl host port remote)
+(defun geiser-repl--start-repl (impl address)
   (message "Starting Geiser REPL for %s ..." impl)
   (geiser-repl--to-repl-buffer impl)
+  (sit-for 0)
   (goto-char (point-max))
   (geiser-repl--autodoc-mode -1)
-  (let ((address (geiser-repl--get-address host port))
-        (prompt-rx (geiser-repl--prompt-regexp impl))
-        (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl))
-        (cname (geiser-repl--repl-name impl)))
+  (let* ((prompt-rx (geiser-repl--prompt-regexp impl))
+         (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl))
+         (prompt (geiser-con--combined-prompt prompt-rx deb-prompt-rx)))
     (unless prompt-rx
       (error "Sorry, I don't know how to start a REPL for %s" impl))
-    (geiser-repl--save-remote-data address remote)
-    (condition-case err
-        (progn
-          (set (make-local-variable 'comint-prompt-regexp)
-               (geiser-con--combined-prompt prompt-rx deb-prompt-rx))
-          (apply 'make-comint-in-buffer `(,cname ,(current-buffer) ,address)))
-      (error (insert "Unable to start REPL:\n\n"
-                     (error-message-string err) "\n")
-             (error "Couldn't start Geiser")))
-    (geiser-inf--wait-for-prompt 10000)
+    (geiser-repl--save-remote-data address)
+    (geiser-repl--start-scheme impl address prompt)
     (geiser-repl--history-setup)
     (add-to-list 'geiser-repl--repls (current-buffer))
     (geiser-repl--set-this-buffer-repl (current-buffer))
@@ -268,10 +262,49 @@ module command as a string")
           (geiser-con--make-connection (get-buffer-process (current-buffer))
                                        prompt-rx
                                        deb-prompt-rx))
-    (geiser-repl--startup impl remote)
+    (geiser-repl--startup impl address)
     (geiser-repl--autodoc-mode 1)
     (message "%s up and running!" (geiser-repl--repl-name impl))))
 
+(defun geiser-repl--start-scheme (impl address prompt)
+  (setq comint-prompt-regexp prompt)
+  (let* ((name (geiser-repl--repl-name impl))
+         (buff (current-buffer))
+         (args (if address (list address)
+                 `(,(geiser-repl--binary impl)
+                   nil
+                   ,@(geiser-repl--arglist impl)))))
+    (condition-case err
+        (apply 'make-comint-in-buffer `(,name ,buff ,@args))
+      (error (insert "Unable to start REPL:\n"
+                     (error-message-string err)
+                     "\n")
+             (error "Couldn't start Geiser")))
+    (geiser-repl--wait-for-prompt 10000)))
+
+(defun geiser-repl--wait-for-prompt (timeout)
+  (let ((p (point)) (seen) (buffer (current-buffer)))
+    (while (and (not seen)
+                (> timeout 0)
+                (get-buffer-process buffer))
+      (sleep-for 0.1)
+      (setq timeout (- timeout 100))
+      (goto-char p)
+      (setq seen (re-search-forward comint-prompt-regexp nil t)))
+    (goto-char (point-max))
+
+    (unless seen (error "%s" "No prompt found!"))))
+
+(defun geiser-repl--is-debugging ()
+  (let ((dp (geiser-con--connection-debug-prompt geiser-repl--connection)))
+    (and dp
+         comint-last-prompt-overlay
+         (save-excursion
+           (goto-char (overlay-start comint-last-prompt-overlay))
+           (re-search-forward dp
+                              (overlay-end comint-last-prompt-overlay)
+                              t)))))
+
 (defun geiser-repl--connection ()
   (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation)))
     (or (and (buffer-live-p buffer)
@@ -303,19 +336,13 @@ module command as a string")
 (defsubst geiser-repl--history-file ()
   (format "%s.%s" geiser-repl-history-filename geiser-impl--implementation))
 
-(defun geiser-repl--quit-inf ()
-  (when (buffer-live-p geiser-repl--inferior-buffer)
-    (with-current-buffer geiser-repl--inferior-buffer
-      (let ((geiser-repl-query-on-exit-p nil))
-        (geiser-repl-exit)))))
-
 (defun geiser-repl--on-quit ()
   (comint-write-input-ring)
   (let ((cb (current-buffer))
         (impl geiser-impl--implementation)
         (comint-prompt-read-only nil))
-    (ignore-errors (geiser-con--connection-close geiser-repl--connection))
-    (geiser-repl--quit-inf)
+    (geiser-con--connection-deactivate geiser-repl--connection)
+    (geiser-con--connection-close geiser-repl--connection)
     (setq geiser-repl--repls (remove cb geiser-repl--repls))
     (dolist (buffer (buffer-list))
       (when (buffer-live-p buffer)
@@ -343,7 +370,7 @@ module command as a string")
         (remove (current-buffer) geiser-repl--closed-repls)))
 
 (defun geiser-repl--input-filter (str)
-  (not (or ;; (geiser-con--is-debugging)
+  (not (or (geiser-repl--is-debugging)
            (string-match "^\\s *$" str)
            (string-match "^,quit *$" str))))
 
@@ -413,10 +440,9 @@ module command as a string")
          (pmark (and proc (process-mark proc)))
          (intxt (and pmark (buffer-substring pmark (point)))))
     (when intxt
-      (when (and geiser-repl-forget-old-errors-p
-;;;                 (not (geiser-con--is-debugging)))
-                 )
-        (compilation-forget-errors))
+      (and geiser-repl-forget-old-errors-p
+           (not (geiser-repl--is-debugging))
+           (compilation-forget-errors))
       (geiser-repl--prepare-send)
       (comint-send-input)
       (when (string-match "^\\s-*$" intxt)
@@ -516,16 +542,7 @@ buffer."
   "Start a new Geiser REPL."
   (interactive
    (list (geiser-repl--get-impl "Start Geiser for scheme implementation: ")))
-  (message "Starting Scheme process...")
-  (let* ((b/p (geiser-inf--run-scheme impl))
-         (inf-buff (car b/p))
-         (port (cadr b/p)))
-    (unless port
-      (when (bufferp inf-buff) (pop-to-buffer inf-buff))
-      (error "%s" "Couldn't connect to inferior scheme process"))
-    (geiser-repl--start-repl impl "localhost" port nil)
-    (setq geiser-repl--inferior-buffer inf-buff)
-    (with-current-buffer inf-buff (setq geiser-impl--implementation impl))))
+  (geiser-repl--start-repl impl nil))
 
 (defalias 'geiser 'run-geiser)
 
@@ -533,7 +550,8 @@ buffer."
   "Start a new Geiser REPL connected to a remote Scheme process."
   (interactive
    (list (geiser-repl--get-impl "Connect to Scheme implementation: ")))
-  (geiser-repl--start-repl impl host port t))
+  (geiser-repl--start-repl impl
+                           (geiser-repl--read-address host port)))
 
 (make-variable-buffer-local
  (defvar geiser-repl--last-scm-buffer nil))
@@ -560,7 +578,7 @@ If no REPL is running, execute `run-geiser' to start a fresh one."
            (when (buffer-live-p geiser-repl--last-scm-buffer)
              (pop-to-buffer geiser-repl--last-scm-buffer)))
           (repl (pop-to-buffer repl))
-          (geiser-repl--remote-p (geiser-connect impl))
+          ((geiser-repl--remote-p) (geiser-connect impl))
           (t (run-geiser impl)))
     (when (and buffer (eq major-mode 'geiser-repl-mode))
       (setq geiser-repl--last-scm-buffer buffer))))
@@ -610,16 +628,15 @@ With a prefix argument, force exit by killing the scheme process."
       (when (buffer-live-p repl)
         (with-current-buffer repl
           (push (cons geiser-impl--implementation
-                      (when geiser-repl--remote-p
-                        (list (geiser-repl--host) (geiser-repl--port))))
+                      geiser-repl--address)
                 lst))))))
 
 (defun geiser-repl--restore (impls)
   (dolist (impl impls)
     (when impl
-      (if (cdr impl)
-          (geiser-connect (car impl) (cadr impl) (caddr impl))
-        (run-geiser (car impl))))))
+      (condition-case err
+          (geiser-repl--start-repl (car impl) (cdr impl))
+        (error (message (error-message-string err)))))))
 
 (defun geiser-repl-unload-function ()
   (dolist (repl geiser-repl--repls)