mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-07-24 12:56:01 +02:00
IDE: method property editor: edit: ask whether jump to inherited or add override
git-svn-id: trunk@55206 -
This commit is contained in:
mattias
parent
4975382c55
commit
b29915c159
@ -400,7 +400,7 @@ type
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
function ApplyClassCompletion(AddMissingProcBodies: boolean): boolean;
|
||||
function ProcExistsInCodeCompleteClass(
|
||||
const NameAndParamsUpCase: string): boolean;
|
||||
const NameAndParamsUpCase: string; SearchInAncestors: boolean = true): boolean;
|
||||
function VarExistsInCodeCompleteClass(const UpperName: string): boolean;
|
||||
procedure AddClassInsertion(
|
||||
const CleanDef, Def, IdentifierName: string;
|
||||
@ -474,7 +474,7 @@ end;
|
||||
{ TCodeCompletionCodeTool }
|
||||
|
||||
function TCodeCompletionCodeTool.ProcExistsInCodeCompleteClass(
|
||||
const NameAndParamsUpCase: string): boolean;
|
||||
const NameAndParamsUpCase: string; SearchInAncestors: boolean): boolean;
|
||||
// NameAndParams should be uppercase and contains the proc name and the
|
||||
// parameter list without names and default values
|
||||
// and should not contain any comments and no result type
|
||||
@ -495,7 +495,7 @@ begin
|
||||
end;
|
||||
// search in current class
|
||||
Result:=(FindProcNode(FCompletingFirstEntryNode,NameAndParamsUpCase,mgMethod,[phpInUpperCase])<>nil);
|
||||
if not Result then
|
||||
if (not Result) and SearchInAncestors then
|
||||
begin
|
||||
//search in ancestor classes
|
||||
Params:=TFindDeclarationParams.Create;
|
||||
|
||||
@ -855,7 +855,7 @@ type
|
||||
NewMethodName: string; ATypeInfo: PTypeInfo;
|
||||
UseTypeInfoForParameters: boolean = false;
|
||||
const APropertyUnitName: string = ''; const APropertyPath: string = '';
|
||||
const CallAncestorMethod: string = ''
|
||||
const CallAncestorMethod: string = ''; AddOverride: boolean = false
|
||||
): boolean;
|
||||
|
||||
// private class parts
|
||||
@ -3856,9 +3856,9 @@ end;
|
||||
|
||||
function TCodeToolManager.CreatePublishedMethod(Code: TCodeBuffer;
|
||||
const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
|
||||
UseTypeInfoForParameters: boolean;
|
||||
const APropertyUnitName: string; const APropertyPath: string;
|
||||
const CallAncestorMethod: string): boolean;
|
||||
UseTypeInfoForParameters: boolean; const APropertyUnitName: string;
|
||||
const APropertyPath: string; const CallAncestorMethod: string;
|
||||
AddOverride: boolean): boolean;
|
||||
begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeToolManager.CreatePublishedMethod A');
|
||||
@ -3870,7 +3870,7 @@ begin
|
||||
Result:=FCurCodeTool.CreateMethod(AClassName,
|
||||
NewMethodName,ATypeInfo,APropertyUnitName,APropertyPath,
|
||||
SourceChangeCache,UseTypeInfoForParameters,pcsPublished,
|
||||
CallAncestorMethod);
|
||||
CallAncestorMethod,AddOverride);
|
||||
except
|
||||
on e: Exception do Result:=HandleException(e);
|
||||
end;
|
||||
|
||||
@ -103,14 +103,16 @@ type
|
||||
SourceChangeCache: TSourceChangeCache;
|
||||
UseTypeInfoForParameters: boolean = false;
|
||||
Section: TPascalClassSection = pcsPublished;
|
||||
const CallAncestorMethod: string = ''): boolean;
|
||||
const CallAncestorMethod: string = '';
|
||||
AddOverride: boolean = false): boolean;
|
||||
function CreateMethod(ClassNode: TCodeTreeNode;
|
||||
const AMethodName: string;
|
||||
ATypeInfo: PTypeInfo; const APropertyUnitName, APropertyPath: string;
|
||||
SourceChangeCache: TSourceChangeCache;
|
||||
UseTypeInfoForParameters: boolean = false;
|
||||
Section: TPascalClassSection = pcsPublished;
|
||||
const CallAncestorMethod: string = ''): boolean;
|
||||
const CallAncestorMethod: string = '';
|
||||
AddOverride: boolean = false): boolean;
|
||||
|
||||
function FindClassOfInstance(Instance: TObject;
|
||||
out FindContext: TFindContext; ExceptionOnNotFound: boolean): boolean;
|
||||
@ -725,9 +727,9 @@ begin
|
||||
exit;
|
||||
end;
|
||||
SrcClassName:=SrcTool.ExtractClassName(ClassNode,true);
|
||||
ANode:=SrcTool.FindMethodNodeInImplementation(SrcClassName,AMethodName,false);
|
||||
ANode:=SrcTool.FindMethodNodeInImplementation(SrcClassName,AMethodName,true);
|
||||
if ANode=nil then begin
|
||||
DebugLn(['TEventsCodeTool.JumpToPublishedMethodBody method not found ',SrcClassName,'.',AMethodName,' in ',SrcTool.MainFilename]);
|
||||
DebugLn(['TEventsCodeTool.JumpToPublishedMethodBody method body not found ',SrcClassName,'.',AMethodName,' in ',SrcTool.MainFilename]);
|
||||
if ErrorOnNotFound then
|
||||
RaiseExceptionFmt(20170421202044,'implementation of method "%s.%s" in %s', [AClassName,AMethodName,SrcTool.MainFilename]);
|
||||
exit;
|
||||
@ -824,13 +826,11 @@ begin
|
||||
Result:=SourceChangeCache.Apply;
|
||||
end;
|
||||
|
||||
function TEventsCodeTool.CreateMethod(const AClassName,
|
||||
AMethodName: string; ATypeInfo: PTypeInfo;
|
||||
const APropertyUnitName, APropertyPath: string;
|
||||
SourceChangeCache: TSourceChangeCache;
|
||||
UseTypeInfoForParameters: boolean;
|
||||
Section: TPascalClassSection;
|
||||
const CallAncestorMethod: string): boolean;
|
||||
function TEventsCodeTool.CreateMethod(const AClassName, AMethodName: string;
|
||||
ATypeInfo: PTypeInfo; const APropertyUnitName, APropertyPath: string;
|
||||
SourceChangeCache: TSourceChangeCache; UseTypeInfoForParameters: boolean;
|
||||
Section: TPascalClassSection; const CallAncestorMethod: string;
|
||||
AddOverride: boolean): boolean;
|
||||
var AClassNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
@ -839,15 +839,14 @@ begin
|
||||
Result:=CreateMethod(AClassNode,AMethodName,ATypeInfo,
|
||||
APropertyUnitName,APropertyPath,
|
||||
SourceChangeCache,UseTypeInfoForParameters,Section,
|
||||
CallAncestorMethod);
|
||||
CallAncestorMethod,AddOverride);
|
||||
end;
|
||||
|
||||
function TEventsCodeTool.CreateMethod(ClassNode: TCodeTreeNode;
|
||||
const AMethodName: string; ATypeInfo: PTypeInfo;
|
||||
const APropertyUnitName, APropertyPath: string;
|
||||
SourceChangeCache: TSourceChangeCache; UseTypeInfoForParameters: boolean;
|
||||
Section: TPascalClassSection;
|
||||
const CallAncestorMethod: string): boolean;
|
||||
const AMethodName: string; ATypeInfo: PTypeInfo; const APropertyUnitName,
|
||||
APropertyPath: string; SourceChangeCache: TSourceChangeCache;
|
||||
UseTypeInfoForParameters: boolean; Section: TPascalClassSection;
|
||||
const CallAncestorMethod: string; AddOverride: boolean): boolean;
|
||||
|
||||
procedure AddNeededUnits(const AFindContext: TFindContext);
|
||||
var
|
||||
@ -933,8 +932,15 @@ begin
|
||||
try
|
||||
if (ClassNode=nil) or (not (ClassNode.Desc in [ctnClass,ctnObjCClass])) or (AMethodName='')
|
||||
or (ATypeInfo=nil) or (SourceChangeCache=nil) or (Scanner=nil) then exit;
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn(['[TEventsCodeTool.CreateMethod] A AMethodName="',AMethodName,'" in "',MainFilename,'" UseTypeInfoForParameters=',UseTypeInfoForParameters]);
|
||||
if CallAncestorMethod<>'' then
|
||||
AddOverride:=true;
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
DebugLn(['[TEventsCodeTool.CreateMethod] A AMethodName="',AMethodName,'" in "',MainFilename,'"',
|
||||
' APropertyUnitName="',APropertyUnitName,'"',
|
||||
' APropertyPath="',APropertyPath,'"',
|
||||
' UseTypeInfoForParameters=',UseTypeInfoForParameters,
|
||||
' CallAncestorMethod="',CallAncestorMethod,'"',
|
||||
' AddOverride=',AddOverride]);
|
||||
{$ENDIF}
|
||||
// initialize class for code completion
|
||||
CodeCompleteClassNode:=ClassNode;
|
||||
@ -955,8 +961,8 @@ begin
|
||||
+FindContext.Tool.ExtractProcHead(FindContext.Node,
|
||||
[phpWithoutClassName, phpWithoutName, phpInUpperCase]);
|
||||
end;
|
||||
if not ProcExistsInCodeCompleteClass(CleanMethodDefinition) then begin
|
||||
{$IFDEF CTDEBUG}
|
||||
if not ProcExistsInCodeCompleteClass(CleanMethodDefinition,not AddOverride) then begin
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
DebugLn('[TEventsCodeTool.CreateMethod] insert method definition to class');
|
||||
{$ENDIF}
|
||||
// insert method definition into class
|
||||
@ -989,7 +995,7 @@ begin
|
||||
phpWithoutParamTypes]));
|
||||
end;
|
||||
end;
|
||||
{$IFDEF CTDEBUG}
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
DebugLn('[TEventsCodeTool.CreateMethod] MethodDefinition="',MethodDefinition,'"');
|
||||
{$ENDIF}
|
||||
if Section in [pcsPublished,pcsPublic] then
|
||||
@ -1016,7 +1022,7 @@ begin
|
||||
AddClassInsertion(CleanMethodDefinition, MethodDefinition, AMethodName,
|
||||
NewSection,nil,ProcBody);
|
||||
end;
|
||||
{$IFDEF CTDEBUG}
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
DebugLn('[TEventsCodeTool.CreateMethod] invoke class completion');
|
||||
{$ENDIF}
|
||||
if not InsertAllNewClassParts then
|
||||
@ -1029,7 +1035,7 @@ begin
|
||||
// apply the changes
|
||||
if not SourceChangeCache.Apply then
|
||||
RaiseException(20170421202122,ctsUnableToApplyChanges);
|
||||
{$IFDEF CTDEBUG}
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
DebugLn('[TEventsCodeTool.CreateMethod] END');
|
||||
{$ENDIF}
|
||||
Result:=true;
|
||||
|
||||
@ -1261,6 +1261,7 @@ type
|
||||
TPropHookRenameMethod = procedure(const CurName, NewName: String) of object;
|
||||
TPropHookShowMethod = procedure(const Name: String) of object;
|
||||
TPropHookMethodFromAncestor = function(const Method:TMethod):boolean of object;
|
||||
TPropHookMethodFromLookupRoot = function(const Method:TMethod):boolean of object;
|
||||
TPropHookChainCall = procedure(const AMethodName, InstanceName,
|
||||
InstanceMethod:ShortString; TypeData:PTypeData) of object;
|
||||
// components
|
||||
@ -1319,6 +1320,7 @@ type
|
||||
htRenameMethod,
|
||||
htShowMethod,
|
||||
htMethodFromAncestor,
|
||||
htMethodFromLookupRoot,
|
||||
htChainCall,
|
||||
// components
|
||||
htGetComponent,
|
||||
@ -1392,6 +1394,7 @@ type
|
||||
procedure RenameMethod(const CurName, NewName: String);
|
||||
procedure ShowMethod(const aName: String);
|
||||
function MethodFromAncestor(const Method: TMethod): boolean;
|
||||
function MethodFromLookupRoot(const Method: TMethod): boolean;
|
||||
procedure ChainCall(const AMethodName, InstanceName,
|
||||
InstanceMethod: ShortString; TypeData: PTypeData);
|
||||
// components
|
||||
@ -1470,6 +1473,10 @@ type
|
||||
const OnMethodFromAncestor: TPropHookMethodFromAncestor);
|
||||
procedure RemoveHandlerMethodFromAncestor(
|
||||
const OnMethodFromAncestor: TPropHookMethodFromAncestor);
|
||||
procedure AddHandlerMethodFromLookupRoot(
|
||||
const OnMethodFromLookupRoot: TPropHookMethodFromLookupRoot);
|
||||
procedure RemoveHandlerMethodFromLookupRoot(
|
||||
const OnMethodFromLookupRoot: TPropHookMethodFromLookupRoot);
|
||||
procedure AddHandlerChainCall(const OnChainCall: TPropHookChainCall);
|
||||
procedure RemoveHandlerChainCall(const OnChainCall: TPropHookChainCall);
|
||||
// component event
|
||||
@ -4592,25 +4599,54 @@ var
|
||||
begin
|
||||
NewMethodName := GetValue;
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.Edit OldValue="',NewMethodName,'"']);
|
||||
debugln(['TMethodPropertyEditor.Edit OldValue="',NewMethodName,'" FromLookupRoot=',(LazIsValidIdent(NewMethodName, True, True) and PropertyHook.MethodFromLookupRoot(GetMethodValue))]);
|
||||
DumpStack;
|
||||
{$ENDIF}
|
||||
if not LazIsValidIdent(NewMethodName, True, True)
|
||||
or PropertyHook.MethodFromAncestor(GetMethodValue) then
|
||||
if IsValidIdent(NewMethodName)
|
||||
and PropertyHook.MethodFromLookupRoot(GetMethodValue) then
|
||||
begin
|
||||
// the current method is from the ancestor
|
||||
// -> add an override with the default name
|
||||
NewMethodName := GetFormMethodName;
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.Edit NewValue="',NewMethodName,'"']);
|
||||
debugln(['TMethodPropertyEditor.Edit Show']);
|
||||
{$ENDIF}
|
||||
if not IsValidIdent(NewMethodName) then
|
||||
raise EPropertyError.Create('Method name "'+NewMethodName+'" must be an identifier');
|
||||
SetValue(NewMethodName); // this will jump to the method
|
||||
PropertyHook.RefreshPropertyValues;
|
||||
end
|
||||
else
|
||||
PropertyHook.ShowMethod(NewMethodName);
|
||||
end else begin
|
||||
// the current method is from the another class (e.g. ancestor or frame)
|
||||
case QuestionDlg('Override or jump',
|
||||
'The event "'+GetName+'" currently points to an inherited method.',
|
||||
mtConfirmation,[mrYes,'Create Override',mrOk,'Jump to inherited method',mrCancel],
|
||||
0) of
|
||||
mrYes:
|
||||
begin
|
||||
// -> add an override with the default name
|
||||
NewMethodName := GetFormMethodName;
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.Edit NewValue="',NewMethodName,'"']);
|
||||
{$ENDIF}
|
||||
if not IsValidIdent(NewMethodName) then
|
||||
raise EPropertyError.Create('Method name "'+NewMethodName+'" must be an identifier');
|
||||
NewMethodName:=PropertyHook.LookupRoot.ClassName+'.'+NewMethodName;
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.Edit CreateMethod "',NewMethodName,'"...']);
|
||||
{$ENDIF}
|
||||
SetMethodValue(
|
||||
PropertyHook.CreateMethod(NewMethodName, GetPropType,
|
||||
GetComponent(0), GetPropertyPath(0)));
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.Edit CHANGED new method=',GetValue]);
|
||||
{$ENDIF}
|
||||
PropertyHook.RefreshPropertyValues;
|
||||
ShowValue;
|
||||
end;
|
||||
mrOk:
|
||||
begin
|
||||
// -> jump to ancestor method
|
||||
{$IFDEF VerboseMethodPropEdit}
|
||||
debugln(['TMethodPropertyEditor.Edit Jump to ancestor method ',NewMethodName]);
|
||||
{$ENDIF}
|
||||
PropertyHook.ShowMethod(NewMethodName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMethodPropertyEditor.ShowValue;
|
||||
@ -6029,7 +6065,7 @@ var
|
||||
begin
|
||||
Result.Code := nil;
|
||||
Result.Data := nil;
|
||||
if IsValidIdent(aName) and Assigned(ATypeInfo) then
|
||||
if LazIsValidIdent(aName,true,true) and Assigned(ATypeInfo) then
|
||||
begin
|
||||
i := GetHandlerCount(htCreateMethod);
|
||||
while GetNextHandlerIndex(htCreateMethod, i) do
|
||||
@ -6181,6 +6217,29 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPropertyEditorHook.MethodFromLookupRoot(const Method: TMethod
|
||||
): boolean;
|
||||
var
|
||||
Root: TPersistent;
|
||||
i: Integer;
|
||||
Handler: TPropHookMethodFromLookupRoot;
|
||||
begin
|
||||
// check if given Method is in LookupRoot source,
|
||||
Root:=LookupRoot;
|
||||
if Root=nil then exit(false);
|
||||
i := GetHandlerCount(htMethodFromLookupRoot);
|
||||
if GetNextHandlerIndex(htMethodFromLookupRoot, i) then
|
||||
begin
|
||||
Handler := TPropHookMethodFromLookupRoot(FHandlers[htMethodFromLookupRoot][i]);
|
||||
Result := Handler(Method);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := (TObject(Method.Data)=Root) and Assigned(Method.Code)
|
||||
and (Root.MethodName(Method.Code)<>'');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPropertyEditorHook.ChainCall(const AMethodName, InstanceName,
|
||||
InstanceMethod: ShortString; TypeData: PTypeData);
|
||||
var
|
||||
@ -6784,6 +6843,18 @@ begin
|
||||
RemoveHandler(htMethodFromAncestor,TMethod(OnMethodFromAncestor));
|
||||
end;
|
||||
|
||||
procedure TPropertyEditorHook.AddHandlerMethodFromLookupRoot(
|
||||
const OnMethodFromLookupRoot: TPropHookMethodFromLookupRoot);
|
||||
begin
|
||||
AddHandler(htMethodFromLookupRoot,TMethod(OnMethodFromLookupRoot));
|
||||
end;
|
||||
|
||||
procedure TPropertyEditorHook.RemoveHandlerMethodFromLookupRoot(
|
||||
const OnMethodFromLookupRoot: TPropHookMethodFromLookupRoot);
|
||||
begin
|
||||
RemoveHandler(htMethodFromLookupRoot,TMethod(OnMethodFromLookupRoot));
|
||||
end;
|
||||
|
||||
procedure TPropertyEditorHook.AddHandlerChainCall(
|
||||
const OnChainCall: TPropHookChainCall);
|
||||
begin
|
||||
|
||||
81
ide/main.pp
81
ide/main.pp
@ -525,6 +525,8 @@ type
|
||||
APersistent: TPersistent;
|
||||
const APropertyPath: string): TMethod;
|
||||
procedure PropHookShowMethod(const AMethodName: String);
|
||||
function PropHookMethodFromAncestor(const Method: TMethod): boolean;
|
||||
function PropHookMethodFromLookupRoot(const Method: TMethod): boolean;
|
||||
procedure PropHookRenameMethod(const CurName, NewName: String);
|
||||
function PropHookBeforeAddPersistent(Sender: TObject;
|
||||
APersistentClass: TPersistentClass;
|
||||
@ -2086,6 +2088,8 @@ begin
|
||||
GlobalDesignHook.AddHandlerMethodExists(@PropHookMethodExists);
|
||||
GlobalDesignHook.AddHandlerCreateMethod(@PropHookCreateMethod);
|
||||
GlobalDesignHook.AddHandlerShowMethod(@PropHookShowMethod);
|
||||
GlobalDesignHook.AddHandlerMethodFromAncestor(@PropHookMethodFromAncestor);
|
||||
GlobalDesignHook.AddHandlerMethodFromLookupRoot(@PropHookMethodFromLookupRoot);
|
||||
GlobalDesignHook.AddHandlerRenameMethod(@PropHookRenameMethod);
|
||||
GlobalDesignHook.AddHandlerBeforeAddPersistent(@PropHookBeforeAddPersistent);
|
||||
GlobalDesignHook.AddHandlerComponentRenamed(@PropHookComponentRenamed);
|
||||
@ -12503,7 +12507,11 @@ end;
|
||||
function TMainIDE.PropHookCreateMethod(const AMethodName: ShortString;
|
||||
ATypeInfo: PTypeInfo;
|
||||
APersistent: TPersistent; const APropertyPath: string): TMethod;
|
||||
{ APersistent is the instance that gets the new method, not the lookuproot.
|
||||
{ AMethodName is the name of the published method in the LookupRoot (class or ancestors)
|
||||
It can take the explicit form LookupRootClassName.MethodName to create an
|
||||
override for an ancestor method.
|
||||
|
||||
APersistent is the instance that gets the new method, not the lookuproot.
|
||||
For example assign 'Button1Click' to Form1.Button1.OnClick:
|
||||
APersistent = APersistent
|
||||
AMethodName = 'Button1Click'
|
||||
@ -12616,8 +12624,8 @@ var
|
||||
var
|
||||
r: boolean;
|
||||
OldChange: Boolean;
|
||||
InheritedMethodPath: String;
|
||||
UseRTTIForMethods: Boolean;
|
||||
InheritedMethodPath, MethodClassName, ShortMethodName: String;
|
||||
UseRTTIForMethods, AddOverride: Boolean;
|
||||
begin
|
||||
Result.Code:=nil;
|
||||
Result.Data:=nil;
|
||||
@ -12635,28 +12643,45 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
if IsValidIdentPair(AMethodName,MethodClassName,ShortMethodName) then
|
||||
begin
|
||||
if CompareText(MethodClassName,ActiveUnitInfo.Component.ClassName)<>0 then
|
||||
begin
|
||||
debugln(['TMainIDE.PropHookCreateMethod wrong class AMethodName="',AMethodName,'" lookuproot=',DbgSName(ActiveUnitInfo.Component)]);
|
||||
raise Exception.Create('Invalid classname "'+AMethodName+'"');
|
||||
end;
|
||||
AddOverride:=true;
|
||||
end else begin
|
||||
MethodClassName:='';
|
||||
ShortMethodName:=AMethodName;
|
||||
AddOverride:=false;
|
||||
end;
|
||||
|
||||
InheritedMethodPath:=GetInheritedMethodPath;
|
||||
OldChange:=OpenEditorsOnCodeToolChange;
|
||||
OpenEditorsOnCodeToolChange:=true;
|
||||
UseRTTIForMethods:=FormEditor1.ComponentUsesRTTIForMethods(ActiveUnitInfo.Component);
|
||||
try
|
||||
// create published method
|
||||
// create published method in active unit
|
||||
{$IFDEF VerboseOnPropHookCreateMethod}
|
||||
debugln(['TMainIDE.OnPropHookCreateMethod CreatePublishedMethod ',ActiveUnitInfo.Source.Filename,' LookupRoot=',ActiveUnitInfo.Component.ClassName,' AMethodName="',AMethodName,'" PropertyUnit=',GetClassUnitName(APersistent.ClassType),' APropertyPath="',APropertyPath,'" CallInherited=',InheritedMethodPath]);
|
||||
debugln(['TMainIDE.OnPropHookCreateMethod CreatePublishedMethod ',ActiveUnitInfo.Source.Filename,' LookupRoot=',ActiveUnitInfo.Component.ClassName,' ShortMethodName="',ShortMethodName,'" PropertyUnit=',GetClassUnitName(APersistent.ClassType),' APropertyPath="',APropertyPath,'" CallInherited=',InheritedMethodPath]);
|
||||
{$ENDIF}
|
||||
r:=CodeToolBoss.CreatePublishedMethod(ActiveUnitInfo.Source,
|
||||
ActiveUnitInfo.Component.ClassName,AMethodName,
|
||||
ATypeInfo,UseRTTIForMethods,GetClassUnitName(APersistent.ClassType),APropertyPath,
|
||||
InheritedMethodPath);
|
||||
ActiveUnitInfo.Component.ClassName,ShortMethodName,
|
||||
ATypeInfo,UseRTTIForMethods,GetClassUnitName(APersistent.ClassType),
|
||||
APropertyPath,InheritedMethodPath,AddOverride);
|
||||
{$IFDEF VerboseOnPropHookCreateMethod}
|
||||
debugln(['[TMainIDE.OnPropHookCreateMethod] ************ ',dbgs(r),' AMethodName="',AMethodName,'"']);
|
||||
debugln(['[TMainIDE.OnPropHookCreateMethod] ************ ',dbgs(r),' ShortMethodName="',ShortMethodName,'"']);
|
||||
{$ENDIF}
|
||||
ApplyCodeToolChanges;
|
||||
if r then begin
|
||||
Result:=FormEditor1.CreateNewJITMethod(ActiveUnitInfo.Component,
|
||||
AMethodName);
|
||||
ShortMethodName);
|
||||
{$IFDEF VerboseOnPropHookCreateMethod}
|
||||
debugln(['TMainIDE.PropHookCreateMethod JITClass=',TJITMethod(Result.Data).TheClass.ClassName]);
|
||||
{$ENDIF}
|
||||
end else begin
|
||||
DebugLn(['Error: (lazarus) TMainIDE.OnPropHookCreateMethod failed adding method "'+AMethodName+'" to source']);
|
||||
DebugLn(['Error: (lazarus) TMainIDE.OnPropHookCreateMethod failed adding method "'+ShortMethodName+'" to source']);
|
||||
DoJumpToCodeToolBossError;
|
||||
raise Exception.Create(lisUnableToCreateNewMethod+' '+lisPleaseFixTheErrorInTheMessageWindow);
|
||||
end;
|
||||
@ -12713,6 +12738,40 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainIDE.PropHookMethodFromAncestor(const Method: TMethod): boolean;
|
||||
var
|
||||
AncestorClass: TClass;
|
||||
JITMethod: TJITMethod;
|
||||
begin
|
||||
Result:=false;
|
||||
if Method.Code<>nil then begin
|
||||
if Method.Data<>nil then begin
|
||||
AncestorClass := TObject(Method.Data).ClassParent;
|
||||
Result := Assigned(AncestorClass) and (AncestorClass.MethodName(Method.Code)<>'');
|
||||
end;
|
||||
end
|
||||
else if IsJITMethod(Method) then begin
|
||||
JITMethod:=TJITMethod(Method.Data);
|
||||
Result:=(GlobalDesignHook.LookupRoot<>nil) and
|
||||
GlobalDesignHook.LookupRoot.InheritsFrom(JITMethod.TheClass);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainIDE.PropHookMethodFromLookupRoot(const Method: TMethod): boolean;
|
||||
var
|
||||
Root: TPersistent;
|
||||
JITMethod: TJITMethod;
|
||||
begin
|
||||
Root:=GlobalDesignHook.LookupRoot;
|
||||
if Root=nil then exit(false);
|
||||
if TObject(Method.Data)=Root then begin
|
||||
Result:=(Method.Code<>nil) and (Root.MethodName(Method.Code)<>'');
|
||||
end else if IsJITMethod(Method) then begin
|
||||
JITMethod:=TJITMethod(Method.Data);
|
||||
Result:=Root.ClassType=JITMethod.TheClass;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainIDE.PropHookRenameMethod(const CurName, NewName: String);
|
||||
var
|
||||
ActiveSrcEdit: TSourceEditor;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user