Generic support for debugging prompts in the REPL

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))