mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-08-20 13:09:06 +02:00
* Some fixes and improvements: refresh tree
This commit is contained in:
parent
09a24f2b17
commit
01a49fbe68
@ -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:='⟳';
|
||||||
|
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);
|
||||||
|
@ -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;
|
||||||
|
@ -20,7 +20,7 @@ unit wasm.debuginspector.shared;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
{$IFDEF PAS2JS}
|
{$IFDEF PAS2JS}
|
||||||
uses rtti;
|
uses typinfo, rtti;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
Const
|
Const
|
||||||
|
Loading…
Reference in New Issue
Block a user