Extended QueryForm with grid for match captures

* query form no longer clones the tree, otherwise selecting a matched
  node in the main form would not work since the nodes are not
  considered equal if they come from a different tree
* main form notifies query form about tree deletion which resets GUI
* selecting a match capture selects the captured node in the main form
* new alias for capture, dynamic capture array and record helper for
  TTSQueryMatch returning a dynamic capture array

Author: modersohn

TreeSitter.Query.pas

@@ -36,8 +36,15 @@   TTSQuery = class
     property Query: PTSQuery read FQuery;
   end;
 
+  TTSQueryCapture = TreeSitterLib.TSQueryCapture;
+  TTSQueryCaptureArray = array of TTSQueryCapture;
+
   TTSQueryMatch = TreeSitterLib.TSQueryMatch;
 
+  TTSQueryMatchHelper = record helper for TTSQueryMatch
+    function CapturesArray: TTSQueryCaptureArray;
+  end;
+
   TTSQueryCursor = class
   strict private
     FQueryCursor: PTSQueryCursor;
@@ -196,4 +203,13 @@ procedure TTSQueryCursor.SetMaxStartDepth(AMaxStartDepth: UInt32);
   ts_query_cursor_set_max_start_depth(FQueryCursor, AMaxStartDepth);
 end;
 
+{ TTSQueryMatchHelper }
+
+function TTSQueryMatchHelper.CapturesArray: TTSQueryCaptureArray;
+begin
+  SetLength(Result, capture_count);
+  if capture_count > 0 then
+    Move(captures[0], Result[0], capture_count * SizeOf(captures[0]));
+end;
+
 end.

VCLDemo/frmDTSMain.pas

@@ -324,16 +324,20 @@ procedure TDTSMainForm.ParseContent;
 begin
   treeView.Items.Clear;
   sCode:= memCode.Lines.Text;
+  if DTSQueryForm <> nil then
+    DTSQueryForm.TreeDeleted;
+  FreeAndNil(FTree);
   if Length(sCode) = 0 then
     Exit; //avoid our own exception that empty string cannot be parsed
   //we no longer pass OldTree as we would need to track editing and call
   //ts_tree_edit
-  FreeAndNil(FTree);
   FTree:= FParser.ParseString(sCode);
   root:= FTree.RootNode;
   rootNode:= TTSTreeViewNode(treeView.Items.AddChild(nil, root.NodeType));
   rootNode.SetupTSNode(root);
   FEditChanged:= False;
+  if DTSQueryForm <> nil then
+    DTSQueryForm.NewTreeGenerated(FTree);
 end;
 
 procedure TDTSMainForm.SetSelectedTSNode(const Value: TTSNode);

VCLDemo/frmDTSQuery.dfm

@@ -3,7 +3,7 @@ object DTSQueryForm: TDTSQueryForm
   Top = 0
   Caption = 'Query'
   ClientHeight = 441
-  ClientWidth = 624
+  ClientWidth = 764
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
@@ -16,7 +16,7 @@ object DTSQueryForm: TDTSQueryForm
   object Splitter1: TSplitter
     Left = 0
     Top = 250
-    Width = 624
+    Width = 764
     Height = 3
     Cursor = crVSplit
     Align = alTop
@@ -34,7 +34,7 @@ object DTSQueryForm: TDTSQueryForm
   object pnlTop: TPanel
     Left = 0
     Top = 0
-    Width = 624
+    Width = 764
     Height = 50
     Align = alTop
     BevelOuter = bvNone
@@ -58,7 +58,7 @@ object DTSQueryForm: TDTSQueryForm
   object memQuery: TMemo
     Left = 0
     Top = 50
-    Width = 624
+    Width = 764
     Height = 200
     Align = alTop
     Font.Charset = DEFAULT_CHARSET
@@ -115,4 +115,62 @@ object DTSQueryForm: TDTSQueryForm
       TabOrder = 1
     end
   end
+  object pnlMatches: TPanel
+    Left = 353
+    Top = 253
+    Width = 411
+    Height = 188
+    Align = alClient
+    BevelOuter = bvNone
+    TabOrder = 3
+    object pnlMatchesTop: TPanel
+      Left = 0
+      Top = 0
+      Width = 411
+      Height = 41
+      Align = alTop
+      BevelOuter = bvNone
+      TabOrder = 0
+      object lblMatch: TLabel
+        Left = 219
+        Top = 13
+        Width = 3
+        Height = 15
+      end
+      object btnMatchStart: TButton
+        Left = 9
+        Top = 9
+        Width = 120
+        Height = 25
+        Caption = 'Start query cursor'
+        Enabled = False
+        TabOrder = 0
+        OnClick = btnMatchStartClick
+      end
+      object btnMatchNext: TButton
+        Left = 132
+        Top = 9
+        Width = 75
+        Height = 25
+        Caption = 'Next match'
+        Enabled = False
+        TabOrder = 1
+        OnClick = btnMatchNextClick
+      end
+    end
+    object sgMatchCaptures: TStringGrid
+      Left = 0
+      Top = 41
+      Width = 411
+      Height = 147
+      Align = alClient
+      ColCount = 2
+      DefaultColWidth = 120
+      DefaultRowHeight = 18
+      RowCount = 1
+      FixedRows = 0
+      TabOrder = 1
+      OnSelectCell = sgMatchCapturesSelectCell
+    end
+  end
 end

VCLDemo/frmDTSQuery.pas

@@ -20,16 +20,31 @@   TDTSQueryForm = class(TForm)
     cbPatternIdx: TComboBox;
     sgPredicateSteps: TStringGrid;
     Splitter2: TSplitter;
+    pnlMatches: TPanel;
+    pnlMatchesTop: TPanel;
+    sgMatchCaptures: TStringGrid;
+    btnMatchStart: TButton;
+    btnMatchNext: TButton;
+    lblMatch: TLabel;
     procedure btnExecuteClick(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
     procedure cbPatternIdxClick(Sender: TObject);
+    procedure btnMatchStartClick(Sender: TObject);
+    procedure btnMatchNextClick(Sender: TObject);
+    procedure sgMatchCapturesSelectCell(Sender: TObject; ACol, ARow: Integer;
+      var CanSelect: Boolean);
   private
     FTree: TTSTree;
     FQuery: TTSQuery;
     FQueryCursor: TTSQueryCursor;
+    FCurrentMatch: TTSQueryMatch;
+    procedure ClearQuery;
+    procedure ClearMatches;
+    procedure ClearPredicates;
   public
-    { Public declarations }
+    procedure TreeDeleted;
+    procedure NewTreeGenerated(ATree: TTSTree);
   end;
 
 var
@@ -39,6 +54,9 @@ procedure ShowQueryForm(ATree: TTSTree);
 
 implementation
 
+uses
+  Math, frmDTSMain;
+
 {$R *.dfm}
 
 procedure ShowQueryForm(ATree: TTSTree);
@@ -47,7 +65,7 @@ procedure ShowQueryForm(ATree: TTSTree);
   begin
     Application.Createform(TDTSQueryForm, DTSQueryForm);
   end;
-  DTSQueryForm.FTree:= ATree.Clone;
+  DTSQueryForm.FTree:= ATree;
   DTSQueryForm.cbPatternIdxClick(nil);
   DTSQueryForm.Show;
   DTSQueryForm.BringToFront;
@@ -64,8 +82,8 @@ procedure TDTSQueryForm.btnExecuteClick(Sender: TObject);
   errorType: TTSQueryError;
   i: Integer;
 begin
-  cbPatternIdx.Items.Clear;
-  FreeAndNil(FQuery);
+  ClearQuery;
+
   FQuery:= TTSQuery.Create(FTree.Language, memQuery.Lines.Text, errorOffset, errorType);
   if errorType <> TTSQueryError.TSQueryErrorNone then
   begin
@@ -80,12 +98,50 @@ procedure TDTSQueryForm.btnExecuteClick(Sender: TObject);
       [FQuery.PatternCount, FQuery.CaptureCount, FQuery.StringCount]);
     for i:= 0 to FQuery.PatternCount - 1 do
       cbPatternIdx.Items.Add(IntToStr(i));
+    btnMatchStart.Enabled:= True;
   end;
   if cbPatternIdx.Items.Count > 0 then
     cbPatternIdx.ItemIndex:= 0;
   cbPatternIdxClick(nil);
 end;
 
+procedure TDTSQueryForm.btnMatchNextClick(Sender: TObject);
+var
+  i: Integer;
+  captures: TTSQueryCaptureArray;
+begin
+  if not FQueryCursor.NextMatch(FCurrentMatch) then
+  begin
+    ClearMatches;
+    lblMatch.Caption:= 'No more matches';
+    Exit;
+  end;
+  lblMatch.Caption:= Format('Match id = %d, pattern idx = %d', [FCurrentMatch.id, FCurrentMatch.pattern_index]);
+
+  captures:= FCurrentMatch.CapturesArray;
+  sgMatchCaptures.RowCount:= Length(captures) + 1;
+  sgMatchCaptures.FixedRows:= 1;
+  for i:= 0 to FCurrentMatch.capture_count - 1 do
+  begin
+    sgMatchCaptures.Cells[0, i + 1]:= IntToStr(captures[i].index);
+    sgMatchCaptures.Cells[1, i + 1]:= captures[i].node.NodeType;
+  end;
+  if InRange(sgMatchCaptures.Selection.Top, 1, Length(captures)) then
+    DTSMainForm.SelectedTSNode:= captures[sgMatchCaptures.Selection.Top - 1].node;
+end;
+
+procedure TDTSQueryForm.btnMatchStartClick(Sender: TObject);
+begin
+  if FQueryCursor = nil then
+    FQueryCursor:= TTSQueryCursor.Create;
+  FQueryCursor.Execute(FQuery, FTree.RootNode);
+  ClearMatches;
+  sgMatchCaptures.Cells[0, 0]:= 'Capture index';
+  sgMatchCaptures.Cells[1, 0]:= 'Node';
+  btnMatchNext.Enabled:= True;
+  btnMatchNextClick(nil);
+end;
+
 procedure TDTSQueryForm.cbPatternIdxClick(Sender: TObject);
 const
   stepTypeStrings: array[TTSQueryPredicateStepType] of string = (
@@ -131,6 +187,28 @@ procedure TDTSQueryForm.cbPatternIdxClick(Sender: TObject);
   end;
 end;
 
+procedure TDTSQueryForm.ClearMatches;
+begin
+  sgMatchCaptures.RowCount:= 1;
+  lblMatch.Caption:= '';
+  btnMatchNext.Enabled:= False;
+end;
+
+procedure TDTSQueryForm.ClearPredicates;
+begin
+  cbPatternIdx.Items.Clear;
+  sgPredicateSteps.RowCount:= 1;
+end;
+
+procedure TDTSQueryForm.ClearQuery;
+begin
+  FreeAndNil(FQuery);
+  btnMatchStart.Enabled:= False;
+  lblQueryState.Caption:= '';
+  ClearPredicates;
+  ClearMatches;
+end;
+
 procedure TDTSQueryForm.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
   Action:= caFree;
@@ -140,9 +218,32 @@ procedure TDTSQueryForm.FormDestroy(Sender: TObject);
 begin
   FreeAndNil(FQueryCursor);
   FreeAndNil(FQuery);
-  FreeAndNil(FTree);
+  //FTree is no longer a clone/copy but identical to main form, otherwise
+  //finding the node in the main forms tree would not work
+  //(nodes belowing to different trees are not considered equal)
+  FTree:= nil;
   if Self = DTSQueryForm then
     DTSQueryForm:= nil;
 end;
 
+procedure TDTSQueryForm.NewTreeGenerated(ATree: TTSTree);
+begin
+  ClearQuery;
+  FTree:= ATree;
+end;
+
+procedure TDTSQueryForm.sgMatchCapturesSelectCell(Sender: TObject; ACol,
+  ARow: Integer; var CanSelect: Boolean);
+begin
+  if not InRange(ARow, 1, FCurrentMatch.capture_count) then
+    Exit;
+
+  DTSMainForm.SelectedTSNode:= FCurrentMatch.captures[ARow - 1].node;
+end;
+
+procedure TDTSQueryForm.TreeDeleted;
+begin
+  ClearQuery;
+end;
+
 end.