feat: dap-js

Shamelessly stolen from emacs-lsp#736

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

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))
@@ -950,7 +950,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))
@@ -1121,9 +1125,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)))))
 
@@ -1167,15 +1178,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"))
 
@@ -1229,9 +1242,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)
@@ -1893,8 +1906,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)))