diff options
| -rw-r--r-- | elisp/geiser-connection.el | 118 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 3 |
2 files changed, 62 insertions, 59 deletions
diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 2702f0f..e24511b 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -35,12 +35,13 @@ ;;; Request datatype: -(defun geiser-con--make-request (str cont &optional sender-buffer) +(defun geiser-con--make-request (con str cont &optional sender-buffer) (list :geiser-connection-request - (cons :id (random)) + (cons :id (geiser-con--connection-inc-count con)) (cons :string str) (cons :continuation cont) - (cons :buffer (or sender-buffer (current-buffer))))) + (cons :buffer (or sender-buffer (current-buffer))) + (cons :connection con))) (defsubst geiser-con--request-p (req) (and (listp req) (eq (car req) :geiser-connection-request))) @@ -57,6 +58,9 @@ (defsubst geiser-con--request-buffer (req) (cdr (assoc :buffer req))) +(defsubst geiser-con--request-connection (req) + (cdr (assoc :connection req))) + (defsubst geiser-con--request-deactivate (req) (setcdr (assoc :continuation req) nil)) @@ -70,9 +74,16 @@ (list :geiser-connection (cons :requests (list)) (cons :current nil) + (cons :count 0) (cons :completed (make-hash-table :weakness 'value)) (cons :buffer buffer) - (cons :timer nil))) + (cons :timer nil) + (cons :reply (geiser-con--make-reply-buffer (buffer-name buffer))))) + +(defun geiser-con--make-reply-buffer (n) + (let ((rb (generate-new-buffer (concat " geiser-con-reply: " n)))) + (buffer-disable-undo rb) + rb)) (defsubst geiser-con--connection-p (c) (and (listp c) (eq (car c) :geiser-connection))) @@ -89,6 +100,9 @@ (defsubst geiser-con--connection-current-request (c) (cdr (assoc :current c))) +(defsubst geiser-con--connection-reply-buffer (c) + (cdr (assoc :reply c))) + (defun geiser-con--connection-clean-current-request (c) (let* ((cell (assoc :current c)) (req (cdr cell))) @@ -112,14 +126,11 @@ (geiser-con--connection-pop-request c) (cdr current)))) -(defun geiser-con--connection-start-timer (c) - (let ((cell (assoc :timer c))) - (when (cdr cell) (cancel-timer (cdr cell))) - (setcdr cell (run-at-time t 0.5 'geiser-con--process-next c)))) - -(defun geiser-con--connection-cancel-timer (c) - (let ((cell (assoc :timer c))) - (when (cdr cell) (cancel-timer (cdr cell))))) +(defun geiser-con--connection-inc-count (c) + (let* ((cnt (assoc :count c)) + (new (1+ (cdr cnt)))) + (setcdr cnt new) + new)) ;;; Connection setup: @@ -142,50 +153,45 @@ (overlay-end comint-last-prompt-overlay))))) -(defsubst geiser-con--has-entered-debugger () - (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))))) +(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--cleanup-connection (c) - (geiser-con--connection-cancel-timer c)) +(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 - (when geiser-con--connection - (geiser-con--cleanup-connection geiser-con--connection)) + (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)) - (geiser-con--setup-comint prompt-regexp debug-prompt-regexp) - (geiser-con--connection-start-timer geiser-con--connection) - (message "Geiser REPL up and running!"))) - -(defun geiser-con--setup-comint (prompt-regexp debug-prompt-regexp) - (set (make-local-variable 'comint-redirect-insert-matching-regexp) - (not (null debug-prompt-regexp))) - (set (make-local-variable 'comint-redirect-finished-regexp) - (if debug-prompt-regexp - (format "\\(%s\\)\\|\\(%s\\)" prompt-regexp debug-prompt-regexp) - prompt-regexp)) - (setq comint-prompt-regexp comint-redirect-finished-regexp) - (add-hook 'comint-redirect-hook 'geiser-con--comint-redirect-hook nil t)) + (set (make-local-variable 'comint-redirect-insert-matching-regexp) + (not (null debug-prompt-regexp))) + (set (make-local-variable 'comint-redirect-finished-regexp) + (if debug-prompt-regexp + (format "\\(%s\\)\\|\\(%s\\)" prompt-regexp debug-prompt-regexp) + prompt-regexp)) + (setq comint-prompt-regexp comint-redirect-finished-regexp) + (add-hook 'comint-redirect-hook 'geiser-con--comint-redirect-hook nil t))) ;;; Requests handling: -(defsubst geiser-con--comint-buffer () - (get-buffer-create " *geiser connection retort*")) - -(defun geiser-con--comint-buffer-form () - (with-current-buffer (geiser-con--comint-buffer) +(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) + (if (geiser-con--has-entered-debugger con) `((error (key . geiser-debugger)) (output . ,(buffer-substring (point-min) (point)))) (condition-case nil @@ -207,32 +213,28 @@ geiser-con--debugging-preamble-regexp)) (req (geiser-con--connection-pop-request con)) (str (and req (geiser-con--request-string req))) - (cbuf (geiser-con--comint-buffer))) - (if (not (buffer-live-p buffer)) - (geiser-con--connection-cancel-timer con) - (when (and buffer req str) - (with-current-buffer cbuf - (setq comint-redirect-echo-input nil) - (setq geiser-con--debugging-prompt-regexp debug-prompt) - (setq geiser-con--debugging-preamble-regexp debug-preamble) - (delete-region (point-min) (point-max))) - (set-buffer buffer) - (if (geiser-con--is-debugging) - (geiser-con--request-deactivate req) - (geiser-log--info "<%s>: %s" (geiser-con--request-id req) str) - (comint-redirect-send-command (format "%s" str) cbuf nil t))))))) + (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--request-deactivate 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))) + (buffer (geiser-con--request-buffer req)) + (con (geiser-con--request-connection req))) (if (not cont) (geiser-log--warn "<%s> Droping result for request %S (%s)" id rstr req) (condition-case cerr (with-current-buffer (or buffer (current-buffer)) - (funcall cont (geiser-con--comint-buffer-form)) + (funcall cont (geiser-con--comint-buffer-form con)) (geiser-log--info "<%s>: processed" id)) (error (geiser-log--error "<%s>: continuation failed %S \n\t%s" id rstr cerr)))))) @@ -263,7 +265,7 @@ (save-current-buffer (let ((con (geiser-con--get-connection buffer/proc))) (unless con (error geiser-con--error-message)) - (let ((req (geiser-con--make-request str cont sender-buffer))) + (let ((req (geiser-con--make-request con str cont sender-buffer))) (geiser-con--connection-add-request con req) (geiser-con--process-next con) req)))) diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index 13b655e..f6fc12b 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -247,7 +247,8 @@ module command as a string") deb-preamble-rx) (add-to-list 'geiser-repl--repls (current-buffer)) (geiser-repl--set-this-buffer-repl (current-buffer)) - (geiser-repl--startup impl))) + (geiser-repl--startup impl) + (message "Geiser REPL up and running!"))) (defun geiser-repl--process () (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation))) |