* Some fixes and improvements: refresh tree

This commit is contained in:
Michael Van Canneyt 2024-08-01 18:10:24 +02:00
parent 09a24f2b17
commit 01a49fbe68
3 changed files with 71 additions and 19 deletions

View File

@ -61,12 +61,15 @@ type
private private
FBuilder: THTMLTreeBuilder; FBuilder: THTMLTreeBuilder;
FCaption: String; FCaption: String;
FOnRefresh: TNotifyEvent;
FOptions: TOTOptions; FOptions: TOTOptions;
FParentElement, FParentElement,
FCaptionElement : TJSHTMLElement; FCaptionElement : TJSHTMLElement;
FRootObjectID: Integer;
function GetOnObjectSelected: TObjectSelectedEvent; function GetOnObjectSelected: TObjectSelectedEvent;
function GetParentElement: TJSHTMLElement; function GetParentElement: TJSHTMLElement;
function GetParentElementID: String; function GetParentElementID: String;
procedure HandleRefresh(aEvent: TJSEvent);
procedure SetCaption(AValue: String); procedure SetCaption(AValue: String);
procedure SetOnObjectSelected(AValue: TObjectSelectedEvent); procedure SetOnObjectSelected(AValue: TObjectSelectedEvent);
procedure SetOptions(AValue: TOTOptions); procedure SetOptions(AValue: TOTOptions);
@ -87,6 +90,8 @@ type
Property OnObjectSelected : TObjectSelectedEvent Read GetOnObjectSelected Write SetOnObjectSelected; Property OnObjectSelected : TObjectSelectedEvent Read GetOnObjectSelected Write SetOnObjectSelected;
Property Caption : String Read FCaption Write SetCaption; Property Caption : String Read FCaption Write SetCaption;
Property Options : TOTOptions Read FOptions Write SetOptions; Property Options : TOTOptions Read FOptions Write SetOptions;
Property OnRefresh : TNotifyEvent Read FOnRefresh Write FOnRefresh;
Property RootObjectID : Integer Read FRootObjectID;
end; end;
TPropDataFlag = (pdfNoValue,pdfError); TPropDataFlag = (pdfNoValue,pdfError);
@ -316,6 +321,12 @@ begin
Result:=''; Result:='';
end; end;
procedure THTMLObjectTree.HandleRefresh(aEvent: TJSEvent);
begin
If Assigned(FOnRefresh) then
FOnRefresh(Self);
end;
procedure THTMLObjectTree.SetCaption(AValue: String); procedure THTMLObjectTree.SetCaption(AValue: String);
begin begin
if FCaption=AValue then Exit; if FCaption=AValue then Exit;
@ -345,17 +356,24 @@ end;
function THTMLObjectTree.BuildWrapper(aParent : TJSHTMLElement) : TJSHTMLElement; function THTMLObjectTree.BuildWrapper(aParent : TJSHTMLElement) : TJSHTMLElement;
var var
DW,DC,DT : TJSHTMLElement; RI,SC,DW,DC,DT : TJSHTMLElement;
begin begin
aParent.InnerHTML:=''; aParent.InnerHTML:='';
DC:=TJSHTMLElement(document.createElement('div')); DC:=TJSHTMLElement(document.createElement('div'));
DC.className:='ot-caption'; DC.className:='ot-caption';
SC:=TJSHTMLElement(document.createElement('span'));
DC.AppendChild(SC);
RI:=TJSHTMLElement(document.createElement('div'));
RI.className:='ot-icon-btn';
RI.InnerHTML:='&#x27F3';
RI.AddEventListener('click',@HandleRefresh);
DC.AppendChild(RI);
aParent.AppendChild(DC); aParent.AppendChild(DC);
FCaptionElement:=DC; FCaptionElement:=SC;
if Not (otShowCaption in Options) then if Not (otShowCaption in Options) then
DC.classList.Add('ot-hidden'); DC.classList.Add('ot-hidden');
RenderCaption(DC); RenderCaption(SC);
DT:=TJSHTMLElement(document.createElement('div')); DT:=TJSHTMLElement(document.createElement('div'));
DT.className:='ot-tree'; DT.className:='ot-tree';
aParent.AppendChild(DT); aParent.AppendChild(DT);
@ -409,12 +427,16 @@ begin
if aParentID<>0 then if aParentID<>0 then
lParent:=FBuilder.FindObjectItem(aParentID) lParent:=FBuilder.FindObjectItem(aParentID)
else else
begin
lParent:=Nil; lParent:=Nil;
FRootObjectID:=AID;
end;
FBuilder.AddItem(lParent,aCaption,aID); FBuilder.AddItem(lParent,aCaption,aID);
end; end;
procedure THTMLObjectTree.Clear; procedure THTMLObjectTree.Clear;
begin begin
FRootObjectID:=0;
FBuilder.Clear; FBuilder.Clear;
end; end;
@ -711,6 +733,7 @@ begin
DC:=TJSHTMLElement(Document.createElement('div')); DC:=TJSHTMLElement(Document.createElement('div'));
DC.className:='oi-caption'; DC.className:='oi-caption';
CS:=TJSHTMLElement(Document.createElement('span')); CS:=TJSHTMLElement(Document.createElement('span'));
CS.className:='oi-caption-lbl';
DC.AppendChild(CS); DC.AppendChild(CS);
RenderCaption(CS); RenderCaption(CS);
Result.AppendChild(DC); Result.AppendChild(DC);

View File

@ -34,15 +34,19 @@ type
TWasmObjectInspectorApi = class(TImportExtension) TWasmObjectInspectorApi = class(TImportExtension)
private private
FHandleObjectSelection: Boolean; FHandleObjectSelection: Boolean;
FHandleRefresh: Boolean;
FInspector: THTMLObjectInspector; FInspector: THTMLObjectInspector;
FLogAPICalls: Boolean; FLogAPICalls: Boolean;
FObjectTree: THTMLObjectTree; FObjectTree: THTMLObjectTree;
procedure DoRefreshTree(Sender: TObject);
procedure DoSelectObject(Sender: TObject; aObjectId: Integer); procedure DoSelectObject(Sender: TObject; aObjectId: Integer);
procedure RaiseOILastError(const aOperation: String); procedure RaiseOILastError(const aOperation: String);
procedure SetHandleHandleRefresh(AValue: Boolean);
procedure SetHandleObjectSelection(AValue: Boolean); procedure SetHandleObjectSelection(AValue: Boolean);
procedure SetInspector(AValue: THTMLObjectInspector); procedure SetInspector(AValue: THTMLObjectInspector);
procedure SetLogAPICalls(AValue: Boolean); procedure SetLogAPICalls(AValue: Boolean);
procedure SetObjectTree(AValue: THTMLObjectTree); procedure SetObjectTree(AValue: THTMLObjectTree);
procedure ShowObjectTree(aObjectID: Integer);
protected protected
procedure Logcall(Const aMsg : string); procedure Logcall(Const aMsg : string);
procedure LogCall(Const aFmt : string; aArgs : Array of const); procedure LogCall(Const aFmt : string; aArgs : Array of const);
@ -58,7 +62,6 @@ type
function TreeAddObject(aInspectorID: TInspectorID; ObjectData : PObjectData): TWasmOIResult; function TreeAddObject(aInspectorID: TInspectorID; ObjectData : PObjectData): TWasmOIResult;
function TreeClear(aInspectorID: TInspectorID) : TWasmOIResult; function TreeClear(aInspectorID: TInspectorID) : TWasmOIResult;
Procedure HookObjectTree; Procedure HookObjectTree;
Procedure UnhookObjectTree;
Function GetTree(aInspectorID : TInspectorID) : THTMLObjectTree; Function GetTree(aInspectorID : TInspectorID) : THTMLObjectTree;
Function GetInspector(aInspectorID : TInspectorID) : THTMLObjectInspector; Function GetInspector(aInspectorID : TInspectorID) : THTMLObjectInspector;
Public Public
@ -69,6 +72,7 @@ type
Property DefaultObjectTree : THTMLObjectTree Read FObjectTree Write SetObjectTree; Property DefaultObjectTree : THTMLObjectTree Read FObjectTree Write SetObjectTree;
property DefaultInspector : THTMLObjectInspector Read FInspector Write SetInspector; property DefaultInspector : THTMLObjectInspector Read FInspector Write SetInspector;
Property HandleObjectSelection : Boolean Read FHandleObjectSelection Write SetHandleObjectSelection; Property HandleObjectSelection : Boolean Read FHandleObjectSelection Write SetHandleObjectSelection;
Property HandleTreeRefresh : Boolean Read FHandleRefresh Write SetHandleHandleRefresh;
property LogAPICalls : Boolean read FLogAPICalls write SetLogAPICalls; property LogAPICalls : Boolean read FLogAPICalls write SetLogAPICalls;
end; end;
@ -78,6 +82,7 @@ uses rtti;
type type
TGetObjectProperties = function(aInspectorID : TInspectorID; aObjectID : TObjectID; aFlags : Longint) : Longint; TGetObjectProperties = function(aInspectorID : TInspectorID; aObjectID : TObjectID; aFlags : Longint) : Longint;
TGetObjectTree = function(aInspectorID : TInspectorID; aObjectID : TObjectID; aFlags : Longint) : Longint;
{ TWasmObjectInspectorApi } { TWasmObjectInspectorApi }
@ -101,8 +106,7 @@ begin
FObjectTree:=AValue; FObjectTree:=AValue;
if assigned(FObjectTree) then if assigned(FObjectTree) then
FObjectTree.Clear; FObjectTree.Clear;
if FHandleObjectSelection then HookObjectTree;
HookObjectTree;
end; end;
procedure TWasmObjectInspectorApi.Logcall(const aMsg: string); procedure TWasmObjectInspectorApi.Logcall(const aMsg: string);
@ -146,19 +150,44 @@ begin
Raise EWasmOI.Create(S); Raise EWasmOI.Create(S);
end; end;
procedure TWasmObjectInspectorApi.SetHandleHandleRefresh(AValue: Boolean);
begin
if FHandleRefresh=AValue then Exit;
FHandleRefresh:=AValue;
HookObjectTree;
end;
procedure TWasmObjectInspectorApi.DoSelectObject(Sender: TObject; aObjectId: Integer); procedure TWasmObjectInspectorApi.DoSelectObject(Sender: TObject; aObjectId: Integer);
begin begin
GetObjectProperties(aObjectID); GetObjectProperties(aObjectID);
end; end;
procedure TWasmObjectInspectorApi.DoRefreshTree(Sender: TObject);
begin
IF not Assigned(FObjectTree) then
Exit;
if (FObjectTree.RootObjectID=0) then
Exit;
ShowObjectTree(FObjectTree.RootObjectID);
end;
procedure TWasmObjectInspectorApi.SetHandleObjectSelection(AValue: Boolean); procedure TWasmObjectInspectorApi.SetHandleObjectSelection(AValue: Boolean);
begin begin
if FHandleObjectSelection=AValue then Exit; if FHandleObjectSelection=AValue then Exit;
FHandleObjectSelection:=AValue; FHandleObjectSelection:=AValue;
if FHandleObjectSelection then HookObjectTree
HookObjectTree end;
else
UnhookObjectTree; procedure TWasmObjectInspectorApi.ShowObjectTree(aObjectID: Integer);
var
Proc : TGetObjectTree;
begin
Proc:=TGetObjectTree(InstanceExports['wasm_oi_get_object_tree']);
if Not Assigned(Proc) then
Raise EWasmOI.Create('No wasm_oi_get_object_tree entry point');
if not Proc(0,aObjectID,0)=WASMOI_SUCCESS then
RaiseOILastError('GetObjectProperties');
end; end;
procedure TWasmObjectInspectorApi.GetObjectProperties(aObjectID: Integer); procedure TWasmObjectInspectorApi.GetObjectProperties(aObjectID: Integer);
@ -272,14 +301,14 @@ procedure TWasmObjectInspectorApi.HookObjectTree;
begin begin
if not Assigned(FObjectTree) then if not Assigned(FObjectTree) then
Exit; Exit;
FObjectTree.OnObjectSelected:=@DoSelectObject; if HandleObjectSelection then
end; FObjectTree.OnObjectSelected:=@DoSelectObject
else
procedure TWasmObjectInspectorApi.UnhookObjectTree; FObjectTree.OnObjectSelected:=Nil;
begin if HandleTreeRefresh then
if not Assigned(FObjectTree) then FObjectTree.OnRefresh:=@DoRefreshTree
Exit; else
FObjectTree.OnObjectSelected:=Nil; FObjectTree.OnRefresh:=Nil;
end; end;
function TWasmObjectInspectorApi.InspectorClear(aInspectorID: TInspectorID): TWasmOIResult; function TWasmObjectInspectorApi.InspectorClear(aInspectorID: TInspectorID): TWasmOIResult;

View File

@ -20,7 +20,7 @@ unit wasm.debuginspector.shared;
interface interface
{$IFDEF PAS2JS} {$IFDEF PAS2JS}
uses rtti; uses typinfo, rtti;
{$ENDIF} {$ENDIF}
Const Const