implemented compiler options for packages

git-svn-id: trunk@4048 -
This commit is contained in:
mattias 2003-04-12 08:44:24 +00:00
parent 1007c59db7
commit db8349a1c6
11 changed files with 464 additions and 115 deletions

1
.gitattributes vendored
View File

@ -828,6 +828,7 @@ packager/packagelinks.pas svneol=native#text/pascal
packager/packagesystem.pas svneol=native#text/pascal
packager/pkggraphexporer.pas svneol=native#text/pascal
packager/pkgmanager.pas svneol=native#text/pascal
packager/pkgoptionsdlg.pas svneol=native#text/pascal
packager/registerfcl.pas svneol=native#text/pascal
packager/registerlcl.pas svneol=native#text/pascal
packager/ucomponentmanmain.lfm svneol=native#text/plain

View File

@ -90,7 +90,9 @@ type
fRangeChecks: Boolean;
fOverflowChecks: Boolean;
fStackChecks: Boolean;
FEmulatedFloatOpcodes: boolean;
fHeapSize: LongInt;
fVerifyObjMethodCall: boolean;
fGenerate: Integer;
fTargetProc: Integer;
fVarsInReg: Boolean;
@ -134,30 +136,32 @@ type
fAdditionalConfigFile: Boolean;
fConfigFilePath: String;
fCustomOptions: string;
procedure LoadTheCompilerOptions(const Path: string);
procedure SaveTheCompilerOptions(const Path: string);
procedure SetModified(const AValue: boolean);
protected
procedure LoadTheCompilerOptions(const Path: string); virtual;
procedure SaveTheCompilerOptions(const Path: string); virtual;
procedure SetModified(const AValue: boolean); virtual;
public
constructor Create;
destructor Destroy; override;
procedure Clear; virtual;
procedure LoadFromXMLConfig(AXMLConfig: TXMLConfig; const Path: string);
procedure SaveToXMLConfig(AXMLConfig: TXMLConfig; const Path: string);
procedure LoadCompilerOptions(UseExistingFile: Boolean);
procedure SaveCompilerOptions(UseExistingFile: Boolean);
procedure Assign(CompOpts: TBaseCompilerOptions);
function IsEqual(CompOpts: TBaseCompilerOptions): boolean;
procedure Assign(CompOpts: TBaseCompilerOptions); virtual;
function IsEqual(CompOpts: TBaseCompilerOptions): boolean; virtual;
function MakeOptionsString: String;
function MakeOptionsString(const MainSourceFileName: string): String;
function MakeOptionsString(const MainSourceFileName: string): String; virtual;
function CustomOptionsAsString: string;
function ParseSearchPaths(const switch, paths: String): String;
function ParseOptions(const Delim, Switch, OptionStr: string): string;
function GetXMLConfigPath: String;
procedure Clear;
function CreateTargetFilename(const MainSourceFileName: string): string;
function GetXMLConfigPath: String; virtual;
function CreateTargetFilename(const MainSourceFileName: string): string; virtual;
public
{ Properties }
property Modified: boolean read FModified write SetModified;
property OnModified: TNotifyEvent read FOnModified write FOnModified;
@ -196,7 +200,9 @@ type
property RangeChecks: Boolean read fRangeChecks write fRangeChecks;
property OverflowChecks: Boolean read fOverflowChecks write fOverflowChecks;
property StackChecks: Boolean read fStackChecks write fStackChecks;
property EmulatedFloatOpcodes: boolean read FEmulatedFloatOpcodes write FEmulatedFloatOpcodes;
property HeapSize: Integer read fHeapSize write fHeapSize;
property VerifyObjMethodCall: boolean read FEmulatedFloatOpcodes write FEmulatedFloatOpcodes;
property Generate: Integer read fGenerate write fGenerate;
property TargetProcessor: Integer read fTargetProc write fTargetProc;
property VariablesInRegisters: Boolean read fVarsInReg write fVarsInReg;
@ -247,6 +253,7 @@ type
{ TAdditionalCompilerOptions
Additional Compiler options are used by packages to define, what a project
or a package or the IDE needs to use the package.
}
@ -284,6 +291,8 @@ type
{ TCompilerOptions }
TCompilerOptions = class(TBaseCompilerOptions)
public
procedure Clear; override;
end;
@ -422,9 +431,6 @@ type
btnCancel: TButton;
btnApply: TButton;
{ Other variables }
// fPath: String;
{ Procedures }
procedure chkAdditionalConfigFileClick(Sender: TObject);
procedure CreateForm(Sender: TObject);
@ -467,9 +473,9 @@ implementation
const
Config_Filename = 'compileroptions.xml';
{------------------------------------------------------------------------------}
{ TBaseCompilerOptions Constructor }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TBaseCompilerOptions Constructor
------------------------------------------------------------------------------}
constructor TBaseCompilerOptions.Create;
begin
inherited Create;
@ -478,9 +484,9 @@ begin
Clear;
end;
{------------------------------------------------------------------------------}
{ TBaseCompilerOptions Destructor }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TBaseCompilerOptions Destructor
------------------------------------------------------------------------------}
destructor TBaseCompilerOptions.Destroy;
begin
inherited Destroy;
@ -522,10 +528,16 @@ begin
else
begin
confPath := GetXMLConfigPath;
XMLConfigFile := TXMLConfig.Create(SetDirSeparators(confPath));
LoadTheCompilerOptions('');
XMLConfigFile.Free;
XMLConfigFile := nil;
try
XMLConfigFile := TXMLConfig.Create(SetDirSeparators(confPath));
LoadTheCompilerOptions('');
XMLConfigFile.Free;
XMLConfigFile := nil;
except
on E: Exception do begin
writeln('TBaseCompilerOptions.LoadCompilerOptions '+Classname+' '+E.Message);
end;
end;
end;
fLoaded := true;
end;
@ -551,7 +563,7 @@ begin
IncludeFiles := XMLConfigFile.GetValue(p+'IncludeFiles/Value', '');
Libraries := XMLConfigFile.GetValue(p+'Libraries/Value', '');
OtherUnitFiles := XMLConfigFile.GetValue(p+'OtherUnitFiles/Value', '');
CompilerPath := XMLConfigFile.GetValue(p+'CompilerPath/Value', '/opt/fpc/ppc386');
CompilerPath := XMLConfigFile.GetValue(p+'CompilerPath/Value', '$(CompPath)');
UnitOutputDirectory := XMLConfigFile.GetValue(p+'UnitOutputDirectory/Value', '');
LCLWidgetType := XMLConfigFile.GetValue(p+'LCLWidgetType/Value', 'gtk');
@ -578,7 +590,9 @@ begin
RangeChecks := XMLConfigFile.GetValue(p+'Checks/RangeChecks/Value', false);
OverflowChecks := XMLConfigFile.GetValue(p+'Checks/OverflowChecks/Value', false);
StackChecks := XMLConfigFile.GetValue(p+'Checks/StackChecks/Value', false);
EmulatedFloatOpcodes := XMLConfigFile.GetValue(p+'EmulateFloatingPointOpCodes/Value', false);
HeapSize := XMLConfigFile.GetValue(p+'HeapSize/Value', 8000000);
VerifyObjMethodCall := XMLConfigFile.GetValue(p+'VerifyObjMethodCallValidity/Value', false);
Generate := XMLConfigFile.GetValue(p+'Generate/Value', 1);
TargetProcessor := XMLConfigFile.GetValue(p+'TargetProcessor/Value', 1);
VariablesInRegisters := XMLConfigFile.GetValue(p+'Optimizations/VariablesInRegisters/Value', false);
@ -641,10 +655,16 @@ begin
else
begin
confPath := GetXMLConfigPath;
XMLConfigFile := TXMLConfig.Create(SetDirSeparators(confPath));
SaveTheCompilerOptions('');
XMLConfigFile.Free;
XMLConfigFile := nil;
try
XMLConfigFile := TXMLConfig.Create(SetDirSeparators(confPath));
SaveTheCompilerOptions('');
XMLConfigFile.Free;
XMLConfigFile := nil;
except
on E: Exception do begin
writeln('TBaseCompilerOptions.LoadCompilerOptions '+Classname+' '+E.Message);
end;
end;
end;
fModified:=false;
end;
@ -697,7 +717,9 @@ begin
XMLConfigFile.SetDeleteValue(p+'Checks/RangeChecks/Value', RangeChecks,false);
XMLConfigFile.SetDeleteValue(p+'Checks/OverflowChecks/Value', OverflowChecks,false);
XMLConfigFile.SetDeleteValue(p+'Checks/StackChecks/Value', StackChecks,false);
XMLConfigFile.SetDeleteValue(p+'EmulateFloatingPointOpCodes/Value', EmulatedFloatOpcodes,false);
XMLConfigFile.SetDeleteValue(p+'HeapSize/Value', HeapSize,8000000);
XMLConfigFile.SetDeleteValue(p+'VerifyObjMethodCallValidity/Value', VerifyObjMethodCall,false);
XMLConfigFile.SetDeleteValue(p+'Generate/Value', Generate,1);
XMLConfigFile.SetDeleteValue(p+'TargetProcessor/Value', TargetProcessor,1);
XMLConfigFile.SetDeleteValue(p+'Optimizations/VariablesInRegisters/Value', VariablesInRegisters,false);
@ -793,9 +815,9 @@ begin
{ Get all the options and create a string that can be passed to the compiler }
{ options of ppc386 1.0.5 :
put + after a boolean switch option to enable it, - to disable it
{ options of ppc386 1.1 :
put + after a boolean switch option to enable it, - to disable it
-a the compiler doesn't delete the generated assembler file
-al list sourcecode lines in assembler file
-ar list register allocation/release info in assembler file
@ -805,11 +827,13 @@ begin
-B build all modules
-C<x> code generation options:
-CD create also dynamic library (not supported)
-Ce Compilation with emulated floating point opcodes
-Ch<n> <n> bytes heap (between 1023 and 67107840)
-Ci IO-checking
-Cn omit linking stage
-Co check overflow of integer operations
-Cr range checking
-CR verify object method call validity
-Cs<n> set stack size to <n>
-Ct stack checking
-CX create also smartlinked library
@ -850,7 +874,7 @@ begin
-S<x> syntax options:
-S2 switch some Delphi 2 extensions on
-Sc supports operators like C (*=,+=,/= and -=)
-sa include assertion code.
-Sa include assertion code.
-Sd tries to be Delphi compatible
-Se<x> compiler stops after the <x> errors (default is 1)
-Sg allow LABEL and GOTO
@ -862,6 +886,8 @@ begin
-Ss constructor name must be init (destructor must be done)
-St allow static keyword in objects
-s don't call assembler and linker (only with -a)
-st Generate script to link on target
-sh Generate script to link on host
-u<x> undefines the symbol <x>
-U unit options:
-Un don't check the unit name
@ -878,6 +904,7 @@ begin
b : Show all procedure r : Rhide/GCC compatibility mode
declarations if an error x : Executable info (Win32 only)
occurs
-V write fpcdebug.txt file with lots of debugging info
-X executable options:
-Xc link with the c library
-Xs strip all symbols from executable
@ -885,10 +912,9 @@ begin
-XS try to link static (default) (defines FPC_LINK_STATIC)
-XX try to link smart (defines FPC_LINK_SMART)
Processor specific options:
Processor specific options:
-A<x> output format:
-Aas assemble using GNU AS
-Aasaout assemble using GNU AS for aout (Go32v1)
-Anasmcoff coff (Go32v2) file using Nasm
-Anasmelf elf32 (Linux) file using Nasm
-Anasmobj obj file using Nasm
@ -907,19 +933,19 @@ begin
-Ou enable uncertain optimizations (see docs)
-O1 level 1 optimizations (quick optimizations)
-O2 level 2 optimizations (-O1 + slower optimizations)
-O3 level 3 optimizations (same as -O2u)
-O3 level 3 optimizations (-O2 repeatedly, max 5 times)
-Op<x> target processor:
-Op1 set target processor to 386/486
-Op2 set target processor to Pentium/PentiumMMX (tm)
-Op3 set target processor to PPro/PII/c6x86/K6 (tm)
-T<x> Target operating system:
-TGO32V1 version 1 of DJ Delorie DOS extender
-TGO32V2 version 2 of DJ Delorie DOS extender
- 3*2TWDOSX DOS 32 Bit Extender
-TLINUX Linux
-Tnetware Novell Netware Module (experimental)
-TOS2 OS/2 2.x
-TSUNOS SunOS/Solaris
-TWin32 Windows 32 Bit
-TBeOS BeOS
-W<x> Win32 target options
-WB<x> Set Image base to Hexadecimal <x> value
-WC Specify console type application
@ -1015,14 +1041,18 @@ begin
{ Checks }
tempsw := '';
if (IOChecks) then
if IOChecks then
tempsw := tempsw + 'i';
if (RangeChecks) then
if RangeChecks then
tempsw := tempsw + 'r';
if (OverflowChecks) then
if OverflowChecks then
tempsw := tempsw + 'o';
if (StackChecks) then
if StackChecks then
tempsw := tempsw + 't';
if EmulatedFloatOpcodes then
tempsw := tempsw + 'e';
if VerifyObjMethodCall then
tempsw := tempsw + 'R';
if (tempsw <> '') then begin
switches := switches + ' -C' + tempsw;
@ -1072,7 +1102,8 @@ begin
GO32V2 = DOS and version 2 of the DJ DELORIE extender.
LINUX = LINUX.
OS2 = OS/2 (2.x) using the EMX extender.
WIN32 = Windows 32 bit. }
WIN32 = Windows 32 bit.
... }
{ Only linux and win32 are in the dialog at this moment}
if TargetOS<>'' then
switches := switches + ' -T' + TargetOS;
@ -1229,7 +1260,13 @@ begin
-dxxx = Define symbol name xxx (Used for conditional compiles)
-uxxx = Undefine symbol name xxx
-Ce Compilation with emulated floating point opcodes
-CR verify object method call validity
-s = Do not call assembler or linker. Write ppas.bat/ppas.sh script.
-st Generate script to link on target
-sh Generate script to link on host
-V write fpcdebug.txt file with lots of debugging info
-Xc = Link with C library (LINUX only)
@ -1357,7 +1394,7 @@ begin
fIncludeFiles := '';
fLibraries := '';
fOtherUnitFiles := '';
fCompilerPath := '/opt/fpc/ppc386';
fCompilerPath := '$(CompPath)';
fUnitOutputDir := '';
fLCLWidgetType := 'gtk';
@ -1462,7 +1499,9 @@ begin
fRangeChecks := CompOpts.fRangeChecks;
fOverflowChecks := CompOpts.fOverflowChecks;
fStackChecks := CompOpts.fStackChecks;
FEmulatedFloatOpcodes := CompOpts.fEmulatedFloatOpcodes;
fHeapSize := CompOpts.fHeapSize;
fVerifyObjMethodCall := CompOpts.fVerifyObjMethodCall;
fGenerate := CompOpts.fGenerate;
fTargetProc := CompOpts.fTargetProc;
fVarsInReg := CompOpts.fVarsInReg;
@ -1541,7 +1580,9 @@ begin
and (fRangeChecks = CompOpts.fRangeChecks)
and (fOverflowChecks = CompOpts.fOverflowChecks)
and (fStackChecks = CompOpts.fStackChecks)
and (FEmulatedFloatOpcodes = CompOpts.FEmulatedFloatOpcodes)
and (fHeapSize = CompOpts.fHeapSize)
and (fVerifyObjMethodCall = CompOpts.fVerifyObjMethodCall)
and (fGenerate = CompOpts.fGenerate)
and (fTargetProc = CompOpts.fTargetProc)
and (fVarsInReg = CompOpts.fVarsInReg)
@ -1598,7 +1639,7 @@ begin
Assert(False, 'Trace:Compiler Options Form Created');
SetBounds((Screen.Width-440) div 2,(Screen.Height-500) div 2,435,480);
Caption := dlgCompilerOptions ;
Caption := dlgCompilerOptions;
OnShow := @CreateForm;
nbMain := TNotebook.Create(Self);
@ -3484,5 +3525,12 @@ begin
XMLConfig.SetDeleteValue(Path+'UnitPath/Value',FUnitPath,'');
end;
{ TCompilerOptions }
procedure TCompilerOptions.Clear;
begin
inherited Clear;
end;
end.

View File

@ -158,6 +158,7 @@ function ShowDiffDialog(Files: TDiffFiles; Text1Index: integer;
var
DiffDlg: TDiffDialog;
begin
OpenDiffInEditor:=false;
DiffDlg:=TDiffDialog.Create(Application);
DiffDlg.BeginUpdate;
DiffDlg.OnGetDiffFile:=OnGetDiffFile;

View File

@ -33,24 +33,41 @@ uses
Classes, SysUtils, BuildLazDialog, LazConf, IDEProcs, Laz_XMLCfg;
type
TSortDirection = (sdAscending, sdDescending);
TSortDomain = (sdWords, sdLines, sdParagraphs);
TMiscellaneousOptions = class
private
fBuildLazOpts: TBuildLazarusOptions;
fFilename: string;
FSortSelDirection: TSortDirection;
FSortSelDomain: TSortDomain;
function GetFilename: string;
public
constructor Create;
destructor Destroy; override;
procedure Load;
procedure Save;
property BuildLazOpts: TBuildLazarusOptions
read fBuildLazOpts write fBuildLazOpts;
property Filename: string read GetFilename;
property BuildLazOpts: TBuildLazarusOptions
read fBuildLazOpts write fBuildLazOpts;
property SortSelDirection: TSortDirection read FSortSelDirection
write FSortSelDirection;
property SortSelDomain: TSortDomain read FSortSelDomain write FSortSelDomain;
end;
const
SortDirectionNames: array[TSortDirection] of string = (
'Ascending', 'Descending');
SortDomainNames: array[TSortDomain] of string = (
'Words', 'Lines', 'Paragraphs');
var MiscellaneousOptions: TMiscellaneousOptions;
function SortDirectionNameToType(const s: string): TSortDirection;
function SortDomainNameToType(const s: string): TSortDomain;
implementation
@ -59,6 +76,20 @@ const
MiscOptsFilename = 'miscellaneousoptions.xml';
MiscOptsVersion = 1;
function SortDirectionNameToType(const s: string): TSortDirection;
begin
for Result:=Low(TSortDirection) to High(TSortDirection) do
if AnsiCompareText(SortDirectionNames[Result],s)=0 then exit;
Result:=sdAscending;
end;
function SortDomainNameToType(const s: string): TSortDomain;
begin
for Result:=Low(TSortDomain) to High(TSortDomain) do
if AnsiCompareText(SortDomainNames[Result],s)=0 then exit;
Result:=sdLines;
end;
{ TMiscellaneousOptions }
constructor TMiscellaneousOptions.Create;
@ -91,6 +122,7 @@ end;
procedure TMiscellaneousOptions.Load;
var XMLConfig: TXMLConfig;
FileVersion: integer;
Path: String;
begin
try
XMLConfig:=TXMLConfig.Create(GetFilename);
@ -100,12 +132,17 @@ begin
end;
try
try
FileVersion:=XMLConfig.GetValue('MiscellaneousOptions/Version/Value',0);
Path:='MiscellaneousOptions/';
FileVersion:=XMLConfig.GetValue(Path+'Version/Value',0);
if (FileVersion<MiscOptsVersion) and (FileVersion<>0) then
writeln('NOTE: converting old miscellaneous options ...');
BuildLazOpts.Load(XMLConfig,'MiscellaneousOptions/BuildLazarusOptions/');
BuildLazOpts.Load(XMLConfig,Path+'BuildLazarusOptions/');
SortSelDirection:=SortDirectionNameToType(XMLConfig.GetValue(
Path+'SortSelection/Direction',SortDirectionNames[sdAscending]));
SortSelDomain:=SortDomainNameToType(XMLConfig.GetValue(
Path+'SortSelection/Domain',SortDomainNames[sdLines]));
finally
XMLConfig.Free;
end;
@ -116,6 +153,7 @@ end;
procedure TMiscellaneousOptions.Save;
var XMLConfig: TXMLConfig;
Path: String;
begin
try
XMLConfig:=TXMLConfig.Create(GetFilename);
@ -125,10 +163,16 @@ begin
end;
try
try
XMLConfig.SetValue('MiscellaneousOptions/Version/Value',MiscOptsVersion);
Path:='MiscellaneousOptions/';
XMLConfig.SetValue(Path+'Version/Value',MiscOptsVersion);
BuildLazOpts.Save(XMLConfig,Path+'BuildLazarusOptions/');
XMLConfig.SetDeleteValue(Path+'SortSelection/Direction',
SortDirectionNames[SortSelDirection],
SortDirectionNames[sdAscending]);
XMLConfig.SetDeleteValue(Path+'SortSelection/Domain',
SortDomainNames[SortSelDomain],SortDomainNames[sdLines]);
BuildLazOpts.Save(XMLConfig,'MiscellaneousOptions/BuildLazarusOptions/');
XMLConfig.Flush;
finally
XMLConfig.Free;

View File

@ -41,12 +41,9 @@ interface
uses
Classes, SysUtils, Forms, Controls, SynEdit, Buttons, StdCtrls, ExtCtrls,
IDEOptionDefs, Dialogs, BasicCodeTools, AVL_Tree, EditorOptions,
SynEditHighlighter;
MiscOptions, SynEditHighlighter;
type
TSortDirection = (sdAscending, sdDescending);
TSortDomain = (sdWords, sdLines, sdParagraphs);
TSortSelDlgState = (ssdPreviewNeedsUpdate, ssdSortedTextNeedsUpdate);
TSortSelDlgStates = set of TSortSelDlgState;
@ -64,6 +61,8 @@ type
procedure DirectionRadioGroupClick(Sender: TObject);
procedure DomainRadioGroupClick(Sender: TObject);
procedure IgnoreSpaceCheckBoxClick(Sender: TObject);
procedure SortSelectionDialogClose(Sender: TObject; var Action: TCloseAction
);
procedure SortSelectionDialogResize(Sender: TObject);
private
FCaseSensitive: boolean;
@ -373,6 +372,13 @@ begin
IgnoreSpace:=IgnoreSpaceCheckBox.Checked;
end;
procedure TSortSelectionDialog.SortSelectionDialogClose(Sender: TObject;
var Action: TCloseAction);
begin
MiscellaneousOptions.SortSelDirection:=Direction;
MiscellaneousOptions.SortSelDomain:=Domain;
end;
procedure TSortSelectionDialog.SetDirection(const AValue: TSortDirection);
begin
if FDirection=AValue then exit;
@ -466,7 +472,10 @@ begin
Add('Ascending');
Add('Descending');
Columns:=2;
ItemIndex:=0;
case MiscellaneousOptions.SortSelDirection of
sdAscending: ItemIndex:=0;
else ItemIndex:=1;
end;
EndUpdate;
end;
OnClick:=@DirectionRadioGroupClick;
@ -486,7 +495,11 @@ begin
Add('Lines');
Add('Words');
Add('Paragraphs');
ItemIndex:=0;
case MiscellaneousOptions.SortSelDomain of
sdLines: ItemIndex:=0;
sdWords: ItemIndex:=1;
else ItemIndex:=2;
end;
Columns:=3;
EndUpdate;
end;
@ -549,6 +562,7 @@ begin
end;
OnResize:=@SortSelectionDialogResize;
OnClose:=@SortSelectionDialogClose;
end;
procedure TSortSelectionDialog.BeginUpdate;

View File

@ -122,8 +122,7 @@ begin
if LI<>nil then begin
CurPkg:=TLazPackage(LI.Data);
HintStr:=
'Filename: '+CurPkg.Filename+EndOfLine
+'Title: '+CurPkg.Title;
'Filename: '+CurPkg.Filename;
if CurPkg.AutoCreated then
HintStr:=HintStr+EndOfLine+'This package was automatically created';
HintStr:=HintStr+EndOfLine+'Description: '

View File

@ -239,6 +239,15 @@ type
{ TPkgCompilerOptions }
TPkgCompilerOptions = class(TBaseCompilerOptions)
private
FLazPackage: TLazPackage;
protected
procedure SetLazPackage(const AValue: TLazPackage);
procedure SetModified(const NewValue: boolean); override;
public
procedure Clear; override;
public
property LazPackage: TLazPackage read FLazPackage write SetLazPackage;
end;
@ -321,7 +330,6 @@ type
FReadOnly: boolean;
FRemovedFiles: TList; // TList of TPkgFile
FRegistered: boolean;
FTitle: string;
FUsageOptions: TAdditionalCompilerOptions;
function GetAutoIncrementVersionOnBuild: boolean;
function GetAutoUpdate: boolean;
@ -349,7 +357,6 @@ type
procedure SetPackageEditor(const AValue: TBasePackageEditor);
procedure SetPackageType(const AValue: TLazPackageType);
procedure SetReadOnly(const AValue: boolean);
procedure SetTitle(const AValue: string);
public
constructor Create;
destructor Destroy; override;
@ -425,7 +432,6 @@ type
property ReadOnly: boolean read FReadOnly write SetReadOnly;
property RemovedFilesCount: integer read GetRemovedCount;
property RemovedFiles[Index: integer]: TPkgFile read GetRemovedFiles;
property Title: string read FTitle write SetTitle;
property UsageOptions: TAdditionalCompilerOptions
read FUsageOptions;
end;
@ -1321,13 +1327,6 @@ begin
FReadOnly:=AValue;
end;
procedure TLazPackage.SetTitle(const AValue: string);
begin
if FTitle=AValue then exit;
FTitle:=AValue;
Modified:=true;
end;
constructor TLazPackage.Create;
begin
inherited Create;
@ -1335,6 +1334,7 @@ begin
FFiles:=TList.Create;
FRemovedFiles:=TList.Create;
FCompilerOptions:=TPkgCompilerOptions.Create;
FCompilerOptions.LazPackage:=Self;
FUsageOptions:=TAdditionalCompilerOptions.Create;
FInstalled:=pitNope;
FAutoInstall:=pitNope;
@ -1381,7 +1381,6 @@ begin
FName:='';
FPackageType:=lptRunTime;
FRegistered:=false;
FTitle:='';
FUsageOptions.Clear;
end;
@ -1474,7 +1473,6 @@ begin
LazPackageTypeIdents[lptRunTime]));
LoadPkgDependencyList(Path+'RequiredPkgs/',
FFirstRequiredDependency,pdlRequires);
FTitle:=XMLConfig.GetValue(Path+'Title/Value','');
FUsageOptions.LoadFromXMLConfig(XMLConfig,Path+'UsageOptions/');
UnlockModified;
end;
@ -1531,7 +1529,6 @@ begin
LazPackageTypeIdents[lptRunTime]);
SavePkgDependencyList(Path+'RequiredPkgs/',
FFirstRequiredDependency,pdlRequires);
XMLConfig.SetDeleteValue(Path+'Title/Value',FTitle,'');
FUsageOptions.SaveToXMLConfig(XMLConfig,Path+'UsageOptions/');
Modified:=false;
end;
@ -1947,6 +1944,25 @@ begin
Result:=Version.Compare(PackageID2.Version);
end;
{ TPkgCompilerOptions }
procedure TPkgCompilerOptions.SetLazPackage(const AValue: TLazPackage);
begin
if FLazPackage=AValue then exit;
FLazPackage:=AValue;
end;
procedure TPkgCompilerOptions.SetModified(const NewValue: boolean);
begin
inherited SetModified(NewValue);
if Modified and (LazPackage<>nil) then LazPackage.Modified:=true;
end;
procedure TPkgCompilerOptions.Clear;
begin
inherited Clear;
end;
initialization
PackageDependencies:=TAVLTree.Create(@ComparePkgDependencyNames);

View File

@ -40,8 +40,8 @@ interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls, ComCtrls, Buttons,
LResources, Graphics, LCLType, Menus, Dialogs, IDEProcs, LazarusIDEStrConsts,
IDEOptionDefs, IDEDefs, ComponentReg, PackageDefs, AddToPackageDlg,
PackageSystem;
IDEOptionDefs, IDEDefs, CompilerOptions, ComponentReg, PackageDefs,
PkgOptionsDlg, AddToPackageDlg, PackageSystem;
type
TOnOpenFile =
@ -66,6 +66,7 @@ type
RemoveBitBtn: TBitBtn;
InstallBitBtn: TBitBtn;
OptionsBitBtn: TBitBtn;
CompilerOptionsBitBtn: TBitBtn;
// items
FilesTreeView: TTreeView;
// properties
@ -88,13 +89,17 @@ type
procedure AddBitBtnClick(Sender: TObject);
procedure ApplyDependencyButtonClick(Sender: TObject);
procedure CallRegisterProcCheckBoxClick(Sender: TObject);
procedure CompileBitBtnClick(Sender: TObject);
procedure CompilerOptionsBitBtnClick(Sender: TObject);
procedure FilePropsGroupBoxResize(Sender: TObject);
procedure FilesPopupMenuPopup(Sender: TObject);
procedure FilesTreeViewDblClick(Sender: TObject);
procedure FilesTreeViewSelectionChanged(Sender: TObject);
procedure InstallBitBtnClick(Sender: TObject);
procedure MaxVersionEditChange(Sender: TObject);
procedure MinVersionEditChange(Sender: TObject);
procedure OpenFileMenuItemClick(Sender: TObject);
procedure OptionsBitBtnClick(Sender: TObject);
procedure PackageEditorFormClose(Sender: TObject; var Action: TCloseAction);
procedure PackageEditorFormCloseQuery(Sender: TObject; var CanClose: boolean
);
@ -207,25 +212,28 @@ var
begin
x:=0;
y:=0;
w:=75;
w:=ClientWidth div 7;
h:=25;
SaveBitBtn.SetBounds(x,y,w,h);
inc(x,w+2);
SaveBitBtn.SetBounds(x,y,w-2,h);
inc(x,w);
CompileBitBtn.SetBounds(x,y,w,h);
inc(x,w+2);
CompileBitBtn.SetBounds(x,y,w-2,h);
inc(x,w);
AddBitBtn.SetBounds(x,y,w,h);
inc(x,w+2);
AddBitBtn.SetBounds(x,y,w-2,h);
inc(x,w);
RemoveBitBtn.SetBounds(x,y,w,h);
inc(x,w+2);
RemoveBitBtn.SetBounds(x,y,w-2,h);
inc(x,w);
InstallBitBtn.SetBounds(x,y,w,h);
inc(x,w+2);
InstallBitBtn.SetBounds(x,y,w-2,h);
inc(x,w);
OptionsBitBtn.SetBounds(x,y,w,h);
OptionsBitBtn.SetBounds(x,y,w-2,h);
inc(x,w);
CompilerOptionsBitBtn.SetBounds(x,y,ClientWidth-x,h);
x:=0;
inc(y,h+3);
w:=ClientWidth;
@ -271,7 +279,8 @@ var
CurNode: TTreeNode;
ItemCnt: Integer;
procedure AddPopupMenuItem(const ACaption: string; AnEvent: TNotifyEvent);
procedure AddPopupMenuItem(const ACaption: string; AnEvent: TNotifyEvent;
EnabledFlag: boolean);
var
CurMenuItem: TMenuItem;
begin
@ -282,31 +291,43 @@ var
CurMenuItem:=FilesPopupMenu.Items[ItemCnt];
CurMenuItem.Caption:=ACaption;
CurMenuItem.OnClick:=AnEvent;
CurMenuItem.Enabled:=EnabledFlag;
inc(ItemCnt);
end;
begin
CurNode:=FilesTreeView.Selected;
ItemCnt:=0;
if CurNode<>nil then begin
if CurNode.Parent<>nil then begin
if CurNode.Parent=FilesNode then begin
AddPopupMenuItem('Open file',@OpenFileMenuItemClick);
AddPopupMenuItem('Remove file from package',@RemoveBitBtnClick);
AddPopupMenuItem('Open file',@OpenFileMenuItemClick,true);
AddPopupMenuItem('Remove file',@RemoveBitBtnClick,true);
end else if (CurNode.Parent=RequiredPackagesNode) then begin
AddPopupMenuItem('Open package',@OpenFileMenuItemClick);
AddPopupMenuItem('Remove dependency from package',@RemoveBitBtnClick);
AddPopupMenuItem('Open package',@OpenFileMenuItemClick,true);
AddPopupMenuItem('Remove dependency',@RemoveBitBtnClick,true);
end else if (CurNode.Parent=RemovedFilesNode) then begin
AddPopupMenuItem('Open file',@OpenFileMenuItemClick);
AddPopupMenuItem('Add file to package',@ReAddMenuItemClick);
AddPopupMenuItem('Open file',@OpenFileMenuItemClick,true);
AddPopupMenuItem('Add file',@ReAddMenuItemClick,true);
end else if (CurNode.Parent=RemovedRequiredNode) then begin
AddPopupMenuItem('Open package',@OpenFileMenuItemClick);
AddPopupMenuItem('Add dependency to package',@ReAddMenuItemClick);
AddPopupMenuItem('Open package',@OpenFileMenuItemClick,true);
AddPopupMenuItem('Add dependency',@ReAddMenuItemClick,true);
end;
end;
end else begin
end;
if ItemCnt>0 then
AddPopupMenuItem('-',nil,true);
AddPopupMenuItem('Save',@SaveBitBtnClick,SaveBitBtn.Enabled);
AddPopupMenuItem('Compile',@CompileBitBtnClick,CompileBitBtn.Enabled);
AddPopupMenuItem('Add',@AddBitBtnClick,AddBitBtn.Enabled);
AddPopupMenuItem('Remove',@RemoveBitBtnClick,RemoveBitBtn.Enabled);
AddPopupMenuItem('Install',@InstallBitBtnClick,InstallBitBtn.Enabled);
AddPopupMenuItem('General Options',@OptionsBitBtnClick,OptionsBitBtn.Enabled);
AddPopupMenuItem('Compiler Options',@CompilerOptionsBitBtnClick,CompilerOptionsBitBtn.Enabled);
while FilesPopupMenu.Items.Count>ItemCnt do
FilesPopupMenu.Items.Delete(FilesPopupMenu.Items.Count-1);
end;
@ -322,6 +343,11 @@ begin
UpdateButtons;
end;
procedure TPackageEditorForm.InstallBitBtnClick(Sender: TObject);
begin
end;
procedure TPackageEditorForm.MaxVersionEditChange(Sender: TObject);
begin
UpdateApplyDependencyButton;
@ -359,6 +385,11 @@ begin
end;
end;
procedure TPackageEditorForm.OptionsBitBtnClick(Sender: TObject);
begin
end;
procedure TPackageEditorForm.PackageEditorFormClose(Sender: TObject;
var Action: TCloseAction);
begin
@ -649,6 +680,27 @@ begin
end;
end;
procedure TPackageEditorForm.CompileBitBtnClick(Sender: TObject);
begin
end;
procedure TPackageEditorForm.CompilerOptionsBitBtnClick(Sender: TObject);
var
CompilerOptsDlg: TfrmCompilerOptions;
begin
CompilerOptsDlg:=TfrmCompilerOptions.Create(Self);
CompilerOptsDlg.CompilerOpts:=LazPackage.CompilerOptions;
with CompilerOptsDlg do begin
GetCompilerOptions;
Caption:='Compiler Options for Package '+LazPackage.IDAsString;
ShowModal;
Free;
end;
UpdateButtons;
UpdateStatusBar;
end;
procedure TPackageEditorForm.SetLazPackage(const AValue: TLazPackage);
var
ARect: TRect;
@ -720,6 +772,8 @@ begin
Parent:=Self;
Caption:='Save';
OnClick:=@SaveBitBtnClick;
Hint:='Save package';
ShowHint:=true;
end;
CompileBitBtn:=TBitBtn.Create(Self);
@ -727,6 +781,9 @@ begin
Name:='CompileBitBtn';
Parent:=Self;
Caption:='Compile';
OnClick:=@CompileBitBtnClick;
Hint:='Compile package';
ShowHint:=true;
end;
AddBitBtn:=TBitBtn.Create(Self);
@ -735,6 +792,8 @@ begin
Parent:=Self;
Caption:='Add';
OnClick:=@AddBitBtnClick;
Hint:='Add an item';
ShowHint:=true;
end;
RemoveBitBtn:=TBitBtn.Create(Self);
@ -743,6 +802,8 @@ begin
Parent:=Self;
Caption:='Remove';
OnClick:=@RemoveBitBtnClick;
Hint:='Remove selected item';
ShowHint:=true;
end;
InstallBitBtn:=TBitBtn.Create(Self);
@ -750,6 +811,9 @@ begin
Name:='InstallBitBtn';
Parent:=Self;
Caption:='Install';
OnClick:=@InstallBitBtnClick;
Hint:='Install package in the IDE';
ShowHint:=true;
end;
OptionsBitBtn:=TBitBtn.Create(Self);
@ -757,6 +821,19 @@ begin
Name:='OptionsBitBtn';
Parent:=Self;
Caption:='Options';
OnClick:=@OptionsBitBtnClick;
Hint:='Edit General Options';
ShowHint:=true;
end;
CompilerOptionsBitBtn:=TBitBtn.Create(Self);
with CompilerOptionsBitBtn do begin
Name:='CompilerOptionsBitBtn';
Parent:=Self;
Caption:='Compiler Options';
OnClick:=@CompilerOptionsBitBtnClick;
Hint:='Edit Options to compile package';
ShowHint:=true;
end;
FilesPopupMenu:=TPopupMenu.Create(Self);
@ -798,6 +875,8 @@ begin
Caption:='Register unit';
UseOnChange:=true;
OnClick:=@CallRegisterProcCheckBoxClick;
Hint:='Call "Register" procedure of selected unit';
ShowHint:=true;
end;
RegisteredPluginsGroupBox:=TGroupBox.Create(Self);
@ -903,6 +982,7 @@ begin
or (FilesTreeView.Selected.Parent=RequiredPackagesNode));
InstallBitBtn.Enabled:=true;
OptionsBitBtn.Enabled:=true;
CompilerOptionsBitBtn.Enabled:=true;
end;
procedure TPackageEditorForm.UpdateFiles;

View File

@ -73,15 +73,18 @@ type
FAbortRegistration: boolean;
FErrorMsg: string;
FFCLPackage: TLazPackage;
FItems: TList; // unsorted list of TLazPackage
FLCLPackage: TLazPackage;
FOnAddPackage: TPkgAddedEvent;
FOnBeginUpdate: TNotifyEvent;
FOnChangePackageName: TPkgChangeNameEvent;
FOnDeletePackage: TPkgDeleteEvent;
FOnEndUpdate: TNotifyEvent;
FRegistrationFile: TPkgFile;
FRegistrationPackage: TLazPackage;
FRegistrationUnitName: string;
FTree: TAVLTree; // sorted tree of TLazPackage
FItems: TList; // unsorted list of TLazPackage
FUpdateLock: integer;
function GetPackages(Index: integer): TLazPackage;
procedure SetAbortRegistration(const AValue: boolean);
procedure SetRegistrationPackage(const AValue: TLazPackage);
@ -94,6 +97,9 @@ type
procedure Clear;
procedure Delete(Index: integer);
function Count: integer;
procedure BeginUpdate;
procedure EndUpdate;
function Updating: boolean;
function FindLowestPkgNodeByName(const PkgName: string): TAVLTreeNode;
function FindNextSameName(ANode: TAVLTreeNode): TAVLTreeNode;
function FindNodeOfDependency(Dependency: TPkgDependency;
@ -142,20 +148,22 @@ type
procedure IteratePackagesSorted(Flags: TFindPackageFlags;
Event: TIteratePackagesEvent);
public
property AbortRegistration: boolean read FAbortRegistration
write SetAbortRegistration;
property ErrorMsg: string read FErrorMsg write FErrorMsg;
property FCLPackage: TLazPackage read FFCLPackage;
property LCLPackage: TLazPackage read FLCLPackage;
property OnAddPackage: TPkgAddedEvent read FOnAddPackage write FOnAddPackage;
property OnBeginUpdate: TNotifyEvent read FOnBeginUpdate write FOnBeginUpdate;
property OnChangePackageName: TPkgChangeNameEvent read FOnChangePackageName
write FOnChangePackageName;
property OnDeletePackage: TPkgDeleteEvent read FOnDeletePackage write FOnDeletePackage;
property OnEndUpdate: TNotifyEvent read FOnEndUpdate write FOnEndUpdate;
property Packages[Index: integer]: TLazPackage read GetPackages; default;
property RegistrationFile: TPkgFile read FRegistrationFile;
property RegistrationPackage: TLazPackage read FRegistrationPackage
write SetRegistrationPackage;
property RegistrationUnitName: string read FRegistrationUnitName;
property RegistrationFile: TPkgFile read FRegistrationFile;
property ErrorMsg: string read FErrorMsg write FErrorMsg;
property AbortRegistration: boolean read FAbortRegistration
write SetAbortRegistration;
property FCLPackage: TLazPackage read FFCLPackage;
property LCLPackage: TLazPackage read FLCLPackage;
property OnChangePackageName: TPkgChangeNameEvent read FOnChangePackageName
write FOnChangePackageName;
property OnAddPackage: TPkgAddedEvent read FOnAddPackage write FOnAddPackage;
property OnDeletePackage: TPkgDeleteEvent read FOnDeletePackage write FOnDeletePackage;
end;
var
@ -248,6 +256,28 @@ begin
Result:=FItems.Count;
end;
procedure TLazPackageGraph.BeginUpdate;
begin
inc(FUpdateLock);
if FUpdateLock=1 then begin
if Assigned(OnBeginUpdate) then OnBeginUpdate(Self);
end;
end;
procedure TLazPackageGraph.EndUpdate;
begin
if FUpdateLock<=0 then RaiseException('TLazPackageGraph.EndUpdate');
dec(FUpdateLock);
if FUpdateLock=0 then begin
if Assigned(OnEndUpdate) then OnEndUpdate(Self);
end;
end;
function TLazPackageGraph.Updating: boolean;
begin
Result:=FUpdateLock>0;
end;
function TLazPackageGraph.FindLowestPkgNodeByName(const PkgName: string
): TAVLTreeNode;
var
@ -632,13 +662,12 @@ begin
with Result do begin
AutoCreated:=true;
Name:='FCL';
Title:='FreePascal Component Library';
Filename:='$(FPCSrcDir)/fcl/';
Version.SetValues(1,0,1,1);
Author:='FPC team';
AutoInstall:=pitStatic;
AutoUpdate:=false;
Description:='The FCL provides the base classes for object pascal.';
Description:='The FCL - FreePascal Component Library provides the base classes for object pascal.';
PackageType:=lptDesignTime;
Installed:=pitStatic;
@ -656,13 +685,12 @@ begin
with Result do begin
AutoCreated:=true;
Name:='LCL';
Title:='Lazarus Component Library';
Filename:='$(LazarusDir)/lcl/';
Version.SetValues(1,0,1,1);
Author:='Lazarus';
AutoInstall:=pitStatic;
AutoUpdate:=false;
Description:='The LCL contains all base components for form editing.';
Description:='The LCL - Lazarus Component Library contains all base components for form editing.';
PackageType:=lptDesignTime;
Installed:=pitStatic;
@ -693,6 +721,7 @@ var
Dependency: TPkgDependency;
DepNode: TAVLTreeNode;
begin
BeginUpdate;
FTree.Add(APackage);
FItems.Add(APackage);
APackage.OnChangeName:=@PackageChangedName;
@ -717,6 +746,7 @@ begin
end;
if Assigned(OnAddPackage) then OnAddPackage(APackage);
EndUpdate;
end;
procedure TLazPackageGraph.AddStaticBasePackages;
@ -792,9 +822,11 @@ procedure TLazPackageGraph.CloseUnneededPackages;
var
i: Integer;
begin
BeginUpdate;
MarkNeededPackages;
for i:=FItems.Count-1 downto 0 do
if not (lpfNeeded in Packages[i].Flags) then Delete(i);
EndUpdate;
end;
function TLazPackageGraph.CheckIfPackageCanBeClosed(APackage: TLazPackage

View File

@ -51,6 +51,8 @@ type
PkgListLabel: TLabel;
PkgListBox: TListBox;
InfoMemo: TMemo;
procedure PackageGraphBeginUpdate(Sender: TObject);
procedure PkgGraphExplorerEndUpdate(Sender: TObject);
procedure PkgGraphExplorerResize(Sender: TObject);
procedure PkgGraphExplorerShow(Sender: TObject);
procedure PkgListBoxClick(Sender: TObject);
@ -61,6 +63,8 @@ type
private
FOnOpenPackage: TOnOpenPackage;
fSortedPackages: TAVLTree;
FChangedDuringLock: boolean;
FUpdateLock: integer;
procedure SetupComponents;
function GetPackageImageIndex(Pkg: TLazPackage): integer;
procedure GetDependency(ANode: TTreeNode; var Pkg: TLazPackage;
@ -71,6 +75,9 @@ type
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure BeginUpdate;
procedure EndUpdate;
function IsUpdating: boolean;
procedure UpdateAll;
procedure UpdateTree;
procedure UpdateList;
@ -132,6 +139,16 @@ begin
SetBounds(x,y,Parent.ClientWidth-2*x,Max(10,Parent.ClientHeight-y-x));
end;
procedure TPkgGraphExplorer.PackageGraphBeginUpdate(Sender: TObject);
begin
BeginUpdate;
end;
procedure TPkgGraphExplorer.PkgGraphExplorerEndUpdate(Sender: TObject);
begin
EndUpdate;
end;
procedure TPkgGraphExplorer.PkgGraphExplorerShow(Sender: TObject);
begin
UpdateAll;
@ -384,6 +401,9 @@ begin
OnResize:=@PkgGraphExplorerResize;
OnResize(Self);
OnShow:=@PkgGraphExplorerShow;
PackageGraph.OnBeginUpdate:=@PackageGraphBeginUpdate;
PackageGraph.OnEndUpdate:=@PkgGraphExplorerEndUpdate;
end;
destructor TPkgGraphExplorer.Destroy;
@ -392,8 +412,30 @@ begin
inherited Destroy;
end;
procedure TPkgGraphExplorer.BeginUpdate;
begin
inc(FUpdateLock);
end;
procedure TPkgGraphExplorer.EndUpdate;
begin
if FUpdateLock<=0 then RaiseException('TPkgGraphExplorer.EndUpdate');
dec(FUpdateLock);
if FChangedDuringLock then UpdateAll;
end;
function TPkgGraphExplorer.IsUpdating: boolean;
begin
Result:=FUpdateLock>0;
end;
procedure TPkgGraphExplorer.UpdateAll;
begin
if IsUpdating then begin
FChangedDuringLock:=true;
exit;
end;
FChangedDuringLock:=false;
UpdateTree;
UpdateList;
UpdateInfo;
@ -498,9 +540,7 @@ begin
InfoStr:='Package '+Dependency.AsString+' not found';
end else if Pkg<>nil then begin
// filename and title
InfoStr:=
'Filename: '+Pkg.Filename+EndOfLine
+'Title: '+Pkg.Title;
InfoStr:='Filename: '+Pkg.Filename;
// state
InfoStr:=InfoStr+EndOfLine+'State: ';
if Pkg.AutoCreated then

View File

@ -0,0 +1,74 @@
{ $Id$ }
{
/***************************************************************************
pkgoptionsdlg.pas
-----------------
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
TPackageOptionsDialog is the form for the options of a package.
}
unit PkgOptionsDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Buttons, LResources, ExtCtrls, StdCtrls,
IDEProcs, PackageDefs, PackageSystem;
type
TPackageOptionsDialog = class(TForm)
Notebook: TNotebook;
// general page
GeneralPage: TPage;
DescriptionGroupBox: TGroupBox;
DescriptionMemo: TMemo;
UsageRadioGroup: TRadioGroup;
BuildRadioGroup: TRadioGroup;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
{ TPackageOptionsDialog }
constructor TPackageOptionsDialog.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
end;
destructor TPackageOptionsDialog.Destroy;
begin
inherited Destroy;
end;
end.