IDE+codetools: implemented creating event override for nested components

git-svn-id: trunk@15738 -

components/codetools/codetoolmanager.pas

@@ -649,7 +649,8 @@ type
     function CreatePublishedMethod(Code: TCodeBuffer; const AClassName,
           NewMethodName: string; ATypeInfo: PTypeInfo;
           UseTypeInfoForParameters: boolean = false;
-          const APropertyUnitName: string = ''; const APropertyPath: string = ''
+          const APropertyUnitName: string = ''; const APropertyPath: string = '';
+          const CallAncestorMethod: string = ''
           ): boolean;
 
     // private class parts
@@ -2912,7 +2913,8 @@ end;
 function TCodeToolManager.CreatePublishedMethod(Code: TCodeBuffer;
   const AClassName, NewMethodName: string; ATypeInfo: PTypeInfo;
   UseTypeInfoForParameters: boolean;
-  const APropertyUnitName: string; const APropertyPath: string): boolean;
+  const APropertyUnitName: string; const APropertyPath: string;
+  const CallAncestorMethod: string): boolean;
 begin
   {$IFDEF CTDEBUG}
   DebugLn('TCodeToolManager.CreatePublishedMethod A');
@@ -2923,7 +2925,8 @@ begin
     SourceChangeCache.Clear;
     Result:=FCurCodeTool.CreateMethod(UpperCaseStr(AClassName),
             NewMethodName,ATypeInfo,APropertyUnitName,APropertyPath,
-            SourceChangeCache,UseTypeInfoForParameters,pcsPublished);
+            SourceChangeCache,UseTypeInfoForParameters,pcsPublished,
+            CallAncestorMethod);
   except
     on e: Exception do Result:=HandleException(e);
   end;

components/codetools/eventcodetool.pas

@@ -90,13 +90,15 @@ type
         const APropertyUnitName, APropertyPath: string;
         SourceChangeCache: TSourceChangeCache;
         UseTypeInfoForParameters: boolean = false;
-        Section: TPascalClassSection = pcsPublished): boolean;
+        Section: TPascalClassSection = pcsPublished;
+        const CallAncestorMethod: string = ''): boolean;
     function CreateMethod(ClassNode: TCodeTreeNode;
         const AMethodName: string;
         ATypeInfo: PTypeInfo; const APropertyUnitName, APropertyPath: string;
         SourceChangeCache: TSourceChangeCache;
         UseTypeInfoForParameters: boolean = false;
-        Section: TPascalClassSection = pcsPublished): boolean;
+        Section: TPascalClassSection = pcsPublished;
+        const CallAncestorMethod: string = ''): boolean;
 
     function CreateExprListFromMethodTypeData(TypeData: PTypeData;
         Params: TFindDeclarationParams): TExprTypeList;
@@ -651,7 +653,8 @@ function TEventsCodeTool.CreateMethod(const UpperClassName,
   const APropertyUnitName, APropertyPath: string;
   SourceChangeCache: TSourceChangeCache;
   UseTypeInfoForParameters: boolean;
-  Section: TPascalClassSection): boolean;
+  Section: TPascalClassSection;
+  const CallAncestorMethod: string): boolean;
 var AClassNode: TCodeTreeNode;
 begin
   Result:=false;
@@ -659,14 +662,16 @@ begin
   AClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
   Result:=CreateMethod(AClassNode,AMethodName,ATypeInfo,
                        APropertyUnitName,APropertyPath,
-                       SourceChangeCache,UseTypeInfoForParameters,Section);
+                       SourceChangeCache,UseTypeInfoForParameters,Section,
+                       CallAncestorMethod);
 end;
 
 function TEventsCodeTool.CreateMethod(ClassNode: TCodeTreeNode;
   const AMethodName: string; ATypeInfo: PTypeInfo;
   const APropertyUnitName, APropertyPath: string;
   SourceChangeCache: TSourceChangeCache; UseTypeInfoForParameters: boolean;
-  Section: TPascalClassSection): boolean;
+  Section: TPascalClassSection;
+  const CallAncestorMethod: string): boolean;
 
   procedure AddNeededUnits(const AFindContext: TFindContext);
   var
@@ -733,6 +738,9 @@ var
   FindContext: TFindContext;
   ATypeData: PTypeData;
   NewSection: TNewClassPart;
+  InsertCall: String;
+  ProcBody: String;
+  BeautifyCodeOpts: TBeautifyCodeOptions;
 begin
   Result:=false;
   try
@@ -746,7 +754,7 @@ begin
     CodeCompleteSrcChgCache:=SourceChangeCache;
     // check if method definition already exists in class
     if UseTypeInfoForParameters then begin
-      // do not lookup the declaration in the source
+      // do not lookup the declaration in the source, use RTTI instead
       ATypeData:=GetTypeData(ATypeInfo);
       if ATypeData=nil then exit(false);
       CleanMethodDefinition:=UpperCaseStr(AMethodName)
@@ -765,20 +773,33 @@ begin
       DebugLn('[TEventsCodeTool.CreateMethod] insert method definition to class');
       {$ENDIF}
       // insert method definition into class
+      InsertCall:='';
       if UseTypeInfoForParameters then begin
         MethodDefinition:=MethodTypeDataToStr(ATypeData,
                     [phpWithStart, phpWithoutClassKeyword, phpWithoutClassName,
                      phpWithoutName, phpWithVarModifiers, phpWithParameterNames,
                      phpWithDefaultValues, phpWithResultType]);
+        if CallAncestorMethod<>'' then begin
+          InsertCall:=CallAncestorMethod+MethodTypeDataToStr(ATypeData,
+                      [phpWithoutClassKeyword, phpWithoutClassName,
+                       phpWithoutName, phpWithParameterNames,
+                       phpWithoutParamTypes]);
+        end;
       end else begin
         MethodDefinition:=TrimCodeSpace(FindContext.Tool.ExtractProcHead(
                      FindContext.Node,
                     [phpWithStart, phpWithoutClassKeyword, phpWithoutClassName,
                      phpWithoutName, phpWithVarModifiers, phpWithParameterNames,
                      phpWithDefaultValues, phpWithResultType]));
+        if CallAncestorMethod<>'' then begin
+          InsertCall:=CallAncestorMethod
+                    +TrimCodeSpace(FindContext.Tool.ExtractProcHead(
+                     FindContext.Node,
+                    [phpWithoutClassKeyword, phpWithoutClassName,
+                     phpWithoutName, phpWithParameterNames,
+                     phpWithoutParamTypes]));
+        end;
       end;
-      MethodDefinition:=SourceChangeCache.BeautifyCodeOptions.
-                         AddClassAndNameToProc(MethodDefinition, '', AMethodName);
       {$IFDEF CTDEBUG}
       DebugLn('[TEventsCodeTool.CreateMethod] MethodDefinition="',MethodDefinition,'"');
       {$ENDIF}
@@ -786,8 +807,25 @@ begin
         NewSection:=ncpPublishedProcs
       else
         NewSection:=ncpPrivateProcs;
+      ProcBody:='';
+      if InsertCall<>'' then begin
+        BeautifyCodeOpts:=SourceChangeCache.BeautifyCodeOptions;
+        ProcBody:=SourceChangeCache.BeautifyCodeOptions.
+                         AddClassAndNameToProc(MethodDefinition,
+                         ExtractClassName(CodeCompleteClassNode,false),
+                         AMethodName)
+          +BeautifyCodeOpts.LineEnd
+          +'begin'+BeautifyCodeOpts.LineEnd
+          +GetIndentStr(BeautifyCodeOpts.Indent)
+            +InsertCall+BeautifyCodeOpts.LineEnd
+          +'end;';
+        //DebugLn(['TEventsCodeTool.CreateMethod ProcBody=""',ProcBody,'']);
+      end;
+        
+      MethodDefinition:=SourceChangeCache.BeautifyCodeOptions.
+                         AddClassAndNameToProc(MethodDefinition, '', AMethodName);
       AddClassInsertion(CleanMethodDefinition, MethodDefinition, AMethodName,
-                        NewSection);
+                        NewSection,nil,ProcBody);
     end;
     {$IFDEF CTDEBUG}
     DebugLn('[TEventsCodeTool.CreateMethod] invoke class completion');

ide/main.pp

@@ -13908,6 +13908,12 @@ var
   ActiveUnitInfo: TUnitInfo;
   r: boolean;
   OldChange: Boolean;
+  p: Integer;
+  APropName: String;
+  OldMethod: TMethod;
+  JITMethod: TJITMethod;
+  OverrideMethodName: String;
+  AComponent: TComponent;
 begin
   Result.Code:=nil;
   Result.Data:=nil;
@@ -13919,7 +13925,43 @@ begin
   DebugLn(['[TMainIDE.OnPropHookCreateMethod] Persistent=',dbgsName(APersistent),' Unit=',GetClassUnitName(APersistent.ClassType),' Path=',APropertyPath]);
   {$ENDIF}
   
-  DebugLn(['TMainIDE.OnPropHookCreateMethod ',APropertyPath]);
+  OverrideMethodName:='';
+  if APersistent is TComponent then begin
+    AComponent:=TComponent(APersistent);
+    p:=length(APropertyPath);
+    while (p>0) and (APropertyPath[p]<>'.') do dec(p);
+    if p>0 then begin
+      APropName:=copy(APropertyPath,p+1,length(APropertyPath));
+      OldMethod:=GetMethodProp(APersistent,APropName);
+      if IsJITMethod(OldMethod) then begin
+        // there is an old method
+        JITMethod:=TJITMethod(OldMethod.Data);
+        if JITMethod.ClassType<>ActiveUnitInfo.Component.ClassType then begin
+          // the old method is inherited
+          // => search the component that has the method
+          //DebugLn(['TMainIDE.OnPropHookCreateMethod ',dbgsName(JITMethod.TheClass),' ',dbgsName(APersistent.ClassType),' ',dbgsName(APersistent)]);
+          while (AComponent<>nil)
+          and (not JITMethod.TheClass.InheritsFrom(AComponent.ClassType)) do
+            AComponent:=AComponent.Owner;
+          // create a path to the component
+          while (AComponent<>nil) and (AComponent<>ActiveUnitInfo.Component) do
+          begin
+            if OverrideMethodName<>'' then
+              OverrideMethodName:='.'+OverrideMethodName;
+            OverrideMethodName:=AComponent.Name+OverrideMethodName;
+            AComponent:=AComponent.Owner;
+          end;
+          if (AComponent=ActiveUnitInfo.Component)
+          and (OverrideMethodName<>'') then begin
+            // the old value does not belong to this main component, but to
+            // a nested/inline component
+            OverrideMethodName:=OverrideMethodName+'.'+JITMethod.TheMethodName;
+            DebugLn(['TMainIDE.OnPropHookCreateMethod OverrideMethodName=',OverrideMethodName]);
+          end;
+        end;
+      end;
+    end;
+  end;
 
   OldChange:=OpenEditorsOnCodeToolChange;
   OpenEditorsOnCodeToolChange:=true;
@@ -13927,7 +13969,8 @@ begin
     // create published method
     r:=CodeToolBoss.CreatePublishedMethod(ActiveUnitInfo.Source,
         ActiveUnitInfo.Component.ClassName,AMethodName,
-        ATypeInfo,false,GetClassUnitName(APersistent.ClassType),APropertyPath);
+        ATypeInfo,false,GetClassUnitName(APersistent.ClassType),APropertyPath,
+        OverrideMethodName);
     {$IFDEF IDE_DEBUG}
     writeln('');
     writeln('[TMainIDE.OnPropHookCreateMethod] ************2 ',r,' ',AMethodName);