|
|
|
|
|
;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware -*- lexical-binding: t; -*-
|
|
|
|
|
|
|
|
|
|
|
|
;; Copyright © 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)
|
|
|
|
|
|
(require 'cider-client)
|
|
|
|
|
|
(require 'cider-util)
|
|
|
|
|
|
(require 'cider-inspector)
|
|
|
|
|
|
(require 'cider-browse-ns)
|
|
|
|
|
|
(require 'cider-common)
|
|
|
|
|
|
(require 'cider-compat)
|
|
|
|
|
|
(require 'seq)
|
|
|
|
|
|
(require 'spinner)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Customization
|
|
|
|
|
|
(defgroup cider-debug nil
|
|
|
|
|
|
"Presentation and behaviour of the cider debugger."
|
|
|
|
|
|
:prefix "cider-debug-"
|
|
|
|
|
|
:group 'cider
|
|
|
|
|
|
:package-version '(cider . "0.10.0"))
|
|
|
|
|
|
|
|
|
|
|
|
(defface cider-debug-code-overlay-face
|
|
|
|
|
|
'((((class color) (background light)) :background "grey80")
|
|
|
|
|
|
(((class color) (background dark)) :background "grey30"))
|
|
|
|
|
|
"Face used to mark code being debugged."
|
|
|
|
|
|
:group 'cider-debug
|
|
|
|
|
|
:package-version '(cider . "0.9.1"))
|
|
|
|
|
|
|
|
|
|
|
|
(defface cider-debug-prompt-face
|
|
|
|
|
|
'((t :underline t :inherit font-lock-builtin-face))
|
|
|
|
|
|
"Face used to highlight keys in the debug prompt."
|
|
|
|
|
|
:group 'cider-debug
|
|
|
|
|
|
:package-version '(cider . "0.10.0"))
|
|
|
|
|
|
|
|
|
|
|
|
(defface cider-instrumented-face
|
|
|
|
|
|
'((t :box (:color "red" :line-width -1)))
|
|
|
|
|
|
"Face used to mark code being debugged."
|
|
|
|
|
|
:group 'cider-debug
|
|
|
|
|
|
:package-version '(cider . "0.10.0"))
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom cider-debug-prompt 'overlay
|
|
|
|
|
|
"If and where to show the keys while debugging.
|
|
|
|
|
|
If `minibuffer', show it in the minibuffer along with the return value.
|
|
|
|
|
|
If `overlay', show it in an overlay above the current function.
|
|
|
|
|
|
If t, do both.
|
|
|
|
|
|
If nil, don't list available keys at all."
|
|
|
|
|
|
:type '(choice (const :tag "Show in minibuffer" minibuffer)
|
|
|
|
|
|
(const :tag "Show above function" overlay)
|
|
|
|
|
|
(const :tag "Show in both places" t)
|
|
|
|
|
|
(const :tag "Don't list keys" nil))
|
|
|
|
|
|
:group 'cider-debug
|
|
|
|
|
|
:package-version '(cider . "0.10.0"))
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom cider-debug-use-overlays t
|
|
|
|
|
|
"Whether to higlight debugging information with overlays.
|
|
|
|
|
|
Takes the same possible values as `cider-use-overlays', but only applies to
|
|
|
|
|
|
values displayed during debugging sessions.
|
|
|
|
|
|
To control the overlay that lists possible keys above the current function,
|
|
|
|
|
|
configure `cider-debug-prompt' instead."
|
|
|
|
|
|
:type '(choice (const :tag "End of line" t)
|
|
|
|
|
|
(const :tag "Bottom of screen" nil)
|
|
|
|
|
|
(const :tag "Both" both))
|
|
|
|
|
|
:group 'cider-debug
|
|
|
|
|
|
:package-version '(cider . "0.9.1"))
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom cider-debug-print-level 10
|
|
|
|
|
|
"print-level for values displayed by the debugger.
|
|
|
|
|
|
This variable must be set before starting the repl connection."
|
|
|
|
|
|
:type '(choice (const :tag "No limit" nil)
|
|
|
|
|
|
(integer :tag "Max depth" 10))
|
|
|
|
|
|
:group 'cider-debug
|
|
|
|
|
|
:package-version '(cider . "0.10.0"))
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom cider-debug-print-length 10
|
|
|
|
|
|
"print-length for values displayed by the debugger.
|
|
|
|
|
|
This variable must be set before starting the repl connection."
|
|
|
|
|
|
:type '(choice (const :tag "No limit" nil)
|
|
|
|
|
|
(integer :tag "Max depth" 10))
|
|
|
|
|
|
:group 'cider-debug
|
|
|
|
|
|
:package-version '(cider . "0.10.0"))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Implementation
|
|
|
|
|
|
(defun cider-browse-instrumented-defs ()
|
|
|
|
|
|
"List all instrumented definitions."
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(if-let ((all (thread-first (cider-nrepl-send-sync-request (list "op" "debug-instrumented-defs"))
|
|
|
|
|
|
(nrepl-dict-get "list"))))
|
|
|
|
|
|
(with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t)
|
|
|
|
|
|
(let ((inhibit-read-only t))
|
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
|
(dolist (list all)
|
|
|
|
|
|
(let ((ns (car list)))
|
|
|
|
|
|
(cider-browse-ns--list (current-buffer) ns
|
|
|
|
|
|
(mapcar #'cider-browse-ns--properties (cdr list))
|
|
|
|
|
|
ns 'noerase)
|
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
|
(insert "\n"))))
|
|
|
|
|
|
(goto-char (point-min)))
|
|
|
|
|
|
(message "No currently instrumented definitions")))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-response-handler (response)
|
|
|
|
|
|
"Handle responses from the cider.debug middleware."
|
|
|
|
|
|
(nrepl-dbind-response response (status id causes)
|
|
|
|
|
|
(when (member "eval-error" status)
|
|
|
|
|
|
(cider--render-stacktrace-causes causes))
|
|
|
|
|
|
(when (member "need-debug-input" status)
|
|
|
|
|
|
(cider--handle-debug response))
|
|
|
|
|
|
(when (member "done" status)
|
|
|
|
|
|
(nrepl--mark-id-completed id))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-init-connection ()
|
|
|
|
|
|
"Initialize a connection with the cider.debug middleware."
|
|
|
|
|
|
(cider-nrepl-send-request
|
|
|
|
|
|
(append '("op" "init-debugger")
|
|
|
|
|
|
(when cider-debug-print-level
|
|
|
|
|
|
(list "print-level" cider-debug-print-level))
|
|
|
|
|
|
(when cider-debug-print-length
|
|
|
|
|
|
(list "print-length" cider-debug-print-length)))
|
|
|
|
|
|
#'cider--debug-response-handler))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Debugging overlays
|
|
|
|
|
|
(defconst cider--fringe-arrow-string
|
|
|
|
|
|
#("." 0 1 (display (left-fringe right-triangle)))
|
|
|
|
|
|
"Used as an overlay's before-string prop to place a fringe arrow.")
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-display-result-overlay (value)
|
|
|
|
|
|
"Place an overlay at point displaying VALUE."
|
|
|
|
|
|
(when cider-debug-use-overlays
|
|
|
|
|
|
;; This is cosmetic, let's ensure it doesn't break the session no matter what.
|
|
|
|
|
|
(ignore-errors
|
|
|
|
|
|
;; Result
|
|
|
|
|
|
(cider--make-result-overlay (cider-font-lock-as-clojure value)
|
|
|
|
|
|
:where (point-marker)
|
|
|
|
|
|
:type 'debug-result
|
|
|
|
|
|
'before-string cider--fringe-arrow-string)
|
|
|
|
|
|
;; Code
|
|
|
|
|
|
(cider--make-overlay (save-excursion (clojure-backward-logical-sexp 1) (point))
|
|
|
|
|
|
(point) 'debug-code
|
|
|
|
|
|
'face 'cider-debug-code-overlay-face
|
|
|
|
|
|
;; Higher priority than `show-paren'.
|
|
|
|
|
|
'priority 2000))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Minor mode
|
|
|
|
|
|
(defvar-local cider--debug-mode-commands-alist nil
|
|
|
|
|
|
"Alist 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'.")
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom cider-debug-display-locals nil
|
|
|
|
|
|
"If non-nil, local variables are displayed while debugging.
|
|
|
|
|
|
Can be toggled at any time with `\\[cider-debug-toggle-locals]'."
|
|
|
|
|
|
:type 'boolean
|
|
|
|
|
|
:group 'cider-debug
|
|
|
|
|
|
:package-version '(cider . "0.10.0"))
|
|
|
|
|
|
|
|
|
|
|
|
(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."
|
|
|
|
|
|
(if locals
|
|
|
|
|
|
(let ((left-col-width
|
|
|
|
|
|
;; To right-indent the variable names.
|
|
|
|
|
|
(apply #'max (mapcar (lambda (l) (string-width (car l))) locals))))
|
|
|
|
|
|
;; A format string to build a format string. :-P
|
|
|
|
|
|
(mapconcat (lambda (l) (format (format " %%%ds: %%s\n" left-col-width)
|
|
|
|
|
|
(propertize (car l) 'face 'font-lock-variable-name-face)
|
|
|
|
|
|
(cider-font-lock-as-clojure (cadr l))))
|
|
|
|
|
|
locals ""))
|
|
|
|
|
|
""))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-prompt (command-list)
|
|
|
|
|
|
"Return prompt to display for COMMAND-LIST."
|
|
|
|
|
|
(concat
|
|
|
|
|
|
(mapconcat (lambda (x) (put-text-property 0 1 'face 'cider-debug-prompt-face x) x)
|
|
|
|
|
|
;; `eval' is now integrated with things like `C-x C-e' and `C-c M-:'
|
|
|
|
|
|
;; so we don't advertise this key to reduce clutter.
|
|
|
|
|
|
;; `inspect' would conflict with `inject'.
|
|
|
|
|
|
(seq-difference command-list '("eval" "inspect")) " ")
|
|
|
|
|
|
"\n"))
|
|
|
|
|
|
|
|
|
|
|
|
(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)
|
|
|
|
|
|
(when (or (eq cider-debug-prompt t)
|
|
|
|
|
|
(eq cider-debug-prompt 'overlay))
|
|
|
|
|
|
(if (overlayp cider--debug-prompt-overlay)
|
|
|
|
|
|
(overlay-put cider--debug-prompt-overlay
|
|
|
|
|
|
'before-string (cider--debug-prompt input-type))
|
|
|
|
|
|
(setq cider--debug-prompt-overlay
|
|
|
|
|
|
(cider--make-overlay
|
|
|
|
|
|
(max (cider-defun-at-point-start-pos)
|
|
|
|
|
|
(window-start))
|
|
|
|
|
|
nil 'debug-prompt
|
|
|
|
|
|
'before-string (cider--debug-prompt input-type)))))
|
|
|
|
|
|
(let* ((value (concat " " cider-eval-result-prefix
|
|
|
|
|
|
(cider-font-lock-as-clojure
|
|
|
|
|
|
(or debug-value "#unknown#"))))
|
|
|
|
|
|
(to-display
|
|
|
|
|
|
(concat (when cider-debug-display-locals
|
|
|
|
|
|
(cider--debug-format-locals-list locals))
|
|
|
|
|
|
(when (or (eq cider-debug-prompt t)
|
|
|
|
|
|
(eq cider-debug-prompt 'minibuffer))
|
|
|
|
|
|
(cider--debug-prompt input-type))
|
|
|
|
|
|
(when (or (not cider-debug-use-overlays)
|
|
|
|
|
|
(eq cider-debug-use-overlays 'both))
|
|
|
|
|
|
value))))
|
|
|
|
|
|
(if (> (string-width to-display) 0)
|
|
|
|
|
|
(message "%s" to-display)
|
|
|
|
|
|
;; If there's nothing to display in the minibuffer. Just send the value
|
|
|
|
|
|
;; to the Messages buffer.
|
|
|
|
|
|
(message "%s" value)
|
|
|
|
|
|
(message nil)))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider-debug-toggle-locals ()
|
|
|
|
|
|
"Toggle display of local variables."
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(setq cider-debug-display-locals (not cider-debug-display-locals))
|
|
|
|
|
|
(cider--debug-mode-redisplay))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-lexical-eval (key form &optional callback _point)
|
|
|
|
|
|
"Eval FORM in the lexical context of debug session given by KEY.
|
|
|
|
|
|
Do nothing if CALLBACK is provided.
|
|
|
|
|
|
Designed to be used as `cider-interactive-eval-override' and called instead
|
|
|
|
|
|
of `cider-interactive-eval' in debug sessions."
|
|
|
|
|
|
;; The debugger uses its own callback, so if the caller is passing a callback
|
|
|
|
|
|
;; we return nil and let `cider-interactive-eval' do its thing.
|
|
|
|
|
|
(unless callback
|
|
|
|
|
|
(cider-debug-mode-send-reply (format "{:response :eval, :code %s}" form)
|
|
|
|
|
|
key)
|
|
|
|
|
|
t))
|
|
|
|
|
|
|
|
|
|
|
|
(defvar cider--debug-mode-tool-bar-map
|
|
|
|
|
|
(let ((tool-bar-map (make-sparse-keymap)))
|
|
|
|
|
|
(tool-bar-add-item "right-arrow" #'cider-debug-mode-send-reply :next :label "Next step")
|
|
|
|
|
|
(tool-bar-add-item "next-node" #'cider-debug-mode-send-reply :continue :label "Continue non-stop")
|
|
|
|
|
|
(tool-bar-add-item "jump-to" #'cider-debug-mode-send-reply :out :label "Out of sexp")
|
|
|
|
|
|
(tool-bar-add-item "exit" #'cider-debug-mode-send-reply :quit :label "Quit")
|
|
|
|
|
|
tool-bar-map))
|
|
|
|
|
|
|
|
|
|
|
|
(defvar cider--debug-mode-map)
|
|
|
|
|
|
|
|
|
|
|
|
(define-minor-mode cider--debug-mode
|
|
|
|
|
|
"Mode active during debug sessions.
|
|
|
|
|
|
In order to work properly, this mode must be activated by
|
|
|
|
|
|
`cider--turn-on-debug-mode'."
|
|
|
|
|
|
nil " DEBUG" '()
|
|
|
|
|
|
(if cider--debug-mode
|
|
|
|
|
|
(if cider--debug-mode-response
|
|
|
|
|
|
(nrepl-dbind-response cider--debug-mode-response (input-type)
|
|
|
|
|
|
;; A debug session is an ongoing eval, but it's annoying to have the
|
|
|
|
|
|
;; spinner spinning while you debug.
|
|
|
|
|
|
(when spinner-current (spinner-stop))
|
|
|
|
|
|
(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)
|
|
|
|
|
|
(unless (consp input-type)
|
|
|
|
|
|
(error "debug-mode activated on a message not asking for commands: %s" cider--debug-mode-response))
|
|
|
|
|
|
;; Integrate with eval commands.
|
|
|
|
|
|
(setq cider-interactive-eval-override
|
|
|
|
|
|
(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)))
|
|
|
|
|
|
(seq-difference input-type '("inspect")))))
|
|
|
|
|
|
(setq cider--debug-mode-commands-alist alist)
|
|
|
|
|
|
(dolist (it alist)
|
|
|
|
|
|
(define-key cider--debug-mode-map (vector (car it)) #'cider-debug-mode-send-reply)))
|
|
|
|
|
|
;; Show the prompt.
|
|
|
|
|
|
(cider--debug-mode-redisplay)
|
|
|
|
|
|
;; If a sync request is ongoing, the user can't act normally to
|
|
|
|
|
|
;; provide input, so we enter `recursive-edit'.
|
|
|
|
|
|
(when nrepl-ongoing-sync-request
|
|
|
|
|
|
(recursive-edit)))
|
|
|
|
|
|
(cider--debug-mode -1)
|
|
|
|
|
|
(if (called-interactively-p 'any)
|
|
|
|
|
|
(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-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
|
|
|
|
|
|
;; doesn't accidentally hit `n' between two messages (thus editing the code).
|
|
|
|
|
|
(when-let ((proc (unless nrepl-ongoing-sync-request
|
|
|
|
|
|
(get-buffer-process (cider-current-connection)))))
|
|
|
|
|
|
(accept-process-output proc 0.5))
|
|
|
|
|
|
(unless cider--debug-mode
|
|
|
|
|
|
(setq buffer-read-only nil)
|
|
|
|
|
|
(cider--debug-remove-overlays (current-buffer)))
|
|
|
|
|
|
(when nrepl-ongoing-sync-request
|
|
|
|
|
|
(ignore-errors (exit-recursive-edit)))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-remove-overlays (&optional buffer)
|
|
|
|
|
|
"Remove CIDER debug overlays from BUFFER if `cider--debug-mode' is nil."
|
|
|
|
|
|
(when (or (not buffer) (buffer-live-p buffer))
|
|
|
|
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
|
|
|
|
(unless cider--debug-mode
|
|
|
|
|
|
(kill-local-variable 'tool-bar-map)
|
|
|
|
|
|
(remove-overlays nil nil 'cider-type 'debug-result)
|
|
|
|
|
|
(remove-overlays nil nil 'cider-type 'debug-code)
|
|
|
|
|
|
(setq cider--debug-prompt-overlay nil)
|
|
|
|
|
|
(remove-overlays nil nil 'cider-type 'debug-prompt)))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-set-prompt (value)
|
|
|
|
|
|
"Set `cider-debug-prompt' to VALUE, then redisplay."
|
|
|
|
|
|
(setq cider-debug-prompt value)
|
|
|
|
|
|
(cider--debug-mode-redisplay))
|
|
|
|
|
|
|
|
|
|
|
|
(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 non-stop" (cider-debug-mode-send-reply ":continue") :keys "c"]
|
|
|
|
|
|
["Move out of sexp" (cider-debug-mode-send-reply ":out") :keys "o"]
|
|
|
|
|
|
["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 value" (cider-debug-mode-send-reply ":inspect")]
|
|
|
|
|
|
["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)]))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider-debug-mode-send-reply (command &optional key)
|
|
|
|
|
|
"Reply to the message that started current bufer's debugging session.
|
|
|
|
|
|
COMMAND is sent as the input option. KEY can be provided to reply to a
|
|
|
|
|
|
specific message."
|
|
|
|
|
|
(interactive (list
|
|
|
|
|
|
(if (symbolp last-command-event)
|
|
|
|
|
|
(symbol-name last-command-event)
|
|
|
|
|
|
(cdr (assq last-command-event cider--debug-mode-commands-alist)))
|
|
|
|
|
|
nil))
|
|
|
|
|
|
(cider-nrepl-send-unhandled-request
|
|
|
|
|
|
(list "op" "debug-input" "input" (or command ":quit")
|
|
|
|
|
|
"key" (or key (nrepl-dict-get cider--debug-mode-response "key"))))
|
|
|
|
|
|
(ignore-errors (cider--debug-mode -1)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-quit ()
|
|
|
|
|
|
"Send a :quit reply to the debugger. Used in hooks."
|
|
|
|
|
|
(when cider--debug-mode
|
|
|
|
|
|
(cider-debug-mode-send-reply ":quit")
|
|
|
|
|
|
(message "Quitting debug session")))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Movement logic
|
|
|
|
|
|
(defconst cider--debug-buffer-format "*cider-debug %s*")
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-trim-code (code)
|
|
|
|
|
|
(replace-regexp-in-string "\\`#\\(dbg\\|break\\) ?" "" code))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--initialize-debug-buffer (code ns id)
|
|
|
|
|
|
"Create a new debugging buffer with CODE and namespace NS.
|
|
|
|
|
|
ID is the id of the message that instrumented CODE."
|
|
|
|
|
|
(let ((buffer-name (format cider--debug-buffer-format id)))
|
|
|
|
|
|
(if-let ((buffer (get-buffer buffer-name)))
|
|
|
|
|
|
(cider-popup-buffer-display buffer 'select)
|
|
|
|
|
|
(with-current-buffer (cider-popup-buffer buffer-name 'select
|
|
|
|
|
|
#'clojure-mode 'ancillary)
|
|
|
|
|
|
(setq cider-buffer-ns ns)
|
|
|
|
|
|
(setq buffer-undo-list nil)
|
|
|
|
|
|
(let ((inhibit-read-only t)
|
|
|
|
|
|
(buffer-undo-list t))
|
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
|
(insert
|
|
|
|
|
|
(format "%s" (cider--debug-trim-code code)))
|
|
|
|
|
|
(cider--font-lock-ensure)
|
|
|
|
|
|
(set-buffer-modified-p nil))))
|
|
|
|
|
|
(switch-to-buffer buffer-name)
|
|
|
|
|
|
(goto-char (point-min))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-goto-keyval (key)
|
|
|
|
|
|
"Find KEY in current sexp or return nil."
|
|
|
|
|
|
(when-let ((limit (ignore-errors (save-excursion (up-list) (point)))))
|
|
|
|
|
|
(search-forward-regexp (concat "\\_<" (regexp-quote key) "\\_>")
|
|
|
|
|
|
limit 'noerror)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--debug-move-point (coordinates)
|
|
|
|
|
|
"Place point on POS in FILE, then navigate into the next sexp.
|
|
|
|
|
|
COORDINATES is a list of integers that specify how to navigate into the
|
|
|
|
|
|
sexp."
|
|
|
|
|
|
(condition-case-unless-debug nil
|
|
|
|
|
|
;; Navigate through sexps inside the sexp.
|
|
|
|
|
|
(let ((in-syntax-quote nil))
|
|
|
|
|
|
(while coordinates
|
|
|
|
|
|
(down-list)
|
|
|
|
|
|
;; Are we entering a syntax-quote?
|
|
|
|
|
|
(when (looking-back "`\\(#{\\|[{[(]\\)" (line-beginning-position))
|
|
|
|
|
|
;; If we are, this affects all nested structures until the next `~',
|
|
|
|
|
|
;; so we set this variable for all following steps in the loop.
|
|
|
|
|
|
(setq in-syntax-quote t))
|
|
|
|
|
|
(when in-syntax-quote
|
|
|
|
|
|
;; A `(. .) is read as (seq (concat (list .) (list .))). This pops
|
|
|
|
|
|
;; the `seq', since the real coordinates are inside the `concat'.
|
|
|
|
|
|
(pop coordinates)
|
|
|
|
|
|
;; Non-list seqs like `[] and `{} are read with
|
|
|
|
|
|
;; an extra (apply vector ...), so pop it too.
|
|
|
|
|
|
(unless (eq ?\( (char-before))
|
|
|
|
|
|
(pop coordinates)))
|
|
|
|
|
|
;; #(...) is read as (fn* ([] ...)), so we patch that here.
|
|
|
|
|
|
(when (looking-back "#(" (line-beginning-position))
|
|
|
|
|
|
(pop coordinates))
|
|
|
|
|
|
(if coordinates
|
|
|
|
|
|
(let ((next (pop coordinates)))
|
|
|
|
|
|
(when in-syntax-quote
|
|
|
|
|
|
;; We're inside the `concat' form, but we need to discard the
|
|
|
|
|
|
;; actual `concat' symbol from the coordinate.
|
|
|
|
|
|
(setq next (1- next)))
|
|
|
|
|
|
;; String coordinates are map keys.
|
|
|
|
|
|
(if (stringp next)
|
|
|
|
|
|
(cider--debug-goto-keyval next)
|
|
|
|
|
|
(clojure-forward-logical-sexp next)
|
|
|
|
|
|
(when in-syntax-quote
|
|
|
|
|
|
(clojure-forward-logical-sexp 1)
|
|
|
|
|
|
(forward-sexp -1)
|
|
|
|
|
|
;; Here a syntax-quote is ending.
|
|
|
|
|
|
(let ((match (when (looking-at "~@?")
|
|
|
|
|
|
(match-string 0))))
|
|
|
|
|
|
(when match
|
|
|
|
|
|
(setq in-syntax-quote nil))
|
|
|
|
|
|
;; A `~@' is read as the object itself, so we don't pop
|
|
|
|
|
|
;; anything.
|
|
|
|
|
|
(unless (equal "~@" match)
|
|
|
|
|
|
;; Anything else (including a `~') is read as a `list'
|
|
|
|
|
|
;; form inside the `concat', so we need to pop the list
|
|
|
|
|
|
;; from the coordinates.
|
|
|
|
|
|
(pop coordinates))))))
|
|
|
|
|
|
;; If that extra pop was the last coordinate, this represents the
|
|
|
|
|
|
;; entire #(...), so we should move back out.
|
|
|
|
|
|
(backward-up-list)))
|
|
|
|
|
|
;; Place point at the end of instrumented sexp.
|
|
|
|
|
|
(clojure-forward-logical-sexp 1))
|
|
|
|
|
|
;; Avoid throwing actual errors, since this happens on every breakpoint.
|
|
|
|
|
|
(error (message "Can't find instrumented sexp, did you edit the source?"))))
|
|
|
|
|
|
|
|
|
|
|
|
(defun cider--handle-debug (response)
|
|
|
|
|
|
"Handle debugging notification.
|
|
|
|
|
|
RESPONSE is a message received from the nrepl describing the input
|
|
|
|
|
|
needed. It is expected to contain at least \"key\", \"input-type\", and
|
|
|
|
|
|
\"prompt\", and possibly other entries depending on the input-type."
|
|
|
|
|
|
(nrepl-dbind-response response (debug-value key coor code file point ns original-id
|
|
|
|
|
|
input-type prompt inspect)
|
|
|
|
|
|
(condition-case-unless-debug e
|
|
|
|
|
|
(progn
|
|
|
|
|
|
(pcase input-type
|
|
|
|
|
|
("expression" (cider-debug-mode-send-reply (cider-read-from-minibuffer
|
|
|
|
|
|
(or prompt "Expression: "))
|
|
|
|
|
|
key))
|
|
|
|
|
|
((pred sequencep)
|
|
|
|
|
|
(when (or code (and file point))
|
|
|
|
|
|
;; We prefer in-source debugging.
|
|
|
|
|
|
(when (and file point)
|
|
|
|
|
|
(if-let ((buf (find-buffer-visiting file)))
|
|
|
|
|
|
(if-let ((win (get-buffer-window buf)))
|
|
|
|
|
|
(select-window win)
|
|
|
|
|
|
(pop-to-buffer buf))
|
|
|
|
|
|
(find-file file))
|
|
|
|
|
|
(goto-char point))
|
|
|
|
|
|
;; But we can create a temp buffer if that fails.
|
|
|
|
|
|
(unless (or (looking-at-p (regexp-quote code))
|
|
|
|
|
|
(looking-at-p (regexp-quote (cider--debug-trim-code code))))
|
|
|
|
|
|
(cider--initialize-debug-buffer code ns original-id))
|
|
|
|
|
|
(cider--debug-move-point coor))
|
|
|
|
|
|
;; The overlay code relies on window boundaries, but point could have been
|
|
|
|
|
|
;; moved outside the window by some other code. Redisplay here to ensure the
|
|
|
|
|
|
;; visible window includes point.
|
|
|
|
|
|
(redisplay)
|
|
|
|
|
|
(cider--debug-remove-overlays)
|
|
|
|
|
|
(when cider-debug-use-overlays
|
|
|
|
|
|
(cider--debug-display-result-overlay debug-value))
|
|
|
|
|
|
(setq cider--debug-mode-response response)
|
|
|
|
|
|
(cider--debug-mode 1)))
|
|
|
|
|
|
(when inspect
|
|
|
|
|
|
(cider-inspector--value-handler nil inspect)
|
|
|
|
|
|
(cider-inspector--done-handler (current-buffer))))
|
|
|
|
|
|
;; If something goes wrong, we send a "quit" or the session hangs.
|
|
|
|
|
|
(error (cider-debug-mode-send-reply ":quit" key)
|
|
|
|
|
|
(message "Error encountered while handling the debug message: %S" e)))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; 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,
|
|
|
|
|
|
a number of keys will be prompted to the user."
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(cider-eval-defun-at-point 'debug-it))
|
|
|
|
|
|
|
|
|
|
|
|
(provide 'cider-debug)
|
|
|
|
|
|
;;; cider-debug.el ends here
|
