Better gud function creation

README.md

@@ -0,0 +1,12 @@
+# Gudap
+
+Combining the powers of Emacs' [GUD](https://www.gnu.org/software/emacs/manual/html_node/emacs/Debuggers.html) and [DAP](https://microsoft.github.io/debug-adapter-protocol/).
+
+# Usage
+
+```lisp
+(use-package gudap
+	:load-path "/path/to/gudap/")
+
+(gudap)
+```

gudap.el

@@ -31,73 +31,443 @@
 
 ;;; Code:
 
-(require 'eglot)
 (require 'jsonrpc)
+(require 'gud)
 
 (defgroup gudap nil
   "Interaction with Debug Adapter Protocol servers."
   :prefix "gudap-"
   :group 'applications)
 
-(defclass gudap-connection ()
+(defclass gudap-server ()
   ((name
     :initarg :name)
-   (-process
+   (dap-process
-    :initarg :process
+    :initarg :dap-process
-    :accessor gudap--process)
+    :accessor gudap-dap-process)
-   (-expected-bytes
+   (gud-buffer
-    :accessor gudap--expected-bytes)
+    :initarg :gud-buffer
-   (-sent-requests
+    :accessor gudap-gud-buffer)
-    :initform (make-hash-table)
+   (events-buffer
-    :accessor gudap--sent-requests) ;; seq to request command
+    :initarg :events-buffer
-   (next-seq
+    :accessor gudap-events-buffer)
-    :initform 0
+   (launch-config
-    :accessor gudap--next-seq)))
+    :initarg :launch-config
+    :accessor gudap-launch-config)
+   (expected-bytes
+    :initform nil
+    :accessor gudap-expected-bytes)
+   (seq
+    :initform 1
+    :accessor gudap-seq)
+   (initialized
+    :initform nil
+    :accessor gudap-initialized)
+   (breakpoints
+    :initform (make-hash-table :test 'equal)
+    :accessor gudap-breakpoints)
+   (capabilities
+    :accessor gudap-capabilities)
+   (callbacks
+    :initform (make-hash-table :test 'equal)
+    :accessor gudap-callbacks)
+   (current-thread
+    :initform nil
+    :accessor gudap-current-thread)
+   (current-frame
+    :initform nil
+    :accessor gudap-current-frame)
+   (stopped
+    :initform t
+    :accessor gudap-stopped)))
 
-(defun gudap--test ()
+(defclass breakpoint ()
-  (let* ((dap-process (make-process :name "lldb-vscode"
+  ((id
-				    :buffer (generate-new-buffer "lldb-vscode")
+    :initarg :id
-				    :command '("lldb-vscode")
+    :accessor gudap-bp-id)
-				    :connection-type 'pipe
+   (verified
-				    :filter 'gudap--process-filter
+    :initarg :verified
-				    :coding 'utf-8-emacs-unix))
+    :accessor gudap-bp-verified)
-	 (conn (make-instance gudap-connection
+   (source
-			      :name "lldb-vscode-conn"
+    :initarg :source
-			      :process dap-process)))
+    :accessor gudap-bp-source)
-    (process-put dap-process 'gudap-connection conn)
+   (line
-    (setq gudap--current-connection conn)
+    :initarg :line
-    (gudap-send-request conn 'initialize nil)))
+    :accessor gudap-bp-line)))
+
+(defclass source-breakpoint (breakpoint)
+  ((condition
+    :initarg :condition
+    :initform nil
+    :accessor gudap-source-bp-condition)))
+
+(cl-defmethod gudap-bp-update ((bp source-breakpoint) server-bp)
+  (cl-destructuring-bind (&key id verified source line &allow-other-keys) server-bp
+    (make-instance 'source-breakpoint
+		   :id id
+		   :verified verified
+		   :source source
+		   :line line
+		   :condition (gudap-source-bp-condition bp))))
+
+(cl-defmethod gudap-bp-params ((bp source-breakpoint))
+  (with-slots (line condition) bp
+    (list :line line
+	  :condition condition)))
+
+(defun gudap-bps-params (bps)
+  (mapcar 'gudap-bp-params bps))
+
+(defvar gudap-server-programs-and-launch
+  '(((c++-mode c-mode rust-mode) "lldb-vscode" (lambda ()
+						  (list :name "gudap-lldb"
+							:type "lldb-vscode"
+							:request "launch"
+							:program (read-file-name "Program to debug? "))))))
+(defvar gudap-active-server nil)
+
+(defun gudap--buffer-line ()
+  (save-restriction
+    (widen)
+    (+ (count-lines (point-min) (point))
+       (if (bolp) 1 0))))
+
+(defmacro gudap-with-initialized (server-var &rest body)
+  (declare (indent defun))
+  `(let* ((server ,server-var)
+	  (initialized (gudap-initialized server)))
+     (if initialized
+	 (progn ,@body))))
+
+(defun gudap--gud-run (arg)
+  (gudap-with-initialized gudap-active-server
+    (gudap-send-request
+     gudap-active-server
+     'configurationDone
+     '())))
+
+(defun gudap--gud-cont (arg)
+  (gudap-with-initialized gudap-active-server
+    (gudap-send-request
+     server
+     'continue
+     (list :threadId (gudap-current-thread server)))))
+
+(defun gudap-update-breakpoints (server file-path bps server-bps)
+  (puthash file-path
+	   (cl-loop for bp across bps
+		    for server-bp across server-bps
+		    collect (gudap-bp-update bp server-bp))
+	   (gudap-breakpoints server)))
+
+(defun gudap--gud-break (arg)
+  (gudap-with-initialized gudap-active-server
+    (let* ((file-path (buffer-file-name))
+	   (current-bps (gethash file-path (gudap-breakpoints server)))
+	   (new-bp (make-instance 'source-breakpoint
+				  :line (line-number-at-pos)
+				  :condition (if (> arg 1) (read-string "Expression: "))))
+	   (bps (vconcat (cons new-bp current-bps))))
+      (gudap-send-request
+       server
+       'setBreakpoints
+       (list :source (gudap--dap-type-source file-path)
+	     :breakpoints (vconcat (mapcar 'gudap-bp-params bps)))
+       (lambda (server success body)
+	 (gudap-update-breakpoints server file-path bps (plist-get body :breakpoints)))))))
+
+(defun gudap--gud-break-cond (arg)
+  (gudap--gud-break (read-string "Expression: ")))
+
+(defun gudap--gud-remove (arg)
+  (gudap-with-initialized gudap-active-server
+    (let* ((file-path (buffer-file-name))
+	   (line (line-number-at-pos))
+	   (current-breakpoints (gethash file-path (gudap-breakpoints server))))
+      (if current-breakpoints
+	  (let* ((filtered-breakpoints (seq-filter
+					(lambda (bp) (/= line (gudap-bp-line bp)))
+					current-breakpoints))
+		 (source-breakpoints (vconcat (gudap-bps-params filtered-breakpoints))))
+	    (if (= (length current-breakpoints) (length source-breakpoints))
+		(gudap--message "No breakpoints at location!")
+	      (remhash file-path (gudap-breakpoints server))
+	      (gudap-send-request
+	       server
+	       'setBreakpoints
+	       (list :source (gudap--dap-type-source file-path)
+		     :breakpoints source-breakpoints)
+	       (lambda (server success body)
+		 (gudap-update-breakpoints server file-path source-breakpoints (plist-get body :breakpoints))))))
+	(gudap--message "No breakpoints at location!")))))
+
+(defun gudap--gud-next (arg)
+  (gudap-with-initialized gudap-active-server
+    (if (gudap-stopped server)
+	(gudap-send-request
+	 server
+	 'next
+	 (list :threadId (gudap-current-thread server))))))
+
+(defun gudap--gud-stepi (arg)
+  (gudap-with-initialized gudap-active-server
+    (if (gudap-stopped server)
+	(gudap-send-request
+	 server
+	 'stepIn
+	 (list :threadId (gudap-current-thread server))))))
+	
+(defun gudap--dap-type-source (file-path)
+  (list :path file-path))
+
+(defmacro def-gudap-cmd (gud-cmd gudap-fn key)
+  `(progn
+     (defalias ',gud-cmd (lambda (arg)
+			   (interactive "p")
+			   (,gudap-fn arg)))
+     ,(if key `(local-set-key ,(concat "\C-c" key) #',gud-cmd))
+     ,(if key `(define-key gud-global-map ,key #',gud-cmd))))
+
+(defun gudap ()
+  (interactive)
+  (let ((program-and-launch-config (gudap--guess-contact))
+	(gud-comint-buffer (gud-common-init "cat"
+					    (lambda (_file args) args)
+					    #'identity)))
+    (setq comint-prompt-regexp "^>")
+    (gudap--connect (car program-and-launch-config) (cdr program-and-launch-config) gud-comint-buffer)
+
+    (def-gudap-cmd gud-break      gudap--gud-break      "\C-b")
+    (def-gudap-cmd gud-cont       gudap--gud-cont       "\C-r")
+    (def-gudap-cmd gud-run        gudap--gud-run        nil)
+    (def-gudap-cmd gud-remove     gudap--gud-remove     "\C-d")
+    (def-gudap-cmd gud-next       gudap--gud-next       "\C-n")
+    (def-gudap-cmd gud-stepi      gudap--gud-stepi      "\C-i")
+
+    (setq gdb-first-prompt t)
+    (setq gud-running nil)
+    (add-hook 'comint-input-filter-functions
+	      (lambda (input) (gudap-gud-input gudap-active-server input)))
+    (gudap-gud-prompt gudap-active-server)))
+
+    ;; (setq-local gud-minor-mode 'gdbmi)
+    ;; (setq-local gdb-control-level 0)
+
+    ;; (gdb-setup-windows))
+
+(defun gudap--gdb-update ()
+  (when gdb-first-prompt
+    (gdb-force-mode-line-update
+     (propertize "initializing..." 'face font-lock-variable-name-face))
+    (gudap--gdb-init-1)
+    (setq gdb-first-prompt nil))
+
+  (gdb-get-buffer-create 'gdb-threads-buffer)
+  (gdb-get-buffer-create 'gdb-breakpoints-buffer)
+
+  ;;(gdb-get-changed-registers)
+  (unless no-proc
+    (gdb-emit-signal gdb-buf-publisher 'update))
+
+  ;; (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
+  ;;   (dolist (var gdb-var-list)
+  ;;     (setcar (nthcdr 5 var) nil))
+  ;;   (gdb-var-update))
+  )
+
+(defun gdb-init-1 ()
+  ;; (Re-)initialize.
+  (setq gdb-selected-frame nil
+	gdb-frame-number nil
+        gdb-thread-number nil
+	gdb-var-list nil
+	gdb-output-sink 'user
+	gdb-location-alist nil
+	gdb-source-file-list nil
+	gdb-last-command nil
+	gdb-token-number 0
+	gdb-handler-list '()
+	gdb-prompt-name nil
+	gdb-first-done-or-error t
+	gdb-target-async-checked nil
+	gdb-buffer-fringe-width (car (window-fringes))
+	gdb-debug-log nil
+	gdb-source-window-list nil
+	gdb-inferior-status nil
+	gdb-continuation nil
+        gdb-buf-publisher '()
+        gdb-threads-list '()
+        gdb-breakpoints-list '()
+        gdb-register-names '()
+        gdb-supports-non-stop nil
+        gdb-non-stop nil
+        gdb-debuginfod-enable gdb-debuginfod-enable-setting)
+  (gdb-force-mode-line-update
+   (propertize "initializing..." 'face font-lock-variable-name-face)))
+
+(defun gudap-shutdown ()
+  (interactive)
+  (kill-buffer (process-buffer (gudap-dap-process gudap-active-server)))
+  (kill-buffer (gudap-gud-buffer gudap-active-server))
+  (kill-buffer (gudap-events-buffer gudap-active-server))
+  (setq gudap-active-server nil))
+
+(defun gudap--connect (server-command launch-config gud-buffer)
+  (let* ((nickname server-command)
+	 (readable-name (format "GUDAP (%s)" nickname))
+	 (dap-proc  (make-process :name            readable-name
+				  :buffer          (get-buffer-create (format " *%s events*" readable-name))
+				  :command         (list server-command)
+				  :filter          'gudap--process-filter
+				  :noquery         t
+				  :connection-type 'pipe
+				  :coding          'utf-8-emacs-unix))
+	 (server (make-instance 'gudap-server
+				:name        readable-name
+				:dap-process dap-proc
+				:gud-buffer  gud-buffer
+				:events-buffer (get-buffer-create (format "*%s log*" readable-name))
+				:launch-config launch-config)))
+    (process-put dap-proc 'gudap-server server)
+    (setq gudap-active-server server)
+    (gudap-send-request server 'initialize (gudap--initialize-arguments))))
+
+(defun gudap--guess-contact ()
+  (let* ((guessed-mode (if buffer-file-name major-mode))
+	 (program-and-launch (gudap--lookup-program-and-launch guessed-mode))
+	 (server-program (cadr program-and-launch))
+	 (launch-config-uneval (caddr program-and-launch))
+	 (launch-config (or (and (functionp launch-config-uneval)
+				 (funcall launch-config-uneval))
+			    (and (listp launch-config-uneval)
+				 launch-config-uneval))))
+    (cons server-program launch-config)))
+
+(defun gudap--lookup-program-and-launch (mode-name)
+  (cl-loop for p-l in gudap-server-programs-and-launch
+	   if (or
+	       (and (listp (car p-l)) (member mode-name (car p-l)))
+	       (and (symbolp (car p-l)) (equal mode-name (car p-l))))
+	   return p-l))
+
+;;; REQUESTS
 
-(defun gudap--cleanup ()
-  (kill-process ((gudap--process gudap--current-connection)))
-  (setq gudap--current-connection nil))
-    
 (cl-defgeneric gudap-send-request (server command arguments))
 
-(cl-defmethod gudap-send-request (server (command (eql initialize)) arguments)
+(cl-defmethod gudap-send-request (server command arguments &optional callback-fn)
-  (puthash (gudap--next-seq server) 'initialize (gudap--sent-requests server))
+  (if callback-fn
+      (puthash (gudap-seq server) callback-fn (gudap-callbacks server)))
   (gudap--connection-send
    server
    (list :type "request"
-	 :command "initialize"
+	 :command (symbol-name command)
-	 :arguments (gudap--initialize-arguments))))
+	 :arguments arguments)))
-	   
 
-(cl-defgeneric gudap-handle-response (server type body))
+;;; RESPONSES
 
-(cl-defmethod gudap-handle-response (server type body)
+(cl-defgeneric gudap-handle-response (server command success body err-msg)
-  (gudap--message "%s" body))
+  "Handler for DAP response.")
 
-(cl-defmethod gudap-handle-response (server (type (eql initialize)) body)
+(cl-defmethod gudap-handle-response (server (_type (eql initialize)) _success _body _err-msg)
-  (gudap--message "initialized: %s" body))
+  (gudap-send-request server 'launch (gudap-launch-config server)))
+
+(cl-defmethod gudap-handle-response (server (type (eql evaluate)) (success (eql t)) body _err-msg)
+  (gudap-gud-output server (plist-get body :result)))
+
+(cl-defmethod gudap-handle-response (server (type (eql evaluate)) _success _body err-msg)
+  (gudap-gud-output server err-msg))
+
+(cl-defmethod gudap-handle-response (server (type (eql continue)) (success (eql t)) _body err-msg)
+  (setf (gudap-stopped server) nil))
+
+(cl-defmethod gudap-handle-response (server command success body err-msg)
+  (gudap--message "unknown response: %s" body))
+
+;;; EVENTS
 
 (cl-defgeneric gudap-handle-event (server event body))
 
 (cl-defmethod gudap-handle-event (server event body)
-  (gudap--message "%s" message))
+  (gudap--message "%s" body))
+
+(cl-defmethod gudap-handle-event (server (event (eql output)) body)
+  (let ((gud-process (get-buffer-process (gudap-gud-buffer server))))
+    (cl-destructuring-bind
+	(&key category output group variablesReference source line column data)
+	body
+      (gudap-gud-output server output))))
+
+(cl-defmethod gudap-handle-event (server (event (eql initialized)) body)
+  (setf (gudap-initialized server) t))
+
+(cl-defmethod gudap-handle-event (server (event (eql terminated)) body)
+  (setf (gudap-initialized server) nil
+	(gudap-stopped server) t))
+
+(defun gudap-gud-goto-frame-from-stack-trace (server success stack-trace-body)
+  (when success
+    (let* ((stack-frames (plist-get stack-trace-body :stackFrames))
+	   (top-frame (aref stack-frames 0))
+	   (path (plist-get (plist-get top-frame :source) :path))
+	   (line (plist-get top-frame :line)))
+      (setf (gudap-current-frame server) (plist-get top-frame :id))
+      (setq gud-last-frame (cons path line)))
+    (gud-display-frame)))
+
+(cl-defmethod gudap-handle-event (server (event (eql stopped)) body)
+  (cl-destructuring-bind (&key reason threadId &allow-other-keys) body
+    (cond
+     ( ;; breakpoint
+      (or (equal reason "breakpoint") (equal reason "step"))
+      (setf (gudap-current-thread server) threadId
+	    (gudap-stopped server) t)
+      (gudap-send-request server
+			  'stackTrace
+			  (list :threadId threadId
+				:levels 1)
+			  'gudap-gud-goto-frame-from-stack-trace)))))
+
+;;; REVERSE REQUESTS
 
 (cl-defgeneric gudap-handle-request (server command arguments))
 
+;;; UTILS
+
+(cl-defgeneric gudap-print-received (server received))
+
+(cl-defmethod gudap-print-received (server received)
+  (with-current-buffer (gudap-events-buffer server)
+    (goto-char (point-max))
+    (insert (format "received:\n%s\n\n" (pp-to-string received)))))
+
+(cl-defgeneric gudap-print-sent (server sent))
+
+(cl-defmethod gudap-print-sent (server sent)
+  (with-current-buffer (gudap-events-buffer server)
+    (goto-char (point-max))
+    (insert (format "sent:\n%s\n\n" (pp-to-string sent)))))
+
+
+
+;;; GUD
+
+(cl-defmethod gudap-gud-output (server output)
+  (let* ((gud-buffer (gudap-gud-buffer server))
+	 (gud-process (get-buffer-process gud-buffer)))
+    (gud-filter gud-process (format "\n%s\n> " output))))
+
+(cl-defmethod gudap-gud-prompt (server)
+  (let ((gud-process (get-buffer-process (gudap-gud-buffer server))))
+    (gud-filter gud-process "> ")))
+
+(cl-defmethod gudap-gud-input (server input)
+  (let ((gud-process (get-buffer-process (gudap-gud-buffer server))))
+    (gudap-send-request server
+			'evaluate
+			(list :expression input
+			      :frameId (gudap-current-frame server)
+			      :context "repl"))))
+
 (defun gudap--initialize-arguments ()
   (list :clientId "gudap"
 	:clientName "gudap"
@@ -116,18 +486,21 @@
 	:supportsArgsCanBeInterpretedByShell nil
 	:supportsStartDebuggingRequest nil))
 
-;; Utils    
+(defun gudap--path (source)
+  (plist-get source :path))
+
+;; Utils
 
 (defun gudap--message (format &rest args)
   "Message out with FORMAT with ARGS."
   (message "[gudap] %s" (apply #'format format args)))
 
-
 ;; JSONRPC-ish handling
 
 (defvar gudap--in-process-filter nil
   "Non-nil if inside `dap--process-filter'.")
 
+;; adapted from jsonrpc.el
 (cl-defun gudap--process-filter (proc string)
   "Called when new data STRING has arrived for PROC."
   (when gudap--in-process-filter
@@ -144,8 +517,8 @@
   (when (buffer-live-p (process-buffer proc))
     (with-current-buffer (process-buffer proc)
       (let* ((gudap--in-process-filter t)
-	     (connection (process-get proc 'gudap-connection))
+	     (server (process-get proc 'gudap-server))
-             (expected-bytes (gudap--expected-bytes connection)))
+             (expected-bytes (gudap-expected-bytes server)))
         ;; Insert the text, advancing the process marker.
         ;;
         (save-excursion
@@ -165,7 +538,7 @@
                         (and (search-forward-regexp
                               "\\(?:.*: .*\r\n\\)*Content-Length: \
 *\\([[:digit:]]+\\)\r\n\\(?:.*: .*\r\n\\)*\r\n"
-                              (+ (point) 200)
+			      nil
                               t)
                              (string-to-number (match-string 1))))
                   (unless expected-bytes
@@ -196,7 +569,7 @@
                                   ;; buffer, shielding proc buffer from
                                   ;; tamper
                                   (with-temp-buffer
-                                    (gudap--connection-receive connection
+                                    (gudap--connection-receive server
                                                                json-message)))))
                           (goto-char message-end)
 			  (let ((inhibit-read-only t))
@@ -208,258 +581,37 @@
                       (setq done :waiting-for-more-bytes-in-this-message))))))))
           ;; Saved parsing state for next visit to this filter
           ;;
-          (setf (gudap--expected-bytes connection) expected-bytes))))))
+          (setf (gudap-expected-bytes server) expected-bytes))))))
 
 (defun gudap--connection-receive (conn message)
-  (cl-destructuring-bind (&key seq type event body arguments &allow-other-keys) message
+  (gudap-print-received conn message)
+  (cl-destructuring-bind (&key seq request_seq type command event body arguments success message &allow-other-keys) message
     (cond
+     (;; callback present
+      (gethash request_seq (gudap-callbacks conn))
+      (funcall (gethash request_seq (gudap-callbacks conn)) conn success body)
+      (remhash request_seq (gudap-callbacks conn)))
      (;; event
       (string-equal type "event")
       (gudap-handle-event conn (intern event) body))
      (;; response
       (string-equal type "response")
-      (let ((request-type (gethash seq (gudap--sent-requests conn))))
+      (gudap-handle-response conn (intern command) success body message))
-	(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--connection-send (conn message)
-  (setq message (plist-put message :seq (gudap--next-seq conn)))
+  (setq message (plist-put message :seq (gudap-seq conn)))
+  (gudap-print-sent conn message)
   (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))
+    (process-send-string (gudap-dap-process conn) content))
-  (setf (gudap--next-seq conn) (1+ (gudap--next-seq conn))))
+  (setf (gudap-seq conn) (1+ (gudap-seq conn))))
-
-;; (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))))
-
 
 ;;;###autoload
 (provide 'gudap)