diff --git a/dap-js.el b/dap-js.el index 33b515d..3c36f79 100644 --- a/dap-js.el +++ b/dap-js.el @@ -20,6 +20,11 @@ ;;; Code: +(require 'cl-lib) +(require 'dash) +(require 'ht) +(require 'json) + (require 'dap-mode) (require 'dap-utils) @@ -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 diff --git a/dap-mode.el b/dap-mode.el index 2241e34..d749fc5 100644 --- a/dap-mode.el +++ b/dap-mode.el @@ -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) @@ -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)) @@ -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)) @@ -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))))) @@ -1166,8 +1177,8 @@ 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 @@ -1175,6 +1186,8 @@ ADAPTER-ID the id of the adapter." :supportsVariableType t :supportsVariablePaging t :supportsRunInTerminalRequest t + :supportsStartDebuggingRequest t + :supportsTerminateDebuggee t :locale "en-us") :type "request")) @@ -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) @@ -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))) diff --git a/dap-utils.el b/dap-utils.el index 4e6b8cf..09fd422 100644 --- a/dap-utils.el +++ b/dap-utils.el @@ -51,7 +51,7 @@ (shell-command (format dap-utils-unzip-script temp-file dest)))) (defcustom dap-utils-vscode-ext-url - "https://marketplace.visualstudio.com/_apis/public/gallery/publishers/%s/vsextensions/%s/%s/vspackage" + "https://marketplace.gallery.vsassets.io/_apis/public/gallery/publisher/%s/extension/%s/%s/assetbyname/Microsoft.VisualStudio.Services.VSIXPackage" "Vscode extension template url." :group 'dap-utils :type 'string) @@ -68,6 +68,12 @@ :group 'dap-utils :type 'string) +(defcustom dap-utils-github-extension-releases-info-url + "https://api.github.com/repos/%s/%s/releases/%s" + "Github extension's latest version information template url." + :group 'dap-utils + :type 'string) + (defcustom dap-utils-extension-path (expand-file-name ".extension" user-emacs-directory) "Directory to store vscode extension." :group 'dap-utils @@ -109,8 +115,6 @@ PATH is the download destination path." (defun dap-utils-vscode-get-installed-extension-version (path) "Check the version of the vscode extension installed in PATH. Returns nil if the extension is not installed." - (require 'xml) - (require 'dom) (let* ((extension-manifest (f-join path "extension.vsixmanifest"))) (when (f-exists? extension-manifest) (let ((pkg-identity (dom-by-tag (xml-parse-file extension-manifest) 'Identity))) @@ -166,11 +170,11 @@ With prefix, FORCED to redownload the extension." extension-name))) (message "%s: %s debug extension are not set. You can download it with M-x %s-setup" ,dapfile ,extension-name ,dapfile))))) -(defmacro dap-utils-github-extension-setup-function (dapfile owner repo version &optional path callback) +(defmacro dap-utils-github-extension-setup-function (dapfile owner repo &optional version path callback) "Helper to create DAPFILE setup function for debug extension from github. OWNER is the github owner. REPO is the github repository. -VERSION is the github extension version. +VERSION is the github extension version, if not set or set to `latest' then grab latest version. PATH is the download destination dir. CALLBACK is the fn to be called after the download." (let* ((extension-name (concat owner "." repo)) @@ -182,13 +186,33 @@ With prefix, FORCED to redownload the extension." extension-name))) (defun ,(intern (format "%s-setup" dapfile)) (&optional forced) ,help-string (interactive "P") - (unless (and (not forced) (file-exists-p ,dest)) - (dap-utils-get-github-extension ,owner ,repo ,version ,dest) - (rename-file (concat ,dest "/" (concat ,repo "-" ,version)) - (concat ,dest "/extension")) - (message "%s: Downloading done!" ,dapfile) - (when ,callback - (funcall ,callback)))) + (if (or (not ,version) + (string= "latest" ,version)) + (progn ; Get the latest actual version + (let* ((url (format dap-utils-github-extension-releases-info-url ,owner ,repo ,version))) + (with-current-buffer (url-retrieve-synchronously url) + (goto-char (point-min)) + (re-search-forward "^$") + (set ',version (substring (cdr (assoc 'tag_name (json-read))) 1))))) + (progn ; Check that version requested exists. + (let* ((url (format dap-utils-github-extension-releases-info-url + ,owner ,repo (concat "tags/v" ,version))) + (status (url-http-symbol-value-in-buffer 'url-http-response-status + (url-retrieve-synchronously url)))) + (unless (eql 200 status) + (error "Error! Extension: %s.%s version: %s returned status: %s for: %s" + ,owner ,repo ,version status url))))) + (if (or forced (not (file-exists-p ,dest))) + (progn + (message "Installing %s.%s version: %s to %s" ,owner ,repo ,version ,dest) + (dap-utils-get-github-extension ,owner ,repo ,version ,dest) + (rename-file (concat ,dest "/" (concat ,repo "-" ,version)) + (concat ,dest "/extension")) + (message "%s: Downloading done!" ,dapfile) + (when ,callback + (funcall ,callback))) + (message "Extension %s.%s exists already in %s. Remove extension, or pass the `forced' \ +argument." ,owner ,repo ,dest))) (unless (file-exists-p ,dest) (message "%s: %s debug extension are not set. You can download it with M-x %s-setup" ,dapfile ,extension-name ,dapfile)))))