Debugger: step-in (#1660)

This is the front-end part of step-in for the debugger.

See: clojure-emacs/cider-nrepl#335

There are two changes here:

- Attempt to find the source file when debugging, rather than popping up
  a debug buffer. This is because with step-in, we can no longer assume
  that functions being debugged have been opened and manually
  instrumented by the user
- Expect the list of debugger commands, which is sent as `input-type`,
  to be an nrepl-dict mapping keys to commands, rather than a list of
  commands.

Author: grammati

CHANGELOG.md

@@ -4,6 +4,7 @@
 
 ### New Features
 
+* Debugger now supports step-in.
 * Improve CIDER's menu-bar menu:
   - Thoroughly reorganize it and split it into 3 separate menus;
   - Add custom-written `:help` strings to some items, and automatically add help strings to the rest;

cider-debug.el

@@ -185,8 +185,8 @@ This variable must be set before starting the repl connection."
 
 
 ;;; Minor mode
-(defvar-local cider--debug-mode-commands-alist nil
-  "Alist from keys to debug commands.
+(defvar-local cider--debug-mode-commands-dict nil
+  "An nrepl-dict from keys to debug commands.
 Autogenerated by `cider--turn-on-debug-mode'.")
 
 (defvar-local cider--debug-mode-response nil
@@ -214,16 +214,18 @@ Each element of LOCALS should be a list of at least two elements."
                    locals ""))
     ""))
 
-(defun cider--debug-prompt (command-list)
-  "Return prompt to display for COMMAND-LIST."
+(defun cider--debug-prompt (command-dict)
+  "Return prompt to display for COMMAND-DICT."
   ;; Force `default' face, otherwise the overlay "inherits" the face of the text
   ;; after it.
-  (format (propertize "%s" 'face 'default)
-          (concat
-           (mapconcat (lambda (x) (put-text-property 0 1 'face 'cider-debug-prompt-face x) x)
-                      command-list
-                      " ")
-           "\n")))
+  (format (propertize "%s\n" 'face 'default)
+          (cider-string-join
+           (nrepl-dict-map (lambda (char cmd)
+                             (when-let ((pos (cl-search char cmd)))
+                               (put-text-property pos (1+ pos) 'face 'cider-debug-prompt-face cmd))
+                             cmd)
+                           command-dict)
+           " ")))
 
 (defvar-local cider--debug-prompt-overlay nil)
 
@@ -299,10 +301,6 @@ In order to work properly, this mode must be activated by
             ;; A debug session is an ongoing eval, but it's annoying to have the
             ;; spinner spinning while you debug.
             (when spinner-current (spinner-stop))
-            ;; `inspect' would conflict with `inject', so there's no key for it.
-            (setq input-type (seq-difference input-type '("inspect")))
-            (nrepl-dict-put cider--debug-mode-response "input-type" input-type)
-
             (setq-local tool-bar-map cider--debug-mode-tool-bar-map)
             (add-hook 'kill-buffer-hook #'cider--debug-quit nil 'local)
             (add-hook 'before-revert-hook #'cider--debug-quit nil 'local)
@@ -313,13 +311,13 @@ In order to work properly, this mode must be activated by
                   (apply-partially #'cider--debug-lexical-eval
                                    (nrepl-dict-get cider--debug-mode-response "key")))
             ;; Set the keymap.
-            (let ((alist (mapcar (lambda (k) (cons (string-to-char k) (concat ":" k)))
-                                 ;; `here' needs a special command.
-                                 (seq-difference input-type '("here")))))
-              (setq cider--debug-mode-commands-alist alist)
-              (dolist (it alist)
-                (define-key cider--debug-mode-map (vector (upcase (car it))) #'cider-debug-mode-send-reply)
-                (define-key cider--debug-mode-map (vector (car it)) #'cider-debug-mode-send-reply)))
+            (nrepl-dict-map (lambda (char cmd)
+                              (unless (string= char "h") ; `here' needs a special command.
+                                (define-key cider--debug-mode-map char #'cider-debug-mode-send-reply))
+                              (when (string= char "o")
+                                (define-key cider--debug-mode-map (upcase char) #'cider-debug-mode-send-reply)))
+                            input-type)
+            (setq cider--debug-mode-commands-dict input-type)
             ;; Show the prompt.
             (cider--debug-mode-redisplay)
             ;; If a sync request is ongoing, the user can't act normally to
@@ -331,7 +329,7 @@ In order to work properly, this mode must be activated by
             (user-error (substitute-command-keys "Don't call this mode manually, use `\\[universal-argument] \\[cider-eval-defun-at-point]' instead"))
           (error "Attempt to activate `cider--debug-mode' without setting `cider--debug-mode-response' first")))
     (setq cider-interactive-eval-override nil)
-    (setq cider--debug-mode-commands-alist nil)
+    (setq cider--debug-mode-commands-dict nil)
     (setq cider--debug-mode-response nil)
     ;; We wait a moment before clearing overlays and the read-onlyness, so that
     ;; cider-nrepl has a chance to send the next message, and so that the user
@@ -394,12 +392,15 @@ message."
                 (if (symbolp last-command-event)
                     (symbol-name last-command-event)
                   (ignore-errors
-                    (cdr (assq (downcase last-command-event)
-                               cider--debug-mode-commands-alist))))
+                    (nrepl-dict-get cider--debug-mode-commands-dict
+                                    (downcase (string last-command-event)))))
                 nil
                 (ignore-errors
                   (let ((case-fold-search nil))
                     (string-match "[[:upper:]]" (string last-command-event))))))
+  (unless (or (string-prefix-p ":" command)
+              (string-prefix-p "{" command))
+    (setq command (concat ":" command)))
   (cider-nrepl-send-unhandled-request
    (append (list "op" "debug-input" "input" (or command ":quit")
                  "key" (or key (nrepl-dict-get cider--debug-mode-response "key")))
@@ -566,10 +567,12 @@ is a coordinate measure in sexps."
         (let ((out))
           ;; We prefer in-source debugging.
           (when-let ((buf (and file line column
-                               (find-buffer-visiting file))))
+                               (ignore-errors
+                                 (cider--jump-to-loc-from-info response)
+                                 (current-buffer)))))
             ;; The logic here makes it hard to use `with-current-buffer'.
             (with-current-buffer buf
-              ;; This is for retoring point inside buf.
+              ;; This is for restoring point inside buf.
               (save-excursion
                 ;; Get to the proper line & column in the file
                 (forward-line (- line (line-number-at-pos)))

test/cider-tests.el

@@ -39,7 +39,7 @@
 
 (ert-deftest test-debug-prompt ()
   (should (equal-including-properties
-           (cider--debug-prompt '("a" "b" "c"))
+           (cider--debug-prompt (nrepl-dict "a" "a" "b" "b" "c" "c"))
            #("a b c\n"
              0 1 (face cider-debug-prompt-face)
              1 2 (face default)
@@ -48,14 +48,14 @@
              4 5 (face cider-debug-prompt-face)
              5 6 (face default))))
   (should (equal-including-properties
-           (cider--debug-prompt '("a" "bc"))
-           #("a bc\n"
+           (cider--debug-prompt (nrepl-dict "a" "abc" "b" "cba"))
+           #("abc cba\n"
              0 1 (face cider-debug-prompt-face)
-             1 2 (face default)
-             2 3 (face cider-debug-prompt-face)
-             3 5 (face default))))
+             1 5 (face default)
+             5 6 (face cider-debug-prompt-face)
+             6 8 (face default))))
   (should (equal-including-properties
-           (cider--debug-prompt '("abc"))
+           (cider--debug-prompt (nrepl-dict "a" "abc"))
            #("abc\n" 0 1 (face cider-debug-prompt-face) 1 4 (face default)))))
 
 (ert-deftest test-debug-move-point ()