Skip to content

Commit b5c61f9

Browse files
zeorinzeorin
committed
feat: dap-js
Shamelessly stolen from emacs-lsp#736
1 parent ffb7957 commit b5c61f9

File tree

3 files changed

+303
-61
lines changed

3 files changed

+303
-61
lines changed

‎dap-js.el

Lines changed: 237 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,11 @@
2020

2121
;;; Code:
2222

23+
(require 'cl-lib)
24+
(require 'dash)
25+
(require 'ht)
26+
(require 'json)
27+
2328
(require 'dap-mode)
2429
(require 'dap-utils)
2530

@@ -34,43 +39,243 @@ Link: https://marketplace.visualstudio.com/items?itemName=webfreak.debug ."
3439
:group 'dap-js
3540
:type '(repeat string))
3641

37-
(defun dap-js-setup (&optional forced)
38-
"Downloading webfreak.debug to path specified.
39-
With prefix, FORCED to redownload the extension."
40-
(interactive "P")
41-
(unless (and (not forced) (file-exists-p dap-js-path))
42-
(lsp-download-install
43-
(lambda (&rest _) (lsp--info "Downloaded extension!"))
44-
(lambda (error) (lsp--error "Failed Downloaded extension %s!" error))
45-
:url (lsp--find-latest-gh-release-url
46-
"https://api.github.com/repos/microsoft/vscode-js-debug/releases/latest"
47-
"js-debug-dap")
48-
:store-path dap-js-path
49-
:decompress :targz)))
42+
(defcustom dap-js-output-telemetry t
43+
"Output telemetry data from js-debug server if non-nil."
44+
:group 'dap-js
45+
:type 'boolean)
46+
47+
(defcustom dap-js-extension-version "latest"
48+
"The version of the github release found at
49+
https://github.com/microsoft/vscode-js-debug/releases"
50+
:group 'dap-js
51+
:type 'string)
52+
53+
(dap-utils-github-extension-setup-function "dap-js" "microsoft" "vscode-js-debug"
54+
dap-js-extension-version
55+
dap-js-path
56+
#'dap-js-extension-build)
57+
58+
(defun dap-js-extension-build ()
59+
"Callback from setup function in order to install extension node deps and compile."
60+
(message "Building ms-vscode.js-debug in %s directory." dap-js-path)
61+
(let ((buf (get-buffer-create "*dap-js extension build*"))
62+
(default-directory (concat dap-js-path "/extension")))
63+
(async-shell-command
64+
"npm install --sav-dev --force; npm run compile -- dapDebugServer" buf buf)))
65+
66+
(cl-defun dap-js-extension-update (&optional (ask-upgrade t))
67+
"Check for update, and if `ask-upgrade' arg is non-nil will prompt user to upgrade."
68+
(interactive)
69+
(let* ((url (format dap-utils-github-extension-releases-info-url "microsoft"
70+
"vscode-js-debug" "latest"))
71+
(cur-version
72+
(let ((file (f-join dap-js-path "extension/package.json")))
73+
(when (file-exists-p file)
74+
(with-temp-buffer
75+
(insert-file-contents file)
76+
(goto-char (point-min))
77+
(cdr (assoc 'version (json-read)))))))
78+
(latest-version
79+
(let ((inhibit-message dap-inhibit-io))
80+
(with-current-buffer
81+
(if-let ((buf (url-retrieve-synchronously url t t 10)))
82+
buf ;returned
83+
(progn
84+
;; Probably timeout
85+
(message "Problem getting latest version from: %s" url)
86+
(generate-new-buffer "*dap-js-temp*")))
87+
(if (/= (point-max) 1)
88+
(progn
89+
(goto-char (point-min))
90+
(re-search-forward "^$")
91+
(substring (cdr (assoc 'tag_name (json-read))) 1))
92+
(progn
93+
(kill-buffer)
94+
cur-version))))))
95+
(if (string= cur-version latest-version)
96+
(when ask-upgrade
97+
(message "ms-vscode.js-debug extension is up to date at version: %s"
98+
latest-version))
99+
(let ((msg (format "Newer version (%s) of vscode/ms-vscode.js-debug exists than \
100+
currently installed version (%s)." latest-version cur-version)))
101+
(if ask-upgrade
102+
(when (y-or-n-p (concat msg " Do you want to upgrade now?"))
103+
(dap-js-setup t))
104+
(message "%s Upgrade with `M-x dap-js-extension-update'" msg))))))
105+
106+
;; Check extension version when loading, and give a message about upgrading.
107+
(dap-js-extension-update nil)
50108

51109
(defun dap-js--populate-start-file-args (conf)
52-
"Populate CONF with the required arguments."
53-
(let ((port (dap--find-available-port)))
54-
(-> conf
55-
(append
56-
(list :debugServer port
57-
:host "localhost"
58-
:type "pwa-node"
59-
:program-to-start (concat (s-join " " dap-js-debug-program)
60-
" "
61-
(number-to-string port))))
62-
(dap--put-if-absent :cwd default-directory)
63-
(dap--put-if-absent :name "Node Debug"))))
110+
"Load up the start config CONF for the debug adapter from launch.json, and default
111+
required attributes if missing. See full options:
112+
`https://github.com/microsoft/vscode-js-debug/blob/main/OPTIONS.md'"
113+
(dap--put-if-absent conf :type "chrome")
114+
(dap--put-if-absent conf :cwd (lsp-workspace-root))
115+
(dap--put-if-absent conf :request "launch")
116+
(dap--put-if-absent conf :console "internalConsole")
117+
(dap--put-if-absent conf :name (concat (plist-get conf :type) "-js-debug"))
118+
(let ((debug-port (dap--find-available-port)))
119+
(dap--put-if-absent conf :host "localhost")
120+
(dap--put-if-absent conf :debugServer debug-port)
121+
(dap--put-if-absent conf :debugPort debug-port)
122+
(dap--put-if-absent conf :program-to-start
123+
(if (not (file-exists-p dap-js-path))
124+
(error "DAP program path: %s does not exist!" dap-js-path)
125+
(format "%s %s %s"
126+
(mapconcat 'identity dap-js-debug-program " ")
127+
(plist-get conf :debugPort)
128+
(plist-get conf :host)))))
129+
(if (plist-member conf :url)
130+
(progn
131+
;;(plist-put conf :mode "url")
132+
(dap--put-if-absent conf :url (read-string
133+
"Browse url: "
134+
"http://localhost:3000" t))
135+
(dap--put-if-absent conf :webRoot (lsp-workspace-root))))
136+
(if (plist-member conf :file)
137+
(if (plist-get conf :url)
138+
(error "Both \"file\" and \"url\" properties are set in launch.json. \
139+
Choose one.")
140+
(progn
141+
(plist-put conf :mode "file")
142+
(dap--put-if-absent conf :file
143+
(read-file-name "Select the file to open in the browser:"
144+
nil (buffer-file-name) t)))))
145+
(if (plist-member conf :program)
146+
(dap--put-if-absent conf :program (read-file-name
147+
"Select the Node.js program to run: "
148+
nil (buffer-file-name) t)))
149+
(when (string= "node-terminal" (plist-get conf :type))
150+
(error "In launch.json \"node-terminal\" debug type is currently not supported."))
151+
(when (string= "integratedTerminal" (plist-get conf :console))
152+
(error "In launch.json \"console\":\"integratedTerminal\" not supported at this \
153+
time, use \"console\":\"internalConsole\" instead"))
154+
(unless dap-inhibit-io
155+
(message "dap-js---populate-start-file-args: %s" conf))
156+
conf)
64157

158+
(dap-register-debug-provider "node" #'dap-js--populate-start-file-args)
159+
(dap-register-debug-provider "node-terminal" #'dap-js--populate-start-file-args)
160+
(dap-register-debug-provider "chrome" #'dap-js--populate-start-file-args)
161+
(dap-register-debug-provider "msedge" #'dap-js--populate-start-file-args)
65162
(dap-register-debug-provider "pwa-node" #'dap-js--populate-start-file-args)
163+
(dap-register-debug-provider "pwa-node" #'dap-js--populate-start-file-args)
164+
(dap-register-debug-provider "pwa-chrome" #'dap-js--populate-start-file-args)
165+
(dap-register-debug-provider "pwa-msedge" #'dap-js--populate-start-file-args)
166+
167+
(dap-register-debug-template "Node.js Launch Program"
168+
(list :type "node"
169+
:cwd nil
170+
:request "launch"
171+
:program nil
172+
:name "Node.js Launch Program"))
173+
174+
(dap-register-debug-template "Chrome Launch File"
175+
(list :type "chrome"
176+
:cwd nil
177+
:request "launch"
178+
:file nil
179+
:name "Chrome Launch File"))
180+
181+
(dap-register-debug-template "Chrome Launch URL"
182+
(list :type "chrome"
183+
:cwd nil
184+
:request "launch"
185+
:webRoot nil
186+
:url nil
187+
:name "Chrome Launch URL"))
188+
189+
190+
(add-hook 'dap-session-created-hook #'dap-js--session-created)
191+
(defun dap-js--session-created (debug-session)
192+
"Set up so that processes won't ask about closing."
193+
(when-let (proc (dap--debug-session-program-proc debug-session))
194+
(set-process-query-on-exit-flag proc nil)))
195+
196+
(defun dap-js--output-filter-function (debug-session event)
197+
"Output event data, including for vscode-js-debug, some useful telemetry data.
198+
Future can do something more with the telemetry data than just printing."
199+
(-let [(&hash "seq" "event" event-type "body") event]
200+
(if (hash-table-p body)
201+
(progn
202+
(if (and (bound-and-true-p dap-js-output-telemetry)
203+
(string= (gethash "category" body) "telemetry"))
204+
(dap--print-to-output-buffer
205+
debug-session (concat (dap--json-encode body) "\n"))
206+
(dap--print-to-output-buffer
207+
debug-session (concat (dap--output-buffer-format body) "\n")))))))
208+
209+
(add-hook 'dap-terminated-hook #'dap-js--term-parent)
210+
(defun dap-js--term-parent (debug-session)
211+
"Kill off parent process when child is disconnected."
212+
(if (eq debug-session (if (boundp 'parent-debug-session) parent-debug-session nil))
213+
(progn
214+
(when-let (proc (dap--debug-session-program-proc debug-session))
215+
(when (process-live-p proc)
216+
(makunbound 'parent-debug-session)
217+
(set-process-query-on-exit-flag proc nil)
218+
(with-current-buffer (process-buffer proc)
219+
;; Switching mode, prevents triggering to open err file after killing proc
220+
(shell-script-mode)
221+
(kill-buffer))
222+
(dap-delete-session debug-session)))))
223+
(kill-buffer (dap--debug-session-output-buffer debug-session)))
66224

67-
(dap-register-debug-template
68-
"Node Run Configuration (new)"
69-
(list :type "pwa-node"
70-
:cwd nil
71-
:request "launch"
72-
:program nil
73-
:name "Node::Run"))
225+
(add-hook 'dap-executed-hook #'dap-js--reverse-request-handler)
226+
(defun dap-js--reverse-request-handler (debug-session command)
227+
"Callback hook to get messages from dap-mode reverse requests."
228+
;;This is set with `add-hook' above.
229+
(unless dap-inhibit-io
230+
(message "dap-js--reverse-request-handler -> command: %s" command))
231+
(pcase command
232+
((guard (string= command "startDebugging"))
233+
;; Assume current session now parent requesting start debugging in child session
234+
(setq parent-debug-session debug-session)
235+
(-let [(&hash "seq" "command" "arguments"
236+
(&hash "request" "configuration"
237+
(&hash? "type" "__pendingTargetId")))
238+
(dap--debug-session-metadata debug-session)]
239+
(-let (((&plist :mode :url :file :webroot :program :outputCapture
240+
:skipFiles :timeout :host :name :debugPort)
241+
(dap--debug-session-launch-args debug-session))
242+
(conf `(:request ,request)))
243+
;; DAP Spec says not to include client variables to start child, including type
244+
;;(plist-put conf :type type)
245+
(plist-put conf :name (concat type "-" command))
246+
(plist-put conf :__pendingTargetId __pendingTargetId)
247+
(plist-put conf :outputCapture outputCapture)
248+
(plist-put conf :skipFiles skipFiles)
249+
(plist-put conf :timeout timeout)
250+
(plist-put conf :host host)
251+
(plist-put conf :debugServer debugPort)
252+
(plist-put conf :debugPort debugPort)
253+
(if (or (string= "pwa-node" type) (string= "node" type))
254+
(plist-put conf :program program)
255+
(progn
256+
(if (string= mode "file")
257+
(plist-put conf :file file)
258+
(progn
259+
(plist-put conf :url url)
260+
(plist-put conf :webroot webroot)))))
261+
(unless dap-inhibit-io
262+
(message "dap-js startDebugging conf: %s" conf))
263+
(dap-start-debugging-noexpand conf)
264+
;; Remove child session if stored in list of recent/last configurations to
265+
;; allow `dap-debug-last' to work by getting parent not child.
266+
(when-let ((last-conf (cdr (cl-first dap--debug-configuration)))
267+
(_ptid-equal (string= __pendingTargetId
268+
(plist-get last-conf :__pendingTargetId))))
269+
(pop dap--debug-configuration))
270+
;; success
271+
(dap--send-message (dap--make-success-response seq command)
272+
(dap--resp-handler) debug-session))))
273+
;; This is really just confirmation response, but good place to ensure session
274+
;; selected
275+
("launch" (dap--switch-to-session debug-session))
276+
(_
277+
(unless dap-inhibit-io
278+
(message "command: %s wasn't handled by dap-js." command)))))
74279

75280
(provide 'dap-js)
76281
;;; dap-js.el ends here

‎dap-mode.el

Lines changed: 30 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -117,7 +117,7 @@ also `dap--make-terminal-buffer'."
117117
(const :tag "asnyc-shell" :value dap-internal-terminal-shell)
118118
(function :tag "Custom function")))
119119

120-
(defcustom dap-output-buffer-filter '("stdout" "stderr")
120+
(defcustom dap-output-buffer-filter '("stdout" "stderr" "console")
121121
"If non-nil, a list of output types to display in the debug output buffer."
122122
:group 'dap-mode
123123
:type 'list)
@@ -226,12 +226,12 @@ request on hitting a breakpoint. 0 means to return all frames."
226226
"Windows to auto show on debugging when in dap-ui-auto-configure-mode."
227227
:group 'dap-mode
228228
:type '(set (const :tag "Show sessions popup window when debugging" sessions)
229-
(const :tag "Show locals popup window when debugging" locals)
230-
(const :tag "Show breakpoints popup window when debugging" breakpoints)
231-
(const :tag "Show expressions popup window when debugging" expressions)
232-
(const :tag "Show REPL popup window when debugging" repl)
233-
(const :tag "Enable `dap-ui-controls-mode` with controls to manage the debug session when debugging" controls)
234-
(const :tag "Enable `dap-tooltip-mode` that enables mouse hover support when debugging" tooltip)))
229+
(const :tag "Show locals popup window when debugging" locals)
230+
(const :tag "Show breakpoints popup window when debugging" breakpoints)
231+
(const :tag "Show expressions popup window when debugging" expressions)
232+
(const :tag "Show REPL popup window when debugging" repl)
233+
(const :tag "Enable `dap-ui-controls-mode` with controls to manage the debug session when debugging" controls)
234+
(const :tag "Enable `dap-tooltip-mode` that enables mouse hover support when debugging" tooltip)))
235235

236236
(defconst dap-features->windows
237237
'((sessions . (dap-ui-sessions . dap-ui--sessions-buffer))
@@ -950,7 +950,11 @@ PARAMS are the event params.")
950950
(formatted-output (if-let ((output-filter-fn (-> debug-session
951951
(dap--debug-session-launch-args)
952952
(plist-get :output-filter-function))))
953-
(funcall output-filter-fn formatted-output)
953+
(progn
954+
;; Test # of params. Consider deprecating 1 param function.
955+
(if (= 1 (cdr (func-arity output-filter-fn)))
956+
(funcall output-filter-fn formatted-output)
957+
(funcall output-filter-fn debug-session event)))
954958
formatted-output)))
955959
(when (or (not dap-output-buffer-filter) (member (gethash "category" body)
956960
dap-output-buffer-filter))
@@ -1121,9 +1125,16 @@ terminal configured (probably xterm)."
11211125
(gethash "command" parsed-msg)))
11221126
(message "Unable to find handler for %s." (pp parsed-msg))))
11231127
("request"
1128+
;; These are "Reverse Requests", or requests from DAP server to client
11241129
(pcase (gethash "command" parsed-msg)
1125-
("startDebugging" (dap--start-debugging debug-session parsed-msg))
1126-
("runInTerminal" (dap--start-process debug-session parsed-msg)))))
1130+
("runInTerminal"
1131+
(dap--start-process debug-session parsed-msg))
1132+
(_
1133+
(setf (dap--debug-session-metadata debug-session) parsed-msg)
1134+
;; Consider moving this hook out to also include runInTerminal reverse requests
1135+
(run-hook-with-args 'dap-executed-hook
1136+
debug-session
1137+
(gethash "command" parsed-msg))))))
11271138
(quit))))
11281139
(dap--parser-read parser msg)))))
11291140

@@ -1167,15 +1178,17 @@ etc...."
11671178
"Create initialize message.
11681179
ADAPTER-ID the id of the adapter."
11691180
(list :command "initialize"
1170-
:arguments (list :clientID "vscode"
1171-
:clientName "Visual Studio Code"
1181+
:arguments (list :clientID "emacs"
1182+
:clientName "emacs DAP client"
11721183
:adapterID adapter-id
11731184
:pathFormat "path"
11741185
:linesStartAt1 t
11751186
:columnsStartAt1 t
11761187
:supportsVariableType t
11771188
:supportsVariablePaging t
11781189
:supportsRunInTerminalRequest t
1190+
:supportsStartDebuggingRequest t
1191+
:supportsTerminateDebuggee t
11791192
:locale "en-us")
11801193
:type "request"))
11811194

@@ -1229,9 +1242,9 @@ ADAPTER-ID the id of the adapter."
12291242
(message "Failed to connect to %s:%s with error message %s"
12301243
host
12311244
port
1232-
(error-message-string err))
1233-
(sit-for dap-connect-retry-interval)
1234-
(setq retries (1+ retries))))))
1245+
(error-message-string err)))
1246+
(sleep-for dap-connect-retry-interval)
1247+
(setq retries (1+ retries)))))
12351248
(or result (error "Failed to connect to port %s" port))))
12361249

12371250
(defun dap--create-session (launch-args)
@@ -1893,8 +1906,8 @@ be used to compile the project, spin up docker, ...."
18931906
(dap-debug-run-task `(:cwd ,(or (plist-get launch-args :dap-compilation-dir)
18941907
(lsp-workspace-root)
18951908
default-directory)
1896-
:command ,dap-compilation
1897-
:label ,(truncate-string-to-width dap-compilation 20)) cb)
1909+
:command ,dap-compilation
1910+
:label ,(truncate-string-to-width dap-compilation 20)) cb)
18981911
(-if-let ((&plist :preLaunchTask) launch-args)
18991912
(let* ((task (dap-tasks-get-configuration-by-label preLaunchTask))
19001913
(tasks (dap-tasks-configuration-get-depends task)))

0 commit comments

Comments
 (0)