project groups: load/save project specific group settings

git-svn-id: trunk@50429 -

components/projectgroups/projectgroup.pp

@@ -41,6 +41,8 @@ type
     function GetRequiredPackages(Index: integer): TPGDependency; override;
     procedure LoadPackage;
     procedure LoadProject;
+    procedure LoadProject_GroupSettings(XMLConfig: TXMLConfig; aPath: string);
+    procedure SaveProject_GroupSettings(XMLConfig: TXMLConfig; aPath: string);
     procedure LoadProjectGroup(Recursively: boolean);
     function ProjectAction(AAction: TPGTargetAction): TPGActionResult;
     function PackageAction(AAction: TPGTargetAction): TPGActionResult;
@@ -52,8 +54,11 @@ type
     procedure ActiveChanged(Sender: TPGCompileTarget); override;
   public
     procedure LoadTarget(Recursively: boolean); virtual;
+    procedure LoadGroupSettings(XMLConfig: TXMLConfig; aPath: string);
+    procedure SaveGroupSettings(XMLConfig: TXMLConfig; aPath: string);
     procedure UnLoadTarget; virtual;
     destructor Destroy; override;
+    procedure Modified; override;
   end;
 
   // Since a project group iself is also a target, we need a target to represent
@@ -208,6 +213,7 @@ var
   OpenRecentProjectGroupSubMenu: TIDEMenuSection;
 
 function LoadXML(aFilename: string; Quiet: boolean): TXMLConfig;
+function CreateXML(aFilename: string; Quiet: boolean): TXMLConfig;
 function GetLazBuildFilename: string;
 
 implementation
@@ -220,6 +226,8 @@ begin
   aFilename:=TrimFilename(aFilename);
   if (aFilename='') or (not FilenameIsAbsolute(aFilename)) then begin
     debugln(['Error: (lazarus) [TIDECompileTarget.LoadXML] invalid filename "',aFilename,'"']);
+    if not Quiet then
+      IDEMessageDialog('Invalid File','Invalid xml file name "'+aFilename+'"',mtError,[mbOk]);
     exit;
   end;
   Code:=CodeToolBoss.LoadFile(aFilename,true,false);
@@ -240,6 +248,25 @@ begin
   end;
 end;
 
+function CreateXML(aFilename: string; Quiet: boolean): TXMLConfig;
+begin
+  Result:=nil;
+  aFilename:=TrimFilename(aFilename);
+  if (aFilename='') or (not FilenameIsAbsolute(aFilename)) then begin
+    debugln(['Error: (lazarus) [TIDECompileTarget.CreateXML] invalid filename "',aFilename,'"']);
+    exit;
+  end;
+  try
+    Result:=TXMLConfig.CreateClean(aFilename);
+  except
+    on E: Exception do begin
+      debugln(['Error: (lazarus) [TIDECompileTarget.CreateXML] unable to create file "',aFilename,'": '+E.Message]);
+      if not Quiet then
+        IDEMessageDialog('Write error','Unable to create file "'+aFilename+'": '+E.Message,mtError,[mbOk]);
+    end;
+  end;
+end;
+
 function GetLazBuildFilename: string;
 begin
   // first check the lazbuild executable in the lazarus directory
@@ -692,10 +719,10 @@ function TIDEProjectGroup.LoadFromFile(Options: TProjectGroupLoadOptions
 Var
   ARoot: String;
   TargetFileName: String;
-  BaseDir: String;
+  BaseDir, APath: String;
   XMLConfig: TXMLConfig;
-  I,ACount: Integer;
+  i,ACount: Integer;
-  Target: TPGCompileTarget;
+  Target: TIDECompileTarget;
   aGroup: TProjectGroup;
 begin
   Result:=false;
@@ -715,23 +742,23 @@ begin
     try
       ARoot:='ProjectGroup';
       ACount:=XMLConfig.GetValue(ARoot+'/Targets/Count',0);
-      I:=0;
+      for i:=0 to ACount-1 do
-      While (I<ACount) do
       begin
         Target:=Nil;
-        TargetFileName:=XMLConfig.GetValue(Format(ARoot+'/Targets/Target%d/FileName',[i]),'');
+        APath:=Format(ARoot+'/Targets/Target%d/',[i]);
+        TargetFileName:=XMLConfig.GetValue(APath+'FileName','');
         TargetFileName:=TrimFilename(SetDirSeparators(TargetFileName));
         if not FilenameIsAbsolute(TargetFileName) then
           TargetFileName:=TrimFilename(BaseDir+TargetFileName);
         If (TargetFileName<>'') and FileExistsCached(TargetFileName) then begin
-          Target:=AddTarget(TargetFileName);
+          Target:=TIDECompileTarget(AddTarget(TargetFileName));
           if pgloLoadRecursively in Options then
-            (Target as TIDECompileTarget).LoadTarget(true);
+            Target.LoadTarget(true);
           // ToDo: load buildmode flags
         end
         else if (pgloRemoveInvalid in Options) then
         begin
-          Target:=AddTarget(TargetFileName);
+          Target:=TIDECompileTarget(AddTarget(TargetFileName));
           Target.Removed:=True;
         end
         else if (pgloSkipInvalid in options) then
@@ -746,23 +773,20 @@ begin
                mrYesToAll,lisSkipAllTargets],'') of
            mrYes :
              begin
-               Target:=AddTarget(TargetFileName);
+               Target:=TIDECompileTarget(AddTarget(TargetFileName));
                Target.Removed:=True;
              end;
            mrNo:
              exit;
            mrYesToAll:
              begin
-               Target:=AddTarget(TargetFileName);
+               Target:=TIDECompileTarget(AddTarget(TargetFileName));
                Target.Removed:=True;
              end;
           else
             exit;
           end;
-        if Assigned(Target) and Not Target.Removed then
+        Target.LoadGroupSettings(XMLConfig,APath);
-          if XMLConfig.GetValue(Format(ARoot+'/Targets/Target%d/Active',[i]),False) then
-            Target.Activate;
-        Inc(I);
       end;
     finally
       Modified:=false;
@@ -781,35 +805,29 @@ function TIDEProjectGroup.SaveToFile: Boolean;
 Var
   TargetPath: String;
   RelativeFileName: String;
-  ARoot: String;
+  ARoot, APath: String;
   XMLConfig: TXMLConfig;
-  I,ACount: Integer;
+  i,ACount: Integer;
-  CompTarget: TPGCompileTarget;
+  aTarget: TIDECompileTarget;
 begin
   TargetPath:=ExtractFilePath(FileName);
   Result:=True;
   try
-    XMLConfig := TXMLConfig.Create(FileName);
+    XMLConfig := CreateXML(FileName,false);
     try
       ARoot:='ProjectGroup';
       ACount:=0;
-      For I:=0 to TargetCount-1 do
+      For i:=0 to TargetCount-1 do
-        if not GetTarget(I).Removed then
-          Inc(ACount);
-      XMLConfig.Clear;
-      XMLConfig.SetValue(ARoot+'/Targets/Count',ACount);
-      I:=0;
-      ACount:=0;
-      For I:=0 to TargetCount-1 do
       begin
-        CompTarget:=GetTarget(I);
+        aTarget:=TIDECompileTarget(GetTarget(i));
-        If not CompTarget.Removed then
+        if aTarget.Removed then continue;
-          begin
+        APath:=Format(ARoot+'/Targets/Target%d/',[ACount]);
-          RelativeFileName:=ExtractRelativepath(TargetPath,CompTarget.FileName);
+        RelativeFileName:=ExtractRelativepath(TargetPath,aTarget.FileName);
-          XMLConfig.SetValue(Format(ARoot+'/Targets/Target%d/FileName',[ACount]),RelativeFileName);
+        XMLConfig.SetDeleteValue(APath+'FileName',RelativeFileName,'');
+        aTarget.SaveGroupSettings(XMLConfig,APath);
         Inc(ACount);
       end;
-        end;
+      XMLConfig.SetDeleteValue(ARoot+'/Targets/Count',ACount,0);
       XMLConfig.Flush;
       Modified:=False;
     finally
@@ -835,6 +853,26 @@ begin
   end;
 end;
 
+procedure TIDECompileTarget.LoadGroupSettings(XMLConfig: TXMLConfig;
+  aPath: string);
+begin
+  case TargetType of
+    ttProject: LoadProject_GroupSettings(XMLConfig,aPath);
+  end;
+  if not Removed then
+    if XMLConfig.GetValue(APath+'Active',False) then
+      Activate;
+end;
+
+procedure TIDECompileTarget.SaveGroupSettings(XMLConfig: TXMLConfig;
+  aPath: string);
+begin
+  case TargetType of
+    ttProject: SaveProject_GroupSettings(XMLConfig,aPath);
+  end;
+  XMLConfig.SetDeleteValue(APath+'Active',Active and not Removed,False);
+end;
+
 procedure TIDECompileTarget.UnLoadTarget;
 begin
   if (FProjectGroup<>nil) and not (Self is TRootProjectGroupTarget) then
@@ -853,6 +891,14 @@ begin
   inherited Destroy;
 end;
 
+procedure TIDECompileTarget.Modified;
+var
+  PG: TProjectGroup;
+begin
+  PG:=GetOwnerProjectGroup;
+  PG.Modified:=true;
+end;
+
 function TIDECompileTarget.CompileUsingLazBuild(const AAction: TPGTargetAction
   ): TPGActionResult;
 var
@@ -1012,7 +1058,7 @@ begin
       for i:=0 to PkgList.Count-1 do begin
         RequiredPkg:=TIDEPackage(PkgList[i]);
         PkgName:=ExtractFileUnitname(RequiredPkg.Filename,true);
-        FRequiredPackages.Add(TPGDependency.Create(PkgName));
+        FRequiredPackages.Add(TPGDependency.Create(Self,PkgName));
       end;
   finally
     PkgList.Free;
@@ -1054,12 +1100,14 @@ begin
         for i:=0 to PkgList.Count-1 do begin
           Pkg:=TIDEPackage(PkgList[i]);
           PkgName:=ExtractFileUnitname(Pkg.Filename,true);
-          FRequiredPackages.Add(TPGDependency.Create(PkgName));
+          FRequiredPackages.Add(TPGDependency.Create(Self,PkgName));
         end;
       end;
     finally
       PkgList.Free;
     end;
+
+    // ToDo: load buildmodes
   end else begin
     // load from .lpi file
 
@@ -1088,7 +1136,7 @@ begin
           SubPath:=Path+'Item'+IntToStr(i)+'/';
           PkgName:=xml.GetValue(SubPath+'PackageName/Value','');
           if PkgName='' then continue;
-          FRequiredPackages.Add(TPGDependency.Create(PkgName));
+          FRequiredPackages.Add(TPGDependency.Create(Self,PkgName));
         end;
 
         // load build modes
@@ -1099,7 +1147,7 @@ begin
           BuildMode:=xml.GetValue(SubPath+'Name','');
           // ToDo: load/store compile in lpg
           if BuildMode<>'' then
-            FBuildModes.Add(TPGBuildMode.Create(BuildMode,false));
+            FBuildModes.Add(TPGBuildMode.Create(Self,BuildMode,false));
         end;
       end;
     finally
@@ -1108,6 +1156,39 @@ begin
   end;
 end;
 
+procedure TIDECompileTarget.LoadProject_GroupSettings(XMLConfig: TXMLConfig;
+  aPath: string);
+var
+  Cnt, i: Integer;
+  SubPath, aName: String;
+  aMode: TPGBuildMode;
+begin
+  Cnt:=XMLConfig.GetValue(aPath+'BuildModes/Count',0);
+  for i:=1 to Cnt do begin
+    SubPath:=aPath+'Mode'+IntToStr(i)+'/';
+    aName:=XMLConfig.GetValue(SubPath+'Name','');
+    aMode:=FindBuildMode(aName);
+    if aMode=nil then continue;
+    aMode.Compile:=XMLConfig.GetValue(SubPath+'Compile',false);
+  end;
+end;
+
+procedure TIDECompileTarget.SaveProject_GroupSettings(XMLConfig: TXMLConfig;
+  aPath: string);
+var
+  i: Integer;
+  SubPath: String;
+  aMode: TPGBuildMode;
+begin
+  XMLConfig.SetDeleteValue(aPath+'BuildModes/Count',BuildModeCount,0);
+  for i:=1 to BuildModeCount do begin
+    SubPath:=aPath+'Mode'+IntToStr(i)+'/';
+    aMode:=BuildModes[i-1];
+    XMLConfig.SetDeleteValue(SubPath+'Name',aMode.Name,'');
+    XMLConfig.SetDeleteValue(SubPath+'Compile',aMode.Compile,false);
+  end;
+end;
+
 procedure TIDECompileTarget.LoadProjectGroup(Recursively: boolean);
 var
   PG: TIDEProjectGroup;

components/projectgroups/projectgroupeditor.pas

@@ -1201,7 +1201,7 @@ begin
   TVPG.BeginUpdate;
   try
     // buildmodes
-    if T.BuildModeCount>0 then begin
+    if T.BuildModeCount>1 then begin
       BuildModeNode:=CreateSectionNode(AParent,lisNodeBuildModes,ntBuildModes);
       for i:=0 to T.BuildModeCount-1 do
         CreateSubNode(BuildModeNode,ntBuildMode,T,T.BuildModes[i].Name);

components/projectgroups/projectgroupintf.pp

@@ -36,21 +36,33 @@ Type
   TPGActionResults = set of TPGActionResult;
 
   TProjectGroup = class;
+  TPGCompileTarget = class;
 
   { TPGBuildMode }
 
   TPGBuildMode = class
-    Name: string;
+  private
-    Compile: boolean;
+    FCompile: boolean;
-    constructor Create(const aName: string; aCompile: boolean);
+    FName: string;
+    FTarget: TPGCompileTarget;
+    procedure SetCompile(AValue: boolean);
+  public
+    constructor Create(aTarget: TPGCompileTarget; const aName: string; aCompile: boolean);
+    property Target: TPGCompileTarget read FTarget;
+    property Name: string read FName;
+    property Compile: boolean read FCompile write SetCompile;
   end;
 
   { TPGDependency }
 
   TPGDependency = class
+  private
+    FPackageName: string;
+    FTarget: TPGCompileTarget;
   public
-    PackageName: string;
+    constructor Create(aTarget: TPGCompileTarget; const aPkgName: string);
-    constructor Create(const aPkgName: string);
+    property Target: TPGCompileTarget read FTarget;
+    property PackageName: string read FPackageName;
   end;
 
   { TPGCompileTarget - a node in the tree, see TPGTargetType }
@@ -84,8 +96,12 @@ Type
     constructor Create(aParent: TPGCompileTarget);
     procedure Activate;
     procedure DeActivate;
+    function GetOwnerProjectGroup: TProjectGroup;
     function GetRootProjectGroup: TProjectGroup;
     function GetNext: TPGCompileTarget;
+    function IndexOfBuildMode(aName: string): integer;
+    function FindBuildMode(aName: string): TPGBuildMode;
+    procedure Modified; virtual; abstract;
     property Parent: TPGCompileTarget read FParent;
     property Filename: string read FFilename write SetFilename; // Absolute, not relative.
     property Removed: boolean read FRemoved write SetRemoved;
@@ -240,17 +256,28 @@ end;
 
 { TPGBuildMode }
 
-constructor TPGBuildMode.Create(const aName: string; aCompile: boolean);
+procedure TPGBuildMode.SetCompile(AValue: boolean);
 begin
-  Name:=aName;
+  if FCompile=AValue then Exit;
-  Compile:=aCompile;
+  FCompile:=AValue;
+  Target.Modified;
+end;
+
+constructor TPGBuildMode.Create(aTarget: TPGCompileTarget; const aName: string;
+  aCompile: boolean);
+begin
+  FTarget:=aTarget;
+  FName:=aName;
+  FCompile:=aCompile;
 end;
 
 { TPGDependency }
 
-constructor TPGDependency.Create(const aPkgName: string);
+constructor TPGDependency.Create(aTarget: TPGCompileTarget;
+  const aPkgName: string);
 begin
-  PackageName:=aPkgName;
+  FTarget:=aTarget;
+  FPackageName:=aPkgName;
 end;
 
 { TProjectGroup }
@@ -496,6 +523,19 @@ begin
   ActiveChanged(Self);
 end;
 
+function TPGCompileTarget.GetOwnerProjectGroup: TProjectGroup;
+var
+  aTarget: TPGCompileTarget;
+begin
+  aTarget:=Self;
+  while (aTarget<>nil) do begin
+    Result:=aTarget.ProjectGroup;
+    if Result<>nil then exit;
+    aTarget:=aTarget.Parent;
+  end;
+  Result:=nil;
+end;
+
 function TPGCompileTarget.GetRootProjectGroup: TProjectGroup;
 var
   aTarget: TPGCompileTarget;
@@ -532,6 +572,24 @@ begin
   Result:=nil;
 end;
 
+function TPGCompileTarget.IndexOfBuildMode(aName: string): integer;
+begin
+  Result:=BuildModeCount-1;
+  while (Result>=0) and (CompareText(aName,BuildModes[Result].Name)<>0) do
+    dec(Result);
+end;
+
+function TPGCompileTarget.FindBuildMode(aName: string): TPGBuildMode;
+var
+  i: Integer;
+begin
+  i:=IndexOfBuildMode(aName);
+  if i>=0 then
+    Result:=BuildModes[i]
+  else
+    Result:=nil;
+end;
+
 function TPGCompileTarget.Perform(AAction: TPGTargetAction): TPGActionResult;
 begin
   if Not (AAction in AllowedActions) then