From b29915c15937f90e5aff6f8f973e59ed34d38a13 Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 4 Jun 2017 09:21:06 +0000 Subject: [PATCH] IDE: method property editor: edit: ask whether jump to inherited or add override git-svn-id: trunk@55206 - --- components/codetools/codecompletiontool.pas | 6 +- components/codetools/codetoolmanager.pas | 10 +-- components/codetools/eventcodetool.pas | 54 ++++++----- components/ideintf/propedits.pp | 99 ++++++++++++++++++--- ide/main.pp | 81 ++++++++++++++--- 5 files changed, 193 insertions(+), 57 deletions(-) diff --git a/components/codetools/codecompletiontool.pas b/components/codetools/codecompletiontool.pas index 3e3dff3135..869adf3db6 100644 --- a/components/codetools/codecompletiontool.pas +++ b/components/codetools/codecompletiontool.pas @@ -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; diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 84a9154ca9..ccd20c60e8 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -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; diff --git a/components/codetools/eventcodetool.pas b/components/codetools/eventcodetool.pas index 6e1edd7436..8de2a406f1 100644 --- a/components/codetools/eventcodetool.pas +++ b/components/codetools/eventcodetool.pas @@ -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; diff --git a/components/ideintf/propedits.pp b/components/ideintf/propedits.pp index 51aaa9ea9a..9fe7642975 100644 --- a/components/ideintf/propedits.pp +++ b/components/ideintf/propedits.pp @@ -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 diff --git a/ide/main.pp b/ide/main.pp index bb6f021948..0a2ea35016 100644 --- a/ide/main.pp +++ b/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;