paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-04 04:18:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDEIntf: changed TPropHookCreateMethod parameters to use propertyowner and propertyname

Browse Source 
git-svn-id: trunk@11844 -
This commit is contained in:
mattias 2007-08-22 08:50:20 +00:00
parent 09d7075438
commit c3d8e9f2e7
5 changed files with 107 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
components/codetools/codetoolmanager.pas
View File

@ -614,13 +614,17 @@ type
function CreatePublishedMethod(Code: TCodeBuffer; const AClassName,
NewMethodName: string; ATypeInfo: PTypeInfo;
UseTypeInfoForParameters: boolean = false;
const ATypeUnitName: string = ''): boolean;
const ATypeUnitName: string = '';
APropertyOwner: TPersistent = nil;
const APropertyName: string = ''): boolean;
// private class parts
function CreatePrivateMethod(Code: TCodeBuffer; const AClassName,
NewMethodName: string; ATypeInfo: PTypeInfo;
UseTypeInfoForParameters: boolean = false;
const ATypeUnitName: string = ''): boolean;
const ATypeUnitName: string = '';
APropertyOwner: TPersistent = nil; const APropertyName: string = ''
): boolean;
// IDE % directives
function GetIDEDirectives(Code: TCodeBuffer;
@ -2693,7 +2697,8 @@ end;
function TCodeToolManager.CreatePublishedMethod(Code: TCodeBuffer;
const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
UseTypeInfoForParameters: boolean; const ATypeUnitName: string): boolean;
UseTypeInfoForParameters: boolean; const ATypeUnitName: string;
APropertyOwner: TPersistent; const APropertyName: string): boolean;
begin
{$IFDEF CTDEBUG}
DebugLn('TCodeToolManager.CreatePublishedMethod A');
@ -2703,8 +2708,10 @@ begin
try
SourceChangeCache.Clear;
Result:=FCurCodeTool.CreateMethod(UpperCaseStr(AClassName),
NewMethodName,ATypeInfo,ATypeUnitName,SourceChangeCache,
UseTypeInfoForParameters,pcsPublished);
NewMethodName,ATypeInfo,
ATypeUnitName,
APropertyOwner,APropertyName,
SourceChangeCache,UseTypeInfoForParameters,pcsPublished);
except
on e: Exception do Result:=HandleException(e);
end;
@ -2712,7 +2719,8 @@ end;
function TCodeToolManager.CreatePrivateMethod(Code: TCodeBuffer;
const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
UseTypeInfoForParameters: boolean; const ATypeUnitName: string): boolean;
UseTypeInfoForParameters: boolean; const ATypeUnitName: string;
APropertyOwner: TPersistent; const APropertyName: string): boolean;
begin
{$IFDEF CTDEBUG}
DebugLn('TCodeToolManager.CreatePrivateMethod A');
@ -2722,8 +2730,9 @@ begin
try
SourceChangeCache.Clear;
Result:=FCurCodeTool.CreateMethod(UpperCaseStr(AClassName),
NewMethodName,ATypeInfo,ATypeUnitName,SourceChangeCache,
UseTypeInfoForParameters,pcsPrivate);
NewMethodName,ATypeInfo,
ATypeUnitName,APropertyOwner,APropertyName,
SourceChangeCache,UseTypeInfoForParameters,pcsPrivate);
except
on e: Exception do Result:=HandleException(e);
end;

19
components/codetools/eventcodetool.pas
View File

@ -86,13 +86,17 @@ type
SourceChangeCache: TSourceChangeCache): boolean;
function CreateMethod(const UpperClassName,
AMethodName: string; ATypeInfo: PTypeInfo; const ATypeUnitName: string;
AMethodName: string; ATypeInfo: PTypeInfo;
const ATypeUnitName: string;
APropertyOwner: TPersistent; const APropertyName: string;
SourceChangeCache: TSourceChangeCache;
UseTypeInfoForParameters: boolean = false;
Section: TPascalClassSection = pcsPublished): boolean;
function CreateMethod(ClassNode: TCodeTreeNode;
const AMethodName: string;
ATypeInfo: PTypeInfo; const ATypeUnitName: string;
ATypeInfo: PTypeInfo;
const ATypeUnitName: string;
APropertyOwner: TPersistent; const APropertyName: string;
SourceChangeCache: TSourceChangeCache;
UseTypeInfoForParameters: boolean = false;
Section: TPascalClassSection = pcsPublished): boolean;
@ -645,6 +649,7 @@ end;
function TEventsCodeTool.CreateMethod(const UpperClassName,
AMethodName: string; ATypeInfo: PTypeInfo; const ATypeUnitName: string;
APropertyOwner: TPersistent; const APropertyName: string;
SourceChangeCache: TSourceChangeCache;
UseTypeInfoForParameters: boolean;
Section: TPascalClassSection): boolean;
@ -654,11 +659,13 @@ begin
BuildTree(false);
AClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
Result:=CreateMethod(AClassNode,AMethodName,ATypeInfo,ATypeUnitName,
APropertyOwner,APropertyName,
SourceChangeCache,UseTypeInfoForParameters,Section);
end;
function TEventsCodeTool.CreateMethod(ClassNode: TCodeTreeNode;
const AMethodName: string; ATypeInfo: PTypeInfo; const ATypeUnitName: string;
APropertyOwner: TPersistent; const APropertyName: string;
SourceChangeCache: TSourceChangeCache; UseTypeInfoForParameters: boolean;
Section: TPascalClassSection): boolean;
@ -698,7 +705,13 @@ begin
[phpWithoutClassName, phpWithoutName, phpInUpperCase]);
end else begin
// search typeinfo in source
FindContext:=FindMethodTypeInfo(ATypeInfo,ATypeUnitName);
{$IFDEF EnableNewFindMethodTypeInfo}
if (APropertyOwner<>nil)
and (APropertyName<>'') then
FindContext:=FindMethodTypeInfo(ATypeInfo,APropertyOwner,APropertyName)
else
{$ENDIF}
FindContext:=FindMethodTypeInfo(ATypeInfo,ATypeUnitName);
AddNeededUnits(FindContext);
CleanMethodDefinition:=UpperCaseStr(AMethodName)
+FindContext.Tool.ExtractProcHead(FindContext.Node,

4
components/codetools/examples/fixdefinitionorder.lpi
View File

@ -26,10 +26,10 @@
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="CodeTools"/>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
<PackageName Value="CodeTools"/>
</Item2>
</RequiredPackages>
<Units Count="3">

11
ide/main.pp
View File

@ -387,7 +387,8 @@ type
IdentIsMethod: boolean): boolean;
function OnPropHookCreateMethod(const AMethodName:ShortString;
ATypeInfo:PTypeInfo;
const ATypeUnitName: string): TMethod;
APropertyOwner: TPersistent;
const APropertyName: shortstring): TMethod;
procedure OnPropHookShowMethod(const AMethodName:ShortString);
procedure OnPropHookRenameMethod(const CurName, NewName:ShortString);
function OnPropHookBeforeAddPersistent(Sender: TObject;
@ -12552,7 +12553,8 @@ begin
end;
function TMainIDE.OnPropHookCreateMethod(const AMethodName: ShortString;
ATypeInfo: PTypeInfo; const ATypeUnitName: string): TMethod;
ATypeInfo: PTypeInfo;
APropertyOwner: TPersistent; const APropertyName: shortstring): TMethod;
var ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
r: boolean;
@ -12571,8 +12573,9 @@ begin
try
// create published method
r:=CodeToolBoss.CreatePublishedMethod(ActiveUnitInfo.Source,
ActiveUnitInfo.Component.ClassName,AMethodName,ATypeInfo,false,
ATypeUnitName);
ActiveUnitInfo.Component.ClassName,AMethodName,
ATypeInfo,false,GetClassUnitName(APropertyOwner.ClassType),
APropertyOwner,APropertyName);
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.OnPropHookCreateMethod] ************2 ',r,' ',AMethodName);

99
ideintf/propedits.pp
View File

@ -299,6 +299,7 @@ type
function IsReadOnly: boolean; virtual;
function GetComponent(Index: Integer): TPersistent;// for Delphi compatibility
function GetUnitName(Index: Integer = 0): string;
function GetPropTypeUnitName(Index: Integer = 0): string;
function GetEditLimit: Integer; virtual;
function GetName: shortstring; virtual;
procedure GetProperties(Proc: TGetPropEditProc); virtual;
@ -312,8 +313,6 @@ type
function GetMethodValueAt(Index: Integer): TMethod;
function GetOrdValue: Longint;
function GetOrdValueAt(Index: Integer): Longint;
// function GetPtrValue: Pointer;
// function GetPtrValueAt(Index: Integer): Pointer;
function GetObjectValue: TObject;
function GetObjectValue(MinClass: TClass): TObject;
function GetObjectValueAt(Index: Integer): TObject;
@ -359,12 +358,12 @@ type
function SubPropertiesNeedsUpdate: boolean; virtual;
function IsDefaultValue: boolean; virtual;
function IsNotDefaultValue: boolean; virtual;
property PropertyHook:TPropertyEditorHook read FPropertyHook;
property PrivateDirectory:ansistring read GetPrivateDirectory;
property PropertyHook: TPropertyEditorHook read FPropertyHook;
property PrivateDirectory: ansistring read GetPrivateDirectory;
property PropCount:Integer read FPropCount;
property FirstValue:ansistring read GetValue write SetValue;
property FirstValue: ansistring read GetValue write SetValue;
property OnSubPropertiesChanged: TNotifyEvent
read FOnSubPropertiesChanged write FOnSubPropertiesChanged;
read FOnSubPropertiesChanged write FOnSubPropertiesChanged;
end;
TPropertyEditorClass=class of TPropertyEditor;
@ -1101,8 +1100,8 @@ type
// lookup root
TPropHookChangeLookupRoot = procedure of object;
// methods
TPropHookCreateMethod = function(const Name:ShortString;
ATypeInfo:PTypeInfo; const ATypeUnitName: string): TMethod of object;
TPropHookCreateMethod = function(const Name: ShortString; ATypeInfo: PTypeInfo;
APropertyOwner: TPersistent; const APropertyName: shortstring): TMethod of object;
TPropHookGetMethodName = function(const Method: TMethod;
CheckOwner: TObject): ShortString of object;
TPropHookGetMethods = procedure(TypeData:PTypeData; Proc:TGetStringProc) of object;
@ -1203,7 +1202,8 @@ type
property LookupRoot: TPersistent read FLookupRoot write SetLookupRoot;
// methods
function CreateMethod(const Name:ShortString; ATypeInfo:PTypeInfo;
const ATypeUnitName: string): TMethod;
APropertyOwner: TPersistent;
const APropertyName: shortstring): TMethod;
function GetMethodName(const Method: TMethod; CheckOwner: TObject): ShortString;
procedure GetMethods(TypeData:PTypeData; Proc:TGetStringProc);
function MethodExists(const Name:ShortString; TypeData: PTypeData;
@ -1871,16 +1871,14 @@ begin
PropEditor := EdClass.Create(AHook,1);
PropEditor.SetPropEntry(0, Instance, PropInfo);
PropEditor.Initialize;
// with PropInfo^ do begin
// check for multiselection, ValueAvailable and customfilter
if ((SelCount > 1)
and not (paMultiSelect in PropEditor.GetAttributes))
or not PropEditor.ValueAvailable
or (Assigned(AEditorFilterFunc) and not AEditorFilterFunc(PropEditor))
then begin
Candidates.Delete(I);
end;
// end;
// check for multiselection, ValueAvailable and customfilter
if ((SelCount > 1)
and not (paMultiSelect in PropEditor.GetAttributes))
or not PropEditor.ValueAvailable
or (Assigned(AEditorFilterFunc) and not AEditorFilterFunc(PropEditor))
then begin
Candidates.Delete(I);
end;
PropEditor.Free;
end;
@ -2046,6 +2044,49 @@ begin
Result:=GetClassUnitName(GetComponent(Index).ClassType);
end;
function TPropertyEditor.GetPropTypeUnitName(Index: Integer): string;
type
PPropData = ^TPropData;
var
AComponent: TPersistent;
CurPropInfo: PPropInfo;
hp: PTypeData;
pd: PPropData;
i: Integer;
UpperName: ShortString;
ATypeInfo: PTypeInfo;
NameFound: Boolean;
ThePropType: PTypeInfo;
begin
Result:='';
AComponent:=GetComponent(Index);
UpperName:=UpCase(GetName);
ThePropType:=GetPropType;
ATypeInfo:=PTypeInfo(AComponent.ClassInfo);
while Assigned(ATypeInfo) do begin
// skip the name
hp:=GetTypeData(ATypeInfo);
// the class info rtti the property rtti follows immediatly
pd:=AlignToPtr(Pointer(Pointer(@hp^.UnitName)+Length(hp^.UnitName)+1));
CurPropInfo:=PPropInfo(@pd^.PropList);
NameFound:=false;
for i:=1 to pd^.PropCount do begin
// found a property of that name ?
if Upcase(CurPropInfo^.Name)=UpperName then begin
DebugLn(['TPropertyEditor.GetPropTypeUnitName ',hp^.UnitName,' IsSamePropInfo=',CurPropInfo^.PropType=ThePropType]);
NameFound:=true;
if CurPropInfo^.PropType=ThePropType then
Result:=hp^.UnitName;
end;
// skip to next property
CurPropInfo:=PPropInfo(AlignToPtr(Pointer(@CurPropInfo^.Name)+Byte(CurPropInfo^.Name[0])+1));
end;
if not NameFound then break;
// parent class
ATypeInfo:=hp^.ParentInfo;
end;
end;
function TPropertyEditor.GetFloatValue:Extended;
begin
Result:=GetFloatValueAt(0);
@ -2132,18 +2173,6 @@ begin
with FPropList^[Index] do Result:=GetOrdProp(Instance,PropInfo);
end;
(*
function TPropertyEditor.GetPtrValue:Pointer;
begin
Result:=GetPtrValueAt(0);
end;
function TPropertyEditor.GetPtrValueAt(Index:Integer):Pointer;
begin
with FPropList^[Index] do Result:=Pointer(GetOrdProp(Instance,PropInfo));
end;
*)
function TPropertyEditor.GetObjectValue: TObject;
begin
Result:=GetObjectValueAt(0);
@ -3907,7 +3936,8 @@ begin
begin
//writeln('### TMethodPropertyEditor.SetValue E');
CreateNewMethod := IsValidIdent(NewValue) and not NewMethodExists;
SetMethodValue(PropertyHook.CreateMethod(NewValue,GetPropType,GetUnitName));
SetMethodValue(
PropertyHook.CreateMethod(NewValue,GetPropType,GetComponent(0),GetName));
//writeln('### TMethodPropertyEditor.SetValue F NewValue=',GetValue);
if CreateNewMethod then begin
{if (PropCount = 1) and (OldMethod.Data <> nil) and (OldMethod.Code <> nil)
@ -5068,7 +5098,8 @@ end;
{ TPropertyEditorHook }
function TPropertyEditorHook.CreateMethod(const Name:Shortstring;
ATypeInfo:PTypeInfo; const ATypeUnitName: string): TMethod;
ATypeInfo: PTypeInfo;
APropertyOwner: TPersistent; const APropertyName: shortstring): TMethod;
var
i: Integer;
Handler: TPropHookCreateMethod;
@ -5079,7 +5110,7 @@ begin
i:=GetHandlerCount(htCreateMethod);
while GetNextHandlerIndex(htCreateMethod,i) do begin
Handler:=TPropHookCreateMethod(FHandlers[htCreateMethod][i]);
Result:=Handler(Name,ATypeInfo,ATypeUnitName);
Result:=Handler(Name,ATypeInfo,APropertyOwner,APropertyName);
if (Result.Data<>nil) or (Result.Code<>nil) then exit;
end;
end;