implemented inherited project compiler options

git-svn-id: trunk@4087 -
This commit is contained in:
mattias 2003-04-20 23:10:03 +00:00
parent 59957529dc
commit 70019f98d4
9 changed files with 181 additions and 81 deletions

View File

@ -52,13 +52,15 @@ type
icoIncludePath,
icoObjectPath,
icoLibraryPath,
icoSrcPath,
icoLinkerOptions,
icoCustomOptions
);
TInheritedCompilerOptions = set of TInheritedCompilerOption;
const
icoAllSearchPaths = [icoUnitPath,icoIncludePath,icoObjectPath,icoLibraryPath];
icoAllSearchPaths = [icoUnitPath,icoIncludePath,icoObjectPath,icoLibraryPath,
icoSrcPath];
type
@ -70,6 +72,7 @@ type
pcosIncludePath, // search path for pascal include files
pcosObjectPath, // search path for .o files
pcosLibraryPath, // search path for libraries
pcosSrcPath, // additional search path for pascal source files
pcosLinkerOptions,// additional linker options
pcosCustomOptions,// additional options
pcosOutputDir, // the output directory
@ -78,8 +81,8 @@ type
TParsedCompilerOptStrings = set of TParsedCompilerOptString;
const
ParsedCompilerSearchPaths = [pcosUnitPath,pcosIncludePath,
pcosObjectPath,pcosLibraryPath];
ParsedCompilerSearchPaths = [pcosUnitPath,pcosIncludePath,pcosObjectPath,
pcosLibraryPath,pcosSrcPath];
ParsedCompilerFilenames = [pcosCompilerPath];
ParsedCompilerDirectories = [pcosOutputDir];
ParsedCompilerFiles =
@ -143,10 +146,11 @@ type
fIncludeFiles: String;
fLibraries: String;
fOtherUnitFiles: String;
FObjectPath: string;
FSrcPath: string;
fCompilerPath: String;
fUnitOutputDir: string;
fLCLWidgetType: string;
FObjectPath: string;
// Parsing:
// style
@ -217,7 +221,6 @@ type
fAdditionalConfigFile: Boolean;
fConfigFilePath: String;
fCustomOptions: string;
procedure SetDefaultMakeOptionsFlags(const AValue: TCompilerCmdLineOptions);
protected
procedure SetBaseDirectory(const AValue: string); virtual;
procedure SetCompilerPath(const AValue: String); virtual;
@ -228,11 +231,13 @@ type
procedure SetOtherUnitFiles(const AValue: String); virtual;
procedure SetUnitOutputDir(const AValue: string); virtual;
procedure SetObjectPath(const AValue: string); virtual;
procedure SetSrcPath(const AValue: string); virtual;
protected
procedure LoadTheCompilerOptions(const Path: string); virtual;
procedure SaveTheCompilerOptions(const Path: string); virtual;
procedure SetModified(const AValue: boolean); virtual;
procedure ClearInheritedOptions;
procedure SetDefaultMakeOptionsFlags(const AValue: TCompilerCmdLineOptions);
public
constructor Create(TheOwner: TObject);
destructor Destroy; override;
@ -282,10 +287,11 @@ type
property IncludeFiles: String read fIncludeFiles write SetIncludeFiles;
property Libraries: String read fLibraries write SetLibraries;
property OtherUnitFiles: String read fOtherUnitFiles write SetOtherUnitFiles;
property ObjectPath: string read FObjectPath write SetObjectPath;
property SrcPath: string read FSrcPath write SetSrcPath;
property CompilerPath: String read fCompilerPath write SetCompilerPath;
property UnitOutputDirectory: string read fUnitOutputDir write SetUnitOutputDir;
property LCLWidgetType: string read fLCLWidgetType write fLCLWidgetType;
property ObjectPath: string read FObjectPath write SetObjectPath;
// parsing:
property Style: Integer read fStyle write fStyle;
@ -590,8 +596,6 @@ type
ImageIndexRequired: integer;
ImageIndexInherited: integer;
InheritedChildDatas: TList; // list of PInheritedNodeData
function GetOtherSourcePath: string;
procedure SetOtherSourcePath(const AValue: string);
procedure SetReadOnly(const AValue: boolean);
procedure UpdateInheritedTab;
procedure ClearInheritedTree;
@ -604,8 +608,6 @@ type
procedure GetCompilerOptions;
procedure PutCompilerOptions;
public
property OtherSourcePath: string
read GetOtherSourcePath write SetOtherSourcePath;
property ReadOnly: boolean read FReadOnly write SetReadOnly;
end;
@ -752,6 +754,13 @@ begin
FDefaultMakeOptionsFlags:=AValue;
end;
procedure TBaseCompilerOptions.SetSrcPath(const AValue: string);
begin
if FSrcPath=AValue then exit;
FSrcPath:=AValue;
ParsedOpts.SetUnparsedValue(pcosSrcPath,FSrcPath);
end;
procedure TBaseCompilerOptions.SetBaseDirectory(const AValue: string);
begin
if FBaseDirectory=AValue then exit;
@ -826,6 +835,7 @@ begin
UnitOutputDirectory := XMLConfigFile.GetValue(p+'UnitOutputDirectory/Value', '');
LCLWidgetType := XMLConfigFile.GetValue(p+'LCLWidgetType/Value', 'gtk');
ObjectPath := XMLConfigFile.GetValue(p+'ObjectPath/Value', '');
SrcPath := XMLConfigFile.GetValue(p+'SrcPath/Value', '');
{ Parsing }
p:='CompilerOptions/Parsing/';
@ -954,6 +964,7 @@ begin
XMLConfigFile.SetDeleteValue(p+'UnitOutputDirectory/Value', UnitOutputDirectory,'');
XMLConfigFile.SetDeleteValue(p+'LCLWidgetType/Value', LCLWidgetType,'');
XMLConfigFile.SetDeleteValue(p+'ObjectPath/Value', ObjectPath,'');
XMLConfigFile.SetDeleteValue(p+'SrcPath/Value', SrcPath,'');
{ Parsing }
p:='CompilerOptions/Parsing/';
@ -1131,6 +1142,7 @@ begin
MergeCustomOptions(fInheritedOptions[icoCustomOptions],
AddOptions.ParsedOpts.GetParsedValue(pcosCustomOptions));
end;
OptionsList.Free;
end;
fInheritedOptParseStamps:=CompilerParseStamp;
fInheritedOptGraphStamps:=CompilerGraphStamp;
@ -1892,6 +1904,7 @@ begin
CompilerPath := '$(CompPath)';
UnitOutputDirectory := '';
ObjectPath:='';
SrcPath:='';
fLCLWidgetType := 'gtk';
// parsing
@ -1977,6 +1990,7 @@ begin
UnitOutputDirectory := CompOpts.fUnitOutputDir;
fLCLWidgetType := CompOpts.fLCLWidgetType;
ObjectPath := CompOpts.FObjectPath;
SrcPath := CompOpts.SrcPath;
// Parsing
fStyle := CompOpts.fStyle;
@ -2057,6 +2071,7 @@ begin
and (fCompilerPath = CompOpts.fCompilerPath)
and (fUnitOutputDir = CompOpts.fUnitOutputDir)
and (FObjectPath = CompOpts.FObjectPath)
and (FSrcPath = CompOpts.FSrcPath)
and (fLCLWidgetType = CompOpts.fLCLWidgetType)
@ -2442,6 +2457,7 @@ begin
edtIncludeFiles.Text := CompilerOpts.IncludeFiles;
edtLibraries.Text := CompilerOpts.Libraries;
grpLibraries.Enabled:=EnabledLinkerOpts;
edtOtherSources.Text := CompilerOpts.SrcPath;
edtCompiler.Text := CompilerOpts.CompilerPath;
edtUnitOutputDir.Text := CompilerOpts.UnitOutputDirectory;
@ -2584,6 +2600,7 @@ begin
CompilerOpts.IncludeFiles := edtIncludeFiles.Text;
CompilerOpts.Libraries := edtLibraries.Text;
CompilerOpts.OtherUnitFiles := edtOtherUnits.Text;
CompilerOpts.SrcPath := edtOtherSources.Text;
CompilerOpts.CompilerPath := edtCompiler.Text;
CompilerOpts.UnitOutputDirectory := edtUnitOutputDir.Text;
@ -2632,6 +2649,7 @@ var
end;
begin
OptionsList:=nil;
CompilerOpts.GetInheritedCompilerOptions(OptionsList);
InhTreeView.BeginUpdate;
ClearInheritedTree;
@ -2682,6 +2700,7 @@ begin
end;
AncestorNode.Expanded:=true;
end;
OptionsList.Free;
end else begin
InhTreeView.Items.Add(nil,'No compiler options inherited.');
end;
@ -4070,16 +4089,6 @@ begin
SetBounds(x-120,y,120,Height);
end;
function TfrmCompilerOptions.GetOtherSourcePath: string;
begin
Result:=edtOtherSources.Text;
end;
procedure TfrmCompilerOptions.SetOtherSourcePath(const AValue: string);
begin
edtOtherSources.Text:=AValue;
end;
procedure TfrmCompilerOptions.SetReadOnly(const AValue: boolean);
begin
if FReadOnly=AValue then exit;

View File

@ -38,8 +38,7 @@ uses
Classes, SysUtils, IDEProcs, CodeToolManager, DefineTemplates,
CompilerOptions, TransferMacros, LinkScanner, FileProcs;
procedure CreateProjectDefineTemplate(CompOpts: TCompilerOptions;
const SrcPath: string);
procedure CreateProjectDefineTemplate(CompOpts: TCompilerOptions);
procedure SetAdditionalGlobalSrcPathToCodeToolBoss(const SrcPath: string);
function FindCurrentProjectDirTemplate: TDefineTemplate;
function FindCurrentProjectDirSrcPathTemplate: TDefineTemplate;
@ -143,8 +142,7 @@ begin
end;
end;
procedure CreateProjectDefineTemplate(CompOpts: TCompilerOptions;
const SrcPath: string);
procedure CreateProjectDefineTemplate(CompOpts: TCompilerOptions);
var ProjectDir, s: string;
ProjTempl: TDefineTemplate;
begin
@ -234,11 +232,11 @@ begin
da_DefineRecurse));
end;
// source path (unitpath + sources for the CodeTools, hidden to the compiler)
if (SrcPath<>'') or (s<>'') then begin
if (CompOpts.SrcPath<>'') or (s<>'') then begin
// add compiled unit path
ProjTempl.AddChild(TDefineTemplate.Create('SrcPath',
'source path addition',ExternalMacroStart+'SrcPath',
ConvertTransferMacrosToExternalMacros(s+';'+SrcPath)+';'
ConvertTransferMacrosToExternalMacros(s+';'+CompOpts.SrcPath)+';'
+'$('+ExternalMacroStart+'SrcPath)',
da_DefineRecurse));
end;

View File

@ -103,7 +103,8 @@ type
ofAddToRecent, // add file to recent files
ofRegularFile, // open as regular file (e.g. do not open projects)
ofVirtualFile, // open the virtual file
ofConvertMacros // replace macros in filename
ofConvertMacros, // replace macros in filename
ofUseCache // do not update file from file
);
TOpenFlags = set of TOpenFlag;
@ -395,7 +396,8 @@ const
'ofAddToRecent',
'ofRegularFile',
'ofVirtualFile',
'ofConvertMacros'
'ofConvertMacros',
'ofUseCache'
);
SaveFlagNames: array[TSaveFlag] of string = (

View File

@ -210,6 +210,7 @@ type
constructor Create(TheProject: TProject);
function GetOwnerName: string; override;
function GetDefaultMainSourceFileName: string; override;
procedure GetInheritedCompilerOptions(var OptionsList: TList); override;
public
property OwnerProject: TProject read FOwnerProject;
end;
@ -255,17 +256,14 @@ type
FOnBeginUpdate: TNotifyEvent;
FOnEndUpdate: TEndUpdateProjectEvent;
fOnFileBackup: TOnFileBackup;
fOutputDirectory: String;
fProjectDirectory: string;
fProjectInfoFile: String; // the lpi filename
fProjectType: TProjectType;
fPublishOptions: TPublishProjectOptions;
fRunParameterOptions: TRunParamsOptions;
fSrcPath: string; // source path addition for units in ProjectDir
fTargetFileExt: String;
fTitle: String;
fUnitList: TList; // list of _all_ units (TUnitInfo)
fUnitOutputDirectory: String;
FUpdateLock: integer;
xmlconfig: TXMLConfig;
function GetMainFilename: String;
@ -284,7 +282,6 @@ type
procedure SetFlags(const AValue: TProjectFlags);
procedure SetMainUnitID(const AValue: Integer);
procedure SetProjectInfoFile(const NewFilename: string);
procedure SetSrcPath(const NewSrcPath: string);
procedure SetTargetFilename(const NewTargetFilename: string);
procedure SetUnits(Index:integer; AUnitInfo: TUnitInfo);
procedure UpdateProjectDirectory;
@ -417,7 +414,6 @@ type
property OnBeginUpdate: TNotifyEvent read FOnBeginUpdate write FOnBeginUpdate;
property OnEndUpdate: TEndUpdateProjectEvent read FOnEndUpdate write FOnEndUpdate;
property OnFileBackup: TOnFileBackup read fOnFileBackup write fOnFileBackup;
property OutputDirectory: String read fOutputDirectory write fOutputDirectory;
property ProjectDirectory: string read fProjectDirectory;
property ProjectInfoFile: string
read GetProjectInfoFile write SetProjectInfoFile;
@ -425,13 +421,10 @@ type
property PublishOptions: TPublishProjectOptions
read fPublishOptions write fPublishOptions;
property RunParameterOptions: TRunParamsOptions read fRunParameterOptions;
property SrcPath: string read fSrcPath write fSrcPath;
property TargetFileExt: String read fTargetFileExt write fTargetFileExt;
property TargetFilename: string
read GetTargetFilename write SetTargetFilename;
property Title: String read fTitle write fTitle;
property UnitOutputDirectory: String
read fUnitOutputDirectory write fUnitOutputDirectory;
property Units[Index: integer]:TUnitInfo read GetUnits write SetUnits;
property UpdateLock: integer read FUpdateLock;
end;
@ -480,6 +473,8 @@ function ProjectFlagsToStr(Flags: TProjectFlags): string;
implementation
const
ProjectInfoFileVersion = 2;
function ProjectFlagsToStr(Flags: TProjectFlags): string;
var f: TProjectFlag;
@ -1032,9 +1027,11 @@ end;
procedure TUnitInfo.SetIsPartOfProject(const AValue: boolean);
begin
if fIsPartOfProject=AValue then exit;
if Project<>nil then Project.BeginUpdate(true);
fIsPartOfProject:=AValue;
UpdatePartOfProjectList;
if fIsPartOfProject then UpdateUsageCount(uuIsPartOfProject,0);
if Project<>nil then Project.EndUpdate;
end;
{-------------------------------------------------------------------------------
@ -1105,16 +1102,13 @@ begin
fJumpHistory.OnLoadSaveFilename:=@OnLoadSaveFilename;
fMainUnitID := -1;
fModified := false;
fOutputDirectory := '.';
fProjectInfoFile := '';
UpdateProjectDirectory;
fPublishOptions:=TPublishProjectOptions.Create;
fRunParameterOptions:=TRunParamsOptions.Create;
fSrcPath := '';
fTargetFileExt := DefaultTargetFileExt;
fTitle := '';
fUnitList := TList.Create; // list of TUnitInfo
fUnitOutputDirectory := '.';
// create program source
NewSource:=TStringList.Create;
@ -1285,6 +1279,7 @@ begin
repeat
try
xmlconfig.SetValue('ProjectOptions/Version/Value',ProjectInfoFileVersion);
xmlconfig.SetDeleteValue('ProjectOptions/General/ProjectType/Value',
ProjectTypeNames[ProjectType],'');
SaveFlags;
@ -1298,14 +1293,8 @@ begin
xmlconfig.SetValue('ProjectOptions/General/TargetFileExt/Value'
,TargetFileExt);
xmlconfig.SetDeleteValue('ProjectOptions/General/Title/Value', Title,'');
xmlconfig.SetDeleteValue('ProjectOptions/General/OutputDirectory/Value'
,OutputDirectory,'');
xmlconfig.SetDeleteValue('ProjectOptions/General/UnitOutputDirectory/Value'
,UnitOutputDirectory,'');
fJumpHistory.DeleteInvalidPositions;
fJumpHistory.SaveToXMLConfig(xmlconfig,'ProjectOptions/');
xmlconfig.SetDeleteValue('ProjectOptions/General/SrcPath/Value',
fSrcPath,'');
SaveUnits;
@ -1361,6 +1350,8 @@ function TProject.ReadProject(const LPIFilename: string): TModalResult;
var
NewUnitInfo: TUnitInfo;
NewUnitCount,i: integer;
FileVersion: Integer;
OldSrcPath: String;
begin
Result := mrCancel;
BeginUpdate(true);
@ -1383,6 +1374,7 @@ begin
try
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject C reading values');{$ENDIF}
FileVersion:= XMLConfig.GetValue('ProjectOptions/Version/Value',0);
ProjectType := ProjectTypeNameToType(xmlconfig.GetValue(
'ProjectOptions/General/ProjectType/Value', ''));
LoadFlags;
@ -1395,12 +1387,9 @@ begin
TargetFileExt := xmlconfig.GetValue(
'ProjectOptions/General/TargetFileExt/Value', DefaultTargetFileExt);
Title := xmlconfig.GetValue('ProjectOptions/General/Title/Value', '');
OutputDirectory := xmlconfig.GetValue(
'ProjectOptions/General/OutputDirectory/Value', '.');
UnitOutputDirectory := xmlconfig.GetValue(
'ProjectOptions/General/UnitOutputDirectory/Value', '.');
fJumpHistory.LoadFromXMLConfig(xmlconfig,'ProjectOptions/');
FSrcPath := xmlconfig.GetValue('ProjectOptions/General/SrcPath/Value','');
if FileVersion<2 then
OldSrcPath := xmlconfig.GetValue('ProjectOptions/General/SrcPath/Value','');
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject D reading units');{$ENDIF}
NewUnitCount:=xmlconfig.GetValue('ProjectOptions/Units/Count',0);
@ -1415,7 +1404,8 @@ begin
// Load the compiler options
CompilerOptions.XMLConfigFile := xmlconfig;
CompilerOptions.LoadCompilerOptions(true);
CreateProjectDefineTemplate(CompilerOptions,FSrcPath);
if FileVersion<2 then CompilerOptions.SrcPath:=OldSrcPath;
CreateProjectDefineTemplate(CompilerOptions);
// load the Publish Options
PublishOptions.LoadFromXMLConfig(xmlconfig,'ProjectOptions/PublishOptions/');
@ -1550,14 +1540,11 @@ begin
fJumpHistory.Clear;
fMainUnitID := -1;
fModified := false;
fOutputDirectory := '.';
fProjectInfoFile := '';
UpdateProjectDirectory;
fPublishOptions.Clear;
fSrcPath := '';
fTargetFileExt := DefaultTargetFileExt;
fTitle := '';
fUnitOutputDirectory := '.';
EndUpdate;
end;
@ -2095,7 +2082,7 @@ begin
if (not IsVirtual) then exit;
ExtendPath(UnitPathMacroName,CompilerOptions.OtherUnitFiles);
ExtendPath(IncludePathMacroName,CompilerOptions.IncludeFiles);
ExtendPath(SrcPathMacroName,SrcPath);
ExtendPath(SrcPathMacroName,CompilerOptions.SrcPath);
end;
procedure TProject.GetUnitsChangedOnDisk(var AnUnitList: TList);
@ -2366,12 +2353,6 @@ begin
end;
end;
procedure TProject.SetSrcPath(const NewSrcPath: string);
begin
if FSrcPath=NewSrcPath then exit;
fSrcPath:=NewSrcPath;
end;
procedure TProject.UpdateProjectDirectory;
begin
fProjectDirectory:=ExtractFilePath(fProjectInfoFile);
@ -2549,12 +2530,26 @@ begin
Result:=inherited GetDefaultMainSourceFileName;
end;
procedure TProjectCompilerOptions.GetInheritedCompilerOptions(
var OptionsList: TList);
var
PkgList: TList;
begin
PkgList:=nil;
OwnerProject.GetAllRequiredPackages(PkgList);
OptionsList:=GetUsageOptionsList(PkgList);
PkgList.Free;
end;
end.
{
$Log$
Revision 1.112 2003/04/20 23:10:03 mattias
implemented inherited project compiler options
Revision 1.111 2003/04/20 20:32:40 mattias
implemented removing, re-adding, updating project dependencies

View File

@ -46,6 +46,8 @@ uses
type
TOnAddUnitToProject =
function(Sender: TObject; AnUnitInfo: TUnitInfo): TModalresult of object;
TRemoveProjInspFileEvent =
function(Sender: TObject; AnUnitInfo: TUnitInfo): TModalResult of object;
TProjectInspectorFlag = (
pifItemsChanged,
@ -77,6 +79,7 @@ type
private
FOnAddUnitToProject: TOnAddUnitToProject;
FOnOpen: TNotifyEvent;
FOnRemoveFile: TRemoveProjInspFileEvent;
FOnShowOptions: TNotifyEvent;
FUpdateLock: integer;
FLazProject: TProject;
@ -119,6 +122,8 @@ type
property OnShowOptions: TNotifyEvent read FOnShowOptions write FOnShowOptions;
property OnAddUnitToProject: TOnAddUnitToProject read FOnAddUnitToProject
write FOnAddUnitToProject;
property OnRemoveFile: TRemoveProjInspFileEvent read FOnRemoveFile
write FOnRemoveFile;
end;
var
@ -314,6 +319,7 @@ end;
procedure TProjectInspectorForm.RemoveBitBtnClick(Sender: TObject);
var
CurDependency: TPkgDependency;
CurFile: TUnitInfo;
begin
CurDependency:=GetSelectedDependency;
if (CurDependency<>nil) and (not CurDependency.Removed) then begin
@ -322,6 +328,18 @@ begin
mtConfirmation,[mbYes,mbNo],0)<>mrYes
then exit;
LazProject.RemoveRequiredDependency(CurDependency);
exit;
end;
CurFile:=GetSelectedFile;
if CurFile<>nil then begin
if (not CurFile.IsPartOfProject) or (CurFile=LazProject.MainUnitInfo)
then exit;
if MessageDlg('Confirm removing file',
'Remove file '+CurFile.Filename+' from project?',
mtConfirmation,[mbYes,mbNo],0)<>mrYes
then exit;
if Assigned(OnRemoveFile) then OnRemoveFile(Self,CurFile);
end;
end;

View File

@ -332,7 +332,7 @@ begin
if not PackageGraph.DependencyExists(NewDependency,fpfSearchPackageEverywhere)
then begin
MessageDlg('Package not found',
'The dependency "'+NewDependency.AsString+'" was not found.'#13
'No package found for dependency "'+NewDependency.AsString+'".'#13
+'Please choose an existing package.',
mtError,[mbCancel],0);
exit;

View File

@ -268,6 +268,7 @@ type
procedure SetLibraries(const AValue: string); override;
procedure SetLinkerOptions(const AValue: string); override;
procedure SetObjectPath(const AValue: string); override;
procedure SetSrcPath(const AValue: string); override;
procedure SetOtherUnitFiles(const AValue: string); override;
procedure SetUnitOutputDir(const AValue: string); override;
public
@ -624,6 +625,14 @@ var
OnGetAllRequiredPackages: TGetAllRequiredPackagesEvent;
function CompareLazPackageID(Data1, Data2: Pointer): integer;
function CompareNameWithPackageID(Key, Data: Pointer): integer;
function CompareLazPackageIDNames(Data1, Data2: Pointer): integer;
function CompareNameWithPkgDependency(Key, Data: Pointer): integer;
function ComparePkgDependencyNames(Data1, Data2: Pointer): integer;
function GetUsageOptionsList(PackageList: TList): TList;
function PkgFileTypeIdentToType(const s: string): TPkgFileType;
function LazPackageTypeIdentToType(const s: string): TLazPackageType;
@ -634,12 +643,6 @@ procedure LoadPkgDependencyList(XMLConfig: TXMLConfig; const ThePath: string;
procedure SavePkgDependencyList(XMLConfig: TXMLConfig; const ThePath: string;
First: TPkgDependency; ListType: TPkgDependencyList);
function CompareLazPackageID(Data1, Data2: Pointer): integer;
function CompareNameWithPackageID(Key, Data: Pointer): integer;
function CompareLazPackageIDNames(Data1, Data2: Pointer): integer;
function CompareNameWithPkgDependency(Key, Data: Pointer): integer;
function ComparePkgDependencyNames(Data1, Data2: Pointer): integer;
function FindDependencyByNameInList(First: TPkgDependency;
ListType: TPkgDependencyList; const Name: string): TPkgDependency;
function FindCompatibleDependencyInList(First: TPkgDependency;
@ -805,6 +808,22 @@ begin
Result:=AnsiCompareText(Dependency1.PackageName,Dependency2.PackageName);
end;
function GetUsageOptionsList(PackageList: TList): TList;
var
Cnt: Integer;
i: Integer;
begin
if PackageList<>nil then begin
Result:=TList.Create;
Cnt:=PackageList.Count;
for i:=0 to Cnt-1 do begin
Result.Add(TLazPackage(PackageList[i]).UsageOptions);
end;
end else begin
Result:=nil;
end;
end;
function FindDependencyByNameInList(First: TPkgDependency;
ListType: TPkgDependencyList; const Name: string): TPkgDependency;
begin
@ -2223,20 +2242,11 @@ end;
procedure TLazPackage.GetInheritedCompilerOptions(var OptionsList: TList);
var
PkgList: TList; // list of TLazPackage
Cnt: Integer;
i: Integer;
begin
PkgList:=nil;
GetAllRequiredPackages(PkgList);
if PkgList<>nil then begin
OptionsList:=TList.Create;
Cnt:=PkgList.Count;
for i:=0 to Cnt-1 do begin
OptionsList.Add(TLazPackage(PkgList[i]).UsageOptions);
end;
end else begin
OptionsList:=nil;
end;
OptionsList:=GetUsageOptionsList(PkgList);
PkgList.Free;
end;
function TLazPackage.GetCompileSourceFilename: string;
@ -2475,6 +2485,13 @@ begin
inherited SetObjectPath(AValue);
end;
procedure TPkgCompilerOptions.SetSrcPath(const AValue: string);
begin
if SrcPath=AValue then exit;
InvalidateOptions;
inherited SetSrcPath(AValue);
end;
procedure TPkgCompilerOptions.SetOtherUnitFiles(const AValue: string);
begin
if OtherUnitFiles=AValue then exit;

View File

@ -120,6 +120,7 @@ type
IgnorePackage: TLazPackage): TLazPackage;
function FindBrokenDependencyPath(APackage: TLazPackage): TList;
function FindCircleDependencyPath(APackage: TLazPackage): TList;
function FindUnsavedDependencyPath(APackage: TLazPackage): TList;
function FindFileInAllPackages(const TheFilename: string;
ResolveLinks, IgnoreDeleted: boolean): TPkgFile;
function FindLowestPkgNodeByName(const PkgName: string): TAVLTreeNode;
@ -1038,6 +1039,56 @@ begin
FindCircle(APackage,Result);
end;
function TLazPackageGraph.FindUnsavedDependencyPath(APackage: TLazPackage
): TList;
procedure FindUnsaved(CurPackage: TLazPackage; var PathList: TList);
var
Dependency: TPkgDependency;
RequiredPackage: TLazPackage;
begin
CurPackage.Flags:=CurPackage.Flags+[lpfVisited];
Dependency:=CurPackage.FirstRequiredDependency;
while Dependency<>nil do begin
if Dependency.LoadPackageResult=lprSuccess then begin
// dependency ok
RequiredPackage:=Dependency.RequiredPackage;
if RequiredPackage.Modified then begin
// unsaved package detected
PathList:=TList.Create;
PathList.Add(CurPackage);
PathList.Add(RequiredPackage);
exit;
end;
if not (lpfVisited in RequiredPackage.Flags) then begin
FindUnsaved(RequiredPackage,PathList);
if PathList<>nil then begin
// unsaved package detected
// -> add current package to list
PathList.Insert(0,CurPackage);
exit;
end;
end;
end;
Dependency:=Dependency.NextRequiresDependency;
end;
CurPackage.Flags:=CurPackage.Flags-[lpfCircle];
end;
var
i: Integer;
Pkg: TLazPackage;
begin
Result:=nil;
if (Count=0) or (APackage=nil) then exit;
// mark all packages as not visited
for i:=FItems.Count-1 downto 0 do begin
Pkg:=TLazPackage(FItems[i]);
Pkg.Flags:=Pkg.Flags-[lpfVisited];
end;
FindUnsaved(APackage,Result);
end;
function TLazPackageGraph.GetAutoCompilationOrder(APackage: TLazPackage
): TList;

View File

@ -600,7 +600,17 @@ begin
mtError,[mbCancel,mbAbort],0);
exit;
end;
// check for unsaved packages
PathList:=PackageGraph.FindUnsavedDependencyPath(APackage);
if PathList<>nil then begin
DoShowPackageGraphPathList(PathList);
Result:=MessageDlg('Unsaved package',
'There is an unsaved package in the required packages. See package graph.',
mtError,[mbCancel,mbAbort],0);
exit;
end;
Result:=mrOk;
end;
@ -1012,7 +1022,7 @@ begin
begin
// add lcl pp/pas dirs to source search path
ds:=PathDelim;
AProject.SrcPath:=
AProject.CompilerOptions.SrcPath:=
'$(LazarusDir)'+ds+'lcl'
+';'+
'$(LazarusDir)'+ds+'lcl'+ds+'interfaces'+ds+'$(LCLWidgetType)';