paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 14:40:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented inherited Compiler Options View

Browse Source 
git-svn-id: trunk@4061 -
This commit is contained in:
mattias 2003-04-15 17:58:28 +00:00
parent 088d4e7233
commit 94d356f9a1
9 changed files with 731 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

412
ide/compileroptions.pp
View File

@ -41,9 +41,10 @@ unit CompilerOptions;
interface
uses
Forms, Classes, SysUtils, ComCtrls, Buttons, StdCtrls, ExtCtrls,
Laz_XMLCfg, FileCtrl, Dialogs, Controls, PathEditorDlg, IDEProcs, LazConf,
IDEOptionDefs, LazarusIDEStrConsts;
Forms, Classes, SysUtils, ComCtrls, Buttons, StdCtrls, ExtCtrls, Graphics,
LResources, Laz_XMLCfg, FileCtrl, Dialogs, Controls,
PathEditorDlg, IDEProcs, LazConf, IDEOptionDefs, LazarusIDEStrConsts,
TransferMacros;
type
TInheritedCompilerOption = (
@ -60,19 +61,30 @@ type
{ TParsedCompilerOptions }
TParsedCompilerOptString = (
pcosBaseDir,
pcosUnitPath,
pcosIncludePath,
pcosObjectPath,
pcosLibraryPath,
pcosLinkerOptions,
pcosCustomOptions,
pcosOutputDir,
pcosCompilerPath
pcosBaseDir, // the base directory for the relative paths
pcosUnitPath, // search path for pascal units
pcosIncludePath, // search path for pascal include files
pcosObjectPath, // search path for .o files
pcosLibraryPath, // search path for libraries
pcosLinkerOptions,// additional linker options
pcosCustomOptions,// additional options
pcosOutputDir, // the output directory
pcosCompilerPath // the filename of the compiler
);
TParsedCompilerOptStrings = set of TParsedCompilerOptString;
const
ParsedCompilerSearchPaths = [pcosUnitPath,pcosIncludePath,
pcosObjectPath,pcosLibraryPath];
ParsedCompilerFilenames = [pcosOutputDir,pcosCompilerPath];
ParsedCompilerFiles = ParsedCompilerSearchPaths+ParsedCompilerFilenames;
type
TLocalSubstitutionEvent = function(const s: string): string of object;
TParsedCompilerOptions = class
private
FOnLocalSubstitute: TLocalSubstitutionEvent;
public
UnparsedValues: array[TParsedCompilerOptString] of string;
ParsedValues: array[TParsedCompilerOptString] of string;
@ -82,6 +94,10 @@ type
procedure SetUnparsedValue(Option: TParsedCompilerOptString;
const NewValue: string);
procedure Clear;
procedure InvalidateAll;
procedure InvalidateFiles;
property OnLocalSubstitute: TLocalSubstitutionEvent read FOnLocalSubstitute
write FOnLocalSubstitute;
end;
TParseStringEvent =
@ -93,16 +109,19 @@ type
TBaseCompilerOptions = class
private
fOwner: TObject;
FBaseDirectory: string;
fInheritedOptions: array[TInheritedCompilerOption] of string;
fInheritedOptParseStamps: integer;
fInheritedOptGraphStamps: integer;
fLoaded: Boolean;
FModified: boolean;
FOnModified: TNotifyEvent;
fOptionsString: String;
fOwner: TObject;
FParsedOpts: TParsedCompilerOptions;
xmlconfig: TXMLConfig;
fXMLFile: String;
fTargetFilename: string;
fLoaded: Boolean;
fXMLFile: String;
xmlconfig: TXMLConfig;
// Search Paths:
fIncludeFiles: String;
@ -111,6 +130,7 @@ type
fCompilerPath: String;
fUnitOutputDir: string;
fLCLWidgetType: string;
FObjectPath: string;
// Parsing:
// style
@ -181,17 +201,21 @@ type
fAdditionalConfigFile: Boolean;
fConfigFilePath: String;
fCustomOptions: string;
procedure SetCompilerPath(const AValue: String);
procedure SetCustomOptions(const AValue: string);
procedure SetIncludeFiles(const AValue: String);
procedure SetLibraries(const AValue: String);
procedure SetLinkerOptions(const AValue: String);
procedure SetOtherUnitFiles(const AValue: String);
procedure SetUnitOutputDir(const AValue: string);
protected
procedure SetBaseDirectory(const AValue: string); virtual;
procedure SetCompilerPath(const AValue: String); virtual;
procedure SetCustomOptions(const AValue: string); virtual;
procedure SetIncludeFiles(const AValue: String); virtual;
procedure SetLibraries(const AValue: String); virtual;
procedure SetLinkerOptions(const AValue: String); virtual;
procedure SetOtherUnitFiles(const AValue: String); virtual;
procedure SetUnitOutputDir(const AValue: string); virtual;
procedure SetObjectPath(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;
public
constructor Create(TheOwner: TObject);
destructor Destroy; override;
@ -214,13 +238,16 @@ type
function CreateTargetFilename(const MainSourceFileName: string): string; virtual;
procedure GetInheritedCompilerOptions(var OptionsList: TList); virtual;
function GetOwnerName: string; virtual;
function GetBaseDirectory: string; virtual;
function GetInheritedOption(Option: TInheritedCompilerOption): string; virtual;
function MergeLinkerOptions(const OldOptions, AddOptions: string): string;
function MergeCustomOptions(const OldOptions, AddOptions: string): string;
public
{ Properties }
property Owner: TObject read fOwner write fOwner;
property Modified: boolean read FModified write SetModified;
property OnModified: TNotifyEvent read FOnModified write FOnModified;
property ParsedOpts: TParsedCompilerOptions read FParsedOpts;
property BaseDirectory: string read FBaseDirectory write SetBaseDirectory;
property XMLFile: String read fXMLFile write fXMLFile;
property TargetFilename: String read fTargetFilename write fTargetFilename;
@ -234,6 +261,7 @@ type
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;
@ -317,6 +345,7 @@ type
TAdditionalCompilerOptions = class
private
FBaseDirectory: string;
FCustomOptions: string;
FIncludePath: string;
FLibraryPath: string;
@ -325,12 +354,14 @@ type
fOwner: TObject;
FParsedOpts: TParsedCompilerOptions;
FUnitPath: string;
procedure SetCustomOptions(const AValue: string);
procedure SetIncludePath(const AValue: string);
procedure SetLibraryPath(const AValue: string);
procedure SetLinkerOptions(const AValue: string);
procedure SetObjectPath(const AValue: string);
procedure SetUnitPath(const AValue: string);
protected
procedure SetBaseDirectory(const AValue: string); virtual;
procedure SetCustomOptions(const AValue: string); virtual;
procedure SetIncludePath(const AValue: string); virtual;
procedure SetLibraryPath(const AValue: string); virtual;
procedure SetLinkerOptions(const AValue: string); virtual;
procedure SetObjectPath(const AValue: string); virtual;
procedure SetUnitPath(const AValue: string); virtual;
public
constructor Create(TheOwner: TObject);
destructor Destroy; override;
@ -338,7 +369,6 @@ type
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
function GetOwnerName: string; virtual;
function GetBaseDirectory: string; virtual;
public
property Owner: TObject read fOwner;
property UnitPath: string read FUnitPath write SetUnitPath;
@ -347,6 +377,7 @@ type
property LibraryPath: string read FLibraryPath write SetLibraryPath;
property LinkerOptions: string read FLinkerOptions write SetLinkerOptions;
property CustomOptions: string read FCustomOptions write SetCustomOptions;
property BaseDirectory: string read FBaseDirectory write SetBaseDirectory;
property ParsedOpts: TParsedCompilerOptions read FParsedOpts;
end;
@ -363,6 +394,7 @@ type
TfrmCompilerOptions = class(TForm)
nbMain: TNotebook;
ImageList: TImageList;
{ Search Paths Controls }
PathPage: TPage;
@ -528,6 +560,8 @@ type
procedure SetupButtonBar;
private
FReadOnly: boolean;
ImageIndexPackage: integer;
ImageIndexRequired: integer;
function GetOtherSourcePath: string;
procedure SetOtherSourcePath(const AValue: string);
procedure SetReadOnly(const AValue: boolean);
@ -549,10 +583,12 @@ type
var
frmCompilerOptions: TfrmCompilerOptions;
ParseStamp: integer;
CompilerParseStamp: integer;
CompilerGraphStamp: integer;
OnParseString: TParseStringEvent;
procedure IncreaseParseStamp;
procedure IncreaseCompilerParseStamp;
procedure IncreaseCompilerGraphStamp;
function ParseString(Options: TParsedCompilerOptions;
const UnparsedValue: string): string;
@ -560,16 +596,24 @@ implementation
const
Config_Filename = 'compileroptions.xml';
MaxParsedStamp = $7fffffff;
MinParsedStamp = -$7fffffff;
InvalidParsedStamp = MinParsedStamp-1;
MaxParseStamp = $7fffffff;
MinParseStamp = -$7fffffff;
InvalidParseStamp = MinParseStamp-1;
procedure IncreaseParseStamp;
procedure IncreaseCompilerParseStamp;
begin
if ParseStamp<MaxParsedStamp then
inc(ParseStamp)
if CompilerParseStamp<MaxParseStamp then
inc(CompilerParseStamp)
else
ParseStamp:=MinParsedStamp;
CompilerParseStamp:=MinParseStamp;
end;
procedure IncreaseCompilerGraphStamp;
begin
if CompilerGraphStamp<MaxParseStamp then
inc(CompilerGraphStamp)
else
CompilerGraphStamp:=MinParseStamp;
end;
function ParseString(Options: TParsedCompilerOptions;
@ -665,6 +709,13 @@ begin
ParsedOpts.SetUnparsedValue(pcosCompilerPath,fCompilerPath);
end;
procedure TBaseCompilerOptions.SetBaseDirectory(const AValue: string);
begin
if FBaseDirectory=AValue then exit;
FBaseDirectory:=AValue;
ParsedOpts.SetUnparsedValue(pcosBaseDir,FBaseDirectory);
end;
procedure TBaseCompilerOptions.SetCustomOptions(const AValue: string);
begin
if fCustomOptions=AValue then exit;
@ -700,6 +751,13 @@ begin
ParsedOpts.SetUnparsedValue(pcosOutputDir,fUnitOutputDir);
end;
procedure TBaseCompilerOptions.SetObjectPath(const AValue: string);
begin
if FObjectPath=AValue then exit;
FObjectPath:=AValue;
ParsedOpts.SetUnparsedValue(pcosObjectPath,FObjectPath);
end;
{------------------------------------------------------------------------------
TfrmCompilerOptions LoadTheCompilerOptions
------------------------------------------------------------------------------}
@ -724,6 +782,7 @@ begin
CompilerPath := XMLConfigFile.GetValue(p+'CompilerPath/Value', '$(CompPath)');
UnitOutputDirectory := XMLConfigFile.GetValue(p+'UnitOutputDirectory/Value', '');
LCLWidgetType := XMLConfigFile.GetValue(p+'LCLWidgetType/Value', 'gtk');
ObjectPath := XMLConfigFile.GetValue(p+'ObjectPath/Value', '');
{ Parsing }
p:='CompilerOptions/Parsing/';
@ -851,6 +910,7 @@ begin
XMLConfigFile.SetDeleteValue(p+'CompilerPath/Value', CompilerPath,'');
XMLConfigFile.SetDeleteValue(p+'UnitOutputDirectory/Value', UnitOutputDirectory,'');
XMLConfigFile.SetDeleteValue(p+'LCLWidgetType/Value', LCLWidgetType,'');
XMLConfigFile.SetDeleteValue(p+'ObjectPath/Value', ObjectPath,'');
{ Parsing }
p:='CompilerOptions/Parsing/';
@ -936,6 +996,16 @@ begin
OnModified(Self);
end;
procedure TBaseCompilerOptions.ClearInheritedOptions;
var
i: TInheritedCompilerOption;
begin
fInheritedOptParseStamps:=InvalidParseStamp;
fInheritedOptGraphStamps:=InvalidParseStamp;
for i:=Low(TInheritedCompilerOption) to High(TInheritedCompilerOption) do
fInheritedOptions[i]:='';
end;
{------------------------------------------------------------------------------
TBaseCompilerOptions CreateTargetFilename
------------------------------------------------------------------------------}
@ -971,11 +1041,88 @@ begin
end;
{------------------------------------------------------------------------------
function TBaseCompilerOptions.GetBaseDirectory: string;
function TBaseCompilerOptions.GetInheritedOption(
Option: TInheritedCompilerOption): string;
------------------------------------------------------------------------------}
function TBaseCompilerOptions.GetBaseDirectory: string;
function TBaseCompilerOptions.GetInheritedOption(
Option: TInheritedCompilerOption): string;
var
OptionsList: TList;
i: Integer;
AddOptions: TAdditionalCompilerOptions;
begin
Result:='';
if (fInheritedOptParseStamps<>CompilerParseStamp)
or (fInheritedOptGraphStamps<>CompilerGraphStamp)
then begin
// update inherited options
ClearInheritedOptions;
OptionsList:=nil;
GetInheritedCompilerOptions(OptionsList);
if OptionsList<>nil then begin
for i:=0 to OptionsList.Count-1 do begin
AddOptions:=TAdditionalCompilerOptions(OptionsList[i]);
if (not (AddOptions is TAdditionalCompilerOptions)) then continue;
// unit search path
fInheritedOptions[icoUnitPath]:=
MergeSearchPaths(fInheritedOptions[icoUnitPath],AddOptions.UnitPath);
// include search path
fInheritedOptions[icoIncludePath]:=
MergeSearchPaths(fInheritedOptions[icoIncludePath],
AddOptions.IncludePath);
// object search path
fInheritedOptions[icoObjectPath]:=
MergeSearchPaths(fInheritedOptions[icoObjectPath],
AddOptions.ObjectPath);
// library search path
fInheritedOptions[icoLibraryPath]:=
MergeSearchPaths(fInheritedOptions[icoLibraryPath],
AddOptions.LibraryPath);
// linker options
fInheritedOptions[icoLinkerOptions]:=
MergeLinkerOptions(fInheritedOptions[icoLinkerOptions],
AddOptions.LinkerOptions);
// custom options
fInheritedOptions[icoCustomOptions]:=
MergeCustomOptions(fInheritedOptions[icoCustomOptions],
AddOptions.CustomOptions);
end;
end;
fInheritedOptParseStamps:=CompilerParseStamp;
fInheritedOptGraphStamps:=CompilerGraphStamp;
end;
Result:=fInheritedOptions[Option];
end;
{------------------------------------------------------------------------------
function TBaseCompilerOptions.MergeLinkerOptions(const OldOptions,
AddOptions: string): string;
------------------------------------------------------------------------------}
function TBaseCompilerOptions.MergeLinkerOptions(const OldOptions,
AddOptions: string): string;
begin
Result:=OldOptions;
if AddOptions='' then exit;
if (OldOptions[length(OldOptions)]<>' ')
and (AddOptions[1]<>' ') then
Result:=Result+' '+AddOptions
else
Result:=Result+AddOptions;
end;
{------------------------------------------------------------------------------
function TBaseCompilerOptions.MergeCustomOptions(const OldOptions,
AddOptions: string): string;
------------------------------------------------------------------------------}
function TBaseCompilerOptions.MergeCustomOptions(const OldOptions,
AddOptions: string): string;
begin
Result:=OldOptions;
if AddOptions='' then exit;
if (OldOptions[length(OldOptions)]<>' ')
and (AddOptions[1]<>' ') then
Result:=Result+' '+AddOptions
else
Result:=Result+AddOptions;
end;
{------------------------------------------------------------------------------
@ -986,6 +1133,10 @@ begin
Result:=MakeOptionsString('')
end;
{------------------------------------------------------------------------------
function TBaseCompilerOptions.MakeOptionsString(
const MainSourceFilename: string): String;
------------------------------------------------------------------------------}
function TBaseCompilerOptions.MakeOptionsString(
const MainSourceFilename: string): String;
var
@ -1576,6 +1727,7 @@ begin
OtherUnitFiles := '';
CompilerPath := '$(CompPath)';
UnitOutputDirectory := '';
ObjectPath:='';
fLCLWidgetType := 'gtk';
// parsing
@ -1643,6 +1795,9 @@ begin
fAdditionalConfigFile := false;
fConfigFilePath := './fpc.cfg';
CustomOptions := '';
// inherited
ClearInheritedOptions;
end;
procedure TBaseCompilerOptions.Assign(CompOpts: TBaseCompilerOptions);
@ -1657,6 +1812,7 @@ begin
CompilerPath := CompOpts.fCompilerPath;
UnitOutputDirectory := CompOpts.fUnitOutputDir;
fLCLWidgetType := CompOpts.fLCLWidgetType;
ObjectPath := CompOpts.FObjectPath;
// Parsing
fStyle := CompOpts.fStyle;
@ -1736,6 +1892,7 @@ begin
and (fOtherUnitFiles = CompOpts.fOtherUnitFiles)
and (fCompilerPath = CompOpts.fCompilerPath)
and (fUnitOutputDir = CompOpts.fUnitOutputDir)
and (FObjectPath = CompOpts.FObjectPath)
and (fLCLWidgetType = CompOpts.fLCLWidgetType)
@ -1813,6 +1970,16 @@ end;
{ TfrmCompilerOptions Constructor }
{------------------------------------------------------------------------------}
constructor TfrmCompilerOptions.Create(TheOwner: TComponent);
procedure AddResImg(const ResName: string);
var Pixmap: TPixmap;
begin
Pixmap:=TPixmap.Create;
Pixmap.TransparentColor:=clWhite;
Pixmap.LoadFromLazarusResource(ResName);
ImageList.Add(Pixmap,nil)
end;
var Page: integer;
begin
inherited Create(TheOwner);
@ -1821,6 +1988,17 @@ begin
Position:=poScreenCenter;
IDEDialogLayoutList.ApplyLayout(Self,550,450);
ImageList:=TImageList.Create(Self);
with ImageList do begin
Width:=17;
Height:=17;
Name:='ImageList';
ImageIndexPackage:=Count;
AddResImg('pkg_package');
ImageIndexRequired:=Count;
AddResImg('pkg_required');
end;
nbMain := TNotebook.Create(Self);
nbMain.Parent := Self;
@ -2218,19 +2396,50 @@ var
i: Integer;
AncestorOptions: TAdditionalCompilerOptions;
AncestorNode: TTreeNode;
procedure AddChildNode(const NewNodeName, Value: string);
var
VisibleValue: String;
ChildNode: TTreeNode;
begin
if Value='' then exit;
if length(Value)>100 then
VisibleValue:=copy(Value,1,100)+'[...]'
else
VisibleValue:=Value;
ChildNode:=InhTreeView.Items.AddChild(AncestorNode,
NewNodeName+' = "'+VisibleValue+'"');
ChildNode.ImageIndex:=ImageIndexRequired;
ChildNode.SelectedIndex:=ChildNode.ImageIndex;
end;
begin
CompilerOpts.GetInheritedCompilerOptions(OptionsList);
InhTreeView.BeginUpdate;
InhTreeView.Items.Clear;
// add All node
// ToDo
if OptionsList<>nil then begin
for i:=0 to OptionsList.Count-1 do begin
AncestorOptions:=TAdditionalCompilerOptions(OptionsList[i]);
AncestorNode:=InhTreeView.Items.Add(nil,'');
AncestorNode.Text:=AncestorOptions.GetOwnerName;
// ToDo
AncestorNode.ImageIndex:=ImageIndexPackage;
AncestorNode.SelectedIndex:=AncestorNode.ImageIndex;
with AncestorOptions.ParsedOpts do begin
AddChildNode('unit path',GetParsedValue(pcosUnitPath));
AddChildNode('include path',GetParsedValue(pcosIncludePath));
AddChildNode('object path',GetParsedValue(pcosObjectPath));
AddChildNode('library path',GetParsedValue(pcosLibraryPath));
AddChildNode('linker options',GetParsedValue(pcosLinkerOptions));
AddChildNode('custom options',GetParsedValue(pcosCustomOptions));
end;
AncestorNode.Expanded:=true;
end;
end else begin
InhTreeView.Items.Add(nil,'No compiler options inherited.');
end;
InhTreeView.EndUpdate;
end;
@ -3209,6 +3418,7 @@ begin
Parent:=InheritedPage;
Options:=Options+[tvoReadOnly, tvoRightClickSelect, tvoShowRoot,
tvoKeepCollapsedNodes];
Images:=ImageList;
Align:=alClient;
end;
end;
@ -3615,6 +3825,13 @@ begin
ParsedOpts.SetUnparsedValue(pcosCustomOptions,fCustomOptions);
end;
procedure TAdditionalCompilerOptions.SetBaseDirectory(const AValue: string);
begin
if FBaseDirectory=AValue then exit;
FBaseDirectory:=AValue;
ParsedOpts.SetUnparsedValue(pcosBaseDir,FBaseDirectory);
end;
procedure TAdditionalCompilerOptions.SetIncludePath(const AValue: string);
begin
if FIncludePath=AValue then exit;
@ -3677,12 +3894,12 @@ procedure TAdditionalCompilerOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig;
const Path: string);
begin
Clear;
fCustomOptions:=XMLConfig.GetValue(Path+'CustomOptions/Value','');
FIncludePath:=XMLConfig.GetValue(Path+'IncludePath/Value','');
FLibraryPath:=XMLConfig.GetValue(Path+'LibraryPath/Value','');
fLinkerOptions:=XMLConfig.GetValue(Path+'LinkerOptions/Value','');
FObjectPath:=XMLConfig.GetValue(Path+'ObjectPath/Value','');
FUnitPath:=XMLConfig.GetValue(Path+'UnitPath/Value','');
CustomOptions:=XMLConfig.GetValue(Path+'CustomOptions/Value','');
IncludePath:=XMLConfig.GetValue(Path+'IncludePath/Value','');
LibraryPath:=XMLConfig.GetValue(Path+'LibraryPath/Value','');
LinkerOptions:=XMLConfig.GetValue(Path+'LinkerOptions/Value','');
ObjectPath:=XMLConfig.GetValue(Path+'ObjectPath/Value','');
UnitPath:=XMLConfig.GetValue(Path+'UnitPath/Value','');
end;
procedure TAdditionalCompilerOptions.SaveToXMLConfig(XMLConfig: TXMLConfig;
@ -3704,18 +3921,6 @@ begin
Result:='Has no owner';
end;
function TAdditionalCompilerOptions.GetBaseDirectory: string;
begin
Result:='';
end;
{ TCompilerOptions }
procedure TCompilerOptions.Clear;
begin
inherited Clear;
end;
{ TParsedCompilerOptions }
constructor TParsedCompilerOptions.Create;
@ -3725,33 +3930,92 @@ end;
function TParsedCompilerOptions.GetParsedValue(Option: TParsedCompilerOptString
): string;
var
BaseDirectory: String;
s: String;
begin
if ParsedStamp[Option]<>ParseStamp then begin
ParsedValues[Option]:=ParseString(Self,UnparsedValues[Option]);
// make filename absolute
// ToDo
ParsedStamp[Option]:=ParseStamp;
if ParsedStamp[Option]<>CompilerParseStamp then begin
s:=ParseString(Self,UnparsedValues[Option]);
if Option=pcosBaseDir then
// base directory (append path)
s:=AppendPathDelim(TrimFilename(s))
else if Option in ParsedCompilerFilenames then begin
// make filename absolute
s:=TrimFilename(s);
BaseDirectory:=GetParsedValue(pcosBaseDir);
if (BaseDirectory<>'') and (not FilenameIsAbsolute(s)) then
s:=BaseDirectory+s;
end
else if Option in ParsedCompilerSearchPaths then begin
// make search paths absolute
BaseDirectory:=GetParsedValue(pcosBaseDir);
s:=TrimSearchPath(s,BaseDirectory);
end;
ParsedValues[Option]:=s;
ParsedStamp[Option]:=CompilerParseStamp;
end;
Result:=ParsedValues[Option];
end;
procedure TParsedCompilerOptions.SetUnparsedValue(
Option: TParsedCompilerOptString; const NewValue: string);
var
PreParsedValue: String;
begin
ParsedStamp[Option]:=InvalidParsedStamp;
UnparsedValues[Option]:=NewValue;
if Assigned(OnLocalSubstitute) then begin
PreParsedValue:=OnLocalSubstitute(NewValue);
end else begin
PreParsedValue:=NewValue;
end;
if PreParsedValue=UnparsedValues[Option] then exit;
IncreaseCompilerGraphStamp;
if Option=pcosBaseDir then
InvalidateFiles
else
ParsedStamp[Option]:=InvalidParseStamp;
UnparsedValues[Option]:=PreParsedValue;
end;
procedure TParsedCompilerOptions.Clear;
var
Option: TParsedCompilerOptString;
begin
InvalidateAll;
for Option:=Low(TParsedCompilerOptString) to High(TParsedCompilerOptString) do
ParsedStamp[Option]:=InvalidParsedStamp;
begin
ParsedValues[Option]:='';
UnparsedValues[Option]:='';
end;
end;
procedure TParsedCompilerOptions.InvalidateAll;
var
Option: TParsedCompilerOptString;
begin
for Option:=Low(TParsedCompilerOptString) to High(TParsedCompilerOptString) do
ParsedStamp[Option]:=InvalidParseStamp;
end;
procedure TParsedCompilerOptions.InvalidateFiles;
var
Option: TParsedCompilerOptString;
begin
for Option:=Low(TParsedCompilerOptString) to High(TParsedCompilerOptString) do
if (Option in ParsedCompilerFiles) then
ParsedStamp[Option]:=InvalidParseStamp;
end;
{ TCompilerOptions }
procedure TCompilerOptions.Clear;
begin
inherited Clear;
end;
initialization
ParseStamp:=0;
CompilerParseStamp:=1;
CompilerGraphStamp:=1;
end.

47
ide/project.pp
View File

@ -209,7 +209,6 @@ type
public
constructor Create(TheProject: TProject);
function GetOwnerName: string; override;
function GetBaseDirectory: string; override;
public
property OwnerProject: TProject read FOwnerProject;
end;
@ -254,6 +253,7 @@ type
fOnFileBackup: TOnFileBackup;
fOutputDirectory: String;
fProjectInfoFile: String; // the lpi filename
fProjectDirectory: string;
fProjectType: TProjectType;
fPublishOptions: TPublishProjectOptions;
fRunParameterOptions: TRunParamsOptions;
@ -281,6 +281,7 @@ type
function JumpHistoryCheckPosition(
APosition:TProjectJumpHistoryPosition): boolean;
procedure SetSrcPath(const NewSrcPath: string);
procedure UpdateProjectDirectory;
protected
procedure AddToEditorWithIndexList(AnUnitInfo: TUnitInfo);
procedure RemoveFromEditorWithIndexList(AnUnitInfo: TUnitInfo);
@ -349,7 +350,6 @@ type
function IsVirtual: boolean;
function RemoveProjectPathFromFilename(const AFilename: string): string;
function ProjectDirectory: string;
function FileIsInProjectDir(const AFilename: string): boolean;
procedure GetVirtualDefines(DefTree: TDefineTree; DirDef: TDirectoryDefines);
function SearchFile(const Filename,SearchPaths,InitialDir:string):string;
@ -368,20 +368,21 @@ type
read fCompilerOptions write fCompilerOptions;
property FirstAutoRevertLockedUnit: TUnitInfo read fFirstAutoRevertLockedUnit;
property FirstLoadedUnit: TUnitInfo read fFirstLoadedUnit;
property FirstUnitWithEditorIndex: TUnitInfo read fFirstUnitWithEditorIndex;
property FirstUnitWithForm: TUnitInfo read fFirstUnitWithForm;
property FirstPartOfProject: TUnitInfo read fFirstPartOfProject;
property FirstUnitWithEditorIndex: TUnitInfo read fFirstUnitWithEditorIndex;
property FirstUnitWithForm: TUnitInfo read fFirstUnitWithForm;
property Flags: TProjectFlags read FFlags write SetFlags;
property IconPath: String read fIconPath write fIconPath;
property JumpHistory: TProjectJumpHistory
read fJumpHistory write fJumpHistory;
property MainFilename: String read GetMainFilename;
property MainUnitID: Integer read fMainUnitID write SetMainUnitID;
property MainUnitInfo: TUnitInfo read GetMainUnitInfo;
property Modified: boolean read fModified write fModified;
property OnFileBackup: TOnFileBackup read fOnFileBackup write fOnFileBackup;
property OutputDirectory: String read fOutputDirectory write fOutputDirectory;
property MainFilename: String read GetMainFilename;
property ProjectDirectory: string read fProjectDirectory;
property ProjectInfoFile: string
read GetProjectInfoFile write SetProjectInfoFile;
property ProjectType: TProjectType read fProjectType write fProjectType;
@ -1066,6 +1067,7 @@ begin
fModified := false;
fOutputDirectory := '.';
fProjectInfoFile := '';
UpdateProjectDirectory;
fPublishOptions:=TPublishProjectOptions.Create;
fRunParameterOptions:=TRunParamsOptions.Create;
fSrcPath := '';
@ -1482,6 +1484,7 @@ begin
fModified := false;
fOutputDirectory := '.';
fProjectInfoFile := '';
UpdateProjectDirectory;
fPublishOptions.Clear;
fSrcPath := '';
fTargetFileExt := DefaultTargetFileExt;
@ -1912,13 +1915,18 @@ begin
end;
procedure TProject.SetProjectInfoFile(const NewFilename:string);
var
NewProjectInfoFile: String;
begin
if NewFilename='' then exit;
NewProjectInfoFile:=TrimFilename(NewFilename);
if NewProjectInfoFile='' then exit;
DoDirSeparators(NewProjectInfoFile);
if (AnsiCompareText(fTitle,ExtractFileNameOnly(fProjectInfoFile))=0)
or (fProjectInfoFile='') or (fTitle='') then
fTitle:=ExtractFileNameOnly(NewFilename);
fProjectInfoFile:=NewFilename;
or (fProjectInfoFile='') or (fTitle='') then begin
fTitle:=ExtractFileNameOnly(NewProjectInfoFile);
end;
fProjectInfoFile:=NewProjectInfoFile;
UpdateProjectDirectory;
Modified:=true;
end;
@ -1968,11 +1976,6 @@ begin
length(Result)-length(ProjectPath));
end;
function TProject.ProjectDirectory: string;
begin
Result:=ExtractFilePath(ProjectInfoFile);
end;
function TProject.FileIsInProjectDir(const AFilename: string): boolean;
var ProjectDir, FilePath: string;
begin
@ -2161,6 +2164,12 @@ begin
fSrcPath:=NewSrcPath;
end;
procedure TProject.UpdateProjectDirectory;
begin
fProjectDirectory:=ExtractFilePath(fProjectInfoFile);
CompilerOptions.BaseDirectory:=fProjectDirectory;
end;
procedure TProject.AddToEditorWithIndexList(AnUnitInfo: TUnitInfo);
begin
// add to list if AnUnitInfo is not in list
@ -2321,17 +2330,15 @@ begin
if Result='' then Result:=ExtractFilename(OwnerProject.ProjectInfoFile);
end;
function TProjectCompilerOptions.GetBaseDirectory: string;
begin
Result:=OwnerProject.ProjectDirectory;
end;
end.
{
$Log$
Revision 1.106 2003/04/15 17:58:28 mattias
implemented inherited Compiler Options View
Revision 1.105 2003/04/15 08:54:27 mattias
fixed TMemo.WordWrap

88
ide/transfermacros.pp
View File

@ -73,9 +73,11 @@ type
TTransferMacroList = class
private
fItems: TList; // list of TTransferMacro
FMarkUnhandledMacros: boolean;
fOnSubstitution: TOnSubstitution;
function GetItems(Index: integer): TTransferMacro;
procedure SetItems(Index: integer; NewMacro: TTransferMacro);
procedure SetMarkUnhandledMacros(const AValue: boolean);
protected
function MF_Ext(const Filename:string; var Abort: boolean):string; virtual;
function MF_Path(const Filename:string; var Abort: boolean):string; virtual;
@ -98,6 +100,7 @@ type
property OnSubstitution: TOnSubstitution
read fOnSubstitution write fOnSubstitution;
function FindByName(const MacroName: string): TTransferMacro; virtual;
property MarkUnhandledMacros: boolean read FMarkUnhandledMacros write SetMarkUnhandledMacros;
end;
@ -124,6 +127,7 @@ constructor TTransferMacroList.Create;
begin
inherited Create;
fItems:=TList.Create;
FMarkUnhandledMacros:=true;
Add(TTransferMacro.Create('Ext','','Function: extract file extension',@MF_Ext,[]));
Add(TTransferMacro.Create('Path','','Function: extract file path',@MF_Path,[]));
Add(TTransferMacro.Create('Name','','Function: extract file name+extension',
@ -154,6 +158,12 @@ begin
fItems[Index]:=NewMacro;
end;
procedure TTransferMacroList.SetMarkUnhandledMacros(const AValue: boolean);
begin
if FMarkUnhandledMacros=AValue then exit;
FMarkUnhandledMacros:=AValue;
end;
procedure TTransferMacroList.SetValue(const MacroName, NewValue: string);
var AMacro:TTransferMacro;
begin
@ -197,6 +207,7 @@ var MacroStart,MacroEnd: integer;
InFrontOfMacroLen: Integer;
NewStringLen: Integer;
NewStringPos: Integer;
sLen: Integer;
function SearchBracketClose(Position:integer): integer;
var BracketClose:char;
@ -216,25 +227,25 @@ var MacroStart,MacroEnd: integer;
begin
Result:=true;
sLen:=length(s);
MacroStart:=1;
repeat
while (MacroStart<=length(s)) do begin
while (MacroStart<sLen) do begin
if (s[MacroStart]='$') and ((MacroStart=1) or (s[MacroStart-1]<>'\')) then
break
else
inc(MacroStart);
end;
if MacroStart>length(s) then break;
if MacroStart>=sLen then break;
MacroEnd:=MacroStart+1;
while (MacroEnd<=length(s))
and (IsIdentCHar[s[MacroEnd]]) do
while (MacroEnd<=sLen) and (IsIdentChar[s[MacroEnd]]) do
inc(MacroEnd);
MacroName:=copy(s,MacroStart+1,MacroEnd-MacroStart-1);
if (MacroEnd<length(s)) and (s[MacroEnd] in ['(','{']) then begin
if (MacroEnd<sLen) and (s[MacroEnd] in ['(','{']) then begin
MacroName:=copy(s,MacroStart+1,MacroEnd-MacroStart-1);
MacroEnd:=SearchBracketClose(MacroEnd)+1;
if MacroEnd>length(s)+1 then break;
if MacroEnd>sLen+1 then break;
OldMacroLen:=MacroEnd-MacroStart;
MacroStr:=copy(s,MacroStart,OldMacroLen);
// Macro found
@ -263,13 +274,14 @@ begin
Result:=false;
exit;
end;
Handled:=true;
end;
end else begin
// Macro variable
MacroStr:=copy(s,MacroStart+2,OldMacroLen-3);
AMacro:=FindByName(MacroStr);
if Assigned(fOnSubstitution) then
fOnSubstitution(AMacro,MacroStr,Handled,ABort);
fOnSubstitution(AMacro,MacroStr,Handled,Abort);
if Abort then begin
Result:=false;
exit;
@ -279,33 +291,41 @@ begin
MacroStr:=AMacro.Value;
Handled:=true;
end;
if not Handled then
MacroStr:='(unknown macro: '+MacroStr+')';
end;
NewMacroEnd:=MacroStart+length(MacroStr);
NewMacroLen:=length(MacroStr);
InFrontOfMacroLen:=MacroStart-1;
BehindMacroLen:=length(s)-MacroEnd+1;
NewString:='';
NewStringLen:=InFrontOfMacroLen+NewMacroLen+BehindMacroLen;
if NewStringLen>0 then begin
SetLength(NewString,NewStringLen);
NewStringPos:=1;
if InFrontOfMacroLen>0 then begin
Move(s[1],NewString[NewStringPos],InFrontOfMacroLen);
inc(NewStringPos,InFrontOfMacroLen);
end;
if NewMacroLen>0 then begin
Move(MacroStr[1],NewString[NewStringPos],NewMacroLen);
inc(NewStringPos,NewMacroLen);
end;
if BehindMacroLen>0 then begin
Move(s[MacroEnd],NewString[NewStringPos],BehindMacroLen);
inc(NewStringPos,BehindMacroLen);
end;
// mark unhandled macros
if not Handled and MarkUnhandledMacros then begin
MacroStr:='(unknown macro: '+MacroStr+')';
Handled:=true;
end;
// replace macro with new value
if Handled then begin
NewMacroLen:=length(MacroStr);
NewMacroEnd:=MacroStart+NewMacroLen;
InFrontOfMacroLen:=MacroStart-1;
BehindMacroLen:=sLen-MacroEnd+1;
NewString:='';
NewStringLen:=InFrontOfMacroLen+NewMacroLen+BehindMacroLen;
if NewStringLen>0 then begin
SetLength(NewString,NewStringLen);
NewStringPos:=1;
if InFrontOfMacroLen>0 then begin
Move(s[1],NewString[NewStringPos],InFrontOfMacroLen);
inc(NewStringPos,InFrontOfMacroLen);
end;
if NewMacroLen>0 then begin
Move(MacroStr[1],NewString[NewStringPos],NewMacroLen);
inc(NewStringPos,NewMacroLen);
end;
if BehindMacroLen>0 then begin
Move(s[MacroEnd],NewString[NewStringPos],BehindMacroLen);
inc(NewStringPos,BehindMacroLen);
end;
end;
s:=NewString;
sLen:=length(s);
// continue after the replacement
MacroEnd:=NewMacroEnd;
end;
s:=NewString;
MacroEnd:=NewMacroEnd;
end;
MacroStart:=MacroEnd;
until false;

48
lcl/include/filectrl.inc
View File

@ -96,16 +96,56 @@ end;
function TrimFilename(const AFilename: string): string;
// trim double path delims, heading and trailing spaces
// and special dirs . and ..
function FilenameIsTrimmed(const TheFilename: string): boolean;
var
l: Integer;
i: Integer;
begin
Result:=false;
if TheFilename='' then begin
Result:=true;
exit;
end;
l:=length(TheFilename);
// check heading spaces
if TheFilename[1]=' ' then exit;
// check trailing spaces
if TheFilename[l]=' ' then exit;
i:=1;
while i<=l do begin
case TheFilename[i] of
PathDelim:
// check for double path delimiter
if (i<l) and (TheFilename[i+1]=PathDelim) then exit;
'.':
if (i=1) or (TheFilename[i-1]=PathDelim) then begin
// check for . and .. directories
if (i=l) or (TheFilename[i+1]=PathDelim) then exit;
if (TheFilename[i+1]='.')
and ((i=l-1) or (TheFilename[i+2]=PathDelim)) then exit;
end;
end;
inc(i);
end;
Result:=true;
end;
var SrcPos, DestPos, l, DirStart: integer;
c: char;
begin
Result:=AFilename;
if FilenameIsTrimmed(Result) then exit;
l:=length(AFilename);
SrcPos:=1;
DestPos:=1;
// skip trailing spaces
while (l>=1) and (AFilename[SrcPos]=' ') do dec(l);
while (l>=1) and (AFilename[l]=' ') do dec(l);
// skip heading spaces
while (SrcPos<=l) and (AFilename[SrcPos]=' ') do inc(SrcPos);
@ -132,7 +172,8 @@ begin
// check for special dirs . and ..
if (c='.') then begin
if (SrcPos<l) then begin
if (AFilename[SrcPos+1]=PathDelim) then begin
if (AFilename[SrcPos+1]=PathDelim)
and ((DestPos=1) or (AFilename[SrcPos-1]=PathDelim)) then begin
// special dir ./
// -> skip
inc(SrcPos,2);
@ -850,6 +891,9 @@ end;
{
$Log$
Revision 1.23 2003/04/15 17:58:28 mattias
implemented inherited Compiler Options View
Revision 1.22 2003/03/30 20:37:15 mattias
ipro now shows simple HTML pages

204
packager/packagedefs.pas
View File

@ -46,7 +46,7 @@ interface
uses
Classes, SysUtils, LCLProc, LResources, Graphics, Laz_XMLCfg, AVL_Tree,
CompilerOptions, Forms, FileCtrl, IDEProcs, ComponentReg;
CompilerOptions, Forms, FileCtrl, IDEProcs, ComponentReg, TransferMacros;
type
TLazPackage = class;
@ -231,6 +231,10 @@ type
ListType: TPkgDependencyList);
procedure RemoveFromList(var FirstDependency: TPkgDependency;
ListType: TPkgDependencyList);
procedure MoveUpInList(var FirstDependency: TPkgDependency;
ListType: TPkgDependencyList);
procedure MoveDownInList(var FirstDependency: TPkgDependency;
ListType: TPkgDependencyList);
public
property PackageName: string read FPackageName write SetPackageName;
property Flags: TPkgDependencyFlags read FFlags write SetFlags;
@ -251,26 +255,39 @@ type
protected
procedure SetLazPackage(const AValue: TLazPackage);
procedure SetModified(const NewValue: boolean); override;
procedure SetCustomOptions(const AValue: string); override;
procedure SetIncludeFiles(const AValue: string); override;
procedure SetLibraries(const AValue: string); override;
procedure SetLinkerOptions(const AValue: string); override;
procedure SetObjectPath(const AValue: string); override;
procedure SetOtherUnitFiles(const AValue: string); override;
public
constructor Create(ThePackage: TLazPackage);
procedure Clear; override;
procedure GetInheritedCompilerOptions(var OptionsList: TList); override;
function GetOwnerName: string; override;
procedure InvalidateOptions;
public
property LazPackage: TLazPackage read FLazPackage write SetLazPackage;
end;
{ TPkgAdditinoalCompilerOptions }
{ TPkgAdditionalCompilerOptions }
TPkgAdditionalCompilerOptions = class(TAdditionalCompilerOptions)
private
FLazPackage: TLazPackage;
procedure SetLazPackage(const AValue: TLazPackage);
protected
procedure SetCustomOptions(const AValue: string); override;
procedure SetIncludePath(const AValue: string); override;
procedure SetLibraryPath(const AValue: string); override;
procedure SetLinkerOptions(const AValue: string); override;
procedure SetObjectPath(const AValue: string); override;
procedure SetUnitPath(const AValue: string); override;
public
constructor Create(ThePackage: TLazPackage);
function GetOwnerName: string; override;
function GetBaseDirectory: string; override;
public
property LazPackage: TLazPackage read FLazPackage write SetLazPackage;
end;
@ -350,6 +367,7 @@ type
FFlags: TLazPackageFlags;
FIconFile: string;
FInstalled: TPackageInstallType;
FMacros: TTransferMacroList;
FModifiedLock: integer;
FPackageEditor: TBasePackageEditor;
FPackageType: TLazPackageType;
@ -383,10 +401,13 @@ type
procedure SetPackageEditor(const AValue: TBasePackageEditor);
procedure SetPackageType(const AValue: TLazPackageType);
procedure SetReadOnly(const AValue: boolean);
procedure OnMacroListSubstitution(TheMacro: TTransferMacro; var s: string;
var Handled, Abort: boolean);
function SubstitutePkgMacro(const s: string): string;
procedure Clear;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure LockModified;
procedure UnlockModified;
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
@ -419,6 +440,8 @@ type
procedure DeleteRemoveRequiredPkg(Dependency: TPkgDependency);
procedure AddRequiredDependency(Dependency: TPkgDependency);
procedure RemoveRequiredDependency(Dependency: TPkgDependency);
procedure MoveRequiredDependencyUp(Dependency: TPkgDependency);
procedure MoveRequiredDependencyDown(Dependency: TPkgDependency);
function CreateDependencyForThisPkg: TPkgDependency;
function AddComponent(PkgFile: TPkgFile; const Page: string;
TheComponentClass: TComponentClass): TPkgComponent;
@ -461,6 +484,7 @@ type
property ReadOnly: boolean read FReadOnly write SetReadOnly;
property RemovedFilesCount: integer read GetRemovedCount;
property RemovedFiles[Index: integer]: TPkgFile read GetRemovedFiles;
property Macros: TTransferMacroList read FMacros;
property UsageOptions: TPkgAdditionalCompilerOptions
read FUsageOptions;
end;
@ -1108,6 +1132,42 @@ begin
PrevDependency[ListType]:=nil;
end;
procedure TPkgDependency.MoveUpInList(var FirstDependency: TPkgDependency;
ListType: TPkgDependencyList);
var
OldPrev: TPkgDependency;
begin
if (FirstDependency=Self) or (PrevDependency[ListType]=nil) then exit;
OldPrev:=PrevDependency[ListType];
if OldPrev.PrevDependency[ListType]<>nil then
OldPrev.PrevDependency[ListType].NextDependency[ListType]:=Self;
if NextDependency[ListType]<>nil then
NextDependency[ListType].PrevDependency[ListType]:=OldPrev;
OldPrev.NextDependency[ListType]:=NextDependency[ListType];
PrevDependency[ListType]:=OldPrev.PrevDependency[ListType];
NextDependency[ListType]:=OldPrev;
OldPrev.PrevDependency[ListType]:=Self;
if FirstDependency=OldPrev then FirstDependency:=Self;
end;
procedure TPkgDependency.MoveDownInList(var FirstDependency: TPkgDependency;
ListType: TPkgDependencyList);
var
OldNext: TPkgDependency;
begin
if (NextDependency[ListType]=nil) then exit;
OldNext:=NextDependency[ListType];
if OldNext.NextDependency[ListType]<>nil then
OldNext.NextDependency[ListType].PrevDependency[ListType]:=Self;
if PrevDependency[ListType]<>nil then
PrevDependency[ListType].NextDependency[ListType]:=OldNext;
OldNext.PrevDependency[ListType]:=PrevDependency[ListType];
NextDependency[ListType]:=OldNext.NextDependency[ListType];
PrevDependency[ListType]:=OldNext;
OldNext.NextDependency[ListType]:=Self;
if FirstDependency=Self then FirstDependency:=OldNext;
end;
{ TPkgVersion }
procedure TPkgVersion.Clear;
@ -1215,6 +1275,25 @@ end;
{ TLazPackage }
procedure TLazPackage.OnMacroListSubstitution(TheMacro: TTransferMacro;
var s: string; var Handled, Abort: boolean);
begin
if AnsiCompareText(s,'PkgOutDir')=0 then begin
Handled:=true;
s:=CompilerOptions.UnitOutputDirectory;
end
else if AnsiCompareText(s,'PkgDir')=0 then begin
Handled:=true;
s:=FDirectory;
end;
end;
function TLazPackage.SubstitutePkgMacro(const s: string): string;
begin
Result:=s;
FMacros.SubstituteStr(Result);
end;
function TLazPackage.GetAutoIncrementVersionOnBuild: boolean;
begin
Result:=lpfAutoIncrementVersionOnBuild in FFlags;
@ -1324,6 +1403,8 @@ begin
FDirectory:=FFilename
else
FDirectory:=ExtractFilePath(FFilename);
FUsageOptions.BaseDirectory:=FDirectory;
FCompilerOptions.BaseDirectory:=FDirectory;
Modified:=true;
end;
@ -1399,19 +1480,26 @@ begin
FComponents:=TList.Create;
FFiles:=TList.Create;
FRemovedFiles:=TList.Create;
FMacros:=TTransferMacroList.Create;
FMacros.MarkUnhandledMacros:=false;
FMacros.OnSubstitution:=@OnMacroListSubstitution;
FCompilerOptions:=TPkgCompilerOptions.Create(Self);
FCompilerOptions.ParsedOpts.OnLocalSubstitute:=@SubstitutePkgMacro;
FUsageOptions:=TPkgAdditionalCompilerOptions.Create(Self);
FUsageOptions.ParsedOpts.OnLocalSubstitute:=@SubstitutePkgMacro;
Clear;
end;
destructor TLazPackage.Destroy;
begin
Include(FFlags,lpfDestroying);
Clear;
FreeAndNil(FRemovedFiles);
FreeAndNil(FFiles);
FreeAndNil(FComponents);
FreeAndNil(FCompilerOptions);
FreeAndNil(FUsageOptions);
FreeAndNil(FMacros);
inherited Destroy;
end;
@ -1437,7 +1525,6 @@ begin
for i:=FComponents.Count-1 downto 0 do Components[i].Free;
FComponents.Clear;
FCompilerOptions.Clear;
fCompilerOptions.UnitOutputDirectory:='lib'+PathDelim;
FDescription:='';
FDirectory:='';
FVersion.Clear;
@ -1446,13 +1533,20 @@ begin
FRemovedFiles.Clear;
for i:=FFiles.Count-1 downto 0 do Files[i].Free;
FFiles.Clear;
FFlags:=[lpfAutoIncrementVersionOnBuild,lpfAutoUpdate];
FIconFile:='';
FInstalled:=pitNope;
FName:='';
FPackageType:=lptRunAndDesignTime;
FRegistered:=false;
FUsageOptions.Clear;
// set some nice start values
if not (lpfDestroying in FFlags) then begin
FFlags:=[lpfAutoIncrementVersionOnBuild,lpfAutoUpdate];
fCompilerOptions.UnitOutputDirectory:='lib'+PathDelim;
FUsageOptions.UnitPath:='$(PkgOutDir)';
end else begin
FFlags:=[lpfDestroying];
end;
end;
procedure TLazPackage.LockModified;
@ -1856,6 +1950,16 @@ begin
Modified:=true;
end;
procedure TLazPackage.MoveRequiredDependencyUp(Dependency: TPkgDependency);
begin
Dependency.MoveUpInList(FFirstRequiredDependency,pdlRequires);
end;
procedure TLazPackage.MoveRequiredDependencyDown(Dependency: TPkgDependency);
begin
Dependency.MoveDownInList(FFirstRequiredDependency,pdlRequires);
end;
function TLazPackage.CreateDependencyForThisPkg: TPkgDependency;
begin
Result:=TPkgDependency.Create;
@ -2089,6 +2193,42 @@ begin
if Modified and (LazPackage<>nil) then LazPackage.Modified:=true;
end;
procedure TPkgCompilerOptions.SetCustomOptions(const AValue: string);
begin
if CustomOptions<>AValue then InvalidateOptions;
inherited SetCustomOptions(AValue);
end;
procedure TPkgCompilerOptions.SetIncludeFiles(const AValue: string);
begin
if IncludeFiles<>AValue then InvalidateOptions;
inherited SetIncludeFiles(AValue);
end;
procedure TPkgCompilerOptions.SetLibraries(const AValue: string);
begin
if Libraries<>AValue then InvalidateOptions;
inherited SetLibraries(AValue);
end;
procedure TPkgCompilerOptions.SetLinkerOptions(const AValue: string);
begin
if LinkerOptions<>AValue then InvalidateOptions;
inherited SetLinkerOptions(AValue);
end;
procedure TPkgCompilerOptions.SetObjectPath(const AValue: string);
begin
if ObjectPath<>AValue then InvalidateOptions;
inherited SetObjectPath(AValue);
end;
procedure TPkgCompilerOptions.SetOtherUnitFiles(const AValue: string);
begin
if OtherUnitFiles<>AValue then InvalidateOptions;
inherited SetOtherUnitFiles(AValue);
end;
constructor TPkgCompilerOptions.Create(ThePackage: TLazPackage);
begin
inherited Create(ThePackage);
@ -2111,6 +2251,11 @@ begin
Result:=LazPackage.IDAsString;
end;
procedure TPkgCompilerOptions.InvalidateOptions;
begin
LazPackage.UsageOptions.ParsedOpts.InvalidateAll;
end;
{ TPkgAdditionalCompilerOptions }
procedure TPkgAdditionalCompilerOptions.SetLazPackage(const AValue: TLazPackage
@ -2120,6 +2265,48 @@ begin
FLazPackage:=AValue;
end;
procedure TPkgAdditionalCompilerOptions.SetCustomOptions(const AValue: string);
begin
if AValue=CustomOptions then exit;
inherited SetCustomOptions(AValue);
LazPackage.Modified:=true;
end;
procedure TPkgAdditionalCompilerOptions.SetIncludePath(const AValue: string);
begin
if AValue=IncludePath then exit;
inherited SetIncludePath(AValue);
LazPackage.Modified:=true;
end;
procedure TPkgAdditionalCompilerOptions.SetLibraryPath(const AValue: string);
begin
if AValue=LibraryPath then exit;
inherited SetLibraryPath(AValue);
LazPackage.Modified:=true;
end;
procedure TPkgAdditionalCompilerOptions.SetLinkerOptions(const AValue: string);
begin
if AValue=LinkerOptions then exit;
inherited SetLinkerOptions(AValue);
LazPackage.Modified:=true;
end;
procedure TPkgAdditionalCompilerOptions.SetObjectPath(const AValue: string);
begin
if AValue=ObjectPath then exit;
inherited SetObjectPath(AValue);
LazPackage.Modified:=true;
end;
procedure TPkgAdditionalCompilerOptions.SetUnitPath(const AValue: string);
begin
if AValue=UnitPath then exit;
inherited SetUnitPath(AValue);
LazPackage.Modified:=true;
end;
constructor TPkgAdditionalCompilerOptions.Create(ThePackage: TLazPackage);
begin
inherited Create(ThePackage);
@ -2131,11 +2318,6 @@ begin
Result:=LazPackage.IDAsString;
end;
function TPkgAdditionalCompilerOptions.GetBaseDirectory: string;
begin
Result:=LazPackage.Directory;
end;
initialization
PackageDependencies:=TAVLTree.Create(@ComparePkgDependencyNames);

36
packager/packageeditor.pas
View File

@ -99,6 +99,8 @@ type
procedure InstallBitBtnClick(Sender: TObject);
procedure MaxVersionEditChange(Sender: TObject);
procedure MinVersionEditChange(Sender: TObject);
procedure MoveDependencyUpClick(Sender: TObject);
procedure MoveDependencyDownClick(Sender: TObject);
procedure OpenFileMenuItemClick(Sender: TObject);
procedure OptionsBitBtnClick(Sender: TObject);
procedure PackageEditorFormClose(Sender: TObject; var Action: TCloseAction);
@ -282,6 +284,8 @@ procedure TPackageEditorForm.FilesPopupMenuPopup(Sender: TObject);
var
CurNode: TTreeNode;
ItemCnt: Integer;
CurDependency: TPkgDependency;
Removed: boolean;
procedure AddPopupMenuItem(const ACaption: string; AnEvent: TNotifyEvent;
EnabledFlag: boolean);
@ -302,14 +306,19 @@ var
begin
CurNode:=FilesTreeView.Selected;
ItemCnt:=0;
CurDependency:=GetCurrentDependency(Removed);
if CurNode<>nil then begin
if CurNode.Parent<>nil then begin
if CurNode.Parent=FilesNode then begin
AddPopupMenuItem('Open file',@OpenFileMenuItemClick,true);
AddPopupMenuItem('Remove file',@RemoveBitBtnClick,true);
end else if (CurNode.Parent=RequiredPackagesNode) then begin
end else if (CurDependency<>nil) and (not Removed) then begin
AddPopupMenuItem('Open package',@OpenFileMenuItemClick,true);
AddPopupMenuItem('Remove dependency',@RemoveBitBtnClick,true);
AddPopupMenuItem('Move dependency up',@MoveDependencyUpClick,
CurDependency.PrevRequiresDependency<>nil);
AddPopupMenuItem('Move dependency down',@MoveDependencyDownClick,
CurDependency.NextRequiresDependency<>nil);
end else if (CurNode.Parent=RemovedFilesNode) then begin
AddPopupMenuItem('Open file',@OpenFileMenuItemClick,true);
AddPopupMenuItem('Add file',@ReAddMenuItemClick,true);
@ -363,6 +372,26 @@ begin
UpdateApplyDependencyButton;
end;
procedure TPackageEditorForm.MoveDependencyUpClick(Sender: TObject);
var
CurDependency: TPkgDependency;
Removed: boolean;
begin
CurDependency:=GetCurrentDependency(Removed);
if (CurDependency=nil) or Removed then exit;
PackageGraph.MoveRequiredDependencyUp(CurDependency);
end;
procedure TPackageEditorForm.MoveDependencyDownClick(Sender: TObject);
var
CurDependency: TPkgDependency;
Removed: boolean;
begin
CurDependency:=GetCurrentDependency(Removed);
if (CurDependency=nil) or Removed then exit;
PackageGraph.MoveRequiredDependencyDown(CurDependency);
end;
procedure TPackageEditorForm.OpenFileMenuItemClick(Sender: TObject);
var
CurNode: TTreeNode;
@ -393,6 +422,9 @@ end;
procedure TPackageEditorForm.OptionsBitBtnClick(Sender: TObject);
begin
ShowPackageOptionsDlg(LazPackage);
UpdateButtons;
UpdateTitle;
UpdateStatusBar;
end;
procedure TPackageEditorForm.PackageEditorFormClose(Sender: TObject;
@ -705,7 +737,7 @@ begin
with CompilerOptsDlg do begin
GetCompilerOptions;
Caption:='Compiler Options for Package '+LazPackage.IDAsString;
ReadOnly:=true;
ReadOnly:=LazPackage.ReadOnly;
ShowModal;
Free;
end;

39
packager/packagesystem.pas
View File

@ -158,6 +158,8 @@ type
procedure ChangeDependency(Dependency, NewDependency: TPkgDependency);
function OpenDependency(Dependency: TPkgDependency;
var APackage: TLazPackage): TLoadPackageResult;
procedure MoveRequiredDependencyUp(ADependency: TPkgDependency);
procedure MoveRequiredDependencyDown(ADependency: TPkgDependency);
procedure IterateComponentClasses(APackage: TLazPackage;
Event: TIterateComponentClassesEvent;
WithUsedPackages, WithRequiredPackages: boolean);
@ -754,10 +756,12 @@ begin
Author:='FPC team';
AutoInstall:=pitStatic;
AutoUpdate:=false;
Description:='The FCL - FreePascal Component Library provides the base classes for object pascal.';
Description:='The FCL - FreePascal Component Library '
+'provides the base classes for object pascal.';
PackageType:=lptDesignTime;
Installed:=pitStatic;
CompilerOptions.UnitOutputDirectory:='';
UsageOptions.UnitPath:='';
// add files
AddFile('inc/process.pp','Process',pftUnit,[pffHasRegisterProc],cpBase);
@ -778,7 +782,8 @@ begin
Author:='Lazarus';
AutoInstall:=pitStatic;
AutoUpdate:=false;
Description:='The LCL - Lazarus Component Library contains all base components for form editing.';
Description:='The LCL - Lazarus Component Library '
+'contains all base components for form editing.';
PackageType:=lptDesignTime;
Installed:=pitStatic;
CompilerOptions.UnitOutputDirectory:='';
@ -1133,6 +1138,30 @@ begin
Result:=Dependency.LoadPackageResult;
end;
procedure TLazPackageGraph.MoveRequiredDependencyUp(
ADependency: TPkgDependency);
begin
if (ADependency=nil) or (ADependency.Removed) or (ADependency.Owner=nil)
or (ADependency.PrevRequiresDependency=nil)
or (not (ADependency.Owner is TLazPackage))
then exit;
BeginUpdate(true);
TLazPackage(ADependency.Owner).MoveRequiredDependencyUp(ADependency);
EndUpdate;
end;
procedure TLazPackageGraph.MoveRequiredDependencyDown(
ADependency: TPkgDependency);
begin
if (ADependency=nil) or (ADependency.Removed) or (ADependency.Owner=nil)
or (ADependency.NextRequiresDependency=nil)
or (not (ADependency.Owner is TLazPackage))
then exit;
BeginUpdate(true);
TLazPackage(ADependency.Owner).MoveRequiredDependencyDown(ADependency);
EndUpdate;
end;
procedure TLazPackageGraph.IterateComponentClasses(APackage: TLazPackage;
Event: TIterateComponentClassesEvent; WithUsedPackages,
WithRequiredPackages: boolean);
@ -1228,6 +1257,9 @@ var
RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited];
PkgStack[StackPtr]:=RequiredPackage;
inc(StackPtr);
// add package to list
if List=nil then List:=TList.Create;
List.Add(RequiredPackage);
end;
end;
CurDependency:=CurDependency.NextRequiresDependency;
@ -1247,9 +1279,6 @@ begin
// get required package from stack
dec(StackPtr);
Pkg:=PkgStack[StackPtr];
// add package to list
if List=nil then List:=TList.Create;
List.Add(Pkg);
// put all required packages on stack
PutPackagesFromDependencyListOnStack(Pkg.FirstRequiredDependency);
end;

3
packager/pkgmanager.pas
View File

@ -49,7 +49,7 @@ uses
LazarusIDEStrConsts, KeyMapping, EnvironmentOpts, IDEProcs, ProjectDefs,
InputHistory, IDEDefs, UComponentManMain, Project, ComponentReg,
PackageEditor, AddToPackageDlg, PackageDefs, PackageLinks, PackageSystem,
OpenInstalledPkgDlg, PkgGraphExplorer, BrokenDependenciesDlg,
OpenInstalledPkgDlg, PkgGraphExplorer, BrokenDependenciesDlg, CompilerOptions,
BasePkgManager, MainBar;
type
@ -284,6 +284,7 @@ end;
procedure TPkgManager.PkgManagerEndUpdate(Sender: TObject; GraphChanged: boolean);
begin
if GraphChanged then IncreaseCompilerGraphStamp;
if PackageGraphExplorer<>nil then begin
if GraphChanged then PackageGraphExplorer.UpdateAll;
PackageGraphExplorer.EndUpdate;

8
packager/pkgoptionsdlg.pas
View File

@ -164,11 +164,7 @@ begin
AnEdit:=GetEditForPathButton(AButton);
OldPath:=AnEdit.Text;
if AButton=UnitPathButton then begin
Templates:=
'$(LazarusDir)/lcl/units'
+';$(LazarusDir)/lcl/units/$(LCLWidgetType)'
+';$(LazarusDir)/components/units'
+';$(LazarusDir)/components/custom';
Templates:='$(PkgOutDir)';
end;
if AButton=IncludePathButton then begin
Templates:='include';
@ -386,6 +382,8 @@ begin
LinkerOptions:=LinkerOptionsMemo.Text;
CustomOptions:=CustomOptionsMemo.Text;
end;
ModalResult:=mrOk;
end;
procedure TPackageOptionsDialog.PackageOptionsDialogClose(Sender: TObject;