diff options
| -rwxr-xr-x | bin/geiser-racket.sh | 6 | ||||
| -rw-r--r-- | elisp/geiser-inf.el | 24 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 50 | ||||
| -rw-r--r-- | scheme/racket/geiser.rkt | 4 | ||||
| -rw-r--r-- | scheme/racket/geiser/server.rkt | 12 | ||||
| -rw-r--r-- | scheme/racket/geiser/user.rkt | 59 |
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)) |