summaryrefslogtreecommitdiff
path: root/elisp/geiser-connection.el
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-01-28 14:53:33 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-01-28 14:53:33 +0100
commitbdda30e6f263f7142f2f33a8be2545d3061fb598 (patch)
tree7373d0e4bc2cb2fffd35296cecfa07b74c59e59b /elisp/geiser-connection.el
parentdd0ef53303074c1217363d363c1cccc6fcad6dc7 (diff)
downloadgeiser-chez-bdda30e6f263f7142f2f33a8be2545d3061fb598.tar.gz
geiser-chez-bdda30e6f263f7142f2f33a8be2545d3061fb598.tar.bz2
Generic support for debugging prompts in the REPL
Diffstat (limited to 'elisp/geiser-connection.el')
-rw-r--r--elisp/geiser-connection.el92
1 files changed, 71 insertions, 21 deletions
diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el
index bdac427..f5b5928 100644
--- a/elisp/geiser-connection.el
+++ b/elisp/geiser-connection.el
@@ -123,23 +123,47 @@
;;; Connection setup:
+(make-variable-buffer-local
+ (defvar geiser-con--debugging-prompt-regexp nil))
+
+(defun geiser-con--is-debugging ()
+ (and geiser-con--debugging-prompt-regexp
+ 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--cleanup-connection (c)
(geiser-con--connection-cancel-timer c))
-(defun geiser-con--setup-connection (buffer prompt-regexp)
+(defun geiser-con--setup-connection (buffer
+ prompt-regexp
+ &optional debug-prompt-regexp)
(with-current-buffer buffer
(when geiser-con--connection
(geiser-con--cleanup-connection geiser-con--connection))
+ (setq geiser-con--debugging-prompt-regexp debug-prompt-regexp)
(setq geiser-con--connection (geiser-con--make-connection buffer))
- (geiser-con--setup-comint prompt-regexp)
+ (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)
- (set (make-local-variable 'comint-redirect-insert-matching-regexp) nil)
- (set (make-local-variable 'comint-redirect-finished-regexp) prompt-regexp)
- (add-hook 'comint-redirect-hook 'geiser-con--comint-redirect-hook nil t))
+(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)
+ (when debug-prompt-regexp
+ (add-hook 'comint-redirect-filter-functions
+ 'geiser-con--debug-watcher
+ nil
+ t)))
;;; Requests handling:
@@ -149,29 +173,41 @@
(defun geiser-con--comint-buffer-form ()
(with-current-buffer (geiser-con--comint-buffer)
- (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 ""))))
- (error `((error (key . geiser-con-error))
- (output . ,(buffer-string)))))))
+ (goto-char (point-max))
+ (if (and geiser-con--debugging-prompt-regexp
+ (re-search-backward geiser-con--debugging-prompt-regexp nil t))
+ `((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 ""))))
+ (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))
+ (debug-prompt (with-current-buffer buffer
+ geiser-con--debugging-prompt-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 (delete-region (point-min) (point-max)))
+ (with-current-buffer cbuf
+ (setq comint-redirect-echo-input nil)
+ (setq geiser-con--debugging-prompt-regexp debug-prompt)
+ (delete-region (point-min) (point-max)))
(set-buffer buffer)
- (geiser-log--info "<%s>: %s" (geiser-con--request-id req) str)
- (comint-redirect-send-command (format "%s" str) cbuf nil t))))))
+ (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)))))))
(defun geiser-con--process-completed-request (req)
(let ((cont (geiser-con--request-continuation req))
@@ -191,10 +227,20 @@
(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)))
+ (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)))))
+ (geiser-con--connection-clean-current-request
+ geiser-con--connection)))))
+
+(defun geiser-con--debug-watcher (pstr)
+ (when (string-match-p geiser-con--debugging-prompt-regexp pstr)
+ (setq comint-redirect-echo-input t)
+ (setq pstr (concat (with-current-buffer comint-redirect-output-buffer
+ (buffer-string))
+ pstr)))
+ pstr)
(defadvice comint-redirect-setup
(after geiser-con--advice
@@ -220,11 +266,15 @@
(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 (buffer/proc str cont
+ &optional timeout sbuf)
(save-current-buffer
(let ((con (geiser-con--get-connection buffer/proc)))
(unless (geiser-con--connection-process con)
(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")))
(let* ((req (geiser-con--send-string buffer/proc str cont sbuf))
(id (and req (geiser-con--request-id req)))
(time (or timeout geiser-connection-timeout))