1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21   Author: Juha Manninen
22 
23   Abstract:
24     Defines build profiles for "Build Lazarus" function, and has a simple GUI
25     for managing them.
26 }
27 unit BuildProfileManager;
28 
29 {$mode objfpc}{$H+}
30 
31 interface
32 
33 uses
34   Classes, SysUtils,
35   // LazUtils
36   Laz2_XMLCfg, LazLoggerBase, LazFileUtils, LazUTF8,
37   // LCL
38   Forms, Controls, Dialogs, ExtCtrls, StdCtrls, ComCtrls, Contnrs, ButtonPanel,
39   InterfaceBase, LCLPlatformDef,
40   // Codetools
41   DefineTemplates,
42   // IdeIntf
43   IDEImagesIntf, IDEHelpIntf, IDEDialogs,
44   // IDE
45   LazarusIDEStrConsts, IDEProcs, TransferMacros, EnvironmentOpts;
46 
47 type
48 
49   TIdeBuildMode = (
50     bmBuild,
51     bmCleanBuild,
52     bmCleanAllBuild
53   );
54 
55   TBuildLazarusProfiles = class;
56 
57   { TBuildLazarusProfile }
58 
59   TBuildLazarusProfile = class
60   private
61     FCleanOnce: boolean;
62     fOwnerCnt: TBuildLazarusProfiles;
63     fName: string;
64     fTargetOS: string;
65     fTargetDirectory: string;
66     fTargetCPU: string;
67     fTargetPlatform: TLCLPlatform;
68     fIdeBuildMode: TIdeBuildMode;
69     fUpdateRevisionInc: boolean;
70     fOptions: TStringList;      // User defined options.
71     fDefines: TStringList;      // Defines selected for this profile.
72 
GetExtraOptionsnull73     function GetExtraOptions: string;
74     procedure SetExtraOptions(const AValue: string);
75   public
76     constructor Create(AOwnerCnt: TBuildLazarusProfiles; AName: string);
77     destructor Destroy; override;
78     procedure Assign(Source: TBuildLazarusProfile; ACopyName: Boolean=True);
79     procedure Load(XMLConfig: TXMLConfig; const Path: string);
80     procedure Save(XMLConfig: TXMLConfig; const Path: string);
FPCTargetOSnull81     function FPCTargetOS: string;
FPCTargetCPUnull82     function FPCTargetCPU: string;
GetParsedTargetDirectorynull83     function GetParsedTargetDirectory(Macros: TTransferMacroList): string;
84   public
85     property Name: string read fName;
86     property ExtraOptions: string read GetExtraOptions write SetExtraOptions;
87     property TargetOS: string read fTargetOS write fTargetOS;
88     property TargetDirectory: string read fTargetDirectory write fTargetDirectory;
89     property TargetCPU: string read fTargetCPU write fTargetCPU;
90     property TargetPlatform: TLCLPlatform read fTargetPlatform write fTargetPlatform;
91     property IdeBuildMode: TIdeBuildMode read fIdeBuildMode write fIdeBuildMode;
92     property CleanOnce: boolean read FCleanOnce write FCleanOnce;
93     property UpdateRevisionInc: boolean read fUpdateRevisionInc write fUpdateRevisionInc;
94     property OptionsLines: TStringList read fOptions;
95     property Defines: TStringList read fDefines;
96   end;
97 
98   { TBuildLazarusProfiles }
99 
100   TBuildLazarusProfiles = class(TObjectList)
101   private
102     fRestartAfterBuild: boolean;
103     fConfirmBuild: boolean;
104     fAllDefines: TStringList;
105     fSelected: TStringList;
106     fStaticAutoInstallPackages: TStringList;
107     fCurrentIndex: integer;
GetCurrentProfilenull108     function GetCurrentProfile: TBuildLazarusProfile;
GetItemsnull109     function GetItems(Index: integer): TBuildLazarusProfile;
110   public
111     constructor Create;
112     destructor Destroy; override;
113     procedure Clear; override;
114     procedure Assign(Source: TBuildLazarusProfiles);
IndexByNamenull115     function IndexByName(AName: string): integer;
CreateDefaultsnull116     function CreateDefaults: integer;
117     procedure Load(XMLConfig: TXMLConfig; const Path: string; const FileVersion: integer);
118     procedure Save(XMLConfig: TXMLConfig; const Path: string);
119     procedure Move(CurIndex, NewIndex: Integer); // Replaces TList.Move
120   public
121     property RestartAfterBuild: boolean read fRestartAfterBuild write fRestartAfterBuild;
122     property ConfirmBuild: boolean read fConfirmBuild write fConfirmBuild;
123     property AllDefines: TStringList read fAllDefines;
124     property Selected: TStringList read fSelected;
125     property StaticAutoInstallPackages: TStringList read fStaticAutoInstallPackages;
126     property CurrentIndex: integer read fCurrentIndex write fCurrentIndex;
127     property Current: TBuildLazarusProfile read GetCurrentProfile;
128     property Items[Index: integer]: TBuildLazarusProfile read GetItems; default;
129   end;
130 
131   { TBuildProfileManagerForm }
132 
133   TBuildProfileManagerForm = class(TForm)
134     AddButton: TToolButton;
135     ButtonPanel:TButtonPanel;
136     EditButton: TToolButton;
137     MoveDownButton: TToolButton;
138     MoveUpButton: TToolButton;
139     ProfilesListBox: TListBox;
140     ProfilesPanel: TPanel;
141     ProfilesToolBar: TToolBar;
142     RemoveButton: TToolButton;
143     tbSeparator: TToolButton;
144     procedure FormCreate(Sender: TObject);
145     procedure FormDestroy(Sender: TObject);
146     procedure ProfilesListboxClick(Sender: TObject);
147     procedure AddButtonClick(Sender: TObject);
148     procedure HelpButtonClick(Sender: TObject);
149     procedure RemoveButtonClick(Sender: TObject);
150     procedure EditButtonClick(Sender: TObject);
151     procedure MoveUpButtonClick(Sender: TObject);
152     procedure MoveDownButtonClick(Sender: TObject);
153   private
154     fProfsToManage: TBuildLazarusProfiles;
155     procedure EnableButtons;
156   public
157     procedure Prepare(AProfiles: TBuildLazarusProfiles);
158     // Assigned by caller when opening/closing this form.
159     property  ProfsToManage: TBuildLazarusProfiles read fProfsToManage;
160 
161   end;
162 
163 var
164   BuildProfileManagerForm: TBuildProfileManagerForm;
165 
166 
167 implementation
168 
169 {$R *.lfm}
170 
171 const
172   DefaultTargetDirectory = ''; // empty will be replaced by '$(ConfDir)/bin';
173 
174 
IdeBuildModeToStrnull175 function IdeBuildModeToStr(BuildMode: TIdeBuildMode): string;
176 begin
177   Result:='';
178   case BuildMode of
179     bmBuild:         Result:='Build';
180     bmCleanBuild:    Result:='Clean + Build';
181     bmCleanAllBuild: Result:='Clean All + Build';
182   end;
183 end;
184 
StrToIdeBuildModenull185 function StrToIdeBuildMode(const s: string): TIdeBuildMode;
186 begin
187   Result:=bmBuild;
188   if s='Clean + Build' then
189     Result:=bmCleanBuild
190   else if s='Clean All + Build' then
191     Result:=bmCleanAllBuild;
192 end;
193 
194 
195 { TBuildLazarusProfile }
196 
197 constructor TBuildLazarusProfile.Create(AOwnerCnt: TBuildLazarusProfiles;
198                                         AName: string);
199 begin
200   inherited Create;
201   fOwnerCnt:=AOwnerCnt;
202   fName:=AName;
203   fOptions:=TStringList.Create;
204   fDefines:=TStringList.Create;
205 end;
206 
207 destructor TBuildLazarusProfile.Destroy;
208 begin
209   fDefines.Free;
210   fOptions.Free;
211   inherited Destroy;
212 end;
213 
214 procedure TBuildLazarusProfile.Load(XMLConfig: TXMLConfig; const Path: string);
215 var
216   LCLPlatformStr: string;
217 begin
218   TargetOS      :=XMLConfig.GetValue(Path+'TargetOS/Value','');
219   TargetCPU     :=XMLConfig.GetValue(Path+'TargetCPU/Value','');
220   LCLPlatformStr:=XMLConfig.GetValue(Path+'LCLPlatform/Value','');
221   if LCLPlatformStr='' then
222     fTargetPlatform:=GetDefaultLCLWidgetType
223   else
224     fTargetPlatform  :=DirNameToLCLPlatform(LCLPlatformStr);
225   FTargetDirectory:=AppendPathDelim(SetDirSeparators(
226       XMLConfig.GetValue(Path+'TargetDirectory/Value', DefaultTargetDirectory)));
227   IdeBuildMode:=StrToIdeBuildMode(XMLConfig.GetValue(Path+'IdeBuildMode/Value',''));
228   CleanOnce:=XMLConfig.GetValue(Path+'CleanOnce/Value',false);
229   FUpdateRevisionInc :=XMLConfig.GetValue(Path+'UpdateRevisionInc/Value',true);
230   LoadStringList(XMLConfig,fOptions,Path+'Options/');
231   if fOptions.Count=0 then     // Support a syntax used earlier by profiles.
232     fOptions.Text:=XMLConfig.GetValue(Path+'ExtraOptions/Value','');
233   LoadStringList(XMLConfig,fDefines,Path+'Defines/');
234 end;
235 
236 procedure TBuildLazarusProfile.Save(XMLConfig: TXMLConfig; const Path: string);
237 begin
238   XMLConfig.SetDeleteValue(Path+'TargetOS/Value',TargetOS,'');
239   XMLConfig.SetDeleteValue(Path+'TargetCPU/Value',TargetCPU,'');
240   XMLConfig.SetDeleteValue(Path+'LCLPlatform/Value',
241                            LCLPlatformDirNames[fTargetPlatform],
242                            '');
243   XMLConfig.SetDeleteValue(Path+'TargetDirectory/Value',
244                            FTargetDirectory,DefaultTargetDirectory);
245   XMLConfig.SetDeleteValue(Path+'IdeBuildMode/Value',IdeBuildModeToStr(IdeBuildMode),'');
246   XMLConfig.SetDeleteValue(Path+'CleanOnce/Value',CleanOnce,false);
247   XMLConfig.SetDeleteValue(Path+'UpdateRevisionInc/Value',FUpdateRevisionInc,true);
248   SaveStringList(XMLConfig,fOptions,Path+'Options/');
249   SaveStringList(XMLConfig,fDefines,Path+'Defines/');
250 end;
251 
252 procedure TBuildLazarusProfile.Assign(Source: TBuildLazarusProfile; ACopyName: Boolean);
253 begin
254   if (Source=nil) or (Source=Self) then exit;
255   if ACopyName then
256     fName           :=Source.Name;
257   TargetOS          :=Source.TargetOS;
258   TargetDirectory   :=Source.TargetDirectory;
259   TargetCPU         :=Source.TargetCPU;
260   TargetPlatform    :=Source.TargetPlatform;
261   IdeBuildMode      :=Source.IdeBuildMode;
262   CleanOnce         :=Source.CleanOnce;
263   UpdateRevisionInc :=Source.UpdateRevisionInc;
264   fOptions.Assign(Source.fOptions);
265   fDefines.Assign(Source.fDefines);
266 end;
267 
FPCTargetOSnull268 function TBuildLazarusProfile.FPCTargetOS: string;
269 begin
270   Result:=GetFPCTargetOS(TargetOS);
271 end;
272 
FPCTargetCPUnull273 function TBuildLazarusProfile.FPCTargetCPU: string;
274 begin
275   Result:=GetFPCTargetCPU(TargetCPU);
276 end;
277 
TBuildLazarusProfile.GetParsedTargetDirectorynull278 function TBuildLazarusProfile.GetParsedTargetDirectory(
279   Macros: TTransferMacroList): string;
280 begin
281   Result:=TargetDirectory;
282   if Result='' then exit;
283   if not Macros.SubstituteStr(Result) then begin
284     DebugLn('TBuildLazarusProfile.GetParsedTargetDirectory macro aborted Options.TargetDirectory=',TargetDirectory);
285     Result:='';
286     exit;
287   end;
288   Result:=TrimAndExpandDirectory(Result,EnvironmentOptions.GetParsedLazarusDirectory);
289 end;
290 
GetExtraOptionsnull291 function TBuildLazarusProfile.GetExtraOptions: string;
292 var
293   i: Integer;
294 begin
295   Result:='';
296   for i:=0 to fOptions.Count-1 do
297     Result:=Result+' '+fOptions[i];
298   Result:=Trim(Result);
299   for i:=0 to fDefines.Count-1 do
300     Result:=Result+' -d'+fDefines[i];
301   Result:=Trim(Result);
302 end;
303 
304 procedure TBuildLazarusProfile.SetExtraOptions(const AValue: string);
305 begin
306   fOptions.Text:=AValue;
307 end;
308 
309 
310 { TBuildLazarusProfiles }
311 
312 constructor TBuildLazarusProfiles.Create;
313 begin
314   inherited Create;
315   fRestartAfterBuild:=True;
316   fConfirmBuild:=True;
317   fAllDefines:=TStringList.Create;
318   fSelected:=TStringList.Create;
319   fStaticAutoInstallPackages:=TStringList.Create;
320 end;
321 
322 destructor TBuildLazarusProfiles.Destroy;
323 begin
324   inherited Destroy;
325   // Clear is called by inherited Destroy. Must be freed later.
326   fStaticAutoInstallPackages.Free;
327   fSelected.Free;
328   fAllDefines.Free;
329 end;
330 
331 procedure TBuildLazarusProfiles.Clear;
332 begin
333   fAllDefines.Clear;
334   fSelected.Clear;
335   fStaticAutoInstallPackages.Clear;
336   inherited Clear;
337 end;
338 
339 procedure TBuildLazarusProfiles.Assign(Source: TBuildLazarusProfiles);
340 var
341   i: Integer;
342   SrcItem, NewItem: TBuildLazarusProfile;
343 begin
344   Clear;
345   RestartAfterBuild :=Source.RestartAfterBuild;
346   ConfirmBuild:=Source.ConfirmBuild;
347   fAllDefines.Assign(Source.fAllDefines);
348   fSelected.Assign(Source.fSelected);
349   fStaticAutoInstallPackages.Assign(Source.fStaticAutoInstallPackages);
350   fCurrentIndex:=Source.fCurrentIndex;
351   for i:=0 to Source.Count-1 do begin
352     SrcItem:=Source.Items[i];
353     NewItem:=TBuildLazarusProfile.Create(Self, SrcItem.Name);
354     NewItem.Assign(SrcItem);
355     Add(NewItem);
356   end;
357 end;
358 
TBuildLazarusProfiles.IndexByNamenull359 function TBuildLazarusProfiles.IndexByName(AName: string): integer;
360 begin
361   Result:=Count-1;
362   while (Result>=0) and (UTF8CompareLatinTextFast(Items[Result].Name,AName)<>0) do
363     dec(Result);
364 end;
365 
CreateDefaultsnull366 function TBuildLazarusProfiles.CreateDefaults: integer;
367 // Create a set of default profiles when none are saved.
368 // Returns index for the default selected profile.
369 var
370   Profile: TBuildLazarusProfile;
371   Platfrm: TLCLPlatform;
372 begin
373   Platfrm:=GetDefaultLCLWidgetType;
374 
375   // Build Normal IDE
376   Profile:=TBuildLazarusProfile.Create(Self, lisLazBuildNormalIDE);
377   with Profile, fOwnerCnt do begin
378     fTargetPlatform:=Platfrm;
379     fIdeBuildMode:=bmBuild;
380     fUpdateRevisionInc:=True;
381   end;
382   // Return this one as default. Needed when building packages without saved profiles.
383   Result:=Add(Profile);
384 
385   // Build Debug IDE
386   Profile:=TBuildLazarusProfile.Create(Self, lisLazBuildDebugIDE);
387   with Profile, fOwnerCnt do begin
388     fTargetPlatform:=Platfrm;
389     fIdeBuildMode:=bmBuild;
390     fUpdateRevisionInc:=True;
391     {$IFDEF Darwin}
392     // FPC on darwin has a bug with -Cr
393     fOptions.Add('-gw -gl -godwarfsets -gh -gt -Co -Ci -Sa');
394     {$ELSE}
395     fOptions.Add('-gw3 -gl -gh -gt -Co -Cr -Ci -Sa');
396     {$ENDIF}
397   end;
398   Add(Profile);
399 
400   // Build Optimised IDE
401   Profile:=TBuildLazarusProfile.Create(Self, lisLazBuildOptimizedIDE);
402   with Profile, fOwnerCnt do begin
403     fTargetPlatform:=Platfrm;
404     fIdeBuildMode:=bmBuild;
405     fUpdateRevisionInc:=True;
406     fOptions.Add('-O3 -g- -Xs');
407   end;
408   Add(Profile);
409 
410   // Clean Up + Build all
411   Profile:=TBuildLazarusProfile.Create(Self, lisLazCleanUpBuildAll);
412   with Profile, fOwnerCnt do begin
413     fTargetPlatform:=Platfrm;
414     fIdeBuildMode:=bmCleanBuild;
415     fUpdateRevisionInc:=True;
416   end;
417   Add(Profile);
418 end;
419 
420 procedure TBuildLazarusProfiles.Load(XMLConfig: TXMLConfig; const Path: string;
421                                      const FileVersion: integer);
422 var
423   i, ProfCount, ProfInd: Integer;
424   ProfPath, ProfName: string;
425   Profile: TBuildLazarusProfile;
426 begin
427   Clear;
428   if FileVersion<1 then
429   begin
430     ProfInd:=CreateDefaults;
431   end else if FileVersion=1 then
432   begin
433     // Older config file version.
434     CreateDefaults;         // Only one profile saved, create defaults always.
435     // Then create MyProfile.
436     Profile:=TBuildLazarusProfile.Create(Self, 'MyProfile');
437     Profile.Load(XMLConfig, Path);
438     Add(Profile);
439     FRestartAfterBuild:=XMLConfig.GetValue(Path+'RestartAfterBuild/Value',true);
440     FConfirmBuild     :=XMLConfig.GetValue(Path+'ConfirmBuild/Value',true);
441     ProfInd:=Count-1;       // Go to last MyProfile.
442   end else begin
443     // Latest config file version.
444     ProfCount:=XMLConfig.GetValue(Path+'Profiles/Count',0);
445     if ProfCount = 0 then
446       ProfInd:=CreateDefaults    // No saved profiles were found, use defaults.
447     else begin
448       // Load list of profiles.
449       for i:=0 to ProfCount-1 do begin
450         ProfPath:=Path+'Profiles/Profile'+IntToStr(i)+'/';
451         ProfName:=XMLConfig.GetValue(ProfPath+'Name','Unknown');
452         Profile:=TBuildLazarusProfile.Create(Self, ProfName);
453         Profile.Load(XMLConfig, ProfPath);
454         Add(Profile);
455       end;
456       // Current profile ItemIndex.
457       ProfInd:=XMLConfig.GetValue(Path+'ProfileIndex/Value',0);
458       // Other global build values.
459       FRestartAfterBuild:=XMLConfig.GetValue(Path+'RestartAfterBuild/Value',true);
460       FConfirmBuild     :=XMLConfig.GetValue(Path+'ConfirmBuild/Value',true);
461     end
462   end;
463   // Load defines, selected profiles and auto install packages.
464   LoadStringList(XMLConfig,fAllDefines,Path+'AllDefines/');
465   LoadStringList(XMLConfig,fSelected,Path+'SelectedProfiles/');
466 
467   LoadStringList(XMLConfig,fStaticAutoInstallPackages,Path+'StaticAutoInstallPackages/');
468   if FileVersion<3 then begin
469     // the IDE part of synedit was split into a new package syneditdsgn
470     fStaticAutoInstallPackages.Add('syneditdsgn');
471   end;
472   fCurrentIndex:=ProfInd;
473 end;
474 
475 procedure TBuildLazarusProfiles.Save(XMLConfig: TXMLConfig; const Path: string);
476 var
477   i: Integer;
478   ProfPath, n: string;
479 begin
480   // Save list of profiles.
481   XMLConfig.SetDeleteValue(Path+'Profiles/Count',Count,0);
482   for i:=0 to Count-1 do begin
483     ProfPath:=Path+'Profiles/Profile'+IntToStr(i)+'/';
484     n:=Items[i].Name;
485     XMLConfig.SetDeleteValue(ProfPath+'Name',n,'');
486     Items[i].Save(XMLConfig, ProfPath);
487   end;
488   // Current profile ItemIndex.
489   XMLConfig.SetDeleteValue(Path+'ProfileIndex/Value',CurrentIndex,0);
490   // Other global build values.
491   XMLConfig.SetDeleteValue(Path+'RestartAfterBuild/Value',FRestartAfterBuild,true);
492   XMLConfig.SetDeleteValue(Path+'ConfirmBuild/Value',FConfirmBuild,true);
493   // Save defines, selected profiles and auto install packages.
494   SaveStringList(XMLConfig,fAllDefines,Path+'AllDefines/');
495   SaveStringList(XMLConfig,fSelected,Path+'SelectedProfiles/');
496   SaveStringList(XMLConfig,fStaticAutoInstallPackages,Path+'StaticAutoInstallPackages/');
497 end;
498 
499 procedure TBuildLazarusProfiles.Move(CurIndex, NewIndex: Integer);
500 begin
501   inherited Move(CurIndex, NewIndex);
502   fCurrentIndex:=NewIndex;
503 end;
504 
GetCurrentProfilenull505 function TBuildLazarusProfiles.GetCurrentProfile: TBuildLazarusProfile;
506 begin
507   Result:=Items[fCurrentIndex];
508 end;
509 
TBuildLazarusProfiles.GetItemsnull510 function TBuildLazarusProfiles.GetItems(Index: integer): TBuildLazarusProfile;
511 begin
512   Result:=TBuildLazarusProfile(inherited Items[Index]);
513 end;
514 
515 
516 { TBuildProfileManagerForm }
517 
518 procedure TBuildProfileManagerForm.FormCreate(Sender: TObject);
519 begin
520   Caption := lisLazBuildManageProfiles;
521 
522   ProfilesToolBar.Images := IDEImages.Images_16;
523   AddButton.ImageIndex     :=IDEImages.LoadImage('laz_add');
524   RemoveButton.ImageIndex  :=IDEImages.LoadImage('laz_delete');
525   EditButton.ImageIndex    :=IDEImages.LoadImage('laz_edit');
526   MoveUpButton.ImageIndex  :=IDEImages.LoadImage('arrow_up');
527   MoveDownButton.ImageIndex:=IDEImages.LoadImage('arrow_down');
528 
529   AddButton.Caption:=lisAdd;
530   RemoveButton.Caption:=lisRemove;
531   EditButton.Caption:=lisRename;
532   MoveUpButton.Caption:=lisUp;
533   MoveDownButton.Caption:=lisDown;
534 
535   ButtonPanel.OKButton.Caption:=lisMenuOk;
536   ButtonPanel.HelpButton.Caption:=lisMenuHelp;
537   ButtonPanel.CancelButton.Caption:=lisCancel;
538 
539   fProfsToManage:=TBuildLazarusProfiles.Create;
540 end;
541 
542 procedure TBuildProfileManagerForm.FormDestroy(Sender: TObject);
543 begin
544   fProfsToManage.Free;
545 end;
546 
547 procedure TBuildProfileManagerForm.Prepare(AProfiles: TBuildLazarusProfiles);
548 var
549   i: Integer;
550 begin
551   fProfsToManage.Assign(AProfiles);
552   for i:=0 to fProfsToManage.Count-1 do
553     ProfilesListBox.Items.Add(fProfsToManage[i].Name);
554   ProfilesListBox.ItemIndex:=fProfsToManage.CurrentIndex;
555 end;
556 
557 procedure TBuildProfileManagerForm.ProfilesListboxClick(Sender: TObject);
558 begin
559   if fProfsToManage.Count>0 then begin
560     fProfsToManage.fCurrentIndex:=(Sender as TListbox).ItemIndex;
561     EnableButtons;
562   end;
563 end;
564 
565 procedure TBuildProfileManagerForm.AddButtonClick(Sender: TObject);
566 var
567   NewProfile: TBuildLazarusProfile;
568   Str: string;
569 begin
570   Str:= '';
571   if not InputQuery(lisLazBuildNewProf, lisLazBuildNewProfInfo, Str) then Exit;
572   if Str='' then Exit;
573 
574   // Update ProfsToManage collection.
575   NewProfile:=TBuildLazarusProfile.Create(fProfsToManage,Str);
576   NewProfile.Assign(fProfsToManage.Current, False);
577   fProfsToManage.Add(NewProfile);
578   fProfsToManage.fCurrentIndex:=fProfsToManage.Count-1; // Select the new profile.
579   // Update ListBox
580   ProfilesListbox.Items.Add(Str);
581   ProfilesListbox.ItemIndex:=ProfilesListbox.Count-1;
582   EnableButtons;
583 end;
584 
585 procedure TBuildProfileManagerForm.RemoveButtonClick(Sender: TObject);
586 var
587   i, SelI, NewI: integer;
588 begin
589   i := ProfilesListbox.ItemIndex;
590   if i<0 then exit;
591   // Remove the item from selected list.
592   if IDEMessageDialog(lisLazBuildConfirmDeletion,
593     lisLazBuildAreYouSureYouWantToDeleteThisBuildProfile, mtConfirmation,
594     [mbYes, mbNo])=mrYes then
595   begin
596     SelI:=fProfsToManage.Selected.IndexOf(fProfsToManage[i].fName);
597     if SelI>-1 then
598       fProfsToManage.Selected.Delete(SelI);
599     // New last item index.
600     NewI:=i;
601     if i=ProfilesListbox.Items.Count-1 then
602       Dec(NewI);
603     // Update ProfsToManage collection.
604     fProfsToManage.Delete(i);
605     fProfsToManage.fCurrentIndex:=NewI;
606     // Update ListBox
607     ProfilesListBox.Items.Delete(i);
608     ProfilesListBox.ItemIndex:=NewI;
609     EnableButtons;
610   end;
611 end;
612 
613 procedure TBuildProfileManagerForm.EditButtonClick(Sender: TObject);
614 var
615   i, SelI: integer;
616   Str: string;
617 begin
618   i:=ProfilesListbox.ItemIndex;
619   if i<0 then exit;
620 
621   Str:= ProfilesListbox.Items[i];
622   if not InputQuery(lisLazBuildRenameProf, lisLazBuildRenameProfInfo, Str) then Exit;
623   if Str='' then Exit;
624 
625   // Update ProfsToManage collection.
626   fProfsToManage[i].fName:=Str;
627   // Update selected list.
628   SelI:=fProfsToManage.Selected.IndexOf(ProfilesListbox.Items[i]);
629   if SelI>-1 then
630     fProfsToManage.Selected[SelI]:=Str;
631   // Update ListBox
632   ProfilesListbox.Items[i]:=Str;
633   EnableButtons;
634 end;
635 
636 procedure TBuildProfileManagerForm.MoveUpButtonClick(Sender: TObject);
637 var
638   i: integer;
639 begin
640   i:=ProfilesListbox.ItemIndex;
641   if i<1 then exit;
642   fProfsToManage.Move(i,i-1);
643   ProfilesListbox.Items.Move(i,i-1);
644   ProfilesListbox.ItemIndex:=i-1;
645   EnableButtons;
646 end;
647 
648 procedure TBuildProfileManagerForm.MoveDownButtonClick(Sender: TObject);
649 var
650   i: integer;
651 begin
652   i:=ProfilesListbox.ItemIndex;
653   if (i<0) or (i>=ProfilesListbox.Items.Count-1) then exit;
654   fProfsToManage.Move(i,i+1);
655   ProfilesListbox.Items.Move(i,i+1);
656   ProfilesListbox.ItemIndex:=i+1;
657   EnableButtons;
658 end;
659 
660 procedure TBuildProfileManagerForm.EnableButtons;
661 var
662   i: integer;
663 begin
664   i:=ProfilesListbox.ItemIndex;
665   AddButton.Enabled:=True;
666   RemoveButton.Enabled:=(i>=0) and (ProfilesListbox.Items.Count>1);
667   EditButton.Enabled:=(i>=0);
668   MoveUpButton.Enabled:=(i>0);
669   MoveDownButton.Enabled:=(i>=0) and (i<ProfilesListbox.Items.Count-1);
670 end;
671 
672 procedure TBuildProfileManagerForm.HelpButtonClick(Sender: TObject);
673 begin
674   LazarusHelp.ShowHelpForIDEControl(Self);
675 end;
676 
677 end.
678 
679