forked from emacs-lsp/dap-mode
-
Notifications
You must be signed in to change notification settings - Fork 0
/
dap-netcore.el
199 lines (180 loc) · 9.05 KB
/
dap-netcore.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
;;; dap-netcore.el --- Debug Adapter Protocol mode for .NET Core -*- lexical-binding: t; -*-
;; Copyright (C) 2019 Reed Mullanix
;; Author: Reed Mullanix <[email protected]>
;; Keywords: languages
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Adapter for https://github.com/Samsung/netcoredbg .
;;; Code:
(require 'dap-mode)
(require 'f)
(require 'dom)
(defcustom dap-netcore-install-dir (f-join user-emacs-directory ".cache" "lsp" "netcoredbg")
"Install directory for netcoredbg."
:group 'dap-netcore
:risky t
:type 'directory)
(defcustom dap-netcore-download-url nil
"Netcoredbg download url.
See asset links here https://github.com/Samsung/netcoredbg/releases/ and select
the correct one for your OS. Will be set automatically in Emacs 27.1 or newer
with libxml2 support."
:group 'dap-netcore
:risky t
:type 'string)
(defun dap-netcore-update-debugger ()
"Update netcoredbg."
(interactive)
(let ((backup (concat dap-netcore-install-dir ".old")))
(when (f-exists-p dap-netcore-install-dir)
(f-move dap-netcore-install-dir backup))
(condition-case err
(dap-netcore--debugger-install)
(error (f-move backup dap-netcore-install-dir)
(signal (car err) (cdr err)))
(:success (when (f-exists-p backup)
(f-delete backup t))))))
(defun dap-netcore--debugger-install ()
"Download the latest version of netcoredbg and extract it
to `dap-netcore-install-dir'."
(let* ((temp-file (make-temp-file "netcoredbg" nil
(if (eq system-type 'windows-nt)
".zip"
".tar.gz")))
(install-dir-full (expand-file-name dap-netcore-install-dir))
(unzip-script (pcase system-type
(`windows-nt (format "powershell -noprofile -noninteractive -nologo -ex bypass Expand-Archive -path '%s' -dest '%s'" temp-file install-dir-full))
((or `gnu/linux `darwin) (format "mkdir -p %s && tar xvzf %s -C %s" dap-netcore-install-dir temp-file dap-netcore-install-dir))
(_ (user-error (format "Unable to extract server - file %s cannot be extracted, please extract it manually" temp-file))))))
(if (and (not dap-netcore-download-url)
(fboundp 'libxml-available-p)
(fboundp 'dom-search)
(fboundp 'dom-attr))
(url-retrieve "https://github.com/Samsung/netcoredbg/releases"
(lambda (_)
(setq dap-netcore-download-url
(concat
"https://github.com"
(dom-attr
(dom-search
(if (libxml-available-p)
(libxml-parse-html-region (point-min) (point-max))
(xml-parse-region (point-min) (point-max)))
(lambda (node)
(string-match-p (pcase system-type
(`gnu/linux (if (string-match-p system-configuration ".*arm")
".*linux-arm64\\.tar\\.gz"
".*linux-amd64\\.tar\\.gz"))
(`darwin ".*osx.*\\.tar\\.gz")
(`windows-nt ".*win64.*\\.zip"))
(or (dom-attr node 'href) ""))))
'href)))
(lsp-download-install
(lambda (&rest _)
(shell-command unzip-script))
(lambda (error &rest _)
(user-error "Error during netcoredbg downloading: %s" error))
:url dap-netcore-download-url
:store-path temp-file)))
(if dap-netcore-download-url
(lsp-download-install
(lambda (&rest _)
(shell-command unzip-script))
(lambda (error &rest _)
(user-error "Error during netcoredbg downloading: %s" error))
:url dap-netcore-download-url
:store-path temp-file)
(user-error "`dap-netcore-download-url' is not set. You can customize it")))))
(defun dap-netcore--debugger-cmd ()
"The location of the netcoredbg executable."
(let ((file-ext (pcase system-type
(`windows-nt ".exe")
(_ ""))))
(or
(executable-find "netcoredbg")
(expand-file-name (concat "netcoredbg" file-ext) (f-join dap-netcore-install-dir "netcoredbg")))))
(defun dap-netcore--debugger-locate-or-install ()
"Return the location of netcoredbg."
(let ((dbg (dap-netcore--debugger-cmd)))
(unless (file-exists-p dbg)
(if (yes-or-no-p "Netcoredbg is not installed. Do you want to install it?")
(dap-netcore--debugger-install)
(error "Cannot start debugger configuration without netcoredbg")))
dbg))
(defun dap-netcore--locate-dominating-file-wildcard (file name)
"Starting at FILE, look up directory hierarchy for directory containing NAME.
FILE can be a file or a directory. If it's a file, its directory will
serve as the starting point for searching the hierarchy of directories.
Stop at the first parent directory containing a file NAME,
and return the directory. Return nil if not found.
Instead of a string, NAME can also be a predicate taking one argument
\(a directory) and returning a non-nil value if that directory is the one for
which we're looking. The predicate will be called with every file/directory
the function needs to examine, starting with FILE."
;; Represent /home/luser/foo as ~/foo so that we don't try to look for
;; `name' in /home or in /.
(setq file (abbreviate-file-name (expand-file-name file)))
(let ((root nil)
try)
(while (not (or root
(null file)
(string-match locate-dominating-stop-dir-regexp file)))
(setq try (if (stringp name)
(and (file-directory-p file)
(file-expand-wildcards (f-join file name)))
(funcall name file)))
(cond (try (setq root file))
((equal file (setq file (file-name-directory
(directory-file-name file))))
(setq file nil))))
(if root (file-name-as-directory root))))
(defun dap-netcore--populate-args (conf)
"Populate CONF with arguments to launch or attach netcoredbg."
(dap--put-if-absent conf :dap-server-path (list (dap-netcore--debugger-locate-or-install) "--interpreter=vscode"))
(pcase (plist-get conf :mode)
("launch"
(dap--put-if-absent
conf
:program
(let ((project-dir (f-full
(or
(dap-netcore--locate-dominating-file-wildcard
default-directory "*.*proj")
(lsp-workspace-root)))))
(save-mark-and-excursion
(find-file (concat (f-slash project-dir) "*.*proj") t)
(let ((res (if (libxml-available-p)
(libxml-parse-xml-region (point-min) (point-max))
(xml-parse-region (point-min) (point-max)))))
(kill-buffer)
(f-join project-dir "bin" "Debug"
(dom-text (dom-by-tag res 'TargetFramework))
(dom-text (dom-by-tag res 'RuntimeIdentifier))
(concat (car (-take-last 1 (f-split project-dir))) ".dll")))))))
("attach"
(dap--put-if-absent conf :processId (string-to-number (read-string "Enter PID: " "2345"))))))
(dap-register-debug-provider
"coreclr"
'dap-netcore--populate-args)
(dap-register-debug-template ".Net Core Attach (Console)"
(list :type "coreclr"
:request "attach"
:mode "attach"
:name "NetCoreDbg::Attach"))
(dap-register-debug-template ".Net Core Launch (Console)"
(list :type "coreclr"
:request "launch"
:mode "launch"
:name "NetCoreDbg::Launch"
:dap-compilation "dotnet build"))
(provide 'dap-netcore)
;;; dap-netcore.el ends here