Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Filter and control order of debugging prompt overlay commands #2731

Merged
merged 4 commits into from
Oct 19, 2019
Merged

Filter and control order of debugging prompt overlay commands #2731

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
b21ad47
Use list of debugging commands instead of dictionary
yuhan0 Oct 14, 2019
e193905
Change format of cider-debug-prompt-commands
yuhan0 Oct 17, 2019
faa8568
Memoize text formatting of debugger prompt
yuhan0 Oct 17, 2019
c948c39
Update tests for cider--debug-prompt
yuhan0 Oct 14, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
83 changes: 59 additions & 24 deletions cider-debug.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -185,10 +185,6 @@ configure `cider-debug-prompt' instead."


;;; Minor mode
(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
"Response that triggered current debug session.
Set by `cider--turn-on-debug-mode'.")
Expand All @@ -200,6 +196,34 @@ Can be toggled at any time with `\\[cider-debug-toggle-locals]'."
:group 'cider-debug
:package-version '(cider . "0.10.0"))

(defcustom cider-debug-prompt-commands
'((?c "continue" "continue")
(?C "continue-all" nil)
(?n "next" "next")
(?i "in" "in")
(?o "out" "out")
(?h "here" "here")
(?e "eval" "eval")
(?p "inspect" "inspect")
(?l "locals" "locals")
(?j "inject" "inject")
(?s "stacktrace" "stacktrace")
(?t "trace" "trace")
(?q "quit" "quit"))
"A list of debugger command specs in the format
(KEY COMMAND-NAME DISPLAY-NAME?)
where KEY is a character which is mapped to the command
COMMAND-NAME is a valid debug command to be passed to the cider-nrepl middleware
DISPLAY-NAME is the string displayed in the debugger overlay

If DISPLAY-NAME is nil, that command is hidden from the overlay but still callable.
The rest of the commands are displayed in the same order as this list."
:type '(alist :key-type character
:value-type (list
(string :tag "command name")
(choice (string :tag "display name") nil)))
:group 'cider-debug)

(defun cider--debug-format-locals-list (locals)
"Return a string description of list LOCALS.
Each element of LOCALS should be a list of at least two elements."
Expand All @@ -214,24 +238,35 @@ Each element of LOCALS should be a list of at least two elements."
locals ""))
""))

(defun cider--debug-prompt (command-dict)
"Return prompt to display for COMMAND-DICT."
(defun cider--debug-propertize-prompt-commands ()
"In-place formatting of the command display names for the cider-debug-prompt overlay"
(mapc (lambda (spec)
(cl-destructuring-bind (char cmd disp-name) spec
(when-let* ((pos (cl-position char disp-name)))
(put-text-property pos (1+ pos) 'face 'cider-debug-prompt-face disp-name))))
cider-debug-prompt-commands))

(defun cider--debug-prompt (commands)
"Return prompt to display for COMMANDS"
;; Force `default' face, otherwise the overlay "inherits" the face of the text
;; after it.
(format (propertize "%s\n" 'face 'default)
(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)
" ")))
(cl-reduce
(lambda (prompt spec)
(cl-destructuring-bind (char cmd disp) spec
(if (and disp (cl-find cmd commands :test 'string=))
(concat prompt " " disp)
prompt)))
cider-debug-prompt-commands
:initial-value "")))

(defvar-local cider--debug-prompt-overlay nil)

(defun cider--debug-mode-redisplay ()
"Display the input prompt to the user."
(nrepl-dbind-response cider--debug-mode-response (debug-value input-type locals)
;; input-type is an unsorted collection of command names,
;; as sent by `cider.nrepl.middleware.debug/read-debug-input`
(when (or (eq cider-debug-prompt t)
(eq cider-debug-prompt 'overlay))
(if (overlayp cider--debug-prompt-overlay)
Expand Down Expand Up @@ -310,14 +345,16 @@ In order to work properly, this mode must be activated by
(setq cider-interactive-eval-override
(apply-partially #'cider--debug-lexical-eval
(nrepl-dict-get cider--debug-mode-response "key")))
;; Set the keymap.
(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)
;; Map over the key->command alist and set the keymap
(mapc
(lambda (p)
(let ((char (car p)) (cmd (cdr p)))
(unless (= char ?h) ; `here' needs a special command.
(define-key cider--debug-mode-map (string char) #'cider-debug-mode-send-reply))
(when (= char ?o)
(define-key cider--debug-mode-map (string (upcase ?o)) #'cider-debug-mode-send-reply))))
cider-debug-prompt-commands)
(cider--debug-propertize-prompt-commands)
;; Show the prompt.
(cider--debug-mode-redisplay)
;; If a sync request is ongoing, the user can't act normally to
Expand All @@ -329,7 +366,6 @@ 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-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
Expand Down Expand Up @@ -402,8 +438,7 @@ message."
(if (symbolp last-command-event)
(symbol-name last-command-event)
(ignore-errors
(concat ":" (nrepl-dict-get cider--debug-mode-commands-dict
(string last-command-event)))))
(concat ":" (cadr (assoc last-command-event cider-debug-prompt-commands)))))
nil
(cider--uppercase-command-p)))
(when (and (string-prefix-p ":" command) force)
Expand Down
67 changes: 45 additions & 22 deletions test/cider-debug-tests.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,28 +33,51 @@

(describe "cider--debug-prompt"
(it "changes the font face to `cider-debug-prompt-face' for the first char"
(expect (equal-including-properties
(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)
2 3 (face cider-debug-prompt-face)
3 4 (face default)
4 5 (face cider-debug-prompt-face)
5 6 (face default)))))

(it "handles multiple chars not separated by spaces"
(expect (equal-including-properties
(cider--debug-prompt (nrepl-dict "a" "abc" "b" "cba"))
#("abc cba\n"
0 1 (face cider-debug-prompt-face)
1 5 (face default)
5 6 (face cider-debug-prompt-face)
6 8 (face default))))

(expect (equal-including-properties
(cider--debug-prompt (nrepl-dict "a" "abc"))
#("abc\n" 0 1 (face cider-debug-prompt-face) 1 4 (face default))))))
(let ((cider-debug-prompt-commands '((?a "abc" "abc") (?x "xyz" "xyz"))))
(cider--debug-propertize-prompt-commands)
(expect (equal-including-properties
(cider--debug-prompt '("abc" "xyz"))
#(" abc xyz\n"
0 1 (face default)
1 2 (face cider-debug-prompt-face)
2 5 (face default)
5 6 (face cider-debug-prompt-face)
6 9 (face default))))))

(it "Uses the display name and handles multiple chars not separated by spaces"
(let ((cider-debug-prompt-commands '((?a "abc" "cba") (?x "xyz" "yxz"))))
(cider--debug-propertize-prompt-commands)
(expect (equal-including-properties
(cider--debug-prompt '("abc" "xyz"))
#(" cba yxz\n"
0 3 (face default)
3 4 (face cider-debug-prompt-face)
4 6 (face default)
6 7 (face cider-debug-prompt-face)
7 9 (face default))))
(expect (equal-including-properties
(cider--debug-prompt '("abc"))
#(" cba\n"
0 3 (face default)
3 4 (face cider-debug-prompt-face)
4 5 (face default))))))

(it "filters and displays commands in the order specified by cider-debug-prompt-commands"
(let ((cider-debug-prompt-commands '((?a "abc" "abc")
(?z "xyz" "xyz")
(?d "def" nil)
(?g "ghi" "ghi"))))
(cider--debug-propertize-prompt-commands)
(expect (equal-including-properties
(cider--debug-prompt '("ghi" "def" "abc" "pqr" "xyz" ))
#(" abc xyz ghi\n"
0 1 (face default)
1 2 (face cider-debug-prompt-face)
2 7 (face default)
7 8 (face cider-debug-prompt-face)
8 9 (face default)
9 10 (face cider-debug-prompt-face)
10 13 (face default)))))))

(describe "cider--debug-move-point"
(it "navigates the clojure sexp's guided by the given coordinates"
Expand Down