From 682e386ab7e2a78b64d2420d4f4c014bc86be256 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 7 Nov 2010 03:40:37 +0100 Subject: Nits --- elisp/geiser-connection.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'elisp/geiser-connection.el') diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index dfdb21d..2702f0f 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -274,8 +274,9 @@ (defun geiser-con--send-string/wait (buffer/proc str cont &optional timeout sbuf) (save-current-buffer - (let ((con (geiser-con--get-connection buffer/proc))) - (unless (geiser-con--connection-process con) + (let* ((con (geiser-con--get-connection buffer/proc)) + (proc (and con (geiser-con--connection-process con)))) + (unless proc (error geiser-con--error-message)) (with-current-buffer (geiser-con--connection-buffer con) (when (geiser-con--is-debugging) @@ -290,8 +291,8 @@ (while (and (> time 0) (geiser-con--connection-process con) (not (geiser-con--connection-completed-p con id))) - (accept-process-output nil waitsecs) - (setq time (- time step))) + (unless (accept-process-output nil waitsecs) + (setq time (- time step)))) (error (setq time 0))) (or (> time 0) (geiser-con--request-deactivate req) -- cgit v1.2.3 From 3ba17b64dfd84a313fdb631c0127de7f54218465 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz 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/geiser-connection.el') 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 From e7aa01584d9b54e47855f2bcc434ab4c253126d5 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 7 Nov 2010 18:29:25 +0100 Subject: Better connection logs --- elisp/geiser-connection.el | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) (limited to 'elisp/geiser-connection.el') diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index e24511b..066d1a3 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -224,17 +224,18 @@ (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))) + (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))) (if (not cont) - (geiser-log--warn "<%s> Droping result for request %S (%s)" - id rstr req) + (geiser-log--warn "<%s> Droping result for request %S: %s" + id rstr form) (condition-case cerr (with-current-buffer (or buffer (current-buffer)) - (funcall cont (geiser-con--comint-buffer-form con)) + (funcall cont form) (geiser-log--info "<%s>: processed" id)) (error (geiser-log--error "<%s>: continuation failed %S \n\t%s" id rstr cerr)))))) -- cgit v1.2.3 From 3e1ed908aa73875bda5842d6d9ce4c8b2d76bfb4 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 7 Nov 2010 18:41:32 +0100 Subject: Interruptible connection waiting --- elisp/geiser-connection.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'elisp/geiser-connection.el') diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 066d1a3..c45a37a 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -294,7 +294,7 @@ (while (and (> time 0) (geiser-con--connection-process con) (not (geiser-con--connection-completed-p con id))) - (unless (accept-process-output nil waitsecs) + (unless (sit-for waitsecs) (setq time (- time step)))) (error (setq time 0))) (or (> time 0) -- cgit v1.2.3 From a73fdcb10bb6144d7befbc4c553102c9816e86c9 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 8 Nov 2010 03:38:44 +0100 Subject: Connection plumbing: ability to specify EOT token added --- elisp/geiser-connection.el | 91 +++++++++++++++++++++++++--------------------- elisp/geiser-eval.el | 6 --- 2 files changed, 49 insertions(+), 48 deletions(-) (limited to 'elisp/geiser-connection.el') diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index c45a37a..5305cd8 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -17,6 +17,7 @@ (require 'geiser-log) (require 'geiser-syntax) (require 'geiser-base) +(require 'geiser-impl) (require 'comint) (require 'advice) @@ -77,13 +78,20 @@ (cons :count 0) (cons :completed (make-hash-table :weakness 'value)) (cons :buffer buffer) - (cons :timer nil) - (cons :reply (geiser-con--make-reply-buffer (buffer-name buffer))))) + (cons :reply (geiser-con--make-reply-buffer buffer)))) -(defun geiser-con--make-reply-buffer (n) - (let ((rb (generate-new-buffer (concat " geiser-con-reply: " n)))) - (buffer-disable-undo rb) - rb)) +(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)))) (defsubst geiser-con--connection-p (c) (and (listp c) (eq (car c) :geiser-connection))) @@ -103,11 +111,15 @@ (defsubst geiser-con--connection-reply-buffer (c) (cdr (assoc :reply c))) +(defsubst geiser-con--connection-completed (c r) + (geiser-con--request-deactivate req) + (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 - (puthash (geiser-con--request-id req) req (cdr (assoc :completed c))) + (geiser-con--connection-completed c req) (setcdr cell nil)))) (defun geiser-con--connection-add-request (c r) @@ -118,13 +130,17 @@ (gethash id (cdr (assoc :completed c)))) (defun geiser-con--connection-pop-request (c) - (let ((reqs (assoc :requests c)) - (current (assoc :current c))) - (setcdr current (prog1 (cadr reqs) (setcdr reqs (cddr reqs)))) - (if (and (cdr current) - (geiser-con--request-deactivated-p (cdr current))) + (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) - (cdr current)))) + (setcdr current new-current)))) (defun geiser-con--connection-inc-count (c) (let* ((cnt (assoc :count c)) @@ -176,13 +192,11 @@ (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) - (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) + (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))) @@ -207,10 +221,6 @@ (defun geiser-con--process-next (con) (when (not (geiser-con--connection-current-request con)) (let* ((buffer (geiser-con--connection-buffer con)) - (debug-prompt (with-current-buffer buffer - geiser-con--debugging-prompt-regexp)) - (debug-preamble (with-current-buffer buffer - geiser-con--debugging-preamble-regexp)) (req (geiser-con--connection-pop-request con)) (str (and req (geiser-con--request-string req))) (rbuffer (geiser-con--connection-reply-buffer con))) @@ -219,7 +229,7 @@ (delete-region (point-min) (point-max))) (set-buffer buffer) (if (geiser-con--is-debugging) - (geiser-con--request-deactivate req) + (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)))))) @@ -236,24 +246,27 @@ (condition-case cerr (with-current-buffer (or buffer (current-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)))))) + "<%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) - (geiser-con--connection-clean-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) @@ -262,20 +275,11 @@ (defconst geiser-con--error-message "Geiser connection not active") -(defun geiser-con--send-string (buffer/proc str cont &optional sender-buffer) - (save-current-buffer - (let ((con (geiser-con--get-connection buffer/proc))) - (unless con (error geiser-con--error-message)) - (let ((req (geiser-con--make-request con str cont sender-buffer))) - (geiser-con--connection-add-request con req) - (geiser-con--process-next con) - req)))) - (defvar geiser-connection-timeout 30000 "Time limit, in msecs, blocking on synchronous evaluation requests") (defun geiser-con--send-string/wait (buffer/proc str cont - &optional timeout sbuf) + &optional timeout sbuf) (save-current-buffer (let* ((con (geiser-con--get-connection buffer/proc)) (proc (and con (geiser-con--connection-process con)))) @@ -284,17 +288,20 @@ (with-current-buffer (geiser-con--connection-buffer con) (when (geiser-con--is-debugging) (error "Geiser REPL is in debug mode"))) - (let* ((req (geiser-con--send-string buffer/proc str cont sbuf)) + (let* ((req (geiser-con--make-request con str cont sbuf)) (id (and req (geiser-con--request-id req))) (time (or timeout geiser-connection-timeout)) (step 100) (waitsecs (/ step 1000.0))) (when id + (geiser-con--connection-add-request con req) + (geiser-con--process-next con) (condition-case nil (while (and (> time 0) (geiser-con--connection-process con) (not (geiser-con--connection-completed-p con id))) - (unless (sit-for waitsecs) + (unless (accept-process-output nil waitsecs nil nil) + (geiser-con--process-next con) (setq time (- time step)))) (error (setq time 0))) (or (> time 0) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index ffe3306..3534312 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -136,12 +136,6 @@ module-exports, autodoc, callers, callees and generic-methods.") (defun geiser-eval--set-sync-retort (s) (setq geiser-eval--sync-retort (geiser-eval--log s))) -(defsubst geiser-eval--send (code cont &optional buffer) - (geiser-con--send-string (geiser-eval--proc) - (geiser-eval--code-str code) - `(lambda (s) (,cont (geiser-eval--log s))) - buffer)) - (defun geiser-eval--send/wait (code &optional timeout buffer) (setq geiser-eval--sync-retort nil) (geiser-con--send-string/wait (geiser-eval--proc) -- cgit v1.2.3 From 512fa06fec02b7dc8ce11684313f7a0ab56bef6b Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 9 Nov 2010 02:38:49 +0100 Subject: Elisp buggettes and warnings --- elisp/geiser-connection.el | 2 +- elisp/geiser-guile.el | 7 ++++--- elisp/geiser-mode.el | 4 ++-- 3 files changed, 7 insertions(+), 6 deletions(-) (limited to 'elisp/geiser-connection.el') diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 5305cd8..f146563 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -112,7 +112,7 @@ By default, Geiser uses the prompt regexp.") (cdr (assoc :reply c))) (defsubst geiser-con--connection-completed (c r) - (geiser-con--request-deactivate req) + (geiser-con--request-deactivate r) (puthash (geiser-con--request-id r) r (cdr (assoc :completed c)))) (defun geiser-con--connection-clean-current-request (c) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index f13fab6..1c39f14 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -139,8 +139,9 @@ This function uses `geiser-guile-init-file' if it exists." :f))) ((listp module) module) ((stringp module) - (or (ignore-errors (car (geiser-syntax--read-from-string module))) - :f)) + (condition-case nil + (car (geiser-syntax--read-from-string module)) + (error :f))) (t :f))) (defun geiser-guile--module-cmd (module fmt &optional def) @@ -251,7 +252,7 @@ it spawn a server thread." (font-lock-add-keywords nil `((,geiser-guile--path-rx 1 compilation-error-face))) - (geiser-eval--send/result + (geiser-eval--send/wait `(:scm ,(format "(set! %%load-path (cons %S %%load-path))" (expand-file-name "guile/" geiser-scheme-dir)))) (geiser-guile-update-warning-level)) diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index 1645ba2..719176d 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -184,7 +184,7 @@ positive values and backward for negative." (let ((pared (and (boundp 'paredit-mode) paredit-mode)) (fwd (> n 0)) (steps (abs n))) - (when pared (paredit-mode -1)) + (when (and pared (fboundp 'paredit-mode)) (paredit-mode -1)) (unwind-protect (save-excursion (unless (looking-at-p "\\s(") (backward-up-list)) @@ -203,7 +203,7 @@ positive values and backward for negative." (progn (when fwd (forward-sexp 2)) (backward-sexp)) (error (setq steps 0)))))) - (when pared (paredit-mode 1))))) + (when (and pared (fboundp 'paredit-mode)) (paredit-mode 1))))) ;;; Geiser mode: -- cgit v1.2.3 From f2bf4b2cda05fe8c32ee74ce3b5cce743d81de61 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 9 Nov 2010 21:35:50 +0100 Subject: Racket: remote REPLs --- .gitignore | 1 + Makefile.am | 2 +- bin/Makefile.am | 15 +++++++++++ bin/geiser-racket.sh | 19 +++++++++++++ configure.ac | 1 + doc/repl.texi | 60 ++++++++++++++++++++++++++++------------- elisp/geiser-connection.el | 57 +++++++++++++++++---------------------- elisp/geiser-racket.el | 12 +++++++++ scheme/racket/geiser/server.rkt | 24 +++++++++++++++++ 9 files changed, 138 insertions(+), 53 deletions(-) create mode 100644 bin/Makefile.am create mode 100755 bin/geiser-racket.sh create mode 100644 scheme/racket/geiser/server.rkt (limited to 'elisp/geiser-connection.el') diff --git a/.gitignore b/.gitignore index 15ac980..444b523 100644 --- a/.gitignore +++ b/.gitignore @@ -30,3 +30,4 @@ /doc/geiser.info /doc/texinfo.tex /autom4te.cache/ +/bin/Makefile.in diff --git a/Makefile.am b/Makefile.am index 0ef180e..4f5a16b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,4 +1,4 @@ -SUBDIRS = . elisp scheme doc +SUBDIRS = . elisp scheme bin doc EXTRA_DIST = THANKS diff --git a/bin/Makefile.am b/bin/Makefile.am new file mode 100644 index 0000000..9f6ee2b --- /dev/null +++ b/bin/Makefile.am @@ -0,0 +1,15 @@ +EXTRA_DIST = geiser-racket.sh +dist_bin_SCRIPTS = geiser-racket +noinst_SCRIPTS = geiser-racket-noinst + +CLEANFILES = $(dist_bin_SCRIPTS) $(noinst_SCRIPTS) + +geiser-racket: $(srcdir)/geiser-racket.sh + @sed -e "s|top=\".*\"|top=$(datarootdir)/geiser|" \ + $(srcdir)/geiser-racket.sh >$@ + @chmod +x $@ + +geiser-racket-noinst: $(srcdir)/geiser-racket.sh + @sed -e "s|top=\".*\"|top=$(abs_top_srcdir)/scheme|" \ + $(srcdir)/geiser-racket.sh >$@ + @chmod +x $@ diff --git a/bin/geiser-racket.sh b/bin/geiser-racket.sh new file mode 100755 index 0000000..4f16383 --- /dev/null +++ b/bin/geiser-racket.sh @@ -0,0 +1,19 @@ +#!/bin/bash +#| +top="$(dirname $0)/../scheme" +exec racket -i -S "$top/racket" -l errortrace -cu "$0" ${1+"$@"} +|# + +#lang racket/base + +(require (lib "cmdline.rkt")) + +(define port (make-parameter 1969)) + +(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))) diff --git a/configure.ac b/configure.ac index 1a70214..ddeec3f 100644 --- a/configure.ac +++ b/configure.ac @@ -25,6 +25,7 @@ elisp/Makefile elisp/geiser-version.el elisp/geiser-load.el scheme/Makefile +bin/Makefile doc/Makefile ]) diff --git a/doc/repl.texi b/doc/repl.texi index e707e61..03fb42a 100644 --- a/doc/repl.texi +++ b/doc/repl.texi @@ -45,27 +45,49 @@ evaluation when they're complete, and will indent new lines properly until then. It will also keep track of your input, maintaining a history file that will be reloaded whenever you restart the REPL. +@subsubheading Connecting to an external Scheme @cindex remote REPL @cindex connect to server -If you use Guile, there's an alternative way of starting a Geiser REPL: -you can connect to a remote Guile process, provided the latter is -running a REPL server. For that to happen, you just need to start your -Guile process (outside Emacs) passing to it the flag @code{--listen}. -Then, come back to Emacs and execute @kbd{M-x connect-to-guile}. You'll -be asked for a host and a port, with suitable default values (Guile's -@code{--listen} flag accepts an optional port as argument (as in -@code{--listen=1969}), if you don't want to use the default). And voila, -you'll have a Geiser REPL that is served by the remote Guile process in -a dedicated thread, meaning that your Guile can go on doing whatever it -was doing while you tinker with it from Emacs. Note, however, -that all Guile threads share the heap, so that you'll be able to -interact with those other threads in the running scheme from Emacs in a -variety of ways. For starters, all you (re)defintions will be visible -everywhere. That's dangerous, but will come in handy when you need to -debug your running webserver. - -Nothing that fanciful this far, but there's more to Geiser's REPL. On -to the next section! +There's an alternative way of starting a Geiser REPL: you can connect to +an external Scheme process, provided it's running a REPL server at some +known port. How to make that happen depends on the Scheme implementation. + +@cindex Guile's REPL server +If you use Guile, you just need to start your Guile process (possibly +outside Emacs) passing to it the flag @code{--listen}. This flag accepts +an optional port as argument (as in @code{--listen=1969}), if you don't +want to use the default. + +@cindex Racket's REPL server +In Racket, you have to use the REPL server that comes with Geiser. To +that end, put Geiser's Racket scheme directory in the Racket's +collection search path and invoke @code{start-geiser} (a procedure in +the module @code{geiser/server}) somewhere in your program, passing it +the desired port. This procedure will start the REPL server in a +separate thread. For an example of how to do that, see the script +@file{bin/geiser-racket.sh} in the source distribution, or, if you've +compiled Geiser, @file{bin/geiser-racket-noinst} in the build directory, +or, if you've installed Geiser, @file{geiser-racket} in +@file{/bin}. These scripts start a new interactive +Racket that is also running a REPL server (they also load the errortrace +library to provide better diagnostics, but that's not strictly needed). + +With your external Scheme process running and serving, come back to +Emacs and execute @kbd{M-x geiser-connect}, @kbd{M-x connect-to-guile} +or @kbd{M-x connect-to-racket}. You'll be asked for a host and a port, +and, voila, you'll have a Geiser REPL that is served by the remote +Scheme process in a dedicated thread, meaning that your external program +can go on doing whatever it was doing while you tinker with it from +Emacs. Note, however, that all Scheme threads share the heap, so that +you'll be able to interact with those other threads in the running +scheme from Emacs in a variety of ways. For starters, all your +(re)defintions will be visible everywhere. That's dangerous, but will +come in handy when you need to debug your running webserver. + +@cindex remote connections +The connection between Emacs and the Scheme process goes over TCP, so it +can be as remote as you need, perhaps with the intervention of an SSH +tunnel. @node First aids, Switching context, Starting the REPL, The REPL @section First aids diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index f146563..dc669aa 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -159,15 +159,17 @@ By default, Geiser uses the prompt regexp.") (make-variable-buffer-local (defvar geiser-con--debugging-preamble-regexp nil)) -(defun geiser-con--is-debugging () - (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))))) +(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) @@ -278,35 +280,24 @@ By default, Geiser uses the prompt regexp.") (defvar geiser-connection-timeout 30000 "Time limit, in msecs, blocking on synchronous evaluation requests") -(defun geiser-con--send-string/wait (buffer/proc str cont - &optional timeout sbuf) +(defun geiser-con--send-string/wait (b/p str cont &optional timeout sbuf) (save-current-buffer - (let* ((con (geiser-con--get-connection buffer/proc)) + (let* ((con (geiser-con--get-connection b/p)) (proc (and con (geiser-con--connection-process con)))) - (unless proc - (error geiser-con--error-message)) - (with-current-buffer (geiser-con--connection-buffer con) - (when (geiser-con--is-debugging) - (error "Geiser REPL is in debug mode"))) + (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)) - (id (and req (geiser-con--request-id req))) - (time (or timeout geiser-connection-timeout)) - (step 100) - (waitsecs (/ step 1000.0))) - (when id - (geiser-con--connection-add-request con req) - (geiser-con--process-next con) + (id (geiser-con--request-id req)) + (timeout (/ (or timeout geiser-connection-timeout) 1000.0)) + (waitsecs 0.1)) + (geiser-con--connection-add-request con req) + (with-timeout (timeout (geiser-con--request-deactivate req)) (condition-case nil - (while (and (> time 0) - (geiser-con--connection-process con) + (while (and (geiser-con--connection-process con) (not (geiser-con--connection-completed-p con id))) - (unless (accept-process-output nil waitsecs nil nil) - (geiser-con--process-next con) - (setq time (- time step)))) - (error (setq time 0))) - (or (> time 0) - (geiser-con--request-deactivate req) - nil)))))) + (geiser-con--process-next con) + (accept-process-output proc waitsecs nil t)) + (error (geiser-con--request-deactivate req)))))))) (provide 'geiser-connection) diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el index 18ed2eb..8c66e67 100644 --- a/elisp/geiser-racket.el +++ b/elisp/geiser-racket.el @@ -222,6 +222,18 @@ This function uses `geiser-racket-init-file' if it exists." (re-search-forward "#lang " nil t)) (geiser-racket--explicit-module))) + +;;; Remote REPLs + +(defun connect-to-racket () + "Start a Racket REPL connected to a remote process. + +The remote process needs to be running a REPL server started +using start-geiser, a procedure in the geiser/server module." + (interactive) + (geiser-connect 'racket)) + + ;;; Implementation definition: diff --git a/scheme/racket/geiser/server.rkt b/scheme/racket/geiser/server.rkt new file mode 100644 index 0000000..cf86b2c --- /dev/null +++ b/scheme/racket/geiser/server.rkt @@ -0,0 +1,24 @@ +;;; server.rkt -- REPL server + +;; 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 . + +;; Start date: Sat Nov 06, 2010 15:15 + +#lang racket/base + +(require geiser/user mzlib/thread) +(provide run-geiser-server 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)))) -- cgit v1.2.3