[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/dape 4ffaef2a06: Async jsonrpc (#40)
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/dape 4ffaef2a06: Async jsonrpc (#40) |
|
Date: |
Thu, 4 Jan 2024 18:57:40 -0500 (EST) |
branch: externals/dape
commit 4ffaef2a06a595d459f04bc90ff066fb1e390327
Author: Daniel Pettersson <daniel@dpettersson.net>
Commit: GitHub <noreply@github.com>
Async jsonrpc (#40)
Moved away from homegrown dap parsing to jsonrcp and jsonrpc-async-request.
---
.github/workflows/test.yml | 3 +
Makefile | 20 +-
README.org | 17 +-
dape-tests.el | 51 +-
dape.el | 1906 ++++++++++++++++++++++----------------------
5 files changed, 999 insertions(+), 998 deletions(-)
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index 6acc8954f4..6b59cd90f2 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -50,6 +50,9 @@ jobs:
- name: Install rdbg
run: gem install debug
+ - name: Install lzip to unpack elpa packages
+ run: sudo apt install lzip
+
- name: Build
run: make all
diff --git a/Makefile b/Makefile
index eb89bb419d..64a2e61c68 100644
--- a/Makefile
+++ b/Makefile
@@ -1,16 +1,28 @@
export EMACS ?= $(shell which emacs)
-ELFILES = dape.el dape-tests.el
+DEPS = jsonrpc-1.0.19/jsonrpc.el
+
+ELFILES = $(DEPS) dape.el dape-tests.el
ELCFILES = $(addsuffix .elc, $(basename $(ELFILES)))
all: $(ELCFILES)
+$(DEPS):
+ @curl "https://elpa.gnu.org/packages/$(@D).tar.lz" -o $(@D).tar.lz
+ @tar -xvf $(@D).tar.lz
+ @rm $(@D).tar.lz
+
%.elc: %.el
@echo Compiling $<
- @${EMACS} -batch -q -no-site-file -L . -f batch-byte-compile $<
+ @${EMACS} -Q -batch -no-site-file -L . -f batch-byte-compile $<
-check: $(ELCFILES)
- @${EMACS} -batch -l ert $(foreach file, $^, -l $(file)) -f
ert-run-tests-batch-and-exit
+check: $(DEPS) $(ELCFILES)
+ @${EMACS} -Q \
+ -batch \
+ -l ert \
+ $(foreach file, $^, -l $(file)) \
+ -f ert-run-tests-batch-and-exit
clean:
@rm -f *.elc
+ @rm -fr $(dir $(DEPS))
diff --git a/README.org b/README.org
index 49984823ea..a89a2dfad7 100644
--- a/README.org
+++ b/README.org
@@ -21,7 +21,7 @@ For complete functionality, activate ~eldoc-mode~ in your
source buffers and ena
+ Memory viewer with ~hexl~
+ ~compile~ integration
+ Debug adapter configuration ergonomics
-+ No dependencies
++ No dependencies (except for jsonrpc which is part of emacs but needed
version is not part of latest stable emacs release 29.1-1 but available on elpa)
[[https://raw.githubusercontent.com/svaante/dape/resources/c-light-left.png]]
And with ~(setq dape-buffer-window-arrangement 'gud)~ + ~corfu~ as
~completion-in-region-function~.
@@ -145,14 +145,9 @@ If you find a working configuration for any other debug
adapter please submit a
See
[[https://microsoft.github.io/debug-adapter-protocol/implementors/adapters/][microsofts
list]] for other adapters, your mileage will vary.
-* Roadmap
-+ More options for indicator placement
-+ Improving completion in REPL
-+ Usage of "setVariable" inside of ~*dape-info*~ buffer
-+ Improve memory reader with auto reload and write functionality
-+ Individual thread controls
-+ Variable values displayed in source buffer, this seams to require
integration with lsp-mode and eglot
-
* Bugs and issues
-Before reporting any issues take a look at ~*dape-debug*~ buffer with all
debug messages enabled.
-~(setq dape--debug-on '(io info error std-server))~.
+Before reporting any issues take a look at ~*dape-repl*~ buffer. Master is
used is for all case and purposes a development branch still and releases on
elpa should be more stable so in the mean time use elpa if the bug is a
breaking you workflow.
+
+
+* Acknowledgements
+ Big thanks to João Távora for input and jsonrpc, the project wouldn't be at
the stage for João.
diff --git a/dape-tests.el b/dape-tests.el
index fb14823f31..86c1444b9a 100644
--- a/dape-tests.el
+++ b/dape-tests.el
@@ -68,7 +68,8 @@ CONTENT-LIST.
(lambda ,(mapcar 'car buffer-fixtures)
,@body)))
-(defvar dape--test-skip-cleanup nil)
+(defvar dape-test--skip-cleanup nil
+ "Skip `dape-test--call-with-files' cleanup.")
(defun dape-test--call-with-files (fixtures fn)
"Setup FIXTURES and apply FN with created buffers.
@@ -88,21 +89,23 @@ Helper for `dape-test--with-files'."
(setq buffers (nreverse buffers))
(apply fn buffers))
;; reset dape
- (unless dape--test-skip-cleanup
+ (unless dape-test--skip-cleanup
(advice-add 'yes-or-no-p :around (defun always-yes (&rest _) t))
(dape-quit)
(setq dape--info-expanded-p
(make-hash-table :test 'equal))
(setq dape--watched nil)
(dape-test--should
- (not dape--process) 10)
+ (not (dape--live-connection t)) 10)
(dape-test--should
(not (seq-find (lambda (buffer)
- (string-match-p "\\*dape-.+\\*"
- (buffer-name buffer)))
+ (and (not (equal (buffer-name buffer)
+ "*dape-connection events*"))
+ (string-match-p "\\*dape-.+\\*"
+ (buffer-name buffer))))
(buffer-list))))
(dape-test--should
- (not (process-list)))
+ (not (process-list)) 10)
(advice-remove 'yes-or-no-p 'always-yes)
(dolist (buffer buffers)
(kill-buffer buffer))
@@ -116,9 +119,15 @@ Helper for `dape-test--with-files'."
(when (re-search-forward regex nil)
(funcall-interactively fn))))
+(defun dape-test--stopped-p ()
+ "If current adapter connection is stopped."
+ (dape--stopped-threads (dape--live-connection t)))
+
(defun dape-test--debug (key &rest options)
"Invoke `dape' config KEY with OPTIONS."
- (dape (dape--config-eval key options)))
+ (let ((config (dape--config-eval key options)))
+ (dape config)
+ (setq dape-history (list (dape--config-to-string key config)))))
;;; Tests
(defun dape--test-restart (buffer &rest dape-args)
@@ -133,15 +142,17 @@ Expects line with string \"breakpoint\" in source."
(apply 'dape-test--debug dape-args)
;; at breakpoint and stopped
(dape-test--should
- (and (eq dape--state 'stopped)
+ (and (dape-test--stopped-p)
(equal (line-number-at-pos)
(dape-test--line-at-regex "breakpoint"))))
+ (sleep-for 1) ;; FIXME Regression dape messes up current live connection
+ ;; on fast restarts
;; restart
(goto-char (point-min))
(dape-restart)
;; at breakpoint and stopped
(dape-test--should
- (and (eq dape--state 'stopped)
+ (and (dape-test--stopped-p)
(equal (line-number-at-pos)
(dape-test--line-at-regex "breakpoint"))))))
@@ -201,15 +212,17 @@ Expects line with string \"breakpoint\" in source."
(apply 'dape-test--debug dape-args)
;; at breakpoint and stopped
(dape-test--should
- (and (eq dape--state 'stopped)
+ (and (dape-test--stopped-p)
(equal (line-number-at-pos)
(dape-test--line-at-regex "breakpoint"))))
+ (sleep-for 2) ;; FIXME Regression dape messes up current live connection
+ ;; on fast restarts
;; restart
(goto-char (point-min))
(apply 'dape-test--debug dape-args)
;; at breakpoint and stopped
(dape-test--should
- (and (eq dape--state 'stopped)
+ (and (dape-test--stopped-p)
(equal (line-number-at-pos)
(dape-test--line-at-regex "breakpoint"))))))
@@ -288,8 +301,7 @@ Expects line with string \"breakpoint\" in source."
(dape-test--should
(not (dape-test--line-at-regex "^ member")))
;; set value
- (when (eq (plist-get dape--capabilities :supportsSetVariable)
- t)
+ (when (dape--capable-p (dape--live-connection t) :supportsSetVariable)
(dape-test--should
(dape-test--line-at-regex "^ a *0"))
(cl-letf (((symbol-function 'read-string)
@@ -373,7 +385,7 @@ Expects line with string \"breakpoint\" in source."
(equal (line-number-at-pos)
(dape-test--line-at-regex "breakpoint"))))
(dape-test--should
- (equal dape--state 'stopped))
+ (dape-test--stopped-p))
;; contents of watch buffer
(with-current-buffer (dape-test--should
(dape--info-get-live-buffer 'dape-info-watch-mode))
@@ -544,7 +556,7 @@ Expects line with string \"breakpoint\" in source."
:program (buffer-file-name main-buffer)
:cwd default-directory)
;; at breakpoint and stopped
- (dape-test--should (dape--stopped-threads))
+ (dape-test--should (dape-test--stopped-p))
(with-current-buffer main-buffer
(dape-test--should
(= (line-number-at-pos)
@@ -552,7 +564,7 @@ Expects line with string \"breakpoint\" in source."
(pop-to-buffer "*dape-repl*")
(insert "next")
(comint-send-input)
- (dape-test--should (dape--stopped-threads))
+ (dape-test--should (dape-test--stopped-p))
(with-current-buffer main-buffer
(dape-test--should
(= (line-number-at-pos)
@@ -563,7 +575,7 @@ Expects line with string \"breakpoint\" in source."
(dape-test--should
(and (= (line-number-at-pos)
(dape-test--line-at-regex "third line"))
- (eq dape--state 'stopped))))
+ (dape-test--stopped-p))))
(insert "a = 99")
(comint-send-input)
(with-current-buffer (dape-test--should
@@ -589,7 +601,7 @@ Expects line with string \"breakpoint\" in source."
:cwd default-directory)
;; at breakpoint and stopped
(dape-test--should
- (eq dape--state 'stopped))
+ (dape-test--stopped-p))
(dape--info-buffer 'dape-info-modules-mode)
;; contents
(with-current-buffer (dape-test--should
@@ -615,8 +627,7 @@ Expects line with string \"breakpoint\" in source."
:program (buffer-file-name index-buffer)
:cwd default-directory)
;; stopped
- (dape-test--should
- (eq dape--state 'stopped))
+ (dape-test--should (dape-test--stopped-p))
(dape--info-buffer 'dape-info-sources-mode)
;; contents
(with-current-buffer (dape-test--should
diff --git a/dape.el b/dape.el
index cca2bb2949..ff709ec750 100644
--- a/dape.el
+++ b/dape.el
@@ -8,7 +8,7 @@
;; License: GPL-3.0-or-later
;; Version: 0.3.0
;; Homepage: https://github.com/svaante/dape
-;; Package-Requires: ((emacs "29.1"))
+;; Package-Requires: ((emacs "29.1") (jsonrpc "1.0.21"))
;; This file is not part of GNU Emacs.
@@ -52,6 +52,7 @@
(require 'project)
(require 'gdb-mi)
(require 'tramp)
+(require 'jsonrpc)
;;; Custom
@@ -289,7 +290,7 @@ where keys can be symbols or keywords.
Symbol Keys (Used by Dape):
- fn: Function or list of functions, takes config and returns config.
- If list functions are applied in order. Used for hiding unnecessary
+ If list functions are applied in order. Used for hiding unnecessary
configuration details from config history.
- ensure: Function to ensure that adapter is available.
- command: Shell command to initiate the debug adapter.
@@ -303,7 +304,7 @@ Symbol Keys (Used by Dape):
completions.
- compile: Executes a shell command with `dape-compile-fn'.
-Debug adapter connection in configuration:
+Debug adapter conn in configuration:
- If only command is specified (without host and port), Dape
will communicate with the debug adapter through stdin/stdout.
- If both host and port are specified, Dape will connect to the
@@ -344,7 +345,7 @@ Sometimes it is useful for files or directories to supply
local values
for this variable.
Example value:
-((codelldb-cc :program \"/home/user/project/a.out\"))"
+\((codelldb-cc :program \"/home/user/project/a.out\"))"
:type '(repeat sexp))
;; TODO Add more defaults, don't know which adapters support
@@ -352,7 +353,7 @@ Example value:
(defcustom dape-mime-mode-alist '(("text/x-lldb.disassembly" . asm-mode)
("text/javascript" . js-mode))
"Alist of MIME types vs corresponding major mode functions.
- Each element should look like (MIME-TYPE . MODE) where
+Each element should look like (MIME-TYPE . MODE) where
MIME-TYPE is a string and MODE is the major mode function to
use for buffers of this MIME type."
:type '(alist :key-type string :value-type function))
@@ -488,13 +489,6 @@ See `dape--default-cwd'."
The hook is run with one argument, the compilation buffer."
:type 'hook)
-(defcustom dape--debug-on '(io info error std-server)
- "Types of logs should be printed to *dape-debug*."
- :type '(set (const :tag "dap IO" io)
- (const :tag "info logging" info)
- (const :tag "error logging" error)
- (const :tag "dap tcp server stdout" std-server)))
-
;;; Face
@@ -531,24 +525,9 @@ The hook is run with one argument, the compilation buffer."
;;; Vars
-(defvar dape--config nil
- "Current session configuration plist.")
-(defvar dape--timers nil
- "List of running timers.")
-(defvar dape--seq 0
- "Session seq number.")
-(defvar dape--cb nil
- "Hash table of request callbacks.")
-(defvar dape--state nil
- "Session state.")
-(defvar dape--thread-id nil
- "Selected thread id.")
-(defvar dape--stack-id nil
- "Selected stack id.")
-(defvar dape--capabilities nil
- "Session capabilities plist.")
-(defvar dape--threads nil
- "Session plist of thread data.")
+(defvar dape-history nil
+ "History variable for `dape'.")
+
(defvar dape--source-buffers nil
"Plist of sources reference to buffer.")
(defvar dape--breakpoints nil
@@ -557,18 +536,10 @@ The hook is run with one argument, the compilation
buffer."
"List of available exceptions as plists.")
(defvar dape--watched nil
"List of watched expressions.")
-(defvar dape--modules nil
- "List of modules.")
-(defvar dape--sources nil
- "List of loaded sources.")
-(defvar dape--server-process nil
- "Debug adapter server process.")
-(defvar dape--process nil
- "Debug adapter communications process.")
-(defvar dape--parent-process nil
- "Debug adapter parent process. Used for by startDebugging adapters.")
-(defvar dape--restart-in-progress nil
- "Used for prevent adapter killing when restart request is in flight.")
+(defvar dape--connection nil
+ "Debug adapter connection.")
+(defvar dape--mode-line-active nil
+ "If mode line is showing.")
(defvar-local dape--source nil
"Store source plist in fetched source buffer.")
@@ -580,9 +551,12 @@ The hook is run with one argument, the compilation buffer."
;;; Utils
(defmacro dape--callback (&rest body)
- "Create callback lambda for `dape-request' with BODY."
- `(lambda (&optional process body success msg)
- (ignore process body success msg)
+ "Create callback lambda for `dape-request' with BODY.
+Binds CONN, BODY and ERROR-MESSAGE.
+Where BODY is assumed to be response body and ERROR-MESSAGE an error
+string if the request where unsuccessfully or if the request timed out."
+ `(lambda (&optional conn body error-message)
+ (ignore conn body error-message)
,@body))
(defmacro dape--with (request-fn args &rest body)
@@ -590,52 +564,55 @@ The hook is run with one argument, the compilation
buffer."
(declare (indent 2))
`(,request-fn ,@args (dape--callback ,@body)))
-(defun dape--next-like-command (command)
+(defun dape--next-like-command (conn command)
"Helper for interactive step like commands.
-Run step like COMMAND. If ARG is set run COMMAND ARG times."
- (if (dape--stopped-threads)
- (dape-request (dape--live-process)
- command
- `(,@(dape--thread-id-object)
- ,@(when (plist-get dape--capabilities
- :supportsSteppingGranularity)
- (list :granularity
- (symbol-name dape-stepping-granularity))))
- (dape--callback
- (when success
- (dape--update-state 'running)
- (dape--remove-stack-pointers)
- (dolist (thread dape--threads)
- (plist-put thread :status "running"))
- (run-hooks 'dape-update-ui-hooks))))
+Run step like COMMAND on CONN. If ARG is set run COMMAND ARG times."
+ (if (dape--stopped-threads conn)
+ (dape--with dape-request
+ (conn
+ command
+ `(,@(dape--thread-id-object conn)
+ ,@(when (dape--capable-p conn :supportsSteppingGranularity)
+ (list :granularity
+ (symbol-name dape-stepping-granularity)))))
+ (unless error-message
+ (dape--update-state conn 'running)
+ (dape--remove-stack-pointers)
+ (dolist (thread (dape--threads conn))
+ (plist-put thread :status "running"))
+ (run-hook-with-args 'dape-update-ui-hooks conn)))
(user-error "No stopped threads")))
-(defun dape--thread-id-object ()
- "Helper to construct a thread id object."
- (when dape--thread-id
- (list :threadId dape--thread-id)))
-
-(defun dape--stopped-threads ()
- "List of stopped threads."
- (mapcan (lambda (thread)
- (when (equal (plist-get thread :status) "stopped")
- (list thread)))
- dape--threads))
-
-(defun dape--current-thread ()
- "Current thread plist."
- (seq-find (lambda (thread)
- (eq (plist-get thread :id) dape--thread-id))
- dape--threads))
-
-(defun dape--path (path format)
- "Translate PATH to FORMAT.
-Accepted FORMAT values is `local' and `remote'."
- (if-let* (((or (plist-member dape--config 'prefix-local)
- (plist-member dape--config 'prefix-remote)))
- (prefix-local (or (plist-get dape--config 'prefix-local)
+(defun dape--thread-id-object (conn)
+ "Construct a thread id object for CONN."
+ (when-let ((thread-id (dape--thread-id conn)))
+ (list :threadId thread-id)))
+
+(defun dape--stopped-threads (conn)
+ "List of stopped threads for CONN."
+ (and conn
+ (mapcan (lambda (thread)
+ (when (equal (plist-get thread :status) "stopped")
+ (list thread)))
+ (dape--threads conn))))
+
+(defun dape--current-thread (conn)
+ "Current thread plist for CONN."
+ (and conn
+ (seq-find (lambda (thread)
+ (eq (plist-get thread :id) (dape--thread-id conn)))
+ (dape--threads conn))))
+
+(defun dape--path (conn path format)
+ "Translate PATH to FORMAT from CONN config.
+Accepted FORMAT values is `local' and `remote'.
+See `dape-config' keywords `prefix-local' `prefix-remote'."
+ (if-let* ((config (and conn (dape--config conn)))
+ ((or (plist-member config 'prefix-local)
+ (plist-member config 'prefix-remote)))
+ (prefix-local (or (plist-get config 'prefix-local)
""))
- (prefix-remote (or (plist-get dape--config 'prefix-remote)
+ (prefix-remote (or (plist-get config 'prefix-remote)
""))
(mapping (pcase format
('local (cons prefix-remote prefix-local))
@@ -646,10 +623,14 @@ Accepted FORMAT values is `local' and `remote'."
(string-remove-prefix (car mapping) path))
path))
-(defun dape--current-stack-frame ()
- "Current stack frame plist."
+(defun dape--capable-p (conn of)
+ "If CONN capable OF."
+ (eq (plist-get (dape--capabilities conn) of) t))
+
+(defun dape--current-stack-frame (conn)
+ "Current stack frame plist for CONN."
(let* ((stack-frames (thread-first
- (dape--current-thread)
+ (dape--current-thread conn)
(plist-get :stackFrames)))
(stack-frames-with-source
(seq-filter (lambda (stack-frame)
@@ -660,7 +641,7 @@ Accepted FORMAT values is `local' and `remote'."
stack-frames)))
(or (seq-find (lambda (stack-frame)
(eq (plist-get stack-frame :id)
- dape--stack-id))
+ (dape--stack-id conn)))
stack-frames-with-source)
(car stack-frames-with-source)
(car stack-frames))))
@@ -678,7 +659,8 @@ Note requires `dape--source-ensure' if source is by
reference."
((buffer-live-p buffer)))
buffer)
(when-let* ((path (plist-get source :path))
- (path (dape--path path 'local))
+ (path (dape--path (dape--live-connection t)
+ path 'local))
((file-exists-p path))
(buffer (find-file-noselect path t)))
buffer))))
@@ -695,7 +677,7 @@ Note requires `dape--source-ensure' if source is by
reference."
"Goto file and line of dap PLIST containing file and line information.
If NO-SELECT does not select buffer.
If PULSE pulse on after opening file."
- (dape--with dape--source-ensure ((dape--live-process t) plist)
+ (dape--with dape--source-ensure ((dape--live-connection t) plist)
(when-let* ((marker (dape--object-to-marker plist))
(window
(display-buffer (marker-buffer marker)
@@ -764,7 +746,7 @@ DEFAULT specifies which file to return on empty input."
(read-number "Pid: ")))
(defun dape-config-autoport (config)
- "Replaces :autoport in CONFIG keys `command-args' and `port'.
+ "Replace :autoport in CONFIG keys `command-args' and `port'.
If `port' is `:autoport' replaces with open port, if not replaces
with value of `port' instead.
Replaces symbol and string occurences of \"autoport\"."
@@ -848,24 +830,20 @@ If EXTENDED end of line is after newline."
(defun dape--format-file-line (file line)
"Formats FILE and LINE to string."
- (concat
- (string-truncate-left (file-relative-name file (plist-get dape--config
:cwd))
- dape-info-file-name-max)
- (when line
- (format ":%d" line))))
-
-(defun dape--kill-processes ()
- "Kill all Dape related process."
- (when (hash-table-p dape--timers)
- (dolist (timer (hash-table-values dape--timers))
- (cancel-timer timer)))
- (ignore-errors
- (and dape--process
- (delete-process dape--process))
- (and dape--server-process
- (delete-process dape--server-process))
- (and dape--parent-process
- (delete-process dape--parent-process))))
+ (let* ((conn (dape--live-connection t))
+ (config
+ (and conn
+ ;; If child connection check parent
+ (or (and-let* ((parent (dape--parent conn)))
+ (dape--config parent))
+ (dape--config conn))))
+ (root-guess (or (plist-get config :cwd)
+ (plist-get config 'command-cwd))))
+ (concat
+ (string-truncate-left (file-relative-name file root-guess)
+ dape-info-file-name-max)
+ (when line
+ (format ":%d" line)))))
(defun dape--kill-buffers (&optional skip-process-buffers)
"Kill all Dape related buffers.
@@ -876,9 +854,13 @@ On SKIP-PROCESS-BUFFERS skip deletion of buffers which has
processes."
(get-buffer-process buffer))
(string-match-p "\\*dape-.+\\*" (buffer-name
buffer)))))
(seq-do (lambda (buffer)
- (when-let ((window (get-buffer-window buffer)))
- (delete-window window))
- (kill-buffer buffer)))))
+ (condition-case err
+ (progn
+ (when-let ((window (get-buffer-window buffer)))
+ (delete-window window))
+ (kill-buffer buffer))
+ (error
+ (message (error-message-string err))))))))
(defun dape--display-buffer (buffer)
"Display BUFFER according to `dape-buffer-window-arrangement'."
@@ -916,199 +898,140 @@ On SKIP-PROCESS-BUFFERS skip deletion of buffers which
has processes."
(_ (error "Unable to display buffer of mode `%s'" mode))))
(_ (user-error "Invalid value of `dape-buffer-window-arrangement'"))))))
+
-;;; Process and parsing
-
-;; HACK Issue #1 for some reason \r is not inserted into the parse
-;; buffer by codelldb on windows. No trace in source code.
-
-;; Some adapters can't help them self, sending headers not in spec..
-(defconst dape--content-length-re
- "Content-Length: \\([[:digit:]]+\\)\r?\n\
-\\(?:.*: .*\r?\n\\)*\
-\r?\n"
- "Matches debug adapter protocol header.")
-
-(defmacro dape--debug (type string &rest objects)
- "Prints STRING of TYPE to *dape-debug*.
-See `format' for STRING and OBJECTS usage.
-See `dape-debug-on' for TYPE information."
- `(when (memq ,type dape--debug-on)
- (let ((objects (list ,@objects)))
- (with-current-buffer (get-buffer-create "*dape-debug*")
- (setq buffer-read-only t)
- (goto-char (point-max))
- (let ((inhibit-read-only t))
- (insert (concat (propertize (format "[%s]" (symbol-name ,type))
'face 'match)
- " "
- (apply 'format ,string objects))
- "\n"))))))
-
-(defun dape--live-process (&optional nowarn)
+;;; Connection
+
+(defun dape--live-connection (&optional nowarn)
"Get current live process.
If NOWARN does not error on no active process."
- (if (and dape--process
- (processp dape--process)
- (process-live-p dape--process))
- dape--process
+ (if (and dape--connection (jsonrpc-running-p dape--connection))
+ dape--connection
(unless nowarn
- (user-error "No debug process live"))))
-
-(defun dape--process-sentinel (process _msg)
- "Sentinel for Dape processes."
- (unless (process-live-p process)
- ;; Flush stdout contents
- (when-let* ((buffer (process-buffer process))
- ((buffer-live-p buffer)))
- (with-current-buffer buffer
- (dape--debug 'io "Flushing io buffer:\n%s" (buffer-string))))
- (dape--remove-stack-pointers)
- ;; Clean mode-line after 2 seconds
- (run-with-timer 2 nil (lambda ()
- (unless (dape--live-process t)
- (setq dape--process nil)
- (force-mode-line-update t))))
- (dape--debug 'info "\nProcess %S exited with %d"
- (process-command process)
- (process-exit-status process))))
-
-(defun dape--handle-object (process object)
- "Handle a incoming parsed OBJECT from PROCESS."
- (dape--debug 'io "Received:\n%S" object)
- (when-let* ((type-string (plist-get object :type))
- (type (intern type-string)))
- (cl-case type
- (response
- (let ((seq (plist-get object :request_seq)))
- (when-let ((timer (gethash seq dape--timers)))
- (cancel-timer timer)
- (remhash seq dape--timers))
- (when-let ((cb (gethash seq dape--cb)))
- (funcall cb
- process
- (plist-get object :body)
- (plist-get object :success)
- (plist-get object :message))
- (remhash seq dape--cb))))
- (request
- (dape-handle-request process
- (intern (plist-get object :command))
- (plist-get object :seq)
- (plist-get object :arguments)))
- (event
- (let ((seq (plist-get object :seq)))
- ;; netcoredbg sends seq as string for some reason
- (when (stringp seq)
- (setq seq (string-to-number seq)))
- (dape-handle-event process
- (intern (plist-get object :event))
- (plist-get object :body))))
- (_ (dape--debug 'info "No handler for type %s" type)))))
-
-(defun dape--process-filter (process string)
- "Filter for Dape processes."
- (when-let (((process-live-p process))
- (input-buffer (process-buffer process))
- (buffer (current-buffer)))
- (with-current-buffer input-buffer
- (goto-char (point-max))
- (insert string)
- (goto-char (point-min))
- (let (expecting-more-bytes start)
- (while (and (setq start (point))
- (search-forward "Content-Length: " nil t)
- (goto-char (match-beginning 0))
- (search-forward-regexp dape--content-length-re
- (+ (point) 1000) t))
- ;; Server non dap output?
- (unless (equal start (match-beginning 0))
- (dape--debug 'std-server "%s"
- (buffer-substring start (match-beginning 0))))
- (let ((content-length (string-to-number (match-string 1))))
- (if-let* ((expected-end
- (byte-to-position
- (+ content-length (position-bytes (point)))))
- (object
- (condition-case nil
- (json-parse-buffer :object-type 'plist
- :null-object nil
- :false-object nil)
- (error
- (and
- (dape--debug 'error
- "Failed to parse json from `%s`"
- (buffer-substring (point)
expected-end))
- nil)))))
- (with-current-buffer buffer
- (setq expecting-more-bytes nil)
- (dape--handle-object process object))
- (dape--debug 'info "Need more bytes")
- (setq expecting-more-bytes t))))
- (when expecting-more-bytes
- (goto-char (point-min))))
- ;; This seams like we are living a bit dangerous. If input buffer
- ;; is killed we are going to erase some random buffer
- (when (buffer-live-p input-buffer)
- (delete-region (point-min) (point))))))
+ (user-error "No debug connection live"))))
+
+(defclass dape-connection (jsonrpc-process-connection)
+ ((last-id
+ :initform 0
+ :documentation "Used for converting JSONRPC's `id' to DAP' `seq'.")
+ (n-sent-notifs
+ :initform 0
+ :documentation "Used for converting JSONRPC's `id' to DAP' `seq'.")
+ (parent
+ :accessor dape--parent :initarg :parent :initform #'ignore
+ :documentation "Parent connection. Used by startDebugging adapters.")
+ (config
+ :accessor dape--config :initarg :config :initform #'ignore
+ :documentation "Current session configuration plist.")
+ (server-process
+ :accessor dape--server-process :initarg :server-process :initform #'ignore
+ :documentation "Debug adapter server process.")
+ (threads
+ :accessor dape--threads :initform nil
+ :documentation "Session plist of thread data.")
+ (capabilities
+ :accessor dape--capabilities :initform nil
+ :documentation "Session capabilities plist.")
+ (thread-id
+ :accessor dape--thread-id :initform nil
+ :documentation "Selected thread id.")
+ (stack-id
+ :accessor dape--stack-id :initform nil
+ :documentation "Selected stack id.")
+ (modules
+ :accessor dape--modules :initform nil
+ :documentation "List of modules.")
+ (sources
+ :accessor dape--sources :initform nil
+ :documentation "List of loaded sources.")
+ (state
+ :accessor dape--state :initform nil
+ :documentation "Session state.")
+ (initialized-p
+ :accessor dape--initialized-p :initform nil
+ :documentation "If connection has been initialized.")
+ (restart-in-progress-p
+ :accessor dape--restart-in-progress-p :initform nil
+ :documentation "If restart request is in flight."))
+ :documentation
+ "Represents a DAP debugger. Wraps a process for DAP communication.")
+
+(cl-defmethod jsonrpc-convert-to-endpoint ((conn dape-connection)
+ message subtype)
+ "Convert jsonrpc CONN MESSAGE with SUBTYPE to DAP format."
+ (cl-destructuring-bind (&key method id error params
+ (result nil result-supplied-p))
+ message
+ (with-slots (last-id n-sent-notifs) conn
+ (cond ((eq subtype 'notification)
+ (cl-incf n-sent-notifs)
+ `(:type "event"
+ :seq ,(+ last-id n-sent-notifs)
+ :event ,method
+ :body ,params))
+ ((eq subtype 'request)
+ `(:type "request"
+ :seq ,(+ (setq last-id id) n-sent-notifs)
+ :command ,method
+ ,@(when params `(:arguments ,params))))
+ (error
+ `(:type "response"
+ :seq ,(+ (setq last-id id) n-sent-notifs)
+ :request_seq ,last-id
+ :success :json-false
+ :message ,(plist-get error :message)
+ :body ,(plist-get error :data)))
+ (t
+ `(:type "response"
+ :seq ,(+ (setq last-id id) n-sent-notifs)
+ :request_seq ,last-id
+ :command ,method
+ :success t
+ ,@(and result `(:body ,result))))))))
+
+(cl-defmethod jsonrpc-convert-from-endpoint ((_conn dape-connection)
dap-message)
+ "Convert JSONRPCesque DAP-MESSAGE to JSONRPC plist."
+ (cl-destructuring-bind (&key type request_seq seq command arguments
+ event body &allow-other-keys)
+ dap-message
+ (when (stringp seq) ;; dirty dirty netcoredbg
+ (setq seq (string-to-number seq)))
+ (cond ((string= type "event")
+ `(:method ,event :params ,body))
+ ((string= type "response")
+ `(:id ,request_seq :result ,dap-message))
+ (command
+ `(:id ,seq :method ,command :params ,arguments)))))
;;; Outgoing requests
-(defconst dape--timeout 5
- "Time before dape starts to complain about missing responses.")
-
-(defun dape--create-timer (process seq)
- "Create SEQ request timeout timer for PROCESS."
- (puthash seq
- (run-with-timer dape--timeout
- nil
- (dape--callback
- (dape--debug 'error
- "Timeout for reached for seq %d"
- seq)
- (when (dape--live-process t)
- (dape--update-state 'timed-out))
- (remhash seq dape--timers)
- (when-let ((cb (gethash seq dape--cb)))
- (remhash seq dape--cb)
- (funcall cb process nil nil nil)))
- process)
- dape--timers))
-
-(defun dape-send-object (process &optional seq object)
- "Helper for `dape-request' to send SEQ request with OBJECT to PROCESS."
- (let* ((object (if seq (plist-put object :seq seq) object))
- (json (json-serialize object :false-object nil))
- (string (format "Content-Length: %d\r\n\r\n%s" (length json) json)))
- (dape--debug 'io "Sending:\n%S" object)
- (condition-case err
- (process-send-string process string)
- (error (dape--debug 'error "%s"
- (error-message-string err))))))
-
-(defun dape-request (process command arguments &optional cb skip-timeout)
- "Send request COMMAND to PROCESS with ARGUMENTS.
-If CB set, invoke CB on response.
-If SKIP-TIMEOUT non nil skip timeout handler creation.
-See `dape--callback' for expected function signature."
- (let ((seq (setq dape--seq (1+ dape--seq)))
- (object (and arguments (list :arguments arguments))))
- (unless skip-timeout
- (dape--create-timer process seq))
- (when cb
- (puthash seq cb dape--cb))
- (dape-send-object process
- seq
- (thread-first object
- (plist-put :type "request")
- (plist-put :command command)))))
-
-(defun dape--initialize (process)
- "Initialize and launch/attach session for PROCESS."
- (dape--with dape-request (process
+(defun dape-request (conn command arguments &optional cb)
+ "Send request with COMMAND and ARGUMENTS to adapter CONN.
+If callback function CB is supplied, it's called on timeout
+and success. See `dape--callback' for signature."
+ (jsonrpc-async-request conn command arguments
+ :success-fn
+ (when (functionp cb)
+ (lambda (result)
+ (funcall cb conn
+ (plist-get result :body)
+ (unless (eq (plist-get result :success)
t)
+ (or (plist-get result :message) "")))))
+ :error-fn 'ignore ;; will never be called
+ :timeout-fn
+ (when (functionp cb)
+ (lambda ()
+ (dape--repl-message
+ (format "* Command %s timeout *" command) 'error)
+ (funcall cb conn nil "Timed out")))))
+
+(defun dape--initialize (conn)
+ "Initialize and launch/attach adapter CONN."
+ (dape--with dape-request (conn
"initialize"
(list :clientID "dape"
- :adapterID (plist-get dape--config
+ :adapterID (plist-get (dape--config conn)
:type)
:pathFormat "path"
:linesStartAt1 t
@@ -1125,30 +1048,24 @@ See `dape--callback' for expected function signature."
:supportsStartDebuggingRequest t
;;:supportsVariableType t
))
- (if (not success)
- (dape--repl-message msg 'dape-repl-exit-code-fail)
- (setq dape--capabilities body)
- (let ((start-debugging (plist-get dape--config 'start-debugging)))
- (dape-request process
- (or (plist-get dape--config :request) "launch")
- (append
- (cl-loop for (key value) on dape--config by 'cddr
- when (keywordp key)
- append (list key value))
- start-debugging)
- (dape--callback
- ;; nil start-debugging only if started as a part of
- ;; a start-debugging request
- (when start-debugging
- (plist-put dape--config 'start-debugging nil))
- (unless success
- (dape--repl-message msg 'dape-repl-exit-code-fail)
- (dape-kill)))
- ;; dlv adapter takes some time during launch request
- 'skip-timeout)))))
-
-(defun dape--set-breakpoints-in-buffer (process buffer &optional cb)
- "Set breakpoints in BUFFER by send setBreakpoints request to PROCESS.
+ (if error-message
+ (progn
+ (dape--repl-message error-message 'dape-repl-exit-code-fail)
+ (dape-kill conn))
+ (setf (dape--capabilities conn) body)
+ (dape--with dape-request
+ (conn
+ (or (plist-get (dape--config conn) :request) "launch")
+ (cl-loop for (key value) on (dape--config conn) by 'cddr
+ when (keywordp key)
+ append (list key (or value :json-false))))
+ (if error-message
+ (progn (dape--repl-message error-message 'dape-repl-exit-code-fail)
+ (dape-kill conn))
+ (setf (dape--initialized-p conn) t))))))
+
+(defun dape--set-breakpoints-in-buffer (conn buffer &optional cb)
+ "Set breakpoints in BUFFER for adapter CONN.
BREAKPOINTS is an list of breakpoint overlays.
See `dape--callback' for expected CB signature."
(let* ((breakpoints (and (buffer-live-p buffer)
@@ -1164,8 +1081,8 @@ See `dape--callback' for expected CB signature."
(list
:name (file-name-nondirectory
(buffer-file-name buffer))
- :path (dape--path (buffer-file-name buffer)
'remote))))))
- (dape-request process
+ :path (dape--path conn (buffer-file-name buffer)
'remote))))))
+ (dape-request conn
"setBreakpoints"
(list
:source source
@@ -1186,12 +1103,12 @@ See `dape--callback' for expected CB signature."
:lines (apply 'vector lines))
cb)))
-(defun dape--set-exception-breakpoints (process cb)
- "Set the exception breakpoints in adapter PROCESS.
+(defun dape--set-exception-breakpoints (conn cb)
+ "Set the exception breakpoints for adapter CONN.
The exceptions are derived from `dape--exceptions'.
See `dape--callback' for expected CB signature."
(if dape--exceptions
- (dape-request process
+ (dape-request conn
"setExceptionBreakpoints"
(list
:filters
@@ -1202,10 +1119,10 @@ See `dape--callback' for expected CB signature."
(plist-get exception :enabled))
dape--exceptions)))
cb)
- (funcall cb process)))
+ (funcall cb conn)))
-(defun dape--configure-exceptions (process cb)
- "Configure exception breakpoints in adapter PROCESS.
+(defun dape--configure-exceptions (conn cb)
+ "Configure exception breakpoints for adapter CONN.
The exceptions are derived from `dape--exceptions'.
See `dape--callback' for expected CB signature."
(setq dape--exceptions
@@ -1223,16 +1140,15 @@ See `dape--callback' for expected CB signature."
;; new exception
(t
(plist-put exception :enabled
- (plist-get exception :default))))))
- (plist-get dape--capabilities
+ (eq (plist-get exception :default) t))))))
+ (plist-get (dape--capabilities conn)
:exceptionBreakpointFilters)))
- (dape--set-exception-breakpoints process
- (dape--callback
- (run-hooks 'dape-update-ui-hooks)
- (funcall cb process))))
+ (dape--with dape--set-exception-breakpoints (conn)
+ (run-hook-with-args 'dape-update-ui-hooks conn)
+ (funcall cb conn)))
-(defun dape--set-breakpoints (process cb)
- "Set breakpoints in adapter PROCESS.
+(defun dape--set-breakpoints (conn cb)
+ "Set breakpoints for adapter CONN.
See `dape--callback' for expected CB signature."
(if-let ((buffers
(thread-last dape--breakpoints
@@ -1240,50 +1156,49 @@ See `dape--callback' for expected CB signature."
(mapcar 'car)))
(responses 0))
(dolist (buffer buffers)
- (dape--with dape--set-breakpoints-in-buffer (process buffer)
+ (dape--with dape--set-breakpoints-in-buffer (conn buffer)
(setq responses (1+ responses))
(when (eq responses (length buffers))
- (funcall cb process nil))))
- (funcall cb process nil)))
-
-(defun dape--get-threads (process stopped-id all-threads-stopped cb)
- "Helper for the stopped event to update `dape--threads'."
- (dape-request process
- "threads"
- nil
- (dape--callback
- (setq dape--threads
- (cl-map
- 'list
- (lambda (new-thread)
- (let ((thread
- (or (seq-find
- (lambda (old-thread)
- (eq (plist-get new-thread :id)
- (plist-get old-thread :id)))
- dape--threads)
- new-thread)))
- (plist-put thread :name
- (plist-get new-thread :name))
- (cond
- (all-threads-stopped
- (plist-put thread :status "stopped"))
- ((eq (plist-get thread :id) stopped-id)
- (plist-put thread :status "stopped"))
- (t thread))))
- (plist-get body :threads)))
- (funcall cb process))))
-
-(defun dape--stack-trace (process thread cb)
- "Update the stack trace in THREAD plist by adapter PROCESS.
+ (funcall cb conn nil))))
+ (funcall cb conn nil)))
+
+(defun dape--update-threads (conn stopped-id all-threads-stopped cb)
+ "Helper for the stopped event to update `dape--threads'.
+Update adapter CONN threads with STOPPED-ID and ALL-THREADS-STOPPED.
+See `dape--callback' for expected CB signature."
+ (dape--with dape-request (conn "threads" nil)
+ (setf (dape--threads conn)
+ (cl-map
+ 'list
+ (lambda (new-thread)
+ (let ((thread
+ (or (seq-find
+ (lambda (old-thread)
+ (eq (plist-get new-thread :id)
+ (plist-get old-thread :id)))
+ (dape--threads conn))
+ new-thread)))
+ (plist-put thread :name
+ (plist-get new-thread :name))
+ (cond
+ (all-threads-stopped
+ (plist-put thread :status "stopped"))
+ ((eq (plist-get thread :id) stopped-id)
+ (plist-put thread :status "stopped"))
+ (t thread))))
+ (plist-get body :threads)))
+ (funcall cb conn)))
+
+(defun dape--stack-trace (conn thread cb)
+ "Update stack trace in THREAD plist by adapter CONN.
See `dape--callback' for expected CB signature."
(cond
((or (not (equal (plist-get thread :status) "stopped"))
(plist-get thread :stackFrames)
(not (integerp (plist-get thread :id))))
- (funcall cb process))
+ (funcall cb conn))
(t
- (dape-request process
+ (dape-request conn
"stackTrace"
(list :threadId (plist-get thread :id)
:levels 50)
@@ -1292,17 +1207,17 @@ See `dape--callback' for expected CB signature."
(cl-map 'list
'identity
(plist-get body :stackFrames)))
- (funcall cb process))))))
+ (funcall cb conn))))))
-(defun dape--variables (process object cb)
- "Update OBJECTs variables by adapter PROCESS.
+(defun dape--variables (conn object cb)
+ "Update OBJECTs variables by adapter CONN.
See `dape--callback' for expected CB signature."
(let ((variables-reference (plist-get object :variablesReference)))
(if (or (not (numberp variables-reference))
(zerop variables-reference)
(plist-get object :variables))
- (funcall cb process)
- (dape-request process
+ (funcall cb conn)
+ (dape-request conn
"variables"
(list :variablesReference variables-reference)
(dape--callback
@@ -1311,89 +1226,89 @@ See `dape--callback' for expected CB signature."
(thread-last (plist-get body :variables)
(cl-map 'list 'identity)
(seq-filter 'identity)))
- (funcall cb process))))))
+ (funcall cb conn))))))
-(defun dape--variables-recursive (process object path pred cb)
+(defun dape--variables-recursive (conn object path pred cb)
"Update variables recursivly.
-Get variable data from PROCESS and put result on OBJECT until PRED is nil.
+Get variable data from CONN and put result on OBJECT until PRED is nil.
PRED is called with PATH and OBJECT.
See `dape--callback' for expected CB signature."
(let ((objects
(seq-filter (apply-partially pred path)
(or (plist-get object :scopes)
(plist-get object :variables))))
- (requests 0))
+ (responses 0))
(if objects
(dolist (object objects)
- (dape--with dape--variables (process object)
- (dape--with dape--variables-recursive (process
+ (dape--with dape--variables (conn object)
+ (dape--with dape--variables-recursive (conn
object
(cons (plist-get object
:name)
path)
pred)
- (setq requests (1+ requests))
- (when (length= objects requests)
- (funcall cb process)))))
- (funcall cb process))))
+ (setq responses (1+ responses))
+ (when (length= objects responses)
+ (funcall cb conn)))))
+ (funcall cb conn))))
-(defun dape--evaluate-expression (process frame-id expression context cb)
- "Send evaluate request to PROCESS.
+(defun dape--evaluate-expression (conn frame-id expression context cb)
+ "Send evaluate request to adapter CONN.
FRAME-ID specifies which frame the EXPRESSION is evaluated in and
CONTEXT which the result is going to be displayed in.
See `dape--callback' for expected CB signature."
- (dape-request process
+ (dape-request conn
"evaluate"
- (append (when (dape--stopped-threads)
+ (append (when (dape--stopped-threads conn)
(list :frameId frame-id))
(list :expression expression
:context context))
cb))
-(defun dape--set-variable (process ref variable value)
- "Set VARIABLE VALUE with REF by request to PROCESS.
+(defun dape--set-variable (conn ref variable value)
+ "Set VARIABLE VALUE with REF in adapter CONN.
REF should refer to VARIABLE container.
See `dape--callback' for expected CB signature."
(cond
- ((and (plist-get dape--capabilities :supportsSetVariable)
+ ((and (dape--capable-p conn :supportsSetVariable)
(numberp ref))
(dape--with dape-request
- (process
+ (conn
"setVariable"
(list
:variablesReference ref
:name (plist-get variable :name)
:value value))
- (if (not success)
- (message "%s" msg)
+ (if error-message
+ (message "%s" error-message)
(plist-put variable :variables nil)
(cl-loop for (key value) on body by 'cddr
do (plist-put variable key value))
- (run-hooks 'dape-update-ui-hooks))))
- ((and (plist-get dape--capabilities :supportsSetExpression)
+ (run-hook-with-args 'dape-update-ui-hooks conn))))
+ ((and (dape--capable-p conn :supportsSetExpression)
(or (plist-get variable :evaluateName)
(plist-get variable :name)))
(dape--with dape-request
- (process
+ (conn
"setExpression"
- (list :frameId (plist-get (dape--current-stack-frame) :id)
+ (list :frameId (plist-get (dape--current-stack-frame conn) :id)
:expression (or (plist-get variable :evaluateName)
(plist-get variable :name))
:value value))
- (if (not success)
- (message "%s" msg)
+ (if error-message
+ (message "%s" error-message)
;; FIXME: js-debug caches variables response for each stop
;; therefore it's not to just refresh all variables as it will
;; return the old value
- (dape--update process nil t))))
+ (dape--update conn nil t))))
((user-error "Unable to set variable"))))
-(defun dape--scopes (process stack-frame cb)
- "Send scopes request to PROCESS for STACK-FRAME plist.
+(defun dape--scopes (conn stack-frame cb)
+ "Send scopes request to CONN for STACK-FRAME plist.
See `dape--callback' for expected CB signature."
(if-let ((id (plist-get stack-frame :id))
((not (plist-get stack-frame :scopes))))
- (dape-request process
+ (dape-request conn
"scopes"
(list :frameId id)
(dape--callback
@@ -1401,58 +1316,45 @@ See `dape--callback' for expected CB signature."
'identity
(plist-get body :scopes))))
(plist-put stack-frame :scopes scopes)
- (funcall cb process))))
- (funcall cb process)))
+ (funcall cb conn))))
+ (funcall cb conn)))
-(defun dape--inactive-threads-stack-trace (process cb)
- (if (not dape--threads)
- (funcall cb process)
+(defun dape--inactive-threads-stack-trace (conn cb)
+ "Populate CONN stack frame data for all threads.
+See `dape--callback' for expected CB signature."
+ (if (not (dape--threads conn))
+ (funcall cb conn)
(let ((responses 0))
- (dolist (thread dape--threads)
- (dape--with dape--stack-trace (process thread)
+ (dolist (thread (dape--threads conn))
+ (dape--with dape--stack-trace (conn thread)
(setq responses (1+ responses))
- (when (length= dape--threads responses)
- (funcall cb process)))))))
+ (when (length= (dape--threads conn) responses)
+ (funcall cb conn)))))))
-(defun dape--update (process
+(defun dape--update (conn
&optional skip-clear-stack-frames
skip-stack-pointer-flash)
- "Update dape data and ui.
-PROCESS specifies adapter process.
-If SKIP-CLEAR-STACK-FRAMES not all stack frame data is cleared. This
-is usefully if only to load data for another thread."
- (let ((current-thread (dape--current-thread)))
+ "Update adapter CONN data and ui.
+If SKIP-CLEAR-STACK-FRAMES no stack frame data is cleared. This
+is usefully if only to load data for another thread.
+If SKIP-STACK-POINTER-FLASH skip flashing after placing stack pointer."
+ (let ((current-thread (dape--current-thread conn)))
(unless skip-clear-stack-frames
- (dolist (thread dape--threads)
+ (dolist (thread (dape--threads conn))
(plist-put thread :stackFrames nil)))
- (dape--with dape--stack-trace (process current-thread)
- (dape--update-stack-pointers skip-stack-pointer-flash)
- (dape--with dape--scopes (process (dape--current-stack-frame))
- (run-hooks 'dape-update-ui-hooks)))))
+ (dape--with dape--stack-trace (conn current-thread)
+ (dape--update-stack-pointers conn skip-stack-pointer-flash)
+ (dape--with dape--scopes (conn (dape--current-stack-frame conn))
+ (run-hook-with-args 'dape-update-ui-hooks conn)))))
;;; Incoming requests
-(defun dape--response (process command seq success &optional body)
- "Send request response for COMMAND for SEQ with SUCCESS and BODY.
-Adapter is identified with PROCESS."
- (dape-send-object process
- nil
- (append (list :type "response"
- :request_seq seq
- :success success
- :command command)
- (when body
- (list :body body)))))
-
-(cl-defgeneric dape-handle-request (_process command _seq arguments)
- "Sink for all unsupported requests."
- (dape--debug 'info "Unhandled request '%S' with arguments %S"
- command
- arguments))
-
-(cl-defmethod dape-handle-request (_process (_command (eql runInTerminal))
_seq arguments)
+(cl-defgeneric dape-handle-request (_conn _command _arguments)
+ "Sink for all unsupported requests." nil)
+
+(cl-defmethod dape-handle-request (_conn (_command (eql runInTerminal))
arguments)
"Handle runInTerminal requests.
-Starts a new process to run process to be debugged."
+Starts a new adapter CONNs from ARGUMENTS."
(let ((default-directory (or (plist-get arguments :cwd)
default-directory))
(process-environment
@@ -1473,140 +1375,141 @@ Starts a new process to run process to be debugged."
buffer
buffer)
(dape--display-buffer buffer)
- ;; For debugpy crashes if we send an response... it expects seq
- ;; in response which makes no sense
- ;; (dape--response process (symbol-name command) seq t
- ;; `(:processID ,pid))
- ))
-
-(cl-defmethod dape-handle-request (process (command (eql startDebugging)) seq
arguments)
- "Handle startDebugging requests.
-Starts a new process as per request of the debug adapter."
- (dape--response process (symbol-name command) seq t)
- (setq dape--parent-process dape--process)
- ;; js-vscode leaves launch request un-answered
- (when (hash-table-p dape--timers)
- (dolist (timer (hash-table-values dape--timers))
- (cancel-timer timer)))
- (dape--create-connection (plist-put dape--config
- 'start-debugging
- (plist-get arguments :configuration))))
+ nil))
+
+(cl-defmethod dape-handle-request (conn (_command (eql startDebugging))
arguments)
+ "Handle adapter CONNs startDebugging requests with ARGUMENTS.
+Starts a new adapter connection as per request of the debug adapter."
+ (let ((config (plist-get arguments :configuration)))
+ (cl-loop for (key value) on (dape--config conn) by 'cddr
+ unless (or (keywordp key)
+ (eq key 'command))
+ do (plist-put config key value))
+ (setq dape--connection (dape--create-connection config conn))
+ (dape--start-debugging dape--connection))
+ nil)
;;; Events
-(cl-defgeneric dape-handle-event (_process event body)
- "Sink for all unsupported events."
- (dape--debug 'info "Unhandled event '%S' with body %S" event body))
-
-(cl-defmethod dape-handle-event (process (_event (eql initialized)) _body)
- "Handle initialized events."
- (dape--update-state 'initialized)
- (dape--with dape--configure-exceptions (process)
- (dape--with dape--set-breakpoints (process)
- (dape-request process "configurationDone" nil))))
-
-(cl-defmethod dape-handle-event (process (_event (eql capabilities)) body)
- "Handle capabilities events."
- (setq dape--capabilities (plist-get body :capabilities))
- (dape--debug 'info "Capabailities recived")
- (dape--configure-exceptions process (dape--callback nil)))
-
-(cl-defmethod dape-handle-event (_process (_event (eql module)) body)
- "Handle module events."
+(cl-defgeneric dape-handle-event (_conn _event _body)
+ "Sink for all unsupported events." nil)
+
+(cl-defmethod dape-handle-event (conn (_event (eql initialized)) _body)
+ "Handle adapter CONNs initialized events."
+ (dape--update-state conn 'initialized)
+ (dape--with dape--configure-exceptions (conn)
+ (dape--with dape--set-breakpoints (conn)
+ (dape-request conn "configurationDone" nil))))
+
+(cl-defmethod dape-handle-event (conn (_event (eql capabilities)) body)
+ "Handle adapter CONNs capabilities events.
+BODY is an plist of adapter capabilities."
+ (setf (dape--capabilities conn) (plist-get body :capabilities))
+ (dape--configure-exceptions conn (dape--callback nil)))
+
+(cl-defmethod dape-handle-event (conn (_event (eql module)) body)
+ "Handle adapter CONNs module events.
+Stores `dape--modules' from BODY."
(let ((reason (plist-get body :reason))
(id (thread-first body (plist-get :module) (plist-get :id))))
(pcase reason
("new"
- (setq dape--modules
- (push (plist-get body :module) dape--modules)))
+ (push (plist-get body :module) (dape--modules conn)))
("changed"
- (cl-loop with plist = (cl-find id dape--modules
+ (cl-loop with plist = (cl-find id (dape--modules conn)
:key (lambda (module)
(plist-get module :id)))
for (key value) on body by 'cddr
do (plist-put plist key value)))
("removed"
- (cl-delete id (lambda (module) (= (plist-get module :id) id))
+ (cl-delete id (dape--modules conn)
:key (lambda (module) (plist-get module :id)))))))
-(cl-defmethod dape-handle-event (_process (_event (eql loadedSource)) body)
- "Handle loadedSource events."
+(cl-defmethod dape-handle-event (conn (_event (eql loadedSource)) body)
+ "Handle adapter CONNs loadedSource events.
+Stores `dape--sources' from BODY."
(let ((reason (plist-get body :reason))
(id (thread-first body (plist-get :source) (plist-get :id))))
(pcase reason
("new"
- (setq dape--sources
- (push (plist-get body :source) dape--sources)))
+ (push (plist-get body :source) (dape--sources conn)))
("changed"
- (cl-loop with plist = (cl-find id dape--sources
+ (cl-loop with plist = (cl-find id (dape--sources conn)
:key (lambda (source)
(plist-get source :id)))
for (key value) on body by 'cddr
do (plist-put plist key value)))
("removed"
- (cl-delete id (lambda (source) (= (plist-get source :id) id))
+ (cl-delete id (dape--sources conn)
:key (lambda (source) (plist-get source :id)))))))
-(cl-defmethod dape-handle-event (_process (_event (eql process)) body)
- "Handle process events."
+(cl-defmethod dape-handle-event (conn (_event (eql process)) body)
+ "Handle adapter CONNs process events.
+Logs and sets state based on BODY contents."
(let ((start-method (format "%sed"
(or (plist-get body :startMethod)
"start"))))
- (dape--update-state (intern start-method))
+ (dape--update-state conn (intern start-method))
(dape--repl-message (format "Process %s %s"
start-method
(plist-get body :name)))))
-(cl-defmethod dape-handle-event (_process (_event (eql thread)) body)
- "Handle thread events."
+(cl-defmethod dape-handle-event (conn (_event (eql thread)) body)
+ "Handle adapter CONNs thread events.
+Stores `dape--thread-id' and updates/adds thread in
+`dape--thread' from BODY."
(if-let ((thread
(seq-find (lambda (thread)
(eq (plist-get thread :id)
(plist-get body :threadId)))
- dape--threads)))
+ (dape--threads conn))))
(progn
(plist-put thread :status (plist-get body :reason))
(plist-put thread :name (or (plist-get thread :name)
"unnamed")))
;; If new thread use thread state as global state
- (dape--update-state (intern (plist-get body :reason)))
+ (dape--update-state conn (intern (plist-get body :reason)))
(push (list :status (plist-get body :reason)
:id (plist-get body :threadId)
:name "unnamed")
- dape--threads))
+ (dape--threads conn)))
;; Select thread if we don't have any thread selected
- (unless dape--thread-id
- (setq dape--thread-id (plist-get body :threadId)))
- (run-hooks 'dape-update-ui-hooks))
-
-(cl-defmethod dape-handle-event (process (_event (eql stopped)) body)
- "Handle stopped events."
- (dape--update-state 'stopped)
- (setq dape--thread-id (plist-get body :threadId))
- (dape--get-threads process
- (plist-get body :threadId)
- (plist-get body :allThreadsStopped)
- (dape--callback
- (dape--update process)))
- (when-let ((texts (seq-filter 'stringp
- (list (plist-get body :text)
- (plist-get body :description)))))
+ (unless (dape--thread-id conn)
+ (setf (dape--thread-id conn) (plist-get body :threadId)))
+ (run-hook-with-args 'dape-update-ui-hooks conn))
+
+(cl-defmethod dape-handle-event (conn (_event (eql stopped)) body)
+ "Handle adapter CONNs stopped events.
+Sets `dape--thread-id' from BODY and invokes ui refresh with
+`dape--update'."
+ (dape--update-state conn 'stopped)
+ (setf (dape--thread-id conn) (plist-get body :threadId))
+ (dape--update-threads conn
+ (plist-get body :threadId)
+ (plist-get body :allThreadsStopped)
+ (dape--callback
+ (dape--update conn)))
+ (when-let ((texts
+ (seq-filter 'stringp
+ (list (plist-get body :text)
+ (plist-get body :description)))))
(dape--repl-message (mapconcat 'identity texts "\n")
(when (equal "exception"
- (plist-get body :reason))
+ (plist-get body :reason))
'error)))
(run-hooks 'dape-on-stopped-hooks))
-(cl-defmethod dape-handle-event (_process (_event (eql continued)) body)
- "Handle continued events."
- (dape--update-state 'running)
+(cl-defmethod dape-handle-event (conn (_event (eql continued)) body)
+ "Handle adapter CONN continued events.
+Sets `dape--thread-id' from BODY if not set."
+ (dape--update-state conn 'running)
(dape--remove-stack-pointers)
- (unless dape--thread-id
- (setq dape--thread-id (plist-get body :threadId))))
+ (unless (dape--thread-id conn)
+ (setf (dape--thread-id conn) (plist-get body :threadId))))
-(cl-defmethod dape-handle-event (_process (_event (eql output)) body)
- "Handle output events."
+(cl-defmethod dape-handle-event (_conn (_event (eql output)) body)
+ "Handle output events by printing BODY with `dape--repl-message'."
(pcase (plist-get body :category)
("stdout"
(dape--repl-message (plist-get body :output)))
@@ -1615,9 +1518,10 @@ Starts a new process as per request of the debug
adapter."
((or "console" "output")
(dape--repl-message (plist-get body :output)))))
-(cl-defmethod dape-handle-event (_process (_event (eql exited)) body)
- "Handle exited events."
- (dape--update-state 'exited)
+(cl-defmethod dape-handle-event (conn (_event (eql exited)) body)
+ "Handle adapter CONNs exited events.
+Prints exit code from BODY."
+ (dape--update-state conn 'exited)
(dape--remove-stack-pointers)
(dape--repl-message (format "* Exit code: %d *"
(plist-get body :exitCode))
@@ -1625,85 +1529,73 @@ Starts a new process as per request of the debug
adapter."
'dape-repl-exit-code-exit
'dape-repl-exit-code-fail)))
-(cl-defmethod dape-handle-event (_process (_event (eql terminated)) _body)
- "Handle terminated events."
- (dape--update-state 'terminated)
+(cl-defmethod dape-handle-event (conn (_event (eql terminated)) _body)
+ "Handle adapter CONNs terminated events.
+Killing the adapter and it's CONN."
(dape--remove-stack-pointers)
- (dape--repl-message "* Program terminated *" 'italic)
- (unless dape--restart-in-progress
- (dape-kill)))
+ (when-let ((parent (dape--parent conn)))
+ ;; Prevent double printing of terminated, caused by
+ ;; parent termination
+ (setf (dape--state parent) 'terminated))
+ (unless (eq (dape--state conn) 'terminated)
+ ;; Prevent double priniting of terminated, caused by
+ ;; adapter responding to `dape-kill' "disconnect" request.
+ (dape--repl-message "* Session terminated *"))
+ (dape--update-state conn 'terminated)
+ (unless (dape--restart-in-progress-p conn)
+ (dape-kill conn)))
;;; Startup/Setup
-(defun dape--setup (process config)
- "Helper for dape--start-* functions."
+(defun dape--start-debugging (conn)
+ "Preform some cleanup and start debugging with CONN."
(dape--remove-stack-pointers)
;; FIXME Cleanup source buffers in a nicer way
(cl-loop for (_ buffer) on dape--source-buffers by 'cddr
do (when (buffer-live-p buffer)
(kill-buffer buffer)))
- (setq dape--config config
- dape--seq 0
- dape--timers (make-hash-table)
- dape--cb (make-hash-table)
- dape--thread-id nil
- dape--capabilities nil
- dape--threads nil
- dape--modules nil
- dape--sources nil
- dape--stack-id nil
+ (setq dape--connection conn
dape--source-buffers nil
- dape--process process
- dape--restart-in-progress nil
- dape--repl-insert-text-guard nil)
- (dape--update-state 'starting)
- (run-hook-with-args 'dape-on-start-hooks)
- (run-hooks 'dape-update-ui-hooks)
- (dape--initialize process))
-
-(defun dape--get-buffer ()
- "Setup and get *dape-processes* buffer."
- (let ((buffer (get-buffer-create "*dape-processes*")))
- (with-current-buffer buffer
- (let ((inhibit-read-only t))
- (erase-buffer)))
- buffer))
-
-(defun dape--create-connection (config)
- (dape--debug 'info "Starting new session with config:\n%S" config)
- (let ((buffer (dape--get-buffer))
- (default-directory (or (plist-get config 'command-cwd)
+ dape--repl-insert-text-guard nil
+ dape--mode-line-active t)
+ (dape--update-state conn 'starting)
+ (run-hook-with-args 'dape-update-ui-hooks conn)
+ (dape--initialize conn))
+
+(defun dape--create-connection (config &optional parent)
+ "Create symbol `dape-connection' instance from CONFIG.
+If started by an startDebugging request expects PARENT to
+symbol `dape-connection'."
+ (run-hooks 'dape-on-start-hooks)
+ (dape--repl-message "\n")
+ (let ((default-directory (or (plist-get config 'command-cwd)
default-directory))
(retries 30)
- process)
+ process server-process)
(cond
- ;; socket connection
+ ;; socket conn
((plist-get config 'port)
;; start server
- (when (and (plist-get config 'command)
- (not (plist-get config 'start-debugging)))
- (setq dape--server-process
- (make-process :name "Dape adapter"
- :command (cons (plist-get config 'command)
- (cl-map 'list 'identity
- (plist-get config
'command-args)))
- :buffer buffer
- :sentinel 'dape--process-sentinel
- :filter (lambda (_process string)
- (dape--repl-message string))
- :noquery t
- :file-handler t
- :stderr
- (make-pipe-process
- :name "Dape adapter stderr"
- :filter (lambda (_process string)
- (dape--debug 'std-server
- "Server stdout:\n%s"
- string))
- :buffer buffer)))
- (dape--debug 'info "Server process started %S"
- (process-command dape--server-process))
+ (when (plist-get config 'command)
+ (let ((stderr-buffer
+ (generate-new-buffer "*dape-server stderr*"))
+ (command
+ (cons (plist-get config 'command)
+ (cl-map 'list 'identity
+ (plist-get config 'command-args)))))
+ (setq server-process
+ (make-process :name "Dape adapter"
+ :command command
+ :filter (lambda (_process string)
+ (dape--repl-message string))
+ :noquery t
+ :file-handler t
+ :stderr stderr-buffer))
+ (process-put server-process 'stderr-buffer stderr-buffer)
+ (dape--repl-message (format "* Adapter server started with %S *"
+ (mapconcat 'identity
+ command " "))))
;; FIXME Why do I need this?
(when (file-remote-p default-directory)
(sleep-for 0 300)))
@@ -1713,164 +1605,213 @@ Starts a new process as per request of the debug
adapter."
(> retries 0))
(ignore-errors
(setq process
- (make-network-process :name "Dape adapter connection"
- :buffer buffer
+ (make-network-process :name
+ (format "dape adapter%s connection"
+ (if parent " child" ""))
:host host
:coding 'utf-8-emacs-unix
:service (plist-get config 'port)
- :sentinel 'dape--process-sentinel
- :filter 'dape--process-filter
:noquery t)))
(sleep-for 0 100)
(setq retries (1- retries)))
(if (zerop retries)
- (progn (dape-kill)
- (user-error "Unable to connect to server %s:%d"
- host
- (plist-get config 'port)))
- (dape--debug 'info "Connection to server established %s:%s"
- host (plist-get config 'port)))))
- ;; stdio connection
+ (progn
+ (dape--repl-message (format "Unable to connect to server %s:%d"
+ host (plist-get config 'port))
+ 'error)
+ ;; barf server std-err
+ (when-let ((buffer
+ (and server-process
+ (process-get server-process 'stderr-buffer))))
+ (with-current-buffer buffer
+ (dape--repl-message (buffer-string) 'error)))
+ (delete-process server-process)
+ (user-error "Unable to connect to server."))
+ (dape--repl-message (format "* %s to adapter established at %s:%s *"
+ (if parent "Child connection"
"Connection")
+ host (plist-get config 'port))))))
+ ;; stdio conn
(t
- (setq process (make-process :name "Dape adapter"
- :command (cons (plist-get config 'command)
- (cl-map 'list 'identity
- (plist-get config
'command-args)))
- :connection-type 'pipe
- :coding 'utf-8-emacs-unix
- :sentinel 'dape--process-sentinel
- :filter 'dape--process-filter
- :buffer buffer
- :noquery t
- :file-handler t))
- (dape--debug 'info "Process started %S" (process-command process))))
- (dape--setup process config)))
+ (let ((command
+ (cons (plist-get config 'command)
+ (cl-map 'list 'identity
+ (plist-get config 'command-args)))))
+ (setq process
+ (make-process :name "dape adapter"
+ :command command
+ :connection-type 'pipe
+ :coding 'utf-8-emacs-unix
+ :noquery t
+ :file-handler t))
+ (dape--repl-message (format "* Adapter started with %S *"
+ (mapconcat 'identity command " "))))))
+ (make-instance 'dape-connection
+ :name "dape-connection"
+ :config config
+ :parent parent
+ :server-process server-process
+ :on-shutdown
+ (lambda (conn)
+ ;; error prints
+ (unless (dape--initialized-p conn)
+ (dape--repl-message "Connection ended without
successfully initializing"
+ 'error)
+ ; barf config
+ (dape--repl-message
+ (format "With adapter request:\n%s"
+ (pp-to-string
+ (cl-loop for (key value) on (dape--config
conn) by 'cddr
+ when (keywordp key)
+ append (list key value))))
+ 'error)
+ ;; barf connection stderr
+ (when-let* ((proc (jsonrpc--process conn))
+ (buffer (process-get proc 'jsonrpc-stderr)))
+ (with-current-buffer buffer
+ (dape--repl-message (buffer-string) 'error)))
+ ;; barf server stderr
+ (when-let* ((server-proc (dape--server-process conn))
+ (buffer (process-get server-proc
'stderr-buffer)))
+ (with-current-buffer buffer
+ (dape--repl-message (buffer-string)
+ 'error))))
+ ;; cleanup server process
+ (when-let ((server-process
+ (dape--server-process conn)))
+ (delete-process server-process)
+ (while (process-live-p server-process)
+ (accept-process-output nil nil 0.1)))
+ ;; cleanup parent
+ (when-let ((parent (dape--parent conn)))
+ (jsonrpc-shutdown parent))
+ ;; ui
+ (dape--remove-stack-pointers)
+ (run-with-timer 1 nil (lambda ()
+ (when (eq dape--connection conn)
+ (setq dape--mode-line-active
nil)
+ (force-mode-line-update t)))))
+ :request-dispatcher 'dape-handle-request
+ :notification-dispatcher 'dape-handle-event
+ :process process)))
;;; Commands
-(defun dape-next ()
- "Step one line (skip functions)."
- (interactive)
- (dape--next-like-command "next"))
-
-(defun dape-step-in ()
- "Steps into function/method. If not possible behaves like `dape-next'."
- (interactive)
- (dape--next-like-command "stepIn"))
-
-(defun dape-step-out ()
- "Steps out of function/method. If not possible behaves like `dape-next'."
- (interactive)
- (dape--next-like-command "stepOut"))
-
-(defun dape-continue ()
- "Resumes execution."
- (interactive)
- (unless (dape--stopped-threads)
+(defun dape-next (conn)
+ "Step one line (skip functions)
+CONN is inferred for interactive invocations."
+ (interactive (list (dape--live-connection)))
+ (dape--next-like-command conn "next"))
+
+(defun dape-step-in (conn)
+ "Step into function/method. If not possible behaves like `dape-next'.
+CONN is inferred for interactive invocations."
+ (interactive (list (dape--live-connection)))
+ (dape--next-like-command conn "stepIn"))
+
+(defun dape-step-out (conn)
+ "Step out of function/method. If not possible behaves like `dape-next'.
+CONN is inferred for interactive invocations."
+ (interactive (list (dape--live-connection)))
+ (dape--next-like-command conn "stepOut"))
+
+(defun dape-continue (conn)
+ "Resumes execution.
+CONN is inferred for interactive invocations."
+ (interactive (list (dape--live-connection)))
+ (unless (dape--stopped-threads conn)
(user-error "No stopped threads"))
- (dape-request (dape--live-process)
- "continue"
- (dape--thread-id-object)
- (dape--callback
- (when success
- (dape--update-state 'running)
- (dape--remove-stack-pointers)
- (dolist (thread dape--threads)
- (plist-put thread :status "running"))
- (run-hooks 'dape-update-ui-hooks)))))
-
-(defun dape-pause ()
- "Pause execution."
- (interactive)
- (when (eq dape--state 'stopped)
+ (dape--with dape-request (conn
+ "continue"
+ (dape--thread-id-object conn))
+ (unless error-message
+ (dape--update-state conn 'running)
+ (dape--remove-stack-pointers)
+ (dolist (thread (dape--threads conn))
+ (plist-put thread :status "running"))
+ (run-hook-with-args 'dape-update-ui-hooks conn))))
+
+(defun dape-pause (conn)
+ "Pause execution.
+CONN is inferred for interactive invocations."
+ (interactive (list (dape--live-connection)))
+ (when (dape--stopped-threads conn)
;; cpptools crashes on pausing an paused thread
(user-error "Thread already is stopped"))
- (dape-request (dape--live-process) "pause" (dape--thread-id-object)))
+ (dape-request conn "pause" (dape--thread-id-object conn)))
-(defun dape-restart ()
- "Restart last debug session started."
- (interactive)
- (when (hash-table-p dape--timers)
- (dolist (timer (hash-table-values dape--timers))
- (cancel-timer timer)))
+(defun dape-restart (&optional conn)
+ "Restart debugging session.
+CONN is inferred for interactive invocations."
+ (interactive (list (dape--live-connection t)))
(dape--remove-stack-pointers)
(cond
- ((and (dape--live-process t)
- (plist-get dape--capabilities :supportsRestartRequest))
- (setq dape--threads nil)
- (setq dape--thread-id nil)
- (setq dape--restart-in-progress t)
- (dape-request dape--process "restart" nil
+ ((and conn
+ (dape--capable-p conn :supportsRestartRequest))
+ (setf (dape--threads conn) nil)
+ (setf (dape--thread-id conn) nil)
+ (setf (dape--restart-in-progress-p conn) t)
+ (dape-request conn "restart" nil
(dape--callback
- (setq dape--restart-in-progress nil))))
- ((and dape--config)
- (dape dape--config))
+ (setf (dape--restart-in-progress-p conn) nil))))
+ (dape-history
+ (dape (apply 'dape--config-eval (dape--config-from-string (car
dape-history)))))
((user-error "Unable to derive session to restart, run `dape'"))))
-(defun dape-kill (&optional process cb with-disconnect)
+(cl-defun dape-kill (conn &optional (cb 'ignore) with-disconnect)
"Kill debug session.
-CB will be called after adapter termination.
-With WITH-DISCONNECT use disconnect instead of terminate
-used internally as a fallback to terminate."
- (interactive)
- (when (hash-table-p dape--timers)
- (dolist (timer (hash-table-values dape--timers))
- (cancel-timer timer)))
- (let ((process
- (or process
- (and (process-live-p dape--parent-process)
- dape--parent-process)
- (dape--live-process t))))
- (cond
- ((and (not with-disconnect)
- process
- (plist-get dape--capabilities
- :supportsTerminateRequest))
- (dape-request dape--process
- "terminate"
- nil
- (dape--callback
- (if (not success)
- (dape-kill cb 'with-disconnect)
- (dape--kill-processes)
- (when cb
- (funcall cb nil))))))
- (process
- (dape-request dape--process
- "disconnect"
- `(:restart nil .
- ,(when (plist-get dape--capabilities
- :supportTerminateDebuggee)
- (list :terminateDebuggee t)))
- (dape--callback
- (dape--kill-processes)
- (when cb
- (funcall cb nil)))))
- (t
- (dape--kill-processes)
- (when cb
- (funcall cb nil))))))
+CB will be called after adapter termination. With WITH-DISCONNECT use
+disconnect instead of terminate used internally as a fallback to
+terminate. CONN is inferred for interactive invocations."
+ (interactive (list (dape--live-connection)))
+ (cond
+ ((and conn
+ (jsonrpc-running-p conn)
+ (not with-disconnect)
+ (dape--capable-p conn :supportsTerminateRequest))
+ (dape-request conn
+ "terminate"
+ nil
+ (dape--callback
+ (if error-message
+ (dape-kill cb 'with-disconnect)
+ (jsonrpc-shutdown conn)
+ (funcall cb)))))
+ ((and conn
+ (jsonrpc-running-p conn))
+ (dape-request conn
+ "disconnect"
+ `(:restart
+ :json-false
+ ,@(when (dape--capable-p conn :supportTerminateDebuggee)
+ (list :terminateDebuggee t)))
+ (dape--callback
+ (jsonrpc-shutdown conn)
+ (funcall cb))))
+ (t (funcall cb))))
-(defun dape-disconnect-quit ()
+(defun dape-disconnect-quit (conn)
"Kill adapter but try to keep debuggee live.
-This will leave a decoupled debuggee process with no debugge
- connection."
- (interactive)
+This will leave a decoupled debugged process with no debugge
+connection. CONN is inferred for interactive invocations."
+ (interactive (list (dape--live-connection)))
(dape--kill-buffers 'skip-process-buffers)
- (dape-request (dape--live-process)
+ (dape-request conn
"disconnect"
(list :terminateDebuggee nil)
(dape--callback
- (dape--kill-processes)
+ (jsonrpc-shutdown conn)
(dape--kill-buffers))))
-(defun dape-quit ()
- "Kill debug session and kill related dape buffers."
- (interactive)
+(defun dape-quit (&optional conn)
+ "Kill debug session and kill related dape buffers.
+CONN is inferred for interactive invocations."
+ (interactive (list (dape--live-connection t)))
(dape--kill-buffers 'skip-process-buffers)
- (dape-kill nil (dape--callback
- (dape--kill-buffers))))
+ (if conn
+ (dape-kill conn (dape--callback
+ (dape--kill-buffers)))
+ (dape--kill-buffers)))
(defun dape-breakpoint-toggle ()
"Add or remove breakpoint at current line.
@@ -1935,48 +1876,59 @@ SKIP-TYPES is a list of overlay properties to skip
removal of."
(pcase-let ((`(,buffer . ,breakpoints) buffer-breakpoints))
(dolist (breakpoint breakpoints)
(dape--breakpoint-remove breakpoint t))
- (when-let ((process (dape--live-process t)))
- (dape--set-breakpoints-in-buffer process buffer))))))
+ (when-let ((conn (dape--live-connection t)))
+ (dape--set-breakpoints-in-buffer conn buffer))))))
-(defun dape-select-thread (thread-id)
- "Selecte currrent thread by THREAD-ID."
+(defun dape-select-thread (conn thread-id)
+ "Select currrent thread for adapter CONN by THREAD-ID."
(interactive
(list
+ (dape--live-connection)
(let* ((collection
(mapcar (lambda (thread) (cons (plist-get thread :name)
(plist-get thread :id)))
- dape--threads))
+ (dape--threads (dape--live-connection))))
(thread-name
- (completing-read (format "Select thread (current %s): "
- (plist-get (dape--current-thread) :name))
- collection
- nil t)))
+ (completing-read
+ (format "Select thread (current %s): "
+ (thread-first (dape--live-connection)
+ (dape--current-stack-frame)
+ (plist-get :name)))
+ collection
+ nil t)))
(alist-get thread-name collection nil nil 'equal))))
- (setq dape--thread-id thread-id)
- (dape--update (dape--live-process) t))
+ (setf (dape--thread-id conn) thread-id)
+ (dape--update conn t))
-(defun dape-select-stack (stack-id)
- "Selected current stack by STACK-ID."
+(defun dape-select-stack (conn stack-id)
+ "Selected current stack for adapter CONN by STACK-ID."
(interactive
(list
+ (dape--live-connection)
(let* ((collection
(mapcar (lambda (stack) (cons (plist-get stack :name)
(plist-get stack :id)))
- (thread-first (dape--current-thread)
+ (thread-first (dape--live-connection)
+ (dape--current-thread)
(plist-get :stackFrames))))
(stack-name
(completing-read (format "Select stack (current %s): "
- (plist-get (dape--current-stack-frame)
:name))
+ (thread-first (dape--live-connection)
+ (dape--current-stack-frame)
+ (plist-get :name)))
collection
nil t)))
(alist-get stack-name collection nil nil 'equal))))
- (setq dape--stack-id stack-id)
- (dape--update (dape--live-process) t))
+ (setf (dape--stack-id conn) stack-id)
+ (dape--update conn t))
(defun dape-watch-dwim (expression &optional skip-add skip-remove)
"Add or remove watch for EXPRESSION.
-Watched symbols are displayed in *dape-info* buffer.
-*dape-info* buffer is displayed by executing the `dape-info' command."
+Watched symbols are displayed in *`dape-info' Watch* buffer.
+*`dape-info' Watch* buffer is displayed by executing the `dape-info'
+command.
+Optional argument SKIP-ADD limits usage to only removal of watched vars.
+Optional argument SKIP-REMOVE limits usage to only adding watched vars."
(interactive
(list (string-trim
(completing-read "Watch or unwatch symbol: "
@@ -2001,23 +1953,26 @@ Watched symbols are displayed in *dape-info* buffer.
dape--watched)
;; FIXME don't want to have a depency on info ui in core commands
(dape--display-buffer (dape--info-buffer 'dape-info-watch-mode))))
- (run-hooks 'dape-update-ui-hooks))
+ (run-hook-with-args 'dape-update-ui-hooks (dape--live-connection t)))
-(defun dape-evaluate-expression (expression)
+(defun dape-evaluate-expression (conn expression)
"Evaluate EXPRESSION.
EXPRESSION can be an expression or adapter command, as it's evaluated in
-repl context."
+repl context. CONN is inferred for interactive invocations."
(interactive
- (list (string-trim
- (read-string "Evaluate: "
- (or (and (region-active-p)
- (buffer-substring (region-beginning)
- (region-end)))
- (thing-at-point 'symbol))))))
- (dape--with dape--evaluate-expression ((dape--live-process)
- (plist-get
(dape--current-stack-frame) :id)
- (substring-no-properties expression)
- "repl")
+ (list
+ (dape--live-connection)
+ (string-trim
+ (read-string "Evaluate: "
+ (or (and (region-active-p)
+ (buffer-substring (region-beginning)
+ (region-end)))
+ (thing-at-point 'symbol))))))
+ (dape--with dape--evaluate-expression
+ (conn
+ (plist-get (dape--current-stack-frame conn) :id)
+ (substring-no-properties expression)
+ "repl")
(message "%s" (plist-get body :result))))
;;;###autoload
@@ -2037,7 +1992,7 @@ Executes alist key `launch' in `dape-configs' with
:program as \"bin\".
Use SKIP-COMPILE to skip compilation."
(interactive (list (dape--read-config)))
- (dape--with dape-kill (nil)
+ (dape--with dape-kill ((dape--live-connection t))
(when-let ((fn (plist-get config 'fn))
(fns (or (and (functionp fn) (list fn))
(and (listp fn) fn))))
@@ -2052,19 +2007,21 @@ Use SKIP-COMPILE to skip compilation."
(with-current-buffer buffer
(let ((inhibit-read-only t))
(erase-buffer))))
- (dape--create-connection config))))
+ (dape--start-debugging (dape--create-connection config)))))
;;; Compile
+(defvar dape--compile-config nil)
+
(defun dape--compile-compilation-finish (buffer str)
"Hook for `dape--compile-compilation-finish'.
-Removes itself on execution."
+Using BUFFER and STR."
(remove-hook 'compilation-finish-functions
#'dape--compile-compilation-finish)
(cond
((equal "finished\n" str)
(run-hook-with-args 'dape-compile-compile-hooks buffer)
- (dape dape--config 'skip-compile))
+ (dape dape--compile-config 'skip-compile))
(t
(dape--repl-message (format "* Compilation failed %s *" str)))))
@@ -2072,7 +2029,7 @@ Removes itself on execution."
"Start compilation for CONFIG."
(let ((default-directory (plist-get config :cwd))
(command (plist-get config 'compile)))
- (setq dape--config config)
+ (setq dape--compile-config config)
(add-hook 'compilation-finish-functions #'dape--compile-compilation-finish)
(funcall dape-compile-fn command)))
@@ -2093,7 +2050,7 @@ Removes itself on execution."
(when-let ((number (thing-at-point 'number)))
(number-to-string number))))
(read-number "Count: " dape-read-memory-default-count)))
- (dape-request (dape--live-process)
+ (dape-request (dape--live-connection)
"readMemory"
(list
:memoryReference memory-reference
@@ -2134,7 +2091,6 @@ Removes itself on execution."
map)
"Keymap for `dape-breakpoint-global-mode'.")
-;; TODO Whould be nice if it was enabled
(define-minor-mode dape-breakpoint-global-mode
"Adds fringe and margin breakpoint controls."
:global t
@@ -2206,9 +2162,9 @@ If SKIP-TYPES overlays with properties in SKIP-TYPES are
filtered."
dape--breakpoints))))
(dolist (breakpoint breakpoints)
(setq dape--breakpoints (delq breakpoint dape--breakpoints)))
- (when-let ((process (dape--live-process t)))
- (dape--set-breakpoints-in-buffer process (current-buffer))))
- (run-hooks 'dape-update-ui-hooks))
+ (when-let ((conn (dape--live-connection t)))
+ (dape--set-breakpoints-in-buffer conn (current-buffer))))
+ (run-hook-with-args 'dape-update-ui-hooks (dape--live-connection t)))
(defun dape--breakpoint-place (&optional log-message expression)
"Place breakpoint at current line.
@@ -2222,6 +2178,7 @@ If EXPRESSION place conditional breakpoint."
(cond
(log-message
(overlay-put breakpoint 'dape-log-message log-message)
+ ;; TODO Add keybinds for removal and change of log message
(overlay-put breakpoint 'after-string (concat
" "
(propertize
@@ -2229,6 +2186,7 @@ If EXPRESSION place conditional breakpoint."
'face 'dape-log-face))))
(expression
(overlay-put breakpoint 'dape-expr-message expression)
+ ;; TODO Add keybinds for removal and change of expression message
(overlay-put breakpoint 'after-string (concat
" "
(propertize
@@ -2241,44 +2199,45 @@ If EXPRESSION place conditional breakpoint."
'dape-breakpoint-face)))
(overlay-put breakpoint 'modification-hooks '(dape--breakpoint-freeze))
(push breakpoint dape--breakpoints))
- (when-let ((process (dape--live-process t)))
- (dape--set-breakpoints-in-buffer process (current-buffer)))
+ (when-let ((conn (dape--live-connection t)))
+ (dape--set-breakpoints-in-buffer conn (current-buffer)))
(add-hook 'kill-buffer-hook 'dape--breakpoint-buffer-kill-hook nil t)
- (run-hooks 'dape-update-ui-hooks))
+ (run-hook-with-args 'dape-update-ui-hooks (dape--live-connection t)))
(defun dape--breakpoint-remove (overlay &optional skip-update)
"Remove OVERLAY breakpoint from buffer and session.
When SKIP-UPDATE is non nil, does not notify adapter about removal."
(setq dape--breakpoints (delq overlay dape--breakpoints))
(when-let (((not skip-update))
- (process (dape--live-process t)))
- (dape--set-breakpoints-in-buffer process (overlay-buffer overlay)))
+ (conn (dape--live-connection t)))
+ (dape--set-breakpoints-in-buffer conn (overlay-buffer overlay)))
(dape--margin-cleanup (overlay-buffer overlay))
- (run-hooks 'dape-update-ui-hooks)
+ (run-hook-with-args 'dape-update-ui-hooks (dape--live-connection t))
(delete-overlay overlay))
;;; Source buffers
-(defun dape--source-ensure (process plist cb)
- "Ensure that source object in PLIST exist for PROCESS.
+(defun dape--source-ensure (conn plist cb)
+ "Ensure that source object in PLIST exist for adapter CONN.
See `dape--callback' for expected CB signature."
(let* ((source (plist-get plist :source))
(path (plist-get source :path))
(source-reference (plist-get source :sourceReference))
(buffer (plist-get dape--source-buffers source-reference)))
(cond
- ((or (and path (file-exists-p (dape--path path 'local)))
+ ((or (not conn)
+ (and path (file-exists-p (dape--path conn path 'local)))
(and buffer (buffer-live-p buffer)))
- (funcall cb process))
+ (funcall cb conn))
((and (numberp source-reference) (> source-reference 0))
- (dape--with dape-request (process
+ (dape--with dape-request (conn
"source"
(list
:source source
:sourceReference source-reference))
- (unless success
- (dape--repl-message (format "%s" msg) 'warning))
+ (when error-message
+ (dape--repl-message (format "%s" error-message) 'warning))
(when-let ((content (plist-get body :content))
(buffer
(generate-new-buffer (format "*dape-source %s*"
@@ -2298,13 +2257,13 @@ See `dape--callback' for expected CB signature."
(erase-buffer)
(insert content))
(goto-char (point-min)))
- (funcall cb process)))))))
+ (funcall cb conn)))))))
;;; Stack pointers
(defvar dape--stack-position (make-marker)
- "Dape stack position for marker `overlay-arrow-variable-list'")
+ "Dape stack position for marker `overlay-arrow-variable-list'.")
(defun dape--remove-stack-pointers ()
"Remove stack pointer marker."
@@ -2313,12 +2272,16 @@ See `dape--callback' for expected CB signature."
(dape--remove-eldoc-hook)))
(set-marker dape--stack-position nil))
-(defun dape--update-stack-pointers (&optional skip-stack-pointer-flash)
- "Update stack pointer marker."
+(defun dape--update-stack-pointers (conn &optional skip-stack-pointer-flash)
+ "Update stack pointer marker for adapter CONN.
+If SKIP-STACK-POINTER-FLASH is non nil refrain from flashing line."
(dape--remove-stack-pointers)
- (when-let ((frame (dape--current-stack-frame)))
- (dape--with dape--source-ensure ((dape--live-process t) frame)
- (dape--goto-source frame (memq major-mode '(dape-repl-mode))
+ (when-let ((frame (dape--current-stack-frame conn)))
+ (dape--with dape--source-ensure (conn frame)
+ (dape--goto-source frame
+ ;; jsonrpc messes with set-buffer
+ (with-current-buffer (car (buffer-list))
+ (memq major-mode '(dape-repl-mode)))
(not skip-stack-pointer-flash))
(when-let ((marker (dape--object-to-marker frame)))
(with-current-buffer (marker-buffer marker)
@@ -2384,7 +2347,8 @@ Handles newline."
(comint-output-filter dummy-process dape--repl-prompt))))))
(defun dape--repl-input-sender (dummy-process input)
- "Dape repl `comint-input-sender'."
+ "Dape repl `comint-input-sender'.
+Send INPUT to DUMMY-PROCESS."
(let (cmd)
(cond
;; Run previous input
@@ -2405,23 +2369,25 @@ Handles newline."
;; Evaluate expression
(t
(dape--repl-insert-prompt)
- (dape--evaluate-expression (dape--live-process)
- (plist-get (dape--current-stack-frame) :id)
- (substring-no-properties input)
- "repl"
- (dape--callback
- (when success
- (dape--update process nil t))
- (dape--repl-message (concat
- (if success
- (plist-get body
:result)
- msg)))))))))
+ (let ((conn (dape--live-connection t)))
+ (dape--with dape--evaluate-expression
+ (conn
+ (plist-get (dape--current-stack-frame conn) :id)
+ (substring-no-properties input)
+ "repl")
+ (unless error-message
+ (dape--update conn nil t))
+ (dape--repl-message (concat
+ (if error-message
+ error-message
+ (plist-get body :result))))))))))
(defun dape--repl-completion-at-point ()
"Completion at point function for *dape-repl* buffer."
(when (or (symbol-at-point)
(member (buffer-substring-no-properties (1- (point)) (point))
- (or (plist-get dape--capabilities
:completionTriggerCharacters)
+ (or (plist-get (dape--capabilities (dape--live-connection
t))
+ :completionTriggerCharacters)
'("."))))
(let* ((bounds (save-excursion
(cons (and (skip-chars-backward "^\s")
@@ -2445,14 +2411,14 @@ Handles newline."
(cdr bounds)
(completion-table-dynamic
(lambda (_str)
- (when-let ((process (dape--live-process t)))
+ (when-let ((conn (dape--live-connection t)))
(dape--with dape-request
- (process
+ (conn
"completions"
(append
- (when (dape--stopped-threads)
+ (when (dape--stopped-threads conn)
(list :frameId
- (plist-get (dape--current-stack-frame) :id)))
+ (plist-get (dape--current-stack-frame conn) :id)))
(list
:text str
:column column
@@ -2538,23 +2504,22 @@ Handles newline."
nil)
(set-process-filter (get-buffer-process (current-buffer))
'comint-output-filter)
- (insert (propertize
- (format
- "* Welcome to Dape REPL! *
+ (insert (format
+ "* Welcome to Dape REPL! *
Available Dape commands: %s
-Empty input will rerun last command.\n\n\n"
- (mapconcat 'identity
- (mapcar (lambda (cmd)
- (let ((str (car cmd)))
- (if dape-repl-use-shorthand
- (concat "["
- (substring str 0 1)
- "]"
- (substring str 1))
- str)))
- dape-repl-commands)
- ", "))
- 'font-lock-face 'italic))
+Empty input will rerun last command.\n"
+ (mapconcat 'identity
+ (mapcar (lambda (cmd)
+ (let ((str (car cmd)))
+ (if dape-repl-use-shorthand
+ (concat
+ (propertize
+ (substring str 0 1)
+ 'font-lock-face 'help-key-binding)
+ (substring str 1))
+ str)))
+ dape-repl-commands)
+ ", ")))
(set-marker (process-mark (get-buffer-process (current-buffer))) (point))
(comint-output-filter (get-buffer-process (current-buffer))
dape--repl-prompt)))
@@ -2573,11 +2538,7 @@ Empty input will rerun last command.\n\n\n"
;;; Info Buffers
-;; TODO There is no way of turning on and off dape info
-;; To turn off remove hook but then you need to add it again
-;; Should be a global minor mode
-
-;; TODO Becouse buttons where removed from info buffer
+;; TODO Because buttons where removed from info buffer
;; there should be a way to controll execution by mouse
(defvar-local dape--info-buffer-related nil
@@ -2589,10 +2550,10 @@ Used there as scope index.")
"Guard for buffer `dape-info-update' fn.")
(defvar dape--info-buffers nil
- "List containing dape-info buffers, might be un-live.")
+ "List containing `dape-info' buffers, might be un-live.")
(defun dape--info-buffer-list ()
- "Returns all live `dape-info-parent-mode'."
+ "Return all live `dape-info-parent-mode'."
(setq dape--info-buffers
(seq-filter 'buffer-live-p dape--info-buffers)))
@@ -2604,7 +2565,7 @@ Uses `dape--info-buffer-identifier' as IDENTIFIER."
(equal dape--info-buffer-identifier identifier))))
(defun dape--info-buffer-tab (&optional reversed)
- "Select next related buffer in dape-info buffers.
+ "Select next related buffer in `dape-info' buffers.
REVERSED selects previous."
(interactive)
(unless dape--info-buffer-related
@@ -2629,8 +2590,8 @@ REVERSED selects previous."
"Keymap for `dape-info-parent-mode'.")
(defun dape--info-buffer-change-fn (&rest _rest)
- "Hook fn for `window-buffer-change-functions' to ensure updates."
- (dape--info-update (current-buffer)))
+ "Hook fn for `window-buffer-change-functions' to ensure update."
+ (dape--info-update (dape--live-connection t) (current-buffer)))
(define-derived-mode dape-info-parent-mode special-mode ""
"Generic mode to derive all other Dape gud buffer modes from."
@@ -2646,9 +2607,9 @@ REVERSED selects previous."
(defun dape--info-header (name mode id help-echo mouse-face face)
"Helper to create buffer header.
-Creates header with string NAME, BUFFER-ID which is an list of
-`dape-info-parent-mode' derived mode and `dape--info-buffer-identifier'
-with HELP-ECHO string, MOSUE-FACE and FACE."
+Creates header with string NAME, mouse map to select buffer
+identified with MODE and ID (see `dape--info-buffer-identifier')
+with HELP-ECHO string, MOUSE-FACE and FACE."
(propertize name 'help-echo help-echo 'mouse-face mouse-face 'face face
'keymap
(gdb-make-header-line-mouse-map
@@ -2677,8 +2638,8 @@ Header line is custructed from buffer local
(defun dape--info-buffer-update-1 (mode id &rest args)
"Helper for `dape--info-buffer-update'.
-Updates BUFFER contents with by calling `dape--info-buffer-update-contents'
-with ARGS."
+Updates buffer identified with MODE and ID contents with by calling
+`dape--info-buffer-update-contents' with ARGS."
(if dape--info-buffer-in-redraw
(run-with-timer 0.01 nil
(lambda (mode id args)
@@ -2706,15 +2667,15 @@ with ARGS."
(when old-window
(select-window old-window))))))))
-(cl-defgeneric dape--info-buffer-update (mode &optional id)
- "Updates buffer specified by MODE and ID."
+(cl-defgeneric dape--info-buffer-update (_conn mode &optional id)
+ "Update buffer specified by MODE and ID."
(dape--info-buffer-update-1 mode id))
-(defun dape--info-update (buffer)
- "Update dape info BUFFER."
+(defun dape--info-update (conn buffer)
+ "Update dape info BUFFER for adapter CONN."
(apply 'dape--info-buffer-update
- (with-current-buffer buffer
- (list major-mode dape--info-buffer-identifier))))
+ conn (with-current-buffer buffer
+ (list major-mode dape--info-buffer-identifier))))
(defun dape--info-get-live-buffer (mode &optional identifier)
"Get live dape info buffer with MODE and IDENTIFIER."
@@ -2724,7 +2685,7 @@ with ARGS."
(dape--info-buffer-list)))
(defun dape--info-buffer-name (mode &optional identifier)
- "Creates buffer name from MODE and IDENTIFIER."
+ "Create buffer name from MODE and IDENTIFIER."
(format "*dape-info %s*"
(pcase mode
('dape-info-breakpoints-mode "Breakpoints")
@@ -2749,7 +2710,7 @@ If SKIP-UPDATE is non nil skip updating buffer contents."
(setq dape--info-buffer-identifier identifier)
(push buffer dape--info-buffers)))
(unless skip-update
- (dape--info-update buffer))
+ (dape--info-update (dape--live-connection t) buffer))
buffer))
(defmacro dape--info-buffer-command (name properties doc &rest body)
@@ -2785,11 +2746,10 @@ FN is executed on mouse-2 and ?r, BODY is executed
inside of let stmt."
,@body
map)))
-(defun dape-info-update ()
- "Update and display `dape-info-*' buffers."
+(defun dape-info-update (conn)
+ "Update and display `dape-info-*' buffers for adapter CONN."
(dolist (buffer (dape--info-buffer-list))
- (dape--info-update buffer)))
-
+ (dape--info-update conn buffer)))
(defun dape-info ()
"Update and display *dape-info* buffers."
@@ -2822,7 +2782,7 @@ FN is executed on mouse-2 and ?r, BODY is executed inside
of let stmt."
(dape--info-buffer-list))
(dape--display-buffer
(dape--info-buffer 'dape-info-scope-mode 0 'skip-update)))
- (dape-info-update))
+ (dape-info-update (dape--live-connection t)))
;;; Info breakpoints buffer
@@ -2852,8 +2812,8 @@ FN is executed on mouse-2 and ?r, BODY is executed inside
of let stmt."
"Toggle exception at line in dape info buffer."
(plist-put dape--info-exception :enabled
(not (plist-get dape--info-exception :enabled)))
- (dape-info-update)
- (dape--with dape--set-exception-breakpoints ((dape--live-process))))
+ (dape-info-update (dape--live-connection t))
+ (dape--with dape--set-exception-breakpoints ((dape--live-connection))))
(dape--info-buffer-map dape-info-exceptions-line-map
dape-info-exceptions-toggle)
@@ -2922,11 +2882,11 @@ FN is executed on mouse-2 and ?r, BODY is executed
inside of let stmt."
;;; Info threads buffer
(defvar dape--info-thread-position nil
- "`dape-info-thread-mode' marker for `overlay-arrow-variable-list'")
+ "`dape-info-thread-mode' marker for `overlay-arrow-variable-list'.")
(dape--info-buffer-command dape-info-select-thread (dape--info-thread)
"Select thread at line in dape info buffer."
- (dape-select-thread (plist-get dape--info-thread :id)))
+ (dape-select-thread (dape--live-connection) (plist-get dape--info-thread
:id)))
(defvar dape--info-threads-font-lock-keywords
(append gdb-threads-font-lock-keywords
@@ -2947,24 +2907,27 @@ FN is executed on mouse-2 and ?r, BODY is executed
inside of let stmt."
dape--info-buffer-related dape--info-group-1-related)
(add-to-list 'overlay-arrow-variable-list 'dape--info-thread-position))
-(cl-defmethod dape--info-buffer-update ((mode (eql dape-info-threads-mode)) id)
+(cl-defmethod dape--info-buffer-update (conn (mode (eql
dape-info-threads-mode)) id)
"Fetches data for `dape-info-threads-mode' and updates buffer.
Buffer is specified by MODE and ID."
- (if-let ((process (dape--live-process t))
- ((eq dape--state 'stopped)))
- (dape--with dape--inactive-threads-stack-trace (process)
+ (if-let ((conn (or conn (dape--live-connection t)))
+ ((dape--stopped-threads conn)))
+ (dape--with dape--inactive-threads-stack-trace (conn)
(dape--info-buffer-update-1 mode id
- :current-thread (dape--current-thread)))
- (dape--info-buffer-update-1 mode id :current-thread nil)))
+ :current-thread (dape--current-thread conn)
+ :threads (dape--threads conn)))
+ (dape--info-buffer-update-1 mode id
+ :current-thread nil
+ :threads (and conn (dape--threads conn)))))
(cl-defmethod dape--info-buffer-update-contents
- (&context (major-mode dape-info-threads-mode) &key current-thread)
+ (&context (major-mode dape-info-threads-mode) &key current-thread threads)
"Updates `dape-info-threads-mode' buffer from CURRENT-THREAD."
(set-marker dape--info-thread-position nil)
- (if (not dape--threads)
+ (if (not threads)
(insert "No thread information available.")
(let ((table (make-gdb-table)))
- (dolist (thread dape--threads)
+ (dolist (thread threads)
(gdb-table-add-row
table
(list
@@ -2981,12 +2944,13 @@ Buffer is specified by MODE and ID."
(car))))
(concat
" in " (plist-get top-stack :name)
- (when-let ((dape-info-thread-buffer-locations)
- (path (thread-first top-stack
- (plist-get :source)
- (plist-get :path)
- (dape--path 'local)))
- (line (plist-get top-stack :line)))
+ (when-let* ((dape-info-thread-buffer-locations)
+ (path (thread-first top-stack
+ (plist-get :source)
+ (plist-get :path)))
+ (path (dape--path (dape--live-connection t)
+ path 'local))
+ (line (plist-get top-stack :line)))
(concat " of " (dape--format-file-line path line)))
(when-let ((dape-info-thread-buffer-addresses)
(addr
@@ -3000,7 +2964,7 @@ Buffer is specified by MODE and ID."
'help-echo "mouse-2, RET: select thread")))
(insert (gdb-table-string table " "))
(when current-thread
- (cl-loop for thread in dape--threads
+ (cl-loop for thread in threads
for line from 1
until (eq current-thread thread)
finally (gdb-mark-line line dape--info-thread-position))))))
@@ -3009,7 +2973,7 @@ Buffer is specified by MODE and ID."
;;; Info stack buffer
(defvar dape--info-stack-position nil
- "`dape-info-stack-mode' marker for `overlay-arrow-variable-list'")
+ "`dape-info-stack-mode' marker for `overlay-arrow-variable-list'.")
(defvar dape--info-stack-font-lock-keywords
'(("in \\([^ ]+\\)" (1 font-lock-function-name-face)))
@@ -3017,7 +2981,7 @@ Buffer is specified by MODE and ID."
(dape--info-buffer-command dape-info-stack-select (dape--info-frame)
"Select stack at line in dape info buffer."
- (dape-select-stack (plist-get dape--info-frame :id)))
+ (dape-select-stack (dape--live-connection) (plist-get dape--info-frame :id)))
(dape--info-buffer-map dape-info-stack-line-map dape-info-stack-select)
@@ -3031,11 +2995,11 @@ Buffer is specified by MODE and ID."
(dape-info-sources-mode nil "Sources")))
(add-to-list 'overlay-arrow-variable-list 'dape--info-stack-position))
-(cl-defmethod dape--info-buffer-update ((mode (eql dape-info-stack-mode)) id)
+(cl-defmethod dape--info-buffer-update (conn (mode (eql dape-info-stack-mode))
id)
"Fetches data for `dape-info-stack-mode' and updates buffer.
Buffer is specified by MODE and ID."
- (let ((stack-frames (plist-get (dape--current-thread) :stackFrames))
- (current-stack-frame (dape--current-stack-frame)))
+ (let ((stack-frames (plist-get (dape--current-thread conn) :stackFrames))
+ (current-stack-frame (dape--current-stack-frame conn)))
(dape--info-buffer-update-1 mode id
:current-stack-frame current-stack-frame
:stack-frames stack-frames)))
@@ -3047,8 +3011,7 @@ Updates from CURRENT-STACK-FRAME STACK-FRAMES."
(set-marker dape--info-stack-position nil)
(cond
((or (not current-stack-frame)
- (not stack-frames)
- (not (eq dape--state 'stopped)))
+ (not stack-frames))
(insert "No stopped thread."))
(t
(cl-loop with table = (make-gdb-table)
@@ -3062,11 +3025,12 @@ Updates from CURRENT-STACK-FRAME STACK-FRAMES."
"in"
(concat
(plist-get frame :name)
- (when-let ((dape-info-stack-buffer-locations)
- (path (thread-first frame
- (plist-get :source)
- (plist-get :path)
- (dape--path 'local))))
+ (when-let* ((dape-info-stack-buffer-locations)
+ (path (thread-first frame
+ (plist-get :source)
+ (plist-get :path)))
+ (path (dape--path (dape--live-connection t)
+ path 'local)))
(concat " of "
(dape--format-file-line path
(plist-get frame :line))))
@@ -3109,11 +3073,18 @@ Updates from CURRENT-STACK-FRAME STACK-FRAMES."
(dape-info-modules-mode nil "Modules")
(dape-info-sources-mode nil "Sources"))))
+(cl-defmethod dape--info-buffer-update (conn (mode (eql
dape-info-modules-mode)) id)
+ (dape--info-buffer-update-1 mode id
+ :modules
+ ;; Use last connection if current is dead
+ (when-let ((conn (or conn dape--connection)))
+ (dape--modules conn))))
+
(cl-defmethod dape--info-buffer-update-contents
- (&context (major-mode dape-info-modules-mode))
+ (&context (major-mode dape-info-modules-mode) &key modules)
"Updates `dape-info-modules-mode' buffer."
(cl-loop with table = (make-gdb-table)
- for module in (reverse dape--modules)
+ for module in (reverse modules)
do
(gdb-table-add-row
table
@@ -3139,7 +3110,7 @@ Updates from CURRENT-STACK-FRAME STACK-FRAMES."
(dape--info-buffer-command dape-info-sources-goto (dape--info-source)
"Goto source."
- (dape--with dape--source-ensure ((dape--live-process)
+ (dape--with dape--source-ensure ((dape--live-connection t)
(list :source dape--info-source))
(if-let ((marker
(dape--object-to-marker (list :source dape--info-source))))
@@ -3155,11 +3126,18 @@ Updates from CURRENT-STACK-FRAME STACK-FRAMES."
(dape-info-modules-mode nil "Modules")
(dape-info-sources-mode nil "Sources"))))
+(cl-defmethod dape--info-buffer-update (conn (mode (eql
dape-info-sources-mode)) id)
+ (dape--info-buffer-update-1 mode id
+ :sources
+ ;; Use last connection if current is dead
+ (when-let ((conn (or conn dape--connection)))
+ (dape--sources conn))))
+
(cl-defmethod dape--info-buffer-update-contents
- (&context (major-mode dape-info-sources-mode))
+ (&context (major-mode dape-info-sources-mode) &key sources)
"Updates `dape-info-modules-mode' buffer."
(cl-loop with table = (make-gdb-table)
- for source in (reverse dape--sources)
+ for source in (reverse sources)
do
(gdb-table-add-row
table
@@ -3182,7 +3160,7 @@ Updates from CURRENT-STACK-FRAME STACK-FRAMES."
(dape--info-buffer-command dape-info-scope-toggle (dape--info-path)
"Expand or contract variable at line in dape info buffer."
- (unless (eq dape--state 'stopped)
+ (unless (dape--stopped-threads (dape--live-connection))
(user-error "No stopped threads"))
(puthash dape--info-path (not (gethash dape--info-path
dape--info-expanded-p))
dape--info-expanded-p)
@@ -3203,7 +3181,7 @@ Updates from CURRENT-STACK-FRAME STACK-FRAMES."
(dape--info-buffer-command dape-info-variable-edit
(dape--info-ref dape--info-variable)
"Edit variable value at line in dape info buffer."
- (dape--set-variable (dape--live-process)
+ (dape--set-variable (dape--live-connection)
dape--info-ref
dape--info-variable
(read-string
@@ -3224,6 +3202,7 @@ Updates from CURRENT-STACK-FRAME STACK-FRAMES."
"Local keymap for dape scope buffers.")
;; TODO Add bindings for adding data breakpoint
+;; FIXME Empty header line when adapter is killed
(define-derived-mode dape-info-scope-mode dape-info-parent-mode "Scope"
"Major mode for Dape info scope."
@@ -3264,7 +3243,6 @@ Updates from CURRENT-STACK-FRAME STACK-FRAMES."
(defun dape--info-scope-add-variable (table object ref path)
"Add variable OBJECT with REF and PATH to TABLE."
- ;; TODO Clean up
(let* ((name (or (plist-get object :name) " "))
(type (or (plist-get object :type) " "))
(value (or (plist-get object :value)
@@ -3321,27 +3299,29 @@ Updates from CURRENT-STACK-FRAME STACK-FRAMES."
(plist-get object :variablesReference)
path)))))
-(cl-defmethod dape--info-buffer-update ((mode (eql dape-info-scope-mode)) id)
+(cl-defmethod dape--info-buffer-update (conn (mode (eql dape-info-scope-mode))
id)
"Fetches data for `dape-info-scope-mode' and updates buffer.
Buffer is specified by MODE and ID."
- (when-let* ((process (dape--live-process t))
- (frame (dape--current-stack-frame))
+ (when-let* ((conn (or conn (dape--live-connection t)))
+ (frame (dape--current-stack-frame conn))
(scopes (plist-get frame :scopes))
;; FIXME if scope is out of range here scope list could
;; have shrunk since last update and current
;; scope buffer should be killed and replaced if
;; if visible
- (scope (nth id scopes)))
- (dape--with dape--variables (process scope)
+ (scope (nth id scopes))
+ ;; Check for stopped threads to reduce flickering
+ ((dape--stopped-threads conn)))
+ (dape--with dape--variables (conn scope)
(dape--with dape--variables-recursive
- (process
+ (conn
scope
(list (plist-get scope :name))
(lambda (path object)
- (and (not (plist-get object :expensive))
+ (and (not (eq (plist-get object :expensive) t))
(gethash (cons (plist-get object :name) path)
dape--info-expanded-p))))
- (when (and scope scopes (eq dape--state 'stopped))
+ (when (and scope scopes (dape--stopped-threads conn))
(dape--info-buffer-update-1 mode id :scope scope :scopes scopes))))))
(cl-defmethod dape--info-buffer-update-contents
@@ -3375,35 +3355,38 @@ Buffer is specified by MODE and ID."
:interactive nil
(setq dape--info-buffer-related '((dape-info-watch-mode nil "Watch"))))
-(cl-defmethod dape--info-buffer-update ((mode (eql dape-info-watch-mode)) id)
+(cl-defmethod dape--info-buffer-update (conn (mode (eql dape-info-watch-mode))
id)
"Fetches data for `dape-info-watch-mode' and updates buffer.
Buffer is specified by MODE and ID."
- (when-let* ((process (dape--live-process t))
- (frame (dape--current-stack-frame))
- (scopes (plist-get frame :scopes))
- (responses 0))
- (if (not dape--watched)
- (dape--info-buffer-update-1 mode id :scopes scopes)
- (dolist (plist dape--watched)
- (dape--with dape--evaluate-expression
- ((dape--live-process t)
- (plist-get frame :id)
- (plist-get plist :name)
- "watch")
- (when success
- (cl-loop for (key value) on body by 'cddr
- do (plist-put plist key value)))
- (setq responses (1+ responses))
- (when (length= dape--watched responses)
- (dape--with dape--variables-recursive
- (process
- (list :variables dape--watched)
- (list "Watch")
- (lambda (path object)
- (and (not (plist-get object :expensive))
- (gethash (cons (plist-get object :name) path)
- dape--info-expanded-p))))
- (dape--info-buffer-update-1 mode id :scopes scopes))))))))
+ (if (not (and conn (jsonrpc-running-p conn)))
+ (dape--info-buffer-update-1 mode id :scopes nil)
+ (when-let* ((frame (dape--current-stack-frame conn))
+ (scopes (plist-get frame :scopes))
+ (responses 0))
+ (if (not dape--watched)
+ (dape--info-buffer-update-1 mode id :scopes scopes)
+ (dolist (plist dape--watched)
+ (plist-put plist :variablesReference nil)
+ (plist-put plist :variables nil)
+ (dape--with dape--evaluate-expression
+ (conn
+ (plist-get frame :id)
+ (plist-get plist :name)
+ "watch")
+ (unless error-message
+ (cl-loop for (key value) on body by 'cddr
+ do (plist-put plist key value)))
+ (setq responses (1+ responses))
+ (when (length= dape--watched responses)
+ (dape--with dape--variables-recursive
+ (conn
+ (list :variables dape--watched)
+ (list "Watch")
+ (lambda (path object)
+ (and (not (eq (plist-get object :expensive) t))
+ (gethash (cons (plist-get object :name) path)
+ dape--info-expanded-p))))
+ (dape--info-buffer-update-1 mode id :scopes scopes)))))))))
(cl-defmethod dape--info-buffer-update-contents
(&context (major-mode dape-info-watch-mode) &key scopes)
@@ -3425,11 +3408,6 @@ Buffer is specified by MODE and ID."
;;; Config
-(defvar dape-history nil
- "History variable for `dape'.")
-(defvar dape-session-history nil
- "Current sessions `dape--read-config' history.
-Used to derive initial-contents in `dape--read-config'.")
(defvar dape--minibuffer-suggestions nil
"Suggested configurations in minibuffer.")
@@ -3548,9 +3526,11 @@ If SIGNAL is non nil raises an `user-error'."
(or (not modes)
(apply 'provided-mode-derived-p
major-mode (cl-map 'list 'identity modes))
- (and (not (derived-mode-p 'prog-mode))
+ (and-let* (((not (derived-mode-p 'prog-mode)))
+ (last-hist (car dape-history))
+ (last-config (cadr (dape--config-from-string last-hist))))
(cl-some (lambda (mode)
- (memql mode (plist-get dape--config 'modes)))
+ (memql mode (plist-get last-config 'modes)))
modes)))))
(defun dape--config-completion-at-point ()
@@ -3605,14 +3585,14 @@ See `dape--config-mode-p' how \"valid\" is defined."
(or
;; Take `dape-command' if exist
(car from-dape-commands)
- ;; Take first valid history item from session
+ ;; Take first valid history item
(seq-find (lambda (str)
(ignore-errors
(member (thread-first (dape--config-from-string str)
(car)
(dape--config-to-string nil))
suggested-configs)))
- dape-session-history)
+ dape-history)
;; Take first suggested config if only one exist
(and (length= suggested-configs 1)
(car suggested-configs)))))
@@ -3623,20 +3603,19 @@ See `dape--config-mode-p' how \"valid\" is defined."
(set-syntax-table emacs-lisp-mode-syntax-table)
(add-hook 'completion-at-point-functions
#'dape--config-completion-at-point nil t))
- (pcase-let* ((str (read-from-minibuffer "Run adapter: "
- initial-contents
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map
minibuffer-local-map)
- (define-key map "C-M-i"
#'completion-at-point)
- (define-key map "\t"
#'completion-at-point)
- map)
- nil 'dape-history
initial-contents))
+ (pcase-let* ((str
+ (let ((history-add-new-input nil))
+ (read-from-minibuffer "Run adapter: "
+ initial-contents
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map
minibuffer-local-map)
+ (define-key map "C-M-i"
#'completion-at-point)
+ (define-key map "\t"
#'completion-at-point)
+ map)
+ nil 'dape-history
initial-contents)))
(`(,key ,config) (dape--config-from-string
(substring-no-properties str)))
(evaled-config (dape--config-eval key config)))
- (setq dape-session-history
- (cons (dape--config-to-string key evaled-config)
- dape-session-history))
(setq dape-history
(cons (dape--config-to-string key evaled-config)
dape-history))
@@ -3647,20 +3626,21 @@ See `dape--config-mode-p' how \"valid\" is defined."
(defun dape-hover-function (cb)
"Hook function to produce doc strings for `eldoc'.
-On success calles CB with the doc string.
+On success calls CB with the doc string.
See `eldoc-documentation-functions', for more infomation."
- (and-let* (((plist-get dape--capabilities :supportsEvaluateForHovers))
+ (and-let* ((conn (dape--live-connection t))
+ ((dape--capable-p conn :supportsEvaluateForHovers))
(symbol (thing-at-point 'symbol)))
- (dape--evaluate-expression (dape--live-process)
- (plist-get (dape--current-stack-frame) :id)
- (substring-no-properties symbol)
- "hover"
- (dape--callback
- (when success
- (funcall cb
- (dape--variable-string
- (plist-put body :name symbol))))))
- t))
+ (dape--with dape--evaluate-expression
+ (conn
+ (plist-get (dape--current-stack-frame conn) :id)
+ (substring-no-properties symbol)
+ "hover")
+ (unless error-message
+ (funcall cb
+ (dape--variable-string
+ (plist-put body :name symbol))))))
+ t)
(defun dape--add-eldoc-hook ()
"Add `dape-hover-function' from eldoc hook."
@@ -3673,9 +3653,9 @@ See `eldoc-documentation-functions', for more infomation."
;;; Mode line
-(defun dape--update-state (state)
- "Update Dape mode line with STATE symbol."
- (setq dape--state state)
+(defun dape--update-state (conn state)
+ "Update Dape mode line with STATE symbol for adapter CONN."
+ (setf (dape--state conn) state)
(force-mode-line-update t))
(defun dape--mode-line-format ()
@@ -3683,11 +3663,13 @@ See `eldoc-documentation-functions', for more
infomation."
(concat (propertize "Dape" 'face 'font-lock-constant-face)
":"
(propertize
- (format "%s" (or dape--state 'unknown))
+ (format "%s" (or (and dape--connection
+ (dape--state dape--connection))
+ 'unknown))
'face 'font-lock-doc-face)))
(add-to-list 'mode-line-misc-info
- `(dape--process
+ `(dape--mode-line-active
(" [" (:eval (dape--mode-line-format)) "] ")))
@@ -3735,20 +3717,18 @@ See `eldoc-documentation-functions', for more
infomation."
;;; Hooks
-;; Cleanup process before bed time
+;; Cleanup conn before bed time
(add-hook 'kill-emacs-hook
(defun dape-kill-busy-wait ()
(let (done)
- (dape-kill nil
- (dape--callback
- (setq done t)))
+ (dape-kill dape--connection
+ (dape--callback
+ (setq done t)))
;; Busy wait for response at least 2 seconds
(cl-loop with max-iterations = 20
for i from 1 to max-iterations
until done
- do (accept-process-output nil 0.1)
- finally (unless done
- (dape--kill-processes))))))
+ do (accept-process-output nil 0.1)))))
(provide 'dape)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/dape 4ffaef2a06: Async jsonrpc (#40),
ELPA Syncer <=