diff --git a/README.md b/README.md index 4220a9e..eabb99a 100644 --- a/README.md +++ b/README.md @@ -241,7 +241,7 @@ Use C-c C-d r to remove breakpoint. Once first breakpoint is added to the project, buffer named `* Breakpoints *` is created. This buffer displays all existing breakpoints in a project. Pressing D on breakpoint line deletes the breakpoint. Pressing RET on breakpoint line shows GDScript file with that breakpoint in other buffer. When any breakpoint exists, running project will automatically start debugger server (if one isn't already running) and connect to it. -Debugger server runs on `localhost` with port specified by `gdscript-debug-port` customizable variable (`9010` by default). +Debugger server runs on `localhost` with port specified by `gdscript-debug-port` customizable variable (`6010` by default). Once breakpoint is hit in your code, Emacs will show two special buffers with information related to a position of the breakpoint: @@ -267,7 +267,8 @@ On breakpoint hit Debug Hydra will be displayed below `* Stack frame vars *` and ### Debug Hydra ``` -n next c continue m step b breakpoints s stack v vars i inspector t scene-tree d details q quit +n next c continue m step b breakpoints s stack v vars i inspector t scene-tree d details +o pin u unpin q quit ``` - n - Jump to next line and stops there @@ -277,7 +278,9 @@ n next c continue m step b breakpoints s stack v vars i inspector t scene - v - Show `* Stack frame vars *` buffer - i - Show `* Inspector *` buffer - t - Show `* Scene tree *` buffer - - d - Fetch details for all `ObjectId`s present in `* Stack frame vars *` and `* Inspector *` buffers and redisplay them. + - d - Fetch details for all `ObjectId`s present in `* Stack frame vars *` and `* Inspector *` buffers and redisplay them + - o - Pin current `self` `ObjectId` in `* Inspector *` buffer. It stays displayed until it cease to exists or until it get unpinned + - u - Unpin currently pinned `ObjectId` - q - Close Debug Hydra ### `* Stack frame vars *` buffer @@ -285,11 +288,13 @@ n next c continue m step b breakpoints s stack v vars i inspector t scene Main source of information about running program. Contains information about locals/members/globals variables. - Press TAB to toggling oneline/multiline display for selected types -- Press RET on `ObjectId` line to display its details +- Press RET on `ObjectId` line to display its details in `* Inspector *`buffer - Press l to display `* Stack dump *` buffer - Press d to display additional details for `ObjectId` variables - Press p to go to previous line - Press n to go to next line +- Press o to pin current `ObjectId` in `* Inspector *` buffer +- Press u to unpin currently pinned `ObjectId` - Press q to close the buffer ### `* Inspector *` buffer @@ -303,6 +308,8 @@ Contains information about inspected object. By default `self` variable from `* - Press d to display additional details for `ObjectId` variables - Press p to go to previous line - Press n to go to next line +- Press o to pin current `ObjectId` in `* Inspector *` buffer +- Press u to unpin currently pinned `ObjectId` - Press q to close the buffer ### `* Stack dump *` buffer @@ -325,3 +332,12 @@ Contains list of all existing breakpoints. - Press TAB to display `* Stack dump *` buffer - Press D to delete the breakpoint - Press q to close the buffer + +### `* Scene tree *` buffer + +Contains tree visualisation of all `ObjectId`s in the running program. + +- Press RET to open corresponding `ObjectId` in `* Inspector *` buffer +- Press p to go to previous line +- Press n to go to next line +- Press q to close the buffer diff --git a/gdscript-comint.el b/gdscript-comint.el index 7734d3a..bd69b91 100644 --- a/gdscript-comint.el +++ b/gdscript-comint.el @@ -37,6 +37,7 @@ (require 'comint) (require 'compile) (require 'gdscript-customization) +(require 'gdscript-debug) (require 'gdscript-format) (require 'gdscript-utils) @@ -47,6 +48,7 @@ comint-mode-map)) (define-key map (kbd "C-a") 'comint-bol) (define-key map (kbd "C-c r") 'gdscript-hydra-show) + (define-key map (kbd "C-c n") 'gdscript-debug-hydra) map) "Basic mode map for `godot-mode'.") diff --git a/gdscript-debug.el b/gdscript-debug.el index 2aec039..66746c0 100644 --- a/gdscript-debug.el +++ b/gdscript-debug.el @@ -1,6 +1,35 @@ -;;; gdscript-debug.el --- Description -*- lexical-binding: t; -*- +;;; gdscript-debug.el --- Debugger for Godot -*- lexical-binding: t; -*- ;; -;; Inspired by gdb-mi +;; Copyright (C) 2020 GDQuest + +;; Author: Josef Vlach +;; URL: https://github.com/GDQuest/emacs-gdscript-mode/ +;; Version: 0.0.1 +;; Package-Requires: ((emacs "26.3")) +;; Maintainer: vlach.josef@gmail.com +;; Created: Oct 2020 +;; Keywords: languages + +;; This file is not part of GNU Emacs + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; For a full copy of the GNU General Public License +;; see . +;; +;;; Commentary: +;; +;; Inspired by gdb-mi. +;; +;;; Code: (require 'bindat) (require 'generator) @@ -20,16 +49,14 @@ when breakpoint is encountered in Godot." ;; Overlay arrow markers (defvar gdscript-debug--thread-position nil) -(defvar gdscript-debug--null-spec) - -(defvar gdscript-debug--boolean-spec +(defvar gdscript-debug--boolean-bindat-spec '((:boolean-data u32r))) -(defvar gdscript-debug--integer-spec +(defvar gdscript-debug--integer-bindat-spec `((:data u32r) (:integer-data eval (- (logand last ,(lognot (lsh 1 31))) (logand last ,(lsh 1 31)))))) -(defvar gdscript-debug--integer-64-spec +(defvar gdscript-debug--integer-64-bindat-spec `((:data-a u32r) (:data-b u32r) (:data eval (let ((a (bindat-get-field struct :data-a)) @@ -85,42 +112,42 @@ when breakpoint is encountered in Godot." (,symbol eval (let ((alist (reverse (append (bindat-get-field struct :vect) nil)))) (apply 'gdscript-debug--load-f32 alist))))))) -(defvar gdscript-debug--float-spec +(defvar gdscript-debug--float-bindat-spec '((:vect vec 4 byte) (:float-value eval (let ((alist (reverse (append (bindat-get-field struct :vect) nil)))) (apply 'gdscript-debug--load-f32 alist))))) -(defvar gdscript-debug--float-64-spec +(defvar gdscript-debug--float-64-bindat-spec '((:vect vec 8 byte) (:float-value eval (let ((alist (reverse (append (bindat-get-field struct :vect) nil)))) (apply 'gdscript-debug--load-f64 alist))))) -(defvar gdscript-debug--string-spec +(defvar gdscript-debug--string-bindat-spec '((:data-length u32r) (:string-data str (:data-length)) (align 4))) -(defvar gdscript-debug--string-z-spec +(defvar gdscript-debug--string-z-bindat-spec '((:data-length u32r) (:string-data strz (:data-length)) (align 4))) -(defvar gdscript-debug--vector2-spec +(defvar gdscript-debug--vector2-bindat-spec `(,@(gdscript-debug--capture-float-spec :x) ,@(gdscript-debug--capture-float-spec :y))) -(defvar gdscript-debug--rect2-spec +(defvar gdscript-debug--rect2-bindat-spec `(,@(gdscript-debug--capture-float-spec :x-coordinate) ,@(gdscript-debug--capture-float-spec :y-coordinate) ,@(gdscript-debug--capture-float-spec :x-size) ,@(gdscript-debug--capture-float-spec :y-size))) -(defvar gdscript-debug--vector3-spec +(defvar gdscript-debug--vector3-bindat-spec `(,@(gdscript-debug--capture-float-spec :x) ,@(gdscript-debug--capture-float-spec :y) ,@(gdscript-debug--capture-float-spec :z))) -(defvar gdscript-debug--transform2d-spec +(defvar gdscript-debug--transform2d-bindat-spec `(,@(gdscript-debug--capture-float-spec :xx) ,@(gdscript-debug--capture-float-spec :xy) ,@(gdscript-debug--capture-float-spec :yx) @@ -128,61 +155,61 @@ when breakpoint is encountered in Godot." ,@(gdscript-debug--capture-float-spec :x-origin) ,@(gdscript-debug--capture-float-spec :y-origin))) -(defvar gdscript-debug--dictionary-spec +(defvar gdscript-debug--dictionary-bindat-spec '((:data u32r) (:shared eval (logand (bindat-get-field struct :data) #x80000000)) (:elements eval (logand (bindat-get-field struct :data) #x7fffffff)) (:dictionary-length eval (* 2 last)) - (:items repeat (:dictionary-length) (struct godot-data-bindat-spec)))) + (:items repeat (:dictionary-length) (struct gdscript-godot-data-bindat-spec)))) -(defvar gdscript-debug--array-spec +(defvar gdscript-debug--array-bindat-spec '((:data u32r) (:shared eval (logand (bindat-get-field struct :data) #x80000000)) (:array-length eval (logand (bindat-get-field struct :data) #x7fffffff)) - (:items repeat (:array-length) (struct godot-data-bindat-spec)))) + (:items repeat (:array-length) (struct gdscript-godot-data-bindat-spec)))) -(defvar gdscript-debug--pool-byte-array-spec +(defvar gdscript-debug--pool-byte-array-bindat-spec '((:array-length u32r) (:items vec (:array-length) byte) (align 4))) -(defvar gdscript-debug--pool-int-array-spec +(defvar gdscript-debug--pool-int-array-bindat-spec '((:array-length u32r) - (:items repeat (:array-length) (struct gdscript-debug--integer-spec)))) + (:items repeat (:array-length) (struct gdscript-debug--integer-bindat-spec)))) -(defvar gdscript-debug--pool-real-array-spec +(defvar gdscript-debug--pool-real-array-bindat-spec '((:array-length u32r) - (:items repeat (:array-length) (struct gdscript-debug--float-spec)))) + (:items repeat (:array-length) (struct gdscript-debug--float-bindat-spec)))) -(defvar gdscript-debug--pool-string-array-spec +(defvar gdscript-debug--pool-string-array-bindat-spec '((:array-length u32r) - (:items repeat (:array-length) (struct gdscript-debug--string-z-spec)))) + (:items repeat (:array-length) (struct gdscript-debug--string-z-bindat-spec)))) -(defvar gdscript-debug--pool-vector2-array-spec +(defvar gdscript-debug--pool-vector2-array-bindat-spec '((:array-length u32r) - (:items repeat (:array-length) (struct gdscript-debug--vector2-spec)))) + (:items repeat (:array-length) (struct gdscript-debug--vector2-bindat-spec)))) -(defvar gdscript-debug--pool-vector3-array-spec +(defvar gdscript-debug--pool-vector3-array-bindat-spec '((:array-length u32r) - (:items repeat (:array-length) (struct gdscript-debug--vector3-spec)))) + (:items repeat (:array-length) (struct gdscript-debug--vector3-bindat-spec)))) -(defvar gdscript-debug--pool-color-array-spec +(defvar gdscript-debug--pool-color-array-bindat-spec '((:array-length u32r) - (:items repeat (:array-length) (struct gdscript-debug--color-spec)))) + (:items repeat (:array-length) (struct gdscript-debug--color-bindat-spec)))) -(defvar gdscript-debug--plane-spec +(defvar gdscript-debug--plane-bindat-spec `(,@(gdscript-debug--capture-float-spec :normal-x) ,@(gdscript-debug--capture-float-spec :normal-y) ,@(gdscript-debug--capture-float-spec :normal-z) ,@(gdscript-debug--capture-float-spec :distance))) -(defvar gdscript-debug--quat-spec +(defvar gdscript-debug--quat-bindat-spec `(,@(gdscript-debug--capture-float-spec :x-imaginary) ,@(gdscript-debug--capture-float-spec :y-imaginary) ,@(gdscript-debug--capture-float-spec :z-imaginary) ,@(gdscript-debug--capture-float-spec :real-w))) -(defvar gdscript-debug--aabb-spec +(defvar gdscript-debug--aabb-bindat-spec `(,@(gdscript-debug--capture-float-spec :x-coordinate) ,@(gdscript-debug--capture-float-spec :y-coordinate) ,@(gdscript-debug--capture-float-spec :z-coordinate) @@ -190,7 +217,7 @@ when breakpoint is encountered in Godot." ,@(gdscript-debug--capture-float-spec :y-size) ,@(gdscript-debug--capture-float-spec :z-size))) -(defvar gdscript-debug--basis-spec +(defvar gdscript-debug--basis-bindat-spec `(,@(gdscript-debug--capture-float-spec :xx) ,@(gdscript-debug--capture-float-spec :xy) ,@(gdscript-debug--capture-float-spec :xz) @@ -201,7 +228,7 @@ when breakpoint is encountered in Godot." ,@(gdscript-debug--capture-float-spec :zy) ,@(gdscript-debug--capture-float-spec :zz))) -(defvar gdscript-debug--transform-spec +(defvar gdscript-debug--transform-bindat-spec `(,@(gdscript-debug--capture-float-spec :xx) ,@(gdscript-debug--capture-float-spec :xy) ,@(gdscript-debug--capture-float-spec :xz) @@ -215,25 +242,25 @@ when breakpoint is encountered in Godot." ,@(gdscript-debug--capture-float-spec :y-origin) ,@(gdscript-debug--capture-float-spec :z-origin))) -(defvar gdscript-debug--color-spec +(defvar gdscript-debug--color-bindat-spec `(,@(gdscript-debug--capture-float-spec :red) ,@(gdscript-debug--capture-float-spec :green) ,@(gdscript-debug--capture-float-spec :blue) ,@(gdscript-debug--capture-float-spec :alpha))) -(defvar gdscript-debug--node-path-spec +(defvar gdscript-debug--node-path-bindat-spec '((:data-length u32r) (:new-format eval (logand (bindat-get-field struct :data-length) #x80000000)) (:name-count eval (logand (bindat-get-field struct :data-length) #x7FFFFFFF)) (:subname-count u32r) (:flags u32r) (:absolute eval (not (eq 0 (logand (bindat-get-field struct :flags) #x1)))) - (:names repeat (:name-count) (struct gdscript-debug--string-spec)) - (:subnames repeat (:subname-count) (struct gdscript-debug--string-spec)))) + (:names repeat (:name-count) (struct gdscript-debug--string-bindat-spec)) + (:subnames repeat (:subname-count) (struct gdscript-debug--string-bindat-spec)))) -(defvar gdscript-debug--rid-spec nil) ;; unsupported +(defvar gdscript-debug--rid-bindat-spec nil) ;; unsupported -(defvar gdscript-debug--object-as-id +(defvar gdscript-debug--object-as-id-bindat-spec '((:object-as-id-a u32r) (:object-as-id-b u32r) (:long eval (let ((a (bindat-get-field struct :object-as-id-a)) @@ -243,42 +270,42 @@ when breakpoint is encountered in Godot." (defconst gdscript-debug--encode-mask #xff) (defconst gdscript-debug--encode-flag-64 (lsh 1 16)) -(defvar godot-data-bindat-spec +(defvar gdscript-godot-data-bindat-spec '((:type-data u32r) (:type eval (logand last gdscript-debug--encode-mask)) (:flag-64 eval (logand (bindat-get-field struct :type-data) gdscript-debug--encode-flag-64)) (:object-as-id eval (logand (bindat-get-field struct :type-data) gdscript-debug--encode-flag-64)) (union (:type) (0 nil) - (1 (struct gdscript-debug--boolean-spec)) - ((eval (and (eq 2 tag) (equal 0 (bindat-get-field struct :flag-64)))) (struct gdscript-debug--integer-spec)) - (2 (struct gdscript-debug--integer-64-spec)) - ((eval (and (eq 3 tag) (equal 0 (bindat-get-field struct :flag-64)))) (struct gdscript-debug--float-spec)) - (3 (struct gdscript-debug--float-64-spec)) - (4 (struct gdscript-debug--string-spec)) - (5 (struct gdscript-debug--vector2-spec)) - (6 (struct gdscript-debug--rect2-spec)) - (7 (struct gdscript-debug--vector3-spec)) - (8 (struct gdscript-debug--transform2d-spec)) - (9 (struct gdscript-debug--plane-spec)) - (10 (struct gdscript-debug--quat-spec)) - (11 (struct gdscript-debug--aabb-spec)) - (12 (struct gdscript-debug--basis-spec)) - (13 (struct gdscript-debug--transform-spec)) - (14 (struct gdscript-debug--color-spec)) - (15 (struct gdscript-debug--node-path-spec)) - (16 (struct gdscript-debug--rid-spec)) + (1 (struct gdscript-debug--boolean-bindat-spec)) + ((eval (and (eq 2 tag) (equal 0 (bindat-get-field struct :flag-64)))) (struct gdscript-debug--integer-bindat-spec)) + (2 (struct gdscript-debug--integer-64-bindat-spec)) + ((eval (and (eq 3 tag) (equal 0 (bindat-get-field struct :flag-64)))) (struct gdscript-debug--float-bindat-spec)) + (3 (struct gdscript-debug--float-64-bindat-spec)) + (4 (struct gdscript-debug--string-bindat-spec)) + (5 (struct gdscript-debug--vector2-bindat-spec)) + (6 (struct gdscript-debug--rect2-bindat-spec)) + (7 (struct gdscript-debug--vector3-bindat-spec)) + (8 (struct gdscript-debug--transform2d-bindat-spec)) + (9 (struct gdscript-debug--plane-bindat-spec)) + (10 (struct gdscript-debug--quat-bindat-spec)) + (11 (struct gdscript-debug--aabb-bindat-spec)) + (12 (struct gdscript-debug--basis-bindat-spec)) + (13 (struct gdscript-debug--transform-bindat-spec)) + (14 (struct gdscript-debug--color-bindat-spec)) + (15 (struct gdscript-debug--node-path-bindat-spec)) + (16 (struct gdscript-debug--rid-bindat-spec)) ((eval (and (eq 17 tag) (equal 0 (bindat-get-field struct :object-as-id)))) (error "[ObjectId] Not implemented yet")) - (17 (struct gdscript-debug--object-as-id)) - (18 (struct gdscript-debug--dictionary-spec)) - (19 (struct gdscript-debug--array-spec)) - (20 (struct gdscript-debug--pool-byte-array-spec)) - (21 (struct gdscript-debug--pool-int-array-spec)) - (22 (struct gdscript-debug--pool-real-array-spec)) - (23 (struct gdscript-debug--pool-string-array-spec)) - (24 (struct gdscript-debug--pool-vector2-array-spec)) - (25 (struct gdscript-debug--pool-vector3-array-spec)) - (26 (struct gdscript-debug--pool-color-array-spec)) + (17 (struct gdscript-debug--object-as-id-bindat-spec)) + (18 (struct gdscript-debug--dictionary-bindat-spec)) + (19 (struct gdscript-debug--array-bindat-spec)) + (20 (struct gdscript-debug--pool-byte-array-bindat-spec)) + (21 (struct gdscript-debug--pool-int-array-bindat-spec)) + (22 (struct gdscript-debug--pool-real-array-bindat-spec)) + (23 (struct gdscript-debug--pool-string-array-bindat-spec)) + (24 (struct gdscript-debug--pool-vector2-array-bindat-spec)) + (25 (struct gdscript-debug--pool-vector3-array-bindat-spec)) + (26 (struct gdscript-debug--pool-color-array-bindat-spec)) (t (eval (error "Unknown type: %s" tag)))))) (defvar gdscript-debug--previous-packet-data nil) @@ -290,7 +317,7 @@ when breakpoint is encountered in Godot." (bindat-unpack gdscript-debug--packet-length-bindat-spec content offset)) (defun gdscript-debug--process-packet (content offset) - (bindat-unpack godot-data-bindat-spec content offset)) + (bindat-unpack gdscript-godot-data-bindat-spec content offset)) (iter-defun gdscript-debug--command-iter () (setq gdscript-debug--data-needed @@ -308,62 +335,62 @@ when breakpoint is encountered in Godot." (throw 'not-enough-data-to-process-packed next-packet-offset)))))) (setq gdscript-debug--offset 0)) -(defsubst get-boolean (struct-data) +(defsubst gdscript-debug--get-boolean (struct-data) (bindat-get-field struct-data :boolean-data)) -(defsubst get-integer (struct-data) +(defsubst gdscript-debug--get-integer (struct-data) (bindat-get-field struct-data :integer-data)) -(defsubst get-float (struct-data) +(defsubst gdscript-debug--get-float (struct-data) (bindat-get-field struct-data :float-value)) -(defsubst get-string (struct-data) +(defsubst gdscript-debug--get-string (struct-data) (bindat-get-field struct-data :string-data)) -(defsubst get-array (struct-data) +(defsubst gdscript-debug--get-array (struct-data) (bindat-get-field struct-data :items)) -(defsubst to-plane (struct) +(defsubst gdscript-debug--to-plane (struct) (let ((normal-x (bindat-get-field struct :normal-x)) (normal-y (bindat-get-field struct :normal-y)) (normal-z (bindat-get-field struct :normal-z)) (distance (bindat-get-field struct :distance))) - (plane-create - :normal (vector3-create + (gdscript-plane-create + :normal (gdscript-vector3-create :x normal-x :y normal-y :z normal-z) :distance distance))) -(defsubst to-quat (struct) +(defsubst gdscript-debug--to-quat (struct) (let ((x-imaginary (bindat-get-field struct :x-imaginary)) (y-imaginary (bindat-get-field struct :y-imaginary)) (z-imaginary (bindat-get-field struct :z-imaginary)) (real-w (bindat-get-field struct :real-w))) - (quat-create + (gdscript-quat-create :x-imaginary x-imaginary :y-imaginary y-imaginary :z-imaginary z-imaginary :real-w real-w))) -(defsubst to-aabb (struct) +(defsubst gdscript-debug--to-aabb (struct) (let ((x-coordinate (bindat-get-field struct :x-coordinate)) (y-coordinate (bindat-get-field struct :y-coordinate)) (z-coordinate (bindat-get-field struct :z-coordinate)) (x-size (bindat-get-field struct :x-size)) (y-size (bindat-get-field struct :y-size)) (z-size (bindat-get-field struct :z-size))) - (aabb-create - :position (vector3-create + (gdscript-aabb-create + :position (gdscript-vector3-create :x x-coordinate :y y-coordinate :z z-coordinate) - :size (vector3-create + :size (gdscript-vector3-create :x x-size :y y-size :z z-size)))) -(defsubst to-basis (struct) +(defsubst gdscript-debug--to-basis (struct) (let ((xx (bindat-get-field struct :xx)) (xy (bindat-get-field struct :xy)) (xz (bindat-get-field struct :xz)) @@ -373,232 +400,249 @@ when breakpoint is encountered in Godot." (zx (bindat-get-field struct :zx)) (zy (bindat-get-field struct :zy)) (zz (bindat-get-field struct :zz))) - (basis-create - :x (vector3-create :x xx :y xy :z xz) - :y (vector3-create :x yx :y yy :z yz) - :z (vector3-create :x zx :y zy :z zz)))) + (gdscript-basis-create + :x (gdscript-vector3-create :x xx :y xy :z xz) + :y (gdscript-vector3-create :x yx :y yy :z yz) + :z (gdscript-vector3-create :x zx :y zy :z zz)))) -(defsubst to-transform (struct) - (let ((basis (to-basis struct)) +(defsubst gdscript-debug--to-transform (struct) + (let ((basis (gdscript-debug--to-basis struct)) (x-origin (bindat-get-field struct :x-origin)) (y-origin (bindat-get-field struct :y-origin)) (z-origin (bindat-get-field struct :z-origin))) - (transform-create + (gdscript-transform-create :basis basis - :origin (vector3-create + :origin (gdscript-vector3-create :x x-origin :y y-origin :z z-origin)))) -(defsubst to-color (struct) +(defsubst gdscript-debug--to-color (struct) (let ((red (bindat-get-field struct :red)) (green (bindat-get-field struct :green)) (blue (bindat-get-field struct :blue)) (alpha (bindat-get-field struct :alpha))) - (color-create :red red :green green :blue blue :alpha alpha))) + (gdscript-color-create :red red :green green :blue blue :alpha alpha))) -(defsubst to-node-path (struct) - (let ((names (mapcar 'to-string (bindat-get-field struct :names))) - (subnames (mapcar 'to-string (bindat-get-field struct :subnames))) +(defsubst gdscript-debug--to-node-path (struct) + (let ((names (mapcar 'gdscript-debug--to-string (bindat-get-field struct :names))) + (subnames (mapcar 'gdscript-debug--to-string (bindat-get-field struct :subnames))) (absolute (bindat-get-field struct :absolute))) - (node-path-create :names names :subnames subnames :absolute (prim-bool-create :value absolute)))) + (gdscript-node-path-create :names names :subnames subnames :absolute (gdscript-bool-create :value absolute)))) -(defsubst to-rid (_struct-data) - (rid-create)) +(defsubst gdscript-debug--to-rid (_struct-data) + (gdscript-rid-create)) -(defsubst to-vector2 (struct-data) +(defsubst gdscript-debug--to-vector2 (struct-data) (let ((x (bindat-get-field struct-data :x)) (y (bindat-get-field struct-data :y))) - (vector2-create :x x :y y))) + (gdscript-vector2-create :x x :y y))) -(defsubst to-rect2 (struct) +(defsubst gdscript-debug--to-rect2 (struct) (let ((x-coordinate (bindat-get-field struct :x-coordinate)) (y-coordinate (bindat-get-field struct :y-coordinate)) (x-size (bindat-get-field struct :x-size)) (y-size (bindat-get-field struct :y-size))) - (rect2-create - :coordinate (vector2-create :x x-coordinate :y y-coordinate) - :size (vector2-create :x x-size :y y-size)))) + (gdscript-rect2-create + :coordinate (gdscript-vector2-create :x x-coordinate :y y-coordinate) + :size (gdscript-vector2-create :x x-size :y y-size)))) -(defsubst to-vector3 (struct-data) +(defsubst gdscript-debug--to-vector3 (struct-data) (let ((x (bindat-get-field struct-data :x)) (y (bindat-get-field struct-data :y)) (z (bindat-get-field struct-data :z))) - (vector3-create :x x :y y :z z))) + (gdscript-vector3-create :x x :y y :z z))) -(defsubst to-transform2d (struct-data) +(defsubst gdscript-debug--to-transform2d (struct-data) (let ((xx (bindat-get-field struct-data :xx)) (xy (bindat-get-field struct-data :xy)) (yx (bindat-get-field struct-data :yx)) (yy (bindat-get-field struct-data :yy)) (x-origin (bindat-get-field struct-data :x-origin)) (y-origin (bindat-get-field struct-data :y-origin))) - (transform2d-create - :x (vector2-create :x xx :y xy) - :y (vector2-create :x yx :y yy) - :origin (vector2-create :x x-origin :y y-origin)))) + (gdscript-transform2d-create + :x (gdscript-vector2-create :x xx :y xy) + :y (gdscript-vector2-create :x yx :y yy) + :origin (gdscript-vector2-create :x x-origin :y y-origin)))) -(defsubst to-null (_struct-data) - (prim-null-create)) +(defsubst gdscript-debug--to-null (_struct-data) + (gdscript-null-create)) -(defsubst to-boolean (struct-data) - (prim-bool-create :value (if (eq 1 (get-boolean struct-data)) - t - nil))) +(defsubst gdscript-debug--to-boolean (struct-data) + (gdscript-bool-create :value (if (eq 1 (gdscript-debug--get-boolean struct-data)) + t + nil))) -(defsubst shared-to-boolean (shared) - (prim-bool-create :value (if (eq 0 shared) nil t))) +(defsubst gdscript-debug--shared-to-boolean (shared) + (gdscript-bool-create :value (if (eq 0 shared) nil t))) -(defsubst to-integer (struct-data) - (prim-integer-create :value (get-integer struct-data))) +(defsubst gdscript-debug--to-integer (struct-data) + (gdscript-integer-create :value (gdscript-debug--get-integer struct-data))) -(defsubst to-float (struct-data) - (prim-float-create :value (get-float struct-data))) +(defsubst gdscript-debug--to-float (struct-data) + (gdscript-float-create :value (gdscript-debug--get-float struct-data))) -(defsubst to-string (struct-data) - (prim-string-create :value (get-string struct-data))) +(defsubst gdscript-debug--to-string (struct-data) + (gdscript-string-create :value (gdscript-debug--get-string struct-data))) -(defsubst to-object-id (struct-data) - (object-id-create :value (bindat-get-field struct-data :long))) +(defsubst gdscript-debug--to-object-id (struct-data) + (gdscript-object-id-create :value (bindat-get-field struct-data :long))) -(defsubst to-dictionary (struct-data) +(defsubst gdscript-debug--to-dictionary (struct-data) (let* ((shared (bindat-get-field struct-data :shared)) (items (bindat-get-field struct-data :items))) - (dictionary-create :shared (shared-to-boolean shared) :elements (to-dic items)))) + (gdscript-dictionary-create :shared (gdscript-debug--shared-to-boolean shared) :elements (gdscript-debug--to-dic items)))) -(defun to-dic (xs) +(defun gdscript-debug--to-dic (xs) (cl-loop for (key value) on xs by 'cddr - collect (from-key-value key value))) + collect (gdscript-debug--from-key-value key value))) -(defsubst to-array (struct-data) +(defsubst gdscript-debug--to-array (struct-data) (let ((shared (bindat-get-field struct-data :shared)) (items (bindat-get-field struct-data :items))) - (prim-array-create :shared (shared-to-boolean shared) :elements (mapcar 'from-variant items)))) + (gdscript-array-create :shared (gdscript-debug--shared-to-boolean shared) :elements (mapcar 'gdscript-debug--from-variant items)))) -(defsubst to-pool-byte-array (struct-data) +(defsubst gdscript-debug--to-pool-byte-array (struct-data) (let ((items (bindat-get-field struct-data :items))) - (pool-byte-array-create :elements items))) + (gdscript-pool-byte-array-create :elements items))) -(defsubst to-pool-int-array (struct-data) +(defsubst gdscript-debug--to-pool-int-array (struct-data) (let ((items (bindat-get-field struct-data :items))) - (pool-int-array-create :elements (mapcar 'to-integer items)))) + (gdscript-pool-int-array-create :elements (mapcar 'gdscript-debug--to-integer items)))) -(defsubst to-pool-real-array (struct-data) +(defsubst gdscript-debug--to-pool-real-array (struct-data) (let ((items (bindat-get-field struct-data :items))) - (pool-real-array-create :elements (mapcar 'to-float items)))) + (gdscript-pool-real-array-create :elements (mapcar 'gdscript-debug--to-float items)))) -(defsubst to-pool-string-array (struct-data) +(defsubst gdscript-debug--to-pool-string-array (struct-data) (let ((items (bindat-get-field struct-data :items))) - (pool-string-array-create :elements (mapcar 'to-string items)))) + (gdscript-pool-string-array-create :elements (mapcar 'gdscript-debug--to-string items)))) -(defsubst to-pool-vector2-array (struct-data) +(defsubst gdscript-debug--to-pool-vector2-array (struct-data) (let ((items (bindat-get-field struct-data :items))) - (pool-vector2-array-create :elements (mapcar 'to-vector2 items)))) + (gdscript-pool-vector2-array-create :elements (mapcar 'gdscript-debug--to-vector2 items)))) -(defsubst to-pool-vector3-array (struct-data) +(defsubst gdscript-debug--to-pool-vector3-array (struct-data) (let ((items (bindat-get-field struct-data :items))) - (pool-vector3-array-create :elements (mapcar 'to-vector3 items)))) + (gdscript-pool-vector3-array-create :elements (mapcar 'gdscript-debug--to-vector3 items)))) -(defsubst to-pool-color-array (struct-data) +(defsubst gdscript-debug--to-pool-color-array (struct-data) (let ((items (bindat-get-field struct-data :items))) - (pool-color-array-create :elements (mapcar 'to-color items)))) + (gdscript-pool-color-array-create :elements (mapcar 'gdscript-debug--to-color items)))) -(defun from-key-value (key value) - (let* ((var-name (from-variant key)) - (var-val (from-variant value))) +(defun gdscript-debug--from-key-value (key value) + (let* ((var-name (gdscript-debug--from-variant key)) + (var-val (gdscript-debug--from-variant value))) `(,var-name . ,var-val))) -(defun from-variant (struct) +(defun gdscript-debug--from-variant (struct) (let ((type (bindat-get-field struct :type)) (object-as-id (bindat-get-field struct :object-as-id))) (pcase type - (0 (to-null struct)) - (1 (to-boolean struct)) - (2 (to-integer struct)) - (3 (to-float struct)) - (4 (to-string struct)) - (5 (to-vector2 struct)) - (6 (to-rect2 struct)) - (7 (to-vector3 struct)) - (8 (to-transform2d struct)) - (9 (to-plane struct)) - (10 (to-quat struct)) - (11 (to-aabb struct)) - (12 (to-basis struct)) - (13 (to-transform struct)) - (14 (to-color struct)) - (15 (to-node-path struct)) - (16 (to-rid struct)) + (0 (gdscript-debug--to-null struct)) + (1 (gdscript-debug--to-boolean struct)) + (2 (gdscript-debug--to-integer struct)) + (3 (gdscript-debug--to-float struct)) + (4 (gdscript-debug--to-string struct)) + (5 (gdscript-debug--to-vector2 struct)) + (6 (gdscript-debug--to-rect2 struct)) + (7 (gdscript-debug--to-vector3 struct)) + (8 (gdscript-debug--to-transform2d struct)) + (9 (gdscript-debug--to-plane struct)) + (10 (gdscript-debug--to-quat struct)) + (11 (gdscript-debug--to-aabb struct)) + (12 (gdscript-debug--to-basis struct)) + (13 (gdscript-debug--to-transform struct)) + (14 (gdscript-debug--to-color struct)) + (15 (gdscript-debug--to-node-path struct)) + (16 (gdscript-debug--to-rid struct)) (17 (if (eq 0 object-as-id) (error "TODO object as not ID") - (to-object-id struct))) - (18 (to-dictionary struct)) - (19 (to-array struct)) - (20 (to-pool-byte-array struct)) - (21 (to-pool-int-array struct)) - (22 (to-pool-real-array struct)) - (23 (to-pool-string-array struct)) - (24 (to-pool-vector2-array struct)) - (25 (to-pool-vector3-array struct)) - (26 (to-pool-color-array struct)) - (_ (error "[from-variant] Unknown type %s" type))))) + (gdscript-debug--to-object-id struct))) + (18 (gdscript-debug--to-dictionary struct)) + (19 (gdscript-debug--to-array struct)) + (20 (gdscript-debug--to-pool-byte-array struct)) + (21 (gdscript-debug--to-pool-int-array struct)) + (22 (gdscript-debug--to-pool-real-array struct)) + (23 (gdscript-debug--to-pool-string-array struct)) + (24 (gdscript-debug--to-pool-vector2-array struct)) + (25 (gdscript-debug--to-pool-vector3-array struct)) + (26 (gdscript-debug--to-pool-color-array struct)) + (_ (error "[gdscript-debug--from-variant] Unknown type %s" type))))) -(defun to-stack-dump (stack-data level) +(defun gdscript-debug--to-stack-dump (stack-data level) (pcase stack-data (`(,_file-key, file-value, _line-key, line-value, _function-key, function-value, _id-key, _id-value) - (stack-dump-create - :file (get-string file-value) - :line (get-integer line-value) - :function-name (get-string function-value) + (gdscript-stack-dump-create + :file (gdscript-debug--get-string file-value) + :line (gdscript-debug--get-integer line-value) + :function-name (gdscript-debug--get-string function-value) :level level)))) -(defun error-data-to-plist (error-data) +(defun gdscript-debug-error-pretty (output-error) + (format "%s:%s %s - %s (%s) - %s" + (gdscript-string->value (gdscript-output-error->source-file output-error)) + (gdscript-integer->value (gdscript-output-error->source-line output-error)) + (gdscript-string->value (gdscript-output-error->source-func output-error)) + (gdscript-string->value (gdscript-output-error->error output-error)) + (gdscript-string->value (gdscript-output-error->error-descr output-error)) + (gdscript-output-error->callstack output-error))) + +(defun gdscript-debug--to-output-error (error-data stack-infos) (pcase error-data (`(,hr, min, sec, msec, source-func, source-file, source-line, error-msg, error-descr, warning) - `(hr ,(get-integer hr) - min ,(get-integer min) - sec ,(get-integer sec) - msec ,(get-integer msec) - source-func ,(get-string source-func) - source-file ,(get-string source-file) - source-line ,(get-integer source-line) - error-msg ,(get-string error-msg) - error-descr ,(get-string error-descr) - warning, (get-boolean warning))))) + (gdscript-output-error-create + :hr (gdscript-debug--to-integer hr) + :min (gdscript-debug--to-integer min) + :sec (gdscript-debug--to-integer sec) + :msec (gdscript-debug--to-integer msec) + :source-file (gdscript-debug--to-string source-file) + :source-func (gdscript-debug--to-string source-func) + :source-line (gdscript-debug--to-integer source-line) + :error (gdscript-debug--to-string error-msg) + :error-descr (gdscript-debug--to-string error-descr) + :warning (gdscript-debug--to-boolean warning) + :callstack stack-infos)))) -(defun mk-error (iter) - (let ((callstack-size (bindat-get-field (iter-next iter) :integer-data)) +(defun gdscript-debug--error-callstack (iter) + (let ((file (bindat-get-field (iter-next iter) :string-data)) + (func (bindat-get-field (iter-next iter) :string-data)) + (line (bindat-get-field (iter-next iter) :integer-data))) + (sgdscript-tack-info-create :file file :func func :line line))) + +(defun gdscript-debug--mk-error (iter) + (let ((_callstack-size (bindat-get-field (iter-next iter) :integer-data)) (error-data (bindat-get-field (iter-next iter) :items)) - (error-callstack-size (bindat-get-field (iter-next iter) :integer-data)) - ;; TODO process call stack - ;; (error-callstack-size (bindat-get-field (iter-next iter) :integer-data)) - ) - `(command "error" callstack-size ,callstack-size error-data ,(error-data-to-plist error-data) error-callstack-size, error-callstack-size))) + (error-callstack-size (bindat-get-field (iter-next iter) :integer-data))) + (let ((stack-infos)) + (dotimes (_i (/ error-callstack-size 3)) + (push (gdscript-debug--error-callstack iter) stack-infos)) + (gdscript-debug--to-output-error error-data (reverse stack-infos))))) -(defun mk-performance (iter) +(defun gdscript-debug--mk-performance (iter) (let ((_skip-this (iter-next iter)) (performance-data (bindat-get-field (iter-next iter) :items))) `(command "performace" performance-data ,performance-data))) -(defun read-var-names (iter count) +(defun gdscript-debug--read-var-names (iter count) (let ((variables)) (dotimes (_i count) (let* ((var-name (bindat-get-field (iter-next iter) :string-data)) (var-value (iter-next iter)) - (var-val (from-variant var-value))) + (var-val (gdscript-debug--from-variant var-value))) (push `(,var-name . ,var-val) variables))) (reverse variables))) -(defun mk-stack-frame-vars (iter) - (let* ((_total-size (get-integer (iter-next iter))) - (locals-size (get-integer (iter-next iter))) - (locals (read-var-names iter locals-size)) - (members-size (get-integer (iter-next iter))) - (members (read-var-names iter members-size)) - (globals-size (get-integer (iter-next iter))) - (globals (read-var-names iter globals-size))) - (stack-frame-vars-create :locals locals :members members :globals globals))) +(defun gdscript-debug--mk-stack-frame-vars (iter) + (let* ((_total-size (gdscript-debug--get-integer (iter-next iter))) + (locals-size (gdscript-debug--get-integer (iter-next iter))) + (locals (gdscript-debug--read-var-names iter locals-size)) + (members-size (gdscript-debug--get-integer (iter-next iter))) + (members (gdscript-debug--read-var-names iter members-size)) + (globals-size (gdscript-debug--get-integer (iter-next iter))) + (globals (gdscript-debug--read-var-names iter globals-size))) + (gdscript-stack-frame-vars-create :locals locals :members members :globals globals))) -(defun to-property-info (properties) +(defun gdscript-debug--to-property-info (properties) (let ((property-info)) (dolist (property properties) (cond ((eq 6 (bindat-get-field property :array-length)) @@ -608,8 +652,8 @@ when breakpoint is encountered in Godot." (hint (bindat-get-field (nth 2 data) :integer-data)) (hint-string (bindat-get-field (nth 3 data) :string-data)) (usage (bindat-get-field (nth 4 data) :integer-data)) - (variant (from-variant (nth 5 data))) - (new-prop (property-info-create + (variant (gdscript-debug--from-variant (nth 5 data))) + (new-prop (gdscript-property-info-create :name name :type type :hint hint @@ -620,50 +664,50 @@ when breakpoint is encountered in Godot." (t (message "Ignoring property %s" property)))) (reverse property-info))) -(defun get-children (iter) - (let ((child-count (get-integer (iter-next iter))) - (node-name (get-string (iter-next iter))) - (node-class (get-string (iter-next iter))) - (instance-id (get-integer (iter-next iter)))) +(defun gdscript-debug--get-children (iter) + (let ((child-count (gdscript-debug--get-integer (iter-next iter))) + (node-name (gdscript-debug--get-string (iter-next iter))) + (node-class (gdscript-debug--get-string (iter-next iter))) + (instance-id (gdscript-debug--get-integer (iter-next iter)))) (let ((children)) (dotimes (_i child-count) - (push (get-children iter) children)) - (scene-tree-level-edge-create :item (scene-tree-node-create - :node-name node-name - :node-class node-class - :instance-id instance-id) - :children children)))) + (push (gdscript-debug--get-children iter) children)) + (gdscript-scene-tree-level-edge-create :item (gdscript-scene-tree-node-create + :node-name node-name + :node-class node-class + :instance-id instance-id) + :children children)))) -(cl-defstruct (scene-tree-level-edge (:constructor scene-tree-level-edge-create) - (:copier nil) - (:conc-name scene-tree-level-edge->)) +(cl-defstruct (gdscript-scene-tree-level-edge (:constructor gdscript-scene-tree-level-edge-create) + (:copier nil) + (:conc-name gdscript-scene-tree-level-edge->)) item children) -(cl-defstruct (scene-tree-node (:constructor scene-tree-node-create) - (:copier nil) - (:conc-name scene-tree-node->)) +(cl-defstruct (gdscript-scene-tree-node (:constructor gdscript-scene-tree-node-create) + (:copier nil) + (:conc-name gdscript-scene-tree-node->)) node-name node-class instance-id) -(defun mk-scene-tree (iter) - (let ((_array-size (get-integer (iter-next iter)))) - (get-children iter))) +(defun gdscript-debug--mk-scene-tree (iter) + (let ((_array-size (gdscript-debug--get-integer (iter-next iter)))) + (gdscript-debug--get-children iter))) -(defun mk-inspect-object (iter) - (let ((_three (get-integer (iter-next iter))) - (object-id (get-integer (iter-next iter))) - (class (get-string (iter-next iter))) - (properties (get-array (iter-next iter)))) - (inspect-object-create :object-id object-id :class class :properties (to-property-info properties)))) +(defun gdscript-debug--mk-inspect-object (iter) + (let ((_three (gdscript-debug--get-integer (iter-next iter))) + (object-id (gdscript-debug--get-integer (iter-next iter))) + (class (gdscript-debug--get-string (iter-next iter))) + (properties (gdscript-debug--get-array (iter-next iter)))) + (gdscript-inspect-object-create :object-id object-id :class class :properties (gdscript-debug--to-property-info properties)))) -(defun mk-stack-dump (iter) - (let ((stack-level-count (get-integer (iter-next iter))) +(defun gdscript-debug--mk-stack-dump (iter) + (let ((stack-level-count (gdscript-debug--get-integer (iter-next iter))) (outputs)) (dotimes (level stack-level-count) (let ((stack-data (bindat-get-field (iter-next iter) :items))) - (push (to-stack-dump stack-data level) outputs))) + (push (gdscript-debug--to-stack-dump stack-data level) outputs))) (reverse outputs))) -(defun mk-output (iter) +(defun gdscript-debug--mk-output (iter) (let ((output-count (bindat-get-field (iter-next iter) :integer-data)) (outputs)) (dotimes (_i output-count) @@ -672,17 +716,17 @@ when breakpoint is encountered in Godot." (setq outputs (cons output outputs)))) `(command "output" outputs, outputs))) -(defun mk-debug-enter (iter) +(defun gdscript-debug--mk-debug-enter (iter) (let ((_skip-this (iter-next iter)) (can-continue (bindat-get-field (iter-next iter) :boolean-data)) (reason (bindat-get-field (iter-next iter) :string-data))) - (debug-enter-create :can-continue can-continue :reason reason))) + (gdscript-debug-enter-create :can-continue can-continue :reason reason))) -(defun mk-debug-exit (iter) +(defun gdscript-debug--mk-debug-exit (iter) (let ((_skip-this (iter-next iter))) '(command "debug_exit"))) -(defun line-posns (line) +(defun gdscript-debug--line-posns (line) "Return a pair of LINE beginning and end positions." (let ((offset (1+ (- line (line-number-at-pos))))) (cons @@ -693,13 +737,13 @@ when breakpoint is encountered in Godot." (substring file-path (length "res://"))) (defun gdscript-debug--on-stack-dump (stack-dump project-root) - (let* ((file (stack-dump->file stack-dump)) - (line (stack-dump->line stack-dump)) + (let* ((file (gdscript-stack-dump->file stack-dump)) + (line (gdscript-stack-dump->line stack-dump)) (full-file-path (concat project-root (gdscript-debug--drop-res file)))) (if (not project-root) (error "Project for file %s not found" file) (with-current-buffer (find-file-noselect full-file-path) - (let* ((posns (line-posns line)) + (let* ((posns (gdscript-debug--line-posns line)) (start-posn (car posns))) (set-marker gdscript-debug--thread-position start-posn) (goto-char gdscript-debug--thread-position) @@ -729,38 +773,39 @@ when breakpoint is encountered in Godot." ("debug_enter" (gdscript-debug--command-handler ;;(message "Received 'debug_enter' command") - (let ((cmd (mk-debug-enter iter))) + (let ((cmd (gdscript-debug--mk-debug-enter iter))) (setq gdscript-debug--debug-enter cmd) (gdscript-debug-get-stack-dump)))) ("debug_exit" (gdscript-debug--command-handler ;;(message "Received 'debug_exit' command") - (let ((_cmd (mk-debug-exit iter)))))) + (let ((_cmd (gdscript-debug--mk-debug-exit iter)))))) ("output" (gdscript-debug--command-handler ;;(message "Received 'output' command") - (let ((_cmd (mk-output iter)))))) + (let ((_cmd (gdscript-debug--mk-output iter)))))) ("error" (gdscript-debug--command-handler ;;(message "Received 'error' command") - (let ((_cmd (mk-error iter)))))) + (let ((cmd (gdscript-debug--mk-error iter))) + (message "%s" (gdscript-debug-error-pretty cmd))))) ("performance" (gdscript-debug--command-handler ;;(message "Received 'performance' command") - (let ((_cmd (mk-performance iter)))))) + (let ((_cmd (gdscript-debug--mk-performance iter)))))) ("stack_dump" (gdscript-debug--command-handler ;;(message "Received 'stack_dump' command") - (let ((cmd (mk-stack-dump iter)) + (let ((cmd (gdscript-debug--mk-stack-dump iter)) (project-root (process-get process 'project))) - (pcase (debug-enter->reason gdscript-debug--debug-enter) + (pcase (gdscript-debug-enter->reason gdscript-debug--debug-enter) ("Breakpoint" (gdscript-debug--refresh-stack-dump-buffer cmd project-root) (setq gdscript-debug--stack-dump (cons cmd project-root)) (let ((top-stack-dump (car cmd))) (setq gdscript-debug--selected-stack-dump top-stack-dump) (gdscript-debug--on-stack-dump top-stack-dump project-root) - (gdscript-debug-get-stack-frame-vars (stack-dump->level top-stack-dump))) + (gdscript-debug-get-stack-frame-vars (gdscript-stack-dump->level top-stack-dump))) (gdscript-debug-hydra)) (other (select-window (display-buffer (gdscript-debug--on-stack-dump (car cmd) project-root))) @@ -769,22 +814,22 @@ when breakpoint is encountered in Godot." ("stack_frame_vars" (gdscript-debug--command-handler ;;(message "Received 'stack_frame_vars' command") - (let ((cmd (mk-stack-frame-vars iter))) + (let ((cmd (gdscript-debug--mk-stack-frame-vars iter))) (setq gdscript-debug--stack-frame-vars cmd gdscript-debug--inspected-objects (make-hash-table) gdscript-debug--object-ids-to-fetch nil gdscript-debug-state nil) (gdscript-debug--construct-stack-var-buffer cmd) - (let* ((self (cdar (stack-frame-vars->members cmd))) - (object-id (object-id->value self))) - (setq gdscript-debug--current-self object-id) - (if (and gdscript-debug--inspector-focused-object-id - (not (eq gdscript-debug--current-self gdscript-debug--inspector-focused-object-id))) + (let* ((self (cdar (gdscript-stack-frame-vars->members cmd))) + (object-id (gdscript-object-id->value self))) + (setq gdscript-debug--current-self object-id + gdscript-debug--inspector-focused-object-id object-id) + (if (and gdscript-debug--pinned-object-id + (not (eq gdscript-debug--current-self gdscript-debug--pinned-object-id))) (progn - (gdscript-debug-inspect-object gdscript-debug--inspector-focused-object-id) + (gdscript-debug-inspect-object gdscript-debug--pinned-object-id) (gdscript-debug-inspect-object gdscript-debug--current-self) (setq gdscript-debug-state :expect-two)) - (gdscript-debug-inspect-object gdscript-debug--current-self) (setq gdscript-debug--inspector-focused-object-id gdscript-debug--current-self gdscript-debug-state :expect-one))))) @@ -792,47 +837,67 @@ when breakpoint is encountered in Godot." ("message:inspect_object" (gdscript-debug--command-handler ;;(message "Received 'message:inspect_object' command") - (let* ((cmd (mk-inspect-object iter)) - (object-id (inspect-object->object-id cmd))) + (let* ((cmd (gdscript-debug--mk-inspect-object iter)) + (object-id (gdscript-inspect-object->object-id cmd))) (puthash object-id cmd gdscript-debug--inspected-objects) (cond ((eq gdscript-debug-state :fetching) - (setq gdscript-debug--object-ids-to-fetch (delete (object-id-create :value object-id) gdscript-debug--object-ids-to-fetch)) + (setq gdscript-debug--object-ids-to-fetch (delete (gdscript-object-id-create :value object-id) gdscript-debug--object-ids-to-fetch)) (when (null gdscript-debug--object-ids-to-fetch) (setq gdscript-debug-state nil) (gdscript-debug--construct-stack-var-buffer gdscript-debug--stack-frame-vars) - (gdscript-debug--refresh-inspector-buffer))) + (gdscript-debug--refresh-inspector-buffer gdscript-debug--inspector-focused-object-id))) ((eq gdscript-debug-state :refresh-inspector) (setq gdscript-debug-state nil) - (gdscript-debug--refresh-inspector-buffer)) + (gdscript-debug--refresh-inspector-buffer object-id)) ((and (eq gdscript-debug-state :expect-two) - (eq object-id gdscript-debug--inspector-focused-object-id)) + (eq object-id gdscript-debug--pinned-object-id)) (setq gdscript-debug-state :expect-one)) ((and (eq gdscript-debug-state :expect-two) (eq object-id gdscript-debug--current-self)) - ;; Expected `gdscript-debug--inspector-focused-object-id' but got `gdscript-debug--current-self' - ;; instead. That means `gdscript-debug--inspector-focused-object-id' doesn't exists anymore. - (setq gdscript-debug--inspector-focused-object-id object-id + ;; Expected `gdscript-debug--pinned-object-id' but got `gdscript-debug--current-self' + ;; instead. That means `gdscript-debug--pinned-object-id' doesn't exists anymore. + (setq gdscript-debug--pinned-object-id nil gdscript-debug--inspector-stack nil gdscript-debug-state nil) - (gdscript-debug--refresh-inspector-buffer)) + (gdscript-debug--refresh-inspector-buffer object-id)) ((eq gdscript-debug-state :expect-one) - (setq gdscript-debug-state nil) - (gdscript-debug--refresh-inspector-buffer)))))) + (setq gdscript-debug-state nil + gdscript-debug--inspector-stack nil) + (gdscript-debug--refresh-inspector-buffer (if gdscript-debug--pinned-object-id + gdscript-debug--pinned-object-id + object-id))))))) ("message:scene_tree" (gdscript-debug--command-handler - (let* ((cmd (mk-scene-tree iter))) + (let* ((cmd (gdscript-debug--mk-scene-tree iter))) (gdscript-debug--refresh-scene-tree-buffer cmd) (gdscript-debug-display-scene-tree-buffer)))) (_ (error "Unknown command %s" str)))))) ;;(iter-end-of-sequence (message "No more packets to process %s" x)) (iter-end-of-sequence nil)))) +(defun gdscript-debug-pin-inspected-object-id () + (interactive) + (setq gdscript-debug--pinned-object-id gdscript-debug--inspector-focused-object-id) + (gdscript-debug--refresh-inspector-buffer gdscript-debug--pinned-object-id)) + +(defun gdscript-debug-pin-current-self () + (interactive) + (setq gdscript-debug--pinned-object-id gdscript-debug--current-self + gdscript-debug--inspector-stack nil) + (gdscript-debug--refresh-inspector-buffer gdscript-debug--pinned-object-id)) + +(defun gdscript-debug-unpin () + (interactive) + (setq gdscript-debug--pinned-object-id nil + gdscript-debug--inspector-stack nil) + (gdscript-debug--refresh-inspector-buffer gdscript-debug--current-self)) + (defun gdscript-debug-fetch-object-ids-detail () (interactive) (setq gdscript-debug-state :fetching) - (mapc #'gdscript-debug-inspect-object (mapcar #'object-id->value gdscript-debug--object-ids-to-fetch))) + (mapc #'gdscript-debug-inspect-object (mapcar #'gdscript-object-id->value gdscript-debug--object-ids-to-fetch))) (defvar gdscript-debug--debug-enter nil "Stores last received `debug_enter' command data.") @@ -840,6 +905,9 @@ when breakpoint is encountered in Godot." "Stores last received `stack_frame_vars' command data.") (defvar gdscript-debug--inspector-focused-object-id nil "Stores `object-id' to display in * Inspector * buffer.") +(defvar gdscript-debug--pinned-object-id nil + "Stores pinned `object-id' to display in * Inspector * buffer. +Pinned `object-id' is explicitely controlled by user.") (defvar gdscript-debug--stack-dump nil "Stores last received `stack_dump' command data.") (defvar gdscript-debug--selected-stack-dump nil @@ -860,19 +928,19 @@ in buffer `buffer' should be rendered multiline.") (defun gdscript-debug--construct-stack-var-buffer (stack-frame-vars) (let ((table (gdscript-debug-table-create))) (gdscript-debug--table-add-row table (list "Locals:" "" "") nil) - (gdscript-debug--add-stack-var-to-table table (stack-frame-vars->locals stack-frame-vars)) + (gdscript-debug--add-stack-var-to-table table (gdscript-stack-frame-vars->locals stack-frame-vars)) (gdscript-debug--table-add-row table (list "Members:" "" "") nil) - (gdscript-debug--add-stack-var-to-table table (stack-frame-vars->members stack-frame-vars)) + (gdscript-debug--add-stack-var-to-table table (gdscript-stack-frame-vars->members stack-frame-vars)) (gdscript-debug--table-add-row table (list "Globals:" "" "") nil) - (gdscript-debug--add-stack-var-to-table table (stack-frame-vars->globals stack-frame-vars)) + (gdscript-debug--add-stack-var-to-table table (gdscript-stack-frame-vars->globals stack-frame-vars)) (with-current-buffer (gdscript-debug--get-stack-frame-vars-buffer) (let ((inhibit-read-only t) (point (point))) (setq header-line-format (format "Stack frame vars - %s:%s %s" - (stack-dump->file gdscript-debug--selected-stack-dump) - (stack-dump->line gdscript-debug--selected-stack-dump) - (stack-dump->function-name gdscript-debug--selected-stack-dump))) + (gdscript-stack-dump->file gdscript-debug--selected-stack-dump) + (gdscript-stack-dump->line gdscript-debug--selected-stack-dump) + (gdscript-stack-dump->function-name gdscript-debug--selected-stack-dump))) (erase-buffer) (insert (gdscript-debug--table-string table " ")) ;; Keep point in `stack-frame-vars-buffer' as close as possible to previous state @@ -886,29 +954,29 @@ in buffer `buffer' should be rendered multiline.") (gdscript-debug--table-add-row table (list - (gdscript-debug--variable-face variable) - (print-data->type-name print-data) - (print-data->string-repr print-data)) + (gdscript-debug-variable-face variable) + (gdscript-print-data->type-name print-data) + (gdscript-print-data->string-repr print-data)) (append (list 'property-name variable) - (cond ((object-id-p variant) - (list 'object-id (object-id->value variant)))))) - (when (object-id-p variant) - (unless (gethash (object-id->value variant) gdscript-debug--inspected-objects) + (cond ((gdscript-object-id-p variant) + (list 'object-id (gdscript-object-id->value variant)))))) + (when (gdscript-object-id-p variant) + (unless (gethash (gdscript-object-id->value variant) gdscript-debug--inspected-objects) (push variant gdscript-debug--object-ids-to-fetch)))))) -(defun gdscript-debug--refresh-inspector-buffer () - (when-let* ((inspect-object (gethash gdscript-debug--inspector-focused-object-id gdscript-debug--inspected-objects)) +(defun gdscript-debug--refresh-inspector-buffer (object-id) + (when-let* ((inspect-object (gethash object-id gdscript-debug--inspected-objects)) (table (gdscript-debug-table-create))) - (dolist (property (inspect-object->properties inspect-object)) - (let* ((variant (property-info->variant property)) - (usage (property-info->usage property)) - (_hint (property-info->hint property)) - (name (property-info->name property)) + (dolist (property (gdscript-inspect-object->properties inspect-object)) + (let* ((variant (gdscript-property-info->variant property)) + (usage (gdscript-property-info->usage property)) + (_hint (gdscript-property-info->hint property)) + (name (gdscript-property-info->name property)) (print-data (gdscript-debug--pure-stringify variant name 'inspector-buffer))) - (when-let ((variant (property-info->variant property)) - (is-object-id (object-id-p variant))) - (unless (gethash (object-id->value variant) gdscript-debug--inspected-objects) + (when-let ((variant (gdscript-property-info->variant property)) + (is-object-id (gdscript-object-id-p variant))) + (unless (gethash (gdscript-object-id->value variant) gdscript-debug--inspected-objects) (push variant gdscript-debug--object-ids-to-fetch))) (gdscript-debug--table-add-row table @@ -920,21 +988,25 @@ in buffer `buffer' should be rendered multiline.") (t (list ;;(concat (format "[%s]" usage) (format "[%s] " hint) name) name - (print-data->type-name print-data) - (print-data->string-repr print-data)))) + (gdscript-print-data->type-name print-data) + (gdscript-print-data->string-repr print-data)))) (append (list 'property-name name) (cond ((equal name "Node/path") - (list 'node-path (substring-no-properties (print-data->string-repr print-data)) 'keymap gdscript-debug--show-in-scene-tree-map)) - ((object-id-p variant) - (list 'object-id (object-id->value variant))) + (list 'node-path (substring-no-properties (gdscript-print-data->string-repr print-data)) 'keymap gdscript-debug--show-in-scene-tree-map)) + ((gdscript-object-id-p variant) + (list 'object-id (gdscript-object-id->value variant))) (t nil)))))) (delete-dups gdscript-debug--object-ids-to-fetch) (with-current-buffer (gdscript-debug--get-inspector-buffer) (let ((inhibit-read-only t) - (class (inspect-object->class inspect-object)) - (object-id (inspect-object->object-id inspect-object)) + (class (gdscript-inspect-object->class inspect-object)) + (object-id (gdscript-inspect-object->object-id inspect-object)) (inspector-stack-car (car gdscript-debug--inspector-stack))) + (setq header-line-format + (if gdscript-debug--pinned-object-id + (format "Inspector - Pinned: %s" gdscript-debug--pinned-object-id) + "Inspector")) (unless (and inspector-stack-car (equal class (gdscript-debug-breadcrumb-entry->class inspector-stack-car)) @@ -953,7 +1025,7 @@ in buffer `buffer' should be rendered multiline.") (interactive) (if-let* ((node-path (get-text-property (point) 'node-path))) (gdscript-debug--jump-to-node-path node-path) - (error "Not recognized as node-path line"))) + (message "Not recognized as node-path line"))) (defun gdscript-debug--jump-to-node-path (node-path) (with-current-buffer (gdscript-debug--get-scene-tree-buffer) @@ -996,7 +1068,7 @@ in buffer `buffer' should be rendered multiline.") (lambda (row properties) (apply 'propertize (mapconcat 'identity - (cl-mapcar (lambda (s x) (gdscript-debug--pad-string s x)) + (cl-mapcar (lambda (s x) (gdscript-debug-pad-string s x)) row column-sizes) sep) properties)) @@ -1004,131 +1076,131 @@ in buffer `buffer' should be rendered multiline.") (gdscript-debug-table->row-properties table)) "\n"))) -(defun gdscript-debug--pad-string (string padding) +(defun gdscript-debug-pad-string (string padding) (format (concat "%" (number-to-string padding) "s") string)) (defun gdscript-debug--pure-stringify (variant property-name buffer-type &optional inline-only) (gdscript-debug--to-print-data - (cond ((prim-null-p variant) + (cond ((gdscript-null-p variant) (list (gdscript-debug--builtin-face "null"))) - ((prim-bool-p variant) + ((gdscript-bool-p variant) (list (gdscript-debug--builtin-face "bool") - (gdscript-debug--prim-bool-to-string variant))) - ((prim-integer-p variant) + (gdscript-debug--gdscript-bool-to-string variant))) + ((gdscript-integer-p variant) (list (gdscript-debug--builtin-face "int") - (number-to-string (prim-integer->value variant)))) - ((prim-float-p variant) + (number-to-string (gdscript-integer->value variant)))) + ((gdscript-float-p variant) (list (gdscript-debug--builtin-face "float") - (number-to-string (prim-float->value variant)))) - ((prim-string-p variant) + (number-to-string (gdscript-float->value variant)))) + ((gdscript-string-p variant) (list - (gdscript-debug--type-face "String") - (gdscript-debug--string-face (prim-string->value variant)))) - ((vector2-p variant) + (gdscript-debug-type-face "String") + (gdscript-debug--string-face (gdscript-string->value variant)))) + ((gdscript-vector2-p variant) (list - (gdscript-debug--type-face "Vector2") + (gdscript-debug-type-face "Vector2") (gdscript-debug--vector2-to-string variant))) - ((rect2-p variant) + ((gdscript-rect2-p variant) (list - (gdscript-debug--type-face "Rect2") - (concat (gdscript-debug--vector2-to-string (rect2->coordinate variant)) " " (gdscript-debug--vector2-to-string (rect2->size variant))))) - ((vector3-p variant) + (gdscript-debug-type-face "Rect2") + (concat (gdscript-debug--vector2-to-string (gdscript-rect2->coordinate variant)) " " (gdscript-debug--vector2-to-string (gdscript-rect2->size variant))))) + ((gdscript-vector3-p variant) (list - (gdscript-debug--type-face "Vector3") + (gdscript-debug-type-face "Vector3") (gdscript-debug--vector3-to-string variant))) - ((transform2d-p variant) + ((gdscript-transform2d-p variant) (list - (gdscript-debug--type-face "Transform2D") - (mapconcat #'gdscript-debug--vector2-to-string (list (transform2d->x variant) (transform2d->y variant) (transform2d->origin variant)) " "))) - ((plane-p variant) + (gdscript-debug-type-face "Transform2D") + (mapconcat #'gdscript-debug--vector2-to-string (list (gdscript-transform2d->x variant) (gdscript-transform2d->y variant) (gdscript-transform2d->origin variant)) " "))) + ((gdscript-plane-p variant) (list - (gdscript-debug--type-face "Plane") - (concat (gdscript-debug--vector3-to-string (plane->normal variant)) " " (number-to-string (plane->distance variant))))) - ((quat-p variant) + (gdscript-debug-type-face "Plane") + (concat (gdscript-debug--vector3-to-string (gdscript-plane->normal variant)) " " (number-to-string (gdscript-plane->distance variant))))) + ((gdscript-quat-p variant) (list - (gdscript-debug--type-face "Quat") - (mapconcat #'number-to-string (list (quat->x-imaginary variant) (quat->y-imaginary variant) (quat->z-imaginary variant) (quat->real-w variant)) " "))) - ((aabb-p variant) + (gdscript-debug-type-face "Quat") + (mapconcat #'number-to-string (list (gdscript-quat->x-imaginary variant) (gdscript-quat->y-imaginary variant) (gdscript-quat->z-imaginary variant) (gdscript-quat->real-w variant)) " "))) + ((gdscript-aabb-p variant) (list - (gdscript-debug--type-face "AABB") - (mapconcat #'gdscript-debug--vector3-to-string (list (aabb->position variant) (aabb->size variant)) " "))) - ((basis-p variant) + (gdscript-debug-type-face "AABB") + (mapconcat #'gdscript-debug--vector3-to-string (list (gdscript-aabb->position variant) (gdscript-aabb->size variant)) " "))) + ((gdscript-basis-p variant) (list - (gdscript-debug--type-face "Basis") + (gdscript-debug-type-face "Basis") (gdscript-debug--basis-to-string variant))) - ((transform-p variant) + ((gdscript-transform-p variant) (list - (gdscript-debug--type-face "Transform") - (concat (gdscript-debug--basis-to-string (transform->basis variant)) " " (gdscript-debug--vector3-to-string (transform->origin variant))))) - ((color-p variant) + (gdscript-debug-type-face "Transform") + (concat (gdscript-debug--basis-to-string (gdscript-transform->basis variant)) " " (gdscript-debug--vector3-to-string (gdscript-transform->origin variant))))) + ((gdscript-color-p variant) (list - (gdscript-debug--type-face "Color") + (gdscript-debug-type-face "Color") (gdscript-debug--color-to-string variant))) - ((node-path-p variant) + ((gdscript-node-path-p variant) (list - (gdscript-debug--type-face "NodePath") - (gdscript-debug--constant-face (concat (when (prim-bool->value (node-path->absolute variant)) "/") (mapconcat #'prim-string->value (node-path->names variant) "/") (when-let* ((subnames (node-path->subnames variant))) (concat ":" (mapconcat #'prim-string->value subnames ":"))))))) - ((rid-p variant) + (gdscript-debug-type-face "NodePath") + (gdscript-debug--constant-face (concat (when (gdscript-bool->value (gdscript-node-path->absolute variant)) "/") (mapconcat #'gdscript-string->value (gdscript-node-path->names variant) "/") (when-let* ((subnames (gdscript-node-path->subnames variant))) (concat ":" (mapconcat #'gdscript-string->value subnames ":"))))))) + ((gdscript-rid-p variant) (list - (gdscript-debug--type-face "RID"))) - ((object-id-p variant) - (let* ((object-id (object-id->value variant)) + (gdscript-debug-type-face "RID"))) + ((gdscript-object-id-p variant) + (let* ((object-id (gdscript-object-id->value variant)) (object-id-data (gethash object-id gdscript-debug--inspected-objects))) (list - (if object-id-data (gdscript-debug--type-face (inspect-object->class object-id-data)) "ObjectID") + (if object-id-data (gdscript-debug-type-face (gdscript-inspect-object->class object-id-data)) "ObjectID") (concat (gdscript-debug--comment-face (format "ObjectID: %s" (number-to-string object-id))) (when object-id-data - (let* ((property (car (inspect-object->properties object-id-data))) - (name (property-info->name property))) + (let* ((property (car (gdscript-inspect-object->properties object-id-data))) + (name (gdscript-property-info->name property))) (when (equal name "Node/path") - (concat " " (print-data->string-repr (gdscript-debug--pure-stringify (property-info->variant property) property-name buffer-type t)))))))))) - ((dictionary-p variant) + (concat " " (gdscript-print-data->string-repr (gdscript-debug--pure-stringify (gdscript-property-info->variant property) property-name buffer-type t)))))))))) + ((gdscript-dictionary-p variant) (list - (gdscript-debug--type-face "Dictionary") + (gdscript-debug-type-face "Dictionary") (gdscript-debug--dictionary-inline-string variant property-name buffer-type) (gdscript-debug--dictionary-multiline-string variant property-name buffer-type))) - ((prim-array-p variant) + ((gdscript-array-p variant) (list - (gdscript-debug--type-face "Array") - (concat "[" (mapconcat (lambda (element) (print-data->string-repr (gdscript-debug--pure-stringify element property-name buffer-type t))) (prim-array->elements variant) ", ") "]") - (concat "[" (mapconcat (lambda (element) (print-data->string-repr (gdscript-debug--pure-stringify element property-name buffer-type t))) (prim-array->elements variant) ", ") "]"))) - ((pool-byte-array-p variant) + (gdscript-debug-type-face "Array") + (concat "[" (mapconcat (lambda (element) (gdscript-print-data->string-repr (gdscript-debug--pure-stringify element property-name buffer-type t))) (gdscript-array->elements variant) ", ") "]") + (concat "[" (mapconcat (lambda (element) (gdscript-print-data->string-repr (gdscript-debug--pure-stringify element property-name buffer-type t))) (gdscript-array->elements variant) ", ") "]"))) + ((gdscript-pool-byte-array-p variant) (list - (gdscript-debug--type-face "PoolByteArray") - (concat "[" (mapconcat #'number-to-string (pool-byte-array->elements variant) " ") "]") - (concat "[" (mapconcat #'number-to-string (pool-byte-array->elements variant) " ") "]"))) - ((pool-int-array-p variant) + (gdscript-debug-type-face "PoolByteArray") + (concat "[" (mapconcat #'number-to-string (gdscript-pool-byte-array->elements variant) " ") "]") + (concat "[" (mapconcat #'number-to-string (gdscript-pool-byte-array->elements variant) " ") "]"))) + ((gdscript-pool-int-array-p variant) (list - (gdscript-debug--type-face "PoolIntArray") - (concat "[" (mapconcat (lambda (int) (number-to-string (prim-integer->value int))) (pool-int-array->elements variant) " ") "]") - (concat "[" (mapconcat (lambda (int) (number-to-string (prim-integer->value int))) (pool-int-array->elements variant) " ") "]"))) - ((pool-real-array-p variant) + (gdscript-debug-type-face "PoolIntArray") + (concat "[" (mapconcat (lambda (int) (number-to-string (gdscript-integer->value int))) (gdscript-pool-int-array->elements variant) " ") "]") + (concat "[" (mapconcat (lambda (int) (number-to-string (gdscript-integer->value int))) (gdscript-pool-int-array->elements variant) " ") "]"))) + ((gdscript-pool-real-array-p variant) (list - (gdscript-debug--type-face "PoolRealArray") + (gdscript-debug-type-face "PoolRealArray") (gdscript-debug--pool-real-array-inline-string variant) (gdscript-debug--pool-real-array-multiline-string variant))) - ((pool-string-array-p variant) + ((gdscript-pool-string-array-p variant) (list - (gdscript-debug--type-face "PoolStringArray") + (gdscript-debug-type-face "PoolStringArray") (gdscript-debug--pool-string-array-inline-string variant) (gdscript-debug--pool-string-array-multiline-string variant))) - ((pool-vector2-array-p variant) + ((gdscript-pool-vector2-array-p variant) (list - (gdscript-debug--type-face "PoolVector2Array") + (gdscript-debug-type-face "PoolVector2Array") (gdscript-debug--pool-vector2-array-inline-string variant) (gdscript-debug--pool-vector2-array-multiline-string variant))) - ((pool-vector3-array-p variant) + ((gdscript-pool-vector3-array-p variant) (list - (gdscript-debug--type-face "PoolVector3Array") + (gdscript-debug-type-face "PoolVector3Array") (gdscript-debug--pool-vector3-array-inline-string variant) (gdscript-debug--pool-vector3-array-multiline-string variant))) - ((pool-color-array-p variant) + ((gdscript-pool-color-array-p variant) (list - (gdscript-debug--type-face "PoolColorArray") + (gdscript-debug-type-face "PoolColorArray") (gdscript-debug--pool-color-array-inline-string variant) (gdscript-debug--pool-color-array-multiline-string variant))) (t (error "[gdscript-debug--pure-stringify] Invalid type %s" variant))) @@ -1144,76 +1216,79 @@ in buffer `buffer' should be rendered multiline.") (defun gdscript-debug--dictionary-inline-string (is-object-id property-name buffer-type) (concat "{" (mapconcat (lambda (key-value) - (gdscript-debug--key-value-to-string key-value property-name buffer-type)) (dictionary->elements is-object-id) ", ") "}")) + (gdscript-debug--key-value-to-string key-value property-name buffer-type)) (gdscript-dictionary->elements is-object-id) ", ") "}")) (defun gdscript-debug--dictionary-multiline-string (dictionary property-name buffer-type) (let ((table (gdscript-debug-table-create))) - (dolist (element (dictionary->elements dictionary)) + (dolist (element (gdscript-dictionary->elements dictionary)) (pcase-let ((`(,key . ,value) element)) (gdscript-debug--table-add-row table (list - (concat " "(print-data->string-repr (gdscript-debug--pure-stringify key property-name buffer-type t)) ":") - (print-data->string-repr (gdscript-debug--pure-stringify value property-name buffer-type t))) - (cond ((object-id-p value) - (list 'object-id (object-id->value value))) + (concat " "(gdscript-print-data->string-repr (gdscript-debug--pure-stringify key property-name buffer-type t)) ":") + (gdscript-print-data->string-repr (gdscript-debug--pure-stringify value property-name buffer-type t))) + (cond ((gdscript-object-id-p value) + (list 'object-id (gdscript-object-id->value value))) (t nil))))) (concat "{\n" (gdscript-debug--table-string table " ") "\n}"))) (defun gdscript-debug--pool-real-array-inline-string (is-object-id) - (concat "[" (mapconcat (lambda (real) (number-to-string (prim-float->value real))) (pool-real-array->elements is-object-id) " ") "]")) + (concat "[" (mapconcat (lambda (real) (number-to-string (gdscript-float->value real))) (gdscript-pool-real-array->elements is-object-id) " ") "]")) (defun gdscript-debug--pool-real-array-multiline-string (is-object-id) - (concat "[\n" (mapconcat (lambda (real) (concat " " (number-to-string (prim-float->value real)) "\n")) (pool-real-array->elements is-object-id) "") "]")) + (concat "[\n" (mapconcat (lambda (real) (concat " " (number-to-string (gdscript-float->value real)) "\n")) (gdscript-pool-real-array->elements is-object-id) "") "]")) (defun gdscript-debug--pool-string-array-inline-string (is-object-id) (concat "[" (mapconcat (lambda (o) - (gdscript-debug--string-face (prim-string->value o))) (pool-string-array->elements is-object-id) " ") "]")) + (gdscript-debug--string-face (gdscript-string->value o))) (gdscript-pool-string-array->elements is-object-id) " ") "]")) (defun gdscript-debug--pool-string-array-multiline-string (is-object-id) (concat "[\n" (mapconcat (lambda (o) - (concat " " (gdscript-debug--string-face (prim-string->value o)) "\n")) (pool-string-array->elements is-object-id) "") "]")) + (concat " " (gdscript-debug--string-face (gdscript-string->value o)) "\n")) (gdscript-pool-string-array->elements is-object-id) "") "]")) (defun gdscript-debug--pool-vector2-array-inline-string (is-object-id) - (concat "[" (mapconcat #'gdscript-debug--vector2-to-string (pool-vector2-array->elements is-object-id) " ") "]")) + (concat "[" (mapconcat #'gdscript-debug--vector2-to-string (gdscript-pool-vector2-array->elements is-object-id) " ") "]")) (defun gdscript-debug--pool-vector2-array-multiline-string (is-object-id) (concat "[\n" (mapconcat (lambda (o) - (concat " " (gdscript-debug--vector2-to-string o) "\n")) (pool-vector2-array->elements is-object-id) "") "]")) + (concat " " (gdscript-debug--vector2-to-string o) "\n")) (gdscript-pool-vector2-array->elements is-object-id) "") "]")) (defun gdscript-debug--pool-vector3-array-inline-string (is-object-id) - (concat "[" (mapconcat #'gdscript-debug--vector3-to-string (pool-vector3-array->elements is-object-id) " ") "]")) + (concat "[" (mapconcat #'gdscript-debug--vector3-to-string (gdscript-pool-vector3-array->elements is-object-id) " ") "]")) (defun gdscript-debug--pool-vector3-array-multiline-string (is-object-id) (concat "[\n" (mapconcat (lambda (o) - (concat " " (gdscript-debug--vector3-to-string o) "\n")) (pool-vector3-array->elements is-object-id) "") "]")) + (concat " " (gdscript-debug--vector3-to-string o) "\n")) (gdscript-pool-vector3-array->elements is-object-id) "") "]")) (defun gdscript-debug--pool-color-array-inline-string (is-object-id) - (concat "[" (mapconcat #'gdscript-debug--color-to-string (pool-color-array->elements is-object-id) " ") "]")) + (concat "[" (mapconcat #'gdscript-debug--color-to-string (gdscript-pool-color-array->elements is-object-id) " ") "]")) (defun gdscript-debug--pool-color-array-multiline-string (is-object-id) (concat "[\n" (mapconcat (lambda (o) - (concat " " (gdscript-debug--color-to-string o) "\n")) (pool-color-array->elements is-object-id) "") "]")) + (concat " " (gdscript-debug--color-to-string o) "\n")) (gdscript-pool-color-array->elements is-object-id) "") "]")) (defun gdscript-debug--to-print-data (args property-name buffer-type &optional inline-only) (pcase args (`(,type-name) - (print-data-create :type-name type-name - :string-repr "")) + (gdscript-print-data-create + :type-name type-name + :string-repr "")) (`(,type-name ,inline-string-repr) - (print-data-create :type-name type-name - :string-repr (gdscript-debug--initial-inline-visibility inline-string-repr nil))) + (gdscript-print-data-create + :type-name type-name + :string-repr (gdscript-debug--initial-inline-visibility inline-string-repr nil))) (`(,type-name ,inline-string-repr ,multiline-string-repr) (let ((multiline-invisible (gethash (cons buffer-type property-name) gdscript-debug--multiline-on))) - (print-data-create :type-name type-name - :string-repr (concat - (gdscript-debug--initial-inline-visibility inline-string-repr multiline-invisible) - (unless inline-only - (gdscript-debug--initial-multiline-visibility multiline-string-repr (not multiline-invisible))))))))) + (gdscript-print-data-create + :type-name type-name + :string-repr (concat + (gdscript-debug--initial-inline-visibility inline-string-repr multiline-invisible) + (unless inline-only + (gdscript-debug--initial-multiline-visibility multiline-string-repr (not multiline-invisible))))))))) -(cl-defstruct (print-data (:constructor print-data-create) - (:copier nil) - (:conc-name print-data->)) +(cl-defstruct (gdscript-print-data (:constructor gdscript-print-data-create) + (:copier nil) + (:conc-name gdscript-print-data->)) type-name string-repr) (defun gdscript-debug--keyword-face (string) @@ -1231,44 +1306,44 @@ in buffer `buffer' should be rendered multiline.") (defun gdscript-debug--builtin-face (string) (propertize string 'font-lock-face font-lock-builtin-face)) -(defun gdscript-debug--type-face (string) +(defun gdscript-debug-type-face (string) (propertize string 'font-lock-face font-lock-type-face)) -(defun gdscript-debug--variable-face (string) +(defun gdscript-debug-variable-face (string) (propertize string 'font-lock-face font-lock-variable-name-face)) (defun gdscript-debug--key-value-to-string (key-value property-name buffer-type) (let ((key (car key-value)) (value (cdr key-value))) - (concat (print-data->string-repr (gdscript-debug--pure-stringify key property-name buffer-type t)) + (concat (gdscript-print-data->string-repr (gdscript-debug--pure-stringify key property-name buffer-type t)) ":" - (print-data->string-repr (gdscript-debug--pure-stringify value property-name buffer-type t))))) + (gdscript-print-data->string-repr (gdscript-debug--pure-stringify value property-name buffer-type t))))) -(defun gdscript-debug--prim-bool-to-string (prim-bool) - (if (prim-bool->value prim-bool) (gdscript-debug--keyword-face "true") (gdscript-debug--keyword-face "false"))) +(defun gdscript-debug--gdscript-bool-to-string (gdscript-bool) + (if (gdscript-bool->value gdscript-bool) (gdscript-debug--keyword-face "true") (gdscript-debug--keyword-face "false"))) (defun gdscript-debug--color-to-string (color) - (format "(%s)" (mapconcat #'number-to-string (list (color->red color) (color->green color) (color->blue color) (color->alpha color)) ", "))) + (format "(%s)" (mapconcat #'number-to-string (list (gdscript-color->red color) (gdscript-color->green color) (gdscript-color->blue color) (gdscript-color->alpha color)) ", "))) (defun gdscript-debug--basis-to-string (basis) - (mapconcat #'gdscript-debug--vector3-to-string (list (basis->x basis) (basis->y basis) (basis->z basis)) " ")) + (mapconcat #'gdscript-debug--vector3-to-string (list (gdscript-basis->x basis) (gdscript-basis->y basis) (gdscript-basis->z basis)) " ")) (defun gdscript-debug--vector2-to-string (vector2) - (concat "(" (number-to-string (vector2->x vector2)) ", " (number-to-string (vector2->y vector2)) ")")) + (concat "(" (number-to-string (gdscript-vector2->x vector2)) ", " (number-to-string (gdscript-vector2->y vector2)) ")")) (defun gdscript-debug--vector3-to-string (vector3) - (concat "(" (number-to-string (vector3->x vector3)) ", " (number-to-string (vector3->y vector3)) ", " (number-to-string (vector3->z vector3)) ")")) + (concat "(" (number-to-string (gdscript-vector3->x vector3)) ", " (number-to-string (gdscript-vector3->y vector3)) ", " (number-to-string (gdscript-vector3->z vector3)) ")")) -(defvar server-clients '() +(defvar gdscript-server-clients '() "List with client processes") (defun gdscript-debug--sentinel-function (process event) "Gets called when the status of the network connection changes." - ;;(message "[sentinel] process: %s" process) - ;;(message "[sentinel] event : %s" event) + ;; (message "[sentinel] process: %s" process) + ;; (message "[sentinel] event : %s" event) (cond ((string-match "open from .*\n" event) - (push process server-clients)) + (push process gdscript-server-clients)) ((or (string= event "connection broken by remote peer\n") (string= event "deleted\n")) @@ -1280,15 +1355,20 @@ in buffer `buffer' should be rendered multiline.") gdscript-debug--multiline-on (make-hash-table :test #'equal) gdscript-debug--inspector-stack nil gdscript-debug--inspector-focused-object-id nil - server-clients '()) + gdscript-debug--pinned-object-id nil + gdscript-server-clients (seq-remove (lambda (client-process) + (string= + (process-name client-process) + (process-name process))) + gdscript-server-clients)) (message "Resetting server to accept data.")) ((eq (process-status process) 'closed) - (message "EHHHH ???")))) + (message "Process Closed")))) (defmacro gdscript-debug--send-command (&rest body) "Todo" (declare (indent 0) (debug t)) - `(pcase server-clients + `(pcase gdscript-server-clients (`() (message "No game process is running.")) (`(,server-process) (let ((command (progn ,@body))) @@ -1298,7 +1378,7 @@ in buffer `buffer' should be rendered multiline.") (defmacro gdscript-debug--if-server-process (&rest body) "Todo" (declare (indent 0) (debug t)) - `(pcase server-clients + `(pcase gdscript-server-clients (`(,server-process) (progn ,@body)))) (defun gdscript-debug-inspect-object (object-id) @@ -1402,84 +1482,84 @@ in buffer `buffer' should be rendered multiline.") (:boolean-type u32r) (:boolean u32r))) -(defconst variant-bool 1 "bool") -(defconst variant-integer 2 "integer") -(defconst variant-float 3 "float") -(defconst variant-string 4 "string") -(defconst variant-array 19 "array") +(defconst gdscript-variant-bool 1 "bool") +(defconst gdscript-variant-integer 2 "integer") +(defconst gdscript-variant-string 4 "string") +(defconst gdscript-variant-array 19 "array") -(defun boolean-to-integer (b) +(defun gdscript-debug--boolean-to-integer (b) (if (null b) 0 1)) (defun gdscript-debug--inspect-object (object-id) (let* ((command "inspect_object") (command-length (length command)) - (command-alength (align-length command)) + (command-alength (gdscript-debug-align-length command)) (packet-length (+ (* 6 4) command-alength)) (spec (gdscript-debug--inspect-object-definition command-length))) (bindat-pack spec `((:packet-length . ,packet-length) - (:array-type . ,variant-array) + (:array-type . ,gdscript-variant-array) (:elements-count . 2) - (:command-type . ,variant-string) + (:command-type . ,gdscript-variant-string) (:command-length . ,command-length) (:command . ,command) - (:object-id-type . ,variant-integer) + (:object-id-type . ,gdscript-variant-integer) (:object-id . ,object-id))))) (defun gdscript-debug--get-stack-frame-vars (frame) (let* ((command "get_stack_frame_vars") (command-length (length command)) - (command-alength (align-length command)) + (command-alength (gdscript-debug-align-length command)) (packet-length (+ (* 6 4) command-alength)) (spec (gdscript-debug--get-stack-frame-vars-definition command-length))) (bindat-pack spec `((:packet-length . ,packet-length) - (:array-type . ,variant-array) + (:array-type . ,gdscript-variant-array) (:elements-count . 2) - (:command-type . ,variant-string) + (:command-type . ,gdscript-variant-string) (:command-length . ,command-length) (:command . ,command) - (:frame-type . ,variant-integer) + (:frame-type . ,gdscript-variant-integer) (:frame . ,frame))))) (defun gdscript-debug--breakpoint-command (file line add-or-remove) (let* ((command "breakpoint") (command-length (length command)) - (command-alength (align-length command)) + (command-alength (gdscript-debug-align-length command)) (file-length (length file)) - (packet-length (+ (* 10 4) command-alength file-length)) + (file-alength (gdscript-debug-align-length file)) + (packet-length (+ (* 10 4) command-alength file-alength)) (spec (gdscript-debug--breakpoint-packet-definition command-length file-length))) (bindat-pack spec `((:packet-length . ,packet-length) - (:array-type . ,variant-array) + (:array-type . ,gdscript-variant-array) (:elements-count . 4) - (:command-type . ,variant-string) + (:command-type . ,gdscript-variant-string) (:command-length . ,command-length) (:command . ,command) - (:file-type . ,variant-string) + (:file-type . ,gdscript-variant-string) (:file-length . ,file-length) (:file . ,file) - (:line-type . ,variant-integer) + (:line-type . ,gdscript-variant-integer) (:line . ,line) - (:boolean-type . ,variant-bool) - (:boolean . ,(boolean-to-integer add-or-remove)))))) + (:boolean-type . ,gdscript-variant-bool) + (:boolean . ,(gdscript-debug--boolean-to-integer add-or-remove)))))) (defun gdscript-debug--set-skip-breakpoints-command (skip) (let* ((command "set_skip_breakpoints") (command-length (length command)) - (command-alength (align-length command)) + (command-alength (gdscript-debug-align-length command)) (packet-length (+ (* 6 4) command-alength)) (spec (gdscript-debug--set-skip-breakpoints-packet-definition command-length))) (bindat-pack spec `((:packet-length . ,packet-length) - (:array-type . ,variant-array) + (:array-type . ,gdscript-variant-array) (:elements-count . 2) - (:command-type . ,variant-string) + (:command-type . ,gdscript-variant-string) (:command-length . ,command-length) (:command . ,command) - (:boolean-type . ,variant-bool) - (:boolean . ,(boolean-to-integer skip)))))) + (:boolean-type . ,gdscript-variant-bool) + (:boolean . ,(gdscript-debug--boolean-to-integer skip)))))) (defun gdscript-debug--packet-definition (string-length) `((:packet-length u32r) @@ -1491,18 +1571,18 @@ in buffer `buffer' should be rendered multiline.") (align 4))) (defun gdscript-debug--command (command) - (let* ((command-alength (align-length command)) + (let* ((command-alength (gdscript-debug-align-length command)) (packet-length (+ (* 4 4) command-alength))) (bindat-pack (gdscript-debug--packet-definition (length command)) `((:packet-length . ,packet-length) - (:array-type . ,variant-array) + (:array-type . ,gdscript-variant-array) (:elements-count . 1) - (:type . ,variant-string) + (:type . ,gdscript-variant-string) (:string-length . ,(length command)) (:string-data . ,command))))) -(defun align-length (string) +(defun gdscript-debug-align-length (string) (let ((len (length string))) (while (/= (% len 4) 0) (setq len (1+ len))) @@ -1551,211 +1631,180 @@ BUFFER nil or omitted means use the current buffer." (message "No GDScript file.") ,body))) -(defun gdscript-debug-remove-breakpoint () - (interactive) - (gdscript-debug--with-gdscript-file file-info - (let* ((start (line-beginning-position)) - (end (line-end-position)) - (line (line-number-at-pos)) - (file (car file-info)) - (file-absolute (cdr file-info)) - (breakpoint (breakpoint-create :file file :file-absolute file-absolute :line line))) - (if (not (member breakpoint gdscript-debug--breakpoints)) - (message "No breakpoint at %s:%s" file line) - (gdscript-debug--remove-strings start end) - (gdscript-debug--remove-breakpoint-from-buffer breakpoint) - (gdscript-debug--if-server-process - (gdscript-debug--send-command - (gdscript-debug--breakpoint-command file line nil))))))) - -(defun gdscript-debug-add-breakpoint () - (interactive) - (gdscript-debug--with-gdscript-file file-info - (let* ((line (line-number-at-pos)) - (file (car file-info)) - (file-absolute (cdr file-info)) - (breakpoint (breakpoint-create :file file :file-absolute file-absolute :line line))) - (if (member breakpoint gdscript-debug--breakpoints) - (message "Breakpoint already present at %s:%s" file line) - (gdscript-debug--add-fringe (line-beginning-position) (not gdscript-debug--skip-breakpoints) 'gdb-bptno 1) - (gdscript-debug--add-breakpoint-to-buffer breakpoint) - (refresh-breakpoints-buffer) - (gdscript-debug--if-server-process - (gdscript-debug--send-command - (gdscript-debug--breakpoint-command file line t))))))) - -(defun set-left-fringe-breakpoints (enabled) - (refresh-breakpoints-buffer) - (dolist (breakpoint gdscript-debug--breakpoints) - (let ((file (breakpoint->file-absolute breakpoint)) - (line (breakpoint->line breakpoint))) - (save-selected-window - (let ((buffer (find-file-noselect file))) - (save-excursion - (with-current-buffer buffer - (goto-char (point-min)) - (forward-line (1- line)) - (let ((start (line-beginning-position)) - (end (line-end-position))) - (dolist (overlay (overlays-in start end)) - (when (overlay-get overlay 'put-break) - (let* ((string (overlay-get overlay 'before-string)) - (prop `(left-fringe breakpoint ,(if (not enabled) 'breakpoint-enabled 'breakpoint-disabled)))) - (put-text-property 0 1 'display prop string)))))))))))) - (defun gdscript-debug-get-stack-frame-vars (level) (gdscript-debug--send-command (gdscript-debug--get-stack-frame-vars level))) -(cl-defstruct (prim-null (:constructor prim-null-create) - (:copier nil))) +(cl-defstruct (gdscript-null (:constructor gdscript-null-create) + (:copier nil))) -(cl-defstruct (prim-bool (:constructor prim-bool-create) - (:copier nil) - (:conc-name prim-bool->)) +(cl-defstruct (gdscript-bool (:constructor gdscript-bool-create) + (:copier nil) + (:conc-name gdscript-bool->)) value) -(cl-defstruct (prim-integer (:constructor prim-integer-create) - (:copier nil) - (:conc-name prim-integer->)) +(cl-defstruct (gdscript-integer (:constructor gdscript-integer-create) + (:copier nil) + (:conc-name gdscript-integer->)) value) -(cl-defstruct (prim-float (:constructor prim-float-create) - (:copier nil) - (:conc-name prim-float->)) +(cl-defstruct (gdscript-float (:constructor gdscript-float-create) + (:copier nil) + (:conc-name gdscript-float->)) value) -(cl-defstruct (prim-string (:constructor prim-string-create) - (:copier nil) - (:conc-name prim-string->)) +(cl-defstruct (gdscript-string (:constructor gdscript-string-create) + (:copier nil) + (:conc-name gdscript-string->)) value) -(cl-defstruct (plane (:constructor plane-create) - (:copier nil) - (:conc-name plane->)) +(cl-defstruct (gdscript-plane (:constructor gdscript-plane-create) + (:copier nil) + (:conc-name gdscript-plane->)) normal distance) -(cl-defstruct (quat (:constructor quat-create) - (:copier nil) - (:conc-name quat->)) +(cl-defstruct (gdscript-quat (:constructor gdscript-quat-create) + (:copier nil) + (:conc-name gdscript-quat->)) x-imaginary y-imaginary z-imaginary real-w) -(cl-defstruct (aabb (:constructor aabb-create) - (:copier nil) - (:conc-name aabb->)) +(cl-defstruct (gdscript-aabb (:constructor gdscript-aabb-create) + (:copier nil) + (:conc-name gdscript-aabb->)) position size) -(cl-defstruct (basis (:constructor basis-create) - (:copier nil) - (:conc-name basis->)) +(cl-defstruct (gdscript-basis (:constructor gdscript-basis-create) + (:copier nil) + (:conc-name gdscript-basis->)) x y z) -(cl-defstruct (transform (:constructor transform-create) - (:copier nil) - (:conc-name transform->)) +(cl-defstruct (gdscript-transform (:constructor gdscript-transform-create) + (:copier nil) + (:conc-name gdscript-transform->)) basis origin) -(cl-defstruct (color (:constructor color-create) - (:copier nil) - (:conc-name color->)) +(cl-defstruct (gdscript-color (:constructor gdscript-color-create) + (:copier nil) + (:conc-name gdscript-color->)) red green blue alpha) -(cl-defstruct (node-path (:constructor node-path-create) - (:copier nil) - (:conc-name node-path->)) +(cl-defstruct (gdscript-node-path (:constructor gdscript-node-path-create) + (:copier nil) + (:conc-name gdscript-node-path->)) names subnames absolute) -(cl-defstruct (rid (:constructor rid-create) - (:copier nil))) +(cl-defstruct (gdscript-rid (:constructor gdscript-rid-create) + (:copier nil))) -(cl-defstruct (object-id (:constructor object-id-create) - (:copier nil) - (:conc-name object-id->)) +(cl-defstruct (gdscript-object-id (:constructor gdscript-object-id-create) + (:copier nil) + (:conc-name gdscript-object-id->)) value) -(cl-defstruct (dictionary (:constructor dictionary-create) - (:copier nil) - (:conc-name dictionary->)) +(cl-defstruct (gdscript-dictionary (:constructor gdscript-dictionary-create) + (:copier nil) + (:conc-name gdscript-dictionary->)) shared elements) -(cl-defstruct (vector2 (:constructor vector2-create) - (:copier nil) - (:conc-name vector2->)) +(cl-defstruct (gdscript-vector2 (:constructor gdscript-vector2-create) + (:copier nil) + (:conc-name gdscript-vector2->)) x y) -(cl-defstruct (rect2 (:constructor rect2-create) - (:copier nil) - (:conc-name rect2->)) +(cl-defstruct (gdscript-rect2 (:constructor gdscript-rect2-create) + (:copier nil) + (:conc-name gdscript-rect2->)) coordinate size) -(cl-defstruct (vector3 (:constructor vector3-create) - (:copier nil) - (:conc-name vector3->)) +(cl-defstruct (gdscript-vector3 (:constructor gdscript-vector3-create) + (:copier nil) + (:conc-name gdscript-vector3->)) x y z) -(cl-defstruct (transform2d (:constructor transform2d-create) - (:copier nil) - (:conc-name transform2d->)) +(cl-defstruct (gdscript-transform2d (:constructor gdscript-transform2d-create) + (:copier nil) + (:conc-name gdscript-transform2d->)) x y origin) -(cl-defstruct (prim-array (:constructor prim-array-create) - (:copier nil) - (:conc-name prim-array->)) +(cl-defstruct (gdscript-array (:constructor gdscript-array-create) + (:copier nil) + (:conc-name gdscript-array->)) shared elements) -(cl-defstruct (pool-byte-array (:constructor pool-byte-array-create) - (:copier nil) - (:conc-name pool-byte-array->)) +(cl-defstruct (gdscript-pool-byte-array (:constructor gdscript-pool-byte-array-create) + (:copier nil) + (:conc-name gdscript-pool-byte-array->)) elements) -(cl-defstruct (pool-int-array (:constructor pool-int-array-create) - (:copier nil) - (:conc-name pool-int-array->)) +(cl-defstruct (gdscript-pool-int-array (:constructor gdscript-pool-int-array-create) + (:copier nil) + (:conc-name gdscript-pool-int-array->)) elements) -(cl-defstruct (pool-real-array (:constructor pool-real-array-create) - (:copier nil) - (:conc-name pool-real-array->)) +(cl-defstruct (gdscript-pool-real-array (:constructor gdscript-pool-real-array-create) + (:copier nil) + (:conc-name gdscript-pool-real-array->)) elements) -(cl-defstruct (pool-string-array (:constructor pool-string-array-create) - (:copier nil) - (:conc-name pool-string-array->)) +(cl-defstruct (gdscript-pool-string-array (:constructor gdscript-pool-string-array-create) + (:copier nil) + (:conc-name gdscript-pool-string-array->)) elements) -(cl-defstruct (pool-vector2-array (:constructor pool-vector2-array-create) - (:copier nil) - (:conc-name pool-vector2-array->)) +(cl-defstruct (gdscript-pool-vector2-array (:constructor gdscript-pool-vector2-array-create) + (:copier nil) + (:conc-name gdscript-pool-vector2-array->)) elements) -(cl-defstruct (pool-vector3-array (:constructor pool-vector3-array-create) - (:copier nil) - (:conc-name pool-vector3-array->)) +(cl-defstruct (gdscript-pool-vector3-array (:constructor gdscript-pool-vector3-array-create) + (:copier nil) + (:conc-name gdscript-pool-vector3-array->)) elements) -(cl-defstruct (pool-color-array (:constructor pool-color-array-create) - (:copier nil) - (:conc-name pool-color-array->)) +(cl-defstruct (gdscript-pool-color-array (:constructor gdscript-pool-color-array-create) + (:copier nil) + (:conc-name gdscript-pool-color-array->)) elements) -(cl-defstruct (stack-frame-vars (:constructor stack-frame-vars-create) - (:copier nil) - (:conc-name stack-frame-vars->)) +(cl-defstruct (gdscript-stack-frame-vars (:constructor gdscript-stack-frame-vars-create) + (:copier nil) + (:conc-name gdscript-stack-frame-vars->)) locals members globals) -(cl-defstruct (stack-dump (:constructor stack-dump-create) - (:copier nil) - (:conc-name stack-dump->)) +(cl-defstruct (gdscript-stack-dump (:constructor gdscript-stack-dump-create) + (:copier nil) + (:conc-name gdscript-stack-dump->)) file line function-name level) -(cl-defstruct (inspect-object (:constructor inspect-object-create) - (:copier nil) - (:conc-name inspect-object->)) +(cl-defstruct (gdscript-output-error (:constructor gdscript-output-error-create) + (:copier nil) + (:conc-name gdscript-output-error->)) + ;; See struct OutputError in script_debugger_remote.h + hr ;; int + min ;; int + sec ;; int + msec ;; int + source-file ;; String + source-func ;; String + source-line ;; int + error ;; String + error-descr ;; String + warning ;; bool + callstack) ;; Array + +(cl-defstruct (gdscript-stack-info (:constructor sgdscript-tack-info-create) + (:copier nil) + (:conc-name gdscript-stack-info->)) + file func line) + +(cl-defstruct (gdscript-inspect-object (:constructor gdscript-inspect-object-create) + (:copier nil) + (:conc-name gdscript-inspect-object->)) object-id class properties) -(cl-defstruct (property-info (:constructor property-info-create) - (:copier nil) - (:conc-name property-info->)) +(cl-defstruct (gdscript-property-info (:constructor gdscript-property-info-create) + (:copier nil) + (:conc-name gdscript-property-info->)) name type hint ;; see enum PropertyHint in object.h @@ -1763,14 +1812,14 @@ BUFFER nil or omitted means use the current buffer." usage ;; see enum PropertyUsageFlags in object.h variant) -(cl-defstruct (breakpoint (:constructor breakpoint-create) - (:copier nil) - (:conc-name breakpoint->)) +(cl-defstruct (gdscript-breakpoint (:constructor gdscript-breakpoint-create) + (:copier nil) + (:conc-name gdscript-breakpoint->)) file file-absolute line) -(cl-defstruct (debug-enter (:constructor debug-enter-create) - (:copier nil) - (:conc-name debug-enter->)) +(cl-defstruct (gdscript-debug-enter (:constructor gdscript-debug-enter-create) + (:copier nil) + (:conc-name gdscript-debug-enter->)) can-continue reason) (cl-defstruct (gdscript-debug-table (:constructor gdscript-debug-table-create) @@ -1819,43 +1868,83 @@ calling `gdscript-debug--table-string'." (setq buffer-read-only t) (buffer-disable-undo)) -(defun gdscript-debug-enable-breakpoints () +(defun gdscript-debug-add-breakpoint () (interactive) - (set-left-fringe-breakpoints nil) - (gdscript-debug--send-command - (gdscript-debug--set-skip-breakpoints-command nil))) + (gdscript-debug--with-gdscript-file file-info + (let* ((line (line-number-at-pos)) + (file (car file-info)) + (file-absolute (cdr file-info)) + (breakpoint (gdscript-breakpoint-create :file file :file-absolute file-absolute :line line))) + (if (member breakpoint gdscript-debug--breakpoints) + (message "Breakpoint already present at %s:%s" file line) + (gdscript-debug--add-fringe (line-beginning-position) (not gdscript-debug--skip-breakpoints) 'gdb-bptno 1) + (gdscript-debug--add-breakpoint-to-buffer breakpoint) + (gdscript-debug-refresh-breakpoints-buffer) + (gdscript-debug--if-server-process + (gdscript-debug--send-command + (gdscript-debug--breakpoint-command file line t))))))) -(defun gdscript-debug-skip-breakpoints () +(defun gdscript-debug-remove-breakpoint () (interactive) - (set-left-fringe-breakpoints t) - (gdscript-debug--send-command - (gdscript-debug--set-skip-breakpoints-command t))) + (gdscript-debug--with-gdscript-file file-info + (let* ((start (line-beginning-position)) + (end (line-end-position)) + (line (line-number-at-pos)) + (file (car file-info)) + (file-absolute (cdr file-info)) + (breakpoint (gdscript-breakpoint-create :file file :file-absolute file-absolute :line line))) + (if (not (member breakpoint gdscript-debug--breakpoints)) + (message "No breakpoint at %s:%s" file line) + (gdscript-debug--remove-strings start end) + (gdscript-debug--remove-breakpoint-from-buffer breakpoint) + (gdscript-debug--if-server-process + (gdscript-debug--send-command + (gdscript-debug--breakpoint-command file line nil))))))) + +(defun gdscript-debug--set-left-fringe-breakpoints (enabled) + (gdscript-debug-refresh-breakpoints-buffer) + (dolist (breakpoint gdscript-debug--breakpoints) + (let ((file (gdscript-breakpoint->file-absolute breakpoint)) + (line (gdscript-breakpoint->line breakpoint))) + (save-selected-window + (let ((buffer (find-file-noselect file))) + (save-excursion + (with-current-buffer buffer + (goto-char (point-min)) + (forward-line (1- line)) + (let ((start (line-beginning-position)) + (end (line-end-position))) + (dolist (overlay (overlays-in start end)) + (when (overlay-get overlay 'put-break) + (let* ((string (overlay-get overlay 'before-string)) + (prop `(left-fringe breakpoint ,(if (not enabled) 'breakpoint-enabled 'breakpoint-disabled)))) + (put-text-property 0 1 'display prop string)))))))))))) (defun gdscript-debug-toggle-breakpoint () (interactive) (setq gdscript-debug--skip-breakpoints (not gdscript-debug--skip-breakpoints)) - (set-left-fringe-breakpoints gdscript-debug--skip-breakpoints) + (gdscript-debug--set-left-fringe-breakpoints gdscript-debug--skip-breakpoints) (gdscript-debug--send-command (gdscript-debug--set-skip-breakpoints-command gdscript-debug--skip-breakpoints))) (defun gdscript-debug-delete-breakpoint () (interactive) (if-let* ((breakpoint (get-text-property (point) 'gdscript-debug--breakpoint))) - (let ((file (breakpoint->file-absolute breakpoint)) - (line (breakpoint->line breakpoint))) + (let ((file (gdscript-breakpoint->file-absolute breakpoint)) + (line (gdscript-breakpoint->line breakpoint))) (save-selected-window (let ((buffer (find-file-noselect file))) (with-current-buffer buffer (goto-char (point-min)) (forward-line (1- line)) (gdscript-debug-remove-breakpoint))))) - (error "Not recognized as breakpoint line"))) + (message "Not recognized as breakpoint line"))) (defun gdscript-debug-goto-breakpoint () (interactive) (if-let* ((breakpoint (get-text-property (point) 'gdscript-debug--breakpoint))) - (let ((file (breakpoint->file-absolute breakpoint)) - (line (breakpoint->line breakpoint))) + (let ((file (gdscript-breakpoint->file-absolute breakpoint)) + (line (gdscript-breakpoint->line breakpoint))) (save-selected-window (let* ((buffer (find-file-noselect file)) (window (gdscript-debug--display-buffer buffer))) @@ -1863,7 +1952,7 @@ calling `gdscript-debug--table-string'." (goto-char (point-min)) (forward-line (1- line)) (set-window-point window (point)))))) - (error "Not recognized as breakpoint line"))) + (message "Not recognized as breakpoint line"))) (defun gdscript-debug-inspect-object-id () (interactive) @@ -1875,11 +1964,11 @@ calling `gdscript-debug--table-string'." (progn (setq gdscript-debug--inspector-focused-object-id object-id) (gdscript-debug--show-object-id object-id)) - (error "Not recognized as object-id line")))) + (message "Not recognized as object-id line")))) (defun gdscript-debug--show-object-id (object-id) (if (gethash object-id gdscript-debug--inspected-objects) - (gdscript-debug--refresh-inspector-buffer) + (gdscript-debug--refresh-inspector-buffer object-id) (if gdscript-debug-state (message "Cannot inspect object-id now") (setq gdscript-debug-state :refresh-inspector) @@ -1891,8 +1980,8 @@ calling `gdscript-debug--table-string'." (beginning-of-line) (if-let* ((stack (get-text-property (point) 'gdscript-debug--stack-dump))) (progn (setq gdscript-debug--selected-stack-dump stack) - (gdscript-debug-get-stack-frame-vars (stack-dump->level stack))) - (error "Not recognized as stack-frame line")))) + (gdscript-debug-get-stack-frame-vars (gdscript-stack-dump->level stack))) + (message "Not recognized as stack-frame line")))) (defun gdscript-debug-jump-to-stack-point () (interactive) @@ -1900,14 +1989,14 @@ calling `gdscript-debug--table-string'." (beginning-of-line) (if-let* ((stack-dump (get-text-property (point) 'gdscript-debug--stack-dump)) (project-root (get-text-property (point) 'gdscript-debug--project-root))) - (let* ((file (stack-dump->file stack-dump)) - (line (stack-dump->line stack-dump)) + (let* ((file (gdscript-stack-dump->file stack-dump)) + (line (gdscript-stack-dump->line stack-dump)) (full-file-path (concat project-root (gdscript-debug--drop-res file)))) (with-current-buffer (find-file full-file-path) - (let* ((posns (line-posns line)) + (let* ((posns (gdscript-debug--line-posns line)) (start-posn (car posns))) (goto-char start-posn)))) - (error "Not recognized as stack-frame line")))) + (message "Not recognized as stack-frame line")))) (defun gdscript-debug-go-back () (interactive) @@ -1973,12 +2062,14 @@ calling `gdscript-debug--table-string'." (let ((map (make-sparse-keymap))) (suppress-keymap map) (define-key map "d" 'gdscript-debug-fetch-object-ids-detail) - (define-key map "q" 'kill-current-buffer) - (define-key map "p" 'previous-line) + (define-key map "l" 'gdscript-debug-display-stack-dump-buffer) (define-key map "n" 'next-line) + (define-key map "o" 'gdscript-debug-pin-inspected-object-id) + (define-key map "p" 'previous-line) + (define-key map "q" 'kill-current-buffer) + (define-key map "u" 'gdscript-debug-unpin) (define-key map "\r" 'gdscript-debug-inspect-object-id) (define-key map "\t" 'gdscript-debug-toggle-visibility) - (define-key map "l" 'gdscript-debug-display-stack-dump-buffer) (define-key map "?" 'describe-mode) (define-key map (kbd "C-c n") 'gdscript-debug-hydra) (define-key map (kbd "C-c r") 'gdscript-hydra-show) @@ -1988,12 +2079,14 @@ calling `gdscript-debug--table-string'." (let ((map (make-sparse-keymap))) (suppress-keymap map) (define-key map "d" 'gdscript-debug-fetch-object-ids-detail) - (define-key map "q" 'kill-current-buffer) - (define-key map "p" 'previous-line) + (define-key map "l" 'gdscript-debug-go-back) (define-key map "n" 'next-line) + (define-key map "u" 'gdscript-debug-unpin) + (define-key map "o" 'gdscript-debug-pin-inspected-object-id) + (define-key map "p" 'previous-line) + (define-key map "q" 'kill-current-buffer) (define-key map "\t" 'gdscript-debug-toggle-visibility) (define-key map "\r" 'gdscript-debug-inspect-object-id) - (define-key map "l" 'gdscript-debug-go-back) (define-key map "?" 'describe-mode) (define-key map (kbd "C-c n") 'gdscript-debug-hydra) (define-key map (kbd "C-c r") 'gdscript-hydra-show) @@ -2062,39 +2155,43 @@ In that buffer, `gdscript-debug--buffer-type' must be equal to BUFFER-TYPE." (window-list))) window-to-switch)) +(defun gdscript-debug--stack-dump-file-path (stack-dump) + (concat (cdr gdscript-debug--stack-dump) (gdscript-debug--drop-res (gdscript-stack-dump->file stack-dump)))) + (defun gdscript-debug--set-window-buffer (window stack-dump) - (let ((buffer (find-file-noselect (concat (cdr gdscript-debug--stack-dump) (gdscript-debug--drop-res (stack-dump->file stack-dump)))))) + (let ((buffer (find-file-noselect (gdscript-debug--stack-dump-file-path stack-dump)))) (set-window-buffer window buffer) (with-current-buffer buffer (goto-char (point-min)) - (forward-line (1- (stack-dump->line stack-dump))) - (set-window-point window (point))))) + (forward-line (1- (gdscript-stack-dump->line stack-dump))) + (point)))) (defun gdscript-debug-windows () (delete-other-windows) (gdscript-debug-hydra) (pcase (car gdscript-debug--stack-dump) (`() nil) - (`(,a) + (`(,stack-dump) (let* ((top-left (selected-window)) (bottom-left (split-window)) (bottom-right (split-window bottom-left nil t))) - (set-window-buffer top-left (find-file-noselect (concat (cdr gdscript-debug--stack-dump) (gdscript-debug--drop-res (stack-dump->file a))))) + (set-window-buffer top-left (find-file-noselect (gdscript-debug--stack-dump-file-path stack-dump))) (set-window-buffer bottom-left (gdscript-debug--get-inspector-buffer)) (set-window-buffer bottom-right (gdscript-debug--get-stack-frame-vars-buffer)))) (_ - (let ((a (caar gdscript-debug--stack-dump)) - (b (cadr (car gdscript-debug--stack-dump)))) - (let* ((top-left (selected-window)) - (bottom-left (split-window)) - (top-right (split-window nil nil t)) - (bottom-right (split-window bottom-left nil t))) - - (gdscript-debug--set-window-buffer top-left b) - (gdscript-debug--set-window-buffer top-right a) - (set-window-buffer bottom-left (gdscript-debug--get-inspector-buffer)) - (set-window-buffer bottom-right (gdscript-debug--get-stack-frame-vars-buffer)) - (select-window top-right)))))) + (let* ((stack-dump-a (caar gdscript-debug--stack-dump)) + (stack-dump-b (cadr (car gdscript-debug--stack-dump))) + (top-left (selected-window)) + (bottom-left (split-window)) + (top-right (split-window nil nil t)) + (bottom-right (split-window bottom-left nil t)) + (top-left-point (gdscript-debug--set-window-buffer top-left stack-dump-b)) + (top-right-point (gdscript-debug--set-window-buffer top-right stack-dump-a))) + (set-window-point top-left top-left-point) + (set-window-point top-right top-right-point) + (set-window-buffer bottom-left (gdscript-debug--get-inspector-buffer)) + (set-window-buffer bottom-right (gdscript-debug--get-stack-frame-vars-buffer)) + (select-window top-right))))) (defun gdscript-debug--display-buffer (buffer) (display-buffer buffer @@ -2115,7 +2212,7 @@ In that buffer, `gdscript-debug--buffer-type' must be equal to BUFFER-TYPE." "Display the breakpoints." (interactive) (display-buffer (gdscript-debug--get-breakpoint-buffer) '((display-buffer-same-window))) - (refresh-breakpoints-buffer)) + (gdscript-debug-refresh-breakpoints-buffer)) (defun gdscript-debug-display-inspector-buffer () "Display the inspector." @@ -2136,7 +2233,7 @@ In that buffer, `gdscript-debug--buffer-type' must be equal to BUFFER-TYPE." (defun gdscript-debug--remove-breakpoint-from-buffer (breakpoint) (setq gdscript-debug--breakpoints (remove breakpoint gdscript-debug--breakpoints)) - (refresh-breakpoints-buffer)) + (gdscript-debug-refresh-breakpoints-buffer)) (defun gdscript-debug--add-breakpoint-to-buffer (breakpoint) (unless (member breakpoint gdscript-debug--breakpoints) @@ -2154,17 +2251,17 @@ In that buffer, `gdscript-debug--buffer-type' must be equal to BUFFER-TYPE." (setq gdscript-debug--after-refresh-function nil))))) (defun gdscript-debug--scene-tree-row (scene-tree-level-edge level node-path) - (let* ((node (scene-tree-level-edge->item scene-tree-level-edge)) - (children (scene-tree-level-edge->children scene-tree-level-edge)) - (node-name (scene-tree-node->node-name node)) - (node-class (scene-tree-node->node-class node)) + (let* ((node (gdscript-scene-tree-level-edge->item scene-tree-level-edge)) + (children (gdscript-scene-tree-level-edge->children scene-tree-level-edge)) + (node-name (gdscript-scene-tree-node->node-name node)) + (node-class (gdscript-scene-tree-node->node-class node)) (path (concat node-path "/" node-name))) (insert (propertize (format "%s %s %s %s\n" - (gdscript-debug--pad-string (if children "+" " ") (* 4 level)) - (gdscript-debug--variable-face node-name) - (gdscript-debug--type-face node-class) - (scene-tree-node->instance-id node)) - 'object-id (scene-tree-node->instance-id node) + (gdscript-debug-pad-string (if children "+" " ") (* 4 level)) + (gdscript-debug-variable-face node-name) + (gdscript-debug-type-face node-class) + (gdscript-scene-tree-node->instance-id node)) + 'object-id (gdscript-scene-tree-node->instance-id node) 'node-path path)) (dolist (child children) (gdscript-debug--scene-tree-row child (1+ level) path)))) @@ -2174,23 +2271,23 @@ In that buffer, `gdscript-debug--buffer-type' must be equal to BUFFER-TYPE." (let ((inhibit-read-only t) (longest-file-name 0)) (dolist (stack stack-dump) - (let* ((file (stack-dump->file stack)) - (line (stack-dump->line stack)) + (let* ((file (gdscript-stack-dump->file stack)) + (line (gdscript-stack-dump->line stack)) (len (+ (length file) (length (number-to-string line))))) (when (< longest-file-name len) (setq longest-file-name len)))) (erase-buffer) (dolist (stack stack-dump) - (let ((ident (format "%s:%s" (stack-dump->file stack) (stack-dump->line stack)))) + (let ((ident (format "%s:%s" (gdscript-stack-dump->file stack) (gdscript-stack-dump->line stack)))) (insert (propertize (concat - (format (concat "%s - %-" (number-to-string (1+ longest-file-name)) "s - ") (stack-dump->level stack) ident) + (format (concat "%s - %-" (number-to-string (1+ longest-file-name)) "s - ") (gdscript-stack-dump->level stack) ident) (propertize - (format "%s\n" (stack-dump->function-name stack)) 'font-lock-face font-lock-function-name-face)) + (format "%s\n" (gdscript-stack-dump->function-name stack)) 'font-lock-face font-lock-function-name-face)) 'gdscript-debug--stack-dump stack 'gdscript-debug--project-root project-root))))))) -(defun refresh-breakpoints-buffer () +(defun gdscript-debug-refresh-breakpoints-buffer () (with-current-buffer (gdscript-debug--get-breakpoint-buffer) (let* ((inhibit-read-only t) (window (get-buffer-window (current-buffer) 0)) @@ -2206,8 +2303,8 @@ In that buffer, `gdscript-debug--buffer-type' must be equal to BUFFER-TYPE." font-lock-comment-face)))) (insert (propertize (format "%s%s:%s\n" indicator - (breakpoint->file breakpoint) - (breakpoint->line breakpoint)) + (gdscript-breakpoint->file breakpoint) + (gdscript-breakpoint->line breakpoint)) 'gdscript-debug--breakpoint breakpoint)))) (set-window-start window start) ;; Forces fringe icons to refresh (set-window-point window p)))) @@ -2302,7 +2399,7 @@ In that buffer, `gdscript-debug--buffer-type' must be equal to BUFFER-TYPE." ;; Don't signal an error when hydra.el is not present (defhydra gdscript-debug--hydra (:hint none) " -_n_ next _c_ continue _m_ step _b_ breakpoints _s_ stack _v_ vars _i_ inspector _t_ scene-tree _d_ details _q_ quit +_n_ next _c_ continue _m_ step _b_ breakpoints _s_ stack _v_ vars _i_ inspector _t_ scene-tree _d_ details _o_ pin _u_ unpin _q_ quit " ("n" (gdscript-debug-next)) ("c" (gdscript-debug-continue)) @@ -2313,6 +2410,8 @@ _n_ next _c_ continue _m_ step _b_ breakpoints _s_ stack _v_ vars _i_ inspector ("i" (gdscript-debug-display-inspector-buffer)) ("t" (gdscript-debug-request-scene-tree)) ("d" (gdscript-debug-fetch-object-ids-detail)) + ("o" (gdscript-debug-pin-current-self)) + ("u" (gdscript-debug-unpin)) ("q" nil))) (defun gdscript-debug-hydra () diff --git a/gdscript-godot.el b/gdscript-godot.el index b0d87b9..46fc2ed 100644 --- a/gdscript-godot.el +++ b/gdscript-godot.el @@ -76,8 +76,8 @@ The output of the process will be provided in a buffer named (unless (get-process (gdscript-debug-process-name (gdscript-util--find-project-configuration-file))) (gdscript-debug-make-server)) (push (mapconcat (lambda (breakpoint) - (let ((file (breakpoint->file breakpoint)) - (line (breakpoint->line breakpoint))) + (let ((file (gdscript-breakpoint->file breakpoint)) + (line (gdscript-breakpoint->line breakpoint))) (format "%s:%s" file line))) gdscript-debug--breakpoints ",") args) (push "--breakpoints" args) (push (format "127.0.0.1:%s" gdscript-debug-port) args)