diff options
| -rwxr-xr-x | bin/geiser-racket.sh | 6 | ||||
| -rw-r--r-- | doc/cheat.texi | 3 | ||||
| -rw-r--r-- | doc/repl.texi | 13 | ||||
| -rw-r--r-- | elisp/Makefile.am | 1 | ||||
| -rw-r--r-- | elisp/geiser-connection.el | 274 | ||||
| -rw-r--r-- | elisp/geiser-eval.el | 10 | ||||
| -rw-r--r-- | elisp/geiser-guile.el | 1 | ||||
| -rw-r--r-- | elisp/geiser-inf.el | 89 | ||||
| -rw-r--r-- | elisp/geiser-log.el | 1 | ||||
| -rw-r--r-- | elisp/geiser-racket.el | 4 | ||||
| -rw-r--r-- | elisp/geiser-reload.el | 1 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 379 | ||||
| -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 | 67 |
15 files changed, 443 insertions, 422 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/doc/cheat.texi b/doc/cheat.texi index 4e81b92..68e4274 100644 --- a/doc/cheat.texi +++ b/doc/cheat.texi @@ -107,9 +107,6 @@ @item C-c C-q @tab geiser-repl-exit @tab Kill Scheme process -@item C-c C-k -@tab geiser-repl-nuke -@tab Soft restart for unresponsive REPL @item M-. @tab geiser-edit-symbol-at-point @tab Edit identifier at point diff --git a/doc/repl.texi b/doc/repl.texi index 03fb42a..aefa432 100644 --- a/doc/repl.texi +++ b/doc/repl.texi @@ -118,15 +118,10 @@ There are also a few commands to twiddle with the Scheme process. mercilessly kill the process (but not before stowing your history in the file system). Unless you're using a remote REPL, that is, in which case both commands will just sever the connection and leave the remote -process alone. A softer nuke is performed by @kbd{C-c C-k}: some (rare, -i promise) times, Geiser's REPL can get confused by the input -received from then underlying Scheme (specially if you have multiple -threads writing to the standard ports), and become irresponsive; you can -try this command to try to revive it without killing the process or -closing your connection. Finally, if worse comes to worst and the -process is dead, @kbd{C-c C-z} will restart it (but the same shortcut, -issued when the REPL is alive, will bring you back to the buffer you -came from, as explained @ref{switching-repl-buff,,here}). +process alone. If worse comes to worst and the process is dead, @kbd{C-c +C-z} will restart it (but the same shortcut, issued when the REPL is +alive, will bring you back to the buffer you came from, as explained +@ref{switching-repl-buff,,here}). The remaining commands are meatier, and deserve sections of their own. diff --git a/elisp/Makefile.am b/elisp/Makefile.am index 1f1ca76..d98751b 100644 --- a/elisp/Makefile.am +++ b/elisp/Makefile.am @@ -15,6 +15,7 @@ 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-connection.el b/elisp/geiser-connection.el index dc669aa..d1e7d59 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -19,8 +19,7 @@ (require 'geiser-base) (require 'geiser-impl) -(require 'comint) -(require 'advice) +(require 'tq) ;;; Buffer connections: @@ -71,234 +70,155 @@ ;;; Connection datatype: -(defsubst geiser-con--make-connection (buffer) +(defun geiser-con--make-connection (proc prompt debug-prompt) (list :geiser-connection - (cons :requests (list)) - (cons :current nil) + (cons :tq (tq-create proc)) + (cons :eot (format "\\(%s%s\\)" + prompt + (if debug-prompt + (format "\\|%s" debug-prompt) + ""))) + (cons :prompt prompt) + (cons :debug-prompt debug-prompt) (cons :count 0) - (cons :completed (make-hash-table :weakness 'value)) - (cons :buffer buffer) - (cons :reply (geiser-con--make-reply-buffer buffer)))) - -(defvar geiser-con--eot-regexp nil) -(geiser-impl--register-local-variable - 'geiser-con--eot-regexp 'eot-regexp nil - "A regular expression used to detect end of transmissions. -By default, Geiser uses the prompt regexp.") - -(defun geiser-con--make-reply-buffer (buffer) - (let ((name (concat " geiser-con-reply: " (buffer-name buffer))) - (eot (with-current-buffer buffer geiser-con--eot-regexp))) - (with-current-buffer (get-buffer-create name) - (setq geiser-con--eot-regexp eot) - (current-buffer)))) + (cons :completed (make-hash-table :weakness 'value)))) + +(defun geiser-con--connection-swap-proc (con proc) + (let* ((this-proc (geiser-con--connection-process con)) + (this-filter (process-filter this-proc)) + (this-buffer (process-buffer this-proc)) + (filter (process-filter proc)) + (buffer (process-buffer proc)) + (tq (geiser-con--connection-tq con))) + (set-process-filter this-proc filter) + (set-process-buffer this-proc buffer) + (set-process-filter proc this-filter) + (set-process-buffer proc this-buffer) + (setcdr tq (cons proc (tq-buffer tq))) + this-proc)) (defsubst geiser-con--connection-p (c) (and (listp c) (eq (car c) :geiser-connection))) -(defsubst geiser-con--connection-buffer (c) - (cdr (assoc :buffer c))) - (defsubst geiser-con--connection-process (c) - (get-buffer-process (geiser-con--connection-buffer c))) + (tq-process (cdr (assoc :tq c)))) + +(defsubst geiser-con--connection-tq (c) + (cdr (assoc :tq c))) -(defsubst geiser-con--connection-requests (c) - (cdr (assoc :requests c))) +(defsubst geiser-con--connection-eot (c) + (cdr (assoc :eot c))) -(defsubst geiser-con--connection-current-request (c) - (cdr (assoc :current c))) +(defsubst geiser-con--connection-prompt (c) + (cdr (assoc :prompt c))) -(defsubst geiser-con--connection-reply-buffer (c) - (cdr (assoc :reply c))) +(defsubst geiser-con--connection-debug-prompt (c) + (cdr (assoc :debug-prompt c))) (defsubst geiser-con--connection-completed (c r) (geiser-con--request-deactivate r) (puthash (geiser-con--request-id r) r (cdr (assoc :completed c)))) -(defun geiser-con--connection-clean-current-request (c) - (let* ((cell (assoc :current c)) - (req (cdr cell))) - (when req - (geiser-con--connection-completed c req) - (setcdr cell nil)))) - -(defun geiser-con--connection-add-request (c r) - (let ((reqs (assoc :requests c))) - (setcdr reqs (append (cdr reqs) (list r))))) - (defsubst geiser-con--connection-completed-p (c id) (gethash id (cdr (assoc :completed c)))) -(defun geiser-con--connection-pop-request (c) - (let* ((reqs (assoc :requests c)) - (current (assoc :current c)) - (old-current (cdr current)) - (new-current (cadr reqs)) - (new-reqs (cddr reqs))) - (when old-current (geiser-con--connection-completed c old-current)) - (setcdr reqs new-reqs) - (if (and new-current - (geiser-con--request-deactivated-p new-current)) - (geiser-con--connection-pop-request c) - (setcdr current new-current)))) - (defun geiser-con--connection-inc-count (c) (let* ((cnt (assoc :count c)) (new (1+ (cdr cnt)))) (setcdr cnt new) new)) - -;;; Connection setup: -(make-variable-buffer-local - (defvar geiser-con--debugging-prompt-regexp nil)) - -(make-variable-buffer-local - (defvar geiser-con--debugging-inhibits-eval t)) - -(make-variable-buffer-local - (defvar geiser-con--debugging-preamble-regexp nil)) - -(defun geiser-con--is-debugging (&optional con) - (with-current-buffer (or (and con (geiser-con--connection-buffer con)) - (current-buffer)) - (and geiser-con--debugging-prompt-regexp - geiser-con--debugging-inhibits-eval - comint-last-prompt-overlay - (string-match-p geiser-con--debugging-prompt-regexp - (buffer-substring (overlay-start - comint-last-prompt-overlay) - (overlay-end - comint-last-prompt-overlay)))))) - -(defsubst geiser-con--has-entered-debugger (con) - (with-current-buffer (geiser-con--connection-buffer con) - (and geiser-con--debugging-prompt-regexp - (re-search-backward geiser-con--debugging-prompt-regexp nil t) - (or (null geiser-con--debugging-preamble-regexp) - (save-excursion - (re-search-backward geiser-con--debugging-preamble-regexp - nil t)))))) - -(defun geiser-con--connection-teardown () - (when geiser-con--connection - (kill-buffer - (geiser-con--connection-reply-buffer geiser-con--connection)))) - -(defun geiser-con--setup-connection (buffer - prompt-regexp - &optional debug-prompt-regexp - debug-preamble-regexp) - (with-current-buffer buffer - (geiser-con--connection-teardown) - (setq geiser-con--debugging-prompt-regexp debug-prompt-regexp) - (setq geiser-con--debugging-preamble-regexp debug-preamble-regexp) - (setq geiser-con--connection (geiser-con--make-connection buffer)) - (set (make-local-variable 'comint-redirect-insert-matching-regexp) t) - (setq comint-prompt-regexp - (if debug-prompt-regexp - (format "\\(%s\\)\\|\\(%s\\)" prompt-regexp debug-prompt-regexp) - prompt-regexp)) - (add-hook 'comint-redirect-hook 'geiser-con--comint-redirect-hook nil t))) +(defun geiser-con--has-entered-debugger (con answer) + (let ((dp (geiser-con--connection-debug-prompt con))) + (and (stringp dp) (string-match dp answer)))) + +(defun geiser-con--connection-close (con) + (let ((tq (geiser-con--connection-tq con))) + (and tq (tq-close tq)))) + +(defvar geiser-con--connection-sentinel nil) +(defun geiser-con--connection-sentinel (p s) + (setq geiser-con--connection-sentinel + (concat geiser-con--connection-sentinel s))) + +(defun geiser-con--open-connection (host port prompt debug-prompt) + (setq geiser-con--connection-sentinel "") + (let ((proc (make-network-process :name "geiser-con" + :host host + :service port + :filter 'geiser-con--connection-sentinel + :noquery t))) + (with-timeout (10 + (error (format "Timeout connecting to %s:%s" host port))) + (while (not (string-match prompt geiser-con--connection-sentinel)) + (accept-process-output proc 1))) + (geiser-con--make-connection proc prompt debug-prompt))) ;;; Requests handling: -(defun geiser-con--comint-buffer-form (con) - (with-current-buffer (geiser-con--connection-reply-buffer con) - (goto-char (point-max)) - (if (geiser-con--has-entered-debugger con) +(defun geiser-con--req-form (req answer) + (let ((con (geiser-con--request-connection req))) + (if (geiser-con--has-entered-debugger con answer) `((error (key . geiser-debugger)) - (output . ,(buffer-substring (point-min) (point)))) - (condition-case nil - (progn - (goto-char (point-min)) - (re-search-forward "((\\(result\\|error\\)\\>") - (goto-char (match-beginning 0)) - (let ((form (read (current-buffer)))) - (if (listp form) form (error "")))) + (output . ,answer)) + (condition-case err + (car (read-from-string answer)) (error `((error (key . geiser-con-error)) - (output . ,(buffer-string)))))))) - -(defun geiser-con--process-next (con) - (when (not (geiser-con--connection-current-request con)) - (let* ((buffer (geiser-con--connection-buffer con)) - (req (geiser-con--connection-pop-request con)) - (str (and req (geiser-con--request-string req))) - (rbuffer (geiser-con--connection-reply-buffer con))) - (when (and buffer (buffer-live-p buffer) req str) - (with-current-buffer rbuffer - (delete-region (point-min) (point-max))) - (set-buffer buffer) - (if (geiser-con--is-debugging) - (geiser-con--connection-completed con req) - (geiser-log--info "<%s>: %s" (geiser-con--request-id req) str) - (comint-redirect-send-command (format "%s" str) rbuffer nil t)))))) - -(defun geiser-con--process-completed-request (req) - (let* ((cont (geiser-con--request-continuation req)) - (id (geiser-con--request-id req)) - (rstr (geiser-con--request-string req)) - (buffer (geiser-con--request-buffer req)) - (con (geiser-con--request-connection req)) - (form (geiser-con--comint-buffer-form con))) + (output . ,(format "%s\n(%s)" + answer + (error-message-string err))))))))) + +(defun geiser-con--process-completed-request (req answer) + (let ((cont (geiser-con--request-continuation req)) + (id (geiser-con--request-id req)) + (rstr (geiser-con--request-string req)) + (form (geiser-con--req-form req answer)) + (buffer (or (geiser-con--request-buffer req) (current-buffer))) + (con (geiser-con--request-connection req))) (if (not cont) (geiser-log--warn "<%s> Droping result for request %S: %s" id rstr form) (condition-case cerr - (with-current-buffer (or buffer (current-buffer)) + (with-current-buffer buffer (funcall cont form) - (geiser-con--request-deactivate req) (geiser-log--info "<%s>: processed" id)) (error (geiser-log--error "<%s>: continuation failed %S \n\t%s" id rstr cerr)))) - (geiser-con--connection-clean-current-request con))) - -(defun geiser-con--comint-redirect-hook () - (if (not geiser-con--connection) - (geiser-log--error "No connection in buffer") - (let ((req (geiser-con--connection-current-request - geiser-con--connection))) - (if (not req) - (geiser-log--error "No current request") - (geiser-con--process-completed-request req))))) - -(defadvice comint-redirect-setup - (after geiser-con--advice - (output-buffer comint-buffer finished-regexp &optional echo)) - (with-current-buffer comint-buffer - (when geiser-con--eot-regexp - (setq comint-redirect-finished-regexp geiser-con--eot-regexp)) - (when geiser-con--connection (setq mode-line-process nil)))) -(ad-activate 'comint-redirect-setup) + (geiser-con--connection-completed con req))) + +(defun geiser-con--connection-add-request (c r) + (tq-enqueue (geiser-con--connection-tq c) + (geiser-con--request-string r) + (geiser-con--connection-eot c) + r + 'geiser-con--process-completed-request + t)) ;;; Message sending interface: -(defconst geiser-con--error-message "Geiser connection not active") +(defun geiser-con--send-string (con str cont &optional sbuf) + (let ((req (geiser-con--make-request con str cont sbuf))) + (geiser-con--connection-add-request con req) + req)) (defvar geiser-connection-timeout 30000 "Time limit, in msecs, blocking on synchronous evaluation requests") -(defun geiser-con--send-string/wait (b/p str cont &optional timeout sbuf) +(defun geiser-con--send-string/wait (con str cont &optional timeout sbuf) (save-current-buffer - (let* ((con (geiser-con--get-connection b/p)) - (proc (and con (geiser-con--connection-process con)))) - (unless proc (error geiser-con--error-message)) - (when (geiser-con--is-debugging con) (error "REPL is in debug mode")) - (let* ((req (geiser-con--make-request con str cont sbuf)) + (let ((proc (and con (geiser-con--connection-process con)))) + (unless proc (error "Geiser connection not active")) + (let* ((req (geiser-con--send-string con str cont sbuf)) (id (geiser-con--request-id req)) - (timeout (/ (or timeout geiser-connection-timeout) 1000.0)) - (waitsecs 0.1)) - (geiser-con--connection-add-request con req) + (timeout (/ (or timeout geiser-connection-timeout) 1000.0))) (with-timeout (timeout (geiser-con--request-deactivate req)) (condition-case nil (while (and (geiser-con--connection-process con) (not (geiser-con--connection-completed-p con id))) - (geiser-con--process-next con) - (accept-process-output proc waitsecs nil t)) + (accept-process-output proc (/ timeout 10))) (error (geiser-con--request-deactivate req)))))))) (provide 'geiser-connection) -;;; geiser-connection.el ends here diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 3534312..72093cc 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -119,11 +119,11 @@ module-exports, autodoc, callers, callees and generic-methods.") ;;; Code sending: -(defvar geiser-eval--default-proc-function nil) +(defvar geiser-eval--default-connection-function nil) -(defsubst geiser-eval--proc () - (and geiser-eval--default-proc-function - (funcall geiser-eval--default-proc-function))) +(defsubst geiser-eval--connection () + (and geiser-eval--default-connection-function + (funcall geiser-eval--default-connection-function))) (defsubst geiser-eval--log (s) (geiser-log--info "RETORT: %S" s) @@ -138,7 +138,7 @@ module-exports, autodoc, callers, callees and generic-methods.") (defun geiser-eval--send/wait (code &optional timeout buffer) (setq geiser-eval--sync-retort nil) - (geiser-con--send-string/wait (geiser-eval--proc) + (geiser-con--send-string/wait (geiser-eval--connection) (geiser-eval--code-str code) 'geiser-eval--set-sync-retort timeout diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index f410674..3979688 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -252,7 +252,6 @@ it spawn a server thread." (set (make-local-variable 'compilation-error-regexp-alist) `((,geiser-guile--path-rx geiser-guile--resolve-file-x) ("^ +\\([0-9]+\\):\\([0-9]+\\)" nil 1 2))) - (setq geiser-con--debugging-inhibits-eval nil) (compilation-setup t) (font-lock-add-keywords nil `((,geiser-guile--path-rx 1 diff --git a/elisp/geiser-inf.el b/elisp/geiser-inf.el new file mode 100644 index 0000000..833850a --- /dev/null +++ b/elisp/geiser-inf.el @@ -0,0 +1,89 @@ +;;; 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-cmd () + "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-log.el b/elisp/geiser-log.el index d078b19..49b067d 100644 --- a/elisp/geiser-log.el +++ b/elisp/geiser-log.el @@ -44,7 +44,6 @@ "Simple mode for Geiser log messages buffer." (kill-all-local-variables) (buffer-disable-undo) - (set (make-local-variable 'comint-redirect-subvert-readonly) t) (add-hook 'after-change-functions '(lambda (b e len) (let ((inhibit-read-only t)) diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el index 8c66e67..4152a22 100644 --- a/elisp/geiser-racket.el +++ b/elisp/geiser-racket.el @@ -84,6 +84,8 @@ This function uses `geiser-racket-init-file' if it exists." (defconst geiser-racket--prompt-regexp "^=?\\(mzscheme\\|racket\\)@[^ ]*?> ") +(defconst geiser-racket--init-server-cmd ",start-geiser") + ;;; Evaluation support: @@ -241,8 +243,8 @@ 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-cmd geiser-racket--init-server-cmd) (startup) - (eot-regexp "\0") (prompt-regexp geiser-racket--prompt-regexp) (marshall-procedure geiser-racket--geiser-procedure) (find-module geiser-racket--get-module) diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el index a5c0125..ca3eb1c 100644 --- a/elisp/geiser-reload.el +++ b/elisp/geiser-reload.el @@ -38,6 +38,7 @@ geiser-connection geiser-syntax geiser-menu + geiser-inf geiser-impl geiser-custom geiser-log diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index a05346c..9136db5 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -13,6 +13,7 @@ (require 'geiser-autodoc) (require 'geiser-edit) (require 'geiser-completion) +(require 'geiser-inf) (require 'geiser-impl) (require 'geiser-eval) (require 'geiser-connection) @@ -106,6 +107,34 @@ expression, if any." :group 'geiser-repl) +;;; 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 +expression for this implementation's debugging prompt.") + +(geiser-impl--define-caller geiser-repl--startup startup () + "Function taking no parameters that is called after the REPL +has been initialised. All Geiser functionality is available to +you at that point.") + +(geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module) + "Function taking a module designator and returning a REPL enter +module command as a string") + +(geiser-impl--define-caller geiser-repl--import-cmd import-command (module) + "Function taking a module designator and returning a REPL import +module command as a string") + +(geiser-impl--define-caller geiser-repl--exit-cmd exit-command () + "Function returning the REPL exit command as a string") + + ;;; Geiser REPL buffers and processes: (defvar geiser-repl--repls nil) @@ -161,50 +190,35 @@ expression, if any." (geiser-repl-mode) (geiser-impl--set-buffer-implementation impl))))) -(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 scheme prompt.") +(defun geiser-repl--read-impl (prompt &optional active) + (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls)))) -(geiser-impl--define-caller - geiser-repl--debugger-prompt-regexp debugger-prompt-regexp () - "A variable (or thunk returning a value) giving the regular -expression for this implementation's debugging prompt.") +(defsubst geiser-repl--only-impl-p () + (and (null (cdr geiser-active-implementations)) + (car geiser-active-implementations))) -(geiser-impl--define-caller - geiser-repl--debugger-preamble-regexp debugger-preamble-regexp () - "A variable (or thunk returning a value) used to determine whether -the REPL has entered debugging mode.") +(defun geiser-repl--get-impl (prompt) + (or (geiser-repl--only-impl-p) + (and (eq major-mode 'geiser-repl-mode) geiser-impl--implementation) + (geiser-repl--read-impl prompt))) -(geiser-impl--define-caller geiser-repl--startup startup () - "Function taking no parameters that is called after the REPL -has been initialised. All Geiser functionality is available to -you at that point.") + +;;; REPL connections -(geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module) - "Function taking a module designator and returning a REPL enter -module command as a string") +(make-variable-buffer-local + (defvar geiser-repl--address nil)) -(geiser-impl--define-caller geiser-repl--import-cmd import-command (module) - "Function taking a module designator and returning a REPL import -module command as a string") +(make-variable-buffer-local + (defvar geiser-repl--connection nil)) -(geiser-impl--define-caller geiser-repl--exit-cmd exit-command () - "Function returning the REPL exit command as a string") +(make-variable-buffer-local + (defvar geiser-repl--remote-p nil)) (make-variable-buffer-local - (defvar geiser-repl--address nil)) + (defvar geiser-repl--inferior-buffer nil)) (defsubst geiser-repl--host () (car geiser-repl--address)) (defsubst geiser-repl--port () (cdr geiser-repl--address)) -(defsubst geiser-repl--remote-p () geiser-repl--address) (defun geiser-repl--get-address (&optional host port) (let ((defhost (or (geiser-repl--host) geiser-repl-default-host)) @@ -214,124 +228,53 @@ module command as a string") nil nil defhost)) (or port (read-number "Port: " defport))))) -(defun geiser-repl--save-remote-data (remote address) - (setq geiser-repl--address (and remote address)) +(defun geiser-repl--save-remote-data (address remote) + (setq geiser-repl--address address) + (setq geiser-repl--remote-p remote) (setq header-line-format (and remote (format "Host: %s Port: %s" (geiser-repl--host) (geiser-repl--port))))) -(defun geiser-repl--start-repl (impl &optional remote host port) +(defun geiser-repl--start-repl (impl host port remote) (message "Starting Geiser REPL for %s ..." impl) (geiser-repl--to-repl-buffer impl) - (let ((program (if remote (geiser-repl--get-address host port) - (geiser-repl--binary impl))) - (args (geiser-repl--arglist impl)) + (goto-char (point-max)) + (let ((address (geiser-repl--get-address host port)) (prompt-rx (geiser-repl--prompt-regexp impl)) (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl)) - (deb-preamble-rx (geiser-repl--debugger-preamble-regexp impl)) (cname (geiser-repl--repl-name impl))) - (unless (and program prompt-rx) + (unless prompt-rx (error "Sorry, I don't know how to start a REPL for %s" impl)) - (set (make-local-variable 'comint-prompt-regexp) prompt-rx) - (geiser-repl--save-remote-data remote program) + (geiser-repl--save-remote-data address remote) (condition-case err - (apply 'make-comint-in-buffer - `(,cname ,(current-buffer) ,program nil ,@args)) + (progn + (setq geiser-repl--connection + (geiser-con--open-connection (car address) + (cdr address) + prompt-rx + deb-prompt-rx)) + (set (make-local-variable 'comint-prompt-regexp) + (geiser-con--connection-eot geiser-repl--connection)) + (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-repl--wait-for-prompt 10000) + (geiser-inf--wait-for-prompt 10000) (geiser-repl--history-setup) - (geiser-con--setup-connection (current-buffer) - prompt-rx - deb-prompt-rx - deb-preamble-rx) (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--process () +(defun geiser-repl--connection () (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation))) - (or (and (buffer-live-p buffer) (get-buffer-process buffer)) + (or (and (buffer-live-p buffer) + (get-buffer-process buffer) + (with-current-buffer buffer geiser-repl--connection)) (error "No Geiser REPL for this buffer (try M-x run-geiser)")))) -(setq geiser-eval--default-proc-function 'geiser-repl--process) - -(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 "No prompt found!")))) - - -;;; Interface: starting and interacting with geiser REPL: - -(defun geiser-repl--read-impl (prompt &optional active) - (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls)))) - -(defsubst geiser-repl--only-impl-p () - (and (null (cdr geiser-active-implementations)) - (car geiser-active-implementations))) - -(defun run-geiser (impl) - "Start a new Geiser REPL." - (interactive - (list (or (geiser-repl--only-impl-p) - (and (eq major-mode 'geiser-repl-mode) - geiser-impl--implementation) - (geiser-repl--read-impl - "Start Geiser for scheme implementation: ")))) - (geiser-repl--start-repl impl)) - -(defun geiser-connect (impl &optional host port) - "Start a new Geiser REPL connected to a remote Scheme process." - (interactive - (list (or (geiser-repl--only-impl-p) - (and (eq major-mode 'geiser-repl-mode) - geiser-impl--implementation) - (geiser-repl--read-impl - "Scheme implementation: ")))) - (geiser-repl--start-repl impl t host port)) - -(make-variable-buffer-local - (defvar geiser-repl--last-scm-buffer nil)) - -(defun switch-to-geiser (&optional ask impl buffer) - "Switch to running Geiser REPL. -With prefix argument, ask for which one if more than one is running. -If no REPL is running, execute `run-geiser' to start a fresh one." - (interactive "P") - (let* ((impl (or impl geiser-impl--implementation)) - (in-repl (eq major-mode 'geiser-repl-mode)) - (in-live-repl (and in-repl (get-buffer-process (current-buffer)))) - (repl (cond ((and (not ask) - (not impl) - (not in-repl) - (or geiser-repl--repl (car geiser-repl--repls)))) - ((and (not ask) - (not in-repl) - impl - (geiser-repl--repl/impl impl))))) - (pop-up-windows geiser-repl-window-allow-split)) - (cond ((or in-live-repl - (and (eq (current-buffer) repl) (not (eq repl buffer)))) - (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)) - (t (run-geiser impl))) - (when (and buffer (eq major-mode 'geiser-repl-mode)) - (setq geiser-repl--last-scm-buffer buffer)))) - -(defalias 'geiser 'switch-to-geiser) +(setq geiser-eval--default-connection-function 'geiser-repl--connection) (defun geiser-repl--send (cmd) (when (and cmd (eq major-mode 'geiser-repl-mode)) @@ -341,64 +284,25 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (let ((comint-input-filter (lambda (x) nil))) (comint-send-input nil t)))) -(defun switch-to-geiser-module (&optional module buffer) - "Switch to running Geiser REPL and try to enter a given module." - (interactive) - (let* ((module (or module - (geiser-completion--read-module - "Switch to module (default top-level): "))) - (cmd (and module - (geiser-repl--enter-cmd geiser-impl--implementation - module)))) - (unless (eq major-mode 'geiser-repl-mode) - (switch-to-geiser nil nil (or buffer (current-buffer)))) - (geiser-repl--send cmd))) - -(defun geiser-repl-import-module (&optional module) - "Import a given module in the current namespace of the REPL." - (interactive) - (let* ((module (or module - (geiser-completion--read-module "Import module: "))) - (cmd (and module - (geiser-repl--import-cmd geiser-impl--implementation - module)))) - (switch-to-geiser nil nil (current-buffer)) - (geiser-repl--send cmd))) - -(defun geiser-repl-exit (&optional arg) - "Exit the current REPL. -With a prefix argument, force exit by killing the scheme process." - (interactive "P") - (when (or (not geiser-repl-query-on-exit-p) - (y-or-n-p "Really quit this REPL? ")) - (let ((cmd (and (not arg) - (geiser-repl--exit-cmd geiser-impl--implementation)))) - (if cmd - (when (stringp cmd) (geiser-repl--send cmd)) - (comint-kill-subjob))))) - -(defun geiser-repl-nuke () - "Try this command if the REPL becomes unresponsive." - (interactive) - (goto-char (point-max)) - (comint-kill-region comint-last-input-start (point)) - (comint-redirect-cleanup) - (geiser-con--setup-connection (current-buffer) - comint-prompt-regexp - geiser-con--debugging-prompt-regexp - geiser-con--debugging-preamble-regexp)) - ;;; REPL history and clean-up: (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) (setq geiser-repl--repls (remove cb geiser-repl--repls)) (dolist (buffer (buffer-list)) (when (buffer-live-p buffer) @@ -415,10 +319,10 @@ With a prefix argument, force exit by killing the scheme process." (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) @@ -426,7 +330,7 @@ With a prefix argument, force exit by killing the scheme process." (remove (current-buffer) geiser-repl--closed-repls))) (defun geiser-repl--input-filter (str) - (not (or (geiser-con--is-debugging) + (not (or ;; (geiser-con--is-debugging) (string-match "^\\s *$" str) (string-match "^,quit *$" str)))) @@ -497,7 +401,8 @@ With a prefix argument, force exit by killing the scheme process." (intxt (and pmark (buffer-substring pmark (point))))) (when intxt (when (and geiser-repl-forget-old-errors-p - (not (geiser-con--is-debugging))) +;;; (not (geiser-con--is-debugging))) + ) (compilation-forget-errors)) (comint-send-input) (when (string-match "^\\s-*$" intxt) @@ -545,7 +450,6 @@ buffer." (setq geiser-eval--get-module-function 'geiser-repl--module-function) (when geiser-repl-autodoc-p (geiser--save-msg (geiser-autodoc-mode 1))) - (setq geiser-autodoc--inhibit-function 'geiser-con--is-debugging) (geiser-company--setup geiser-repl-company-p) ;; enabling compilation-shell-minor-mode without the annoying highlighter (compilation-setup t)) @@ -588,15 +492,104 @@ buffer." ("Kill Scheme interpreter" "\C-c\C-q" geiser-repl-exit :enable (geiser-repl--live-p)) ("Restart" "\C-c\C-z" switch-to-geiser :enable (not (geiser-repl--live-p))) - ("Revive REPL" "\C-c\C-k" geiser-repl-nuke - "Use this command if the REPL becomes irresponsive" - :enable (geiser-repl--live-p)) -- (custom "REPL options" geiser-repl)) (define-key geiser-repl-mode-map [menu-bar completion] 'undefined) +;;; User commands + +(defun run-geiser (impl) + "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)))) + +(defalias 'geiser 'run-geiser) + +(defun geiser-connect (impl &optional host port) + "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)) + +(make-variable-buffer-local + (defvar geiser-repl--last-scm-buffer nil)) + +(defun switch-to-geiser (&optional ask impl buffer) + "Switch to running Geiser REPL. +With prefix argument, ask for which one if more than one is running. +If no REPL is running, execute `run-geiser' to start a fresh one." + (interactive "P") + (let* ((impl (or impl geiser-impl--implementation)) + (in-repl (eq major-mode 'geiser-repl-mode)) + (in-live-repl (and in-repl (get-buffer-process (current-buffer)))) + (repl (cond ((and (not ask) + (not impl) + (not in-repl) + (or geiser-repl--repl (car geiser-repl--repls)))) + ((and (not ask) + (not in-repl) + impl + (geiser-repl--repl/impl impl))))) + (pop-up-windows geiser-repl-window-allow-split)) + (cond ((or in-live-repl + (and (eq (current-buffer) repl) (not (eq repl buffer)))) + (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)) + (t (run-geiser impl))) + (when (and buffer (eq major-mode 'geiser-repl-mode)) + (setq geiser-repl--last-scm-buffer buffer)))) + +(defun switch-to-geiser-module (&optional module buffer) + "Switch to running Geiser REPL and try to enter a given module." + (interactive) + (let* ((module (or module + (geiser-completion--read-module + "Switch to module (default top-level): "))) + (cmd (and module + (geiser-repl--enter-cmd geiser-impl--implementation + module)))) + (unless (eq major-mode 'geiser-repl-mode) + (switch-to-geiser nil nil (or buffer (current-buffer)))) + (geiser-repl--send cmd))) + +(defun geiser-repl-import-module (&optional module) + "Import a given module in the current namespace of the REPL." + (interactive) + (let* ((module (or module + (geiser-completion--read-module "Import module: "))) + (cmd (and module + (geiser-repl--import-cmd geiser-impl--implementation + module)))) + (switch-to-geiser nil nil (current-buffer)) + (geiser-repl--send cmd))) + +(defun geiser-repl-exit (&optional arg) + "Exit the current REPL. +With a prefix argument, force exit by killing the scheme process." + (interactive "P") + (when (or (not geiser-repl-query-on-exit-p) + (y-or-n-p "Really quit this REPL? ")) + (let ((cmd (and (not arg) + (geiser-repl--exit-cmd geiser-impl--implementation)))) + (if cmd + (when (stringp cmd) (geiser-repl--send cmd)) + (comint-kill-subjob))))) + + ;;; Unload: (defun geiser-repl--repl-list () @@ -604,17 +597,25 @@ buffer." (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 37763b9..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)) @@ -32,11 +37,8 @@ (define orig-loader (current-load/use-compiled)) (define geiser-loader (module-loader orig-loader)) -(define geiser-send-null (make-parameter #f)) - (define (geiser-eval) (define geiser-main (module->namespace 'geiser/main)) - (geiser-send-null #t) (let* ([mod (read)] [lang (read)] [form (read)]) @@ -45,32 +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)]))))) - -(define (geiser-read) - (if (geiser-send-null) - (begin (geiser-send-null #f) - (write-char #\nul)) - (printf "racket@~a> " (namespace->module-name (current-namespace)))) + (eval-in `(,proc ,@args) mod lang))] + [else (eval-in form mod lang)]))))) + +(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) @@ -78,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)) |