From e070d76166d249695f1d2ee0269cc5c91537e0c9 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Fri, 12 Nov 2010 22:55:40 +0100 Subject: [PATCH] Make do with a single connection Separate connections for the REPL and Geiser commands was kind of neat, but it had the problem of synchronising the current namespace for both connections. A quick fix would have been to ask the scheme for the current namespace for every Geiser command in the REPL, but that, besides clunky, would add potentially prohibitive overhead for (real) remote connections. As it happens, using a single connection turned out to be not that difficult and relatively clean code-wise. We could even turn back to not use inferior schemes, and the net result of this refactoring would be the replacement of comint-redirect (which wasn't able to match the whole EOT token if it didn't arrive all at once) by transaction queues (which also makes geiser-connection's implementation cleaner). But using an inferior scheme has a dog-food value, and allows external processes to connect to the scheme being used by Geiser without further ado, which could be useful for debugging (although this is a lame excuse: nothing prevents you from starting a REPL server from emacs if you want). We'll see. --- elisp/geiser-connection.el | 49 ++++++++++++++++++++++++-------------- elisp/geiser-guile.el | 20 +++++++++------- elisp/geiser-racket.el | 14 +++++------ elisp/geiser-repl.el | 29 +++++++++++----------- scheme/guile/geiser/evaluation.scm | 1 - scheme/racket/geiser/eval.rkt | 1 - 6 files changed, 65 insertions(+), 49 deletions(-) diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 76ba24a..0225964 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -74,37 +74,48 @@ (format "\\(%s%s\\)" prompt (if debug (format "\\|%s" debug) ""))) (defun geiser-con--connection-eot-re (prompt debug) - (geiser-con--combined-prompt (format "\0\n%s" prompt) + (geiser-con--combined-prompt (format "\n%s" prompt) (and debug (format "\n%s" debug)))) (defun geiser-con--make-connection (proc prompt debug-prompt) - (list :geiser-connection + (list t + (cons :filter (process-filter proc)) (cons :tq (tq-create proc)) + (cons :tq-filter (process-filter proc)) (cons :eot (geiser-con--connection-eot-re prompt debug-prompt)) (cons :prompt prompt) (cons :debug-prompt debug-prompt) (cons :count 0) (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)) - (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 nil) - (setcdr tq (cons proc (tq-buffer tq))) - this-proc)) - -(defsubst geiser-con--connection-p (c) - (and (listp c) (eq (car c) :geiser-connection))) +(defun geiser-con--connection-deactivate (c) + (when (car c) + (let* ((tq (geiser-con--connection-tq c)) + (proc (geiser-con--connection-process c)) + (proc-filter (geiser-con--connection-filter c))) + (while (not (tq-queue-empty tq)) + (accept-process-output proc 0.1)) + (set-process-filter proc proc-filter) + (setcar c nil)))) + +(defun geiser-con--connection-activate (c) + (when (not (car c)) + (let* ((tq (geiser-con--connection-tq c)) + (proc (geiser-con--connection-process c)) + (tq-filter (geiser-con--connection-tq-filter c))) + (while (accept-process-output proc 0.01)) + (set-process-filter proc tq-filter) + (setcar c t)))) (defsubst geiser-con--connection-process (c) (tq-process (cdr (assoc :tq c)))) +(defsubst geiser-con--connection-filter (c) + (cdr (assoc :filter c))) + +(defsubst geiser-con--connection-tq-filter (c) + (cdr (assoc :tq-filter c))) + (defsubst geiser-con--connection-tq (c) (cdr (assoc :tq c))) @@ -164,7 +175,8 @@ `((error (key . geiser-debugger)) (output . ,answer)) (condition-case err - (car (read-from-string answer)) + (let ((form (car (read-from-string answer)))) + (and (listp form) form)) (error `((error (key . geiser-con-error)) (output . ,(format "%s\n(%s)" answer @@ -192,6 +204,7 @@ (geiser-log--info "REQUEST: <%s>: %s" (geiser-con--request-id r) (geiser-con--request-string r)) + (geiser-con--connection-activate c) (tq-enqueue (geiser-con--connection-tq c) (concat (geiser-con--request-string r) "\n") (geiser-con--connection-eot c) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index 3d42d24..687bf34 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -174,13 +174,11 @@ This function uses `geiser-guile-init-file' if it exists." ;;; Error display (defun geiser-guile--enter-debugger () - (let ((bt-cmd (format ",%s\n" + (let ((bt-cmd (format ",geiser-newline\n,error-message\n,%s\n" (if geiser-guile-debug-show-bt-p "bt" "fr")))) (compilation-forget-errors) (goto-char (point-max)) - (geiser-repl--swap) - (comint-send-string nil ",geiser-newline\n") - (comint-send-string nil ",error-message\n") + (geiser-repl--prepare-send) (comint-send-string nil bt-cmd) (when geiser-guile-show-debug-help-p (message "Debug REPL. Enter ,q to quit, ,h for help.")) @@ -266,10 +264,16 @@ it spawn a server thread." (when remote (geiser-repl--send-silent (geiser-guile--load-path-string)) (geiser-repl--send-silent ",use (geiser emacs)")) - (geiser-guile-update-warning-level)) - -(defconst geiser-guile--init-server-command - ",use (geiser emacs)\n,geiser-start-server") + (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") ;;; Implementation definition: diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el index f3aa7e5..3ab181b 100644 --- a/elisp/geiser-racket.el +++ b/elisp/geiser-racket.el @@ -82,7 +82,7 @@ This function uses `geiser-racket-init-file' if it exists." ,@(and init-file (file-readable-p init-file) (list "-f" init-file)) "-f" ,(expand-file-name "racket/geiser.rkt" geiser-scheme-dir)))) -(defconst geiser-racket--prompt-regexp "^=?\\(mzscheme\\|racket\\)@[^ ]*?> ") +(defconst geiser-racket--prompt-regexp "\\(mzscheme\\|racket\\)@[^ ]*?> ") (defconst geiser-racket--init-server-command ",start-geiser") @@ -97,6 +97,12 @@ This function uses `geiser-racket-init-file' if it exists." (car (geiser-syntax--read-from-string (match-string-no-properties 1))) "#f"))) +(defun geiser-racket--enter-command (module) + (when (stringp module) + (cond ((zerop (length module)) ",enter #f") + ((file-name-absolute-p module) (format ",enter (file %S)" module)) + (t (format ",enter %s" module))))) + (defun geiser-racket--geiser-procedure (proc &rest args) (case proc ((eval compile) @@ -140,12 +146,6 @@ This function uses `geiser-racket-init-file' if it exists." (defun geiser-racket--symbol-begin (module) (save-excursion (skip-syntax-backward "^-()>") (point))) -(defun geiser-racket--enter-command (module) - (when (stringp module) - (cond ((zerop (length module)) ",enter #f") - ((file-name-absolute-p module) (format ",enter (file %S)" module)) - (t (format ",enter %s" module))))) - (defun geiser-racket--import-command (module) (and (stringp module) (not (zerop (length module))) diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index f73bd90..e6f01d4 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -228,6 +228,10 @@ module command as a string") nil nil defhost)) (or port (read-number "Port: " defport))))) +(defun geiser-repl--autodoc-mode (n) + (when (or geiser-repl-autodoc-p (< n 0)) + (geiser--save-msg (geiser-autodoc-mode n)))) + (defun geiser-repl--save-remote-data (address remote) (setq geiser-repl--address address) (setq geiser-repl--remote-p remote) @@ -240,6 +244,7 @@ module command as a string") (message "Starting Geiser REPL for %s ..." impl) (geiser-repl--to-repl-buffer impl) (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)) @@ -249,11 +254,6 @@ module command as a string") (geiser-repl--save-remote-data address remote) (condition-case err (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--combined-prompt prompt-rx deb-prompt-rx)) (apply 'make-comint-in-buffer `(,cname ,(current-buffer) ,address))) @@ -264,7 +264,12 @@ module command as a string") (geiser-repl--history-setup) (add-to-list 'geiser-repl--repls (current-buffer)) (geiser-repl--set-this-buffer-repl (current-buffer)) + (setq geiser-repl--connection + (geiser-con--make-connection (get-buffer-process (current-buffer)) + prompt-rx + deb-prompt-rx)) (geiser-repl--startup impl remote) + (geiser-repl--autodoc-mode 1) (message "%s up and running!" (geiser-repl--repl-name impl)))) (defun geiser-repl--connection () @@ -276,16 +281,12 @@ module command as a string") (setq geiser-eval--default-connection-function 'geiser-repl--connection) -(defun geiser-repl--swap () - (let ((p (get-buffer-process (current-buffer)))) - (when (and p geiser-repl--connection) - (let ((p (geiser-con--connection-swap-proc geiser-repl--connection - p))) - (goto-char (point-max)) - (set-marker (process-mark p) (point)))))) +(defun geiser-repl--prepare-send () + (geiser-con--connection-deactivate geiser-repl--connection)) (defun geiser-repl--send (cmd) (when (and cmd (eq major-mode 'geiser-repl-mode)) + (geiser-repl--prepare-send) (goto-char (point-max)) (comint-kill-input) (insert cmd) @@ -293,6 +294,7 @@ module command as a string") (comint-send-input nil t)))) (defun geiser-repl--send-silent (cmd) + (geiser-repl--prepare-send) (comint-redirect-results-list cmd ".+" 0)) @@ -415,6 +417,7 @@ module command as a string") ;;; (not (geiser-con--is-debugging))) ) (compilation-forget-errors)) + (geiser-repl--prepare-send) (comint-send-input) (when (string-match "^\\s-*$" intxt) (comint-send-string proc (geiser-eval--scheme-str '(:ge no-values))) @@ -459,8 +462,6 @@ buffer." (set (make-local-variable 'comint-input-ignoredups) geiser-repl-history-no-dups-p) (setq geiser-eval--get-module-function 'geiser-repl--module-function) - (when geiser-repl-autodoc-p - (geiser--save-msg (geiser-autodoc-mode 1))) (geiser-company--setup geiser-repl-company-p) ;; enabling compilation-shell-minor-mode without the annoying highlighter (compilation-setup t)) diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm index d7d0a68..305ccfd 100644 --- a/scheme/guile/geiser/evaluation.scm +++ b/scheme/guile/geiser/evaluation.scm @@ -50,7 +50,6 @@ (define (write-result result output) (write (list (cons 'result result) (cons 'output output))) - (write-char #\nul) (newline)) (define (call-with-result thunk) diff --git a/scheme/racket/geiser/eval.rkt b/scheme/racket/geiser/eval.rkt index 1efaded..c406aae 100644 --- a/scheme/racket/geiser/eval.rkt +++ b/scheme/racket/geiser/eval.rkt @@ -57,7 +57,6 @@ (lambda () (update-signature-cache spec form) (eval form (module-spec->namespace spec lang))))) - (write-char #\null) (newline)) (define compile-in eval-in) -- 2.11.4.GIT