Skip to content

Commit

Permalink
feat: dap-js
Browse files Browse the repository at this point in the history 
Shamelessly stolen from emacs-lsp#736
  • Loading branch information
@zeorin
zeorin committed Jun 19, 2024
1 parent b407773 commit 8bb83f9
Show file tree
Hide file tree
Showing 3 changed files with 303 additions and 61 deletions.
269 changes: 237 additions & 32 deletions dap-js.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,11 @@

;;; Code:

(require 'cl-lib)
(require 'dash)
(require 'ht)
(require 'json)

(require 'dap-mode)
(require 'dap-utils)

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

(defun dap-js-setup (&optional forced)
"Downloading webfreak.debug to path specified.
With prefix, FORCED to redownload the extension."
(interactive "P")
(unless (and (not forced) (file-exists-p dap-js-path))
(lsp-download-install
(lambda (&rest _) (lsp--info "Downloaded extension!"))
(lambda (error) (lsp--error "Failed Downloaded extension %s!" error))
:url (lsp--find-latest-gh-release-url
"https://api.github.com/repos/microsoft/vscode-js-debug/releases/latest"
"js-debug-dap")
:store-path dap-js-path
:decompress :targz)))
(defcustom dap-js-output-telemetry t
"Output telemetry data from js-debug server if non-nil."
:group 'dap-js
:type 'boolean)

(defcustom dap-js-extension-version "latest"
"The version of the github release found at
https://github.com/microsoft/vscode-js-debug/releases"
:group 'dap-js
:type 'string)

(dap-utils-github-extension-setup-function "dap-js" "microsoft" "vscode-js-debug"
dap-js-extension-version
dap-js-path
#'dap-js-extension-build)

(defun dap-js-extension-build ()
"Callback from setup function in order to install extension node deps and compile."
(message "Building ms-vscode.js-debug in %s directory." dap-js-path)
(let ((buf (get-buffer-create "*dap-js extension build*"))
(default-directory (concat dap-js-path "/extension")))
(async-shell-command
"npm install --sav-dev --force; npm run compile -- dapDebugServer" buf buf)))

(cl-defun dap-js-extension-update (&optional (ask-upgrade t))
"Check for update, and if `ask-upgrade' arg is non-nil will prompt user to upgrade."
(interactive)
(let* ((url (format dap-utils-github-extension-releases-info-url "microsoft"
"vscode-js-debug" "latest"))
(cur-version
(let ((file (f-join dap-js-path "extension/package.json")))
(when (file-exists-p file)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(cdr (assoc 'version (json-read)))))))
(latest-version
(let ((inhibit-message dap-inhibit-io))
(with-current-buffer
(if-let ((buf (url-retrieve-synchronously url t t 10)))
buf ;returned
(progn
;; Probably timeout
(message "Problem getting latest version from: %s" url)
(generate-new-buffer "*dap-js-temp*")))
(if (/= (point-max) 1)
(progn
(goto-char (point-min))
(re-search-forward "^$")
(substring (cdr (assoc 'tag_name (json-read))) 1))
(progn
(kill-buffer)
cur-version))))))
(if (string= cur-version latest-version)
(when ask-upgrade
(message "ms-vscode.js-debug extension is up to date at version: %s"
latest-version))
(let ((msg (format "Newer version (%s) of vscode/ms-vscode.js-debug exists than \
currently installed version (%s)." latest-version cur-version)))
(if ask-upgrade
(when (y-or-n-p (concat msg " Do you want to upgrade now?"))
(dap-js-setup t))
(message "%s Upgrade with `M-x dap-js-extension-update'" msg))))))

;; Check extension version when loading, and give a message about upgrading.
(dap-js-extension-update nil)

(defun dap-js--populate-start-file-args (conf)
"Populate CONF with the required arguments."
(let ((port (dap--find-available-port)))
(-> conf
(append
(list :debugServer port
:host "localhost"
:type "pwa-node"
:program-to-start (concat (s-join " " dap-js-debug-program)
" "
(number-to-string port))))
(dap--put-if-absent :cwd default-directory)
(dap--put-if-absent :name "Node Debug"))))
"Load up the start config CONF for the debug adapter from launch.json, and default
required attributes if missing. See full options:
`https://github.com/microsoft/vscode-js-debug/blob/main/OPTIONS.md'"
(dap--put-if-absent conf :type "chrome")
(dap--put-if-absent conf :cwd (lsp-workspace-root))
(dap--put-if-absent conf :request "launch")
(dap--put-if-absent conf :console "internalConsole")
(dap--put-if-absent conf :name (concat (plist-get conf :type) "-js-debug"))
(let ((debug-port (dap--find-available-port)))
(dap--put-if-absent conf :host "localhost")
(dap--put-if-absent conf :debugServer debug-port)
(dap--put-if-absent conf :debugPort debug-port)
(dap--put-if-absent conf :program-to-start
(if (not (file-exists-p dap-js-path))
(error "DAP program path: %s does not exist!" dap-js-path)
(format "%s %s %s"
(mapconcat 'identity dap-js-debug-program " ")
(plist-get conf :debugPort)
(plist-get conf :host)))))
(if (plist-member conf :url)
(progn
;;(plist-put conf :mode "url")
(dap--put-if-absent conf :url (read-string
"Browse url: "
"http://localhost:3000" t))
(dap--put-if-absent conf :webRoot (lsp-workspace-root))))
(if (plist-member conf :file)
(if (plist-get conf :url)
(error "Both \"file\" and \"url\" properties are set in launch.json. \
Choose one.")
(progn
(plist-put conf :mode "file")
(dap--put-if-absent conf :file
(read-file-name "Select the file to open in the browser:"
nil (buffer-file-name) t)))))
(if (plist-member conf :program)
(dap--put-if-absent conf :program (read-file-name
"Select the Node.js program to run: "
nil (buffer-file-name) t)))
(when (string= "node-terminal" (plist-get conf :type))
(error "In launch.json \"node-terminal\" debug type is currently not supported."))
(when (string= "integratedTerminal" (plist-get conf :console))
(error "In launch.json \"console\":\"integratedTerminal\" not supported at this \
time, use \"console\":\"internalConsole\" instead"))
(unless dap-inhibit-io
(message "dap-js---populate-start-file-args: %s" conf))
conf)

(dap-register-debug-provider "node" #'dap-js--populate-start-file-args)
(dap-register-debug-provider "node-terminal" #'dap-js--populate-start-file-args)
(dap-register-debug-provider "chrome" #'dap-js--populate-start-file-args)
(dap-register-debug-provider "msedge" #'dap-js--populate-start-file-args)
(dap-register-debug-provider "pwa-node" #'dap-js--populate-start-file-args)
(dap-register-debug-provider "pwa-node" #'dap-js--populate-start-file-args)
(dap-register-debug-provider "pwa-chrome" #'dap-js--populate-start-file-args)
(dap-register-debug-provider "pwa-msedge" #'dap-js--populate-start-file-args)

(dap-register-debug-template "Node.js Launch Program"
(list :type "node"
:cwd nil
:request "launch"
:program nil
:name "Node.js Launch Program"))

(dap-register-debug-template "Chrome Launch File"
(list :type "chrome"
:cwd nil
:request "launch"
:file nil
:name "Chrome Launch File"))

(dap-register-debug-template "Chrome Launch URL"
(list :type "chrome"
:cwd nil
:request "launch"
:webRoot nil
:url nil
:name "Chrome Launch URL"))


(add-hook 'dap-session-created-hook #'dap-js--session-created)
(defun dap-js--session-created (debug-session)
"Set up so that processes won't ask about closing."
(when-let (proc (dap--debug-session-program-proc debug-session))
(set-process-query-on-exit-flag proc nil)))

(defun dap-js--output-filter-function (debug-session event)
"Output event data, including for vscode-js-debug, some useful telemetry data.
Future can do something more with the telemetry data than just printing."
(-let [(&hash "seq" "event" event-type "body") event]
(if (hash-table-p body)
(progn
(if (and (bound-and-true-p dap-js-output-telemetry)
(string= (gethash "category" body) "telemetry"))
(dap--print-to-output-buffer
debug-session (concat (dap--json-encode body) "\n"))
(dap--print-to-output-buffer
debug-session (concat (dap--output-buffer-format body) "\n")))))))

(add-hook 'dap-terminated-hook #'dap-js--term-parent)
(defun dap-js--term-parent (debug-session)
"Kill off parent process when child is disconnected."
(if (eq debug-session (if (boundp 'parent-debug-session) parent-debug-session nil))
(progn
(when-let (proc (dap--debug-session-program-proc debug-session))
(when (process-live-p proc)
(makunbound 'parent-debug-session)
(set-process-query-on-exit-flag proc nil)
(with-current-buffer (process-buffer proc)
;; Switching mode, prevents triggering to open err file after killing proc
(shell-script-mode)
(kill-buffer))
(dap-delete-session debug-session)))))
(kill-buffer (dap--debug-session-output-buffer debug-session)))

(dap-register-debug-template
"Node Run Configuration (new)"
(list :type "pwa-node"
:cwd nil
:request "launch"
:program nil
:name "Node::Run"))
(add-hook 'dap-executed-hook #'dap-js--reverse-request-handler)
(defun dap-js--reverse-request-handler (debug-session command)
"Callback hook to get messages from dap-mode reverse requests."
;;This is set with `add-hook' above.
(unless dap-inhibit-io
(message "dap-js--reverse-request-handler -> command: %s" command))
(pcase command
((guard (string= command "startDebugging"))
;; Assume current session now parent requesting start debugging in child session
(setq parent-debug-session debug-session)
(-let [(&hash "seq" "command" "arguments"
(&hash "request" "configuration"
(&hash? "type" "__pendingTargetId")))
(dap--debug-session-metadata debug-session)]
(-let (((&plist :mode :url :file :webroot :program :outputCapture
:skipFiles :timeout :host :name :debugPort)
(dap--debug-session-launch-args debug-session))
(conf `(:request ,request)))
;; DAP Spec says not to include client variables to start child, including type
;;(plist-put conf :type type)
(plist-put conf :name (concat type "-" command))
(plist-put conf :__pendingTargetId __pendingTargetId)
(plist-put conf :outputCapture outputCapture)
(plist-put conf :skipFiles skipFiles)
(plist-put conf :timeout timeout)
(plist-put conf :host host)
(plist-put conf :debugServer debugPort)
(plist-put conf :debugPort debugPort)
(if (or (string= "pwa-node" type) (string= "node" type))
(plist-put conf :program program)
(progn
(if (string= mode "file")
(plist-put conf :file file)
(progn
(plist-put conf :url url)
(plist-put conf :webroot webroot)))))
(unless dap-inhibit-io
(message "dap-js startDebugging conf: %s" conf))
(dap-start-debugging-noexpand conf)
;; Remove child session if stored in list of recent/last configurations to
;; allow `dap-debug-last' to work by getting parent not child.
(when-let ((last-conf (cdr (cl-first dap--debug-configuration)))
(_ptid-equal (string= __pendingTargetId
(plist-get last-conf :__pendingTargetId))))
(pop dap--debug-configuration))
;; success
(dap--send-message (dap--make-success-response seq command)
(dap--resp-handler) debug-session))))
;; This is really just confirmation response, but good place to ensure session
;; selected
("launch" (dap--switch-to-session debug-session))
(_
(unless dap-inhibit-io
(message "command: %s wasn't handled by dap-js." command)))))

(provide 'dap-js)
;;; dap-js.el ends here
47 changes: 30 additions & 17 deletions dap-mode.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -117,7 +117,7 @@ also `dap--make-terminal-buffer'."
(const :tag "asnyc-shell" :value dap-internal-terminal-shell)
(function :tag "Custom function")))

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

(defconst dap-features->windows
'((sessions . (dap-ui-sessions . dap-ui--sessions-buffer))
Expand Down Expand Up @@ -949,7 +949,11 @@ PARAMS are the event params.")
(formatted-output (if-let ((output-filter-fn (-> debug-session
(dap--debug-session-launch-args)
(plist-get :output-filter-function))))
(funcall output-filter-fn formatted-output)
(progn
;; Test # of params. Consider deprecating 1 param function.
(if (= 1 (cdr (func-arity output-filter-fn)))
(funcall output-filter-fn formatted-output)
(funcall output-filter-fn debug-session event)))
formatted-output)))
(when (or (not dap-output-buffer-filter) (member (gethash "category" body)
dap-output-buffer-filter))
Expand Down Expand Up @@ -1120,9 +1124,16 @@ terminal configured (probably xterm)."
(gethash "command" parsed-msg)))
(message "Unable to find handler for %s." (pp parsed-msg))))
("request"
;; These are "Reverse Requests", or requests from DAP server to client
(pcase (gethash "command" parsed-msg)
("startDebugging" (dap--start-debugging debug-session parsed-msg))
("runInTerminal" (dap--start-process debug-session parsed-msg)))))
("runInTerminal"
(dap--start-process debug-session parsed-msg))
(_
(setf (dap--debug-session-metadata debug-session) parsed-msg)
;; Consider moving this hook out to also include runInTerminal reverse requests
(run-hook-with-args 'dap-executed-hook
debug-session
(gethash "command" parsed-msg))))))
(quit))))
(dap--parser-read parser msg)))))

Expand Down Expand Up @@ -1166,15 +1177,17 @@ etc...."
"Create initialize message.
ADAPTER-ID the id of the adapter."
(list :command "initialize"
:arguments (list :clientID "vscode"
:clientName "Visual Studio Code"
:arguments (list :clientID "emacs"
:clientName "emacs DAP client"
:adapterID adapter-id
:pathFormat "path"
:linesStartAt1 t
:columnsStartAt1 t
:supportsVariableType t
:supportsVariablePaging t
:supportsRunInTerminalRequest t
:supportsStartDebuggingRequest t
:supportsTerminateDebuggee t
:locale "en-us")
:type "request"))

Expand Down Expand Up @@ -1228,9 +1241,9 @@ ADAPTER-ID the id of the adapter."
(message "Failed to connect to %s:%s with error message %s"
host
port
(error-message-string err))
(sit-for dap-connect-retry-interval)
(setq retries (1+ retries))))))
(error-message-string err)))
(sleep-for dap-connect-retry-interval)
(setq retries (1+ retries)))))
(or result (error "Failed to connect to port %s" port))))

(defun dap--create-session (launch-args)
Expand Down Expand Up @@ -1892,8 +1905,8 @@ be used to compile the project, spin up docker, ...."
(dap-debug-run-task `(:cwd ,(or (plist-get launch-args :dap-compilation-dir)
(lsp-workspace-root)
default-directory)
:command ,dap-compilation
:label ,(truncate-string-to-width dap-compilation 20)) cb)
:command ,dap-compilation
:label ,(truncate-string-to-width dap-compilation 20)) cb)
(-if-let ((&plist :preLaunchTask) launch-args)
(let* ((task (dap-tasks-get-configuration-by-label preLaunchTask))
(tasks (dap-tasks-configuration-get-depends task)))
Expand Down
Loading

0 comments on commit 8bb83f9

Please sign in to comment.