From 8bcf623f2f2f62c887ab9c687dd6ad6b8ae02f6e Mon Sep 17 00:00:00 2001 From: dominik martinez Date: Sun, 3 Sep 2023 22:06:57 -0400 Subject: [PATCH] start of refactor --- gudap.el | 675 +++++++++++++++++++++++++++---------------------------- 1 file changed, 336 insertions(+), 339 deletions(-) diff --git a/gudap.el b/gudap.el index ece5c59..fcdbd6d 100644 --- a/gudap.el +++ b/gudap.el @@ -39,287 +39,98 @@ :prefix "gudap-" :group 'applications) -(defconst dap-buffer-size 200) - -(defclass dap-connection () +(defclass gudap-connection () ((name :initarg :name) - (dap-process - :initarg :dap-process - :accessor dap-process) - (event-dispatcher - :initform #'ignore - :initarg :event-dispatcher) - (request-dispatcher - :initform #'ignore - :initarg :request-dispatcher) - (response-dispatcher - :initform #'ignore - :initarg :response-dispatcher) - (message-queue - :initform '() - :accessor message-queue) - (expected-seq - :initform 1 - :accessor expected-seq) - (expected-bytes - :accessor expected-bytes) - (comint-process - :initarg :comint-process - :accessor comint-process) + (-process + :initarg :process + :accessor gudap--process) + (-expected-bytes + :accessor gudap--expected-bytes) + (-sent-requests + :initform (make-hash-table) + :accessor gudap--sent-requests) ;; seq to request command (next-seq - :initform 1 - :accessor next-seq) - (launch-args - :initarg :launch-args - :accessor launch-args) - (breakpoints ;; key is file path, value is list of breakpoints - :initform (make-hash-table :test #'equal) - :accessor breakpoints) - (breakpoints-req-seq ;; key is seq number, value is file path - :initform (make-hash-table :test #'equal) - :accessor breakpoints-req-seq))) + :initform 0 + :accessor gudap--next-seq))) -(cl-defgeneric connection-live-p (connection)) +(defun gudap--test () + (let* ((dap-process (make-process :name "lldb-vscode" + :buffer (generate-new-buffer "lldb-vscode") + :command '("lldb-vscode") + :connection-type 'pipe + :filter 'gudap--process-filter + :coding 'utf-8-emacs-unix)) + (conn (make-instance gudap-connection + :name "lldb-vscode-conn" + :process dap-process))) + (process-put dap-process 'gudap-connection conn) + (setq gudap--current-connection conn) + (gudap-send-request conn 'initialize nil))) -(cl-defmethod connection-live-p ((connection dap-connection)) - (process-live-p (dap-process connection))) +(defun gudap--cleanup () + (kill-process ((gudap--process gudap--current-connection))) + (setq gudap--current-connection nil)) + +(cl-defgeneric gudap-send-request (server command arguments)) -(defvar gudap-server-programs - '(((elixir-mode elixir-ts-mode) . ("elixir-ls-debug")) - ((java-mode java-ts-mode) . (lambda (_inter) - (let ((port (eglot-execute-command - (eglot-current-server) - "vscode.java.startDebugSession" - '()))) - `("localhost" ,port)))))) +(cl-defmethod gudap-send-request (server (command (eql initialize)) arguments) + (puthash (gudap--next-seq server) 'initialize (gudap--sent-requests server)) + (gudap--connection-send + server + (list :type "request" + :command "initialize" + :arguments (gudap--initialize-arguments)))) + + +(cl-defgeneric gudap-handle-response (server type body)) + +(cl-defmethod gudap-handle-response (server type body) + (gudap--message "%s" body)) + +(cl-defmethod gudap-handle-response (server (type (eql initialize)) body) + (gudap--message "initialized: %s" body)) + +(cl-defgeneric gudap-handle-event (server event body)) + +(cl-defmethod gudap-handle-event (server event body) + (gudap--message "%s" message)) + +(cl-defgeneric gudap-handle-request (server command arguments)) + +(defun gudap--initialize-arguments () + (list :clientId "gudap" + :clientName "gudap" + :adapterId "gudap" + :locale "en-US" + :linesStartAt1 t + :columnsStartAt1 t + :pathFormat "path" + :supportsVariableType nil + :supportsVariablePaging nil + :supportsRunInTerminalRequest nil + :supportsMemoryReferences nil + :supportsProgressReporting nil + :supportsInvalidatedEvent nil + :supportsMemoryEvent nil + :supportsArgsCanBeInterpretedByShell nil + :supportsStartDebuggingRequest nil)) + +;; Utils + +(defun gudap--message (format &rest args) + "Message out with FORMAT with ARGS." + (message "[gudap] %s" (apply #'format format args))) -(defvar gudap-launch-args - `(((elixir-mode elixir-ts-mode) . (("phx" . ,(lambda (project) - (list :type "mix_task" - :name "phx.server" - :request "launch" - :task "phx.server" - :projectDir (file-truename (project-root project))))))))) +;; JSONRPC-ish handling -(defvar gudap--connections-by-project (make-hash-table :test #'equal) - "Keys are projects. Values are dap connecections.") - -(defvar gudap--cached-connection nil) - -(defun gudap-reset () - (interactive) - (clrhash gudap--connections-by-project) - (setq gudap--cached-connection nil)) - -(defun gudap (managed-major-modes project _class contact language-id &optional interactive) - (interactive (gudap--guess-contact)) - (let* ((current-conn (gudap-current-connection)) - (live-p (and current-conn (connection-live-p current-conn)))) - (if (and live-p - interactive - (y-or-n-p "[gudap] Live process found, reconnect instead? ")) - (gudap-reconnect current-conn interactive) - (when live-p (ignore-errors (gudap-shutdown current-conn))) - (gudap--connect managed-major-modes project 'dap-connection contact language-id)))) - -(defun gudap--guess-contact () - (let ((eglot-server-programs gudap-server-programs)) - (eglot--guess-contact t))) - -(defun gudap--lookup-launch-args (mode) - (let ((eglot-server-programs gudap-launch-args)) - (eglot--lookup-mode mode))) - -(defun gudap-shutdown () - (interactive) - (let* ((conn (gudap-current-connection))) - (if (dap-process conn) - (kill-buffer (process-buffer (dap-process conn)))) - (if (comint-process conn) - (kill-buffer (process-buffer (comint-process conn)))) - (remhash (eglot--current-project) gudap--connections-by-project) - (setq gudap--cached-connection nil))) - -(defun gudap--connect (managed-modes project class contact language-id) - (let* ((nickname (project-name project)) - (readable-name (format "GUDAP (%s/%s)" nickname managed-modes)) - (dap-proc (if (integerp (cadr contact)) - (open-network-stream - readable-name - (generate-new-buffer readable-name) - (car contact) - (cadr contact) - :sentinel 'dap--server-sentinel - :noquery t) - (make-process :name readable-name - :buffer (generate-new-buffer readable-name) - :command contact - :sentinel 'dap--server-sentinel - :noquery t - :connection-type 'pipe - :coding 'utf-8-emacs-unix))) - (comint-name (format "%s SHELL" readable-name)) - (comint-proc (make-process :name comint-name - :buffer (generate-new-buffer comint-name) - :command nil - :noquery t)) - (conn (make-instance class - :name readable-name - :dap-process dap-proc - :event-dispatcher 'gudap-event-dispatcher - :response-dispatcher 'gudap-response-dispatcher - :comint-process comint-proc - :launch-args (alist-get managed-modes gudap-launch-args nil nil #'equal)))) - (set-process-filter dap-proc 'dap--process-filter) - (setq gudap--cached-connection conn) - (process-put dap-proc 'dap-connection conn) - (process-put comint-proc 'dap-connection conn) - (puthash project conn gudap--connections-by-project) - (gudap--init-comint conn) - (dap--send-initialize conn))) - -(defun gudap--init-comint (conn) - (let ((buffer (process-buffer (comint-process conn)))) - (with-current-buffer buffer - (comint-mode) - (setq-local comint-input-sender #'gudap-comint-receive) - (setq-local comint-prompt-regexp "^> ") - (setq-local comint-use-prompt-regexp t)))) - -(defun gudap-comint-receive (proc message) - (message message)) - -(defun gudap-comint-send (conn message) - (comint-output-filter - (comint-process conn) - (format "%s\n" message))) - -(defun gudap-event-dispatcher (conn message) - (cl-destructuring-bind (&key event body &allow-other-keys) - message - (cond - ( - (equal event "output") - (gudap-comint-send conn (plist-get body :output))) - ( - (equal event "initialized") - (dap--send-all-breakpoints conn) - (dap--send-config-done conn))))) - -(defun gudap-response-dispatcher (conn message) - (cl-destructuring-bind (&key command request_seq body &allow-other-keys) - message - (cond - ( - (equal command "setBreakpoints") - (gudap--verify-breakpoints conn message))))) - -(defun gudap--verify-breakpoints (conn message) - (cl-destructuring-bind (&key request_seq body &allow-other-keys) - message - (let* ((bp-results-vector (plist-get body :breakpoints)) - (bp-results (append bp-results-vector nil)) ;; convert to list - (bp-path (gethash request_seq (breakpoints-req-seq conn))) - (pending-bps (gethash bp-path (breakpoints conn))) - (valid-bps (gudap--validate-breakpoints pending-bps bp-results))) - (puthash bp-path valid-bps (breakpoints conn)) - (remhash request_seq (breakpoints-req-seq conn)) - (message "breakpoints validated")))) - -(defun gudap--validate-breakpoints (bps bp-results) - (if (/= (length bps) (length bp-results)) - (error "Breakpoints and breakpoints results must be the same length.")) - (let ((bp (car bps)) - (bp-result (car bp-results))) - (cond - ( - (null bp) - '()) - ( - (plist-get bp-result :verified) - (cons bp (gudap--validate-breakpoints (cdr bps) (cdr bp-results)))) - ( - (not (plist-get bp-result :verified)) - (gudap--validate-breakpoints (cdr bps) (cdr bp-results)))))) - -(defun dap--send-breakpoints (conn path breakpoints) - (puthash (next-seq conn) path (breakpoints-req-seq conn)) - (dap-connection-send - conn - (list :seq (next-seq conn) - :type "request" - :command "setBreakpoints" - :arguments - (list :source `(:path ,path) - :breakpoints (vconcat breakpoints))))) - -(defun dap--send-all-breakpoints (conn) - (maphash - (lambda (path bps) - (dap--send-breakpoints conn path bps)) - (breakpoints conn))) - -(defun gudap-current-connection () - "Return logical Gudap server for current buffer, nil if none." - (setq gudap--cached-connection - (or gudap--cached-connection - (gethash (eglot--current-project) gudap--connections-by-project)))) - -(defun gudap-launch (conn) - (interactive (list (gudap-current-connection))) - (let* ((launch-keys (mapcar (lambda (elem) (car elem)) (launch-args conn))) - (launch-key (read-from-minibuffer "What launch config to use? " - launch-keys)) - (launch-args (funcall (alist-get launch-key (launch-args conn) nil nil #'equal) (project-current)))) - (dap--send-launch conn launch-args))) - -(defun dap--send-initialize (conn) - (let ((message (list :seq (next-seq conn) - :type "request" - :command "initialize" - :arguments (list :adapterID "dummy" - :supportsProgressReporting t)))) - (dap-connection-send conn message))) - -(defun dap--send-launch (conn launch-args) - (let ((message (list :seq (next-seq conn) - :type "request" - :command "launch" - :arguments launch-args))) - (dap-connection-send conn message))) - -(defun dap--send-config-done (conn) - (let ((message (list :seq (next-seq conn) - :type "request" - :command "configurationDone"))) - (dap-connection-send conn message))) - -(defun dap--server-sentinel (proc event) - (let ((conn (process-get proc 'dap-connection))) - (remhash (eglot--current-project) gudap--connections-by-project)) - (setq gudap--cached-connection nil)) - -(defun dap-connection-send (conn message) - ;; (message "\nSending message:\n") - ;; (pp message) - ;; (message "\n") - (let* ((json-object-type 'plist) - (json (jsonrpc--json-encode message)) - (headers `(("Content-Length" . ,(format "%d" (string-bytes json))))) - (content (cl-loop for (header . value) in headers - concat (concat header ": " value "\r\n") into header-section - finally return (format "%s\r\n%s" header-section json)))) - (process-send-string (dap-process conn) content)) - (setf (next-seq conn) (1+ (next-seq conn)))) - -(defvar dap--in-process-filter nil +(defvar gudap--in-process-filter nil "Non-nil if inside `dap--process-filter'.") -(cl-defun dap--process-filter (proc string) +(cl-defun gudap--process-filter (proc string) "Called when new data STRING has arrived for PROC." - (when dap--in-process-filter + (when gudap--in-process-filter ;; Problematic recursive process filters may happen if ;; `dap--connection-receive', called by us, eventually calls ;; client code which calls `process-send-string' (which see) to, @@ -328,19 +139,18 @@ ;; messages. In that case, remove recursiveness by re-scheduling ;; ourselves to run from within a timer as soon as possible ;; (bug#60088) - (run-at-time 0 nil #'dap--process-filter proc string) - (cl-return-from dap--process-filter)) + (run-at-time 0 nil #'gudap--process-filter proc string) + (cl-return-from gudap--process-filter)) (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) - (let* ((inhibit-read-only t) - (dap--in-process-filter t) - (connection (process-get proc 'dap-connection)) - (expected-bytes (expected-bytes connection))) + (let* ((gudap--in-process-filter t) + (connection (process-get proc 'gudap-connection)) + (expected-bytes (gudap--expected-bytes connection))) ;; Insert the text, advancing the process marker. ;; (save-excursion (goto-char (process-mark proc)) - (insert string) + (let ((inhibit-read-only t)) (insert string)) (set-marker (process-mark proc) (point))) ;; Loop (more than one message might have arrived) ;; @@ -355,7 +165,7 @@ (and (search-forward-regexp "\\(?:.*: .*\r\n\\)*Content-Length: \ *\\([[:digit:]]+\\)\r\n\\(?:.*: .*\r\n\\)*\r\n" - (+ (point) 100) + (+ (point) 200) t) (string-to-number (match-string 1)))) (unless expected-bytes @@ -386,10 +196,11 @@ ;; buffer, shielding proc buffer from ;; tamper (with-temp-buffer - (dap-connection-receive connection - json-message))))) + (gudap--connection-receive connection + json-message))))) (goto-char message-end) - (delete-region (point-min) (point)) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point))) (setq expected-bytes nil)))) (t ;; Message is still incomplete @@ -397,72 +208,258 @@ (setq done :waiting-for-more-bytes-in-this-message)))))))) ;; Saved parsing state for next visit to this filter ;; - (setf (expected-bytes connection) expected-bytes)))))) + (setf (gudap--expected-bytes connection) expected-bytes)))))) -(defun dap-connection-receive (conn message) - (if (dap-queue-full-p (message-queue conn)) - (dap-connection-process-messages conn t)) - (setf (message-queue conn) (dap-queue-insert (message-queue conn) message)) - (dap-connection-process-messages conn)) - -(defun dap-queue-insert (queue message) - (if (dap-queue-full-p queue) - (error "Queue full.")) - (let ((seq (plist-get :seq message)) - (next-seq (plist-get :seq (cadr queue)))) - (cond - ( - (not next-seq) - (list message)) - ( - (> seq next-seq) - (cons (car queue) (dap-queue-insert (cdr queue) message))) - ( - t - (cons message queue))))) - -(defun dap-queue-full-p (queue) - (length= queue dap-buffer-size)) - -(defun dap-connection-process-messages (conn &optional all) - (let ((next-message (car (message-queue conn)))) - (while (and next-message - (or all - (= (plist-get next-message :seq) (expected-seq conn)))) - (dap-process-message conn (pop (message-queue conn))) - (setq next-message (car (message-queue conn)))))) - -(defun dap-process-message (conn message) - (message "\nReceiving message:\n") - (pp message) - (message "\n") - (cl-destructuring-bind (&key seq type &allow-other-keys) - message - (setf (expected-seq conn) (1+ seq)) +(defun gudap--connection-receive (conn message) + (cl-destructuring-bind (&key seq type event body arguments &allow-other-keys) message (cond (;; event - (equal type "event") - (funcall (slot-value conn 'event-dispatcher) conn message)) - (;; request - (equal type "request") - (funcall (slot-value conn 'request-dispatcher) conn message)) + (string-equal type "event") + (gudap-handle-event conn (intern event) body)) (;; response - (equal type "response") - (funcall (slot-value conn 'response-dispatcher) conn message))))) + (string-equal type "response") + (let ((request-type (gethash seq (gudap--sent-requests conn)))) + (if request-type + (gudap-handle-response conn request-type body) + (gudap--message "received response to a nonexistent request. ignoring"))) + (remhash seq (gudap--sent-requests conn))) + (;; reverse request + (string-equal type "request") + (gudap-handle-request conn (intern command) arguments))))) -(defun gudap-break (conn) - (interactive (list (gudap-current-connection))) - (push (gudap--source-breakpoint) (gethash (buffer-file-name) (breakpoints conn)))) +(defun gudap--connection-send (conn message) + (setq message (plist-put message :seq (gudap--next-seq conn))) + (let* ((json-object-type 'plist) + (json (jsonrpc--json-encode message)) + (headers `(("Content-Length" . ,(format "%d" (string-bytes json))))) + (content (cl-loop for (header . value) in headers + concat (concat header ": " value "\r\n") into header-section + finally return (format "%s\r\n%s" header-section json)))) + (process-send-string (gudap--process conn) content)) + (setf (gudap--next-seq conn) (1+ (gudap--next-seq conn)))) -(defun gudap--source-breakpoint () - (list :line (save-restriction - (widen) - (+ (count-lines (point-min) (point)) - (if (bolp) 1 0))) - :column (1+ (current-column)))) +;; (defvar gudap-server-programs +;; '(((elixir-mode elixir-ts-mode) . ("elixir-ls-debug")))) + +;; (defvar gudap-launch-args +;; `(((elixir-mode elixir-ts-mode) . (("phx" . ,(lambda (project) +;; (list :type "mix_task" +;; :name "phx.server" +;; :request "launch" +;; :task "phx.server" +;; :projectDir (file-truename (project-root project))))))))) + +;; (defvar gudap--connections-by-project (make-hash-table :test #'equal) +;; "Keys are projects. Values are dap connecections.") + +;; (defvar gudap--cached-connection nil) + +;; (defun gudap-reset () +;; (interactive) +;; (clrhash gudap--connections-by-project) +;; (setq gudap--cached-connection nil)) + +;; (defun gudap (managed-major-modes project _class contact language-id &optional interactive) +;; (interactive (gudap--guess-contact)) +;; (let* ((current-conn (gudap-current-connection)) +;; (live-p (and current-conn (connection-live-p current-conn)))) +;; (if (and live-p +;; interactive +;; (y-or-n-p "[gudap] Live process found, reconnect instead? ")) +;; (gudap-reconnect current-conn interactive) +;; (when live-p (ignore-errors (gudap-shutdown current-conn))) +;; (gudap--connect managed-major-modes project 'dap-connection contact language-id)))) + +;; (defun gudap--guess-contact () +;; (let ((eglot-server-programs gudap-server-programs)) +;; (eglot--guess-contact t))) + +;; (defun gudap--lookup-launch-args (mode) +;; (let ((eglot-server-programs gudap-launch-args)) +;; (eglot--lookup-mode mode))) + +;; (defun gudap-shutdown () +;; (interactive) +;; (let* ((conn (gudap-current-connection))) +;; (if (dap-process conn) +;; (kill-buffer (process-buffer (dap-process conn)))) +;; (if (comint-process conn) +;; (kill-buffer (process-buffer (comint-process conn)))) +;; (remhash (eglot--current-project) gudap--connections-by-project) +;; (setq gudap--cached-connection nil))) + +;; (defun gudap--connect (managed-modes project class contact language-id) +;; (let* ((nickname (project-name project)) +;; (readable-name (format "GUDAP (%s/%s)" nickname managed-modes)) +;; (dap-proc (if (integerp (cadr contact)) +;; (open-network-stream +;; readable-name +;; (generate-new-buffer readable-name) +;; (car contact) +;; (cadr contact) +;; :sentinel 'dap--server-sentinel +;; :noquery t) +;; (make-process :name readable-name +;; :buffer (generate-new-buffer readable-name) +;; :command contact +;; :sentinel 'dap--server-sentinel +;; :noquery t +;; :connection-type 'pipe +;; :coding 'utf-8-emacs-unix))) +;; (comint-name (format "%s SHELL" readable-name)) +;; (comint-proc (make-process :name comint-name +;; :buffer (generate-new-buffer comint-name) +;; :command nil +;; :noquery t)) +;; (conn (make-instance class +;; :name readable-name +;; :dap-process dap-proc +;; :event-dispatcher 'gudap-event-dispatcher +;; :response-dispatcher 'gudap-response-dispatcher +;; :comint-process comint-proc +;; :launch-args (alist-get managed-modes gudap-launch-args nil nil #'equal)))) +;; (set-process-filter dap-proc 'dap--process-filter) +;; (setq gudap--cached-connection conn) +;; (process-put dap-proc 'dap-connection conn) +;; (process-put comint-proc 'dap-connection conn) +;; (puthash project conn gudap--connections-by-project) +;; (gudap--init-comint conn) +;; (dap--send-initialize conn))) + +;; (defun gudap--init-comint (conn) +;; (let ((buffer (process-buffer (comint-process conn)))) +;; (with-current-buffer buffer +;; (comint-mode) +;; (setq-local comint-input-sender #'gudap-comint-receive) +;; (setq-local comint-prompt-regexp "^> ") +;; (setq-local comint-use-prompt-regexp t)))) + +;; (defun gudap-comint-receive (proc message) +;; (message message)) + +;; (defun gudap-comint-send (conn message) +;; (comint-output-filter +;; (comint-process conn) +;; (format "%s\n" message))) + +;; (defun gudap-event-dispatcher (conn message) +;; (cl-destructuring-bind (&key event body &allow-other-keys) +;; message +;; (cond +;; ( +;; (equal event "output") +;; (gudap-comint-send conn (plist-get body :output))) +;; ( +;; (equal event "initialized") +;; (dap--send-all-breakpoints conn) +;; (dap--send-config-done conn))))) + +;; (defun gudap-response-dispatcher (conn message) +;; (cl-destructuring-bind (&key command request_seq body &allow-other-keys) +;; message +;; (cond +;; ( +;; (equal command "setBreakpoints") +;; (gudap--verify-breakpoints conn message))))) + +;; (defun gudap--verify-breakpoints (conn message) +;; (cl-destructuring-bind (&key request_seq body &allow-other-keys) +;; message +;; (let* ((bp-results-vector (plist-get body :breakpoints)) +;; (bp-results (append bp-results-vector nil)) ;; convert to list +;; (bp-path (gethash request_seq (breakpoints-req-seq conn))) +;; (pending-bps (gethash bp-path (breakpoints conn))) +;; (valid-bps (gudap--validate-breakpoints pending-bps bp-results))) +;; (puthash bp-path valid-bps (breakpoints conn)) +;; (remhash request_seq (breakpoints-req-seq conn)) +;; (message "breakpoints validated")))) + +;; (defun gudap--validate-breakpoints (bps bp-results) +;; (if (/= (length bps) (length bp-results)) +;; (error "Breakpoints and breakpoints results must be the same length.")) +;; (let ((bp (car bps)) +;; (bp-result (car bp-results))) +;; (cond +;; ( +;; (null bp) +;; '()) +;; ( +;; (plist-get bp-result :verified) +;; (cons bp (gudap--validate-breakpoints (cdr bps) (cdr bp-results)))) +;; ( +;; (not (plist-get bp-result :verified)) +;; (gudap--validate-breakpoints (cdr bps) (cdr bp-results)))))) + +;; (defun dap--send-breakpoints (conn path breakpoints) +;; (puthash (next-seq conn) path (breakpoints-req-seq conn)) +;; (dap-connection-send +;; conn +;; (list :seq (next-seq conn) +;; :type "request" +;; :command "setBreakpoints" +;; :arguments +;; (list :source `(:path ,path) +;; :breakpoints (vconcat breakpoints))))) + +;; (defun dap--send-all-breakpoints (conn) +;; (maphash +;; (lambda (path bps) +;; (dap--send-breakpoints conn path bps)) +;; (breakpoints conn))) + +;; (defun gudap-current-connection () +;; "Return logical Gudap server for current buffer, nil if none." +;; (setq gudap--cached-connection +;; (or gudap--cached-connection +;; (gethash (eglot--current-project) gudap--connections-by-project)))) + +;; (defun gudap-launch (conn) +;; (interactive (list (gudap-current-connection))) +;; (let* ((launch-keys (mapcar (lambda (elem) (car elem)) (launch-args conn))) +;; (launch-key (read-from-minibuffer "What launch config to use? " +;; launch-keys)) +;; (launch-args (funcall (alist-get launch-key (launch-args conn) nil nil #'equal) (project-current)))) +;; (dap--send-launch conn launch-args))) + +;; (defun dap--send-initialize (conn) +;; (let ((message (list :seq (next-seq conn) +;; :type "request" +;; :command "initialize" +;; :arguments (list :adapterID "dummy" +;; :supportsProgressReporting t)))) +;; (dap-connection-send conn message))) + +;; (defun dap--send-launch (conn launch-args) +;; (let ((message (list :seq (next-seq conn) +;; :type "request" +;; :command "launch" +;; :arguments launch-args))) +;; (dap-connection-send conn message))) + +;; (defun dap--send-config-done (conn) +;; (let ((message (list :seq (next-seq conn) +;; :type "request" +;; :command "configurationDone"))) +;; (dap-connection-send conn message))) + +;; (defun dap--server-sentinel (proc event) +;; (let ((conn (process-get proc 'dap-connection))) +;; (remhash (eglot--current-project) gudap--connections-by-project)) +;; (setq gudap--cached-connection nil)) + +;; (defun dap-connection-send (conn message) +;; ;; (message "\nSending message:\n") +;; ;; (pp message) +;; ;; (message "\n") +;; (let* ((json-object-type 'plist) +;; (json (jsonrpc--json-encode message)) +;; (headers `(("Content-Length" . ,(format "%d" (string-bytes json))))) +;; (content (cl-loop for (header . value) in headers +;; concat (concat header ": " value "\r\n") into header-section +;; finally return (format "%s\r\n%s" header-section json)))) +;; (process-send-string (dap-process conn) content)) +;; (setf (next-seq conn) (1+ (next-seq conn)))) -(defun gudap--source (file-path) - (list :path file-path)) ;;;###autoload (provide 'gudap)