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