;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware  -*- lexical-binding: t; -*-

;; Copyright © 2015-2026 Bozhidar Batsov, Artur Malabarba and CIDER contributors

;; 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 'subr-x)

(require 'spinner)
(require 'transient)

(require 'cider-browse-ns)
(require 'cider-client)
(require 'cider-eval)
(require 'cider-enlighten) ; the enlighten handler dispatched below lives there
(require 'cider-inspector)
(require 'cider-util)
(require 'cider-common)
(require 'nrepl-client) ; `nrepl-make-eval-handler', `nrepl-dbind-response'
(require 'nrepl-dict)


;;; Customization
(defgroup cider-debug nil
  "Presentation and behavior 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."
  :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."
  :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))
  :package-version '(cider . "0.10.0"))

(defcustom cider-debug-use-overlays t
  "Whether to highlight debugging information with overlays.
Takes the same possible values as `cider-eval-result-display', 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))
  :package-version '(cider . "0.9.1"))


;;; Implementation
(declare-function cider-browse-ns--combined-vars-with-meta "cider-browse-ns")

(defun cider-browse-instrumented-defs ()
  "List all instrumented definitions."
  (interactive)
  (if-let* ((all (thread-first (cider-nrepl-sync-request '("op" "cider/debug-instrumented-defs"))
                               (nrepl-dict-get "list"))))
      (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t)
        (let ((inhibit-read-only t))
          (dolist (list all)
            (let* ((ns (car list))
                   (ns-vars-with-meta (cider-browse-ns--combined-vars-with-meta ns))
                   (instrumented-meta (nrepl-dict-filter (lambda (k _)
                                                           (member k list))
                                                         ns-vars-with-meta)))
              (cider-browse-ns--list (current-buffer) ns
                                     instrumented-meta
                                     ns)))))
    (message "No currently instrumented definitions")))

(defun cider--debug-response-handler ()
  "Build a handler for responses from the cider.debug middleware.
Dispatches on the debug-specific status flags (`enlighten',
`eval-error', `stack', `need-debug-input').  Bookkeeping for the
\"done\" status (request-id cleanup) is handled by
`nrepl-make-eval-handler' itself."
  (nrepl-make-eval-handler
   :on-status (lambda (status response)
                (nrepl-dbind-response response (causes caught-msg)
                  (when (member "enlighten" status)
                    (cider--handle-enlighten response))
                  (when (or (member "eval-error" status)
                            (member "stack" status))
                    ;; TODO: Make the error buffer a bit friendlier when we're
                    ;; just printing the stack.
                    (if cider-show-error-buffer
                        (cider--render-stacktrace-causes causes)
                      (cider--debug-display-result-overlay nil caught-msg)))
                  (when (member "need-debug-input" status)
                    (cider--handle-debug response))))))

(defun cider--debug-init-connection ()
  "Initialize a connection with the cider.debug middleware."
  (cider-nrepl-send-request
   `("op" "cider/init-debugger"
     ,@(cider--nrepl-print-request-plist fill-column))
   (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 caught)
  "Place an overlay at point displaying VALUE.
When CAUGHT is non-nil, display it as an error message overlay."
  (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 (or caught (cider-font-lock-as-clojure value))
        :where (point-marker)
        :type 'debug-result
        :prepend-face (if caught 'cider-error-overlay-face
                        'cider-result-overlay-face)
        '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-response nil
  "Response that triggered current debug session.
Set by `cider--turn-on-debug-mode'.")

(defvar cider--debug-origin-marker nil
  "Marker to the location where the current debug session was started.
Restored when the session is quit with `:quit'.  See
`cider--debug-remember-origin' and `cider--debug-restore-origin'.")

(defvar cider--debug-origin-id nil
  "The \"original-id\" of the eval owning `cider--debug-origin-marker'.
Used to detect when a new debug session starts, so the origin is only
remembered on the session's first step.")

(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
  :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")
    ;; 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")
    (?P "inspect-prompt" nil)
    (?l "locals" "locals")
    (?j "inject" "inject")
    (?s "stacktrace" "stacktrace")
    (?t "trace" "trace")
    (?q "quit" "quit"))
  "A list of debugger command specs.

Specs are 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") (const nil))))
  :package-version '(cider . "0.24.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-propertize-prompt-commands ()
  "In-place format the command display names for the `cider-debug-prompt' overlay."
  (mapc (lambda (spec)
          (pcase-let ((`(,char ,_cmd ,disp-name) spec))
            (when-let* ((pos (seq-position disp-name char)))
              (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)
          (seq-reduce
           (lambda (prompt spec)
             (pcase-let ((`(,_char ,cmd ,disp) spec))
               (if (and disp (seq-find (lambda (c) (string= cmd c)) commands))
                   (concat prompt " " disp)
                 prompt)))
           cider-debug-prompt-commands
           "")))

(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)
          (overlay-put cider--debug-prompt-overlay
                       'before-string (cider--debug-prompt input-type))
        (setq cider--debug-prompt-overlay
              (cider--make-overlay
               (max (car (cider-defun-at-point 'bounds))
                    (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")
    (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
  (let ((map (make-sparse-keymap)))
    ;; Bind the `:here` command to both h and H, because it behaves differently
    ;; if invoked with an uppercase letter.
    (define-key map "h" #'cider-debug-move-here)
    (define-key map "H" #'cider-debug-move-here)
    (define-key map "L" #'cider-debug-toggle-locals)
    (define-key map "?" #'cider-debug-menu)
    map)
  "The active keymap during a debugging session.")

(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'.

\\{cider--debug-mode-map}"
  :init-value nil :lighter " DEBUG" :keymap '()
  (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 "Activated debug-mode 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")))
            ;; Map over the key->command alist and set the keymap
            (mapc
             (lambda (p)
               (let ((char (car 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
            ;; 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-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-repl)))))
      (accept-process-output proc 1))
    (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 variable `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 'category 'debug-result)
        (remove-overlays nil nil 'category 'debug-code)
        (setq cider--debug-prompt-overlay nil)
        (remove-overlays nil nil 'category '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))

;; 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."
  (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.).

(defun cider-debug-next ()
  "Step to the next instrumented point in the code being debugged."
  (interactive)
  (cider-debug-mode-send-reply ":next"))

(defun cider-debug-in ()
  "Step into the function about to be called."
  (interactive)
  (cider-debug-mode-send-reply ":in"))

(defun cider-debug-out ()
  "Step out of the sexp being debugged."
  (interactive)
  (cider-debug-mode-send-reply ":out"))

(defun cider-debug-force-out ()
  "Step out of the sexp being debugged, skipping any breakpoints inside it."
  (interactive)
  (cider-debug-mode-send-reply ":out" nil t))

(defun cider-debug-continue ()
  "Continue running until the next breakpoint."
  (interactive)
  (cider-debug-mode-send-reply ":continue"))

(defun cider-debug-continue-all ()
  "Continue running, ignoring all further breakpoints in this session."
  (interactive)
  (cider-debug-mode-send-reply ":continue-all"))

(defun cider-debug-eval ()
  "Read an expression and evaluate it in the debugger's lexical scope."
  (interactive)
  (cider-debug-mode-send-reply ":eval"))

(defun cider-debug-inject ()
  "Read an expression and replace the current value with its result."
  (interactive)
  (cider-debug-mode-send-reply ":inject"))

(defun cider-debug-inspect ()
  "Inspect the current value in the CIDER inspector."
  (interactive)
  (cider-debug-mode-send-reply ":inspect"))

(defun cider-debug-inspect-expr ()
  "Read an expression, evaluate it in the debugger's scope and inspect it."
  (interactive)
  (cider-debug-mode-send-reply ":inspect-prompt"))

(defun cider-debug-locals ()
  "Inspect the local variables of the current debugging context."
  (interactive)
  (cider-debug-mode-send-reply ":locals"))

(defun cider-debug-stacktrace ()
  "Show the stacktrace of the current debugging context."
  (interactive)
  (cider-debug-mode-send-reply ":stacktrace"))

(defun cider-debug-trace ()
  "Continue running, printing the value at each instrumented point."
  (interactive)
  (cider-debug-mode-send-reply ":trace"))

(defun cider-debug-quit ()
  "Quit the current debugging session."
  (interactive)
  (cider-debug-mode-send-reply ":quit"))

(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."
     [,(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."
  (ignore-errors
    (let ((case-fold-search nil))
      (string-match "[[:upper:]]" (string last-command-event)))))

(defun cider--debug-remember-origin (id)
  "Remember point as the origin of the debug session identified by ID.
Only the first step of a session (the first with a given \"original-id\"
ID) is remembered, so that stepping through the code doesn't overwrite
the location the session was started from."
  (unless (equal id cider--debug-origin-id)
    (setq cider--debug-origin-id id
          cider--debug-origin-marker (point-marker))))

(defun cider--debug-restore-origin ()
  "Move point back to where the current debug session was started.
Return non-nil if point was restored.  Does nothing if the origin buffer
is no longer live.  See `cider--debug-remember-origin'."
  (prog1 (when-let* ((marker cider--debug-origin-marker)
                     (buffer (marker-buffer marker)))
           (when (buffer-live-p buffer)
             (pop-to-buffer buffer)
             (goto-char marker)
             t))
    (setq cider--debug-origin-id nil)
    (when cider--debug-origin-marker
      (set-marker cider--debug-origin-marker nil)
      (setq cider--debug-origin-marker nil))))

(defun cider-debug-mode-send-reply (command &optional key force)
  "Reply to the message that started current buffer's debugging session.
COMMAND is sent as the input option.  KEY can be provided to reply to a
specific message.  If FORCE is non-nil, send a \"force?\" argument in the
message."
  (interactive (list
                (if (symbolp last-command-event)
                    (symbol-name last-command-event)
                  (ignore-errors
                    (concat ":" (cadr (assoc last-command-event cider-debug-prompt-commands)))))
                nil
                (cider--uppercase-command-p)))
  (let ((quit-p (member command '(nil ":quit"))))
    (when (and (string-prefix-p ":" command) force)
      (setq command (format "{:response %s :force? true}" command)))
    (cider-nrepl-send-unhandled-request
     `("op" "cider/debug-input"
       "input" ,(or command ":quit")
       "key" ,(or key (nrepl-dict-get cider--debug-mode-response "key"))))
    (ignore-errors (cider--debug-mode -1))
    (when quit-p
      (cider--debug-restore-origin))))

(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)
  "Remove whitespace and reader macros from the start of the CODE.
Return trimmed CODE."
  (replace-regexp-in-string "\\`#[a-z]+[\n\r[:blank:]]*" "" code))

(declare-function cider-set-buffer-ns "cider-mode")
(defun cider--initialize-debug-buffer (code ns id &optional reason)
  "Create a new debugging buffer with CODE and namespace NS.
ID is the id of the message that instrumented CODE.
REASON is a keyword describing why this buffer was necessary."
  (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)
        (cider-set-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)))
          (when code
            (insert "\n\n\n;; We had to create this temporary buffer because we couldn't find the original definition. That probably happened because "
                    reason
                    ".")
            (fill-paragraph))
          (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-skip-discarded-forms ()
  "Skip past all forms discarded with the #_ reader macro."
  ;; Logic taken from `clojure--search-comment-macro-internal'
  (while (looking-at (concat "[ ,\r\t\n]*" clojure--comment-macro-regexp))
    (let ((md (match-data))
          (start (match-beginning 1)))
      (goto-char start)
      ;; Count how many #_ we got and step by that many sexps
      (clojure-forward-logical-sexp
       (count-matches (rx "#_") (elt md 0) (elt md 1))))))

(defun cider--debug-move-point (coordinates)
  "Place point on after the sexp specified by COORDINATES.
COORDINATES is a list of integers that specify how to navigate into the
sexp that is after point when this function is called.

As an example, a COORDINATES list of (1 0 2) means:
  - enter next sexp then `forward-sexp' once,
  - enter next sexp,
  - enter next sexp then `forward-sexp' twice.

In the following snippet, this takes us to the (* x 2) sexp (point is left
at the end of the given sexp).

    (letfn [(twice [x]
              (* x 2))]
      (twice 15))

In addition to numbers, a coordinate can be a string.  This string names the
key of a map, and it means \"go to the value associated with this key\"."
  (condition-case-unless-debug nil
      ;; Navigate through sexps inside the sexp.
      (let ((in-syntax-quote nil))
        (while coordinates
          (while (clojure--looking-at-non-logical-sexp)
            (forward-sexp))
          ;; An `@x` is read as (deref x), so we pop coordinates once to account
          ;; for the extra depth, and move past the @ char.
          (if (eq ?@ (char-after))
              (progn (forward-char 1)
                     (pop 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)))
          ;; Finally skip past all #_ forms
          (cider--debug-skip-discarded-forms))
        ;; 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--debug-position-for-code (code)
  "Return non-nil if point is roughly before CODE.
This might move point one line above.

A nil CODE counts as a match: enlighten events carry only the form's
line/column (not its source text), so there is nothing to verify against
and the position must be trusted as-is."
  (or (null code)
      (looking-at-p (regexp-quote code))
      (let ((trimmed (regexp-quote (cider--debug-trim-code code))))
        (or (looking-at-p trimmed)
            ;; If this is a fake #dbg injected by `C-u
            ;; C-M-x', then the sexp we want is actually on
            ;; the line above.
            (progn (forward-line -1)
                   (looking-at-p trimmed))))))

(defun cider--debug-find-source-position (response &optional create-if-needed)
  "Return a marker of the position after the sexp specified in RESPONSE.
This marker might be in a different buffer!  If the sexp can't be
found (file that contains the code is no longer visited or has been
edited), return nil.  However, if CREATE-IF-NEEDED is non-nil, a new buffer
is created in this situation and the return value is never nil.

Follow the \"line\" and \"column\" entries in RESPONSE, and check whether
the code at point matches the \"code\" entry in RESPONSE.  If it doesn't,
assume that the code in this file has been edited, and create a temp buffer
holding the original code.
Either way, navigate inside the code by following the \"coor\" entry which
is a coordinate measure in sexps."
  (nrepl-dbind-response response (code file line column ns original-id coor)
    (when (or code (and file line column))
      ;; This is for restoring current-buffer.
      (save-excursion
        (let ((out))
          ;; We prefer in-source debugging.
          (when-let* ((buf (and file line column
                                (ignore-errors
                                  (cider--find-buffer-for-file file)))))
            ;; The logic here makes it hard to use `with-current-buffer'.
            (with-current-buffer 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)))
                ;; Column numbers in the response start from 1.
                ;; Convert to Emacs system which starts from 0
                ;; Inverse of `cider-column-number-at-pos'.
                (move-to-column (max 0 (1- column)))
                ;; Check if it worked
                (when (cider--debug-position-for-code code)
                  ;; Find the desired sexp.
                  (cider--debug-move-point coor)
                  (setq out (point-marker))))))
          ;; But we can create a temp buffer if that fails.
          (or out
              (when create-if-needed
                (cider--initialize-debug-buffer
                 code ns original-id
                 (if (and line column)
                     "you edited the code"
                   "your nREPL version is older than 0.2.11"))
                (save-excursion
                  (cider--debug-move-point coor)
                  (point-marker)))))))))

(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 input-type prompt inspect caught-msg)
    (condition-case-unless-debug e
        (progn
          (pcase input-type
            ("expression" (cider-debug-mode-send-reply
                           (condition-case nil
                               (cider-read-from-minibuffer
                                (or prompt "Expression: "))
                             (quit "nil"))
                           key))
            ((pred sequencep)
             (let* ((marker (cider--debug-find-source-position response 'create-if-needed)))
               (pop-to-buffer (marker-buffer marker))
               ;; Remember where we started, so `:quit' can return here.  Point
               ;; hasn't moved to the breakpoint yet, so it's still at the place
               ;; the session was invoked from.
               (cider--debug-remember-origin (nrepl-dict-get response "original-id"))
               (goto-char marker))
             ;; 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)
             ;; Remove overlays AFTER redisplaying! Otherwise there's a visible
             ;; flicker even if we immediately recreate the overlays.
             (cider--debug-remove-overlays)
             (when cider-debug-use-overlays
               (cider--debug-display-result-overlay debug-value caught-msg))
             (setq cider--debug-mode-response response)
             (cider--debug-mode 1)))
          (when inspect
            (cider-inspector--render-value inspect :next-inspectable)))
      ;; 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)))))

;;; Move here command
;; This is the inverse of `cider--debug-move-point'.  However, that algorithm is
;; complicated, and trying to code its inverse would probably be insane.
;; Instead, we find the coordinate by trial and error.
(defun cider--debug-find-coordinates-for-point (target &optional list-so-far)
  "Return the coordinates list for reaching TARGET.
Assumes that the next thing after point is a logical Clojure sexp and that
TARGET is inside it.  The returned list is suitable for use in
`cider--debug-move-point'.  LIST-SO-FAR is for internal use."
  (when (looking-at (rx (or "(" "[" "#{" "{")))
    (let ((starting-point (point)))
      (unwind-protect
          (let ((x 0))
            ;; Keep incrementing the last coordinate until we've moved
            ;; past TARGET.
            (while (condition-case nil
                       (progn (goto-char starting-point)
                              (cider--debug-move-point (append list-so-far (list x)))
                              (< (point) target))
                     ;; Not a valid coordinate. Move back a step and stop here.
                     (scan-error (setq x (1- x))
                                 nil))
              (setq x (1+ x)))
            (setq list-so-far (append list-so-far (list x)))
            ;; We have moved past TARGET, now determine whether we should
            ;; stop, or if target is deeper inside the previous sexp.
            (if (or (= target (point))
                    (progn (forward-sexp -1)
                           (<= target (point))))
                list-so-far
              (goto-char starting-point)
              (cider--debug-find-coordinates-for-point target list-so-far)))
        ;; `unwind-protect' clause.
        (goto-char starting-point)))))

(defun cider-debug-move-here (&optional force)
  "Skip any breakpoints up to point.
The boolean value of FORCE will be sent in the reply."
  (interactive (list (cider--uppercase-command-p)))
  (unless cider--debug-mode
    (user-error "`cider-debug-move-here' only makes sense during a debug session"))
  (let ((here (point)))
    (nrepl-dbind-response cider--debug-mode-response (line column)
      (if (and line column (buffer-file-name))
          (progn ;; Get to the proper line & column in the file
            (forward-line (1- (- line (line-number-at-pos))))
            (move-to-column column))
        (beginning-of-defun-raw))
      ;; Is HERE inside the sexp being debugged?
      (when (or (< here (point))
                (save-excursion
                  (clojure-forward-logical-sexp 1)
                  (> here (point))))
        (user-error "Point is outside the sexp being debugged"))
      ;; Move forward until start of sexp.
      (comment-normalize-vars t)
      (comment-forward (point-max))
      ;; Find the coordinate and send it.
      (cider-debug-mode-send-reply
       (format "{:response :here, :coord %s :force? %s}"
               (cider--debug-find-coordinates-for-point here)
               (if force "true" "false"))))))


;;; 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
