From 3ba17b64dfd84a313fdb631c0127de7f54218465 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Sun, 7 Nov 2010 17:31:09 +0100
Subject: Pumbling cleanups
---
elisp/geiser-connection.el | 118 +++++++++++++++++++++++----------------------
elisp/geiser-racket.el | 4 +-
elisp/geiser-repl.el | 3 +-
3 files changed, 64 insertions(+), 61 deletions(-)
(limited to 'elisp')
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-racket.el b/elisp/geiser-racket.el
index cd4cc8a..34dd497 100644
--- a/elisp/geiser-racket.el
+++ b/elisp/geiser-racket.el
@@ -98,12 +98,12 @@ This function uses `geiser-racket-init-file' if it exists."
(defun geiser-racket--geiser-procedure (proc &rest args)
(case proc
((eval compile)
- (format ",geiser-eval %s %s %s\n"
+ (format ",geiser-eval %s %s %s"
(or (car args) "#f")
(geiser-racket--language)
(mapconcat 'identity (cdr args) " ")))
((load-file compile-file)
- (format ",geiser-eval geiser/main racket (geiser:%s %s)\n"
+ (format ",geiser-eval geiser/main racket (geiser:%s %s)"
proc (car args)))
((no-values) ",geiser-no-values")
(t (format ",apply geiser:%s (%s)" proc (mapconcat 'identity args " ")))))
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)))
--
cgit v1.2.3