Merge pull request #1019 from Malabarba/debug

Debugging in Cider

7 files changed, 229 insertions, 7 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 7490f938..ef4a9aed 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,6 +4,10 @@
 
 ### New features
 
+* [#1019](https://github.com/clojure-emacs/cider/pull/1019): New file, cider-debug.el.
+  Provides a new command, `cider-debug-defun-at-point`, bound to <kbd>C-u C-M-x</kbd>.
+  Interactively debug top-level clojure forms.
+
 * New defcustom, `cider-auto-select-test-report-buffer` (boolean).
   Controls whether the test report buffer is selected after running a test. Defaults to true.
 * Trigger Grimoire doc lookup from doc buffers by pressing <kbd>g</kbd> (in Emacs) and <kbd>G</kbd> (in browser).
@@ -36,6 +40,8 @@
 
 ### Changes
 
+* [#1019](https://github.com/clojure-emacs/cider/pull/1019):
+  <kbd>C-u C-M-x</kbd> no longer does `eval-defun`+print-result. Instead it debugs the form at point.
 * [#854](https://github.com/clojure-emacs/cider/pull/854) Error navigation now
   favors line information reported by the stacktrace, being more detailed than
   the info reported by `info` middleware.
diff --git a/README.md b/README.md
index 5539a508..d5ebdf73 100644
--- a/README.md
+++ b/README.md
@@ -724,7 +724,8 @@ Keyboard shortcut                    | Description
 <kbd>C-c M-p</kbd>                   | Load the form preceding point in the REPL buffer.
 <kbd>C-c C-p</kbd>                   | Evaluate the form preceding point and pretty-print the result in a popup buffer.
 <kbd>C-c C-f</kbd>                   | Evaluate the top level form under point and pretty-print the result in a popup buffer.
-<kbd>C-M-x</kbd> <kbd>C-c C-c</kbd>  | Evaluate the top level form under point and display the result in the echo area.  If invoked with a prefix argument, insert the result into the current buffer.
+<kbd>C-M-x</kbd> <kbd>C-c C-c</kbd>  | Evaluate the top level form under point and display the result in the echo area.
+<kbd>C-u C-M-x</kbd> <kbd>C-u C-c C-c</kbd>  | Debug the top level form under point and walk through its evaluation
 <kbd>C-c C-r</kbd>                   | Evaluate the region and display the result in the echo area.
 <kbd>C-c C-b</kbd>                   | Interrupt any pending evaluations.
 <kbd>C-c C-m</kbd>                   | Invoke `macroexpand-1` on the form at point and display the result in a macroexpansion buffer.  If invoked with a prefix argument, `macroexpand` is used instead of `macroexpand-1`.
@@ -844,6 +845,19 @@ Keyboard shortcut               | Description
 <kbd>d</kbd> | toggle display of duplicate frames
 <kbd>a</kbd> | toggle display of all frames
 
+### cider-debug
+<!-- Technically this is not a mode (yet), but let's not burden the user with that knowledge. -->
+
+cider-debug (invoked with <kbd>C-u C-M-x</kbd>) tries to be consistent with
+Edebug. So it makes available the following bindings while stepping through
+code.
+
+Keyboard shortcut               | Description
+--------------------------------|-------------------------------
+<kbd>n</kbd> | Next step
+<kbd>c</kbd> | Continue without stopping
+<kbd>i</kbd> | Inject a value into running code
+
 ### Managing multiple sessions
 
 You can connect to multiple nREPL servers using <kbd>M-x
diff --git a/cider-debug.el b/cider-debug.el
new file mode 100644
index 00000000..2da0ad3f
--- /dev/null
+++ b/cider-debug.el
@@ -0,0 +1,174 @@
+;;; cider-debug.el --- CIDER interaction with clj-debugger  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015  Artur Malabarba
+
+;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Instrument code with `cider-debug-defun-at-point', and when the code is
+;; executed cider-debug will kick in.  See this function's doc for more
+;; information.
+
+;;; Code:
+
+(require 'nrepl-client)
+(require 'cider-interaction)
+
+(defvar cider--current-debug-value nil
+  "Last value received from the debugger.
+Is printed by `cider--debug-read-command' while stepping through
+code.")
+
+(defconst cider--instrument-format
+  (concat "(cider.nrepl.middleware.debug/instrument-and-eval"
+          ;; filename and point are passed in a map. Eventually, this should be
+          ;; part of the message (which the nrepl sees as a map anyway).
+          " {:filename %S :point %S} '%s)")
+  "Format to instrument an expression given a file and a coordinate.")
+
+
+;;; Implementation
+(defun cider--debug-init-connection ()
+  "Initialize a connection with clj-debugger."
+  (nrepl-send-request
+   '("op" "init-debugger")
+   (let ((connection-buffer (nrepl-current-connection-buffer)))
+     (lambda (response)
+       (nrepl-dbind-response response (value coor filename point status id)
+         (if (not (member "done" status))
+             (cider--handle-debug value coor filename point connection-buffer)
+           (puthash id (gethash id nrepl-pending-requests)
+                    nrepl-completed-requests)
+           (remhash id nrepl-pending-requests)))))))
+
+(defun cider--forward-sexp (n)
+  "Move forward N logical sexps.
+This will skip over sexps that don't represent objects, such as ^{}."
+  (while (> n 0)
+    ;; Non-logical sexps.
+    (while (progn (forward-sexp 1)
+                  (forward-sexp -1)
+                  (looking-at-p "\\^"))
+      (forward-sexp 1))
+    ;; The actual sexp
+    (forward-sexp 1)
+    (setq n (1- n))))
+
+(defun cider--handle-debug (value coordinates file point connection-buffer)
+  "Handle debugging notification.
+VALUE is saved in `cider--current-debug-value' to be printed
+while waiting for user input.
+COORDINATES, FILE and POINT are used to place point at the instrumented sexp.
+CONNECTION-BUFFER is the nrepl buffer."
+  ;; Be ready to prompt the user when debugger.core/break is
+  ;; triggers a need-input request.
+  (nrepl-push-input-handler #'cider--need-debug-input connection-buffer)
+
+  ;; Navigate to the instrumented sexp, wherever we might be.
+  (find-file file)
+  ;; Position of the sexp.
+  (goto-char point)
+  (condition-case nil
+      ;; Make sure it is a list.
+      (let ((coordinates (append coordinates nil)))
+        ;; Navigate through sexps inside the sexp.
+        (while coordinates
+          (down-list)
+          (cider--forward-sexp (pop coordinates)))
+        ;; Place point at the end of instrumented sexp.
+        (cider--forward-sexp 1))
+    ;; Avoid throwing actual errors, since this happens on every breakpoint.
+    (error (message "Can't find instrumented sexp, did you edit the source?")))
+  ;; Prepare to notify the user.
+  (setq cider--current-debug-value value))
+
+(defun cider--debug-read-command ()
+  "Receive input from the user representing a command to do."
+  (let ((cider-interactive-eval-result-prefix
+         "(n)ext (c)ontinue (i)nject => "))
+    (cider--display-interactive-eval-result
+     cider--current-debug-value))
+  (let ((input
+         (cl-case (read-char)
+           ;; These keys were chosen to match edebug rather than clj-debugger.
+           (?n "(c)")
+           (?c "(q)")
+           ;; Inject
+           (?i (condition-case nil
+                   (concat (read-from-minibuffer "Expression to inject (non-nil): ")
+                           "\n(c)")
+                 (quit nil))))))
+    (if (and input (not (string= "" input)))
+        (progn (setq cider--current-debug-value nil)
+               input)
+      (cider--debug-read-command))))
+
+(defun cider--need-debug-input (buffer)
+  "Handle an need-input request from BUFFER."
+  (with-current-buffer buffer
+    (nrepl-request:stdin
+     ;; For now we immediately try to read-char. Ideally, this will
+     ;; be done in a minor-mode (like edebug does) so that the user
+     ;; isn't blocked from doing anything else.
+     (concat (cider--debug-read-command) "\n")
+     (cider-stdin-handler buffer))))
+
+
+;;; User commands
+;;;###autoload
+(defun cider-debug-defun-at-point ()
+  "Instrument the top-level expression at point.
+If it is a defn, dispatch the instrumented definition. Otherwise,
+immediately evaluate the instrumented expression.
+
+While debugged code is being evaluated, the user is taken through the
+source code and displayed the value of various expressions. At each step,
+the following keys are available:
+    n: Next step
+    c: Continue without stopping
+    i: Inject a value at this point"
+  (interactive)
+  (cider--debug-init-connection)
+  (let* ((expression (cider-defun-at-point))
+         (eval-buffer (current-buffer))
+         (position (cider-defun-at-point-start-pos))
+         (prefix
+          (if (string-match "\\`(defn-? " expression)
+              "Instrumented => " "=> "))
+         (instrumented (format cider--instrument-format
+                         (buffer-file-name)
+                         position
+                         expression)))
+    ;; Once the code has been instrumented, it can be sent as a
+    ;; regular evaluation. Any debug messages will be received by the
+    ;; callback specified in `cider--debug-init-connection'.
+    (cider-interactive-source-tracking-eval
+     instrumented position
+     (nrepl-make-response-handler (current-buffer)
+                                  (lambda (_buffer value)
+                                    (let ((cider-interactive-eval-result-prefix prefix))
+                                      (cider--display-interactive-eval-result value)))
+                                  ;; Below is the default for `cider-interactive-source-tracking-eval'.
+                                  (lambda (_buffer out)
+                                    (cider-emit-interactive-eval-output out))
+                                  (lambda (_buffer err)
+                                    (cider-emit-interactive-eval-err-output err)
+                                    (cider-handle-compilation-errors err eval-buffer))
+                                  '()))))
+
+(provide 'cider-debug)
+;;; cider-debug.el ends here
diff --git a/cider-interaction.el b/cider-interaction.el
index f2f8b5e4..829e693b 100644
--- a/cider-interaction.el
+++ b/cider-interaction.el
@@ -1558,12 +1558,16 @@ Print its value into the current buffer."
 
 (defun cider-eval-defun-at-point (&optional prefix)
   "Evaluate the current toplevel form, and print result in the minibuffer.
-With a PREFIX argument, print the result in the current buffer."
+With a PREFIX argument, debug the form instead by invoking
+`cider-debug-defun-at-point'."
   (interactive "P")
-  (cider-interactive-source-tracking-eval
-   (cider-defun-at-point)
-   (cider-defun-at-point-start-pos)
-   (when prefix (cider-eval-print-handler))))
+  (if prefix
+      (progn (require 'cider-debug)
+             (cider-debug-defun-at-point))
+    (cider-interactive-source-tracking-eval
+     (cider-defun-at-point)
+     (cider-defun-at-point-start-pos)
+     (when prefix (cider-eval-print-handler)))))
 
 (defun cider-pprint-eval-defun-at-point ()
   "Evaluate the top-level form at point and pprint its value in a popup buffer."
diff --git a/cider-mode.el b/cider-mode.el
index 7e68c2c4..5e546afd 100644
--- a/cider-mode.el
+++ b/cider-mode.el
@@ -123,6 +123,7 @@ entirely."
         ["Show test report" cider-test-show-report]
         "--"
         ["Inspect" cider-inspect]
+        ["Debug top-level form" cider-debug-defun-at-point]
         "--"
         ["Set ns" cider-repl-set-ns]
         ["Switch to REPL" cider-switch-to-repl-buffer]
diff --git a/cider.el b/cider.el
index e414bc8b..589146a2 100644
--- a/cider.el
+++ b/cider.el
@@ -65,6 +65,7 @@
 (require 'cider-repl)
 (require 'cider-mode)
 (require 'cider-util)
+(require 'cider-debug)
 (require 'tramp-sh)
 
 (defvar cider-version "0.9.0-snapshot"
diff --git a/nrepl-client.el b/nrepl-client.el
index 4973c291..2f54398b 100644
--- a/nrepl-client.el
+++ b/nrepl-client.el
@@ -815,6 +815,23 @@ for functionality like pretty-printing won't clobber the values of *1, *2, etc."
 (defvar nrepl-err-handler 'cider-default-err-handler
   "Evaluation error handler.")
 
+(defvar-local nrepl--input-handler-queue (make-queue)
+  "A queue of handlers (functions) for incoming \"need-input\" messages.
+Functions are passed the connection buffer as the only argument and should
+send a string to stdin on that connection. See `cider-need-input' for an
+example.
+
+This variable is designed as a queue, so new elements should be added to
+the bottom using `nrepl-push-input-handler', and they are removed from the
+top when used. Whenever the variable is nil, `cider-need-input' is used.")
+
+(defun nrepl-push-input-handler (function buffer)
+  "Add FUNCTION to input handlers queue on BUFFER's connection.
+FUNCTION is added to the bottom of `nrepl--input-handler-queue'."
+  (with-current-buffer buffer
+    (with-current-buffer (nrepl-current-connection-buffer)
+      (queue-enqueue nrepl--input-handler-queue function))))
+
 (defun nrepl-make-response-handler (buffer value-handler stdout-handler
                                            stderr-handler done-handler
                                            &optional eval-error-handler)
@@ -859,7 +876,12 @@ server responses."
              (when (member "namespace-not-found" status)
                (message "Namespace not found."))
              (when (member "need-input" status)
-               (cider-need-input buffer))
+               (let ((handler
+                      (with-current-buffer buffer
+                        (with-current-buffer (nrepl-current-connection-buffer)
+                          (or (queue-dequeue nrepl--input-handler-queue)
+                              #'cider-need-input)))))
+                 (funcall handler buffer)))
              (when (member "done" status)
                (puthash id (gethash id nrepl-pending-requests) nrepl-completed-requests)
                (remhash id nrepl-pending-requests)