added package gtkopengl

git-svn-id: trunk@4109 -
This commit is contained in:
mattias 2003-04-29 19:00:43 +00:00
parent 9acb463376
commit 01696fe7b6
21 changed files with 297 additions and 302 deletions

View File

@ -527,8 +527,7 @@ begin
then begin
exit;
end;
ClearFile(AFilename,true);
XMLConfig:=TXMLConfig.Create(AFilename);
XMLConfig:=TXMLConfig.CreateClean(AFilename);
try
Result:=SaveIncludeLinksToXML(XMLConfig,'');
fLastIncludeLinkFile:=AFilename;

View File

@ -189,7 +189,12 @@ ResourceString
ctsCustomComponentsDirectory = 'Custom Components Directory';
ctsToolsDirectory = 'Tools Directory';
ctsDesignerDirectory = 'Designer Directory';
ctsJITFormDirectory = 'JITForm Directory';
ctsDesignerUnitsDirectory = 'Designer Units';
ctsCompiledSrcPath = 'Compiled SrcPath';
ctsPackagerDirectory = 'Packager Directory';
ctsPackagerRegistrationDirectory = 'Packager Registration Directory';
ctsPackagerUnitsDirectory = 'Packager Units Directory';
ctsLazarusMainDirectory = 'lazarus main directory';
ctsDebuggerDirectory = 'Debugger Directory';
ctsLazarusSources = 'Lazarus Sources';

View File

@ -3059,6 +3059,24 @@ begin
ExternalMacroStart+'IncPath',
'..'+ds+'include;..'+ds+'include'+ds+TargetOS,
da_Define));
// designer/jitform
SubDirTempl:=TDefineTemplate.Create('JITForm',ctsJITFormDirectory,
'','jitform',da_Directory);
SubDirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
Format(ctsAddsDirToSourcePath,['lcl']),
ExternalMacroStart+'SrcPath',
'..'+ds+'..'+ds+'lcl'
+';..'+ds+'..'+ds+'lcl'+ds+'interfaces'+ds+WidgetType
+';'+SrcPath
,da_Define));
DirTempl.AddChild(SubDirTempl);
// designer/units
SubDirTempl:=TDefineTemplate.Create('Designer Units',
ctsDesignerUnitsDirectory,'','units',da_Directory);
SubDirTempl.AddChild(TDefineTemplate.Create('CompiledSrcPath',
ctsCompiledSrcPath,CompiledSrcPathMacroName,'..'+ds+'jitform'+ds,
da_Define));
DirTempl.AddChild(SubDirTempl);
MainDir.AddChild(DirTempl);
// images
@ -3104,6 +3122,17 @@ begin
ExternalMacroStart+'IncPath',
'..'+ds+'include;..'+ds+'include'+ds+TargetOS,
da_Define));
// packager/registration
SubDirTempl:=TDefineTemplate.Create('Registration',
ctsPackagerRegistrationDirectory,'','registration',da_Directory);
DirTempl.AddChild(SubDirTempl);
// packager/units
SubDirTempl:=TDefineTemplate.Create('Packager Units',
ctsPackagerUnitsDirectory,'','units',da_Directory);
SubDirTempl.AddChild(TDefineTemplate.Create('CompiledSrcPath',
ctsCompiledSrcPath,CompiledSrcPathMacroName,'..'+ds+'registration'+ds,
da_Define));
DirTempl.AddChild(SubDirTempl);
MainDir.AddChild(DirTempl);
// examples

View File

@ -52,10 +52,12 @@ type
protected
doc: TXMLDocument;
FModified: Boolean;
fDoNotLoad: boolean;
procedure Loaded; override;
function FindNode(const APath: String; PathHasValue: boolean): TDomNode;
public
constructor Create(const AFilename: String); overload;
constructor CreateClean(const AFilename: String);
destructor Destroy; override;
procedure Clear;
procedure Flush; // Writes the XML file
@ -90,6 +92,13 @@ begin
SetFilename(AFilename);
end;
constructor TXMLConfig.CreateClean(const AFilename: String);
begin
inherited Create(nil);
fDoNotLoad:=true;
SetFilename(AFilename);
end;
destructor TXMLConfig.Destroy;
begin
if Assigned(doc) then
@ -329,7 +338,7 @@ begin
end;
doc:=nil;
if FileExists(AFilename) then
if FileExists(AFilename) and (not fDoNotLoad) then
ReadXMLFile(doc,AFilename);
if not Assigned(doc) then
@ -347,6 +356,9 @@ end;
end.
{
$Log$
Revision 1.9 2003/04/29 19:00:43 mattias
added package gtkopengl
Revision 1.8 2002/12/28 11:29:47 mattias
xmlcfg deletion, focus fixes

View File

@ -4,7 +4,7 @@
#
[package]
name=lazarus-gtkglarea
name=gtkopengl
version=0.8a
[compiler]

View File

@ -10,27 +10,30 @@
* *
*****************************************************************************
Author: Mattias Gaertner
Author: Mattias Gaertner
}
unit gtkglarea;
unit GTKGLArea;
{$MODE objfpc}{$H+}
interface
uses
Classes, SysUtils, VCLGlobals, LCLLinux, LCLType, glib, gdk, gtk,
gtkglarea_int, gl, Controls, gtkint, gtkwinapiwindow, LMessages;
Classes, SysUtils, Controls, Graphics, LMessages, VCLGlobals, GTKGLArea_Int,
InterfaceBase, GTKInt, LResources, NVGLX;
type
TCustomGTKGLAreaControl = class(TWinControl)
private
FCanvas: TCanvas; // only valid at designtime
protected
procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
function GetWidget: PGtkGLArea;
procedure CreateWnd; override;
procedure CreateComponent(TheOwner: TComponent); override;
public
property Widget: PGtkGLArea read GetWidget;
constructor Create(AOwner: TComponent); override;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
@ -38,32 +41,67 @@ type
published
end;
procedure Register;
implementation
{ TCustomGTKGLArea }
const
InitAttrList: array [1..11] of LongInt=
( GDK_GL_RGBA,
GDK_GL_RED_SIZE, 1,
GDK_GL_GREEN_SIZE, 1,
GDK_GL_BLUE_SIZE, 1,
GDK_GL_DEPTH_SIZE,1,
GDK_GL_DOUBLEBUFFER,
GDK_GL_None
);
InitAttrList: array [1..11] of LongInt = (
GDK_GL_RGBA,
GDK_GL_RED_SIZE, 1,
GDK_GL_GREEN_SIZE, 1,
GDK_GL_BLUE_SIZE, 1,
GDK_GL_DEPTH_SIZE,1,
GDK_GL_DOUBLEBUFFER,
GDK_GL_None
);
constructor TCustomGTKGLAreaControl.Create(AOwner: TComponent);
procedure Register;
begin
inherited Create(AOwner);
SetBounds(1, 1, 75, 25);
RegisterComponents('OpenGL',[TGTKGLAreaControl]);
end;
{ TCustomGTKGLAreaControl }
constructor TCustomGTKGLAreaControl.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
ControlStyle:=ControlStyle-[csSetCaption];
if (csDesigning in ComponentState) then begin
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end else
FCompStyle:=csNonLCL;
SetBounds(1, 1, 160, 90);
end;
destructor TCustomGTKGLAreaControl.Destroy;
begin
FCanvas.Free;
FCanvas:=nil;
inherited Destroy;
end;
procedure TCustomGTKGLAreaControl.WMPaint(var Message: TLMPaint);
begin
Include(FControlState, csCustomPaint);
inherited WMPaint(Message);
if (csDesigning in ComponentState) and (FCanvas<>nil) then begin
with FCanvas do begin
Brush.Color:=clLtGray;
Pen.Color:=clRed;
Rectangle(0,0,Width-1,Height-1);
MoveTo(0,0);
LineTo(Width,Height);
MoveTo(0,Height);
LineTo(Width,0);
end;
end;
Exclude(FControlState, csCustomPaint);
end;
function TCustomGTKGLAreaControl.GetWidget: PGtkGLArea;
begin
if HandleAllocated then
@ -72,45 +110,20 @@ begin
Result:=nil;
end;
procedure TCustomGTKGLAreaControl.CreateWnd;
procedure TCustomGTKGLAreaControl.CreateComponent(TheOwner: TComponent);
var
Params: TCreateParams;
NewWidget: Pointer;
begin
CreateParams(Params);
with Params do begin
if (WndParent = 0) and (Style and WS_CHILD <> 0) then exit;
end;
Handle := longint(gtk_gl_area_new(pgint(@InitAttrList)));
if Widget <> nil then begin
gtk_object_set_data(pgtkobject(Widget),'Sender',Self);
gtk_object_set_data(pgtkobject(Widget),'Class', Pointer(Self));
gtk_object_set_data(pgtkObject(Widget),'Style',0);
gtk_object_set_data(pgtkObject(Widget),'ExStyle',0);
end else begin
writeln('Creation of gtkglarea failed.');
Halt(1);
end;
if Parent <> nil then AddControl;
InitializeWnd;
end;
//-----------------------------------------------------------------------------
procedure InternalInit;
begin
if not InitGl then begin
WriteLn('OpenGL is not supported on this system');
Halt(2);
if csDesigning in ComponentState then
inherited CreateComponent(TheOwner)
else begin
NewWidget:=gtk_gl_area_new(Plongint(@InitAttrList));
Handle := longint(NewWidget);
TGtkObject(InterfaceObject).FinishComponentCreate(Self,NewWidget,true);
end;
end;
initialization
InternalInit;
finalization
{$i gtkglarea.lrs}
end.

View File

@ -1,228 +1,107 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="2"/>
<General>
<ProjectType Value="Program"/>
<Flags>
<SaveClosedFiles Value="True"/>
<SaveOnlyProjectUnits Value="True"/>
</Flags>
<MainUnit Value="0"/>
<ActiveEditorIndexAtStart Value="2"/>
<IconPath Value=""/>
<TargetFileExt Value=""/>
<Title Value="gtkglarea_demo"/>
<OutputDirectory Value="."/>
<UnitOutputDirectory Value="."/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/gtk"/>
</General>
<Bookmarks Count="0"/>
<JumpHistory Count="14" HistoryIndex="13">
<JumpHistory Count="12" HistoryIndex="11">
<Position1>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Filename Value="exampleform.pp"/>
<Caret Line="53" Column="15" TopLine="32"/>
</Position1>
<Position2>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="104" Column="12" TopLine="66"/>
<Filename Value="exampleform.pp"/>
<Caret Line="255" Column="33" TopLine="233"/>
</Position2>
<Position3>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="24" Column="42" TopLine="1"/>
<Filename Value="exampleform.pp"/>
<Caret Line="44" Column="27" TopLine="32"/>
</Position3>
<Position4>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="103" Column="10" TopLine="71"/>
<Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="23" Column="56" TopLine="1"/>
</Position4>
<Position5>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="24" Column="18" TopLine="1"/>
<Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="37" Column="56" TopLine="1"/>
</Position5>
<Position6>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/nvgl.pp"/>
<Caret Line="750" Column="1" TopLine="703"/>
<Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="84" Column="40" TopLine="45"/>
</Position6>
<Position7>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/nvgl.pp"/>
<Caret Line="2239" Column="17" TopLine="2215"/>
<Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="23" Column="47" TopLine="1"/>
</Position7>
<Position8>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/nvgl.pp"/>
<Caret Line="1296" Column="9" TopLine="1249"/>
<Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="84" Column="54" TopLine="45"/>
</Position8>
<Position9>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="84" Column="3" TopLine="70"/>
<Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="83" Column="5" TopLine="45"/>
</Position9>
<Position10>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="24" Column="18" TopLine="1"/>
<Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="68" Column="23" TopLine="45"/>
</Position10>
<Position11>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="28" Column="18" TopLine="1"/>
<Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="68" Column="17" TopLine="46"/>
</Position11>
<Position12>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="106" Column="5" TopLine="70"/>
<Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="69" Column="22" TopLine="51"/>
</Position12>
<Position13>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="38" Column="34" TopLine="1"/>
</Position13>
<Position14>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="104" Column="16" TopLine="70"/>
</Position14>
</JumpHistory>
<Units Count="2">
<Unit0>
<CursorPos X="7" Y="26"/>
<EditorIndex Value="0"/>
<Filename Value="gtkglarea_demo.pp"/>
<FormName Value=""/>
<HasResources Value="False"/>
<IsPartOfProject Value="True"/>
<Loaded Value="True"/>
<ReadOnly Value="False"/>
<ResourceFilename Value=""/>
<SyntaxHighlighter Value="FreePascal"/>
<TopLine Value="1"/>
<UnitName Value="GTKGLArea_Demo"/>
<BreakPoints Count="0"/>
<UsageCount Value="22"/>
</Unit0>
<Unit1>
<CursorPos X="17" Y="69"/>
<CursorPos X="24" Y="44"/>
<EditorIndex Value="1"/>
<Filename Value="exampleform.pp"/>
<FormName Value=""/>
<HasResources Value="False"/>
<IsPartOfProject Value="True"/>
<Loaded Value="True"/>
<ReadOnly Value="False"/>
<ResourceFilename Value=""/>
<SyntaxHighlighter Value="FreePascal"/>
<TopLine Value="45"/>
<TopLine Value="32"/>
<UnitName Value="ExampleForm"/>
<BreakPoints Count="0"/>
<UsageCount Value="22"/>
</Unit1>
</Units>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)/publishedproject/"/>
<CommandAfter Value=""/>
<UseIncludeFileFilter Value="True"/>
<IncludeFileFilter Value="*.{pas,pp,inc,lfm,lpr,lrs,lpi,lpk,fpc,sh,xml}"/>
<UseExcludeFileFilter Value="False"/>
<ExcludeFileFilter Value="*.{bak,ppu,ppw,o,so};*~;backup"/>
<SaveClosedEditorFilesInfo Value="False"/>
<SaveEditorInfoOfNonProjectFiles Value="False"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<HostApplicationFilename Value=""/>
<CommandLineParams Value=""/>
<LaunchingApplication Use="False" PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e bash -i -c '$(TargetCmdLine)'"/>
<WorkingDirectory Value=""/>
<Display Use="False" Value=":0"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e bash -i -c '$(TargetCmdLine)'"/>
</local>
<environment>
<UserOverrides Count="0"/>
<IncludeSystemVariables Value="False"/>
</environment>
</RunParams>
</ProjectOptions>
<CompilerOptions>
<Target>
<Filename Value=""/>
</Target>
<Parsing>
<Style Value="1"/>
<SymantecChecking>
<D2Extensions Value="True"/>
<CStyleOperator Value="True"/>
<IncludeAssertionCode Value="False"/>
<AllowLabel Value="True"/>
<CPPInline Value="True"/>
<CStyleMacros Value="False"/>
<TPCompatible Value="False"/>
<InitConstructor Value="False"/>
<StaticKeyword Value="False"/>
<DelphiCompat Value="False"/>
<UseAnsiStrings Value="False"/>
<GPCCompat Value="False"/>
</SymantecChecking>
</Parsing>
<CodeGeneration>
<UnitStyle Value="1"/>
<Checks>
<IOChecks Value="False"/>
<RangeChecks Value="False"/>
<OverflowChecks Value="False"/>
<StackChecks Value="False"/>
</Checks>
<HeapSize Value="8000000"/>
<Generate Value="1"/>
<TargetProcessor Value="1"/>
<Optimizations>
<VariablesInRegisters Value="False"/>
<UncertainOptimizations Value="False"/>
<OptimizationLevel Value="1"/>
</Optimizations>
<TargetOS Value="linux"/>
<LinkStyle Value="1"/>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<GenerateDebugDBX Value="False"/>
<UseLineInfoUnit Value="True"/>
<UseHeaptrc Value="False"/>
<GenGProfCode Value="False"/>
<StripSymbols Value="False"/>
</Debugging>
<Options>
<PassLinkerOptions Value="False"/>
<LinkerOptions Value=""/>
</Options>
</Linking>
<Other>
<Verbosity>
<ShowErrors Value="True"/>
<ShowWarn Value="True"/>
<ShowNotes Value="True"/>
<ShowHints Value="True"/>
<ShowGenInfo Value="True"/>
<ShoLineNum Value="False"/>
<ShowAll Value="False"/>
<ShowAllProcsOnError Value="False"/>
<ShowDebugInfo Value="False"/>
<ShowUsedFiles Value="False"/>
<ShowTriedFiles Value="False"/>
<ShowDefMacros Value="False"/>
<ShowCompProc Value="False"/>
<ShowCond Value="False"/>
<ShowNothing Value="False"/>
<ShowHintsForUnusedProjectUnits Value="False"/>
</Verbosity>
<WriteFPCLogo Value="True"/>
<ConfigFile>
<DontUseConfigFile Value="False"/>
<AdditionalConfigFile Value="False"/>
<ConfigFilePath Value="./fpc.cfg"/>
<StopAfterErrCount Value="1"/>
</ConfigFile>
</Other>
<SearchPaths>
<IncludeFiles Value=""/>
<Libraries Value=""/>
<OtherUnitFiles Value="$(LazarusDir)/lcl/units;$(LazarusDir)/lcl/units/gtk;$(LazarusDir)/components/gtk/gtkglarea"/>
<CompilerPath Value="$(CompPath)"/>
<UnitOutputDirectory Value=""/>
<LCLWidgetType Value="gtk"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/gtk"/>
</SearchPaths>
</CompilerOptions>
<ProjectSpecificCodeToolsDefines>
<Count Value="0"/>
</ProjectSpecificCodeToolsDefines>
</CONFIG>

View File

@ -56,6 +56,14 @@ type
);
TLCLPlatforms = set of TLCLPlatform;
TBuildLazarusFlag = (
blfWithoutIDE,
blfOnlyIDE,
blfQuick,
blfWithStaticPackages
);
TBuildLazarusFlags = set of TBuildLazarusFlag;
TBuildLazarusItem = class
private
fCommands: array[TMakeMode] of string;
@ -187,7 +195,7 @@ function ShowConfigureBuildLazarusDlg(
function BuildLazarus(Options: TBuildLazarusOptions;
ExternalTools: TExternalToolList; Macros: TTransferMacroList;
const PackageOptions: string): TModalResult;
const PackageOptions: string; Flags: TBuildLazarusFlags): TModalResult;
implementation
@ -249,12 +257,13 @@ end;
function BuildLazarus(Options: TBuildLazarusOptions;
ExternalTools: TExternalToolList; Macros: TTransferMacroList;
const PackageOptions: string): TModalResult;
const PackageOptions: string; Flags: TBuildLazarusFlags): TModalResult;
var
Tool: TExternalToolOptions;
i: Integer;
CurItem: TBuildLazarusItem;
ExtraOptions: String;
CurMakeMode: TMakeMode;
function RemoveProfilerOption(const ExtraOptions: string): string;
var
@ -287,7 +296,7 @@ begin
end;
Tool.ScanOutputForFPCMessages:=true;
Tool.ScanOutputForMakeMessages:=true;
if Options.CleanAll then begin
if Options.CleanAll and (not (blfQuick in Flags)) then begin
// clean lazarus source directories
Tool.Title:=lisCleanLazarusSource;
Tool.WorkingDirectory:='$(LazarusDir)';
@ -298,29 +307,39 @@ begin
for i:=0 to Options.Count-1 do begin
// build item
CurItem:=Options.Items[i];
if CurItem.MakeMode<>mmNone then begin
Tool.Title:=CurItem.Description;
Tool.WorkingDirectory:='$(LazarusDir)/'+CurItem.Directory;
Tool.CmdLineParams:=CurItem.Commands[CurItem.MakeMode];
// append extra options
ExtraOptions:=Options.ExtraOptions;
if CurItem=Options.ItemJITForm then begin
ExtraOptions:=RemoveProfilerOption(ExtraOptions);
end else if CurItem=Options.ItemIDE then begin
if PackageOptions<>'' then begin
if ExtraOptions<>'' then ExtraOptions:=ExtraOptions+' ';
ExtraOptions:=ExtraOptions+PackageOptions;
end;
// calculate make mode
CurMakeMode:=CurItem.MakeMode;
if (blfOnlyIDE in Flags) then
if (CurItem=Options.ItemIDE) then
CurMakeMode:=mmCleanBuild
else
CurMakeMode:=mmNone;
if (blfWithoutIDE in Flags) and (CurItem=Options.ItemIDE) then
CurMakeMode:=mmNone;
if (blfQuick in Flags) and (CurMakeMode=mmCleanBuild) then
CurMakeMode:=mmBuild;
if CurMakeMode=mmNone then continue;
Tool.Title:=CurItem.Description;
Tool.WorkingDirectory:='$(LazarusDir)/'+CurItem.Directory;
Tool.CmdLineParams:=CurItem.Commands[CurItem.MakeMode];
// append extra options
ExtraOptions:=Options.ExtraOptions;
if CurItem=Options.ItemJITForm then begin
ExtraOptions:=RemoveProfilerOption(ExtraOptions);
end else if CurItem=Options.ItemIDE then begin
if PackageOptions<>'' then begin
if ExtraOptions<>'' then ExtraOptions:=ExtraOptions+' ';
ExtraOptions:=ExtraOptions+PackageOptions;
end;
if ExtraOptions<>'' then
Tool.CmdLineParams:=Tool.CmdLineParams+' OPT='''+ExtraOptions+'''';
// append target OS
if Options.TargetOS<>'' then
Tool.CmdLineParams:=Tool.CmdLineParams+' OS_TARGET='+Options.TargetOS;
// run
Result:=ExternalTools.Run(Tool,Macros);
if Result<>mrOk then exit;
end;
if ExtraOptions<>'' then
Tool.CmdLineParams:=Tool.CmdLineParams+' OPT='''+ExtraOptions+'''';
// append target OS
if Options.TargetOS<>'' then
Tool.CmdLineParams:=Tool.CmdLineParams+' OS_TARGET='+Options.TargetOS;
// run
Result:=ExternalTools.Run(Tool,Macros);
if Result<>mrOk then exit;
end;
Result:=mrOk;
finally

View File

@ -449,8 +449,7 @@ var
XMLConfig: TXMLConfig;
begin
try
ClearFile(FFileName,true);
XMLConfig:=TXMLConfig.Create(FFileName);
XMLConfig:=TXMLConfig.CreateClean(FFileName);
XMLConfig.SetValue('CodeToolsOptions/Version/Value',
CodeToolsOptionsVersion);

View File

@ -362,8 +362,7 @@ var
XMLConfig: TXMLConfig;
begin
try
ClearFile(FFilename,true);
XMLConfig:=TXMLConfig.Create(FFileName);
XMLConfig:=TXMLConfig.CreateClean(FFileName);
XMLConfig.SetDeleteValue('InputHistory/Version/Value',
InputHistoryVersion,0);
SaveToXMLConfig(XMLConfig,'InputHistory/');

View File

@ -44,6 +44,7 @@ uses
Buttons, Menus, ComCtrls, Spin, SysUtils, FileCtrl,
Controls, Graphics, ExtCtrls, Dialogs, CodeToolManager, CodeCache,
SynEditKeyCmds, LazConf, LazarusIDEStrConsts, ProjectDefs, Project,
BuildLazDialog,
{$IFDEF EnablePkgs}
ComponentReg,
{$ELSE}
@ -145,13 +146,6 @@ type
);
TCodeToolsFlags = set of TCodeToolsFlag;
// build lazarus flags
TBuildLazarusFlag = (
blfWithStaticPackages
);
TBuildLazarusFlags = set of TBuildLazarusFlag;
{ TMainIDEBar }
TMainIDEBar = class(TForm)

View File

@ -160,8 +160,7 @@ var XMLConfig: TXMLConfig;
begin
XMLFilename:=GetFilename;
try
ClearFile(XMLFilename,true);
XMLConfig:=TXMLConfig.Create(XMLFilename);
XMLConfig:=TXMLConfig.CreateClean(XMLFilename);
except
on E: Exception do begin
writeln('ERROR: unable to open miscellaneous options "',XMLFilename,'":',E.Message);

View File

@ -1298,8 +1298,7 @@ begin
end;
confPath:=SetDirSeparators(confPath);
try
ClearFile(confPath,true);
xmlconfig := TXMLConfig.Create(confPath);
xmlconfig := TXMLConfig.CreateClean(confPath);
except
on E: Exception do begin
writeln('ERROR: ',E.Message);
@ -2654,6 +2653,9 @@ end.
{
$Log$
Revision 1.116 2003/04/29 19:00:41 mattias
added package gtkopengl
Revision 1.115 2003/04/29 09:31:10 mattias
changed macro name ProjectDir to ProjPath

View File

@ -983,7 +983,7 @@ begin
TForm(Instance).HandleNeeded;
FMainForm := TForm(Instance);
end else begin
if not assigned(FList) then
if not Assigned(FList) then
FList := TList.Create;
FList.Add(TForm(Instance));
end;
@ -1003,6 +1003,9 @@ end;
{ =============================================================================
$Log$
Revision 1.52 2003/04/29 19:00:43 mattias
added package gtkopengl
Revision 1.51 2003/04/20 07:36:29 mattias
fixed loading form name

View File

@ -388,11 +388,11 @@ begin
if (Val >= FItems.Count) then
raise Exception.CreateFmt(rsIndexOutOfRange,[ClassName,Val,FItems.Count]);
if Val<0 then Val:=-1;
writeln('[TCustomListBox.SetItemIndex] A ',FItems.ClassName,' ',Val);
//writeln('[TCustomListBox.SetItemIndex] A ',FItems.ClassName,' ',Val);
FItemIndex:=Val;
if HandleAllocated then
CNSendMessage(LM_SETITEMINDEX, Self, Pointer(Val));
writeln('[TCustomListBox.SetItemIndex] END ',FItems.ClassName);
//writeln('[TCustomListBox.SetItemIndex] END ',FItems.ClassName);
end;
{------------------------------------------------------------------------------

View File

@ -445,6 +445,8 @@ begin
OpenDialog:=TOpenDialog.Create(Application);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
OpenDialog.InitialDir:=
LazPackage.GetFileDialogInitialDir(OpenDialog.InitialDir);
OpenDialog.Title:=lisOpenFile;
OpenDialog.Options:=OpenDialog.Options+[ofFileMustExist,ofPathMustExist];
if OpenDialog.Execute then begin
@ -465,10 +467,14 @@ procedure TAddToPackageDlg.AddFileButtonClick(Sender: TObject);
var
i: Integer;
CurPFT: TPkgFileType;
Filename: String;
begin
Filename:=AddFilenameEdit.Text;
LazPackage.LongenFilename(Filename);
FillChar(Params,SizeOf(Params),0);
Params.AddType:=d2ptUnit;
Params.UnitFilename:=AddFilenameEdit.Text;
Params.UnitFilename:=Filename;
Params.FileType:=pftText;
Params.UnitName:='';
Params.PkgFileFlags:=[];
@ -506,6 +512,8 @@ begin
OpenDialog:=TOpenDialog.Create(Application);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
OpenDialog.InitialDir:=
LazPackage.GetFileDialogInitialDir(OpenDialog.InitialDir);
OpenDialog.Title:=lisOpenFile;
OpenDialog.Options:=OpenDialog.Options+[ofFileMustExist,ofPathMustExist];
if OpenDialog.Execute then begin
@ -615,6 +623,8 @@ begin
OpenDialog:=TOpenDialog.Create(Application);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
OpenDialog.InitialDir:=
LazPackage.GetFileDialogInitialDir(OpenDialog.InitialDir);
OpenDialog.Title:=lisOpenFile;
OpenDialog.Options:=OpenDialog.Options+[ofPathMustExist];
if OpenDialog.Execute then begin
@ -1310,9 +1320,12 @@ procedure TAddToPackageDlg.UpdateAddUnitInfo;
var
AnUnitName: string;
HasRegisterProc: boolean;
Filename: String;
begin
if Assigned(OnGetUnitRegisterInfo) then begin
OnGetUnitRegisterInfo(Self,AddUnitFilenameEdit.Text,
Filename:=AddUnitFilenameEdit.Text;
LazPackage.LongenFilename(Filename);
OnGetUnitRegisterInfo(Self,Filename,
AnUnitName,HasRegisterProc);
AddUnitSrcNameEdit.Text:=AnUnitName;
AddUnitHasRegisterCheckBox.Checked:=HasRegisterProc;

View File

@ -537,6 +537,7 @@ type
CompPriorityCat: TComponentPriorityCategory): TPkgFile;
procedure RemoveFile(PkgFile: TPkgFile);
procedure UnremovePkgFile(PkgFile: TPkgFile);
function GetFileDialogInitialDir(const DefaultDirectory: string): string;
// required dependencies (plus removed required dependencies)
function FindDependencyByName(const PkgName: string): TPkgDependency;
function RequiredDepByIndex(Index: integer): TPkgDependency;
@ -1720,9 +1721,12 @@ begin
end;
procedure TLazPackage.SetOutputStateFile(const AValue: string);
var
NewStateFile: String;
begin
if FOutputStateFile=AValue then exit;
FOutputStateFile:=AValue;
NewStateFile:=TrimFilename(AValue);
if FOutputStateFile=NewStateFile then exit;
FOutputStateFile:=NewStateFile;
end;
procedure TLazPackage.SetRegistered(const AValue: boolean);
@ -2205,6 +2209,7 @@ begin
ComponentPriority.Category:=CompPriorityCat;
end;
FFiles.Add(Result);
Modified:=true;
end;
function TLazPackage.AddRemovedFile(const NewFilename, NewUnitName: string;
@ -2242,6 +2247,15 @@ begin
PkgFile.Removed:=false;
end;
function TLazPackage.GetFileDialogInitialDir(const DefaultDirectory: string
): string;
begin
Result:=AppendPathDelim(TrimFilename(DefaultDirectory));
if (SourceDirectories.GetFileReference(Result)=nil)
and DirectoryExists(Directory) then
Result:=Directory;
end;
procedure TLazPackage.RemoveRemovedDependency(Dependency: TPkgDependency);
begin
Dependency.RemoveFromList(FFirstRemovedDependency,pdlRequires);

View File

@ -1744,8 +1744,7 @@ begin
if fLayouts=nil then exit;
Filename:=GetLayoutConfigFilename;
try
ClearFile(Filename,true);
XMLConfig:=TXMLConfig.Create(Filename);
XMLConfig:=TXMLConfig.CreateClean(Filename);
except
on E: Exception do begin
writeln('ERROR: unable to open miscellaneous options "',Filename,'": ',E.Message);

View File

@ -448,8 +448,7 @@ begin
XMLConfig:=nil;
try
ClearFile(ConfigFilename,true);
XMLConfig:=TXMLConfig.Create(ConfigFilename);
XMLConfig:=TXMLConfig.CreateClean(ConfigFilename);
Path:='UserPkgLinks/';
ANode:=FUserLinks.FindLowest;

View File

@ -1003,8 +1003,7 @@ procedure TLazPackageGraph.ReplacePackage(OldPackage, NewPackage: TLazPackage);
end;
while OldPkgFile.ComponentCount>0 do begin
PkgComponent:=OldPkgFile.Components[0];
OldPkgFile.RemovePkgComponent(PkgComponent);
NewPkgFile.AddPkgComponent(PkgComponent);
PkgComponent.PkgFile:=NewPkgFile;
end;
end;
end;

View File

@ -51,13 +51,14 @@ uses
UComponentManMain, PackageEditor, AddToPackageDlg, PackageDefs, PackageLinks,
PackageSystem, OpenInstalledPkgDlg, PkgGraphExplorer, BrokenDependenciesDlg,
CompilerOptions, ExtToolDialog, ExtToolEditDlg, EditDefineTree,
DefineTemplates, LazConf, ProjectInspector, ComponentPalette, UnitEditor,
AddFileToAPackageDlg, LazarusPackageIntf,
BuildLazDialog, DefineTemplates, LazConf, ProjectInspector, ComponentPalette,
UnitEditor, AddFileToAPackageDlg, LazarusPackageIntf,
BasePkgManager, MainBar;
type
TPkgManager = class(TBasePkgManager)
// events
// events - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
// package editor
function OnPackageEditorCompilePackage(Sender: TObject;
APackage: TLazPackage;
CompileClean, CompileRequired: boolean): TModalResult;
@ -73,19 +74,13 @@ type
): TModalResult;
function OnPackageEditorSavePackage(Sender: TObject; APackage: TLazPackage;
SaveAs: boolean): TModalResult;
function PackageGraphExplorerOpenPackage(Sender: TObject;
APackage: TLazPackage): TModalResult;
procedure MainIDEitmPkgOpenPackageFileClick(Sender: TObject);
procedure MainIDEitmPkgPkgGraphClick(Sender: TObject);
procedure MainIDEitmPkgAddCurUnitToPkgClick(Sender: TObject);
procedure mnuConfigCustomCompsClicked(Sender: TObject);
procedure mnuOpenRecentPackageClicked(Sender: TObject);
procedure mnuPkgOpenPackageClicked(Sender: TObject);
procedure OnApplicationIdle(Sender: TObject);
procedure OnPackageEditorFreeEditor(APackage: TLazPackage);
procedure OnPackageEditorGetUnitRegisterInfo(Sender: TObject;
const AFilename: string; var TheUnitName: string;
var HasRegisterProc: boolean);
// package graph
function PackageGraphExplorerOpenPackage(Sender: TObject;
APackage: TLazPackage): TModalResult;
procedure PackageGraphAddPackage(Pkg: TLazPackage);
procedure PackageGraphBeginUpdate(Sender: TObject);
procedure PackageGraphChangePackageName(APackage: TLazPackage;
@ -93,9 +88,20 @@ type
procedure PackageGraphDeletePackage(APackage: TLazPackage);
procedure PackageGraphDependencyModified(ADependency: TPkgDependency);
procedure PackageGraphEndUpdate(Sender: TObject; GraphChanged: boolean);
// menu
procedure MainIDEitmPkgOpenPackageFileClick(Sender: TObject);
procedure MainIDEitmPkgPkgGraphClick(Sender: TObject);
procedure MainIDEitmPkgAddCurUnitToPkgClick(Sender: TObject);
procedure mnuConfigCustomCompsClicked(Sender: TObject);
procedure mnuOpenRecentPackageClicked(Sender: TObject);
procedure mnuPkgOpenPackageClicked(Sender: TObject);
procedure IDEComponentPaletteEndUpdate(Sender: TObject;
PaletteChanged: boolean);
procedure IDEComponentPaletteOpenPackage(Sender: TObject);
// misc
procedure OnApplicationIdle(Sender: TObject);
procedure GetDependencyOwnerDescription(Dependency: TPkgDependency;
var Description: string);
private
@ -121,7 +127,7 @@ type
function DoGetUnitRegisterInfo(const AFilename: string;
var TheUnitName: string; var HasRegisterProc: boolean;
IgnoreErrors: boolean): TModalResult;
procedure SaveAutoInstallDependencies;
procedure SaveAutoInstallDependencies(SetWithStaticPcksFlagForIDE: boolean);
procedure LoadStaticBasePackages;
procedure LoadStaticCustomPackages;
function LoadInstalledPackage(const PackageName: string): TLazPackage;
@ -130,28 +136,35 @@ type
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
// initialization and menu
procedure ConnectMainBarEvents; override;
procedure ConnectSourceNotebookEvents; override;
procedure SetupMainBarShortCuts; override;
procedure SetRecentPackagesMenu; override;
procedure AddFileToRecentPackages(const Filename: string);
procedure SaveSettings; override;
function GetDefaultSaveDirectoryForFile(const Filename: string): string; override;
procedure LoadInstalledPackages; override;
procedure UnloadInstalledPackages;
procedure UpdateVisibleComponentPalette; override;
// files
function GetDefaultSaveDirectoryForFile(const Filename: string): string; override;
function OnRenameFile(const OldFilename,
NewFilename: string): TModalResult; override;
// package graph
function AddPackageToGraph(APackage: TLazPackage; Replace: boolean): TModalResult;
function DoShowPackageGraph: TModalResult;
procedure DoShowPackageGraphPathList(PathList: TList); override;
// project
function OpenProjectDependencies(AProject: TProject): TModalResult; override;
procedure AddDefaultDependencies(AProject: TProject); override;
procedure AddProjectDependency(AProject: TProject; APackage: TLazPackage); override;
procedure AddProjectRegCompDependency(AProject: TProject;
ARegisteredComponent: TRegisteredComponent); override;
procedure AddProjectLCLDependency(AProject: TProject); override;
function OnProjectInspectorOpen(Sender: TObject): boolean; override;
function ShowConfigureCustomComponents: TModalResult; override;
// package editors
function DoNewPackage: TModalResult; override;
function DoShowOpenInstalledPckDlg: TModalResult; override;
function DoOpenPackage(APackage: TLazPackage): TModalResult; override;
@ -160,27 +173,28 @@ type
function DoSavePackage(APackage: TLazPackage;
Flags: TPkgSaveFlags): TModalResult; override;
function DoSaveAllPackages(Flags: TPkgSaveFlags): TModalResult; override;
function DoShowPackageGraph: TModalResult;
function DoClosePackageEditor(APackage: TLazPackage): TModalResult; override;
function DoCloseAllPackageEditors: TModalResult; override;
procedure DoShowPackageGraphPathList(PathList: TList); override;
function DoAddActiveUnitToAPackage: TModalResult;
// package compilation
function DoCompileProjectDependencies(AProject: TProject;
Flags: TPkgCompileFlags): TModalResult; override;
function DoCompilePackage(APackage: TLazPackage;
Flags: TPkgCompileFlags): TModalResult; override;
function DoSavePackageMainSource(APackage: TLazPackage;
Flags: TPkgCompileFlags): TModalResult; override;
function OnRenameFile(const OldFilename,
NewFilename: string): TModalResult; override;
function DoAddActiveUnitToAPackage: TModalResult;
// package installation
procedure LoadInstalledPackages; override;
procedure UnloadInstalledPackages;
function ShowConfigureCustomComponents: TModalResult; override;
function DoInstallPackage(APackage: TLazPackage): TModalResult;
function DoUninstallPackage(APackage: TLazPackage): TModalResult;
function DoCompileAutoInstallPackages(Flags: TPkgCompileFlags
): TModalResult; override;
function DoSaveAutoInstallConfig: TModalResult; override;
function DoGetIDEInstallPackageOptions: string; override;
function OnProjectInspectorOpen(Sender: TObject): boolean; override;
end;
implementation
@ -738,8 +752,7 @@ begin
StateFile:=APackage.GetStateFilename;
try
CompilerFileDate:=FileAge(CompilerFilename);
ClearFile(StateFile,true);
XMLConfig:=TXMLConfig.Create(StateFile);
XMLConfig:=TXMLConfig.CreateClean(StateFile);
try
XMLConfig.SetValue('Compiler/Value',CompilerFilename);
XMLConfig.SetValue('Compiler/Date',CompilerFileDate);
@ -919,6 +932,7 @@ begin
writeln('TPkgManager.CheckIfPackageNeedsCompilation Required ',
RequiredPackage.IDAsString,' OtherState file "',OtherStateFile,'"'
,' is newer than State file ',APackage.IDAsString);
Result:=mrYes;
exit;
end;
end;
@ -1067,11 +1081,17 @@ begin
Result:=mrOk;
end;
procedure TPkgManager.SaveAutoInstallDependencies;
procedure TPkgManager.SaveAutoInstallDependencies(
SetWithStaticPcksFlagForIDE: boolean);
var
Dependency: TPkgDependency;
sl: TStringList;
begin
if SetWithStaticPcksFlagForIDE then begin
MiscellaneousOptions.BuildLazOpts.WithStaticPackages:=true;
MiscellaneousOptions.Save;
end;
sl:=TStringList.Create;
Dependency:=FirstAutoInstallDependency;
while Dependency<>nil do begin
@ -1645,7 +1665,7 @@ begin
end;
// backup old file
Result:=MainIDE.DoBackupFile(APackage.Filename,false);
Result:=MainIDE.DoBackupFile(APackage.Filename,true);
if Result=mrAbort then exit;
// delete ambigious files
@ -1654,8 +1674,7 @@ begin
// save
try
ClearFile(APackage.Filename,true);
XMLConfig:=TXMLConfig.Create(APackage.Filename);
XMLConfig:=TXMLConfig.CreateClean(APackage.Filename);
try
XMLConfig.Clear;
APackage.SaveToXMLConfig(XMLConfig,'Package/');
@ -2150,7 +2169,7 @@ begin
end;
end;
if NeedSaving then
SaveAutoInstallDependencies;
SaveAutoInstallDependencies(true);
// ask user to rebuilt Lazarus now
Result:=MessageDlg('Rebuild Lazarus?',
@ -2166,7 +2185,7 @@ begin
end;
// rebuild Lazarus
Result:=MainIDE.DoBuildLazarus([blfWithStaticPackages]);
Result:=MainIDE.DoBuildLazarus([blfWithStaticPackages,blfQuick,blfOnlyIDE]);
if Result<>mrOk then exit;
finally
@ -2214,7 +2233,7 @@ begin
Dependency.RemoveFromList(FirstAutoInstallDependency,pdlRequires);
Dependency.Free;
end;
SaveAutoInstallDependencies;
SaveAutoInstallDependencies(true);
end;
// ask user to rebuilt Lazarus now
@ -2231,7 +2250,7 @@ begin
end;
// rebuild Lazarus
Result:=MainIDE.DoBuildLazarus([blfWithStaticPackages]);
Result:=MainIDE.DoBuildLazarus([blfWithStaticPackages,blfOnlyIDE,blfQuick]);
if Result<>mrOk then exit;
finally