From df4cbb0501438ba2ecc00e8ee4ea19efa018d4c4 Mon Sep 17 00:00:00 2001 From: Ziad Ahmed Date: Mon, 21 Sep 2026 00:32:57 +0300 Subject: [PATCH] Add compact variable previews in scope and watch buffers * dape.el (dape-info-variable-value-max-length) (dape-info-scalar-value-max-length, dape-variable-placeholder-face): New options and face. (dape--info-variable-placeholder, dape--info-variable-compact) (dape--info-variable-compact-context-p): New functions. (dape--info-scope-add-variable): Use them. * dape-tests.el (dape-test-info-variable-*): New tests. --- dape-tests.el | 697 +++++++++++++++++++++++++++++--------------------- dape.el | 215 ++++++++++++---- 2 files changed, 565 insertions(+), 347 deletions(-) diff --git a/dape-tests.el b/dape-tests.el index ce1066e7..80fb7bc8 100644 --- a/dape-tests.el +++ b/dape-tests.el @@ -249,32 +249,32 @@ Expects line with string \"breakpoint\" in source." (ert-deftest dape-test-restart-with-dape () "Should be able to restart with `dape' even though session active." (dape-test--with-files - ((main-buffer - "main.py" - ("pass" - "pass # breakpoint"))) - (dape--test-restart-with-dape main-buffer 'debugpy)) + ((main-buffer + "main.py" + ("pass" + "pass # breakpoint"))) + (dape--test-restart-with-dape main-buffer 'debugpy)) (dape-test--with-files - ((index-buffer - "index.js" - ("()=>{};" - "()=>{}; // breakpoint"))) - (dape--test-restart-with-dape index-buffer 'js-debug-node)) + ((index-buffer + "index.js" + ("()=>{};" + "()=>{}; // breakpoint"))) + (dape--test-restart-with-dape index-buffer 'js-debug-node)) (dape-test--with-files - ((main-buffer - "main.c" - ("int main() {" - " return 0; // breakpoint" - "}"))) - (dape--test-restart-with-dape main-buffer 'lldb-dap - 'compile "gcc -g -o a.out main.c")) + ((main-buffer + "main.c" + ("int main() {" + " return 0; // breakpoint" + "}"))) + (dape--test-restart-with-dape main-buffer 'lldb-dap + 'compile "gcc -g -o a.out main.c")) (dape-test--with-files - ((main-buffer - "main.rb" - ("puts \"\"" - "puts \"\"" - "0 # breakpoint"))) - (dape--test-restart-with-dape main-buffer 'rdbg))) + ((main-buffer + "main.rb" + ("puts \"\"" + "puts \"\"" + "0 # breakpoint"))) + (dape--test-restart-with-dape main-buffer 'rdbg))) (defun dape--test-scope-buffer (buffer &rest dape-args) "Helper for ert test `dape-test-scope-buffer-contents'. @@ -328,304 +328,304 @@ Expects line with string \"breakpoint\" in source." (ert-deftest dape-test-scope-buffer () "Assert basic scope buffer content." (dape-test--with-files - ((main-buffer - "main.py" - ("class B:" - " member = 0" - "a = 0" - "b = B()" - "pass # breakpoint"))) - (dape--test-scope-buffer main-buffer 'debugpy)) + ((main-buffer + "main.py" + ("class B:" + " member = 0" + "a = 0" + "b = B()" + "pass # breakpoint"))) + (dape--test-scope-buffer main-buffer 'debugpy)) (dape-test--with-files - ((index-buffer - "index.js" - ("var a = 0;" - "var b = {'member': 0};" - "()=>{}; // breakpoint"))) - (dape--test-scope-buffer index-buffer 'js-debug-node)) + ((index-buffer + "index.js" + ("var a = 0;" + "var b = {'member': 0};" + "()=>{}; // breakpoint"))) + (dape--test-scope-buffer index-buffer 'js-debug-node)) (dape-test--with-files - ((main - "main.c" - ("int main() {" - " int a = 0;" - " struct { int member; } b = {0};" - " return 0; // breakpoint" - "}"))) - (ignore main) - (dape--test-scope-buffer main 'lldb-dap - 'compile "gcc -g -o a.out main.c"))) + ((main + "main.c" + ("int main() {" + " int a = 0;" + " struct { int member; } b = {0};" + " return 0; // breakpoint" + "}"))) + (ignore main) + (dape--test-scope-buffer main 'lldb-dap + 'compile "gcc -g -o a.out main.c"))) (ert-deftest dape-test-watch-buffer() "Watch buffer content and commands." (setq dape-variable-auto-expand-alist nil) (dape-test--with-files - ((main-buffer - "main.py" - ("class B:" - " member = 0" - "a = 0" - "b = B()" - "pass # breakpoint"))) - ;; setup watched vars - (dape-watch-dwim "a") - (dape-watch-dwim "b") - ;; set breakpoint - (with-current-buffer main-buffer - (let ((line (dape-test--line-at-regex "breakpoint"))) - (save-excursion - (dape-test--goto-line line) - (dape-breakpoint-toggle)))) - ;; start debugging - (dape-test--debug main-buffer 'debugpy) - ;; stopped and at breakpoint - (dape-test--should-stopped) - (with-current-buffer main-buffer - (dape-test--should - (equal (line-number-at-pos) - (dape-test--line-at-regex "breakpoint")))) - ;; contents of watch buffer - (with-current-buffer (dape--info-get-buffer-create 'dape-info-watch-mode) - (dape-test--revert-buffer) - (dape-test--should - (and (dape-test--line-at-regex "^ a") - (dape-test--line-at-regex "^\\+ b"))) - ;; expansion - (dape-test--apply-to-match "^\\+ b" 'dape-info-scope-toggle) - (dape-test--should - (dape-test--line-at-regex "^ member")) - ;; assert contraction - (dape-test--apply-to-match "^\\- b" 'dape-info-scope-toggle) - (dape-test--should - (not (dape-test--line-at-regex "^ member"))) - ;; set value - (dape-test--should - (dape-test--line-at-regex "^ a *0")) - (cl-letf (((symbol-function 'read-string) - (lambda (&rest _) "99"))) - (dape-test--apply-to-match "^ a *0" 'dape-info-variable-edit)) - (dape-test--revert-buffer) - (dape-test--should - (dape-test--line-at-regex "^ a *99")) - ;; watch removal - (dape-test--apply-to-match "^ a" 'dape-info-scope-watch-dwim) - (dape-test--revert-buffer) - (dape-test--should - (not (dape-test--line-at-regex "^ a")))))) + ((main-buffer + "main.py" + ("class B:" + " member = 0" + "a = 0" + "b = B()" + "pass # breakpoint"))) + ;; setup watched vars + (dape-watch-dwim "a") + (dape-watch-dwim "b") + ;; set breakpoint + (with-current-buffer main-buffer + (let ((line (dape-test--line-at-regex "breakpoint"))) + (save-excursion + (dape-test--goto-line line) + (dape-breakpoint-toggle)))) + ;; start debugging + (dape-test--debug main-buffer 'debugpy) + ;; stopped and at breakpoint + (dape-test--should-stopped) + (with-current-buffer main-buffer + (dape-test--should + (equal (line-number-at-pos) + (dape-test--line-at-regex "breakpoint")))) + ;; contents of watch buffer + (with-current-buffer (dape--info-get-buffer-create 'dape-info-watch-mode) + (dape-test--revert-buffer) + (dape-test--should + (and (dape-test--line-at-regex "^ a") + (dape-test--line-at-regex "^\\+ b"))) + ;; expansion + (dape-test--apply-to-match "^\\+ b" 'dape-info-scope-toggle) + (dape-test--should + (dape-test--line-at-regex "^ member")) + ;; assert contraction + (dape-test--apply-to-match "^\\- b" 'dape-info-scope-toggle) + (dape-test--should + (not (dape-test--line-at-regex "^ member"))) + ;; set value + (dape-test--should + (dape-test--line-at-regex "^ a *0")) + (cl-letf (((symbol-function 'read-string) + (lambda (&rest _) "99"))) + (dape-test--apply-to-match "^ a *0" 'dape-info-variable-edit)) + (dape-test--revert-buffer) + (dape-test--should + (dape-test--line-at-regex "^ a *99")) + ;; watch removal + (dape-test--apply-to-match "^ a" 'dape-info-scope-watch-dwim) + (dape-test--revert-buffer) + (dape-test--should + (not (dape-test--line-at-regex "^ a")))))) (ert-deftest dape-test-stack-buffer() "Stack buffer contents and commands." (dape-test--with-files - ((main-buffer - "main.py" - ("def a():" - " a_var = 0" - " b() # stack" - "def b():" - " b_var = 0" - " pass # breakpoint" - "a()"))) - ;; set breakpoint - (with-current-buffer main-buffer - (let ((line (dape-test--line-at-regex "breakpoint"))) - (save-excursion - (dape-test--goto-line line) - (dape-breakpoint-toggle)))) - ;; start debugging - (dape-test--debug main-buffer 'debugpy) - ;; stopped and at breakpoint - (dape-test--should-stopped) - (with-current-buffer main-buffer - (dape-test--should - (= (line-number-at-pos) - (dape-test--line-at-regex "breakpoint")))) - (with-current-buffer (dape-test--should - (dape--info-get-live-buffer 'dape-info-stack-mode)) - ;; buffer contents - (dape-test--should - (and (dape-test--line-at-regex "^1 b") - (dape-test--line-at-regex "^2 a") - (member 'dape--info-stack-position - overlay-arrow-variable-list) - (= (marker-position dape--info-stack-position) 1))) - ;; select stack frame - (dape-test--apply-to-match "^2 a" 'dape-info-stack-select) - ;; buffer contents - (dape-test--should - (and (= (marker-position dape--info-stack-position) - (save-excursion - (dape-test--goto-line (dape-test--line-at-regex "^2 a")) - (point)))))) - ;; scope buffer should update to new stack - (with-current-buffer - (dape-test--should - (dape--info-get-live-buffer 'dape-info-scope-mode 0)) - (dape-test--should - (dape-test--line-at-regex "^ a_var"))) - ;; source buffer points at new stack frame - (with-current-buffer main-buffer + ((main-buffer + "main.py" + ("def a():" + " a_var = 0" + " b() # stack" + "def b():" + " b_var = 0" + " pass # breakpoint" + "a()"))) + ;; set breakpoint + (with-current-buffer main-buffer + (let ((line (dape-test--line-at-regex "breakpoint"))) + (save-excursion + (dape-test--goto-line line) + (dape-breakpoint-toggle)))) + ;; start debugging + (dape-test--debug main-buffer 'debugpy) + ;; stopped and at breakpoint + (dape-test--should-stopped) + (with-current-buffer main-buffer + (dape-test--should (= (line-number-at-pos) - (dape-test--line-at-regex "stack"))))) + (dape-test--line-at-regex "breakpoint")))) + (with-current-buffer (dape-test--should + (dape--info-get-live-buffer 'dape-info-stack-mode)) + ;; buffer contents + (dape-test--should + (and (dape-test--line-at-regex "^1 b") + (dape-test--line-at-regex "^2 a") + (member 'dape--info-stack-position + overlay-arrow-variable-list) + (= (marker-position dape--info-stack-position) 1))) + ;; select stack frame + (dape-test--apply-to-match "^2 a" 'dape-info-stack-select) + ;; buffer contents + (dape-test--should + (and (= (marker-position dape--info-stack-position) + (save-excursion + (dape-test--goto-line (dape-test--line-at-regex "^2 a")) + (point)))))) + ;; scope buffer should update to new stack + (with-current-buffer + (dape-test--should + (dape--info-get-live-buffer 'dape-info-scope-mode 0)) + (dape-test--should + (dape-test--line-at-regex "^ a_var"))) + ;; source buffer points at new stack frame + (with-current-buffer main-buffer + (= (line-number-at-pos) + (dape-test--line-at-regex "stack"))))) (ert-deftest dape-test-threads-buffer () "Threads buffer contents and commands." (dape-test--with-files - ((main-buffer - "main.py" - ("import threading" - "def thread_fn():" - " thread_var = 0" - " pass # breakpoint" - "thread = threading.Thread(target=thread_fn)" - "thread.start()" - "thread.join()"))) - ;; set breakpoint - (with-current-buffer main-buffer - (let ((line (dape-test--line-at-regex "breakpoint"))) - (save-excursion - (dape-test--goto-line line) - (dape-breakpoint-toggle)))) - ;; start debugging - (dape-test--debug main-buffer 'debugpy) - ;; stopped and at breakpoint - (dape-test--should-stopped) - (with-current-buffer main-buffer - (dape-test--should - (= (line-number-at-pos) - (dape-test--line-at-regex "breakpoint")))) - (with-current-buffer (dape--info-get-buffer-create 'dape-info-threads-mode) - (dape-test--revert-buffer) - ;; buffer contents - (dape-test--should - (and (dape-test--line-at-regex "stopped in") - (dape-test--line-at-regex "stopped in thread_fn") - (member 'dape--info-thread-position - overlay-arrow-variable-list) - (= (marker-position dape--info-thread-position) - (save-excursion - (dape-test--goto-line (dape-test--line-at-regex - "stopped in thread_fn")) - (point)))))) - (with-current-buffer (dape--info-get-buffer-create 'dape-info-scope-mode 0) - (dape-test--revert-buffer) - ;; scope buffer in thread_fn - (dape-test--should - (dape-test--line-at-regex "^ thread_var"))) - (with-current-buffer (dape--info-get-buffer-create 'dape-info-threads-mode) - ;; select thread - (dape-test--apply-to-match "stopped in" 'dape-info-select-thread)) - (with-current-buffer (dape--info-get-buffer-create 'dape-info-threads-mode) - (revert-buffer) - ;; thread selected - (dape-test--should - (and (dape-test--line-at-regex "stopped in") - (dape-test--line-at-regex "stopped in thread_fn") - (member 'dape--info-thread-position - overlay-arrow-variable-list) - (= (marker-position dape--info-thread-position) - (save-excursion - (dape-test--goto-line (dape-test--line-at-regex - "stopped in")) - (point)))))) - (with-current-buffer (dape--info-get-live-buffer 'dape-info-scope-mode 0) - (revert-buffer) - ;; scope buffer in thread_fn - (dape-test--should - (not (dape-test--line-at-regex "^ thread_var")))))) + ((main-buffer + "main.py" + ("import threading" + "def thread_fn():" + " thread_var = 0" + " pass # breakpoint" + "thread = threading.Thread(target=thread_fn)" + "thread.start()" + "thread.join()"))) + ;; set breakpoint + (with-current-buffer main-buffer + (let ((line (dape-test--line-at-regex "breakpoint"))) + (save-excursion + (dape-test--goto-line line) + (dape-breakpoint-toggle)))) + ;; start debugging + (dape-test--debug main-buffer 'debugpy) + ;; stopped and at breakpoint + (dape-test--should-stopped) + (with-current-buffer main-buffer + (dape-test--should + (= (line-number-at-pos) + (dape-test--line-at-regex "breakpoint")))) + (with-current-buffer (dape--info-get-buffer-create 'dape-info-threads-mode) + (dape-test--revert-buffer) + ;; buffer contents + (dape-test--should + (and (dape-test--line-at-regex "stopped in") + (dape-test--line-at-regex "stopped in thread_fn") + (member 'dape--info-thread-position + overlay-arrow-variable-list) + (= (marker-position dape--info-thread-position) + (save-excursion + (dape-test--goto-line (dape-test--line-at-regex + "stopped in thread_fn")) + (point)))))) + (with-current-buffer (dape--info-get-buffer-create 'dape-info-scope-mode 0) + (dape-test--revert-buffer) + ;; scope buffer in thread_fn + (dape-test--should + (dape-test--line-at-regex "^ thread_var"))) + (with-current-buffer (dape--info-get-buffer-create 'dape-info-threads-mode) + ;; select thread + (dape-test--apply-to-match "stopped in" 'dape-info-select-thread)) + (with-current-buffer (dape--info-get-buffer-create 'dape-info-threads-mode) + (revert-buffer) + ;; thread selected + (dape-test--should + (and (dape-test--line-at-regex "stopped in") + (dape-test--line-at-regex "stopped in thread_fn") + (member 'dape--info-thread-position + overlay-arrow-variable-list) + (= (marker-position dape--info-thread-position) + (save-excursion + (dape-test--goto-line (dape-test--line-at-regex + "stopped in")) + (point)))))) + (with-current-buffer (dape--info-get-live-buffer 'dape-info-scope-mode 0) + (revert-buffer) + ;; scope buffer in thread_fn + (dape-test--should + (not (dape-test--line-at-regex "^ thread_var")))))) (ert-deftest dape-test-repl-buffer () "Repl buffer contents and commands." (dape-test--with-files - ((main-buffer - "main.py" - ("a = 0 # breakpoint" - "b = 0 # second line" - "c = 0 # third line"))) - ;; set breakpoint - (with-current-buffer main-buffer - (let ((line (dape-test--line-at-regex "breakpoint"))) - (save-excursion - (dape-test--goto-line line) - (dape-breakpoint-toggle)))) - ;; start debugging - (dape-test--debug main-buffer 'debugpy) - ;; stopped - (dape-test--should-stopped) - ;; at breakpoint - (with-current-buffer main-buffer - (dape-test--should - (= (line-number-at-pos) - (dape-test--line-at-regex "breakpoint")))) - (pop-to-buffer "*dape-repl*") - (insert "next") - (comint-send-input) - ;; stopped - (dape-test--should-stopped) - (with-current-buffer main-buffer - (dape-test--should - (= (line-number-at-pos) - (dape-test--line-at-regex "second line")))) - (insert "next") - (comint-send-input) - ;; stopped - (dape-test--should-stopped) - (with-current-buffer main-buffer - (dape-test--should - (= (line-number-at-pos) - (dape-test--line-at-regex "third line")))) - (insert "a = 99") - (comint-send-input) - (with-current-buffer (dape-test--should - (dape--info-get-live-buffer 'dape-info-scope-mode 0)) - (dape-test--should - (dape-test--line-at-regex "^ a *99"))))) + ((main-buffer + "main.py" + ("a = 0 # breakpoint" + "b = 0 # second line" + "c = 0 # third line"))) + ;; set breakpoint + (with-current-buffer main-buffer + (let ((line (dape-test--line-at-regex "breakpoint"))) + (save-excursion + (dape-test--goto-line line) + (dape-breakpoint-toggle)))) + ;; start debugging + (dape-test--debug main-buffer 'debugpy) + ;; stopped + (dape-test--should-stopped) + ;; at breakpoint + (with-current-buffer main-buffer + (dape-test--should + (= (line-number-at-pos) + (dape-test--line-at-regex "breakpoint")))) + (pop-to-buffer "*dape-repl*") + (insert "next") + (comint-send-input) + ;; stopped + (dape-test--should-stopped) + (with-current-buffer main-buffer + (dape-test--should + (= (line-number-at-pos) + (dape-test--line-at-regex "second line")))) + (insert "next") + (comint-send-input) + ;; stopped + (dape-test--should-stopped) + (with-current-buffer main-buffer + (dape-test--should + (= (line-number-at-pos) + (dape-test--line-at-regex "third line")))) + (insert "a = 99") + (comint-send-input) + (with-current-buffer (dape-test--should + (dape--info-get-live-buffer 'dape-info-scope-mode 0)) + (dape-test--should + (dape-test--line-at-regex "^ a *99"))))) (ert-deftest dape-test-modules-buffer () "Modules buffer contents and commands." (dape-test--with-files - ((main-buffer - "main.py" - ("pass # breakpoint"))) - ;; set breakpoint - (with-current-buffer main-buffer - (let ((line (dape-test--line-at-regex "breakpoint"))) - (save-excursion - (dape-test--goto-line line) - (dape-breakpoint-toggle)))) - ;; start debugging - (dape-test--debug main-buffer 'debugpy) - ;; at breakpoint and stopped - (dape-test--should-stopped) - ;; contents - (with-current-buffer (dape--info-get-buffer-create 'dape-info-modules-mode) - (revert-buffer) - (dape-test--should ;; Regression .* symlinks are now handled differently - (dape-test--line-at-regex "^__main__ of .*main.py"))))) + ((main-buffer + "main.py" + ("pass # breakpoint"))) + ;; set breakpoint + (with-current-buffer main-buffer + (let ((line (dape-test--line-at-regex "breakpoint"))) + (save-excursion + (dape-test--goto-line line) + (dape-breakpoint-toggle)))) + ;; start debugging + (dape-test--debug main-buffer 'debugpy) + ;; at breakpoint and stopped + (dape-test--should-stopped) + ;; contents + (with-current-buffer (dape--info-get-buffer-create 'dape-info-modules-mode) + (revert-buffer) + (dape-test--should ;; Regression .* symlinks are now handled differently + (dape-test--line-at-regex "^__main__ of .*main.py"))))) (ert-deftest dape-test-sources-buffer () "Sources buffer contents and commands." (dape-test--with-files - ((index-buffer - "index.js" - ("()=>{};" - "()=>{}; // breakpoint"))) - ;; set breakpoint - (with-current-buffer index-buffer - (let ((line (dape-test--line-at-regex "breakpoint"))) - (save-excursion - (dape-test--goto-line line) - (dape-breakpoint-toggle)))) - ;; start debugging - (dape-test--debug index-buffer 'js-debug-node) - ;; stopped - (dape-test--should-stopped) - ;; contents - (with-current-buffer (dape--info-get-buffer-create 'dape-info-sources-mode) - (revert-buffer) - (dape-test--should (dape-test--line-at-regex "^os ")) - (dape-test--should (dape-test--line-at-regex "^util ")) - (dape-test--apply-to-match "^os " 'dape-info-sources-goto)) - (dape-test--should - (member "*dape-source os*" (mapcar 'buffer-name (buffer-list)))))) + ((index-buffer + "index.js" + ("()=>{};" + "()=>{}; // breakpoint"))) + ;; set breakpoint + (with-current-buffer index-buffer + (let ((line (dape-test--line-at-regex "breakpoint"))) + (save-excursion + (dape-test--goto-line line) + (dape-breakpoint-toggle)))) + ;; start debugging + (dape-test--debug index-buffer 'js-debug-node) + ;; stopped + (dape-test--should-stopped) + ;; contents + (with-current-buffer (dape--info-get-buffer-create 'dape-info-sources-mode) + (revert-buffer) + (dape-test--should (dape-test--line-at-regex "^os ")) + (dape-test--should (dape-test--line-at-regex "^util ")) + (dape-test--apply-to-match "^os " 'dape-info-sources-goto)) + (dape-test--should + (member "*dape-source os*" (mapcar 'buffer-name (buffer-list)))))) (defun dape-test--breakpoint-hits (buffer key &rest args) "Helper for ert test `dape-test-breakpoint-hits'." @@ -703,5 +703,116 @@ Expects line with string \"breakpoint\" in source." ;; Second session still running (should (= 1 (length (dape--live-connections-root)))))) +(ert-deftest dape-test-info-variable-placeholder () + (cl-flet ((ph (type preview &optional indexed) + (dape--info-variable-placeholder + `(:type ,type :variablesReference 1 + ,@(when indexed `(:indexedVariables ,indexed))) + preview))) + ;; Head is kept, body is dropped. + (should (equal (ph "Server" "Server {_events: {...}, _eventsCount: 2, ...}") + "Server {…}")) + (should (equal (ph "Map" "Map(2) {'a' => 1, 'b' => 2}") "Map(2) {…}")) + (should (equal (ph "Array" "(5) [1, 2, 3, 4, 5]") "(5) […]")) + ;; Anonymous object/array: no head. + (should (equal (ph "Object" "{a: 1, b: 2}") "{…}")) + (should (equal (ph "Array" "[1, 2, 3]") "[…]")) + ;; No brackets in preview: fall back to type (and count). + (should (equal (ph "Foo" "an opaque preview") "Foo {…}")) + (should (equal (ph "list" "an opaque preview" 3) "list(3)")) + (should (equal (ph "" "an opaque preview" 3) "Array(3)")) + (should (equal (ph "" "an opaque preview") "{…}")) + ;; Head too long to be useful: fall back to type. + (should (equal (ph "Foo" (concat (make-string 41 ?x) " {a: 1}")) + "Foo {…}")))) + +(ert-deftest dape-test-info-variable-compact-short-compound-untouched () + (let ((dape-info-variable-value-max-length 50) + (object '(:name "a" :value "{id: 1}" :variablesReference 3))) + (should (eq (dape--info-variable-compact object) object)))) + +(ert-deftest dape-test-info-variable-compact-long-compound () + (let* ((dape-info-variable-value-max-length 50) + (preview "Server {_events: {...}, _eventsCount: 2, _maxListeners: undefined}") + (children '((:name "_events" :value "{}" :variablesReference 0))) + (object `(:name "srv" :value ,preview :type "Server" + :variablesReference 7 :variables ,children)) + (result (dape--info-variable-compact object)) + (shown (plist-get result :value))) + (should-not (eq result object)) + (should (equal (substring-no-properties shown) "Server {…}")) + (should (eq (get-text-property 0 'font-lock-face shown) + 'dape-variable-placeholder-face)) + (should (equal (get-text-property 0 'help-echo shown) preview)) + ;; Expansion data is untouched. + (should (equal (plist-get result :variablesReference) 7)) + (should (equal (plist-get result :variables) children)) + ;; The original object is not modified. + (should (equal (plist-get object :value) preview)))) + +(ert-deftest dape-test-info-variable-compact-compound-limits () + (let ((object '(:name "a" :value "{id: 1}" :variablesReference 3))) + ;; 0 always collapses. + (let ((dape-info-variable-value-max-length 0)) + (should (equal (substring-no-properties + (plist-get (dape--info-variable-compact object) :value)) + "{…}"))) + ;; nil disables. + (let ((dape-info-variable-value-max-length nil)) + (should (eq (dape--info-variable-compact object) object))) + ;; Exactly at the limit is not collapsed. + (let ((dape-info-variable-value-max-length (length "{id: 1}"))) + (should (eq (dape--info-variable-compact object) object))))) + +(ert-deftest dape-test-info-variable-compact-scalar () + (let ((dape-info-scalar-value-max-length 5) + (dape-info-variable-value-max-length 50)) + ;; Truncated with ellipsis, full value kept as help echo. + (let* ((object '(:name "s" :value "abcdefghij" :variablesReference 0)) + (result (dape--info-variable-compact object)) + (shown (plist-get result :value))) + (should (<= (string-width shown) 5)) + (should (string-prefix-p "abc" shown)) + (should (string-suffix-p "…" shown)) + (should (equal (get-text-property 0 'help-echo shown) "abcdefghij")) + (should-not (get-text-property 0 'font-lock-face shown)) + (should (equal (plist-get object :value) "abcdefghij"))) + ;; Wide characters are measured by display width. + (let* ((object '(:name "s" :value "漢字漢字漢字漢字" :variablesReference 0)) + (shown (plist-get (dape--info-variable-compact object) :value))) + (should (<= (string-width shown) 5))) + ;; Within the limit. + (let ((object '(:name "s" :value "abcde" :variablesReference 0))) + (should (eq (dape--info-variable-compact object) object))) + ;; Disabled. + (let ((dape-info-scalar-value-max-length nil) + (object '(:name "s" :value "abcdefghij" :variablesReference 0))) + (should (eq (dape--info-variable-compact object) object))))) + +(ert-deftest dape-test-info-variable-compact-result () + "Watch and evaluate results carry `:result' instead of `:value'." + (let* ((dape-info-scalar-value-max-length 5) + (object '(:result "abcdefghij" :variablesReference 0)) + (result (dape--info-variable-compact object))) + (should (<= (string-width (plist-get result :result)) 5)) + (should-not (plist-member result :value)))) + +(ert-deftest dape-test-info-variable-compact-non-string () + (let ((dape-info-variable-value-max-length 0) + (dape-info-scalar-value-max-length 0)) + (dolist (object '((:name "a" :variablesReference 0) + (:name "a" :value nil :variablesReference 2))) + (should (eq (dape--info-variable-compact object) object))))) + +(ert-deftest dape-test-info-variable-compact-context () + ;; Path is innermost first, last element is the buffer identifier. + (should (dape--info-variable-compact-context-p '(0))) + (should (dape--info-variable-compact-context-p '("child" "parent" 1))) + (should (dape--info-variable-compact-context-p '("Watch"))) + (should-not (dape--info-variable-compact-context-p '(repl))) + (should-not (dape--info-variable-compact-context-p '("child" repl))) + (should-not (dape--info-variable-compact-context-p '(_)))) + + (provide 'dape-tests) ;;; dape-tests.el ends here diff --git a/dape.el b/dape.el index c87ce96b..3380dbaf 100644 --- a/dape.el +++ b/dape.el @@ -206,37 +206,37 @@ :args [] :stopAtBeginningOfMainSubprogram nil) ,@(let ((gdb-common - `( ensure (lambda (config) - (dape-ensure-command config) - (let* ((default-directory - (or (dape-config-get config 'command-cwd) - default-directory)) - (command (dape-config-get config 'command)) - (output (shell-command-to-string (format "%s --version" command))) - (version (save-match-data - (when (string-match "GNU gdb \\(?:(.*) \\)?\\([0-9.]+\\)" output) - (string-to-number (match-string 1 output)))))) - (unless (>= version 14.1) - (user-error "Requires gdb version >= 14.1")))) - command "gdb" - command-args ("--interpreter=dap") - :request "launch" - :stopAtBeginningOfMainSubprogram nil))) - `((gdb-go-test ,@gdb-common - modes (go-mode go-ts-mode) - command-cwd (file-name-directory (buffer-file-name)) - compile (format "go test -c -o %s -gcflags='all=-N -l'" - (expand-file-name "__test.bin" temporary-file-directory)) ;; compile without optimizations - :program (expand-file-name "__test.bin" temporary-file-directory) - :args []) - (gdb-go ,@gdb-common - modes (go-mode go-ts-mode) - command-cwd (file-name-directory (buffer-file-name)) - compile (format "go build -o %s -gcflags='all=-N -l'" - (expand-file-name "__binary.bin" temporary-file-directory)) ;; compile without optimizations - :request "launch" - :program (expand-file-name "__binary.bin" temporary-file-directory) - :args []))) + `( ensure (lambda (config) + (dape-ensure-command config) + (let* ((default-directory + (or (dape-config-get config 'command-cwd) + default-directory)) + (command (dape-config-get config 'command)) + (output (shell-command-to-string (format "%s --version" command))) + (version (save-match-data + (when (string-match "GNU gdb \\(?:(.*) \\)?\\([0-9.]+\\)" output) + (string-to-number (match-string 1 output)))))) + (unless (>= version 14.1) + (user-error "Requires gdb version >= 14.1")))) + command "gdb" + command-args ("--interpreter=dap") + :request "launch" + :stopAtBeginningOfMainSubprogram nil))) + `((gdb-go-test ,@gdb-common + modes (go-mode go-ts-mode) + command-cwd (file-name-directory (buffer-file-name)) + compile (format "go test -c -o %s -gcflags='all=-N -l'" + (expand-file-name "__test.bin" temporary-file-directory)) ;; compile without optimizations + :program (expand-file-name "__test.bin" temporary-file-directory) + :args []) + (gdb-go ,@gdb-common + modes (go-mode go-ts-mode) + command-cwd (file-name-directory (buffer-file-name)) + compile (format "go build -o %s -gcflags='all=-N -l'" + (expand-file-name "__binary.bin" temporary-file-directory)) ;; compile without optimizations + :request "launch" + :program (expand-file-name "__binary.bin" temporary-file-directory) + :args []))) (godot modes (gdscript-mode) port 6006 @@ -283,12 +283,12 @@ :cwd dape-cwd :program dape-buffer-default :console "internalConsole") - (js-debug-node-attach + (js-debug-node-attach modes (js-mode js-ts-mode typescript-mode typescript-ts-mode) ,@js-debug :type "pwa-node" - :request "attach" - :port 9229) + :request "attach" + :port 9229) (js-debug-chrome modes (js-mode js-ts-mode typescript-mode typescript-ts-mode) ,@js-debug @@ -363,23 +363,23 @@ (unless (and (featurep 'eglot) (eglot-current-server)) (user-error "No eglot instance active in buffer %s" (current-buffer))) (unless (seq-contains-p (eglot--server-capable :executeCommandProvider :commands) - "vscode.java.resolveClasspath") - (user-error "Jdtls instance does not bundle java-debug-server, please install"))))) + "vscode.java.resolveClasspath") + (user-error "Jdtls instance does not bundle java-debug-server, please install"))))) fn (lambda (config) (with-current-buffer (find-file-noselect (dape-config-get config :filePath)) (if-let* ((server (eglot-current-server))) - (pcase-let ((`[,module-paths ,class-paths] - (eglot-execute-command server + (pcase-let ((`[,module-paths ,class-paths] + (eglot-execute-command server "vscode.java.resolveClasspath" - (vector (plist-get config :mainClass) + (vector (plist-get config :mainClass) (plist-get config :projectName)))) (port (eglot-execute-command server - "vscode.java.startDebugSession" nil))) - (thread-first config + "vscode.java.startDebugSession" nil))) + (thread-first config (plist-put 'port port) - (plist-put :modulePaths module-paths) - (plist-put :classPaths class-paths))) + (plist-put :modulePaths module-paths) + (plist-put :classPaths class-paths))) server))) ,@(cl-flet ((resolve-main-class (key) (ignore-errors @@ -664,6 +664,22 @@ left-to-right display order of the properties." :value-type (choice (const :tag "Full" 0) (natnum :tag "Width")))) +(defcustom dape-info-variable-value-max-length 50 + "Max length of a compound variable's preview in scope and watch buffers. +Longer previews are replaced by a placeholder such as \"Server {…}\" +or \"(5) […]\". 0 means always collapse. nil disables collapsing." + :type '(choice (natnum :tag "Max characters (0 = always collapse)") + (const :tag "Disabled" nil))) + +(defcustom dape-info-scalar-value-max-length 120 + "Max display width of the value of a variable without children. +Longer values are truncated with an ellipsis in scope and watch +buffers. The full value is shown as help echo (tooltip). +nil disables truncation." + :type '(choice (natnum :tag "Max display width") + (const :tag "Disabled" nil))) + + (defcustom dape-info-thread-buffer-locations t "Show file information or library names in threads buffer." :type 'boolean) @@ -788,8 +804,8 @@ See `dape-minibuffer-hint'." :program, and :args as launch options. Example: \"launch - ENV=value program arg1 arg2\"." :type '(choice (const :tag "Input" input) - (const :tag "After evaluation of each key" expanded) - (const :tag "Shell like with - separator" shell-like))) + (const :tag "After evaluation of each key" expanded) + (const :tag "Shell like with - separator" shell-like))) (defcustom dape-ui-debounce-time 0.1 "Number of seconds to debounce `revert-buffer' for UI buffers." @@ -845,6 +861,10 @@ Debug logging has an noticeable effect on performance." (defface dape-header-line-hover-face '((t :inherit mode-line-highlight)) "Face for hovered Dape header tabs.") +(defface dape-variable-placeholder-face '((t :inherit shadow :slant italic)) + "Face used for the placeholder of a collapsed compound variable.") + + ;;; Forward declarations @@ -3007,9 +3027,9 @@ The frame is identified by STACK-ID under adapter CONN." (user-error "Adapter not capable of restarting frame")) (dape-select-stack conn stack-id) (let* ((current-frame (dape--current-stack-frame conn)) - (frame-id (plist-get current-frame :id))) + (frame-id (plist-get current-frame :id))) (dape--with-request-bind (_body error) - (dape-request conn :restartFrame `(:frameId ,frame-id)) + (dape-request conn :restartFrame `(:frameId ,frame-id)) (when error (dape--warn "Failed to restart stack frame: %s" error))))) @@ -3806,8 +3826,8 @@ Helper for `dape--stack-frame-display'." (goto-char (marker-position marker)) ;; ...like fixing `hl-line' (when (featurep 'hl-line) - (cond (global-hl-line-mode (global-hl-line-highlight)) - ((and hl-line-mode hl-line-sticky-flag) (hl-line-highlight)))) + (cond (global-hl-line-mode (global-hl-line-highlight)) + ((and hl-line-mode hl-line-sticky-flag) (hl-line-highlight)))) (run-hooks 'dape-display-source-hook))))))) (defun dape--stack-frame-display (conn) @@ -4735,20 +4755,105 @@ current buffer with CONN config." (push prop columns))))) (nreverse columns))) +(defun dape--info-variable-placeholder (object preview) + "Return a short placeholder for compound variable OBJECT. +PREVIEW is the full preview string sent by the adapter. The useful +head of PREVIEW (class name, element count) is kept and its body is +dropped: + + Server {_events: {...}, ...} -> Server {…} + Map(2) {\\='a\\=' => 1} -> Map(2) {…} + (5) [1, 2, 3, 4, 5] -> (5) […]" + (let ((type (or (plist-get object :type) "")) + (indexed (plist-get object :indexedVariables))) + (cond + ((and (string-match "\\`\\([^{[]*\\)\\([{[]\\)" preview) + (<= (length (match-string 1 preview)) 40)) + ;; Read both groups before calling `string-trim', which is free + ;; to clobber the match data. + (let* ((raw-head (match-string 1 preview)) + (open (match-string 2 preview)) + (head (string-trim raw-head))) + (concat head (unless (string-empty-p head) " ") + open "…" (if (equal open "{") "}" "]")))) + ((numberp indexed) + (format "%s(%d)" (if (string-empty-p type) "Array" type) indexed)) + ((string-empty-p type) "{…}") + (t (format "%s {…}" type))))) + +(defun dape--info-variable-replace-preview (object shown preview &optional face) + "Return a copy of variable OBJECT that displays SHOWN instead of PREVIEW. +SHOWN is given a `help-echo' with (a prefix of) PREVIEW and, if +non-nil, FACE. OBJECT itself is not modified." + (let ((copy (copy-sequence object)) + (shown (apply #'propertize shown + 'help-echo (truncate-string-to-width preview 2000 nil nil "…") + (when face (list 'font-lock-face face))))) + ;; Watch and evaluate results carry `:result' instead of `:value'. + (dolist (key '(:value :result)) + (when (plist-member copy key) + (setq copy (plist-put copy key shown)))) + copy)) + +(defun dape--info-variable-compact (object) + "Return OBJECT, or a copy with a compact preview if it is too long. +Only the displayed preview changes. `:variables', +`:variablesReference' etc. are kept, so expanding a variable works as +before. See `dape-info-variable-value-max-length' and +`dape-info-scalar-value-max-length'." + (let ((ref (plist-get object :variablesReference)) + (preview (or (plist-get object :value) (plist-get object :result)))) + (cond + ((not (stringp preview)) object) + ;; Compound: has children. + ((and (integerp ref) (> ref 0)) + (if (and dape-info-variable-value-max-length + (length> preview dape-info-variable-value-max-length)) + (dape--info-variable-replace-preview + object + (dape--info-variable-placeholder object preview) + preview + 'dape-variable-placeholder-face) + object)) + ;; Scalar: strings, numbers, ... + ((and dape-info-scalar-value-max-length + (> (string-width preview) dape-info-scalar-value-max-length)) + (dape--info-variable-replace-preview + object + (truncate-string-to-width preview dape-info-scalar-value-max-length + nil nil "…") + preview)) + (t object)))) + +(defun dape--info-variable-compact-context-p (path) + "Return non-nil if variables at PATH should get compact previews. +PATH is the path given to `dape--info-scope-add-variable' with the +innermost element first, so its last element identifies the buffer. +Only scope and watch buffers are compacted. In the REPL and in eldoc +the preview is the whole output, hiding it would lose information." + (let ((root (car (last path)))) + (or (integerp root) (equal root "Watch")))) + + (defun dape--info-scope-add-variable (table object reference path test-expanded &optional no-handles) "Add variable OBJECT with REFERENCE and PATH to TABLE. TEST-EXPANDED is called with PATH and OBJECT to determine if recursive calls should continue. If NO-HANDLES is non-nil skip + - handles." + (let* ((name (dape--variable-name object)) (type (or (plist-get object :type) "")) - (value (or (plist-get object :value) - (plist-get object :result) + (shown (if (dape--info-variable-compact-context-p path) + (dape--info-variable-compact object) + object)) + (value (or (plist-get shown :value) + (plist-get shown :result) " ")) (prefix (make-string (* (1- (length path)) 2) ?\s)) (path (cons name path)) (expanded-p (funcall test-expanded path)) row) + (setq name (propertize name 'font-lock-face 'font-lock-variable-name-face @@ -4758,7 +4863,9 @@ calls should continue. If NO-HANDLES is non-nil skip + - handles." type (propertize type 'font-lock-face 'font-lock-type-face) value (propertize value 'mouse-face 'highlight - 'help-echo "mouse-2: edit value" + 'help-echo (or (and (not (string-empty-p value)) + (get-text-property 0 'help-echo value)) + "mouse-2: edit value") 'keymap dape-info-variable-value-map) prefix (cond (no-handles prefix) ((zerop (or (plist-get object :variablesReference) 0)) @@ -4918,7 +5025,7 @@ calls should continue. If NO-HANDLES is non-nil skip + - handles." buffer-read-only nil font-lock-defaults '(dape--info-watch-edit-font-lock-keywords)) (message "%s" (substitute-command-keys - "Press \\[dape-info-watch-finish-edit] when finished \ + "Press \\[dape-info-watch-finish-edit] when finished \ or \\[dape-info-watch-abort-changes] to abort changes")) (dape--info-set-related-buffers) (revert-buffer)) @@ -5006,7 +5113,7 @@ The search is done backwards from POINT. The line is marked with (defun dape--repl-revert-region (&rest _) "Revert region by cont text property dape--revert-tag." (when-let* ((inhibit-read-only t) - (fn (get-text-property (point) 'dape--revert-fn)) + (fn (get-text-property (point) 'dape--revert-fn)) (start (save-excursion (previous-single-property-change (1+ (point)) 'dape--revert-tag)))