From 702f5917b13f7ca27efcf45026798314b155f52d Mon Sep 17 00:00:00 2001 From: dominik martinez Date: Thu, 6 Jun 2024 16:51:19 -0400 Subject: [PATCH] Conditional source breakpoints --- gudap.el | 110 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 67 insertions(+), 43 deletions(-) diff --git a/gudap.el b/gudap.el index ed027e8..b5ad4f8 100644 --- a/gudap.el +++ b/gudap.el @@ -63,7 +63,7 @@ (initialized :initform nil :accessor gudap-initialized) - (breakpoints ;; file path to list of plists (:line lineNum) + (breakpoints :initform (make-hash-table :test 'equal) :accessor gudap-breakpoints) (capabilities @@ -81,6 +81,43 @@ :initform t :accessor gudap-stopped))) +(defclass breakpoint () + ((id + :initarg :id + :accessor gudap-bp-id) + (verified + :initarg :verified + :accessor gudap-bp-verified) + (source + :initarg :source + :accessor gudap-bp-source) + (line + :initarg :line + :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" @@ -95,19 +132,6 @@ (+ (count-lines (point-min) (point)) (if (bolp) 1 0)))) -(defun gudap--source-breakpoint (&optional breakpoint) - (if breakpoint - (cl-destructuring-bind (&key line column &allow-other-keys) breakpoint - (list :line line)) - (list :line (line-number-at-pos)))) - -(defun gudap--breakpoints-source-breakpoints (breakpoints) - "Convert BREAKPOINTS to source breakpoints for setBreakpoints request." - (mapcar 'gudap--source-breakpoint breakpoints)) - -(defun gudap--source (filepath) - (list :path filepath)) - (defmacro gudap-with-initialized (server-var &rest body) (declare (indent defun)) `(let* ((server ,server-var) @@ -131,39 +155,55 @@ '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 () +(defun gudap--gud-break (&optional condition) (interactive) (gudap-with-initialized gudap-active-server (let* ((file-path (buffer-file-name)) - (old-breakpoints (gethash file-path (gudap-breakpoints server))) - (source-breakpoints (vconcat (cons (gudap--source-breakpoint) - (gudap--breakpoints-source-breakpoints old-breakpoints))))) + (current-bps (gethash file-path (gudap-breakpoints server))) + (new-bp (make-instance 'source-breakpoint + :line (line-number-at-pos) + :condition condition)) + (bps (vconcat (cons new-bp current-bps)))) (gudap-send-request server 'setBreakpoints (list :source (gudap--dap-type-source file-path) - :breakpoints source-breakpoints))))) + :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 () + (interactive) + (gudap--gud-break (read-string "Expression: "))) (defun gudap--gud-remove () (interactive) (gudap-with-initialized gudap-active-server (let* ((file-path (buffer-file-name)) (line (line-number-at-pos)) - (old-breakpoints (gethash file-path (gudap-breakpoints server)))) - (if old-breakpoints + (current-breakpoints (gethash file-path (gudap-breakpoints server)))) + (if current-breakpoints (let* ((filtered-breakpoints (seq-filter - (lambda (bp) (/= line (plist-get bp :line))) - old-breakpoints)) - (source-breakpoints (vconcat (gudap--breakpoints-source-breakpoints filtered-breakpoints)))) - (if (= (length old-breakpoints) (length source-breakpoints)) + (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)))) + :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 () @@ -197,6 +237,7 @@ (gudap--connect (car program-and-launch-config) (cdr program-and-launch-config) gud-comint-buffer) (defalias 'gud-break 'gudap--gud-break) + (defalias 'gud-break-cond 'gudap--gud-break-cond) (defalias 'gud-cont 'gudap--gud-cont) (defalias 'gud-run 'gudap--gud-run) (defalias 'gud-remove 'gudap--gud-remove) @@ -309,20 +350,6 @@ (and (symbolp (car p-l)) (equal mode-name (car p-l)))) return p-l)) -(cl-defgeneric gudap-update-breakpoints (server breakpoints)) - -(cl-defmethod gudap-update-breakpoints (server breakpoints) - "Breakpoints are assumed to belong to the same source" - (if (length> breakpoints 0) - (cl-loop for breakpoint across breakpoints - with path = (plist-get (plist-get (aref breakpoints 0) :source) :path) - with updated-breakpoints = '() do - (cl-destructuring-bind (&key verified &allow-other-keys) breakpoint - (if verified - (push breakpoint updated-breakpoints))) - finally - (puthash path updated-breakpoints (gudap-breakpoints server))))) - ;;; REQUESTS (cl-defgeneric gudap-send-request (server command arguments)) @@ -344,9 +371,6 @@ (cl-defmethod gudap-handle-response (server (_type (eql initialize)) _success _body _err-msg) (gudap-send-request server 'launch (gudap-launch-config server))) -(cl-defmethod gudap-handle-response (server (type (eql setBreakpoints)) (success (eql t)) body _err-msg) - (gudap-update-breakpoints server (plist-get body :breakpoints))) - (cl-defmethod gudap-handle-response (server (type (eql evaluate)) (success (eql t)) body _err-msg) (gudap-gud-output server (plist-get body :result)))