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: Mattias Gaertner
22 Converted to lfm by: Matthijs Willemstein
23 Quickoptions added by: Giuliano Colla
24 Then extensively modified by: Juha Manninen
25 - added support for Build Profiles which extend the idea of Quick Options.
26 - changed UI to be less weird and comply better with UI design norms.
27 - changed object structure to keep it logical and to avoid duplicate data.
28
29 Abstract:
30 Defines settings for the "Build Lazarus" function of the IDE.
31 TConfigureBuildLazarusDlg is used to edit the build options.
32
33 The BuildLazarus function will build the lazarus parts.
34
35 Building occurs only with options defined in the Detail Page.
36 Profiles are just used to set options there. Therefore beginners can
37 use default profiles and don't need to touch the Detail Page.
38 Advanced users can define their own profiles for example for cross compiling.
39 }
40 unit BuildLazDialog;
41
42 {$mode objfpc}{$H+}
43
44 interface
45
46 uses
47 Classes, SysUtils,
48 {$IFDEF Windows}
49 Windows,
50 {$ENDIF}
51 LCLProc, Forms, Controls, LCLType, StdCtrls, ExtCtrls, Buttons, Dialogs,
52 LCLPlatformDef, CheckLst, Menus, ComCtrls,
53 // LazUtils
54 FileUtil, LazFileUtils, LazUTF8, LazLoggerBase, LazFileCache,
55 // LazControls
56 DividerBevel,
57 // Codetools
58 CodeToolManager, DefineTemplates,
59 // IDEIntf
60 LazIDEIntf, IDEMsgIntf, IDEHelpIntf, IDEImagesIntf, IDEWindowIntf,
61 PackageIntf, IDEExternToolIntf, IDEDialogs, IDEUtils,
62 // IDE
63 LazarusIDEStrConsts, TransferMacros, LazConf, DialogProcs,
64 MainBar, EnvironmentOpts,
65 ApplicationBundle, ModeMatrixOpts, CompilerOptions, BuildProfileManager,
66 GenericListEditor, GenericCheckList, PackageSystem, PackageDefs;
67
68 type
69
70 TBuildLazarusFlag = (
71 blfDontBuild, // skip all building, only cleaning
72 blfOnlyIDE, // skip all but IDE (for example build IDE, but not packages, not lazbuild, ...)
73 blfDontClean, // ignore clean up option in profile
74 blfUseMakeIDECfg, // append @idemake.cfg
75 blfBackupOldExe // rename existing lazarus exe to lazarus.old
76 );
77 TBuildLazarusFlags = set of TBuildLazarusFlag;
78
79 TLazarusBuilder = class;
80
81 { TConfigureBuildLazarusDlg }
82
83 TConfigureBuildLazarusDlg = class(TForm)
84 CleanAllRadioButton: TRadioButton;
85 CleanAutoRadioButton: TRadioButton;
86 CleanCommonRadioButton: TRadioButton;
87 CleanOnceCheckBox: TCheckBox;
88 CleanCommonCheckBox: TCheckBox;
89 CommonsDividerBevel: TDividerBevel;
90 ConfirmBuildCheckBox: TCheckBox;
91 DefinesButton: TButton;
92 DefinesLabel: TLabel;
93 DefinesListBox: TCheckListBox;
94 CancelButton: TBitBtn;
95 CBLDBtnPanel: TPanel;
96 BuildProfileComboBox: TComboBox;
97 CompileButton: TBitBtn;
98 CompileAdvancedButton: TBitBtn;
99 InhTreeView: TTreeView;
100 LCLWidgetTypeLabel: TLabel;
101 LCLWidgetTypeComboBox: TComboBox;
102 OptionsLabel: TLabel;
103 OptionsMemo: TMemo;
104 CleanUpGroupBox: TGroupBox;
105 PageControl1: TPageControl;
106 RestartAfterBuildCheckBox: TCheckBox;
107 ShowOptsMenuItem: TMenuItem;
108 DetailsPanel: TPanel;
109 HelpButton: TBitBtn;
110 BuildProfileLabel: TLabel;
111 OptionsPopupMenu: TPopupMenu;
112 Panel2: TPanel;
113 SaveSettingsButton: TBitBtn;
114 BuildProfileButton: TButton;
115 BuildTabSheet: TTabSheet;
116 InfoTabSheet: TTabSheet;
117 TargetCPUComboBox: TComboBox;
118 TargetCPULabel: TLabel;
119 TargetDirectoryButton: TButton;
120 TargetDirectoryComboBox: TComboBox;
121 TargetDirectoryLabel: TLabel;
122 TargetOSComboBox: TComboBox;
123 TargetOSLabel: TLabel;
124 UpdateRevisionIncCheckBox: TCheckBox;
125 procedure BuildProfileButtonClick(Sender: TObject);
126 procedure BuildProfileComboBoxSelect(Sender: TObject);
127 procedure CleanRadioButtonClick(Sender: TObject);
128 procedure CleanCommonCheckBoxClick(Sender: TObject);
129 procedure CompileAdvancedButtonClick(Sender: TObject);
130 procedure CompileButtonClick(Sender: TObject);
131 procedure DefinesButtonClick(Sender: TObject);
132 procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
133 procedure FormCreate(Sender: TObject);
134 procedure FormResize(Sender: TObject);
135 procedure FormShow(Sender: TObject);
136 procedure HelpButtonClick(Sender: TObject);
137 procedure ShowOptsMenuItemClick(Sender: TObject);
138 procedure SaveSettingsButtonClick(Sender: TObject);
139 procedure TargetDirectoryButtonClick(Sender: TObject);
140 private
141 fBuilder: TLazarusBuilder;
142 // Data is copied by caller before and after opening this dialog.
143 fProfiles: TBuildLazarusProfiles;
144 fUpdatingProfileCombo: Boolean;
145 fImageIndexPackage: Integer;
146 fImageIndexRequired: Integer;
147 fImageIndexInherited: Integer;
148 procedure SetupInfoPage;
149 procedure UpdateInheritedTree;
150 procedure PrepareClose;
151 procedure ShowHideCleanup(aShow: Boolean);
152 public
153 constructor Create(TheOwner: TComponent); overload; reintroduce;
154 destructor Destroy; override;
155 procedure CopyProfileToUI(AProfile: TBuildLazarusProfile);
156 procedure CopyUIToProfile(AProfile: TBuildLazarusProfile);
157 procedure UpdateProfileNamesUI;
158 end;
159
160 { TLazarusBuilder }
161
162 TLazarusBuilder = class
163 private
164 fCompilerTargetCPU, fCompilerTargetOS: String;
165 fExtraOptions: string;
166 fMacros: TTransferMacroList;
167 fOutputDirRedirected: boolean;
168 fPackageOptions: string;
169 fProfile: TBuildLazarusProfile;
170 fProfileChanged: boolean;
171 fTargetCPU: string;
172 fTargetDir: string;
173 fTargetFilename: string; // = fTargetDir + 'lazarus'+GetExecutableExt(fTargetOS)
174 fTargetOS: string;
175 fUnitOutDir: string;
176 fUpdateRevInc: boolean;
177 fWorkingDir: string;
178 // Methods used by MakeLazarus :
179 procedure ApplyCleanOnce;
CheckDirectoryWritablenull180 function CheckDirectoryWritable(Dir: string): boolean;
181 procedure CleanDir(Dir: string; Recursive: boolean = true);
182 procedure CleanLazarusSrcDir;
183 procedure CheckRevisionInc;
184 procedure RestoreBackup;
185 // Methods used by SaveIDEMakeOptions :
BreakExtraOptionsnull186 function BreakExtraOptions: string;
187 // Methods used by CalcTargets :
188 procedure SpecialIdeConfig;
189 // This is used by CreateIDEMakeOptions and IsWriteProtected
CalcTargetsnull190 function CalcTargets(Flags: TBuildLazarusFlags): TModalResult;
191 // Methods used by CreateIDEMakeOptions :
192 procedure BackupExe(Flags: TBuildLazarusFlags);
CreateAppleBundlenull193 function CreateAppleBundle: TModalResult;
194 procedure AppendExtraOption(const aOption: string; AutoQuote: boolean = True);
195 // This is used by MakeLazarus and SaveIDEMakeOptions
PrepareTargetDirnull196 function PrepareTargetDir(Flags: TBuildLazarusFlags): TModalResult;
197 public
198 constructor Create;
ShowConfigureBuildLazarusDlgnull199 function ShowConfigureBuildLazarusDlg(AProfiles: TBuildLazarusProfiles): TModalResult;
MakeLazarusnull200 function MakeLazarus(Profile: TBuildLazarusProfile; Flags: TBuildLazarusFlags): TModalResult;
IsWriteProtectednull201 function IsWriteProtected(Profile: TBuildLazarusProfile): Boolean;
SaveIDEMakeOptionsnull202 function SaveIDEMakeOptions(Profile: TBuildLazarusProfile; Flags: TBuildLazarusFlags): TModalResult;
203 public
204 property PackageOptions: string read fPackageOptions write fPackageOptions;
205 property ProfileChanged: boolean read fProfileChanged write fProfileChanged;
206 end;
207
GetMakeIDEConfigFilenamenull208 function GetMakeIDEConfigFilename: string;
GetBackupExeFilenamenull209 function GetBackupExeFilename(Filename: string): string;
210
211 implementation
212
213 {$R *.lfm}
214
215 const
216 DefaultIDEMakeOptionFilename = 'idemake.cfg';
217
GetMakeIDEConfigFilenamenull218 function GetMakeIDEConfigFilename: string;
219 begin
220 Result:=AppendPathDelim(GetPrimaryConfigPath)+DefaultIDEMakeOptionFilename;
221 end;
222
GetBackupExeFilenamenull223 function GetBackupExeFilename(Filename: string): string;
224 var
225 Ext: String;
226 begin
227 Ext:=ExtractFileExt(Filename);
228 Result:=LeftStr(Filename,length(Filename)-length(Ext))+'.old'+Ext;
229 end;
230
231 { TLazarusBuilder }
232
233 constructor TLazarusBuilder.Create;
234 begin
235 fMacros:=GlobalMacroList;
236 end;
237
TLazarusBuilder.ShowConfigureBuildLazarusDlgnull238 function TLazarusBuilder.ShowConfigureBuildLazarusDlg(AProfiles: TBuildLazarusProfiles): TModalResult;
239 // mrOk=save
240 // mrYes=save and compile
241 // mrAll=save and compile all selected profiles
242 var
243 ConfigBuildLazDlg: TConfigureBuildLazarusDlg;
244 begin
245 Result := mrCancel;
246 ConfigBuildLazDlg := TConfigureBuildLazarusDlg.Create(nil);
247 try
248 ConfigBuildLazDlg.fBuilder := Self;
249 ConfigBuildLazDlg.fProfiles.Assign(AProfiles); // Copy profiles to dialog.
250 Result := ConfigBuildLazDlg.ShowModal;
251 if Result in [mrOk,mrYes,mrAll] then
252 AProfiles.Assign(ConfigBuildLazDlg.fProfiles); // Copy profiles back from dialog.
253 finally
254 ConfigBuildLazDlg.Free;
255 end;
256 end;
257
258 procedure TLazarusBuilder.ApplyCleanOnce;
259 begin
260 if not fProfile.CleanOnce then exit;
261 if fProfile.IdeBuildMode=bmBuild then exit;
262 fProfile.IdeBuildMode:=bmBuild;
263 fProfileChanged:=true;
264 end;
265
TLazarusBuilder.CheckDirectoryWritablenull266 function TLazarusBuilder.CheckDirectoryWritable(Dir: string): boolean;
267 begin
268 if DirectoryIsWritableCached(Dir) then exit(true);
269 Result:=false;
270 IDEMessageDialog(lisBuildingLazarusFailed,
271 Format(lisThisSetOfOptionsToBuildLazarusIsNotSupportedByThis,[LineEnding,Dir,LineEnding]),
272 mtError,[mbCancel]);
273 end;
274
275 procedure TLazarusBuilder.CleanDir(Dir: string; Recursive: boolean = true);
276 var
277 FileInfo: TSearchRec;
278 Filename: TFilename;
279 begin
280 Dir:=AppendPathDelim(TrimFilename(Dir));
281 if FindFirstUTF8(Dir+AllFilesMask,faAnyFile,FileInfo)=0 then begin
282 repeat
283 if (FileInfo.Name='') or (FileInfo.Name='.') or (FileInfo.Name='..')
284 or (FileInfo.Name[1]='.')
285 then
286 continue;
287 Filename:=Dir+FileInfo.Name;
288 if faDirectory and FileInfo.Attr>0 then
289 begin
290 if Recursive then
291 CleanDir(Filename)
292 end
293 else begin
294 if FilenameExtIn(FileInfo.Name,['.ppu','.o','.rst','.rsj']) then begin
295 if not DeleteFileUTF8(Filename) then
296 debugln(['Error : (lazarus) Clean directory: failed to delete file "',Filename,'"']);
297 end;
298 end;
299 until FindNextUTF8(FileInfo)<>0;
300 end;
301 FindCloseUTF8(FileInfo);
302 end;
303
304 procedure TLazarusBuilder.CleanLazarusSrcDir;
305 var
306 s: String;
307 begin
308 // clean all lazarus source directories
309 // Note: Some installations put the fpc units into the lazarus directory
310 // => clean only the known directories
311 CleanDir(fWorkingDir,false);
312 CleanDir(fWorkingDir+PathDelim+'examples');
313 CleanDir(fWorkingDir+PathDelim+'components');
314 CleanDir(fWorkingDir+PathDelim+'units');
315 CleanDir(fWorkingDir+PathDelim+'ide');
316 CleanDir(fWorkingDir+PathDelim+'packager');
317 CleanDir(fWorkingDir+PathDelim+'lcl');
318 CleanDir(fWorkingDir+PathDelim+'ideintf'); // from very old lazarus
319 CleanDir(fWorkingDir+PathDelim+'tools');
320 CleanDir(fWorkingDir+PathDelim+'test');
321
322 // clean config directory
323 CleanDir(AppendPathDelim(GetPrimaryConfigPath)+'units');
324
325 // clean custom target directory
326 if fProfile.TargetDirectory<>'' then begin
327 s:=fProfile.GetParsedTargetDirectory(fMacros);
328 if (s<>'') and DirPathExists(s) then
329 CleanDir(s);
330 end;
331 end;
332
333 procedure TLazarusBuilder.CheckRevisionInc;
334 var
335 RevisionIncFile: String;
336 sl: TStringList;
337 begin
338 RevisionIncFile:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory)+'ide'+PathDelim+'revision.inc';
339 if not FileExistsUTF8(RevisionIncFile) then begin
340 debugln(['Note: (lazarus) revision.inc file missing: ',RevisionIncFile]);
341 sl:=TStringList.Create;
342 sl.Add('// Created by lazbuild');
343 sl.Add('const RevisionStr = '''+LazarusVersionStr+''';');
344 try
345 sl.SaveToFile(RevisionIncFile);
346 except
347 on E: Exception do begin
348 debugln(['Warning: (lazarus) unable to write ',RevisionIncFile,': ',E.Message]);
349 end;
350 end;
351 sl.Free;
352 end;
353 end;
354
355 procedure TLazarusBuilder.RestoreBackup;
356 var
357 BackupFilename: String;
358 begin
359 if FileExistsUTF8(fTargetFilename) then begin
360 if not DeleteFileUTF8(fTargetFilename) then begin
361 debugln(['Error: (lazarus) Building IDE failed. Unable to delete "',fTargetFilename,'"']);
362 exit;
363 end;
364 end;
365 BackupFilename:=GetBackupExeFilename(fTargetFilename);
366 if FileExistsUTF8(BackupFilename) then begin
367 if not RenameFileUTF8(BackupFilename,fTargetFilename) then begin
368 debugln(['Error: (lazarus) Building IDE failed. Unable to restore backup file "',BackupFilename,'" to "',fTargetFilename,'"']);
369 end;
370 end;
371 end;
372
MakeLazarusnull373 function TLazarusBuilder.MakeLazarus(Profile: TBuildLazarusProfile;
374 Flags: TBuildLazarusFlags): TModalResult;
375 var
376 Tool: TAbstractExternalTool;
377 Executable, Cmd: String;
378 CmdLineParams: TStrings;
379 EnvironmentOverrides: TStringList;
380
381 procedure AddCmdLineParam(Param: string; ExecMacros: boolean);
382 begin
383 if Param='' then exit;
384 if ExecMacros and (fMacros<>nil) then
385 fMacros.SubstituteStr(Param);
386 if Param<>'' then
387 CmdLineParams.Add(Param);
388 end;
389
Runnull390 function Run(CurTitle: string): TModalResult;
391 begin
392 AddCmdLineParam(Cmd,false);
393 Tool:=ExternalToolList.Add(CurTitle);
394 Tool.Reference(Self,ClassName);
395 try
396 Tool.Data:=TIDEExternalToolData.Create(IDEToolCompileIDE,'lazarus',
397 AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory)+'lazarus.pp');
398 Tool.FreeData:=true;
399 Tool.Process.Executable:=Executable;
400 Tool.AddParsers(SubToolFPC);
401 Tool.AddParsers(SubToolMake);
402 Tool.Process.CurrentDirectory:=fWorkingDir;
403 Tool.EnvironmentOverrides:=EnvironmentOverrides;
404 Tool.CmdLineParams:=MergeCmdLineParams(CmdLineParams);
405 Tool.Execute;
406 Tool.WaitForExit;
407 if Tool.ErrorMessage='' then
408 exit(mrOk)
409 else
410 exit(mrCancel);
411 finally
412 Tool.Release(Self);
413 end;
414 end;
415
416 var
417 IdeBuildMode: TIdeBuildMode;
418 s: String;
419 DefaultTargetFilename: String;
420 begin
421 // Get target files and directories.
422 Result:=mrCancel;
423 fProfile:=Profile;
424 if CalcTargets(Flags)<>mrOk then exit;
425
426 if LazarusIDE<>nil then
427 LazarusIDE.MainBarSubTitle:=Profile.Name;
428 IdeBuildMode:=Profile.IdeBuildMode;
429
430 EnvironmentOverrides:=TStringList.Create;
431 CmdLineParams:=TStringList.Create;
432 Tool:=nil;
433 try
434 // setup external tool
435 EnvironmentOverrides.Values['LCL_PLATFORM']:=LCLPlatformDirNames[Profile.TargetPlatform];
436 EnvironmentOverrides.Values['LANG']:= 'en_US';
437 s:=EnvironmentOptions.GetParsedCompilerFilename;
438 if s<>'' then
439 EnvironmentOverrides.Values['PP']:=s;
440
441 Executable:=EnvironmentOptions.GetParsedMakeFilename;
442 if (Executable<>'') and (not FileExistsUTF8(Executable)) then
443 Executable:=FindDefaultExecutablePath(Executable);
444 if (Executable='') or (not FileExistsUTF8(Executable)) then begin
445 Executable:=FindDefaultMakePath;
446 if (Executable='') or (not FileExistsUTF8(Executable)) then begin
447 IDEMessageDialog(lisMakeNotFound,
448 Format(lisTheProgramMakeWasNotFoundThisToolIsNeededToBuildLa, [LineEnding]),
449 mtError, [mbCancel]);
450 exit;
451 end;
452 end;
453
454 // add -w option to print leaving/entering messages of "make"
455 AddCmdLineParam('-w',false);
456 // append target OS
457 if fTargetOS<>fCompilerTargetOS then begin
458 AddCmdLineParam('OS_TARGET='+fTargetOS,true);
459 AddCmdLineParam('OS_SOURCE='+fTargetOS,true);
460 end;
461 // append target CPU
462 if fTargetCPU<>fCompilerTargetCPU then begin
463 AddCmdLineParam('CPU_TARGET='+fTargetCPU,true);
464 AddCmdLineParam('CPU_SOURCE='+fTargetCPU,true);
465 end;
466
467 // create target directory and bundle
468 Result:=PrepareTargetDir(Flags);
469 if Result<>mrOk then exit;
470
471 fWorkingDir:=EnvironmentOptions.GetParsedLazarusDirectory;
472
473 // clean up
474 if (IdeBuildMode<>bmBuild) and (not (blfDontClean in Flags)) then begin
475
476 if not fOutputDirRedirected then begin
477 // clean up Lazarus sources
478 if not CheckDirectoryWritable(fWorkingDir) then exit(mrCancel);
479
480 if (IdeBuildMode=bmCleanAllBuild) and (not (blfOnlyIDE in Flags)) then
481 CleanLazarusSrcDir;
482
483 // call make to clean up
484 if (IdeBuildMode=bmCleanBuild) or (blfOnlyIDE in Flags) then
485 Cmd:='cleanide'
486 else
487 Cmd:='cleanlaz';
488 Result:=Run(lisCleanLazarusSource);
489 if Result<>mrOk then exit;
490 end;
491
492 // when cleaning, always clean up fallback output directory too
493 if (IdeBuildMode=bmCleanAllBuild) and (not (blfOnlyIDE in Flags)) then
494 begin
495 // clean up fallback package output directories
496 CleanDir(AppendPathDelim(GetPrimaryConfigPath)+'lib');
497 end;
498 // clean up fallback IDE output directory
499 CleanDir(AppendPathDelim(GetPrimaryConfigPath)+'units');
500
501 ApplyCleanOnce;
502 end;
503
504 // build IDE
505 if not (blfDontBuild in Flags) then begin
506 if blfDontClean in Flags then
507 IdeBuildMode:=bmBuild;
508 if IdeBuildMode=bmBuild then
509 Cmd:='idepkg'
510 else
511 Cmd:='cleanide ide';
512
513 if (not fOutputDirRedirected) and (not CheckDirectoryWritable(fWorkingDir)) then
514 exit(mrCancel);
515
516 // fTargetFilename may be lazarus.new.exe, append -o
517 // Note: FPC automatically changes the last extension (append or replace)
518 // For example under linux, where executables don't need any extension
519 // fpc removes the last extension of the -o option.
520 DefaultTargetFilename:='lazarus'+GetExecutableExt(fTargetOS);
521 if CreateRelativePath(fTargetFilename,fTargetDir) <> DefaultTargetFilename then
522 AppendExtraOption('-o'+fTargetFilename);
523
524 if fExtraOptions<>'' then
525 EnvironmentOverrides.Values['OPT'] := fExtraOptions;
526 if not fUpdateRevInc then begin
527 CheckRevisionInc;
528 EnvironmentOverrides.Values['USESVN2REVISIONINC'] := '0';
529 end;
530 // run
531 Result:=Run(lisBuildIDE);
532 // clean only once. If building failed the user must first fix the error
533 // before a clean build is needed.
534 ApplyCleanOnce;
535 if Result<>mrOk then begin
536 // build failed: restore backup of lazarus.exe
537 RestoreBackup;
538 exit;
539 end;
540 end;
541 Result:=mrOk;
542 finally
543 CmdLineParams.Free;
544 EnvironmentOverrides.Free;
545 if LazarusIDE<>nil then
546 LazarusIDE.MainBarSubTitle:='';
547 end;
548 end;
549
550 procedure TLazarusBuilder.SpecialIdeConfig;
551 var
552 MakeIDECfgFilename: string;
553 begin
554 MakeIDECfgFilename:=GetMakeIDEConfigFilename;
555 DebugLn(['SpecialIdeConfig MAKE MakeIDECfgFilename=',MakeIDECfgFilename,' ',FileExistsUTF8(MakeIDECfgFilename)]);
556 if (FileExistsUTF8(MakeIDECfgFilename)) then begin
557 // If a file name contains spaces, a file name whould need to be quoted.
558 // Using a single quote is not possible, it is used already in the
559 // makefile to group all Profile in OPT='bla bla'.
560 // using " implicates that make uses a shell to execute the command of
561 // that line. But using shells (i.e. command.com, cmd.exe, etc) is so
562 // fragile (see bug 11362), that is better to avoid this.
563 // Therefore we use a short 8.3 file and path name, so we don't need to
564 // use quotes at all.
565 // On platforms other than windows, ExtractShortPathName is implemented
566 // too and simply returns the passed file name, so there is no need
567 // for $IFDEF.
568 if pos(' ',MakeIDECfgFilename)>0 then
569 MakeIDECfgFilename:=ExtractShortPathNameUTF8(MakeIDECfgFilename);
570 AppendExtraOption('@'+MakeIDECfgFilename);
571 end;
572 end;
573
CalcTargetsnull574 function TLazarusBuilder.CalcTargets(Flags: TBuildLazarusFlags): TModalResult;
575
IfPairIsnull576 function IfPairIs(const Var1, Var2, Value1, Value2: string): boolean;
577 begin
578 Result:=((Var1=Value1) or (Var1=Value2))
579 and ((Var2=Value1) or (Var2=Value2));
580 end;
581
582 var
583 LazDir, TargetLCLPlatform: string;
584 IsCrossCompiling: Boolean;
585 s: String;
586 begin
587 Result:=mrOk;
588 fOutputDirRedirected:=False;
589 fUpdateRevInc:=fProfile.UpdateRevisionInc;
590
591 fExtraOptions:='';
592
593 // check for special IDE config file
594 //DebugLn(['CreateIDEMakeOptions blfUseMakeIDECfg=',blfUseMakeIDECfg in FLags,' ExtraOptions="',fExtraOptions,'" ',fPackageOptions]);
595 if (blfUseMakeIDECfg in Flags) then
596 begin
597 SpecialIdeConfig;
598 end
599 else begin
600 AppendExtraOption(fPackageOptions,false);
601
602 // write full file names and message ids
603 AppendExtraOption('-vbq');
604
605 {$IFDEF Windows}
606 if (fProfile.TargetPlatform=lpWin32)
607 and (Win32MajorVersion <=4)
608 and (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) then
609 AppendExtraOption('-dWIN9XPLATFORM');
610 {$ENDIF}
611
612 // append profile and global custom options
613 s:=fProfile.ExtraOptions;
614 if OnAppendCustomOption<>nil then
615 OnAppendCustomOption(Self,s,[bmgtEnvironment]);
616
617 GlobalMacroList.SubstituteStr(s);
618 AppendExtraOption(s,false);
619 end;
620
621 // set target filename and target directory:
622 // 1. the user has set a target directory
623 // 2. For crosscompiling the IDE needs a different directory
624 // 3. If lazarus is installed as root/administrator, the lazarus directory
625 // is readonly and needs a different name and directory
626 // (e.g. ~/.lazarus/bin/lazarus).
627 // 4. Platforms like windows locks executables, so lazarus can not replace
628 // itself. The IDE will try to rename the file or fallback to another name
629 // (e.g. lazarus.new.exe).
630 // The target directory is writable, the lazarus.o file can be created.
631 // Otherwise: Don't touch the target filename.
632
633 fTargetFilename:='';
634 fUnitOutDir:='';
635 CodeToolBoss.CompilerDefinesCache.ConfigCaches.GetDefaultCompilerTarget(
636 EnvironmentOptions.GetParsedCompilerFilename,'',fCompilerTargetOS,fCompilerTargetCPU);
637 if fCompilerTargetOS='' then
638 fCompilerTargetOS:=GetCompiledTargetOS;
639 if fCompilerTargetCPU='' then
640 fCompilerTargetCPU:=GetCompiledTargetCPU;
641 fTargetOS:=fProfile.FPCTargetOS;
642 fTargetCPU:=fProfile.FPCTargetCPU;
643 TargetLCLPlatform:=LCLPlatformDirNames[fProfile.TargetPlatform];
644 if fTargetOS='' then fTargetOS:=fCompilerTargetOS;
645 if fTargetCPU='' then fTargetCPU:=fCompilerTargetCPU;
646 LazDir:=EnvironmentOptions.GetParsedLazarusDirectory;
647
648 //DebugLn(['CalcTargets NewTargetOS=',fTargetOS,' NewTargetCPU=',fTargetCPU]);
649 if (fProfile.TargetDirectory<>'') then begin
650 // Case 1. the user has set a target directory
651 fTargetDir:=fProfile.GetParsedTargetDirectory(fMacros);
652 if fTargetDir='' then begin
653 debugln('Error: (lazarus) [CalcTargets] error resolving macros in TargetDirectory=',fProfile.TargetDirectory);
654 Exit(mrAbort);
655 end;
656 fUnitOutDir:=AppendPathDelim(fTargetDir)+'units';
657 debugln('Hint: (lazarus) [CalcTargets] TargetDirectory=',fTargetDir);
658 debugln('Hint: (lazarus) [CalcTargets] UnitsTargetDirectory=',fUnitOutDir);
659 end else begin
660 // no user defined target directory
661 // => find it automatically
662 IsCrossCompiling:=false;
663 if (CompareText(fTargetOS,GetCompiledTargetOS)<>0)
664 or (CompareText(fTargetCPU,GetCompiledTargetCPU)<>0) then
665 begin
666 IsCrossCompiling:=true;
667 if IfPairIs(fTargetCPU,GetCompiledTargetCPU,'i386','x86_64') then
668 begin
669 if (fTargetOS=GetCompiledTargetOS)
670 or IfPairIs(fTargetOS,GetCompiledTargetOS,'win32','win64') then
671 IsCrossCompiling:=false; // a 32 or 64bit IDE is more a flavor than cross compiling
672 end;
673 end;
674
675 if IsCrossCompiling then
676 begin
677 // Case 2. crosscompiling the IDE
678 // lazarus.exe to <primary config dir>/bin/<fTargetCPU>-<fTargetOS>
679 fTargetDir:=AppendPathDelim(GetPrimaryConfigPath)+'bin'
680 +PathDelim+fTargetCPU+'-'+fTargetOS;
681 // ppu files to <primary config dir>/units/<fTargetCPU>-<fTargetOS>/<LCLWidgetType>
682 fUnitOutDir:=AppendPathDelim(GetPrimaryConfigPath)+'units'
683 +PathDelim+fTargetCPU+'-'+fTargetOS+PathDelim+TargetLCLPlatform;
684 debugln('Hint: (lazarus) [CalcTargets] Cross Compiling TargetOS=',fProfile.FPCTargetOS,' TargetCPU=',
685 fProfile.FPCTargetCPU,' CompilerDefaultOS=',fCompilerTargetOS,' CompilerDefaultCPU=',fCompilerTargetCPU);
686 end else begin
687 // -> normal compile for this platform
688
689 // get lazarus directory
690 fTargetDir:=LazDir;
691 if (fTargetDir<>'') and DirPathExists(fTargetDir) then
692 begin
693 if not DirectoryIsWritableCached(fTargetDir) then begin
694 // Case 3. the lazarus directory is not writable
695 // lazarus.exe to <primary config dir>/bin/
696 // ppu files to <primary config dir>/units/<fTargetCPU>-<fTargetOS>/<LCLWidgetType>
697 fUpdateRevInc:=false;
698 fTargetDir:=AppendPathDelim(GetPrimaryConfigPath)+'bin';
699 debugln('Hint: (lazarus) [CalcTargets] Lazarus directory is readonly, using fallback target directory: ',fTargetDir);
700 fUnitOutDir:=AppendPathDelim(GetPrimaryConfigPath)+'units'
701 +PathDelim+fTargetCPU+'-'+fTargetOS+PathDelim+TargetLCLPlatform;
702 end else begin
703 // Case 4. the lazarus directory is writable
704 // ppu files to <lazarusdir>/units/<fTargetCPU>-<fTargetOS>/<LCLWidgetType>
705 fUnitOutDir:=AppendPathDelim(fTargetDir)+'units'
706 +PathDelim+fTargetCPU+'-'+fTargetOS+PathDelim+TargetLCLPlatform;
707 end;
708 end else begin
709 // lazarus dir is not valid (probably someone is experimenting)
710 // -> just compile to current directory
711 fTargetDir:='';
712 end;
713 end;
714 end;
715
716 // compute TargetFilename
717 if not FilenameIsAbsolute(fTargetDir) then
718 fTargetDir:=TrimFilename(AppendPathDelim(LazDir)+fTargetDir);
719 if fTargetFilename='' then
720 fTargetFilename:='lazarus'+GetExecutableExt(fTargetOS);
721 if not FilenameIsAbsolute(fTargetFilename) then
722 fTargetFilename:=TrimFilename(AppendPathDelim(fTargetDir)+fTargetFilename);
723
724 // check if target file is default
725 fOutputDirRedirected:=CompareFilenames(ChompPathDelim(LazDir),
726 ChompPathDelim(fTargetDir))<>0;
727
728 // append target options
729 if not (blfUseMakeIDECfg in Flags) then
730 begin
731 if fTargetOS<>fCompilerTargetOS then
732 AppendExtraOption('-T'+fTargetOS);
733 if fTargetCPU<>fCompilerTargetCPU then
734 AppendExtraOption('-P'+fTargetCPU);
735
736 if fUnitOutDir<>'' then
737 // FPC interpretes '\ ' as an escape for a space in a path on Windows,
738 // so make sure the directory doesn't end with the path delimiter.
739 AppendExtraOption('-FU'+ChompPathDelim(fUnitOutDir));
740
741 //debugln(['TLazarusBuilder.CreateIDEMakeOptions fTargetDir=',fTargetDir,' fOutputDirRedirected=',fOutputDirRedirected,' fTargetFilename=',fTargetFilename]);
742 if fOutputDirRedirected then
743 // FPC interpretes '\ ' as an escape for a space in a path on Windows,
744 // so make sure the directory doesn't end with the path delimiter.
745 AppendExtraOption('-FE'+ChompPathDelim(fTargetDir));
746
747 // Important: Do not append -o here, because if the old exe cannot be
748 // renamed/deleted it needs to be changed.
749 end;
750
751 //DebugLn(['CreateIDEMakeOptions ',MMDef.Name,' ',fExtraOptions]);
752 end;
753
754 procedure TLazarusBuilder.BackupExe(Flags: TBuildLazarusFlags);
755 { Try to delete old backups and try to rename old exe.
756 Some OS (Win) locks the exe while running, so it cannot be deleted.
757 Some OS (Win XP) forbids renaming while exe is running.
758 }
759 var
760 Ext: String;
761 BackupFilename: String;
762 Backup2Filename: String;
763 AltFilename: String;
764 begin
765 if not FileExistsUTF8(fTargetFilename) then exit;
766 // the exe already exists
767 Ext:=ExtractFileExt(fTargetFilename);
768 AltFilename:=LeftStr(fTargetFilename,length(fTargetFilename)-length(Ext))+'.new'+Ext;
769 if blfBackupOldExe in Flags then begin
770 // first try to delete the lazarus.new exe, so that users/startlazarus are
771 // not confused which one is the newest.
772 // This may fail if OS has locked the exe.
773 if FileExistsUTF8(AltFilename) then begin
774 if DeleteFileUTF8(AltFilename) then
775 debugln(['Note: (lazarus) deleted file "',AltFilename,'"'])
776 else
777 debugln(['Warning: (lazarus) unable to delete file "',AltFilename,'"']);
778 end;
779
780 // try to rename the old exe
781 BackupFilename:=GetBackupExeFilename(fTargetFilename);
782 if FileExistsUTF8(BackupFilename) then begin
783 if DeleteFileUTF8(BackupFilename) then begin
784 debugln(['Note: (lazarus) deleted backup "',BackupFilename,'"']);
785 end else begin
786 // unable to delete old backup file, maybe an old IDE is still running
787 // => try to backup the backup
788 Backup2Filename:=LeftStr(fTargetFilename,length(fTargetFilename)-length(Ext))+'.old2'+Ext;
789 if FileExistsUTF8(Backup2Filename) then begin
790 if DeleteFileUTF8(Backup2Filename) then
791 debugln(['Note: (lazarus) deleted backup "',Backup2Filename,'"'])
792 else
793 debugln(['Warning: (lazarus) unable to delete old backup file "'+Backup2Filename+'"']);
794 end;
795 if not FileExistsUTF8(Backup2Filename) then begin
796 if RenameFileUTF8(BackupFilename,Backup2Filename) then
797 debugln(['Note: (lazarus) renamed old backup file "'+BackupFilename+'" to "',Backup2Filename,'"'])
798 else
799 debugln(['Warning: (lazarus) unable to rename old backup file "'+BackupFilename+'" to "',Backup2Filename,'"']);
800 end;
801 end;
802 end;
803 if not FileExistsUTF8(BackupFilename) then begin
804 if RenameFileUTF8(fTargetFilename,BackupFilename) then
805 debugln(['Note: (lazarus) renamed file "'+fTargetFilename+'" to "',BackupFilename,'"'])
806 else
807 debugln(['Warning: (lazarus) unable to rename file "'+fTargetFilename+'" to "',BackupFilename,'"']);
808 end;
809
810 if FileExistsUTF8(fTargetFilename)
811 and FileExistsUTF8(AltFilename) then begin
812 IDEMessageDialog('Delete Error','Unable to rename'#13
813 +fTargetFilename+#13
814 +'and unable to delete'#13
815 +AltFilename+#13
816 +'One of them must be gone, before building the IDE. Maybe you have another IDE still running?',mtError,[mbCancel]);
817 exit;
818 end;
819 end;
820 if FileExistsUTF8(fTargetFilename) then
821 fTargetFilename:=AltFilename; // backup didn't work => use another file name
822 end;
823
CreateAppleBundlenull824 function TLazarusBuilder.CreateAppleBundle: TModalResult;
825 var
826 BundleDir: String;
827 begin
828 Result:=mrOk;
829 BundleDir:=ChangeFileExt(fTargetFilename,'.app');
830 //debugln(['CreateAppleBundle checking bundle ',BundleDir]);
831 if not FileExistsCached(BundleDir) then begin
832 //debugln(['CreateAppleBundle TargetFile=',fTargetFilename]);
833 Result:=CreateApplicationBundle(fTargetFilename, 'Lazarus');
834 if not (Result in [mrOk,mrIgnore]) then begin
835 debugln(['Error: (lazarus) unable to create application bundle']);
836 if IDEMessagesWindow<>nil then
837 IDEMessagesWindow.AddCustomMessage(mluError,'to create application bundle '+BundleDir);
838 exit;
839 end;
840 Result:=CreateAppBundleSymbolicLink(fTargetFilename);
841 if not (Result in [mrOk,mrIgnore]) then begin
842 debugln(['Error: (lazarus) unable to create symlink in application bundle: ',fTargetFilename]);
843 if IDEMessagesWindow<>nil then
844 IDEMessagesWindow.AddCustomMessage(mluError,'failed to create application bundle symlink to '+fTargetFilename);
845 exit;
846 end;
847 end;
848 end;
849
850 procedure TLazarusBuilder.AppendExtraOption(const aOption: string; AutoQuote: boolean);
851 begin
852 if aOption='' then exit;
853 if fExtraOptions<>'' then
854 fExtraOptions:=fExtraOptions+' ';
855 if AutoQuote and (pos(' ',aOption)>0) then
856 fExtraOptions:=fExtraOptions+AnsiQuotedStr(aOption,'"')
857 else
858 fExtraOptions:=fExtraOptions+aOption;
859 //DebugLn(['AppendExtraOption ',fExtraOptions]);
860 end;
861
PrepareTargetDirnull862 function TLazarusBuilder.PrepareTargetDir(Flags: TBuildLazarusFlags): TModalResult;
863 begin
864 // backup old exe
865 BackupExe(Flags);
866
867 // create output directories
868 if fOutputDirRedirected then begin
869 Result:=ForceDirectoryInteractive(fTargetDir,[]);
870 if Result<>mrOk then exit;
871 end;
872 if fUnitOutDir<>'' then begin
873 Result:=ForceDirectoryInteractive(fUnitOutDir,[]);
874 if Result<>mrOk then exit;
875 end;
876
877 // create apple bundle if needed
878 //debugln(['CreateIDEMakeOptions NewTargetDirectory=',fTargetDir]);
879 if (CompareText(fTargetOS,'darwin')=0)
880 and fOutputDirRedirected and DirectoryIsWritableCached(fTargetDir) then
881 begin
882 Result:=CreateAppleBundle;
883 if not (Result in [mrOk,mrIgnore]) then Exit;
884 end;
885
886 Result:=mrOk;
887 end;
888
TLazarusBuilder.IsWriteProtectednull889 function TLazarusBuilder.IsWriteProtected(Profile: TBuildLazarusProfile): Boolean;
890 // Returns True if Lazarus installation directory is write protected. Now uses OutputDirRedirected info.
891 begin
892 fProfile:=Profile;
893 if CalcTargets([])<>mrOk then exit(false);
894 Result:=fOutputDirRedirected;
895 end;
896
BreakExtraOptionsnull897 function TLazarusBuilder.BreakExtraOptions: string;
898 var
899 StartPos: Integer;
900 EndPos: Integer;
901 c: Char;
902 CurLine: String;
903 begin
904 Result:='';
905 // write each option into a line of its own
906 StartPos:=1;
907 repeat
908 while (StartPos<=length(fExtraOptions)) and (fExtraOptions[StartPos]=' ') do
909 inc(StartPos);
910 EndPos:=StartPos;
911 while EndPos<=length(fExtraOptions) do begin
912 c:=fExtraOptions[EndPos];
913 case c of
914 ' ': break;
915
916 '''','"','`':
917 begin
918 repeat
919 inc(EndPos);
920 if (fExtraOptions[EndPos]=c) then begin
921 inc(EndPos);
922 break;
923 end;
924 until (EndPos>length(fExtraOptions));
925 end;
926
927 else
928 inc(EndPos);
929 end;
930 end;
931 if (EndPos>StartPos) then begin
932 CurLine:=Trim(copy(fExtraOptions,StartPos,EndPos-StartPos));
933 if (length(CurLine)>2) and (CurLine[1] in ['''','"','`'])
934 and (CurLine[1]=CurLine[length(CurLine)]) then begin
935 // whole line enclosed in quotation marks
936 // in fpc config this is forbidden and gladfully unncessary
937 CurLine:=copy(CurLine,2,length(CurLine)-2);
938 end;
939 Result:=Result+CurLine+LineEnding;
940 end;
941 StartPos:=EndPos;
942 until StartPos>length(fExtraOptions);
943 end;
944
SaveIDEMakeOptionsnull945 function TLazarusBuilder.SaveIDEMakeOptions(Profile: TBuildLazarusProfile;
946 Flags: TBuildLazarusFlags): TModalResult;
947 var
948 Filename: String;
949 fs: TFileStream;
950 OptionsAsText: String;
951 begin
952 Result:=mrCancel;
953 fProfile:=Profile;
954 if CalcTargets(Flags-[blfUseMakeIDECfg])<>mrOk then exit;
955
956 Result:=PrepareTargetDir(Flags);
957 if Result<>mrOk then exit;
958 Filename:=GetMakeIDEConfigFilename;
959 try
960 InvalidateFileStateCache;
961 fs:=TFileStream.Create(Filename,fmCreate);
962 try
963 if fExtraOptions<>'' then begin
964 // FPC expects console codepage for command line params
965 // and system codepage in config files
966 OptionsAsText:=UTF8ToWinCP(BreakExtraOptions);
967 fs.Write(OptionsAsText[1],length(OptionsAsText));
968 end;
969 finally
970 fs.Free;
971 end;
972 except
973 on E: Exception do begin
974 Result:=IDEMessageDialog(lisLazBuildErrorWritingFile,
975 Format(lisLazBuildUnableToWriteFile, [Filename, LineEnding])
976 +E.Message,
977 mtError,[mbCancel,mbAbort]);
978 exit;
979 end;
980 end;
981 Result:=mrOk;
982 end;
983
984 { TConfigureBuildLazarusDlg }
985
986 constructor TConfigureBuildLazarusDlg.Create(TheOwner: TComponent);
987 begin
988 inherited Create(TheOwner);
989 fProfiles:=TBuildLazarusProfiles.Create;
990 fUpdatingProfileCombo:=False;
991 end;
992
993 destructor TConfigureBuildLazarusDlg.Destroy;
994 begin
995 FreeAndNil(fProfiles);
996 inherited Destroy;
997 end;
998
999 procedure TConfigureBuildLazarusDlg.FormCreate(Sender: TObject);
1000 var
1001 LCLInterface: TLCLPlatform;
1002 begin
1003 IDEDialogLayoutList.ApplyLayout(Self,700,480);
1004
1005 Caption := lisConfigureBuildLazarus;
1006 PageControl1.ActivePage:=BuildTabSheet;
1007 BuildTabSheet.Caption:=lisBuildCaption;
1008
1009 // Show Build target names in combobox.
1010 LCLWidgetTypeLabel.Caption := lisLCLWidgetType;
1011 for LCLInterface:=Low(TLCLPlatform) to High(TLCLPlatform) do
1012 LCLWidgetTypeComboBox.Items.Add(LCLPlatformDisplayNames[LCLInterface]);
1013
1014 BuildProfileLabel.Caption:=lisLazBuildProfile;
1015 BuildProfileButton.Hint := lisLazBuildManageProfiles2;
1016 BuildProfileComboBox.Hint := lisLazBuildNameOfTheActiveProfile;
1017 OptionsLabel.Caption := lisLazBuildOptions;
1018 TargetOSLabel.Caption := lisLazBuildTargetOS;
1019 TargetCPULabel.Caption := lisLazBuildTargetCPU;
1020 TargetDirectoryLabel.Caption := lisLazBuildTargetDirectory;
1021
1022 DefinesListBox.Hint := lisLazBuildDefinesWithoutD;
1023 DefinesLabel.Caption := lisLazBuildDefines;
1024 DefinesButton.Caption := lisLazBuildEditDefines;
1025 DefinesButton.Hint := lisLazBuildEditListOfDefinesWhichCanBeUsedByAnyProfile;
1026
1027 CleanUpGroupBox.Caption:=lisCleanUp;
1028 CleanAutoRadioButton.Caption:=lisAutomatically;
1029 CleanCommonRadioButton.Caption:=lisCleanCommonFiles;
1030 CleanAllRadioButton.Caption:=lisCleanAll;
1031 CleanOnceCheckBox.Caption:=lisCleanOnlyOnce;
1032 CleanOnceCheckBox.Hint:=lisAfterCleaningUpSwitchToAutomaticClean;
1033 CleanCommonCheckBox.Caption:=lisCleanCommonFiles;
1034
1035 UpdateRevisionIncCheckBox.Caption := lisLazBuildUpdateRevInc;
1036 UpdateRevisionIncCheckBox.Hint := lisLazBuildUpdateRevisionInfoInAboutLazarusDialog;
1037
1038 CommonsDividerBevel.Caption := lisLazBuildCommonSettings;
1039 RestartAfterBuildCheckBox.Caption := lisLazBuildRestartAfterBuild;
1040 RestartAfterBuildCheckBox.Hint := lisLazBuildRestartLazarusAutomatically;
1041 ConfirmBuildCheckBox.Caption := lisLazBuildConfirmBuild;
1042 ConfirmBuildCheckBox.Hint := lisLazBuildShowConfirmationDialogWhenBuilding;
1043
1044 CompileButton.Caption := lisBuild;
1045 IDEImages.AssignImage(CompileButton, 'menu_build');
1046 CompileAdvancedButton.Caption := lisLazBuildBuildMany;
1047 IDEImages.AssignImage(CompileAdvancedButton, 'menu_build_all');
1048 SaveSettingsButton.Caption := lisSaveSettings;
1049 SaveSettingsButton.LoadGlyphFromStock(idButtonSave);
1050 if SaveSettingsButton.Glyph.Empty then
1051 IDEImages.AssignImage(SaveSettingsButton, 'laz_save');
1052 CancelButton.Caption := lisCancel;
1053 HelpButton.Caption := lisMenuHelp;
1054
1055 OptionsMemo.Hint := lisLazBuildOptionsPassedToCompiler;
1056 ShowOptsMenuItem.Caption := lisLazBuildShowOptionsAndDefinesForCommandLine;
1057
1058 with TargetOSComboBox do
1059 begin
1060 with Items do begin
1061 Add(''); //('+rsiwpDefault+')');
1062 Add('Darwin');
1063 Add('FreeBSD');
1064 Add('Linux');
1065 Add('NetBSD');
1066 Add('OpenBSD');
1067 Add('DragonFly');
1068 Add('Solaris');
1069 Add('Win32');
1070 Add('Win64');
1071 Add('WinCE');
1072 Add('Go32v2');
1073 Add('OS2');
1074 Add('BeOS');
1075 Add('Haiku');
1076 Add('QNX');
1077 Add('NetWare');
1078 Add('wdosx');
1079 Add('emx');
1080 Add('Watcom');
1081 Add('NetwLibC');
1082 Add('Amiga');
1083 Add('AROS');
1084 Add('Atari');
1085 Add('PalmOS');
1086 Add('GBA');
1087 Add('NDS');
1088 Add('MacOS');
1089 Add('MorphOS');
1090 Add('Embedded');
1091 Add('Symbian');
1092 Add('MSDOS');
1093 Add('Wii');
1094 Add('iOS');
1095 end;
1096 ItemIndex:=0;
1097 end;
1098
1099 with TargetCPUComboBox do begin
1100 with Items do begin
1101 Add(''); //('+rsiwpDefault+')');
1102 Add('aarch64');
1103 Add('arm');
1104 Add('i386');
1105 Add('m68k');
1106 Add('powerpc');
1107 Add('powerpc64');
1108 Add('sparc');
1109 Add('x86_64');
1110 end;
1111 ItemIndex:=0;
1112 end;
1113
1114 SetupInfoPage;
1115 BuildProfileComboBox.DropDownCount:=EnvironmentOptions.DropDownCount;
1116 LCLWidgetTypeComboBox.DropDownCount:=EnvironmentOptions.DropDownCount;
1117 TargetOSComboBox.DropDownCount:=EnvironmentOptions.DropDownCount;
1118 TargetCPUComboBox.DropDownCount:=EnvironmentOptions.DropDownCount;
1119 TargetDirectoryComboBox.DropDownCount:=EnvironmentOptions.DropDownCount;
1120 end;
1121
1122 procedure TConfigureBuildLazarusDlg.FormResize(Sender: TObject);
1123 begin
1124 LCLWidgetTypeComboBox.Width:=(OptionsMemo.Width - 12) div 3;
1125 TargetOSComboBox.Width:=LCLWidgetTypeComboBox.Width;
1126 DefinesListBox.Width:=(OptionsMemo.Width - 6) div 2;
1127 end;
1128
1129 procedure TConfigureBuildLazarusDlg.FormShow(Sender: TObject);
1130 begin
1131 UpdateProfileNamesUI;
1132 end;
1133
1134 procedure TConfigureBuildLazarusDlg.HelpButtonClick(Sender: TObject);
1135 begin
1136 LazarusHelp.ShowHelpForIDEControl(Self);
1137 end;
1138
1139 procedure TConfigureBuildLazarusDlg.ShowOptsMenuItemClick(Sender: TObject);
1140 begin
1141 CopyUIToProfile(fProfiles.Current);
1142 ShowMessage(fProfiles.Current.ExtraOptions);
1143 end;
1144
1145 procedure TConfigureBuildLazarusDlg.TargetDirectoryButtonClick(Sender: TObject);
1146 var
1147 DirDialog: TSelectDirectoryDialog;
1148 lExpandedName: string;
1149 lDirName, lDirNameF: string;
1150 begin
1151 DirDialog:=TSelectDirectoryDialog.Create(nil);
1152 try
1153 DirDialog.Options:=DirDialog.Options+[ofPathMustExist];
1154 DirDialog.Title:=lisLazBuildABOChooseOutputDir+'(lazarus'+
1155 GetExecutableExt(fProfiles.Current.FPCTargetOS)+')';
1156
1157 { Setup directory path }
1158 lDirName:=EnvironmentOptions.GetParsedValue(eopLazarusDirectory, TargetDirectoryComboBox.Text);
1159 lExpandedName:=CleanAndExpandDirectory(lDirName);
1160 lDirName:=GetValidDirectoryAndFilename(lDirName, lDirNameF);
1161
1162 DirDialog.InitialDir:=IncludeTrailingBackslash(lDirName);
1163 DirDialog.FileName:=lDirNameF;
1164
1165 if DirDialog.Execute then begin
1166 lDirName:=CleanAndExpandDirectory(DirDialog.Filename);
1167 { ~bk Here I wanted to keeep Macros but it doesn't seem to work
1168 if UpperCase(lDirName)<>UpperCase(lExpandedName) then }
1169 TargetDirectoryComboBox.AddHistoryItem(lDirName,10,true,true);
1170 end;
1171 finally
1172 DirDialog.Free;
1173 end;
1174 end;
1175
1176 procedure TConfigureBuildLazarusDlg.CopyProfileToUI(AProfile: TBuildLazarusProfile);
1177 var
1178 i: Integer;
1179 begin
1180 CleanAutoRadioButton.OnClick:=Nil;
1181 CleanCommonRadioButton.OnClick:=Nil;
1182 CleanAllRadioButton.OnClick:=Nil;
1183 CleanCommonCheckBox.OnClick:=Nil;
1184 try
1185 LCLWidgetTypeComboBox.ItemIndex :=ord(AProfile.TargetPlatform);
1186 UpdateRevisionIncCheckBox.Checked :=AProfile.UpdateRevisionInc;
1187 TargetOSComboBox.Text :=AProfile.TargetOS;
1188 TargetDirectoryComboBox.Text :=AProfile.TargetDirectory;
1189 TargetCPUComboBox.Text :=AProfile.TargetCPU;
1190 case AProfile.IdeBuildMode of
1191 bmBuild: CleanAutoRadioButton.Checked:=true;
1192 bmCleanBuild: CleanCommonRadioButton.Checked:=true;
1193 bmCleanAllBuild: CleanAllRadioButton.Checked:=true;
1194 end;
1195 CleanCommonCheckBox.Checked := AProfile.IdeBuildMode=bmCleanAllBuild;
1196 CleanOnceCheckBox.Checked:=AProfile.CleanOnce;
1197 OptionsMemo.Lines.Assign(AProfile.OptionsLines);
1198 for i:=0 to DefinesListBox.Items.Count-1 do
1199 DefinesListBox.Checked[i]:=AProfile.Defines.IndexOf(DefinesListBox.Items[i]) > -1;
1200 finally
1201 CleanAutoRadioButton.OnClick:=@CleanRadioButtonClick;
1202 CleanCommonRadioButton.OnClick:=@CleanRadioButtonClick;
1203 CleanAllRadioButton.OnClick:=@CleanRadioButtonClick;
1204 CleanCommonCheckBox.OnClick:=@CleanCommonCheckBoxClick;
1205 end;
1206 end;
1207
1208 procedure TConfigureBuildLazarusDlg.CopyUIToProfile(AProfile: TBuildLazarusProfile);
1209 var
1210 i: Integer;
1211 begin
1212 AProfile.TargetPlatform :=TLCLPlatform(LCLWidgetTypeComboBox.ItemIndex);
1213 AProfile.UpdateRevisionInc :=UpdateRevisionIncCheckBox.Checked;
1214 AProfile.TargetOS :=TargetOSComboBox.Text;
1215 AProfile.TargetDirectory :=TargetDirectoryComboBox.Text;
1216 AProfile.TargetCPU :=TargetCPUComboBox.Text;
1217 if CleanAllRadioButton.Checked then
1218 AProfile.IdeBuildMode := bmCleanAllBuild
1219 else if CleanCommonRadioButton.Checked then
1220 AProfile.IdeBuildMode := bmCleanBuild
1221 else
1222 AProfile.IdeBuildMode := bmBuild;
1223 AProfile.CleanOnce:=CleanOnceCheckBox.Checked;
1224 AProfile.OptionsLines.Assign(OptionsMemo.Lines);
1225 AProfile.Defines.Clear;
1226 for i:=0 to DefinesListBox.Items.Count-1 do
1227 if DefinesListBox.Checked[i] then
1228 AProfile.Defines.Add(DefinesListBox.Items[i]);
1229 end;
1230
1231 procedure TConfigureBuildLazarusDlg.UpdateProfileNamesUI;
1232 var
1233 i: Integer;
1234 begin
1235 // List of defines to checklistbox.
1236 DefinesListBox.Items.Clear;
1237 for i:=0 to fProfiles.AllDefines.Count-1 do
1238 DefinesListBox.Items.Add(fProfiles.AllDefines[i]);
1239 // Update the Profiles ComboBox.
1240 fUpdatingProfileCombo:=True;
1241 BuildProfileComboBox.Items.BeginUpdate;
1242 BuildProfileComboBox.Items.Clear;
1243 for i:=0 to fProfiles.Count-1 do
1244 BuildProfileComboBox.Items.Add(fProfiles[i].Name);
1245 BuildProfileCombobox.ItemIndex:=fProfiles.CurrentIndex;
1246 CopyProfileToUI(fProfiles.Current); // Copy current selection to UI.
1247 ShowHideCleanup(not fBuilder.IsWriteProtected(fProfiles.Current));
1248 BuildProfileComboBox.Items.EndUpdate;
1249 fUpdatingProfileCombo:=False;
1250 RestartAfterBuildCheckBox.Checked:=fProfiles.RestartAfterBuild;
1251 ConfirmBuildCheckBox.Checked :=fProfiles.ConfirmBuild;
1252 end;
1253
1254 procedure TConfigureBuildLazarusDlg.SetupInfoPage;
1255 begin
1256 InfoTabSheet.Caption:=lisInformation;
1257
1258 fImageIndexPackage := IDEImages.LoadImage('item_package');
1259 fImageIndexRequired := IDEImages.LoadImage('pkg_required');
1260 fImageIndexInherited := IDEImages.LoadImage('pkg_inherited');
1261 InhTreeView.Images := IDEImages.Images_16;
1262
1263 UpdateInheritedTree;
1264 end;
1265
1266 procedure TConfigureBuildLazarusDlg.UpdateInheritedTree;
1267 var
1268 AncestorNode: TTreeNode;
1269
1270 procedure AddChildNode(const NewNodeName, Value: string);
1271 var
1272 VisibleValue: string;
1273 ChildNode: TTreeNode;
1274 begin
1275 VisibleValue := UTF8Trim(Value);
1276 if VisibleValue = '' then
1277 exit;
1278 ChildNode := InhTreeView.Items.AddChild(AncestorNode,
1279 NewNodeName + ' = "' + VisibleValue + '"');
1280 ChildNode.ImageIndex := fImageIndexRequired;
1281 ChildNode.SelectedIndex := ChildNode.ImageIndex;
1282 end;
1283
1284 var
1285 PkgList: TFPList;
1286 i: Integer;
1287 Pkg: TLazPackage;
1288 AncestorOptions: TPkgAdditionalCompilerOptions;
1289 LazDir: String;
1290 begin
1291 PkgList:=nil;
1292 InhTreeView.BeginUpdate;
1293 LazDir:=EnvironmentOptions.GetParsedLazarusDirectory;
1294 try
1295 PackageGraph.GetAllRequiredPackages(nil,
1296 PackageGraph.FirstAutoInstallDependency,PkgList,[pirSkipDesignTimeOnly]);
1297
1298 // add detail nodes
1299 if PkgList<>nil then
1300 for i := 0 to PkgList.Count - 1 do
1301 begin
1302 Pkg:=TLazPackage(PkgList[i]);
1303 AncestorOptions := Pkg.UsageOptions;
1304 AncestorNode := InhTreeView.Items.Add(nil, '');
1305 AncestorNode.Text := AncestorOptions.GetOwnerName;
1306 AncestorNode.ImageIndex := fImageIndexPackage;
1307 AncestorNode.SelectedIndex := AncestorNode.ImageIndex;
1308 with AncestorOptions.ParsedOpts do
1309 begin
1310 AddChildNode(lisunitPath,
1311 CreateRelativeSearchPath(GetParsedValue(pcosUnitPath),LazDir));
1312 AddChildNode(lisincludePath,
1313 CreateRelativeSearchPath(GetParsedValue(pcosIncludePath),LazDir));
1314 AddChildNode(lisobjectPath,
1315 CreateRelativeSearchPath(GetParsedValue(pcosObjectPath),LazDir));
1316 AddChildNode(lislibraryPath,
1317 CreateRelativeSearchPath(GetParsedValue(pcosLibraryPath),LazDir));
1318 AddChildNode(lislinkerOptions, GetParsedValue(pcosLinkerOptions));
1319 AddChildNode(liscustomOptions, GetParsedValue(pcosCustomOptions));
1320 end;
1321 AncestorNode.Expanded := True;
1322 end;
1323 finally
1324 InhTreeView.EndUpdate;
1325 PkgList.Free;
1326 end;
1327 end;
1328
1329 procedure TConfigureBuildLazarusDlg.PrepareClose;
1330 begin
1331 CopyUIToProfile(fProfiles.Current);
1332 fProfiles.RestartAfterBuild :=RestartAfterBuildCheckBox.Checked;
1333 fProfiles.ConfirmBuild :=ConfirmBuildCheckBox.Checked;
1334 MainIDEBar.itmToolBuildLazarus.Caption:=
1335 Format(lisMenuBuildLazarusProf, [fProfiles.Current.Name]);
1336 end;
1337
1338 procedure TConfigureBuildLazarusDlg.ShowHideCleanup(aShow: Boolean);
1339 // When target directory is read-only, hide Radiobuttons and show a single checkbox.
1340 begin
1341 CleanAutoRadioButton.Visible:=aShow;
1342 CleanCommonRadioButton.Visible:=aShow;
1343 CleanAllRadioButton.Visible:=aShow;
1344 CleanOnceCheckBox.Visible:=aShow;
1345 CleanCommonCheckBox.Visible:=not aShow;
1346 end;
1347
1348 procedure TConfigureBuildLazarusDlg.CompileAdvancedButtonClick(Sender: TObject);
1349 // mrOk=change selected profiles. Selected profiles will be saved or discarded
1350 // depending on the calling dialog
1351 // mrYes=save and compile
1352 // mrCancel=do nothing
1353 var
1354 EditForm: TGenericCheckListForm;
1355 i, ind: Integer;
1356 begin
1357 PrepareClose;
1358 // Add a button for building all.
1359 EditForm:=TGenericCheckListForm.CreateWithActionButton(lisBuild, 'menu_build');
1360 try
1361 EditForm.Caption:=lisLazBuildSelectProfilesToBuild;
1362 // Copy profile names to checkboxlist and check the previously selected ones.
1363 for i:=0 to fProfiles.Count-1 do begin
1364 ind:=EditForm.CheckListBox1.Items.Add(fProfiles[i].Name);
1365 if fProfiles.Selected.IndexOf(fProfiles[i].Name)>-1 then
1366 EditForm.CheckListBox1.Checked[ind]:=True;
1367 end;
1368 // Show the form.
1369 EditForm.ShowModal;
1370 if EditForm.ModalResult in [mrOK, mrYes] then begin
1371 // Copy checked profile names to Selected.
1372 fProfiles.Selected.Clear;
1373 for i:=0 to fProfiles.Count-1 do begin // fProfiles and CheckListBox1
1374 if EditForm.CheckListBox1.Checked[i] then // indexes match now.
1375 fProfiles.Selected.Add(fProfiles[i].Name);
1376 end;
1377 end;
1378 if EditForm.ModalResult=mrYes then
1379 ModalResult:=mrAll;
1380 finally
1381 EditForm.Free;
1382 end;
1383 end;
1384
1385 procedure TConfigureBuildLazarusDlg.CompileButtonClick(Sender: TObject);
1386 begin
1387 PrepareClose;
1388 ModalResult:=mrYes;
1389 end;
1390
1391 procedure TConfigureBuildLazarusDlg.SaveSettingsButtonClick(Sender: TObject);
1392 begin
1393 PrepareClose;
1394 ModalResult:=mrOk;
1395 end;
1396
1397 procedure TConfigureBuildLazarusDlg.DefinesButtonClick(Sender: TObject);
1398 var
1399 EditForm: TGenericListEditForm;
1400 i: Integer;
1401 begin
1402 EditForm:=TGenericListEditForm.Create(Nil);
1403 try
1404 EditForm.Caption:=lisLazBuildEditDefines;
1405 EditForm.Memo1.Lines.Assign(fProfiles.AllDefines);
1406 if EditForm.ShowModal=mrOK then begin
1407 CopyUIToProfile(fProfiles.Current); // Make sure changed fields don't get lost.
1408 fProfiles.AllDefines.Assign(EditForm.Memo1.Lines);
1409 DefinesListBox.Items.Clear;
1410 for i:=0 to fProfiles.AllDefines.Count-1 do
1411 DefinesListBox.Items.Add(fProfiles.AllDefines[i]);
1412 for i:=0 to DefinesListBox.Items.Count-1 do // Check the right boxes again.
1413 DefinesListBox.Checked[i]:=fProfiles.Current.Defines.IndexOf(DefinesListBox.Items[i]) > -1;
1414 end;
1415 finally
1416 EditForm.Free;
1417 end;
1418 end;
1419
1420 procedure TConfigureBuildLazarusDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
1421 begin
1422 IDEDialogLayoutList.SaveLayout(Self);
1423 end;
1424
1425 procedure TConfigureBuildLazarusDlg.BuildProfileButtonClick(Sender: TObject);
1426 var
1427 Frm: TBuildProfileManagerForm;
1428 begin
1429 Frm:=TBuildProfileManagerForm.Create(nil);
1430 try
1431 CopyUIToProfile(fProfiles.Current); // Make sure changed fields get included.
1432 Frm.Prepare(fProfiles); // Copy profiles to dialog.
1433 if Frm.ShowModal = mrOk then begin
1434 fProfiles.Assign(Frm.ProfsToManage); // Copy profiles back from dialog.
1435 UpdateProfileNamesUI;
1436 end;
1437 finally
1438 Frm.Free;
1439 end;
1440 end;
1441
1442 procedure TConfigureBuildLazarusDlg.BuildProfileComboBoxSelect(Sender: TObject);
1443 begin
1444 // QT binding calls this also when items are added to list. It shouldn't.
1445 if (fProfiles.Count=0) or fUpdatingProfileCombo then Exit;
1446 if (Sender as TComboBox).ItemIndex=-1 then Exit;
1447 CopyUIToProfile(fProfiles.Current); // Save old selection from UI.
1448 fProfiles.CurrentIndex:=(Sender as TComboBox).ItemIndex;
1449 CopyProfileToUI(fProfiles.Current); // Copy new selection to UI.
1450 ShowHideCleanup(not fBuilder.IsWriteProtected(fProfiles.Current));
1451 end;
1452
1453 procedure TConfigureBuildLazarusDlg.CleanRadioButtonClick(Sender: TObject);
1454 begin
1455 CleanCommonCheckBox.Checked:=CleanAllRadioButton.Checked;
1456 //DebugLn(['TConfigureBuildLazarusDlg.CleanRadioButtonClick: set CleanCommonCheckBox to ', CleanCommonRadioButton.Checked]);
1457 end;
1458
1459 procedure TConfigureBuildLazarusDlg.CleanCommonCheckBoxClick(Sender: TObject);
1460 begin
1461 if CleanCommonCheckBox.Checked then
1462 CleanAllRadioButton.Checked:=True
1463 else
1464 CleanAutoRadioButton.Checked:=True;
1465 //DebugLn(['TConfigureBuildLazarusDlg.CleanCommonCheckBoxClick: set CleanCommonRadioButton to ', CleanCommonCheckBox.Checked]);
1466 end;
1467
1468 end.
1469
1470