From 8e8ddb4db771eb45e4d9ef7c38b2c16a4367eb79 Mon Sep 17 00:00:00 2001 From: dominik martinez Date: Sun, 11 Jun 2023 12:31:59 -0400 Subject: [PATCH] Some more breakpoint work complete. --- gudap.el | 56 ++++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 46 insertions(+), 10 deletions(-) diff --git a/gudap.el b/gudap.el index 962db82..548b2ec 100644 --- a/gudap.el +++ b/gudap.el @@ -75,7 +75,10 @@ :accessor launch-args) (breakpoints ;; key is file path, value is list of breakpoints :initform (make-hash-table :test #'equal) - :accessor breakpoints))) + :accessor breakpoints) + (breakpoints-req-seq ;; key is seq number, value is file path + :initform (make-hash-table :test #'equal) + :accessor breakpoints-req-seq))) (cl-defgeneric connection-live-p (connection)) @@ -95,6 +98,8 @@ (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) @@ -187,7 +192,44 @@ (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) @@ -203,8 +245,6 @@ (dap--send-breakpoints conn path bps)) (breakpoints conn))) -(defun gudap-response-dispatcher (conn message)) - (defun gudap-current-connection () "Return logical Gudap server for current buffer, nil if none." (setq gudap--cached-connection @@ -219,9 +259,6 @@ (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" @@ -244,15 +281,14 @@ (dap-connection-send conn message))) (defun dap--server-sentinel (proc event) - (pp 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") + ;; (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)))))