Merge pull request #4076 from clojure-emacs/debugger-cleanup

bbatsov · web-flow · commit 5dceb6ce1138 · 2026-07-05T16:46:36.000+03:00
Clean up the debugger menus and fix the force step-out key
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -45,6 +45,8 @@
 
 ### Bugs fixed
 
+- Fix the debugger's `O` (force step-out) key, which aborted the session with an error because it sent an invalid `:force-out` command instead of a forced `:out`.
+- Fix the debugger's menu-bar menu: it advertised the wrong key for "Inject value" (`i` instead of `j`) and was missing entries for stepping in, showing the stacktrace, and tracing.
 - Fix `cider-log-kill-appender`'s confirmation message, which had the appender and framework names swapped.
 - [#4066](https://github.com/clojure-emacs/cider/pull/4066): Jump to the actual source when clicking a stack frame for a top-level anonymous function (the `deftest` shape), instead of landing in `clojure.core/fn` ([#3157](https://github.com/clojure-emacs/cider/issues/3157)).
 - [#4058](https://github.com/clojure-emacs/cider/pull/4058): Signal a helpful error when `cider-javadoc` gets an unresolvable (non-absolute) Javadoc URL from the middleware, instead of silently doing nothing ([#2969](https://github.com/clojure-emacs/cider/issues/2969)).
diff --git a/lisp/cider-debug.el b/lisp/cider-debug.el
@@ -186,7 +186,10 @@ Can be toggled at any time with `\\[cider-debug-toggle-locals]'."
     (?n "next" "next")
     (?i "in" "in")
     (?o "out" "out")
-    (?O "force-out" nil)
+    ;; Force-out is not a distinct middleware command: it's `out' sent with a
+    ;; `force?' flag, which `cider-debug-mode-send-reply' adds because the key
+    ;; is uppercase.
+    (?O "out" nil)
     (?h "here" "here")
     (?e "eval" "eval")
     (?p "inspect" "inspect")
@@ -394,31 +397,60 @@ In order to work properly, this mode must be activated by
   (setq cider-debug-prompt value)
   (cider--debug-mode-redisplay))
 
+;; The command catalog is the single source of truth for both the menu-bar
+;; menu (`cider-debug-mode-menu') and the transient menu (`cider-debug-menu'),
+;; so the two can no longer drift apart.  It is wrapped in `eval-and-compile'
+;; because the transient prefix is generated from it at macroexpansion time.
+(eval-and-compile
+  (defconst cider--debug-commands
+    '((?n cider-debug-next         "Next step"                         stepping)
+      (?i cider-debug-in           "Step in"                           stepping)
+      (?o cider-debug-out          "Step out"                          stepping)
+      (?O cider-debug-force-out    "Step out (skip breakpoints)"       stepping)
+      (?h cider-debug-move-here    "Continue to point"                 stepping)
+      (?c cider-debug-continue     "Continue"                          stepping)
+      (?C cider-debug-continue-all "Continue non-stop"                 stepping)
+      (?e cider-debug-eval         "Eval in debug scope"               values)
+      (?j cider-debug-inject       "Inject value"                      values)
+      (?p cider-debug-inspect      "Inspect current value"             values)
+      (?P cider-debug-inspect-expr "Inspect expression"                values)
+      (?l cider-debug-locals       "Inspect locals"                    values)
+      (?L cider-debug-toggle-locals "Toggle locals display"            values)
+      (?s cider-debug-stacktrace   "Show stacktrace"                   session)
+      (?t cider-debug-trace        "Trace (continue, printing values)" session)
+      (?q cider-debug-quit         "Quit session"                      session))
+    "Catalog of the debugger's user-facing commands.
+Each entry is (KEY FUNCTION DESCRIPTION GROUP), where KEY is the character
+that invokes FUNCTION during a session, DESCRIPTION is the label shown in
+the menus, and GROUP is one of `stepping', `values', or `session'.")
+
+  (defun cider--debug-commands-in-group (group)
+    "Return the `cider--debug-commands' entries belonging to GROUP."
+    (seq-filter (pcase-lambda (`(,_key ,_fn ,_desc ,g)) (eq g group))
+                cider--debug-commands)))
+
+(defun cider--debug-menu-items (group)
+  "Return `easy-menu' items for the debugger commands in GROUP."
+  (mapcar (pcase-lambda (`(,key ,fn ,desc ,_group))
+            (vector desc fn :keys (string key)))
+          (cider--debug-commands-in-group group)))
+
 (easy-menu-define cider-debug-mode-menu cider--debug-mode-map
   "Menu for CIDER debug mode."
-  `("CIDER Debugger"
-    ["Next step" (cider-debug-mode-send-reply ":next") :keys "n"]
-    ["Continue" (cider-debug-mode-send-reply ":continue") :keys "c"]
-    ["Continue non-stop" (cider-debug-mode-send-reply ":continue-all") :keys "C"]
-    ["Move out of sexp" (cider-debug-mode-send-reply ":out") :keys "o"]
-    ["Forced move out of sexp" (cider-debug-mode-send-reply ":out" nil t) :keys "O"]
-    ["Move to current position" (cider-debug-mode-send-reply ":here") :keys "h"]
-    ["Quit" (cider-debug-mode-send-reply ":quit") :keys "q"]
-    "--"
-    ["Evaluate in current scope" (cider-debug-mode-send-reply ":eval") :keys "e"]
-    ["Inject value" (cider-debug-mode-send-reply ":inject") :keys "i"]
-    ["Inspect current value" (cider-debug-mode-send-reply ":inspect") :keys "p"]
-    ["Inspect expression" (cider-debug-mode-send-reply ":inspect-prompt") :keys "P"]
-    ["Inspect local variables" (cider-debug-mode-send-reply ":locals") :keys "l"]
-    "--"
-    ("Configure keys prompt"
-     ["Don't show keys"     (cider--debug-set-prompt nil)         :style toggle :selected (eq cider-debug-prompt nil)]
-     ["Show in minibuffer"  (cider--debug-set-prompt 'minibuffer) :style toggle :selected (eq cider-debug-prompt 'minibuffer)]
-     ["Show above function" (cider--debug-set-prompt 'overlay)    :style toggle :selected (eq cider-debug-prompt 'overlay)]
-     ["Show in both places" (cider--debug-set-prompt t)           :style toggle :selected (eq cider-debug-prompt t)]
-     "--"
-     ["List locals" cider-debug-toggle-locals :style toggle :selected cider-debug-display-locals])
-    ["Customize" (customize-group 'cider-debug)]))
+  (append
+   '("CIDER Debugger")
+   (cider--debug-menu-items 'stepping)
+   '("--")
+   (cider--debug-menu-items 'values)
+   '("--")
+   (cider--debug-menu-items 'session)
+   '("--")
+   '(("Configure keys prompt"
+      ["Don't show keys"     (cider--debug-set-prompt nil)         :style toggle :selected (eq cider-debug-prompt nil)]
+      ["Show in minibuffer"  (cider--debug-set-prompt 'minibuffer) :style toggle :selected (eq cider-debug-prompt 'minibuffer)]
+      ["Show above function" (cider--debug-set-prompt 'overlay)    :style toggle :selected (eq cider-debug-prompt 'overlay)]
+      ["Show in both places" (cider--debug-set-prompt t)           :style toggle :selected (eq cider-debug-prompt t)])
+     ["Customize" (customize-group 'cider-debug)])))
 
 ;; Named commands for the debugger replies, so they can be invoked outside
 ;; the single-key session bindings (M-x, the transient menu below, etc.).
@@ -493,33 +525,30 @@ In order to work properly, this mode must be activated by
   (interactive)
   (cider-debug-mode-send-reply ":quit"))
 
-(transient-define-prefix cider-debug-menu ()
-  "Transient menu for the CIDER debugger.
+(eval-and-compile
+  (defun cider--debug-transient-column (title group)
+    "Build a transient column vector titled TITLE for GROUP.
+The suffixes are derived from `cider--debug-commands'."
+    (apply #'vector title
+           (mapcar (pcase-lambda (`(,key ,fn ,desc ,_group))
+                     (list (string key) desc fn))
+                   (cider--debug-commands-in-group group)))))
+
+(defmacro cider--debug-define-menu ()
+  "Define the `cider-debug-menu' transient from `cider--debug-commands'."
+  `(transient-define-prefix cider-debug-menu ()
+     "Transient menu for the CIDER debugger.
 It groups and labels the debugger's single-key commands, so they can be
 discovered without memorizing the key prompt.  The sub-keys match the
 session bindings, so this menu is purely additive."
-  [["Stepping"
-    ("n" "Next step" cider-debug-next)
-    ("i" "Step in" cider-debug-in)
-    ("o" "Step out" cider-debug-out)
-    ("O" "Step out (skip breakpoints)" cider-debug-force-out)
-    ("h" "Continue to point" cider-debug-move-here)
-    ("c" "Continue" cider-debug-continue)
-    ("C" "Continue non-stop" cider-debug-continue-all)]
-   ["Values"
-    ("e" "Eval in debug scope" cider-debug-eval)
-    ("j" "Inject value" cider-debug-inject)
-    ("p" "Inspect current value" cider-debug-inspect)
-    ("P" "Inspect expression" cider-debug-inspect-expr)
-    ("l" "Inspect locals" cider-debug-locals)
-    ("L" "Toggle locals display" cider-debug-toggle-locals)]
-   ["Session"
-    ("s" "Show stacktrace" cider-debug-stacktrace)
-    ("t" "Trace (continue, printing values)" cider-debug-trace)
-    ("q" "Quit session" cider-debug-quit)]]
-  ;; Uppercase `here', preserving the H binding's forced variant.
-  [:hide (lambda () t)
-   ("H" "Continue to point (forced)" cider-debug-move-here)])
+     [,(cider--debug-transient-column "Stepping" 'stepping)
+      ,(cider--debug-transient-column "Values" 'values)
+      ,(cider--debug-transient-column "Session" 'session)]
+     ;; Uppercase `here', preserving the H binding's forced variant.
+     [:hide (lambda () t)
+      ("H" "Continue to point (forced)" cider-debug-move-here)]))
+
+(cider--debug-define-menu)
 
 (defun cider--uppercase-command-p ()
   "Return non-nil if the last command was uppercase letter."
diff --git a/test/cider-debug-tests.el b/test/cider-debug-tests.el
@@ -179,6 +179,29 @@
       (cider--debug-move-point '(3 2 1))
       (expect (thing-at-point 'symbol) :to-equal "x"))))
 
+(describe "cider--debug-find-coordinates-for-point"
+  ;; `cider--debug-find-coordinates-for-point' is the inverse of
+  ;; `cider--debug-move-point', so feeding its result back into the latter
+  ;; must land on the same spot.
+  (it "round-trips with cider--debug-move-point"
+    ;; Each form is paired with coordinates known to be valid for it.
+    (dolist (case '(("(defn a [] (let [x 1] (inc x)) {:a 1, :b 2})" (3 2 1) (3 1 1) (2))
+                    ("(defn f [y] (+ (* y 2) (- y 3)))" (3 2 1) (3 1 1))
+                    ("(let [x (atom 1)] @x)" (2 1))
+                    ("(do @(do (atom {})))" (1 1 1))))
+      (let ((form (car case)))
+        (dolist (coord (cdr case))
+          (with-temp-buffer
+            (clojure-mode)
+            (save-excursion (insert form))
+            (cider--debug-move-point coord)
+            (let ((target (point)))
+              (goto-char (point-min))
+              (let ((found (cider--debug-find-coordinates-for-point target)))
+                (goto-char (point-min))
+                (cider--debug-move-point found)
+                (expect (point) :to-equal target)))))))))
+
 (describe "cider--debug-remember-origin"
   (before-each
     (setq cider--debug-origin-marker nil
@@ -260,16 +283,40 @@
 
   (it "send a forced :out for `cider-debug-force-out'"
     (cider-debug-force-out)
-    (expect 'cider-debug-mode-send-reply :to-have-been-called-with ":out" nil t))
-
-  (it "cover every command char of `cider-debug-prompt-commands'"
-    ;; `here' is handled by `cider-debug-move-here'; the rest map to named
-    ;; commands, so the transient menu can offer the full command set.
-    (dolist (cmd '(cider-debug-continue cider-debug-continue-all
-                   cider-debug-next cider-debug-in cider-debug-out
-                   cider-debug-force-out cider-debug-eval
-                   cider-debug-inspect cider-debug-inspect-expr
-                   cider-debug-locals cider-debug-inject
-                   cider-debug-stacktrace cider-debug-trace
-                   cider-debug-quit))
-      (expect (commandp cmd) :to-be-truthy))))
+    (expect 'cider-debug-mode-send-reply :to-have-been-called-with ":out" nil t)))
+
+(describe "cider-debug-mode-send-reply"
+  (it "sends a forced :out for the uppercase O key, not an invalid :force-out"
+    ;; The middleware has no `:force-out' command; force-out is `:out' with a
+    ;; `force?' flag, keyed off the uppercase letter.
+    (spy-on 'cider-nrepl-send-unhandled-request)
+    (let ((last-command-event ?O)
+          (cider--debug-mode-response (nrepl-dict "key" "the-key")))
+      (call-interactively 'cider-debug-mode-send-reply)
+      (let ((request (car (spy-calls-args-for 'cider-nrepl-send-unhandled-request 0))))
+        (expect (cadr (member "input" request)) :to-equal "{:response :out :force? true}")
+        (expect (cadr (member "key" request)) :to-equal "the-key"))))
+
+  (it "expose every catalog command as a callable command"
+    ;; Every entry in `cider--debug-commands' feeds the menus, so its
+    ;; function must be an actual command.
+    (pcase-dolist (`(,_key ,fn ,_desc ,_group) cider--debug-commands)
+      (expect (commandp fn) :to-be-truthy))))
+
+(describe "cider--debug-commands"
+  (it "covers every command in `cider-debug-prompt-commands'"
+    ;; The catalog drives the menus; the prompt commands drive the overlay
+    ;; and the session keymap.  Every prompt command must therefore have a
+    ;; catalog entry, so a command can never appear in one surface but not
+    ;; the others.
+    (let ((catalog-keys (mapcar #'car cider--debug-commands)))
+      (dolist (spec cider-debug-prompt-commands)
+        (expect (memq (car spec) catalog-keys) :to-be-truthy))))
+
+  (it "groups every entry under a known group"
+    (pcase-dolist (`(,_key ,_fn ,_desc ,group) cider--debug-commands)
+      (expect (memq group '(stepping values session)) :to-be-truthy)))
+
+  (it "binds each key to a distinct command"
+    (let ((keys (mapcar #'car cider--debug-commands)))
+      (expect (length keys) :to-equal (length (seq-uniq keys))))))
