summaryrefslogtreecommitdiff
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
parentdd0ef53303074c1217363d363c1cccc6fcad6dc7 (diff)
downloadgeiser-chez-bdda30e6f263f7142f2f33a8be2545d3061fb598.tar.gz
geiser-chez-bdda30e6f263f7142f2f33a8be2545d3061fb598.tar.bz2
Generic support for debugging prompts in the REPL
-rw-r--r--elisp/geiser-autodoc.el10
-rw-r--r--elisp/geiser-connection.el92
-rw-r--r--elisp/geiser-debug.el27
-rw-r--r--elisp/geiser-impl.el5
-rw-r--r--elisp/geiser-repl.el14
5 files changed, 106 insertions, 42 deletions
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index d0345e0..0d9d863 100644
--- a/elisp/geiser-autodoc.el
+++ b/elisp/geiser-autodoc.el
@@ -1,6 +1,6 @@
;; geiser-autodoc.el -- autodoc mode
-;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 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
@@ -158,11 +158,15 @@ when `geiser-autodoc-display-module-p' is on."
;;; Autodoc function:
(make-variable-buffer-local
- (defvar geiser-autodoc--inhibit-flag nil))
+ (defvar geiser-autodoc--inhibit-function nil))
+
+(defsubst geiser-autodoc--inhibit ()
+ (and geiser-autodoc--inhibit-function
+ (funcall geiser-autodoc--inhibit-function)))
(defun geiser-autodoc--eldoc-function ()
(condition-case e
- (and (not geiser-autodoc--inhibit-flag)
+ (and (not (geiser-autodoc--inhibit))
(geiser-autodoc--autodoc (geiser-syntax--scan-sexps)))
(error (format "Autodoc not available (%s)" (error-message-string e)))))
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))
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el
index 9b31968..b181ef5 100644
--- a/elisp/geiser-debug.el
+++ b/elisp/geiser-debug.el
@@ -1,6 +1,6 @@
;;; geiser-debug.el -- displaying debug information and evaluation results
-;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 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
@@ -59,18 +59,19 @@ non-null value.")
(output (geiser-eval--retort-output ret))
(impl geiser-impl--implementation)
(module (geiser-eval--get-module)))
- (geiser-debug--with-buffer
- (erase-buffer)
- (insert what)
- (newline 2)
- (when res
- (insert res)
- (newline 2))
- (unless (geiser-debug--display-error impl module key output)
- (when err (insert (geiser-eval--error-str err) "\n\n"))
- (when output (insert output "\n\n")))
- (goto-char (point-min)))
- (when err (geiser-debug--pop-to-buffer))))
+ (if (eq key 'geiser-debugger) (switch-to-geiser)
+ (geiser-debug--with-buffer
+ (erase-buffer)
+ (insert what)
+ (newline 2)
+ (when res
+ (insert res)
+ (newline 2))
+ (unless (geiser-debug--display-error impl module key output)
+ (when err (insert (geiser-eval--error-str err) "\n\n"))
+ (when output (insert output "\n\n")))
+ (goto-char (point-min)))
+ (when err (geiser-debug--pop-to-buffer)))))
(defsubst geiser-debug--wrap-region (str)
(format "(begin %s)" str))
diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el
index e870be3..3902b09 100644
--- a/elisp/geiser-impl.el
+++ b/elisp/geiser-impl.el
@@ -1,6 +1,6 @@
;; geiser-impl.el -- generic support for scheme implementations
-;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 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
@@ -112,7 +112,8 @@ determine its scheme flavour."
(add-to-list 'geiser-active-implementations impl))
(defsubst geiser-deactivate-implementation (impl)
- (setq geiser-active-implementations (delq impl geiser-active-implementations)))
+ (setq geiser-active-implementations
+ (delq impl geiser-active-implementations)))
;;; Defining implementations:
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index da6eca1..9bff115 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -1,6 +1,6 @@
;;; geiser-repl.el --- Geiser's REPL
-;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 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
@@ -132,6 +132,11 @@ arguments to be used when invoking the scheme binary.")
"A variable (or thunk returning a value) giving the regular
expression for this implementation's scheme prompt.")
+(geiser-impl--define-caller
+ geiser-repl--debugger-prompt-regexp debugger-prompt-regexp ()
+ "A variable (or thunk returning a value) giving the regular
+expression for this implementation's debugging prompt.")
+
(geiser-impl--define-caller geiser-repl--startup startup ()
"Function taking no parameters that is called after the REPL
has been initialised. All Geiser functionality is available to
@@ -143,14 +148,16 @@ you at that point.")
(let ((binary (geiser-repl--binary impl))
(args (geiser-repl--arglist impl))
(prompt-rx (geiser-repl--prompt-regexp impl))
+ (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl))
(cname (geiser-repl--repl-name impl)))
(unless (and binary prompt-rx)
(error "Sorry, I don't know how to start a REPL for %s" impl))
(set (make-local-variable 'comint-prompt-regexp) prompt-rx)
- (apply 'make-comint-in-buffer `(,cname ,(current-buffer) ,binary nil ,@args))
+ (apply 'make-comint-in-buffer
+ `(,cname ,(current-buffer) ,binary nil ,@args))
(geiser-repl--wait-for-prompt 10000)
(geiser-repl--history-setup)
- (geiser-con--setup-connection (current-buffer) prompt-rx)
+ (geiser-con--setup-connection (current-buffer) prompt-rx deb-prompt-rx)
(add-to-list 'geiser-repl--repls (current-buffer))
(geiser-repl--set-this-buffer-repl (current-buffer))
(geiser-repl--startup impl)))
@@ -305,6 +312,7 @@ If no REPL is running, execute `run-geiser' to start a fresh one."
(set-syntax-table scheme-mode-syntax-table)
(setq geiser-eval--get-module-function 'geiser-repl--module-function)
(when geiser-repl-autodoc-p (geiser-autodoc-mode 1))
+ (setq geiser-autodoc--inhibit-function 'geiser-con--is-debugging)
(geiser-company--setup geiser-repl-company-p)
;; enabling compilation-shell-minor-mode without the annoying highlighter
(compilation-setup t))