Racket reconnected

6 files changed, 102 insertions, 53 deletions

diff --git a/bin/geiser-racket.sh b/bin/geiser-racket.sh
index 4f16383..cbe3b9e 100755
--- a/bin/geiser-racket.sh
+++ b/bin/geiser-racket.sh
@@ -8,12 +8,12 @@ exec racket -i -S "$top/racket" -l errortrace -cu "$0" ${1+"$@"}
 
 (require (lib "cmdline.rkt"))
 
-(define port (make-parameter 1969))
+(define port (make-parameter 0))
 
 (command-line
  "run-racket.sh" (current-command-line-arguments)
  (once-each
   (("-p" "--port") p "Geiser server port" (port (string->number p)))))
 
-(and ((dynamic-require 'geiser/server 'start-geiser) (port))
-     (printf "Geiser server running at port ~a~%" (port)))
+(printf "Geiser server running at port ~a~%"
+        ((dynamic-require 'geiser/server 'start-geiser)))
diff --git a/elisp/geiser-inf.el b/elisp/geiser-inf.el
index efe7e34..833850a 100644
--- a/elisp/geiser-inf.el
+++ b/elisp/geiser-inf.el
@@ -26,9 +26,10 @@ for this implementation.")
   "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-regexp prompt-regexp ()
+(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 scheme prompt.")
+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-cmd ()
   "A variable (or thunk returning a value) giving the REPL server
@@ -55,29 +56,34 @@ list of the form (server PORT).")
     (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-regexp impl)))
-    (unless (and bin args prompt-rx)
+        (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)
-      (setq comint-prompt-regexp prompt-rx)
+      (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 "Unable to start REPL: %s" (error-message-string err))))
+        (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)
-                                          "(server-port \\([0-9]\\)+)"
+                                          "(port \\([0-9]+\\))"
                                           1)))))
 
-
-
 
 (provide 'geiser-inf)
 
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index dceec78..9136db5 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -109,6 +109,10 @@ expression, if any."
 
 ;;; Implementation-dependent parameters
 
+(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.")
+
 (geiser-impl--define-caller
     geiser-repl--debugger-prompt-regexp debugger-prompt-regexp ()
   "A variable (or thunk returning a value) giving the regular
@@ -235,8 +239,9 @@ module command as a string")
 (defun geiser-repl--start-repl (impl host port remote)
   (message "Starting Geiser REPL for %s ..." impl)
   (geiser-repl--to-repl-buffer impl)
+  (goto-char (point-max))
   (let ((address (geiser-repl--get-address host port))
-        (prompt-rx (geiser-inf--prompt-regexp impl))
+        (prompt-rx (geiser-repl--prompt-regexp impl))
         (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl))
         (cname (geiser-repl--repl-name impl)))
     (unless prompt-rx
@@ -260,7 +265,7 @@ module command as a string")
     (add-to-list 'geiser-repl--repls (current-buffer))
     (geiser-repl--set-this-buffer-repl (current-buffer))
     (geiser-repl--startup impl)
-    (message "Geiser REPL up and running!")))
+    (message "%s up and running!" (geiser-repl--repl-name impl))))
 
 (defun geiser-repl--connection ()
   (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation)))
@@ -288,8 +293,8 @@ module command as a string")
 (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))
-      (kill-buffer))))
+      (let ((geiser-repl-query-on-exit-p nil))
+        (geiser-repl-exit)))))
 
 (defun geiser-repl--on-quit ()
   (comint-write-input-ring)
@@ -314,10 +319,10 @@ module command as a string")
               (comint-input-ring-file-name (geiser-repl--history-file)))
           (geiser-repl--on-quit)
           (push pb geiser-repl--closed-repls)
-          (when (buffer-name (current-buffer))
-            (comint-kill-region comint-last-input-start (point))
-            (insert "\nIt's been nice interacting with you!\n")
-            (insert "Press C-c C-z to bring me back.\n" )))))))
+          (goto-char (point-max))
+          (comint-kill-region comint-last-input-start (point))
+          (insert "\nIt's been nice interacting with you!\n")
+          (insert "Press C-c C-z to bring me back.\n" ))))))
 
 (defun geiser-repl--on-kill ()
   (geiser-repl--on-quit)
@@ -499,9 +504,16 @@ buffer."
   "Start a new Geiser REPL."
   (interactive
    (list (geiser-repl--get-impl "Start Geiser for scheme implementation: ")))
-  (let ((b/p (geiser-inf--run-scheme impl)))
-    (setq geiser-repl--inferior-buffer (car b/p))
-    (geiser-repl--start-repl impl "localhost" (cdr b/p) nil)))
+  (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))))
 
 (defalias 'geiser 'run-geiser)
 
@@ -585,17 +597,25 @@ With a prefix argument, force exit by killing the scheme process."
     (dolist (repl geiser-repl--repls lst)
       (when (buffer-live-p repl)
         (with-current-buffer repl
-          (push geiser-impl--implementation lst))))))
+          (push (cons geiser-impl--implementation
+                      (when geiser-repl--remote-p
+                        (list geiser-repl--host geiser-repl--port)))
+                lst))))))
 
 (defun geiser-repl--restore (impls)
   (dolist (impl impls)
-    (when impl (run-geiser impl))))
+    (when impl
+      (if (cdr impl)
+          (geiser-connect (car impl) (cadr impl) (caddr impl))
+        (run-geiser (car impl))))))
 
 (defun geiser-repl-unload-function ()
   (dolist (repl geiser-repl--repls)
     (when (buffer-live-p repl)
-      (kill-buffer repl))))
+      (with-current-buffer repl
+        (let ((geiser-repl-query-on-exit-p nil)) (geiser-repl-exit))
+        (sit-for 0.05)
+        (kill-buffer)))))
 
 
 (provide 'geiser-repl)
-;;; geiser-repl.el ends here
diff --git a/scheme/racket/geiser.rkt b/scheme/racket/geiser.rkt
index 44a2ed8..3d75157 100644
--- a/scheme/racket/geiser.rkt
+++ b/scheme/racket/geiser.rkt
@@ -18,8 +18,6 @@
          (version)))
 
 (require errortrace)
-
 (require geiser/user)
-(init-geiser-repl)
 
-;;; geiser.rkt ends here
+(init-geiser-repl)
diff --git a/scheme/racket/geiser/server.rkt b/scheme/racket/geiser/server.rkt
index cf86b2c..10b15a1 100644
--- a/scheme/racket/geiser/server.rkt
+++ b/scheme/racket/geiser/server.rkt
@@ -11,14 +11,6 @@
 
 #lang racket/base
 
-(require geiser/user mzlib/thread)
-(provide run-geiser-server start-geiser)
+(require geiser/user)
+(provide start-geiser)
 
-(define (run-geiser-server port enforce-module-constants)
-  (run-server port
-              (lambda (in out)
-                (run-geiser-repl in out enforce-module-constants))
-              #f))
-
-(define (start-geiser (port 1969) (enforce-module-constants #f))
-  (thread (lambda () (run-geiser-server port enforce-module-constants))))
diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt
index 412cfe7..9d5b169 100644
--- a/scheme/racket/geiser/user.rkt
+++ b/scheme/racket/geiser/user.rkt
@@ -11,10 +11,15 @@
 
 #lang racket/base
 
-(provide init-geiser-repl run-geiser-repl enter!)
+(provide init-geiser-repl run-geiser-server start-geiser)
 
 (require (for-syntax racket/base)
-	 geiser/main geiser/enter geiser/eval geiser/modules)
+         mzlib/thread
+         racket/tcp
+         geiser/main
+         geiser/enter
+         geiser/eval
+         geiser/modules)
 
 (define top-namespace (current-namespace))
 
@@ -42,29 +47,38 @@
                          (cond [(equal? form '(unquote apply))
                                 (let* ([proc (eval (read) geiser-main)]
                                        [args (read)])
-                                  ((geiser:eval lang) `(,proc ,@args) mod))]
-                               [else ((geiser:eval lang) form mod)])))))
+                                  (eval-in `(,proc ,@args) mod lang))]
+                               [else (eval-in form mod lang)])))))
 
-(define (geiser-read)
-  (printf "racket@~a> " (namespace->module-name (current-namespace)))
+(define ((geiser-read prompt))
+  (prompt)
   (flush-output)
   (let* ([in (current-input-port)]
 	 [form ((current-read-interaction) (object-name in) in)])
     (syntax-case form ()
       [(uq cmd) (eq? 'unquote (syntax-e #'uq))
        (case (syntax-e #'cmd)
-         ((enter) (enter! (read) #'cmd))
-         ((geiser-eval) (geiser-eval))
-         ((geiser-no-values) (datum->syntax #f (void)))
-         (else form))]
+         [(start-geiser) (datum->syntax #f `(list 'port ,(start-geiser)))]
+         [(enter) (enter! (read) #'cmd)]
+         [(geiser-eval) (geiser-eval)]
+         [(geiser-no-values) (datum->syntax #f (void))]
+         [else form])]
       [_ form])))
 
-(define geiser-prompt-read (make-repl-reader geiser-read))
+(define geiser-prompt
+  (lambda () (printf "> ")))
+
+(define geiser-server-prompt
+  (lambda ()
+    (printf "racket@~a> " (namespace->module-name (current-namespace)))))
+
+(define (geiser-prompt-read prompt)
+  (make-repl-reader (geiser-read prompt)))
 
 (define (init-geiser-repl)
   (compile-enforce-module-constants #f)
   (current-load/use-compiled geiser-loader)
-  (current-prompt-read geiser-prompt-read))
+  (current-prompt-read (geiser-prompt-read geiser-prompt)))
 
 (define (run-geiser-repl in out enforce-module-constants)
   (parameterize [(compile-enforce-module-constants enforce-module-constants)
@@ -72,5 +86,24 @@
                  (current-output-port out)
                  (current-error-port out)
                  (current-load/use-compiled geiser-loader)
-                 (current-prompt-read geiser-prompt-read)]
+                 (current-prompt-read (geiser-prompt-read
+                                       geiser-server-prompt))]
     (read-eval-print-loop)))
+
+(define server-channel (make-channel))
+
+(define (run-geiser-server port enforce-module-constants)
+  (run-server port
+              (lambda (in out)
+                (run-geiser-repl in out enforce-module-constants))
+              #f
+              void
+              (lambda (p _ __)
+                (let ([lsner (tcp-listen p)])
+                  (let-values ([(_ p __ ___) (tcp-addresses lsner #t)])
+                    (channel-put server-channel p)
+                    lsner)))))
+
+(define (start-geiser (port 0) (enforce-module-constants #f))
+  (thread (lambda () (run-geiser-server port enforce-module-constants)))
+  (channel-get server-channel))