paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 10:39:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

added package gtkopengl

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/codetools/codecache.pas
View File

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

5
components/codetools/codetoolsstrconsts.pas
View File

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

29
components/codetools/definetemplates.pas
View File

@ -3059,6 +3059,24 @@ begin
ExternalMacroStart+'IncPath', ExternalMacroStart+'IncPath',
'..'+ds+'include;..'+ds+'include'+ds+TargetOS, '..'+ds+'include;..'+ds+'include'+ds+TargetOS,
da_Define)); 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); MainDir.AddChild(DirTempl);
// images // images
@ -3104,6 +3122,17 @@ begin
ExternalMacroStart+'IncPath', ExternalMacroStart+'IncPath',
'..'+ds+'include;..'+ds+'include'+ds+TargetOS, '..'+ds+'include;..'+ds+'include'+ds+TargetOS,
da_Define)); 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); MainDir.AddChild(DirTempl);
// examples // examples

14
components/codetools/laz_xmlcfg.pas
View File

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

2
components/gtk/gtkglarea/Makefile.fpc
View File

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

119
components/gtk/gtkglarea/gtkglarea.pp
View File

@ -10,27 +10,30 @@
* * * *
***************************************************************************** *****************************************************************************
Author: Mattias Gaertner Author: Mattias Gaertner
} }
unit gtkglarea; unit GTKGLArea;
{$MODE objfpc}{$H+} {$MODE objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, VCLGlobals, LCLLinux, LCLType, glib, gdk, gtk, Classes, SysUtils, Controls, Graphics, LMessages, VCLGlobals, GTKGLArea_Int,
gtkglarea_int, gl, Controls, gtkint, gtkwinapiwindow, LMessages; InterfaceBase, GTKInt, LResources, NVGLX;
type type
TCustomGTKGLAreaControl = class(TWinControl) TCustomGTKGLAreaControl = class(TWinControl)
private
FCanvas: TCanvas; // only valid at designtime
protected protected
procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
function GetWidget: PGtkGLArea; function GetWidget: PGtkGLArea;
procedure CreateWnd; override; procedure CreateComponent(TheOwner: TComponent); override;
public public
property Widget: PGtkGLArea read GetWidget; property Widget: PGtkGLArea read GetWidget;
constructor Create(AOwner: TComponent); override; constructor Create(TheOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
end; end;
@ -38,32 +41,67 @@ type
published published
end; end;
procedure Register;
implementation implementation
{ TCustomGTKGLArea }
const const
InitAttrList: array [1..11] of LongInt= InitAttrList: array [1..11] of LongInt = (
( GDK_GL_RGBA, GDK_GL_RGBA,
GDK_GL_RED_SIZE, 1, GDK_GL_RED_SIZE, 1,
GDK_GL_GREEN_SIZE, 1, GDK_GL_GREEN_SIZE, 1,
GDK_GL_BLUE_SIZE, 1, GDK_GL_BLUE_SIZE, 1,
GDK_GL_DEPTH_SIZE,1, GDK_GL_DEPTH_SIZE,1,
GDK_GL_DOUBLEBUFFER, GDK_GL_DOUBLEBUFFER,
GDK_GL_None GDK_GL_None
); );
constructor TCustomGTKGLAreaControl.Create(AOwner: TComponent); procedure Register;
begin begin
inherited Create(AOwner); RegisterComponents('OpenGL',[TGTKGLAreaControl]);
SetBounds(1, 1, 75, 25); 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; end;
destructor TCustomGTKGLAreaControl.Destroy; destructor TCustomGTKGLAreaControl.Destroy;
begin begin
FCanvas.Free;
FCanvas:=nil;
inherited Destroy; inherited Destroy;
end; 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; function TCustomGTKGLAreaControl.GetWidget: PGtkGLArea;
begin begin
if HandleAllocated then if HandleAllocated then
@ -72,45 +110,20 @@ begin
Result:=nil; Result:=nil;
end; end;
procedure TCustomGTKGLAreaControl.CreateWnd; procedure TCustomGTKGLAreaControl.CreateComponent(TheOwner: TComponent);
var var
Params: TCreateParams; NewWidget: Pointer;
begin begin
CreateParams(Params); if csDesigning in ComponentState then
with Params do begin inherited CreateComponent(TheOwner)
if (WndParent = 0) and (Style and WS_CHILD <> 0) then exit; else begin
end; NewWidget:=gtk_gl_area_new(Plongint(@InitAttrList));
Handle := longint(NewWidget);
Handle := longint(gtk_gl_area_new(pgint(@InitAttrList))); TGtkObject(InterfaceObject).FinishComponentCreate(Self,NewWidget,true);
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);
end; end;
end; end;
initialization initialization
InternalInit; {$i gtkglarea.lrs}
finalization
end. end.

189
examples/gtkglarea/gtkglarea_demo.lpi
View File

@ -1,228 +1,107 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="2"/>
<General> <General>
<ProjectType Value="Program"/> <ProjectType Value="Program"/>
<Flags> <Flags>
<SaveClosedFiles Value="True"/>
<SaveOnlyProjectUnits Value="True"/> <SaveOnlyProjectUnits Value="True"/>
</Flags> </Flags>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<ActiveEditorIndexAtStart Value="2"/> <ActiveEditorIndexAtStart Value="2"/>
<IconPath Value=""/>
<TargetFileExt Value=""/> <TargetFileExt Value=""/>
<Title Value="gtkglarea_demo"/> <Title Value="gtkglarea_demo"/>
<OutputDirectory Value="."/>
<UnitOutputDirectory Value="."/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/gtk"/>
</General> </General>
<Bookmarks Count="0"/> <JumpHistory Count="12" HistoryIndex="11">
<JumpHistory Count="14" HistoryIndex="13">
<Position1> <Position1>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/> <Filename Value="exampleform.pp"/>
<Caret Line="1" Column="1" TopLine="1"/> <Caret Line="53" Column="15" TopLine="32"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/> <Filename Value="exampleform.pp"/>
<Caret Line="104" Column="12" TopLine="66"/> <Caret Line="255" Column="33" TopLine="233"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/> <Filename Value="exampleform.pp"/>
<Caret Line="24" Column="42" TopLine="1"/> <Caret Line="44" Column="27" TopLine="32"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/> <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="103" Column="10" TopLine="71"/> <Caret Line="23" Column="56" TopLine="1"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/> <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="24" Column="18" TopLine="1"/> <Caret Line="37" Column="56" TopLine="1"/>
</Position5> </Position5>
<Position6> <Position6>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/nvgl.pp"/> <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="750" Column="1" TopLine="703"/> <Caret Line="84" Column="40" TopLine="45"/>
</Position6> </Position6>
<Position7> <Position7>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/nvgl.pp"/> <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="2239" Column="17" TopLine="2215"/> <Caret Line="23" Column="47" TopLine="1"/>
</Position7> </Position7>
<Position8> <Position8>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/nvgl.pp"/> <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="1296" Column="9" TopLine="1249"/> <Caret Line="84" Column="54" TopLine="45"/>
</Position8> </Position8>
<Position9> <Position9>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/> <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="84" Column="3" TopLine="70"/> <Caret Line="83" Column="5" TopLine="45"/>
</Position9> </Position9>
<Position10> <Position10>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/> <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="24" Column="18" TopLine="1"/> <Caret Line="68" Column="23" TopLine="45"/>
</Position10> </Position10>
<Position11> <Position11>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/> <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="28" Column="18" TopLine="1"/> <Caret Line="68" Column="17" TopLine="46"/>
</Position11> </Position11>
<Position12> <Position12>
<Filename Value="/home/mattias/pascal/official/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/> <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/gtk/gtkglarea/gtkglarea.pp"/>
<Caret Line="106" Column="5" TopLine="70"/> <Caret Line="69" Column="22" TopLine="51"/>
</Position12> </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> </JumpHistory>
<Units Count="2"> <Units Count="2">
<Unit0> <Unit0>
<CursorPos X="7" Y="26"/> <CursorPos X="7" Y="26"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<Filename Value="gtkglarea_demo.pp"/> <Filename Value="gtkglarea_demo.pp"/>
<FormName Value=""/>
<HasResources Value="False"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<Loaded Value="True"/> <Loaded Value="True"/>
<ReadOnly Value="False"/>
<ResourceFilename Value=""/>
<SyntaxHighlighter Value="FreePascal"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UnitName Value="GTKGLArea_Demo"/> <UnitName Value="GTKGLArea_Demo"/>
<BreakPoints Count="0"/> <UsageCount Value="22"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<CursorPos X="17" Y="69"/> <CursorPos X="24" Y="44"/>
<EditorIndex Value="1"/> <EditorIndex Value="1"/>
<Filename Value="exampleform.pp"/> <Filename Value="exampleform.pp"/>
<FormName Value=""/>
<HasResources Value="False"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<Loaded Value="True"/> <Loaded Value="True"/>
<ReadOnly Value="False"/> <TopLine Value="32"/>
<ResourceFilename Value=""/>
<SyntaxHighlighter Value="FreePascal"/>
<TopLine Value="45"/>
<UnitName Value="ExampleForm"/> <UnitName Value="ExampleForm"/>
<BreakPoints Count="0"/> <UsageCount Value="22"/>
</Unit1> </Unit1>
</Units> </Units>
<PublishOptions> <PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)/publishedproject/"/> <DestinationDirectory Value="$(TestDir)/publishedproject/"/>
<CommandAfter Value=""/> <IgnoreBinaries Value="False"/>
<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"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/> <FormatVersion Value="1"/>
<HostApplicationFilename Value=""/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e bash -i -c '$(TargetCmdLine)'"/>
<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"/>
</local> </local>
<environment>
<UserOverrides Count="0"/>
<IncludeSystemVariables Value="False"/>
</environment>
</RunParams> </RunParams>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <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> <SearchPaths>
<IncludeFiles Value=""/>
<Libraries Value=""/>
<OtherUnitFiles Value="$(LazarusDir)/lcl/units;$(LazarusDir)/lcl/units/gtk;$(LazarusDir)/components/gtk/gtkglarea"/> <OtherUnitFiles Value="$(LazarusDir)/lcl/units;$(LazarusDir)/lcl/units/gtk;$(LazarusDir)/components/gtk/gtkglarea"/>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
<UnitOutputDirectory Value=""/>
<LCLWidgetType Value="gtk"/> <LCLWidgetType Value="gtk"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/gtk"/>
</SearchPaths> </SearchPaths>
</CompilerOptions> </CompilerOptions>
<ProjectSpecificCodeToolsDefines>
<Count Value="0"/>
</ProjectSpecificCodeToolsDefines>
</CONFIG> </CONFIG>

67
ide/buildlazdialog.pas
View File

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

3
ide/codetoolsoptions.pas
View File

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

3
ide/inputhistory.pas
View File

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

8
ide/mainbar.pas
View File

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

3
ide/miscoptions.pas
View File

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

6
ide/project.pp
View File

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

5
lcl/include/application.inc
View File

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

4
lcl/include/customlistbox.inc
View File

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

17
packager/addtopackagedlg.pas
View File

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

18
packager/packagedefs.pas
View File

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

3
packager/packageeditor.pas
View File

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

3
packager/packagelinks.pas
View File

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

3
packager/packagesystem.pas
View File

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

91
packager/pkgmanager.pas
View File

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