IDE: implemented auto keeping/closing of poperty referenced designer forms

git-svn-id: trunk@14878 -

ide/include/ide.inc

@@ -34,5 +34,9 @@
 {$DEFINE DisableFakeMethods}
 {$ENDIF}
 
+{$IFDEF EnableMultiFormProperties}
+{$DEFINE VerboseIDEMultiForm}
+{$ENDIF}
+
 // end.
 

ide/main.pp

@@ -627,7 +627,6 @@ type
                                           Flags: TCloseFlags): TModalResult;
     function UnitComponentIsUsed(AnUnitInfo: TUnitInfo;
                                  CheckHasDesigner: boolean): boolean;
-    procedure UpdateUnitComponentDependencies;
 
     // methods for creating a project
     function CreateProjectObject(ProjectDesc,
@@ -5453,7 +5452,7 @@ begin
                    AncestorType,AncestorBinStream,copy(NewUnitName,1,255),true);
       AnUnitInfo.Component:=NewComponent;
       if (AncestorUnitInfo<>nil) then
-        AnUnitInfo.AddRequiresComponentDependency(AncestorUnitInfo);
+        AnUnitInfo.AddRequiresComponentDependency(AncestorUnitInfo,[ucdtAncestor]);
       if NewComponent<>nil then begin
         // component loaded, now load the referenced units
         Result:=DoFixupComponentReferences(AnUnitInfo,OpenFlags);
@@ -5626,6 +5625,11 @@ var
       end;
       RefUnitInfo.Source := UnitCode;
     end;
+    
+    if RefUnitInfo.Component<>nil then begin
+      Result:=mrOk;
+      exit;
+    end;
 
     // load resource hidden
     Result:=DoLoadLFM(RefUnitInfo,LFMCode,
@@ -5674,8 +5678,6 @@ begin
         // b) undo the opening (close the designer forms)
       end;
     end;
-    
-    
   finally
     ReferenceRootNames.Free;
     ReferenceInstanceNames.Free;
@@ -5979,51 +5981,73 @@ var
 begin
   LookupRoot:=AnUnitInfo.Component;
   if LookupRoot=nil then exit(mrOk);
-  //DebugLn(['TMainIDE.CloseUnitComponent ',AnUnitInfo.Filename,' ',dbgsName(LookupRoot)]);
+  {$IFDEF VerboseIDEMultiForm}
+  DebugLn(['TMainIDE.CloseUnitComponent ',AnUnitInfo.Filename,' ',dbgsName(LookupRoot)]);
+  {$ENDIF}
 
-  // save
+  Project1.LockUnitComponentDependencies;
-  if (cfSaveFirst in Flags) and (AnUnitInfo.EditorIndex>=0) then begin
+  try
-    Result:=DoSaveEditorFile(AnUnitInfo.EditorIndex,[sfCheckAmbiguousFiles]);
+    // save
-    if Result<>mrOk then exit;
+    if (cfSaveFirst in Flags) and (AnUnitInfo.EditorIndex>=0) then begin
-  end;
+      Result:=DoSaveEditorFile(AnUnitInfo.EditorIndex,[sfCheckAmbiguousFiles]);
-
+      if Result<>mrOk then exit;
-  // close dependencies
-  if cfCloseDependencies in Flags then begin
-    DumpStack;
-    Result:=CloseDependingUnitComponents(AnUnitInfo,Flags);
-    if Result<>mrOk then exit;
-  end;
-
-  AForm:=FormEditor1.GetDesignerForm(LookupRoot);
-  OldDesigner:=nil;
-  if AForm<>nil then
-    OldDesigner:=TDesigner(AForm.Designer);
-  if FLastFormActivated=AForm then
-    FLastFormActivated:=nil;
-  if (OldDesigner=nil) then begin
-    // hidden component
-    //DebugLn(['TMainIDE.CloseUnitComponent freeing hidden component without designer: ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
-    if UnitComponentIsUsed(AnUnitInfo,false) then begin
-      // hidden component is still used => keep it
-    end else begin
-      // hidden component is not used => free it
-      FormEditor1.DeleteComponent(LookupRoot,true);
-      AnUnitInfo.Component:=nil;
-      FreeUnusedComponents;
     end;
-  end else begin
+
-    // component with designer
+    // close dependencies
-    if UnitComponentIsUsed(AnUnitInfo,false) then begin
+    if cfCloseDependencies in Flags then begin
-      // free designer, keep component hidden
+      {$IFDEF VerboseIDEMultiForm}
-      //DebugLn(['TMainIDE.CloseUnitComponent hiding component and freeing designer: ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
+      DebugLn(['TMainIDE.CloseUnitComponent cfCloseDependencies ',AnUnitInfo.Filename,' ',dbgsName(LookupRoot)]);
-      OldDesigner.FreeDesigner(false);
+      DumpStack;
-    end else begin
+      {$ENDIF}
-      // free designer and design form
+      Result:=CloseDependingUnitComponents(AnUnitInfo,Flags);
-      //DebugLn(['TMainIDE.CloseUnitComponent freeing component and designer: ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
+      if Result<>mrOk then exit;
-      OldDesigner.FreeDesigner(true);
-      AnUnitInfo.Component:=nil;
-      FreeUnusedComponents;
     end;
+
+    AForm:=FormEditor1.GetDesignerForm(LookupRoot);
+    OldDesigner:=nil;
+    if AForm<>nil then
+      OldDesigner:=TDesigner(AForm.Designer);
+    if FLastFormActivated=AForm then
+      FLastFormActivated:=nil;
+    if (OldDesigner=nil) then begin
+      // hidden component
+      //DebugLn(['TMainIDE.CloseUnitComponent freeing hidden component without designer: ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
+      if UnitComponentIsUsed(AnUnitInfo,false) then begin
+        // hidden component is still used => keep it
+        {$IFDEF VerboseIDEMultiForm}
+        DebugLn(['TMainIDE.CloseUnitComponent hidden component is still used => keep it ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
+        {$ENDIF}
+      end else begin
+        // hidden component is not used => free it
+        {$IFDEF VerboseIDEMultiForm}
+        DebugLn(['TMainIDE.CloseUnitComponent hidden component is not used => free it ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
+        {$ENDIF}
+        FormEditor1.DeleteComponent(LookupRoot,true);
+        AnUnitInfo.Component:=nil;
+        AnUnitInfo.ClearComponentDependencies;
+        FreeUnusedComponents;
+      end;
+    end else begin
+      // component with designer
+      if UnitComponentIsUsed(AnUnitInfo,false) then begin
+        // free designer, keep component hidden
+        {$IFDEF VerboseIDEMultiForm}
+        DebugLn(['TMainIDE.CloseUnitComponent hiding component and freeing designer: ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
+        {$ENDIF}
+        OldDesigner.FreeDesigner(false);
+      end else begin
+        // free designer and design form
+        {$IFDEF VerboseIDEMultiForm}
+        DebugLn(['TMainIDE.CloseUnitComponent freeing component and designer: ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
+        {$ENDIF}
+        OldDesigner.FreeDesigner(true);
+        AnUnitInfo.Component:=nil;
+        AnUnitInfo.ClearComponentDependencies;
+        FreeUnusedComponents;
+      end;
+    end;
+  finally
+    Project1.UnlockUnitComponentDependencies;
   end;
 
   Result:=mrOk;
@@ -6038,23 +6062,28 @@ var
 begin
   Result:=mrCancel;
   UserAsked:=false;
-  repeat
+  Project1.LockUnitComponentDependencies;
-    DependingUnitInfo:=Project1.UnitUsingComponentUnit(AnUnitInfo);
+  try
-    if DependingUnitInfo=nil then exit(mrOk);
+    repeat
-    if (not UserAsked) and (not (cfQuiet in Flags)) then begin
+      DependingUnitInfo:=Project1.UnitUsingComponentUnit(AnUnitInfo);
-      Result:=IDEQuestionDialog('Close component?',
+      if DependingUnitInfo=nil then exit(mrOk);
-        'Close component '+dbgsName(DependingUnitInfo.Component)+'?',
+      if (not UserAsked) and (not (cfQuiet in Flags)) then begin
-        mtConfirmation,[mrYes,mrAbort]);
+        Result:=IDEQuestionDialog('Close component?',
-      if Result<>mrYes then exit;
+          'Close component '+dbgsName(DependingUnitInfo.Component)+'?',
-      UserAsked:=true;
+          mtConfirmation,[mrYes,mrAbort]);
-    end;
+        if Result<>mrYes then exit;
-    // close recursively
+        UserAsked:=true;
-    DependenciesFlags:=Flags+[cfCloseDependencies];
+      end;
-    if cfSaveDependencies in Flags then
+      // close recursively
-      Include(DependenciesFlags,cfSaveFirst);
+      DependenciesFlags:=Flags+[cfCloseDependencies];
-    Result:=CloseUnitComponent(DependingUnitInfo,DependenciesFlags);
+      if cfSaveDependencies in Flags then
-    if Result<>mrOk then exit;
+        Include(DependenciesFlags,cfSaveFirst);
-  until false;
+      Result:=CloseUnitComponent(DependingUnitInfo,DependenciesFlags);
+      if Result<>mrOk then exit;
+    until false;
+  finally
+    Project1.UnlockUnitComponentDependencies;
+  end;
 end;
 
 function TMainIDE.UnitComponentIsUsed(AnUnitInfo: TUnitInfo;
@@ -6072,15 +6101,11 @@ begin
     if (AForm<>nil) and (AForm.Designer<>nil) then exit(true);
   end;
   // check if another component uses this component
+  Project1.UpdateUnitComponentDependencies;
   if Project1.UnitUsingComponentUnit(AnUnitInfo)<>nil then
     exit(true);
 end;
 
-procedure TMainIDE.UpdateUnitComponentDependencies;
-begin
-  Project1.UpdateUnitComponentDependencies;
-end;
-
 function TMainIDE.GetAncestorUnit(AnUnitInfo: TUnitInfo): TUnitInfo;
 begin
   if (AnUnitInfo=nil) or (AnUnitInfo.Component=nil) then
@@ -8900,7 +8925,7 @@ begin
         Result:=Project1.SaveStateFile(CompilerFilename,CompilerParams);
         if Result<>mrOk then exit;
 
-        // upate project .po file
+        // update project .po file
         Result:=UpdateProjectPOFile(Project1);
         if Result<>mrOk then exit;
 

ide/project.pp

@@ -47,13 +47,17 @@ uses
 {$IFDEF IDE_MEM_CHECK}
   MemCheck,
 {$ENDIF}
-  Classes, SysUtils, FPCAdds, LCLProc, LCLIntf, LCLType, Forms, Controls,
+  Classes, SysUtils, TypInfo, FPCAdds, LCLProc, LCLIntf, LCLType, Forms,
-  Dialogs, Laz_XMLCfg, LazConf, FileUtil,
+  Controls, Dialogs, Laz_XMLCfg, LazConf, FileUtil,
-  LazarusIDEStrConsts, CompilerOptions, CodeToolManager, CodeCache,
+  // IDEIntf
-  EditorOptions, IDEProcs, RunParamsOpts, ProjectIntf, ProjectDefs, MacroIntf,
+  PropEdits, ProjectIntf, MacroIntf, LazIDEIntf,
-  FileReferenceList, EditDefineTree, DefineTemplates, PackageDefs, LazIDEIntf,
   // for .res files
-  W32VersionInfo, W32Manifest;
+  W32VersionInfo, W32Manifest,
+  // IDE
+  LazarusIDEStrConsts, CompilerOptions, CodeToolManager, CodeCache,
+  EditorOptions, IDEProcs, RunParamsOpts, ProjectDefs,
+  FileReferenceList, EditDefineTree, DefineTemplates, PackageDefs
+  ;
 
 type
   TUnitInfo = class;
@@ -89,6 +93,11 @@ type
     ucdtProperty  // a property references RequiresUnit's component or sub component
     );
   TUnitCompDependencyTypes = set of TUnitCompDependencyType;
+
+const
+  AllUnitCompDependencyTypes = [low(TUnitCompDependencyType)..high(TUnitCompDependencyType)];
+
+type
     
   { TUnitComponentDependency }
 
@@ -240,10 +249,16 @@ type
     function GetSourceText: string; override;
 
     // component dependencies
-    procedure AddRequiresComponentDependency(RequiredUnit: TUnitInfo);
+    function AddRequiresComponentDependency(RequiredUnit: TUnitInfo;
-    procedure RemoveRequiresComponentDependency(RequiredUnit: TUnitInfo);
+                    Types: TUnitCompDependencyTypes
-    function FindComponentDependency(RequiredUnit: TUnitInfo): TUnitComponentDependency;
+                    ): TUnitComponentDependency;
+    procedure RemoveRequiresComponentDependency(RequiredUnit: TUnitInfo;
+                    Types: TUnitCompDependencyTypes);
+    function FindComponentDependency(RequiredUnit: TUnitInfo
+                                     ): TUnitComponentDependency;
     function FindAncestorUnit: TUnitInfo;
+    procedure ClearUnitComponentDependencies(
+                     ClearTypes: TUnitCompDependencyTypes);
   public
     { Properties }
     // Unit lists
@@ -494,7 +509,8 @@ type
     procedure(Sender: TObject; ProjectChanged: boolean) of object;
     
   TLazProjectStateFlag = (
-    lpsfStateFileLoaded
+    lpsfStateFileLoaded,
+    lpsfUnitCompDependenciesNeedUpdate
     );
   TLazProjectStateFlags = set of TLazProjectStateFlag;
     
@@ -521,6 +537,7 @@ type
     FLastCompilerParams: string;
     fLastReadLPIFileDate: TDateTime;
     fLastReadLPIFilename: string;
+    FLockUnitComponentDependencies: integer;
     FMainProject: boolean;
     fMainUnitID: Integer;
     FOnBeginUpdate: TNotifyEvent;
@@ -709,7 +726,11 @@ type
     procedure AddPackageDependency(const PackageName: string); override;
     
     // unit dependencies
+    procedure LockUnitComponentDependencies;
+    procedure UnlockUnitComponentDependencies;
     procedure UpdateUnitComponentDependencies;
+    procedure ClearUnitComponentDependencies(
+                   ClearTypes: TUnitCompDependencyTypes);
 
     // paths
     procedure AddSrcPath(const SrcPathAddition: string); override;
@@ -1336,23 +1357,40 @@ begin
   Result:=Source.Source;
 end;
 
-procedure TUnitInfo.AddRequiresComponentDependency(RequiredUnit: TUnitInfo);
+function TUnitInfo.AddRequiresComponentDependency(RequiredUnit: TUnitInfo;
-var
+  Types: TUnitCompDependencyTypes): TUnitComponentDependency;
-  ADependency: TUnitComponentDependency;
 begin
   if RequiredUnit=nil then RaiseGDBException('inconsistency');
-  ADependency:=TUnitComponentDependency.Create;
+  // search a dependency to this RequiredUnit
-  ADependency.RequiresUnit:=RequiredUnit;
+  Result:=FirstRequiredComponent;
-  ADependency.UsedByUnit:=Self;
+  while Result<>nil do begin
+    if Result.RequiresUnit=RequiredUnit then break;
+    Result:=Result.NextRequiresDependency;
+  end;
+  // if none exists, then create one
+  if Result=nil then
+    Result:=TUnitComponentDependency.Create;
+  Result.RequiresUnit:=RequiredUnit;
+  Result.UsedByUnit:=Self;
+  Result.Types:=Result.Types+Types;
 end;
 
-procedure TUnitInfo.RemoveRequiresComponentDependency(RequiredUnit: TUnitInfo);
+procedure TUnitInfo.RemoveRequiresComponentDependency(RequiredUnit: TUnitInfo;
+  Types: TUnitCompDependencyTypes);
 var
   Dependency: TUnitComponentDependency;
+  NextDependency: TUnitComponentDependency;
 begin
-  Dependency:=FindComponentDependency(RequiredUnit);
+  Dependency:=FirstRequiredComponent;
-  if Dependency<>nil then
+  while Dependency<>nil do begin
-    Dependency.Free;
+    NextDependency:=Dependency.NextRequiresDependency;
+    if (Dependency.RequiresUnit=RequiredUnit) then begin
+      Dependency.Types:=Dependency.Types-Types;
+      if Dependency.Types=[] then
+        Dependency.Free;
+    end;
+    Dependency:=NextDependency;
+  end;
 end;
 
 function TUnitInfo.FindComponentDependency(RequiredUnit: TUnitInfo
@@ -1382,6 +1420,22 @@ begin
   Result:=nil;
 end;
 
+procedure TUnitInfo.ClearUnitComponentDependencies(
+  ClearTypes: TUnitCompDependencyTypes);
+var
+  Dep: TUnitComponentDependency;
+  NextDep: TUnitComponentDependency;
+begin
+  Dep:=FirstRequiredComponent;
+  while Dep<>nil do begin
+    NextDep:=Dep.NextRequiresDependency;
+    Dep.Types:=Dep.Types-ClearTypes;
+    if Dep.Types=[] then
+      Dep.Free;
+    Dep:=NextDep;
+  end;
+end;
+
 function TUnitInfo.ReadOnly: boolean;
 begin
   Result:=UserReadOnly or FileReadOnly;
@@ -3371,9 +3425,106 @@ begin
   AddRequiredDependency(PkgDependency);
 end;
 
-procedure TProject.UpdateUnitComponentDependencies;
+procedure TProject.LockUnitComponentDependencies;
 begin
+  inc(FLockUnitComponentDependencies);
+  if FLockUnitComponentDependencies=1 then begin
+    // update once
+    Include(FStateFlags,lpsfUnitCompDependenciesNeedUpdate);
+  end;
+end;
 
+procedure TProject.UnlockUnitComponentDependencies;
+begin
+  if FLockUnitComponentDependencies=0 then
+    raise Exception.Create('');
+  dec(FLockUnitComponentDependencies);
+end;
+
+procedure TProject.UpdateUnitComponentDependencies;
+
+  procedure Search(AnUnitInfo: TUnitInfo; AComponent: TComponent);
+  // search the published properties of AComponent for references to other units
+  var
+    TypeInfo: PTypeInfo;
+    TypeData: PTypeData;
+    PropInfo: PPropInfo;
+    CurCount: Word;
+    ReferenceComponent: TComponent;
+    OwnerComponent: TComponent;
+    ReferenceUnit: TUnitInfo;
+  begin
+    // read all properties and remove doubles
+    TypeInfo:=PTypeInfo(AComponent.ClassInfo);
+    repeat
+      // read all property infos of current class
+      TypeData:=GetTypeData(TypeInfo);
+      // skip unitname
+      PropInfo:=PPropInfo(PByte(@TypeData^.UnitName)+Length(TypeData^.UnitName)+1);
+      // read property count
+      CurCount:=PWord(PropInfo)^;
+      inc(PtrUInt(PropInfo),SizeOf(Word));
+      
+      // read properties
+      while CurCount>0 do begin
+        // point PropInfo to next propinfo record.
+        // Located at Name[Length(Name)+1] !
+        if (PropInfo^.PropType=ClassTypeInfo(TComponent)) then begin
+          // property of kind TComponent
+          ReferenceComponent:=TComponent(GetObjectProp(AComponent,PropInfo));
+          //debugln('TProject.UpdateUnitComponentDependencies Property ',dbgsName(AComponent),' Name=',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' Value=',dbgsName(ReferenceComponent),' TypeInfo=',TypeInfo^.Name);
+          if ReferenceComponent<>nil then begin
+            OwnerComponent:=ReferenceComponent;
+            while OwnerComponent.Owner<>nil do
+              OwnerComponent:=OwnerComponent.Owner;
+            if OwnerComponent<>AnUnitInfo.Component then begin
+              // property references a component that is not owned
+              // by the current unit
+              ReferenceUnit:=UnitWithComponent(OwnerComponent);
+              if ReferenceUnit<>nil then begin
+                // property references another unit
+                DebugLn(['TProject.UpdateUnitComponentDependencies multi form reference found: ',AnUnitInfo.Filename,' -> ',ReferenceUnit.Filename]);
+                AnUnitInfo.AddRequiresComponentDependency(
+                                     ReferenceUnit,[ucdtProperty]);
+              end;
+            end;
+          end;
+        end;
+        PropInfo:=PPropInfo(pointer(@PropInfo^.Name)+PByte(@PropInfo^.Name)^+1);
+        dec(CurCount);
+      end;
+      TypeInfo:=TypeData^.ParentInfo;
+    until TypeInfo=nil;
+  end;
+
+var
+  AnUnitInfo: TUnitInfo;
+  i: Integer;
+begin
+  if (FLockUnitComponentDependencies>0)
+  and (not (lpsfUnitCompDependenciesNeedUpdate in FStateFlags)) then begin
+    // the dependencies are locked and up2date
+    exit;
+  end;
+  Exclude(FStateFlags,lpsfUnitCompDependenciesNeedUpdate);
+  ClearUnitComponentDependencies([ucdtProperty]);
+  DebugLn(['TProject.UpdateUnitComponentDependencies ']);
+  AnUnitInfo:=FirstUnitWithComponent;
+  while AnUnitInfo<>nil do begin
+    Search(AnUnitInfo,AnUnitInfo.Component);
+    for i:=AnUnitInfo.Component.ComponentCount-1 downto 0 do
+      Search(AnUnitInfo,AnUnitInfo.Component.Components[i]);
+    AnUnitInfo:=AnUnitInfo.NextUnitWithComponent;
+  end;
+end;
+
+procedure TProject.ClearUnitComponentDependencies(
+  ClearTypes: TUnitCompDependencyTypes);
+var
+  i: Integer;
+begin
+  for i:=UnitCount-1 downto 0 do
+    Units[i].ClearUnitComponentDependencies(ClearTypes);
 end;
 
 procedure TProject.AddSrcPath(const SrcPathAddition: string);
@@ -3679,8 +3830,8 @@ function TProject.UnitUsingComponentUnit(ComponentUnit: TUnitInfo): TUnitInfo;
 begin
   Result:=nil;
   if ComponentUnit.Component=nil then exit;
-  Result:=UnitComponentInheritingFrom(
+  if ComponentUnit.FirstUsedByComponent=nil then exit;
-              TComponentClass(ComponentUnit.Component.ClassType),ComponentUnit);
+  Result:=ComponentUnit.FirstUsedByComponent.UsedByUnit;
 end;
 
 function TProject.UnitInfoWithFilename(const AFilename: string): TUnitInfo;