diff options
| -rw-r--r-- | CHANGELOG.md | 1 | ||||
| -rw-r--r-- | cider-debug.el | 55 | ||||
| -rw-r--r-- | test/cider-tests.el | 14 |
3 files changed, 37 insertions, 33 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index fe39d726..85ba0676 100644 --- a/CHANGELOG.md +++ b/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; diff --git a/cider-debug.el b/cider-debug.el index 6afa8999..031dda13 100644 --- a/cider-debug.el +++ b/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))) diff --git a/test/cider-tests.el b/test/cider-tests.el index 3e77cdc8..e7c533f3 100644 --- a/test/cider-tests.el +++ b/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 () |