mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-19 09:59:10 +02:00
IDE: implemented fake methods (-dEnableFakeMethods). ToDos: 1. extend TWriter.OnWriteMethodProperty for fPropPath, 2. test
git-svn-id: trunk@11037 -
This commit is contained in:
parent
a6d2e13791
commit
83d784f501
@ -47,8 +47,8 @@ uses
|
|||||||
{$IFDEF IDE_MEM_CHECK}
|
{$IFDEF IDE_MEM_CHECK}
|
||||||
MemCheck,
|
MemCheck,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
Classes, SysUtils, TypInfo, LCLProc, LResources, Forms, Controls, LCLIntf,
|
Classes, SysUtils, AvgLvlTree, TypInfo, LCLProc, LResources, Forms, Controls,
|
||||||
Dialogs, JITForm, ComponentReg, IDEProcs;
|
LCLIntf, Dialogs, JITForm, ComponentReg, IDEProcs;
|
||||||
|
|
||||||
type
|
type
|
||||||
//----------------------------------------------------------------------------
|
//----------------------------------------------------------------------------
|
||||||
@ -150,7 +150,6 @@ type
|
|||||||
function FindComponentByClass(AClass: TComponentClass): integer;
|
function FindComponentByClass(AClass: TComponentClass): integer;
|
||||||
function FindComponentByName(const AName: shortstring): integer;
|
function FindComponentByName(const AName: shortstring): integer;
|
||||||
procedure GetUnusedNames(var ComponentName, ComponentClassName: shortstring);
|
procedure GetUnusedNames(var ComponentName, ComponentClassName: shortstring);
|
||||||
procedure AddNewMethod(JITComponent: TComponent; const AName: ShortString);
|
|
||||||
function CreateNewMethod(JITComponent: TComponent;
|
function CreateNewMethod(JITComponent: TComponent;
|
||||||
const AName: ShortString): TMethod;
|
const AName: ShortString): TMethod;
|
||||||
procedure RemoveMethod(JITComponent: TComponent; const AName: ShortString);
|
procedure RemoveMethod(JITComponent: TComponent; const AName: ShortString);
|
||||||
@ -199,6 +198,55 @@ type
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TJITMethods = class;
|
||||||
|
|
||||||
|
{ TJITMethod }
|
||||||
|
|
||||||
|
TJITMethod = class
|
||||||
|
private
|
||||||
|
FMethod: TMethod;
|
||||||
|
FOwner: TJITMethods;
|
||||||
|
FTheClass: TClass;
|
||||||
|
FTheMethodName: shortstring;
|
||||||
|
public
|
||||||
|
constructor Create(AnOwner: TJITMethods; aClass: TClass;
|
||||||
|
const aMethodName: shortstring);
|
||||||
|
destructor Destroy; override;
|
||||||
|
property Method: TMethod read FMethod;
|
||||||
|
property TheClass: TClass read FTheClass;
|
||||||
|
property TheMethodName: shortstring read FTheMethodName;
|
||||||
|
property Owner: TJITMethods read FOwner;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TJITMethods }
|
||||||
|
|
||||||
|
TJITMethods = class
|
||||||
|
private
|
||||||
|
fClearing: boolean;
|
||||||
|
fMethods: TAvgLvlTree;// sorted with CompareJITMethod
|
||||||
|
procedure InternalAdd(const AMethod: TJITMethod);
|
||||||
|
procedure InternalRemove(const AMethod: TJITMethod);
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Clear;
|
||||||
|
function Add(aClass: TClass; const aMethodName: shortstring): TJITMethod;
|
||||||
|
function Find(aClass: TClass; const aMethodName: shortstring): TJITMethod;
|
||||||
|
function Delete(aMethod: TJITMethod): boolean;
|
||||||
|
function Delete(aClass: TClass; const aMethodName: shortstring): boolean;
|
||||||
|
procedure DeleteAllOfClass(aClass: TClass);
|
||||||
|
function Rename(aClass: TClass;
|
||||||
|
const OldMethodName, NewMethodName: shortstring): boolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function IsJITMethod(const aMethod: TMethod): boolean;
|
||||||
|
function CompareJITMethod(Data1, Data2: Pointer): integer;
|
||||||
|
|
||||||
|
var
|
||||||
|
JITMethods: TJITMethods = nil;
|
||||||
|
|
||||||
|
|
||||||
function ClassAsString(AClass: TClass): string;
|
function ClassAsString(AClass: TClass): string;
|
||||||
function ClassMethodTableAsString(AClass: TClass): string;
|
function ClassMethodTableAsString(AClass: TClass): string;
|
||||||
function ClassTypeInfoAsString(AClass: TClass): string;
|
function ClassTypeInfoAsString(AClass: TClass): string;
|
||||||
@ -364,6 +412,12 @@ begin
|
|||||||
Result:=MyFindGlobalComponentProc(AName);
|
Result:=MyFindGlobalComponentProc(AName);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function IsJITMethod(const aMethod: TMethod): boolean;
|
||||||
|
begin
|
||||||
|
Result:=(aMethod.Data<>nil) and (aMethod.Code=nil)
|
||||||
|
and (TObject(aMethod.Data).ClassType=TJITMethod);
|
||||||
|
end;
|
||||||
|
|
||||||
function ClassAsString(AClass: TClass): string;
|
function ClassAsString(AClass: TClass): string;
|
||||||
var
|
var
|
||||||
ParentClass: TClass;
|
ParentClass: TClass;
|
||||||
@ -518,6 +572,18 @@ begin
|
|||||||
{$endif}
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function CompareJITMethod(Data1, Data2: Pointer): integer;
|
||||||
|
var
|
||||||
|
JITMethod1: TJITMethod;
|
||||||
|
JITMethod2: TJITMethod;
|
||||||
|
begin
|
||||||
|
JITMethod1:=TJITMethod(Data1);
|
||||||
|
JITMethod2:=TJITMethod(Data2);
|
||||||
|
Result:=ComparePointers(JITMethod1.TheClass,JITMethod2.TheClass);
|
||||||
|
if Result<>0 then exit;
|
||||||
|
Result:=CompareText(JITMethod1.TheMethodName,JITMethod2.TheMethodName);
|
||||||
|
end;
|
||||||
|
|
||||||
function CalculateTypeInfoSize(const AClassName: shortstring;
|
function CalculateTypeInfoSize(const AClassName: shortstring;
|
||||||
PropInfoCount: integer): integer;
|
PropInfoCount: integer): integer;
|
||||||
begin
|
begin
|
||||||
@ -843,12 +909,6 @@ begin
|
|||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TJITComponentList.AddNewMethod(JITComponent:TComponent;
|
|
||||||
const AName:ShortString);
|
|
||||||
begin
|
|
||||||
CreateNewmethod(JITComponent,AName);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TJITComponentList.RemoveMethod(JITComponent:TComponent;
|
procedure TJITComponentList.RemoveMethod(JITComponent:TComponent;
|
||||||
const AName:ShortString);
|
const AName:ShortString);
|
||||||
var OldCode:Pointer;
|
var OldCode:Pointer;
|
||||||
@ -863,6 +923,14 @@ begin
|
|||||||
JITComponent.ClassName);
|
JITComponent.ClassName);
|
||||||
if (AName='') or (not IsValidIdent(AName)) then
|
if (AName='') or (not IsValidIdent(AName)) then
|
||||||
raise Exception.Create('TJITComponentList.RemoveMethod invalid name: "'+AName+'"');
|
raise Exception.Create('TJITComponentList.RemoveMethod invalid name: "'+AName+'"');
|
||||||
|
|
||||||
|
// delete TJITMethod
|
||||||
|
if JITMethods.Delete(JITComponent.ClassType,AName) then begin
|
||||||
|
// this was a TJITmethod
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// delete real method
|
||||||
OldCode:=nil;
|
OldCode:=nil;
|
||||||
DoRemoveMethod(JITComponent.ClassType,AName,OldCode);
|
DoRemoveMethod(JITComponent.ClassType,AName,OldCode);
|
||||||
FreeMem(OldCode);
|
FreeMem(OldCode);
|
||||||
@ -881,6 +949,14 @@ begin
|
|||||||
JITComponent.ClassName);
|
JITComponent.ClassName);
|
||||||
if (NewName='') or (not IsValidIdent(NewName)) then
|
if (NewName='') or (not IsValidIdent(NewName)) then
|
||||||
raise Exception.Create('TJITComponentList.RenameMethod invalid name: "'+NewName+'"');
|
raise Exception.Create('TJITComponentList.RenameMethod invalid name: "'+NewName+'"');
|
||||||
|
|
||||||
|
// rename TJITMethod
|
||||||
|
if JITMethods.Rename(JITComponent.ClassType,OldName,NewName) then begin
|
||||||
|
// this was a TJITMethod
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// rename real method
|
||||||
DoRenameMethod(JITComponent.ClassType,OldName,NewName);
|
DoRenameMethod(JITComponent.ClassType,OldName,NewName);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -982,6 +1058,9 @@ function TJITComponentList.CreateNewMethod(JITComponent: TComponent;
|
|||||||
var CodeTemplate,NewCode:Pointer;
|
var CodeTemplate,NewCode:Pointer;
|
||||||
CodeSize:integer;
|
CodeSize:integer;
|
||||||
OldCode: Pointer;
|
OldCode: Pointer;
|
||||||
|
{$IFDEF EnableFakeMethods}
|
||||||
|
JITMethod: TJITMethod;
|
||||||
|
{$ENDIF}
|
||||||
begin
|
begin
|
||||||
{$IFDEF VerboseJITForms}
|
{$IFDEF VerboseJITForms}
|
||||||
debugln('TJITComponentList.CreateNewMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName);
|
debugln('TJITComponentList.CreateNewMethod ',JITComponent.Name,':',JITComponent.Name,' Method=',AName);
|
||||||
@ -995,10 +1074,16 @@ begin
|
|||||||
raise Exception.Create('TJITComponentList.CreateNewMethod invalid name: "'+AName+'"');
|
raise Exception.Create('TJITComponentList.CreateNewMethod invalid name: "'+AName+'"');
|
||||||
OldCode:=JITComponent.MethodAddress(AName);
|
OldCode:=JITComponent.MethodAddress(AName);
|
||||||
if OldCode<>nil then begin
|
if OldCode<>nil then begin
|
||||||
|
// there is already a real method with this name
|
||||||
Result.Data:=JITComponent;
|
Result.Data:=JITComponent;
|
||||||
Result.Code:=OldCode;
|
Result.Code:=OldCode;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
{$IFDEF EnableFakeMethods}
|
||||||
|
// create a TJITMethod
|
||||||
|
JITMethod:=JITMethods.Add(JITComponent.ClassType,AName);
|
||||||
|
Result:=JITMethod.Method;
|
||||||
|
{$ELSE}
|
||||||
CodeTemplate:=MethodAddress('DoNothing');
|
CodeTemplate:=MethodAddress('DoNothing');
|
||||||
CodeSize:=100; // !!! what is the real codesize of DoNothing? !!!
|
CodeSize:=100; // !!! what is the real codesize of DoNothing? !!!
|
||||||
GetMem(NewCode,CodeSize);
|
GetMem(NewCode,CodeSize);
|
||||||
@ -1006,6 +1091,7 @@ begin
|
|||||||
DoAddNewMethod(JITComponent.ClassType,AName,NewCode);
|
DoAddNewMethod(JITComponent.ClassType,AName,NewCode);
|
||||||
Result.Data:=JITComponent;
|
Result.Data:=JITComponent;
|
||||||
Result.Code:=NewCode;
|
Result.Code:=NewCode;
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TJITComponentList.CreateNewJITClass(ParentClass: TClass;
|
function TJITComponentList.CreateNewJITClass(ParentClass: TClass;
|
||||||
@ -1129,6 +1215,9 @@ var
|
|||||||
OldTypeInfo: PTypeInfo;
|
OldTypeInfo: PTypeInfo;
|
||||||
OldMethodTable: PMethodNameTable;
|
OldMethodTable: PMethodNameTable;
|
||||||
begin
|
begin
|
||||||
|
// free TJITMethods
|
||||||
|
JITMethods.DeleteAllOfClass(AClass);
|
||||||
|
|
||||||
OldVMT:=Pointer(AClass);
|
OldVMT:=Pointer(AClass);
|
||||||
// free methodtable
|
// free methodtable
|
||||||
OldMethodTable:=PMethodNameTable((OldVMT+vmtMethodTable)^);
|
OldMethodTable:=PMethodNameTable((OldVMT+vmtMethodTable)^);
|
||||||
@ -1288,7 +1377,7 @@ end;
|
|||||||
descendent, all methods and components are published members and TReader can
|
descendent, all methods and components are published members and TReader can
|
||||||
set these values.
|
set these values.
|
||||||
But at design time we do not have the corresponding TForm descendent. And
|
But at design time we do not have the corresponding TForm descendent. And
|
||||||
there is no compiled code, thus it must be produced it at runtime
|
there is no compiled code, thus it must be produced
|
||||||
(just-in-time).
|
(just-in-time).
|
||||||
}
|
}
|
||||||
procedure TJITComponentList.ReaderFindMethod(Reader: TReader;
|
procedure TJITComponentList.ReaderFindMethod(Reader: TReader;
|
||||||
@ -1298,6 +1387,9 @@ begin
|
|||||||
{$IFDEF IDE_DEBUG}
|
{$IFDEF IDE_DEBUG}
|
||||||
debugln('[TJITComponentList.ReaderFindMethod] A "'+FindMethodName+'" Address=',DbgS(Address));
|
debugln('[TJITComponentList.ReaderFindMethod] A "'+FindMethodName+'" Address=',DbgS(Address));
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
{$IFDEF EnableFakeMethods}
|
||||||
|
RaiseGDBException('TJITComponentList.ReaderFindMethod this event should never be called -> this is a bug in TReader, or misuse of TReader.OnFindMethod');
|
||||||
|
{$ELSE}
|
||||||
if Address=nil then begin
|
if Address=nil then begin
|
||||||
// there is no method in the ancestor class with this name
|
// there is no method in the ancestor class with this name
|
||||||
// => add a JIT method with this name to the JITForm
|
// => add a JIT method with this name to the JITForm
|
||||||
@ -1305,6 +1397,7 @@ begin
|
|||||||
Address:=NewMethod.Code;
|
Address:=NewMethod.Code;
|
||||||
Error:=false;
|
Error:=false;
|
||||||
end;
|
end;
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TJITComponentList.ReaderPropertyNotFound(Reader: TReader;
|
procedure TJITComponentList.ReaderPropertyNotFound(Reader: TReader;
|
||||||
@ -1319,8 +1412,27 @@ end;
|
|||||||
procedure TJITComponentList.ReaderSetMethodProperty(Reader: TReader;
|
procedure TJITComponentList.ReaderSetMethodProperty(Reader: TReader;
|
||||||
Instance: TPersistent; PropInfo: PPropInfo; const TheMethodName: string;
|
Instance: TPersistent; PropInfo: PPropInfo; const TheMethodName: string;
|
||||||
var Handled: boolean);
|
var Handled: boolean);
|
||||||
|
{$IFDEF EnableFakeMethods}
|
||||||
|
var
|
||||||
|
Method: TMethod;
|
||||||
|
JITMethod: TJITMethod;
|
||||||
|
{$ENDIF}
|
||||||
begin
|
begin
|
||||||
//debugln('TJITComponentList.ReaderSetMethodProperty ',PropInfo^.Name,':=',TheMethodName);
|
//debugln('TJITComponentList.ReaderSetMethodProperty ',PropInfo^.Name,':=',TheMethodName);
|
||||||
|
{$IFDEF EnableFakeMethods}
|
||||||
|
Method.Code:=FCurReadJITComponent.MethodAddress(TheMethodName);
|
||||||
|
if Method.Code<>nil then begin
|
||||||
|
// there is a real method with this name
|
||||||
|
Method.Data := FCurReadJITComponent;
|
||||||
|
end else begin
|
||||||
|
// create a fake TJITMethod
|
||||||
|
JITMethod:=JITMethods.Add(FCurReadJITComponent.ClassType,TheMethodName);
|
||||||
|
Method:=JITMethod.Method;
|
||||||
|
end;
|
||||||
|
SetMethodProp(Instance, PropInfo, Method);
|
||||||
|
|
||||||
|
Handled:=true;
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TJITComponentList.ReaderSetName(Reader: TReader;
|
procedure TJITComponentList.ReaderSetName(Reader: TReader;
|
||||||
@ -1442,8 +1554,184 @@ begin
|
|||||||
and (IndexOf(AComponent)>=0);
|
and (IndexOf(AComponent)>=0);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ TJITMethod }
|
||||||
|
|
||||||
|
constructor TJITMethod.Create(AnOwner: TJITMethods;
|
||||||
|
aClass: TClass; const aMethodName: shortstring);
|
||||||
|
begin
|
||||||
|
FMethod.Data:=Self;
|
||||||
|
FMethod.Code:=nil;
|
||||||
|
fTheClass:=AClass;
|
||||||
|
fTheMethodName:=aMethodName;
|
||||||
|
Owner.InternalAdd(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJITMethod.Destroy;
|
||||||
|
begin
|
||||||
|
if Owner<>nil then
|
||||||
|
Owner.InternalRemove(Self);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TJITMethods }
|
||||||
|
|
||||||
|
procedure TJITMethods.InternalAdd(const AMethod: TJITMethod);
|
||||||
|
begin
|
||||||
|
fMethods.Add(AMethod);
|
||||||
|
AMethod.fOwner:=Self;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJITMethods.InternalRemove(const AMethod: TJITMethod);
|
||||||
|
begin
|
||||||
|
AMethod.fOwner:=nil;
|
||||||
|
if not fClearing then
|
||||||
|
fMethods.Remove(AMethod);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJITMethods.Create;
|
||||||
|
begin
|
||||||
|
fMethods:=TAvgLvlTree.Create(@CompareJITMethod);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJITMethods.Destroy;
|
||||||
|
begin
|
||||||
|
Clear;
|
||||||
|
FreeAndNil(fMethods);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJITMethods.Clear;
|
||||||
|
begin
|
||||||
|
fClearing:=true;
|
||||||
|
fMethods.FreeAndClear;
|
||||||
|
fClearing:=false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJITMethods.Add(aClass: TClass;
|
||||||
|
const aMethodName: shortstring): TJITMethod;
|
||||||
|
begin
|
||||||
|
Result:=Find(aClass,aMethodName);
|
||||||
|
if Result=nil then
|
||||||
|
Result:=TJITMethod.Create(Self,aClass,aMethodName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJITMethods.Find(aClass: TClass;
|
||||||
|
const aMethodName: shortstring): TJITMethod;
|
||||||
|
var
|
||||||
|
CurMethod: TJITMethod;
|
||||||
|
Node: TAvgLvlTreeNode;
|
||||||
|
Comp: LongInt;
|
||||||
|
begin
|
||||||
|
Node:=fMethods.Root;
|
||||||
|
while (Node<>nil) do begin
|
||||||
|
CurMethod:=TJITMethod(Node.Data);
|
||||||
|
Comp:=ComparePointers(aClass,CurMethod.TheClass);
|
||||||
|
if Comp=0 then
|
||||||
|
Comp:=CompareText(aMethodName,CurMethod.TheMethodName);
|
||||||
|
if Comp=0 then
|
||||||
|
exit(CurMethod);
|
||||||
|
if Comp<0 then begin
|
||||||
|
Node:=Node.Left
|
||||||
|
end else begin
|
||||||
|
Node:=Node.Right
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result:=nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJITMethods.Delete(aMethod: TJITMethod): boolean;
|
||||||
|
begin
|
||||||
|
if (aMethod=nil) then
|
||||||
|
Result:=false
|
||||||
|
else if aMethod.Owner<>Self then
|
||||||
|
RaiseGDBException('TJITMethods.DeleteJITMethod')
|
||||||
|
else begin
|
||||||
|
Result:=true;
|
||||||
|
InternalRemove(aMethod);
|
||||||
|
aMethod.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJITMethods.Delete(aClass: TClass;
|
||||||
|
const aMethodName: shortstring): boolean;
|
||||||
|
var
|
||||||
|
CurMethod: TJITMethod;
|
||||||
|
begin
|
||||||
|
CurMethod:=Find(aClass,aMethodName);
|
||||||
|
if CurMethod=nil then begin
|
||||||
|
Result:=false;
|
||||||
|
end else begin
|
||||||
|
Result:=true;
|
||||||
|
InternalRemove(CurMethod);
|
||||||
|
CurMethod.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJITMethods.DeleteAllOfClass(aClass: TClass);
|
||||||
|
var
|
||||||
|
CurMethod: TJITMethod;
|
||||||
|
Node: TAvgLvlTreeNode;
|
||||||
|
Comp: LongInt;
|
||||||
|
NextNode: TAvgLvlTreeNode;
|
||||||
|
begin
|
||||||
|
Node:=fMethods.Root;
|
||||||
|
while (Node<>nil) do begin
|
||||||
|
CurMethod:=TJITMethod(Node.Data);
|
||||||
|
Comp:=ComparePointers(aClass,CurMethod.TheClass);
|
||||||
|
if Comp<0 then begin
|
||||||
|
Node:=Node.Left
|
||||||
|
end else if Comp>0 then begin
|
||||||
|
Node:=Node.Right
|
||||||
|
end else begin
|
||||||
|
// one node found
|
||||||
|
|
||||||
|
// search lowest
|
||||||
|
repeat
|
||||||
|
NextNode:=fMethods.FindPrecessor(Node);
|
||||||
|
if (NextNode=nil)
|
||||||
|
or (ComparePointers(aClass,TJITMethod(NextNode.Data).TheClass)<>0)
|
||||||
|
then
|
||||||
|
break;
|
||||||
|
Node:=NextNode;
|
||||||
|
until false;
|
||||||
|
|
||||||
|
// delete all nodes of this class
|
||||||
|
repeat
|
||||||
|
NextNode:=fMethods.FindSuccessor(Node);
|
||||||
|
CurMethod:=TJITMethod(Node.Data);
|
||||||
|
CurMethod.FOwner:=nil;
|
||||||
|
fMethods.Delete(Node);
|
||||||
|
CurMethod.Free;
|
||||||
|
Node:=NextNode;
|
||||||
|
until (Node=nil)
|
||||||
|
or (ComparePointers(aClass,TJITMethod(Node.Data).TheClass)<>0);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJITMethods.Rename(aClass: TClass; const OldMethodName,
|
||||||
|
NewMethodName: shortstring): boolean;
|
||||||
|
var
|
||||||
|
CurMethod: TJITMethod;
|
||||||
|
begin
|
||||||
|
CurMethod:=Find(aClass,OldMethodName);
|
||||||
|
if CurMethod=nil then begin
|
||||||
|
Result:=false;
|
||||||
|
end else begin
|
||||||
|
Result:=true;
|
||||||
|
fMethods.Remove(CurMethod);
|
||||||
|
CurMethod.fTheMethodName:=NewMethodName;
|
||||||
|
fMethods.Add(CurMethod);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
Initialization
|
Initialization
|
||||||
TComponentValidateRenameOffset:=GetTComponentValidateRenameVMTOffset;
|
TComponentValidateRenameOffset:=GetTComponentValidateRenameVMTOffset;
|
||||||
|
JITMethods:=TJITMethods.Create;
|
||||||
|
|
||||||
|
finalization
|
||||||
|
FreeAndNil(JITMethods);
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
@ -183,6 +183,9 @@ each control that's dropped onto the form
|
|||||||
): TComponent;
|
): TComponent;
|
||||||
function FindJITComponentByClass(AComponentClass: TComponentClass
|
function FindJITComponentByClass(AComponentClass: TComponentClass
|
||||||
): TComponent;
|
): TComponent;
|
||||||
|
procedure WriteMethodPropertyEvent(Writer: TWriter; Instance: TPersistent;
|
||||||
|
PropInfo: PPropInfo; const MethodValue: TMethod;
|
||||||
|
const DefMethodCodeValue: Pointer; var Handled: boolean);
|
||||||
|
|
||||||
// designers
|
// designers
|
||||||
function DesignerCount: integer; override;
|
function DesignerCount: integer; override;
|
||||||
@ -1261,6 +1264,40 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCustomFormEditor.WriteMethodPropertyEvent(Writer: TWriter;
|
||||||
|
Instance: TPersistent; PropInfo: PPropInfo; const MethodValue: TMethod;
|
||||||
|
const DefMethodCodeValue: Pointer; var Handled: boolean);
|
||||||
|
{$IFDEF EnableFakeMethods}
|
||||||
|
var
|
||||||
|
DefaultValue: TMethod;
|
||||||
|
PropPath: String;
|
||||||
|
CurName: String;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF EnableFakeMethods}
|
||||||
|
Handled:=true;
|
||||||
|
|
||||||
|
DebugLn(['TCustomFormEditor.WriteMethodPropertyEvent ',GlobalDesignHook.GetMethodName(MethodValue,nil)]);
|
||||||
|
|
||||||
|
// find ancestor method value
|
||||||
|
DefaultValue := GetMethodProp(Writer.Ancestor, PropInfo);
|
||||||
|
if (DefaultValue.Data=MethodValue.Data)
|
||||||
|
and (DefaultValue.Code=MethodValue.Code) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
PropPath:='';// ToDo: Writer.FPropPath
|
||||||
|
Writer.Driver.BeginProperty(PropPath + PPropInfo(PropInfo)^.Name);
|
||||||
|
if IsJITMethod(MethodValue) then
|
||||||
|
CurName:=TJITMethod(MethodValue.Data).TheMethodName
|
||||||
|
else if MethodValue.Code<>nil then
|
||||||
|
CurName:=Writer.LookupRoot.MethodName(MethodValue.Code)
|
||||||
|
else
|
||||||
|
CurName:='';
|
||||||
|
Writer.Driver.WriteMethodName(CurName);
|
||||||
|
Writer.Driver.EndProperty;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
function TCustomFormEditor.DesignerCount: integer;
|
function TCustomFormEditor.DesignerCount: integer;
|
||||||
begin
|
begin
|
||||||
Result:=JITFormList.Count+JITNonFormList.Count;
|
Result:=JITFormList.Count+JITNonFormList.Count;
|
||||||
|
@ -94,7 +94,7 @@ uses
|
|||||||
// help manager
|
// help manager
|
||||||
IDEContextHelpEdit, HelpManager,
|
IDEContextHelpEdit, HelpManager,
|
||||||
// designer
|
// designer
|
||||||
JITForm, ComponentPalette, ComponentReg, ObjInspExt,
|
JITForm, JITForms, ComponentPalette, ComponentReg, ObjInspExt,
|
||||||
Designer, FormEditor, CustomFormEditor,
|
Designer, FormEditor, CustomFormEditor,
|
||||||
ControlSelection, AnchorEditor,
|
ControlSelection, AnchorEditor,
|
||||||
{$DEFINE UseNewMenuEditor}
|
{$DEFINE UseNewMenuEditor}
|
||||||
@ -1279,7 +1279,7 @@ end;
|
|||||||
function TMainIDE.OnPropHookGetMethodName(const Method: TMethod;
|
function TMainIDE.OnPropHookGetMethodName(const Method: TMethod;
|
||||||
CheckOwner: TObject): ShortString;
|
CheckOwner: TObject): ShortString;
|
||||||
begin
|
begin
|
||||||
if Assigned(Method.Code) then begin
|
if Method.Code<>nil then begin
|
||||||
if Method.Data<>nil then begin
|
if Method.Data<>nil then begin
|
||||||
if (CheckOwner<>nil) and (TObject(Method.Data)<>CheckOwner) then
|
if (CheckOwner<>nil) and (TObject(Method.Data)<>CheckOwner) then
|
||||||
Result:=''
|
Result:=''
|
||||||
@ -1290,6 +1290,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
end else
|
end else
|
||||||
Result:='<No LookupRoot>';
|
Result:='<No LookupRoot>';
|
||||||
|
end else if IsJITMethod(Method) then begin
|
||||||
|
Result:=TJITMethod(Method.Data).TheMethodName;
|
||||||
end else
|
end else
|
||||||
Result:='';
|
Result:='';
|
||||||
end;
|
end;
|
||||||
@ -4195,6 +4197,7 @@ begin
|
|||||||
Grubber:=TLRTGrubber.Create;
|
Grubber:=TLRTGrubber.Create;
|
||||||
Writer.OnWriteStringProperty:=@Grubber.Grub;
|
Writer.OnWriteStringProperty:=@Grubber.Grub;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
Writer.OnWriteMethodProperty:=@FormEditor1.WriteMethodPropertyEvent;
|
||||||
AncestorUnit:=GetAncestorUnit(AnUnitInfo);
|
AncestorUnit:=GetAncestorUnit(AnUnitInfo);
|
||||||
if AncestorUnit<>nil then
|
if AncestorUnit<>nil then
|
||||||
AncestorInstance:=AncestorUnit.Component
|
AncestorInstance:=AncestorUnit.Component
|
||||||
|
@ -3722,6 +3722,7 @@ begin
|
|||||||
CurFirstValue := GetMethodValue;
|
CurFirstValue := GetMethodValue;
|
||||||
for I := 1 to PropCount - 1 do begin
|
for I := 1 to PropCount - 1 do begin
|
||||||
AnotherValue := GetMethodValueAt(I);
|
AnotherValue := GetMethodValueAt(I);
|
||||||
|
// Note: compare Code and Data
|
||||||
if (AnotherValue.Code <> CurFirstValue.Code)
|
if (AnotherValue.Code <> CurFirstValue.Code)
|
||||||
or (AnotherValue.Data <> CurFirstValue.Data) then
|
or (AnotherValue.Data <> CurFirstValue.Data) then
|
||||||
Exit;
|
Exit;
|
||||||
@ -3827,7 +3828,7 @@ begin
|
|||||||
System.Delete(Result, I, 1);
|
System.Delete(Result, I, 1);
|
||||||
end;
|
end;
|
||||||
if Result = '' then begin
|
if Result = '' then begin
|
||||||
{raise EPropertyError.CreateRes(@SCannotCreateName);}
|
DebugLn(['TMethodPropertyEditor.GetDefaultMethodName can not create name - this should never happen']);
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
Postfix := PropName;
|
Postfix := PropName;
|
||||||
@ -3897,7 +3898,7 @@ begin
|
|||||||
and (not PropertyHook.MethodFromAncestor(GetMethodValue)) then begin
|
and (not PropertyHook.MethodFromAncestor(GetMethodValue)) then begin
|
||||||
// rename the method
|
// rename the method
|
||||||
// Note:
|
// Note:
|
||||||
// All other not selected properties that use this method, contains just
|
// All other not selected properties that use this method, contain just
|
||||||
// the TMethod record. So, changing the name in the jitform will change
|
// the TMethod record. So, changing the name in the jitform will change
|
||||||
// all other event names in all other components automatically.
|
// all other event names in all other components automatically.
|
||||||
//writeln('### TMethodPropertyEditor.SetValue D');
|
//writeln('### TMethodPropertyEditor.SetValue D');
|
||||||
@ -3906,7 +3907,6 @@ begin
|
|||||||
begin
|
begin
|
||||||
//writeln('### TMethodPropertyEditor.SetValue E');
|
//writeln('### TMethodPropertyEditor.SetValue E');
|
||||||
CreateNewMethod := IsValidIdent(NewValue) and not NewMethodExists;
|
CreateNewMethod := IsValidIdent(NewValue) and not NewMethodExists;
|
||||||
//OldMethod := GetMethodValue;
|
|
||||||
SetMethodValue(PropertyHook.CreateMethod(NewValue,GetPropType,GetUnitName));
|
SetMethodValue(PropertyHook.CreateMethod(NewValue,GetPropType,GetUnitName));
|
||||||
//writeln('### TMethodPropertyEditor.SetValue F NewValue=',GetValue);
|
//writeln('### TMethodPropertyEditor.SetValue F NewValue=',GetValue);
|
||||||
if CreateNewMethod then begin
|
if CreateNewMethod then begin
|
||||||
|
Loading…
Reference in New Issue
Block a user