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