paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 04:55:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

project groups: load/save project specific group settings

Browse Source 
git-svn-id: trunk@50429 -
This commit is contained in:
mattias 2015-11-20 07:08:30 +00:00
parent 42f2cc6200
commit 059314c38d
3 changed files with 190 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

161
components/projectgroups/projectgroup.pp
View File

@ -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;
Target: TPGCompileTarget;
i,ACount: Integer;
Target: TIDECompileTarget;
aGroup: TProjectGroup;
begin
Result:=false;
@ -715,23 +742,23 @@ begin
try
ARoot:='ProjectGroup';
ACount:=XMLConfig.GetValue(ARoot+'/Targets/Count',0);
I:=0;
While (I<ACount) do
for i:=0 to ACount-1 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
if XMLConfig.GetValue(Format(ARoot+'/Targets/Target%d/Active',[i]),False) then
Target.Activate;
Inc(I);
Target.LoadGroupSettings(XMLConfig,APath);
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;
CompTarget: TPGCompileTarget;
i,ACount: Integer;
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
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);
If not CompTarget.Removed then
begin
RelativeFileName:=ExtractRelativepath(TargetPath,CompTarget.FileName);
XMLConfig.SetValue(Format(ARoot+'/Targets/Target%d/FileName',[ACount]),RelativeFileName);
Inc(ACount);
end;
end;
For i:=0 to TargetCount-1 do
begin
aTarget:=TIDECompileTarget(GetTarget(i));
if aTarget.Removed then continue;
APath:=Format(ARoot+'/Targets/Target%d/',[ACount]);
RelativeFileName:=ExtractRelativepath(TargetPath,aTarget.FileName);
XMLConfig.SetDeleteValue(APath+'FileName',RelativeFileName,'');
aTarget.SaveGroupSettings(XMLConfig,APath);
Inc(ACount);
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;

2
components/projectgroups/projectgroupeditor.pas
View File

@ -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);

78
components/projectgroups/projectgroupintf.pp
View File

@ -36,21 +36,33 @@ Type
TPGActionResults = set of TPGActionResult;
TProjectGroup = class;
TPGCompileTarget = class;
{ TPGBuildMode }
TPGBuildMode = class
Name: string;
Compile: boolean;
constructor Create(const aName: string; aCompile: boolean);
private
FCompile: 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(const aPkgName: string);
constructor Create(aTarget: TPGCompileTarget; 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;
Compile:=aCompile;
if FCompile=AValue then Exit;
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