luaedit/LuaEdit/Watch.pas

unit Watch;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, ValEdit, ComCtrls, Menus, StdCtrls, ExtCtrls, SynEdit,
  JvComponent, JvDockControlForm, JvDragDrop, VirtualTrees, ActiveX,
  ImgList, ToolWin;

const
  // Helper message to decouple node change handling from edit handling.
  WM_STARTEDITING = WM_USER + 778;

type
  PWatchNodeData = ^TWatchNodeData;
  TWatchNodeData = record
    Value: String;
    Name: String;
    NestedTableCount: Integer;
    ToKeep: Boolean;
  end;

  // Our own edit link to implement several different node editors.
  TEditLinker = class(TInterfacedObject, IVTEditLink)
  private
    FTree: TVirtualStringTree; // A back reference to the tree calling.
    FNode: PVirtualNode;       // The node being edited.
    FColumn: Integer;          // The column of the node being edited.
  public
    constructor Create;
    destructor Destroy; override;

    function BeginEdit: Boolean; stdcall;
    function CancelEdit: Boolean; stdcall;
    function EndEdit: Boolean; stdcall;
    function GetBounds: TRect; stdcall;
    function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
    procedure SetBounds(R: TRect); stdcall;
    procedure ProcessMessage(var Message: TMessage); stdcall;
  end;

  TfrmWatch = class(TForm)
    ppmWatch: TPopupMenu;
    memoSwap: TMemo;
    JvDockClient1: TJvDockClient;
    vstWatch: TVirtualStringTree;
    tblWatch: TToolBar;
    tbtnAddWatch: TToolButton;
    ToolButton1: TToolButton;
    tbtnRefreshWatch: TToolButton;
    FEdit: TEdit;
    tbtnDelete: TToolButton;
    DeleteSelectedItem1: TMenuItem;
    N1: TMenuItem;
    Refresh1: TMenuItem;
    AddWatch1: TMenuItem;
    N2: TMenuItem;
    ExpandAll1: TMenuItem;
    CollapseAll1: TMenuItem;
    Expand1: TMenuItem;
    Collapse1: TMenuItem;
    N3: TMenuItem;
    procedure vstWatchGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
    procedure vstWatchEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
    procedure vstWatchCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
    procedure vstWatchGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
    procedure vstWatchAfterItemPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect);
    procedure vstWatchDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
    procedure vstWatchDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
    procedure tbtnRefreshWatchClick(Sender: TObject);
    procedure tbtnAddWatchClick(Sender: TObject);
    procedure vstWatchEdited(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
    procedure vstWatchChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure FEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure vstWatchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure DeleteSelected();
    procedure tbtnDeleteClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AddWatch1Click(Sender: TObject);
    procedure Refresh1Click(Sender: TObject);
    procedure DeleteSelectedItem1Click(Sender: TObject);
    procedure Expand1Click(Sender: TObject);
    procedure Collapse1Click(Sender: TObject);
    procedure ExpandAll1Click(Sender: TObject);
    procedure CollapseAll1Click(Sender: TObject);
    procedure vstWatchMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure vstWatchDblClick(Sender: TObject);
  private
    { Private declarations }
    procedure WMStartEditing(var Message: TMessage); message WM_STARTEDITING;
  public
    { Public declarations }
  end;

var
  frmWatch: TfrmWatch;

implementation

uses Main, Types;

{$R *.dfm}

////////////////////////////////////// TEditLinker implementation //////////////////////////////////////

constructor TEditLinker.Create;
begin
  FTree := nil;
  FNode := nil;
  FColumn := 0;
end;

destructor TEditLinker.Destroy;

begin
  // nothing for now...
  inherited;
end;

function TEditLinker.BeginEdit: Boolean;
begin
  Result := True;
  frmWatch.FEdit.Show;
  frmWatch.FEdit.SetFocus;
end;

function TEditLinker.CancelEdit: Boolean;
begin
  Result := True;
  frmWatch.FEdit.Hide;
end;

function TEditLinker.EndEdit: Boolean;
var
  Data: PWatchNodeData;
  S: String;
begin
  Result := True;

  Data := FTree.GetNodeData(FNode);
  S := frmWatch.FEdit.Text;

  if S <> Data.Name then
  begin
    Data.Name := S;
    FTree.InvalidateNode(FNode);
  end;

  frmWatch.FEdit.Hide;
  frmWatch.tbtnDelete.Enabled := True;
  frmWatch.DeleteSelectedItem1.Enabled := True;
  FTree.SetFocus;
end;

procedure TEditLinker.SetBounds(R: TRect);
var
  Dummy: Integer;
begin
  // Since we don't want to activate grid extensions in the tree (this would influence how the selection is drawn)
  // we have to set the edit's width explicitly to the width of the column.
  FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right);
  frmWatch.FEdit.BoundsRect := R;
end;

function TEditLinker.GetBounds: TRect;
begin
  Result := frmWatch.FEdit.BoundsRect;
end;

function TEditLinker.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
var
  Data: PWatchNodeData;
begin
  Result := True;
  FTree := Tree as TVirtualStringTree;
  FNode := Node;
  FColumn := Column;
    
  Data := FTree.GetNodeData(Node);
  frmWatch.tbtnDelete.Enabled := False;
  frmWatch.DeleteSelectedItem1.Enabled := False;

  with frmWatch.FEdit do
  begin
    Visible := False;
    Parent := FTree;
    AutoSize := False;
    MaxLength := 1000;
    Ctl3D := False;
    Text := Data.Name;
  end;
end;

procedure TEditLinker.ProcessMessage(var Message: TMessage);
begin
  frmWatch.FEdit.WindowProc(Message);
end;

////////////////////////////////////// TfrmWatch implementation //////////////////////////////////////

procedure TfrmWatch.vstWatchCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
begin
  // Create the editor class wich will interact with the user when editing a variable name
  EditLink := TEditLinker.Create;
end;

// This is called whenever the tree needs to get the text for the current cell
procedure TfrmWatch.vstWatchGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
var
  pData: PWatchNodeData;
begin
  if TextType = ttNormal then
  begin
    case Column of
      0:
      begin
        pData := Sender.GetNodeData(Node);
        CellText := pData.Name;
      end;
      1:
      begin
        pData := Sender.GetNodeData(Node);
        CellText := pData.Value;
      end;
    end;
  end;
end;

procedure TfrmWatch.vstWatchEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
  Allowed := ((Column = 0) and (Node.Parent = Sender.RootNode));
end;

procedure TfrmWatch.vstWatchGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(TWatchNodeData);
end;

procedure TfrmWatch.vstWatchAfterItemPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect);
var
  pRect: TRect;
begin
  pRect := ItemRect;
  pRect.Bottom := pRect.Bottom - 1;
  pRect.Right := pRect.Left + 22;
  TargetCanvas.Brush.Color := clWhite;
  TargetCanvas.FillRect(pRect);

  // Draw node button since the noda has some child
  if ((Node.Parent = Sender.RootNode) and (Node.ChildCount <> 0)) then
  begin
    // Draw the frame around the button
    TargetCanvas.Pen.Color := clBtnShadow;
    TargetCanvas.Rectangle(5, 4, 14, 13);
    TargetCanvas.MoveTo(14, 8);
    TargetCanvas.LineTo(20, 8);
    TargetCanvas.Pen.Color := clBlack;

    if not (vsExpanded in Node.States) then
    begin
      // Draw expandable node button (plus sign)
      TargetCanvas.MoveTo(7, 8);
      TargetCanvas.LineTo(12, 8);
      TargetCanvas.MoveTo(9, 6);
      TargetCanvas.LineTo(9, 11);
    end
    else
    begin
      // Draw non-expandable node button (minus sign)
      TargetCanvas.MoveTo(7, 8);
      TargetCanvas.LineTo(12, 8);
    end;
  end;
end;

procedure TfrmWatch.vstWatchDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
  pNode: PVirtualNode;
  pData: PWatchNodeData;
begin
  // Only works over the list view lvwWatch
  if ((Sender = vstWatch) and (TSynEdit(Source).SelText <> ''))then
  begin
    pNode := Sender.AddChild(Sender.RootNode);
    pData := Sender.GetNodeData(pNode);
    pData.Name := TSynEdit(Source).SelText;
    frmLuaEditMain.PrintWatch(frmLuaEditMain.LuaState);
  end;
end;

procedure TfrmWatch.vstWatchDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
  Accept := (Source is TSynEdit);
end;

procedure TfrmWatch.tbtnRefreshWatchClick(Sender: TObject);
begin
  frmLuaEditMain.PrintWatch(frmLuaEditMain.LuaState);
end;

procedure TfrmWatch.tbtnAddWatchClick(Sender: TObject);
begin
  frmLuaEditMain.DoAddWatchExecute;
end;

procedure TfrmWatch.vstWatchEdited(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
begin
  frmLuaEditMain.PrintWatch(frmLuaEditMain.LuaState);
end;

procedure TfrmWatch.WMStartEditing(var Message: TMessage);
// This message was posted by ourselves from the node change handler above to decouple that change event and our
// intention to start editing a node. This is necessary to avoid interferences between nodes editors potentially created
// for an old edit action and the new one we start here.
var
  Node: PVirtualNode;
begin
  Node := Pointer(Message.WParam);
  // Note: the test whether a node can really be edited is done in the OnEditing event.
  vstWatch.EditNode(Node, 1);
end;

procedure TfrmWatch.vstWatchChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
  with Sender do
  begin
    if Assigned(Node) then
    begin
      tbtnDelete.Enabled := (Node.Parent = RootNode);
      DeleteSelectedItem1.Enabled := (Node.Parent = RootNode);
      Expand1.Enabled := (Node.ChildCount > 0);
      ExpandAll1.Enabled := (Node.ChildCount > 0);
      Collapse1.Enabled := (Node.ChildCount > 0);
      CollapseAll1.Enabled := (Node.ChildCount > 0);
    end
    else
    begin
      tbtnDelete.Enabled := False;
      DeleteSelectedItem1.Enabled := False;
      Expand1.Enabled := False;
      ExpandAll1.Enabled := False;
      Collapse1.Enabled := False;
      CollapseAll1.Enabled := False;
    end;

    // Start immediate editing as soon as another node gets focused.
    if Assigned(Node) and (Node.Parent <> RootNode) then
    begin
      // We want to start editing the currently selected node. However it might well happen that this change event
      // here is caused by the node editor if another node is currently being edited. It causes trouble
      // to start a new edit operation if the last one is still in progress. So we post us a special message and
      // in the message handler we then can start editing the new node. This works because the posted message
      // is first executed *after* this event and the message, which triggered it is finished.
      PostMessage(Self.Handle, WM_STARTEDITING, Integer(Node), 0);
    end;
  end;
end;

procedure TfrmWatch.FEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  CanAdvance: Boolean;
begin
  CanAdvance := True;

  case Key of
    VK_ESCAPE:
      if CanAdvance then
      begin
        vstWatch.CancelEditNode;
        Key := 0;
      end;
    VK_RETURN:
      if CanAdvance then
      begin
        vstWatch.EndEditNode;
        Key := 0;
      end;

    VK_UP,
    VK_DOWN:
      begin
        // Consider special cases before finishing edit mode.
        CanAdvance := Shift = [];

        if CanAdvance then
        begin
          // Forward the keypress to the tree. It will asynchronously change the focused node.
          PostMessage(vstWatch.Handle, WM_KEYDOWN, Key, 0);
          Key := 0;
        end;
      end;
  end;
end;

procedure TfrmWatch.vstWatchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if not vstWatch.IsEditing then
  begin
    // Seek delete key for node deletion
    if Key = VK_DELETE then
      DeleteSelected;
  end;
end;

procedure TfrmWatch.DeleteSelected();
begin
  if Assigned(vstWatch.GetFirstSelected()) then
    vstWatch.DeleteNode(vstWatch.GetFirstSelected());
end;

procedure TfrmWatch.tbtnDeleteClick(Sender: TObject);
begin
  DeleteSelected;
end;

procedure TfrmWatch.FormCreate(Sender: TObject);
begin
  tbtnDelete.Enabled := False;
  DeleteSelectedItem1.Enabled := False;
  Expand1.Enabled := False;
  ExpandAll1.Enabled := False;
  Collapse1.Enabled := False;
  CollapseAll1.Enabled := False;
end;

procedure TfrmWatch.AddWatch1Click(Sender: TObject);
begin
  tbtnAddWatch.Click;
end;

procedure TfrmWatch.Refresh1Click(Sender: TObject);
begin
  tbtnRefreshWatch.Click;
end;

procedure TfrmWatch.DeleteSelectedItem1Click(Sender: TObject);
begin
  tbtnDelete.Click;
end;

procedure TfrmWatch.Expand1Click(Sender: TObject);
begin
  if Assigned(vstWatch.GetFirstSelected()) then
    vstWatch.Expanded[vstWatch.GetFirstSelected] := True;
end;

procedure TfrmWatch.Collapse1Click(Sender: TObject);
begin
  if Assigned(vstWatch.GetFirstSelected()) then
    vstWatch.Expanded[vstWatch.GetFirstSelected] := False;
end;

procedure TfrmWatch.ExpandAll1Click(Sender: TObject);
begin
  if Assigned(vstWatch.GetFirstSelected()) then
    vstWatch.FullExpand(vstWatch.GetFirstSelected());
end;

procedure TfrmWatch.CollapseAll1Click(Sender: TObject);
begin
  if Assigned(vstWatch.GetFirstSelected()) then
    vstWatch.FullCollapse(vstWatch.GetFirstSelected());
end;

procedure TfrmWatch.vstWatchMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(vstWatch.GetFirstSelected()) then
  begin
    Expand1.Enabled := (vstWatch.GetFirstSelected().ChildCount > 0);
    ExpandAll1.Enabled := (vstWatch.GetFirstSelected().ChildCount > 0);
    Collapse1.Enabled := (vstWatch.GetFirstSelected().ChildCount > 0);
    CollapseAll1.Enabled := (vstWatch.GetFirstSelected().ChildCount > 0);
  end;
end;

procedure TfrmWatch.vstWatchDblClick(Sender: TObject);
begin
  if Assigned(vstWatch.GetFirstSelected()) then
  begin
    // todo: Allow Variable Inspection...
  end;
end;

end.