1 {
2 /***************************************************************************
3 buildmanager.pas
4 ----------------
5
6
7 ***************************************************************************/
8
9 ***************************************************************************
10 * *
11 * This source is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 * This code is distributed in the hope that it will be useful, but *
17 * WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
19 * General Public License for more details. *
20 * *
21 * A copy of the GNU General Public License is available on the World *
22 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
23 * obtain it by writing to the Free Software Foundation, *
24 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
25 * *
26 ***************************************************************************
27 }
28 unit BuildManager;
29
30 {$mode objfpc}{$H+}
31
32 {off $DEFINE VerboseFPCSrcScan}
33
34 interface
35
36 uses
37 // RTL + FCL
38 Classes, SysUtils, Laz_AVL_Tree,
39 // LCL
40 InterfaceBase, LCLPlatformDef, Dialogs, Forms, Controls,
41 // CodeTools
42 ExprEval, BasicCodeTools, CodeToolManager, DefineTemplates, CodeCache,
43 FileProcs, CodeToolsCfgScript, LinkScanner,
44 // LazUtils
45 LConvEncoding, FileUtil, LazFileUtils, LazFileCache, LazUTF8, Laz2_XMLCfg,
46 LazUtilities, LazStringUtils, LazMethodList,
47 // BuildIntf
48 BaseIDEIntf, IDEOptionsIntf, ProjectIntf, MacroIntf, PublishModuleIntf,
49 IDEExternToolIntf, CompOptsIntf, MacroDefIntf,
50 // IDEIntf
51 IDEDialogs, LazIDEIntf, IDEMsgIntf,
52 // IDE
53 IDECmdLine, LazarusIDEStrConsts, DialogProcs, IDEProcs,
54 InputHistory, EditDefineTree, ProjectResources, MiscOptions, LazConf,
55 EnvironmentOpts, TransferMacros, CompilerOptions,
56 ExtTools, etMakeMsgParser, etFPCMsgParser, etPas2jsMsgParser,
57 Compiler, FPCSrcScan, PackageDefs, PackageSystem, Project, ProjectIcon,
58 ModeMatrixOpts, BaseBuildManager, ApplicationBundle, RunParamsOpts;
59
60 type
61
62 { TBuildManager }
63
64 TBuildManager = class(TBaseBuildManager)
65 private
66 FBuildTarget: TProject;
67 FUnitSetCache: TFPCUnitSetCache;
68 fBuildLazExtraOptions: string; // last build lazarus extra options
69 FUnitSetChangeStamp: integer;
70 FFPCSrcScans: TFPCSrcScans;
71 FProjectNameSpace: string;
72 FProjectNameSpaceCode: TCodeBuffer;
73 FProjectNameSpaceCodeChgStep: integer;
74 // Macro FPCVer
75 FFPCVer: string;
76 FFPC_FULLVERSION: integer;
77 FFPCVerChangeStamp: integer;
78 // Macro InstantFPCCache
79 FMacroInstantFPCCache: string;
80 FMacroInstantFPCCacheValid: boolean;
81 // current target
82 fTargetOS: string;
83 fTargetCPU: string;
84 fLCLWidgetType: string;
85 // cache
86 FFPCompilerFilename: string;
87 FFPCompilerFilenameStamp: Integer;
88 procedure DoOnRescanFPCDirectoryCache(Sender: TObject);
GetTargetFilenamenull89 function GetTargetFilename: String;
90 procedure OnMacroSubstitution(TheMacro: TTransferMacro;
91 const MacroName: string; var s: string;
92 const {%H-}Data: PtrInt; var Handled, {%H-}Abort: boolean;
93 {%H-}Depth: integer);
OnSubstituteCompilerOptionnull94 function OnSubstituteCompilerOption({%H-}Options: TParsedCompilerOptions;
95 const UnparsedValue: string;
96 PlatformIndependent: boolean): string;
MacroFuncBuildModenull97 function MacroFuncBuildMode(const {%H-}Param: string; const {%H-}Data: PtrInt;
98 var {%H-}Abort: boolean): string;
MacroFuncEnvnull99 function MacroFuncEnv(const Param: string; const {%H-}Data: PtrInt;
100 var {%H-}Abort: boolean): string;
MacroFuncCompPathnull101 function MacroFuncCompPath(const {%H-}s:string; const {%H-}Data: PtrInt;
102 var {%H-}Abort: boolean): string;
MacroFuncFPCMsgFilenull103 function MacroFuncFPCMsgFile(const {%H-}Param: string; const {%H-}Data: PtrInt;
104 var {%H-}Abort: boolean): string;
MacroFuncFPCVernull105 function MacroFuncFPCVer(const {%H-}Param: string; const {%H-}Data: PtrInt;
106 var {%H-}Abort: boolean): string;
MacroFuncFPC_FULLVERSIONnull107 function MacroFuncFPC_FULLVERSION(const {%H-}Param: string; const {%H-}Data: PtrInt;
108 var {%H-}Abort: boolean): string;
MacroFuncLCLWidgetTypenull109 function MacroFuncLCLWidgetType(const {%H-}Param: string; const Data: PtrInt;
110 var {%H-}Abort: boolean): string;
MacroFuncLazVernull111 function MacroFuncLazVer(const {%H-}Param: string; const {%H-}Data: PtrInt;
112 var {%H-}Abort: boolean): string;
MacroFuncMakenull113 function MacroFuncMake(const {%H-}Param: string; const {%H-}Data: PtrInt;
114 var {%H-}Abort: boolean): string;// make utility
MacroFuncMakeExenull115 function MacroFuncMakeExe(const Filename: string; const {%H-}Data: PtrInt;
116 var {%H-}Abort: boolean): string;
MacroFuncMakeLibnull117 function MacroFuncMakeLib(const Filename: string; const {%H-}Data: PtrInt;
118 var {%H-}Abort: boolean): string;
MacroFuncInstantFPCCachenull119 function MacroFuncInstantFPCCache(const {%H-}Param: string; const {%H-}Data: PtrInt;
120 var {%H-}Abort: boolean): string;// path of the instantfpc cache
MacroFuncParamsnull121 function MacroFuncParams(const {%H-}Param: string; const {%H-}Data: PtrInt;
122 var {%H-}Abort: boolean): string;
MacroFuncProjectnull123 function MacroFuncProject(const Param: string; const {%H-}Data: PtrInt;
124 var {%H-}Abort: boolean): string;
MacroFuncProjFilenull125 function MacroFuncProjFile(const {%H-}Param: string; const {%H-}Data: PtrInt;
126 var {%H-}Abort: boolean): string;
MacroFuncProjIncPathnull127 function MacroFuncProjIncPath(const {%H-}Param: string; const {%H-}Data: PtrInt;
128 var {%H-}Abort: boolean): string;
MacroFuncProjNamespacesnull129 function MacroFuncProjNamespaces(const {%H-}Param: string; const {%H-}Data: PtrInt;
130 var {%H-}Abort: boolean): string;
MacroFuncProjOutDirnull131 function MacroFuncProjOutDir(const {%H-}Param: string; const {%H-}Data: PtrInt;
132 var {%H-}Abort: boolean): string;
MacroFuncProjPathnull133 function MacroFuncProjPath(const {%H-}Param: string; const {%H-}Data: PtrInt;
134 var {%H-}Abort: boolean): string;
MacroFuncProjPublishDirnull135 function MacroFuncProjPublishDir(const {%H-}Param: string; const {%H-}Data: PtrInt;
136 var {%H-}Abort: boolean): string;
MacroFuncProjSrcPathnull137 function MacroFuncProjSrcPath(const {%H-}Param: string; const {%H-}Data: PtrInt;
138 var {%H-}Abort: boolean): string;
MacroFuncProjUnitPathnull139 function MacroFuncProjUnitPath(const {%H-}Param: string; const {%H-}Data: PtrInt;
140 var {%H-}Abort: boolean): string;
MacroFuncRunCmdLinenull141 function MacroFuncRunCmdLine(const {%H-}Param: string; const {%H-}Data: PtrInt;
142 var {%H-}Abort: boolean): string;
MacroFuncSrcOSnull143 function MacroFuncSrcOS(const {%H-}Param: string; const Data: PtrInt;
144 var {%H-}Abort: boolean): string;
MacroFuncTargetCmdLinenull145 function MacroFuncTargetCmdLine(const {%H-}Param: string; const {%H-}Data: PtrInt;
146 var {%H-}Abort: boolean): string;
MacroFuncTargetCPUnull147 function MacroFuncTargetCPU(const {%H-}Param: string; const Data: PtrInt;
148 var {%H-}Abort: boolean): string;
MacroFuncTargetFilenull149 function MacroFuncTargetFile(const {%H-}Param: string; const {%H-}Data: PtrInt;
150 var {%H-}Abort: boolean): string;
MacroFuncOutputFilenull151 function MacroFuncOutputFile(const {%H-}Param: string; const {%H-}Data: PtrInt;
152 var {%H-}Abort: boolean): string;
MacroFuncTargetOSnull153 function MacroFuncTargetOS(const {%H-}Param: string; const Data: PtrInt;
154 var {%H-}Abort: boolean): string;
MacroFuncIDEBuildOptionsnull155 function MacroFuncIDEBuildOptions(const {%H-}Param: string; const Data: PtrInt;
156 var {%H-}Abort: boolean): string;
MacroFuncPrimaryConfigPathnull157 function MacroFuncPrimaryConfigPath(const {%H-}Param: string; const {%H-}Data: PtrInt;
158 var {%H-}Abort: boolean): string;
MacroFuncSecondaryConfigPathnull159 function MacroFuncSecondaryConfigPath(const {%H-}Param: string; const {%H-}Data: PtrInt;
160 var {%H-}Abort: boolean): string;
MacroFuncFallbackOutputRootnull161 function MacroFuncFallbackOutputRoot(const {%H-}Param: string; const {%H-}Data: PtrInt;
162 var {%H-}Abort: boolean): string;
163
CTMacroFuncProjectNamespacesnull164 function CTMacroFuncProjectNamespaces(Data: Pointer): boolean;
CTMacroFuncProjectUnitPathnull165 function CTMacroFuncProjectUnitPath(Data: Pointer): boolean;
CTMacroFuncProjectIncPathnull166 function CTMacroFuncProjectIncPath(Data: Pointer): boolean;
CTMacroFuncProjectSrcPathnull167 function CTMacroFuncProjectSrcPath(Data: Pointer): boolean;
168 procedure OnProjectDestroy(Sender: TObject);
169 procedure SetUnitSetCache(const AValue: TFPCUnitSetCache);
GetProjectDefaultNamespacenull170 function GetProjectDefaultNamespace: string; // read .lpr file
171 protected
172 // command line overrides
173 OverrideTargetOS: string;
174 OverrideTargetCPU: string;
175 OverrideLCLWidgetType: string;
176 DefaultCfgVars: TCTCfgScriptVariables;
177 DefaultCfgVarsBuildMacroStamp: integer;
178 procedure Notification(AComponent: TComponent; Operation: TOperation);
179 override;
OnGetBuildMacroValuesnull180 function OnGetBuildMacroValues(Options: TBaseCompilerOptions;
181 IncludeSelf: boolean): TCTCfgScriptVariables;
GetActiveBuildModeNamenull182 function GetActiveBuildModeName: string;
183 procedure AppendMatrixCustomOption(Sender: TObject;
184 var Options: string; Types: TBuildMatrixGroupTypes);
185 procedure GetMatrixOutputDirectoryOverride(Sender: TObject;
186 var OutDir: string; Types: TBuildMatrixGroupTypes);
GetModeMatrixTargetnull187 function GetModeMatrixTarget(Sender: TObject): string;
EnvironmentOptionsIsGlobalModenull188 function EnvironmentOptionsIsGlobalMode(const Identifier: string): boolean;
189 public
190 constructor Create(AOwner: TComponent); override;
191 destructor Destroy; override;
192 procedure SetupTransferMacros;
193 procedure TranslateMacros;
194 procedure SetupExternalTools(aToolsClass: TExternalToolsClass);
195 procedure SetupCompilerInterface;
196 procedure SetupInputHistories(aInputHist: TInputHistories);
197 procedure EnvOptsChanged;
198
GetBuildMacroOverridenull199 function GetBuildMacroOverride(const MacroName: string): string; override;
GetBuildMacroOverridesnull200 function GetBuildMacroOverrides: TStrings; override;
GetTargetOSnull201 function GetTargetOS: string; override;
GetTargetCPUnull202 function GetTargetCPU: string; override;
GetLCLWidgetTypenull203 function GetLCLWidgetType: string; override;
GetRunCommandLinenull204 function GetRunCommandLine: string; override;
205 procedure WriteDebug_RunCommandLine; override;
206
GetCompilerFilenamenull207 function GetCompilerFilename: string; override;
GetFPCompilerFilenamenull208 function GetFPCompilerFilename: string; override;
GetFPCFrontEndOptionsnull209 function GetFPCFrontEndOptions: string; override;
GetProjectPublishDirnull210 function GetProjectPublishDir: string; override;
GetProjectTargetFilenamenull211 function GetProjectTargetFilename(aProject: TProject): string; override;
GetProjectUsesAppBundlenull212 function GetProjectUsesAppBundle: Boolean; override;
GetTestUnitFilenamenull213 function GetTestUnitFilename(AnUnitInfo: TUnitInfo): string; override;
GetTestBuildDirectorynull214 function GetTestBuildDirectory: string; override;
IsTestUnitFilenamenull215 function IsTestUnitFilename(const AFilename: string): boolean; override;
GetTargetUnitFilenamenull216 function GetTargetUnitFilename(AnUnitInfo: TUnitInfo): string; override;
217
218 procedure UpdateEnglishErrorMsgFilename;
219 procedure RescanCompilerDefines(ResetBuildTarget, ClearCaches,
220 WaitTillDone, Quiet: boolean); override;
CompilerOnDiskChangednull221 function CompilerOnDiskChanged: boolean; override;
222 procedure LoadCompilerDefinesCaches;
223 procedure SaveCompilerDefinesCaches;
224 property UnitSetCache: TFPCUnitSetCache read FUnitSetCache write SetUnitSetCache;
225
DoCheckIfProjectNeedsCompilationnull226 function DoCheckIfProjectNeedsCompilation(AProject: TProject;
227 out NeedBuildAllFlag: boolean; var Note: string): TModalResult;
CheckAmbiguousSourcesnull228 function CheckAmbiguousSources(const AFilename: string;
229 Compiling: boolean): TModalResult; override;
DeleteAmbiguousFilesnull230 function DeleteAmbiguousFiles(const Filename:string
231 ): TModalResult; override;
CheckUnitPathForAmbiguousPascalFilesnull232 function CheckUnitPathForAmbiguousPascalFiles(const BaseDir, TheUnitPath,
233 CompiledExt, ContextDescription: string
234 ): TModalResult; override;
CreateProjectApplicationBundlenull235 function CreateProjectApplicationBundle: Boolean; override;
BackupFileForWritenull236 function BackupFileForWrite(const Filename: string): TModalResult; override;
237
GetResourceTypenull238 function GetResourceType(AnUnitInfo: TUnitInfo): TResourceType;
FindLRSFilenamenull239 function FindLRSFilename(AnUnitInfo: TUnitInfo;
240 UseDefaultIfNotFound: boolean): string;
GetDefaultLRSFilenamenull241 function GetDefaultLRSFilename(AnUnitInfo: TUnitInfo): string;
UpdateLRSFromLFMnull242 function UpdateLRSFromLFM(AnUnitInfo: TUnitInfo; ShowAbort: boolean): TModalResult;
UpdateProjectAutomaticFilesnull243 function UpdateProjectAutomaticFiles(TestDir: string): TModalResult; override;
244
245 // methods for building IDE (will be changed when project groups are there)
246 procedure SetBuildTarget(const TargetOS, TargetCPU, LCLWidgetType: string;
247 ScanFPCSrc: TScanModeFPCSources; Quiet: boolean);
248 procedure SetBuildTargetProject1; override; overload;
249 procedure SetBuildTargetProject1(Quiet: boolean; ScanFPCSrc: TScanModeFPCSources = smsfsBackground); overload;
250 procedure SetBuildTargetIDE(aQuiet: boolean = false); override;
BuildTargetIDEIsDefaultnull251 function BuildTargetIDEIsDefault: boolean; override;
252
253 property FPCSrcScans: TFPCSrcScans read FFPCSrcScans;
254 property BuildTarget: TProject read FBuildTarget; // TProject or nil
255 end;
256
257 var
258 MainBuildBoss: TBuildManager = nil;
259 TheCompiler: TCompiler = nil;
260
261 procedure RunBootHandlers(ht: TLazarusIDEBootHandlerType);external name 'ideintf_LazIDEIntf_RunBootHandlers';
262
263 implementation
264
265 type
266 TUnitFile = record
267 FileUnitName: string;
268 Filename: string;
269 end;
270 PUnitFile = ^TUnitFile;
271
272 procedure BMLazConfMacroFunction(var s: string);
273 begin
274 if not GlobalMacroList.SubstituteStr(s) then
275 debugln(['BMLazConfMacroFunction failed "',s,'"']);
276 end;
277
CompareUnitFilesnull278 function CompareUnitFiles(UnitFile1, UnitFile2: PUnitFile): integer;
279 begin
280 Result:=CompareIdentifierPtrs(Pointer(UnitFile1^.FileUnitName),
281 Pointer(UnitFile2^.FileUnitName));
282 end;
283
CompareUnitNameAndUnitFilenull284 function CompareUnitNameAndUnitFile(UnitName: PChar; UnitFile: PUnitFile): integer;
285 begin
286 Result:=CompareIdentifierPtrs(Pointer(UnitName),Pointer(UnitFile^.FileUnitName));
287 end;
288
289 { TBuildManager }
290
291 procedure TBuildManager.OnProjectDestroy(Sender: TObject);
292 var
293 aProject: TProject;
294 begin
295 if not (Sender is TProjectIDEOptions) then
296 exit;
297 aProject:=TProjectIDEOptions(Sender).Project;
298 if FBuildTarget=aProject then
299 FBuildTarget:=nil;
300 end;
301
302 procedure TBuildManager.OnMacroSubstitution(TheMacro: TTransferMacro;
303 const MacroName: string; var s: string; const Data: PtrInt; var Handled,
304 Abort: boolean; Depth: integer);
305 begin
306 if TheMacro=nil then begin
307 if ConsoleVerbosity>=0 then
308 DebugLn('Warning: (lazarus) Macro not defined: "'+MacroName+'".');
309 {$IFDEF VerboseMacroNotDefined}
310 DumpStack;
311 {$ENDIF}
312 s:='';
313 //IDEMessageDialog('Unknown Macro','Macro not defined: "'+s+'".',mtError,[mbAbort],0);
314 Handled:=true;
315 exit;
316 end;
317 end;
318
TBuildManager.OnSubstituteCompilerOptionnull319 function TBuildManager.OnSubstituteCompilerOption(
320 Options: TParsedCompilerOptions; const UnparsedValue: string;
321 PlatformIndependent: boolean): string;
322 begin
323 Result:=UnparsedValue;
324 if PlatformIndependent then
325 GlobalMacroList.SubstituteStr(Result,CompilerOptionMacroPlatformIndependent)
326 else
327 GlobalMacroList.SubstituteStr(Result,CompilerOptionMacroNormal);
328 end;
329
TBuildManager.MacroFuncBuildModenull330 function TBuildManager.MacroFuncBuildMode(const Param: string;
331 const Data: PtrInt; var Abort: boolean): string;
332 begin
333 Result:=GetActiveBuildModeName;
334 end;
335
336 constructor TBuildManager.Create(AOwner: TComponent);
337 begin
338 EnvironmentOptions := TEnvironmentOptions.Create;
339 IDEEnvironmentOptions := EnvironmentOptions;
340 EnvironmentOptions.IsGlobalMode:=@EnvironmentOptionsIsGlobalMode;
341 DefaultCfgVars:=TCTCfgScriptVariables.Create;
342 DefaultCfgVarsBuildMacroStamp:=CTInvalidChangeStamp;
343 FFPCVerChangeStamp:=CTInvalidChangeStamp;
344 FFPCompilerFilenameStamp:=CTInvalidChangeStamp;
345 MainBuildBoss:=Self;
346 inherited Create(AOwner);
347 fTargetOS:=GetCompiledTargetOS;
348 fTargetCPU:=GetCompiledTargetCPU;
349 fLCLWidgetType:=GetLCLWidgetTypeName;
350 FUnitSetChangeStamp:=TFPCUnitSetCache.GetInvalidChangeStamp;
351
352 OnBackupFileInteractive:=@BackupFileForWrite;
353
354 GetBuildMacroValues:=@OnGetBuildMacroValues;
355 OnAppendCustomOption:=@AppendMatrixCustomOption;
356 OnGetOutputDirectoryOverride:=@GetMatrixOutputDirectoryOverride;
357
358 CodeToolBoss.OnRescanFPCDirectoryCache:=@DoOnRescanFPCDirectoryCache;
359 end;
360
361 destructor TBuildManager.Destroy;
362 begin
363 ExternalToolList.Free; // sets ExternalToolList to nil, do not use FreeAndNil!
364
365 GetBuildMacroValues:=nil;
366 OnAppendCustomOption:=nil;
367 OnBackupFileInteractive:=nil;
368
369 FreeAndNil(FFPCSrcScans);
370
371 LazConfMacroFunc:=nil;
372 FreeAndNil(InputHistories);
373 FreeAndNil(DefaultCfgVars);
374
375 if CompareMethods(TMethod(CodeToolBoss.OnRescanFPCDirectoryCache), TMethod(@DoOnRescanFPCDirectoryCache)) then
376 CodeToolBoss.OnRescanFPCDirectoryCache:=nil;
377
378 inherited Destroy;
379 MainBuildBoss:=nil;
380 end;
381
382 procedure TBuildManager.SetupTransferMacros;
383 begin
384 LazConfMacroFunc:=@BMLazConfMacroFunction;
GlobalMacroListnull385 GlobalMacroList:=TTransferMacroList.Create;
386 GlobalMacroList.OnSubstitution:=@OnMacroSubstitution;
387 IDEMacros:=TLazIDEMacros.Create;
388 CompilerOptions.OnParseString:=@OnSubstituteCompilerOption;
389
390 // environment
391 EnvironmentOptions.InitMacros(GlobalMacroList);
392
393 // project
394 GlobalMacroList.Add(TTransferMacro.Create('Project','',
395 lisProjectMacroProperties,@MacroFuncProject,[]));
396 GlobalMacroList.Add(TTransferMacro.Create('BuildMode','',
397 lisNameOfActiveBuildMode, @MacroFuncBuildMode, []));
398 GlobalMacroList.Add(TTransferMacro.Create('LCLWidgetType','',
399 lisLCLWidgetType,@MacroFuncLCLWidgetType,[]));
400 GlobalMacroList.Add(TTransferMacro.Create('TargetCPU','',
401 lisTargetCPU,@MacroFuncTargetCPU,[]));
402 GlobalMacroList.Add(TTransferMacro.Create('TargetOS','',
403 lisTargetOS,@MacroFuncTargetOS,[]));
404 GlobalMacroList.Add(TTransferMacro.Create('SrcOS','',
405 lisSrcOS,@MacroFuncSrcOS,[]));
406 GlobalMacroList.Add(TTransferMacro.Create('CompPath','',
407 lisCompilerFilename,@MacroFuncCompPath,[]));
408 GlobalMacroList.Add(TTransferMacro.Create('FPCVer','',
409 lisFPCVersionEG222, @MacroFuncFPCVer, []));
410 GlobalMacroList.Add(TTransferMacro.Create('FPC_FULLVERSION','',
411 lisFPCFullVersionEG20701, @MacroFuncFPC_FULLVERSION, []));
412 GlobalMacroList.Add(TTransferMacro.Create('FPCMsgFile','',
413 dlgFilterFPCMessageFile, @MacroFuncFPCMsgFile, []));
414 GlobalMacroList.Add(TTransferMacro.Create('Params','',
415 lisCommandLineParamsOfProgram,@MacroFuncParams,[]));
416 GlobalMacroList.Add(TTransferMacro.Create('ProjFile','',
417 lisProjectFilename,@MacroFuncProjFile,[]));
418 GlobalMacroList.Add(TTransferMacro.Create('ProjPath','',
419 lisProjectDirectory,@MacroFuncProjPath,[]));
420 GlobalMacroList.Add(TTransferMacro.Create('TargetFile','',
421 lisTargetFilenameOfProject,@MacroFuncTargetFile,[]));
422 GlobalMacroList.Add(TTransferMacro.Create('TargetCmdLine','',
423 lisTargetFilenamePlusParams,@MacroFuncTargetCmdLine,[]));
424 GlobalMacroList.Add(TTransferMacro.Create('RunCmdLine','',
425 lisLaunchingCmdLine,@MacroFuncRunCmdLine,[]));
426 GlobalMacroList.Add(TTransferMacro.Create('OutputFile','',
427 lisOutputFilenameOfProject,@MacroFuncOutputFile,[]));
428 GlobalMacroList.Add(TTransferMacro.Create('ProjPublishDir','',
429 lisPublishProjDir,@MacroFuncProjPublishDir,[]));
430 GlobalMacroList.Add(TTransferMacro.Create('ProjNamespaces','',
431 lisProjectNamespaces,@MacroFuncProjNamespaces,[]));
432 GlobalMacroList.Add(TTransferMacro.Create('ProjUnitPath','',
433 lisProjectUnitPath,@MacroFuncProjUnitPath,[]));
434 GlobalMacroList.Add(TTransferMacro.Create('ProjIncPath','',
435 lisProjectIncPath,@MacroFuncProjIncPath,[]));
436 GlobalMacroList.Add(TTransferMacro.Create('ProjSrcPath','',
437 lisProjectSrcPath,@MacroFuncProjSrcPath,[]));
438 GlobalMacroList.Add(TTransferMacro.Create('ProjOutDir','',
439 lisProjectOutDir,@MacroFuncProjOutDir,[]));
440 GlobalMacroList.Add(TTransferMacro.Create('Env','',
441 lisEnvironmentVariableNameAsParameter, @MacroFuncEnv, []));
442 GlobalMacroList.Add(TTransferMacro.Create('MakeExe','',
443 lisMakeExe,@MacroFuncMakeExe,[]));
444 GlobalMacroList.Add(TTransferMacro.Create('MakeLib','',
445 lisMakeExe,@MacroFuncMakeLib,[]));
446 GlobalMacroList.Add(TTransferMacro.Create('Make','',
447 lisPathOfTheMakeUtility, @MacroFuncMake, []));
448 GlobalMacroList.Add(TTransferMacro.Create('InstantFPCCache','',
449 lisPathOfTheInstantfpcCache, @MacroFuncInstantFPCCache, []));
450 GlobalMacroList.Add(TTransferMacro.Create('IDEBuildOptions','',
451 lisIDEBuildOptions, @MacroFuncIDEBuildOptions, []));
452 GlobalMacroList.Add(TTransferMacro.Create('PrimaryConfigPath','',
453 lisPrimaryConfigPath, @MacroFuncPrimaryConfigPath, []));
454 GlobalMacroList.Add(TTransferMacro.Create('SecondaryConfigPath','',
455 lisSecondaryConfigPath, @MacroFuncSecondaryConfigPath, []));
456 GlobalMacroList.Add(TTransferMacro.Create('FallbackOutputRoot','',
457 lisSecondaryConfigPath, @MacroFuncFallbackOutputRoot, []));
458 GlobalMacroList.Add(TTransferMacro.Create('LAZVer','',
459 lisLAZVer, @MacroFuncLazVer, []));
460
461 // codetools macro functions
462 CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
463 'PROJECTNAMESPACES',nil,@CTMacroFuncProjectNamespaces);
464 CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
465 'PROJECTUNITPATH',nil,@CTMacroFuncProjectUnitPath);
466 CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
467 'PROJECTINCPATH',nil,@CTMacroFuncProjectIncPath);
468 CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
469 'PROJECTSRCPATH',nil,@CTMacroFuncProjectSrcPath);
470
471 RunBootHandlers(libhTransferMacrosCreated);
472 end;
473
474 procedure TBuildManager.TranslateMacros;
475
476 procedure tr(const MacroName, Description: string);
477 var
478 Macro: TTransferMacro;
479 begin
480 Macro:=GlobalMacroList.FindByName(MacroName);
481 if Macro=nil then exit;
482 Macro.Description:=Description;
483 end;
484
485 begin
486 tr('Project',lisProjectMacroProperties);
487 tr('BuildMode',lisNameOfActiveBuildMode);
488 tr('LCLWidgetType',lisLCLWidgetType);
489 tr('TargetCPU',lisTargetCPU);
490 tr('TargetOS',lisTargetOS);
491 tr('SrcOS',lisSrcOS);
492 tr('FPCVer',lisFPCVersionEG222);
493 tr('LAZVer',lisLAZVer);
494 tr('FPC_FULLVERSION',lisFPCFullVersionEG20701);
495 tr('Params',lisCommandLineParamsOfProgram);
496 tr('ProjFile',lisProjectFilename);
497 tr('ProjPath',lisProjectDirectory);
498 tr('TargetFile',lisTargetFilenameOfProject);
499 tr('TargetCmdLine',lisTargetFilenamePlusParams);
500 tr('RunCmdLine',lisLaunchingCmdLine);
501 tr('OutputFile',lisOutputFilenameOfProject);
502 tr('ProjPublishDir',lisPublishProjDir);
503 tr('ProjNamespaces',lisProjectNamespaces);
504 tr('ProjUnitPath',lisProjectUnitPath);
505 tr('ProjIncPath',lisProjectIncPath);
506 tr('ProjSrcPath',lisProjectSrcPath);
507 tr('ProjOutDir',lisProjectOutDir);
508 tr('Env',lisEnvironmentVariableNameAsParameter);
509 tr('FPCMsgFile',dlgFilterFPCMessageFile);
510 tr('MakeExe',lisMakeExe);
511 tr('MakeLib',lisMakeExe);
512 tr('Make',lisPathOfTheMakeUtility);
513 tr('InstantFPCCache',lisPathOfTheInstantfpcCache);
514 tr('IDEBuildOptions',lisIDEBuildOptions);
515 tr('PrimaryConfigPath',lisPrimaryConfigPath);
516 tr('SecondaryConfigPath',lisSecondaryConfigPath);
517 tr('FallbackOutputRoot',lisSecondaryConfigPath);
518 tr('CompPath',lisCompilerFilename);
519 tr('FPCSrcDir',lisFreePascalSourceDirectory);
520 tr('LazarusDir',lisLazarusDirectory);
521 tr('ExeExt',lisFileExtensionOfPrograms);
522 tr('LanguageID',lisLazarusLanguageID);
523 tr('LanguageName',lisLazarusLanguageName);
524 tr('TestDir',lisTestDirectory);
525 tr('ConfDir',lisConfigDirectory);
526 tr('Home',lisUserSHomeDirectory);
527 tr('Ext',lisTMFunctionExtractFileExtension);
528 tr('Path',lisTMFunctionExtractFilePath);
529 tr('Name',lisTMFunctionExtractFileNameExtension);
530 tr('NameOnly',lisTMFunctionExtractFileNameOnly);
531 tr('MakeDir',lisTMFunctionAppendPathDelimiter);
532 tr('MakeFile',lisTMFunctionChompPathDelimiter);
533 end;
534
535 procedure TBuildManager.SetupExternalTools(aToolsClass: TExternalToolsClass);
536 var
537 Tools: TExternalTools;
538 begin
539 // setup the external tool queue
540 Tools:=aToolsClass.Create(Self);
541 if Tools<>ExternalToolList then
542 raise Exception.Create('TBuildManager.SetupExternalTools ExternalTools='+DbgSName(ExternalToolList));
543 EnvOptsChanged;
544 RegisterFPCParser;
545 RegisterPas2jsParser;
546 RegisterMakeParser;
547 ExternalToolList.RegisterParser(TDefaultParser);
548
549 FPCMsgFilePool:=TFPCMsgFilePool.Create(nil);
550 Pas2jsMsgFilePool:=TPas2jsMsgFilePool.Create(nil);
551 end;
552
553 procedure TBuildManager.SetupCompilerInterface;
554 begin
555 TheCompiler := TCompiler.Create;
556 end;
557
558 procedure TBuildManager.SetupInputHistories(aInputHist: TInputHistories);
559 begin
560 aInputHist.SetLazarusDefaultFilename;
561 aInputHist.Load;
562 end;
563
564 procedure TBuildManager.EnvOptsChanged;
565 begin
566 if EnvironmentOptions.MaxExtToolsInParallel<=0 then
567 ExternalToolsRef.MaxProcessCount:=DefaultMaxProcessCount
568 else
569 ExternalToolsRef.MaxProcessCount:=EnvironmentOptions.MaxExtToolsInParallel;
570 end;
571
GetBuildMacroOverridenull572 function TBuildManager.GetBuildMacroOverride(const MacroName: string): string;
573 begin
574 Result:='';
575 if SysUtils.CompareText(MacroName,'TargetOS')=0 then
576 Result:=OverrideTargetOS
577 else if SysUtils.CompareText(MacroName,'TargetCPU')=0 then
578 Result:=OverrideTargetCPU
579 else if SysUtils.CompareText(MacroName,'LCLWidgetType')=0 then
580 Result:=OverrideLCLWidgetType;
581 end;
582
GetBuildMacroOverridesnull583 function TBuildManager.GetBuildMacroOverrides: TStrings;
584 begin
585 Result:=TStringList.Create;
586 if OverrideTargetOS<>'' then
587 Result.Values['TargetOS']:=OverrideTargetOS;
588 if OverrideTargetCPU<>'' then
589 Result.Values['TargetCPU']:=OverrideTargetCPU;
590 if OverrideLCLWidgetType<>'' then
591 Result.Values['LCLWidgetType']:=OverrideLCLWidgetType;
592 end;
593
TBuildManager.GetTargetOSnull594 function TBuildManager.GetTargetOS: string;
595 begin
596 Result:=fTargetOS;
597 end;
598
GetTargetCPUnull599 function TBuildManager.GetTargetCPU: string;
600 begin
601 Result:=fTargetCPU;
602 //debugln(['TBuildManager.GetTargetCPU ',Result]);
603 end;
604
GetLCLWidgetTypenull605 function TBuildManager.GetLCLWidgetType: string;
606 begin
607 Result:=fLCLWidgetType;
608 end;
609
GetTargetFilenamenull610 function TBuildManager.GetTargetFilename: String;
611 begin
612 Result := GetProjectTargetFilename(Project1);
613 if GetProjectUsesAppBundle then
614 // return command line to Application Bundle (darwin only)
615 Result := ExtractFileNameWithoutExt(Result) + '.app';
616 end;
617
GetRunCommandLinenull618 function TBuildManager.GetRunCommandLine: string;
619 var
620 TargetFilename: string;
621 AMode: TRunParamsOptionsMode;
622 begin
623 Result := '';
624 if Project1=nil then exit;
625 AMode := Project1.RunParameterOptions.GetActiveMode;
626 if (AMode<>nil) and AMode.UseLaunchingApplication then
627 Result := AMode.LaunchingApplicationPathPlusParams;
628
629 if Result='' then
630 begin
631 if (AMode<>nil) then
632 Result := AMode.CmdLineParams;
633 if GlobalMacroList.SubstituteStr(Result) then
634 begin
635 TargetFilename := GetTargetFilename;
636 if (TargetFilename <> '')
637 and (TargetFilename[Length(TargetFilename)] in AllowDirectorySeparators) then
638 TargetFilename += ExtractFileNameOnly(
639 Project1.CompilerOptions.GetDefaultMainSourceFileName);
640 TargetFilename := '"'+TargetFilename+'"';
641 if Result='' then
642 Result:=TargetFilename
643 else
644 Result:=TargetFilename+' '+Result;
645 end else
646 Result:='';
647 end else begin
648 if not GlobalMacroList.SubstituteStr(Result) then Result:='';
649 end;
650 end;
651
652 procedure TBuildManager.WriteDebug_RunCommandLine;
653 var
654 AMode: TRunParamsOptionsMode;
655 s, TargetFilename: String;
656 begin
657 s:='';
658 if Project1=nil then
659 begin
660 debugln(['Note: (lazarus) [TBuildManager.WriteDebug_RunCommandLine] Project1=nil RunCmdLine=[',GetRunCommandLine,']']);
661 end else begin
662 AMode := Project1.RunParameterOptions.GetActiveMode;
663 if AMode<>nil then
664 debugln(['Note: (lazarus) [TBuildManager.WriteDebug_RunCommandLine] AMode="',AMode.Name,'" AMode.WorkingDirectory=[',AMode.WorkingDirectory,']'])
665 else
666 debugln(['Note: (lazarus) [TBuildManager.WriteDebug_RunCommandLine] AMode=nil']);
667 if (AMode<>nil) and AMode.UseLaunchingApplication then
668 begin
669 s := AMode.LaunchingApplicationPathPlusParams;
670 debugln(['Note: (lazarus) [TBuildManager.WriteDebug_RunCommandLine] LaunchingApplicationPathPlusParams=[',s,']']);
671 end;
672
673 if s='' then
674 begin
675 // no launching app
676 debugln(['Note: (lazarus) [TBuildManager.WriteDebug_RunCommandLine] no LaunchingApplication']);
677 if (AMode<>nil) then
678 begin
679 s := AMode.CmdLineParams;
680 if s<>'' then
681 debugln(['Note: (lazarus) [TBuildManager.WriteDebug_RunCommandLine] AMode.CmdLineParams=[',s,']']);
682 end;
683 TargetFilename := GetTargetFilename;
684 if (TargetFilename <> '')
685 and (TargetFilename[Length(TargetFilename)] in AllowDirectorySeparators) then
686 TargetFilename += ExtractFileNameOnly(
687 Project1.CompilerOptions.GetDefaultMainSourceFileName);
688
689 debugln(['Note: (lazarus) [TBuildManager.WriteDebug_RunCommandLine] TargetFilename=[',TargetFilename,']']);
690 end;
691 debugln(['Note: (lazarus) [TBuildManager.WriteDebug_RunCommandLine] Project1<>nil RunCmdLine=[',GetRunCommandLine,']']);
692 end;
693 end;
694
TBuildManager.GetCompilerFilenamenull695 function TBuildManager.GetCompilerFilename: string;
696 var
697 Opts: TProjectCompilerOptions;
698 begin
699 Result:='';
700 //debugln(['TBuildManager.GetCompilerFilename START FBuildTarget=',DbgSName(FBuildTarget)]);
701 if FBuildTarget<>nil then
702 begin
703 Opts:=FBuildTarget.CompilerOptions;
704 //debugln(['TBuildManager.GetCompilerFilename FBuildTarget=',DbgSName(FBuildTarget),' Path=',Opts.CompilerPath,' Build=',[crCompile,crBuild]*Opts.CompileReasons<>[],' Parsing=',Opts.ParsedOpts.Values[pcosCompilerPath].Parsing]);
705 // Note: even if Opts.CompileReasons are disabled, the project compiler path is used by codetools
706 if (Opts.CompilerPath<>'')
707 and (not Opts.ParsedOpts.Values[pcosCompilerPath].Parsing) then
708 begin
709 Result:=Opts.CompilerPath;
710 // the compiler filename is resolved twice, once for getting the default
711 // compiler target OS/CPU and once with the real values.
712 // For easier macro debugging, avoid this double resolve.
713 if Result='' then
714 // see below
715 else if Result='$(CompPath)' then
716 Result:=''
717 else if (Pos('$',Result)<1) and (FilenameIsAbsolute(Result)) then
718 Result:=TrimFilename(Result)
719 else
720 Result:=FBuildTarget.GetCompilerFilename;
721 //debugln(['TBuildManager.GetCompilerFilename project compiler="',Result,'"']);
722 end;
723 end;
724 if Result='' then
725 Result:=EnvironmentOptions.GetParsedCompilerFilename;
726 //debugln(['TBuildManager.GetCompilerFilename END Result="',Result,'"']);
727 end;
728
TBuildManager.GetFPCompilerFilenamenull729 function TBuildManager.GetFPCompilerFilename: string;
730 var
731 ErrMsg: string;
732 Kind: TPascalCompiler;
733 begin
734 if FFPCompilerFilenameStamp<>CompilerParseStamp then begin
735 FFPCompilerFilename:=GetCompilerFilename;
736 if (not IsCompilerExecutable(FFPCompilerFilename,ErrMsg,Kind,false)) or (ErrMsg<>'')
737 or (Kind<>pcFPC) then
738 FFPCompilerFilename:=EnvironmentOptions.GetParsedCompilerFilename;
739 FFPCompilerFilenameStamp:=CompilerParseStamp;
740 end;
741 Result:=FFPCompilerFilename;
742 end;
743
TBuildManager.GetFPCFrontEndOptionsnull744 function TBuildManager.GetFPCFrontEndOptions: string;
745 var
746 s: String;
747 begin
748 Result:='';
749 if FBuildTarget<>nil then
750 begin
751 s:=ExtractFPCFrontEndParameters(FBuildTarget.CompilerOptions.CustomOptions);
752 if GlobalMacroList.SubstituteStr(s) then
753 begin
754 if s<>'' then
755 Result:=s;
756 end else begin
757 debugln(['Warning: (lazarus) [GetFPCFrontEndOptions] ignoring invalid macros in custom options for fpc frontend: "',ExtractFPCFrontEndParameters(FBuildTarget.CompilerOptions.CustomOptions),'"']);
758 end;
759 end;
760 if LazarusIDE<>nil then
761 if not LazarusIDE.CallHandlerGetFPCFrontEndParams(Self,Result) then begin
762 debugln(['Warning: TBuildManager.GetFPCFrontEndOptions: LazarusIDE.CallHandlerGetFPCFrontEndParams failed Result="',Result,'"']);
763 end;
764 Result:=UTF8Trim(Result);
765 end;
766
TBuildManager.GetProjectPublishDirnull767 function TBuildManager.GetProjectPublishDir: string;
768 begin
769 if Project1<>nil then
770 Result:=RealPublishDir(Project1.PublishOptions)
771 else
772 Result:='';
773 end;
774
GetProjectTargetFilenamenull775 function TBuildManager.GetProjectTargetFilename(aProject: TProject): string;
776 var
777 AMode: TRunParamsOptionsMode;
778 begin
779 Result:='';
780 if aProject=nil then exit;
781 AMode := aProject.RunParameterOptions.GetActiveMode;
782 if AMode<>nil then
783 Result:=AMode.HostApplicationFilename;
784 GlobalMacroList.SubstituteStr(Result);
785 if (Result='') and (aProject.MainUnitID>=0) then begin
786 Result := aProject.CompilerOptions.CreateTargetFilename;
787 end;
788 end;
789
TBuildManager.GetProjectUsesAppBundlenull790 function TBuildManager.GetProjectUsesAppBundle: Boolean;
791 begin
792 Result := (Project1<>nil)
793 and ( (Project1.RunParameterOptions.GetActiveMode=nil)
794 or (Project1.RunParameterOptions.GetActiveMode.HostApplicationFilename = ''))
795 and (GetTargetOS = 'darwin') and Project1.UseAppBundle;
796 end;
797
GetTestUnitFilenamenull798 function TBuildManager.GetTestUnitFilename(AnUnitInfo: TUnitInfo): string;
799 var
800 TestDir: String;
801 begin
802 Result:='';
803 if AnUnitInfo=nil then exit;
804 TestDir:=GetTestBuildDirectory;
805 if TestDir='' then exit;
806 Result:=ExtractFilename(AnUnitInfo.Filename);
807 if Result='' then exit;
808 Result:=TestDir+Result;
809 end;
810
TBuildManager.GetTestBuildDirectorynull811 function TBuildManager.GetTestBuildDirectory: string;
812 begin
813 Result:=EnvironmentOptions.GetParsedTestBuildDirectory;
814 end;
815
IsTestUnitFilenamenull816 function TBuildManager.IsTestUnitFilename(const AFilename: string): boolean;
817 var
818 TestDir: string;
819 begin
820 Result:=false;
821 if (Project1<>nil) and Project1.IsVirtual then begin
822 TestDir:=GetTestBuildDirectory;
823 Result:=FileIsInPath(AFilename,TestDir);
824 end;
825 end;
826
GetTargetUnitFilenamenull827 function TBuildManager.GetTargetUnitFilename(AnUnitInfo: TUnitInfo): string;
828 begin
829 if Project1.IsVirtual then
830 Result:=GetTestUnitFilename(AnUnitInfo)
831 else
832 Result:=AnUnitInfo.Filename;
833 end;
834
835 procedure TBuildManager.UpdateEnglishErrorMsgFilename;
836 begin
837 if EnvironmentOptions.GetParsedLazarusDirectory<>'' then begin
838 CodeToolBoss.DefinePool.EnglishErrorMsgFilename:=
839 AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory)+
840 GetForcedPathDelims('components/codetools/fpc.errore.msg');
841 CodeToolBoss.CompilerDefinesCache.ExtraOptions:=
842 '-Fr'+CodeToolBoss.DefinePool.EnglishErrorMsgFilename;
843 end;
844 end;
845
846 procedure TBuildManager.RescanCompilerDefines(ResetBuildTarget,
847 ClearCaches, WaitTillDone, Quiet: boolean);
848
849 procedure AddTemplate(ADefTempl: TDefineTemplate; AddToPool: boolean;
850 const ErrorMsg: string);
851 begin
852 if ADefTempl = nil then
853 begin
854 DebugLn('');
855 DebugLn(ErrorMsg);
856 end else
857 begin
858 if AddToPool then
859 CodeToolBoss.DefinePool.Add(ADefTempl.CreateCopy(false,true,true));
860 CodeToolBoss.DefineTree.ReplaceRootSameName(ADefTempl);
861 end;
862 end;
863
FoundSystemPPUnull864 function FoundSystemPPU: boolean;
865 var
866 ConfigCache: TPCTargetConfigCache;
867 AFilename: string;
868 begin
869 Result:=false;
870 ConfigCache:=UnitSetCache.GetConfigCache(false);
871 if ConfigCache=nil then exit;
872 if ConfigCache.Units=nil then exit;
873 AFilename:=ConfigCache.Units['system'];
874 if AFilename='' then exit;
875 if not FilenameExtIs(AFilename,'ppu',true) then exit;
876 Result:=true;
877 end;
878
PPUFilesAndCompilerMatchnull879 function PPUFilesAndCompilerMatch: boolean;
880 // check if compiler is in another directory than the ppu files
881 // for example: a 'make install' installs to /usr/local/lib/fpc
882 // while the rpm/deb packages install to /usr/lib
883 var
884 Cfg: TPCTargetConfigCache;
885 Filename: String;
886 begin
887 Cfg:=UnitSetCache.GetConfigCache(false);
888 if Cfg=nil then exit(true);
889 if Cfg.Kind=pcFPC then begin
890 if Cfg.RealCompiler='' then begin
891 if ConsoleVerbosity>=0 then
892 debugln(['Error: (lazarus) [PPUFilesAndCompilerMatch] Compiler=',Cfg.Compiler,' RealComp=',Cfg.RealCompiler,' InPath=',Cfg.RealTargetCPUCompiler]);
893 IDEMessageDialog(lisCCOErrorCaption, Format(
894 lisCompilerDoesNotSupportTarget, [Cfg.Compiler, Cfg.TargetCPU, Cfg.TargetOS]),
895 mtError,[mbOk]);
896 exit(false);
897 end;
898 Filename:=GetPhysicalFilenameCached(Cfg.RealCompiler,true);
899 if (Filename='') then begin
900 IDEMessageDialog('Error','Compiler executable is missing: '+Cfg.RealCompiler,
901 mtError,[mbOk]);
902 exit(false);
903 end;
904 end;
905 Result:=true;
906 end;
907
908 var
909 TargetOS, TargetCPU, FPCOptions: string;
910 CompilerFilename: String;
911 FPCSrcDir: string;
912 ADefTempl: TDefineTemplate;
913 FPCSrcCache: TFPCSourceCache;
914 NeedUpdateFPCSrcCache: Boolean;
915 IgnorePath: String;
916 MsgResult: TModalResult;
917 AsyncScanFPCSrcDir: String;
918 UnitSetChanged: Boolean;
919 HasTemplate: Boolean;
920 CompilerErrorMsg: string;
921 Msg, DefCompilerFilename, ProjCompilerFilename, ProjCompilerErrorMsg,
922 DefCompilerErrorMsg: String;
923 CompilerKind, ProjCompilerKind, DefCompilerKind: TPascalCompiler;
924 begin
925 if ClearCaches then begin
926 {$IFDEF VerboseFPCSrcScan}
927 debugln(['TBuildManager.RescanCompilerDefines clear caches']);
928 {$ENDIF}
929 CodeToolBoss.CompilerDefinesCache.ConfigCaches.Clear;
930 CodeToolBoss.CompilerDefinesCache.SourceCaches.Clear;
931 end;
932 if ResetBuildTarget then
933 SetBuildTarget('','','',smsfsSkip,true);
934
935 // start the compiler and ask for his settings
936 // provide an english message file
937 UpdateEnglishErrorMsgFilename;
938
939 // use current TargetOS, TargetCPU, compilerfilename and FPC source dir
940 TargetOS:=GetTargetOS;
941 TargetCPU:=GetTargetCPU;
942 {$IFDEF VerboseFPCSrcScan}
943 debugln(['TBuildManager.RescanCompilerDefines GetParsedFPCSourceDirectory needs FPCVer...']);
944 {$ENDIF}
945 CompilerFilename:=GetCompilerFilename;
946 IsCompilerExecutable(CompilerFilename,CompilerErrorMsg,CompilerKind,{$IFDEF VerboseFPCSrcScan}true{$ELSE}false{$ENDIF});
947 FPCSrcDir:=EnvironmentOptions.GetParsedFPCSourceDirectory; // needs FPCVer macro
948 FPCOptions:=GetFPCFrontEndOptions;
949
950 {$IFDEF VerboseFPCSrcScan}
951 debugln(['TMainIDE.RescanCompilerDefines START ',
952 ' CompilerFilename=',CompilerFilename,
953 ' Kind=',PascalCompilerNames[CompilerKind],
954 ' TargetOS=',TargetOS,
955 ' TargetCPU=',TargetCPU,
956 ' FPCOptions="',FPCOptions,'"',
957 ' EnvFPCSrcDir=',EnvironmentOptions.FPCSourceDirectory,
958 ' FPCSrcDir=',FPCSrcDir,
959 ' WaitTillDone=',WaitTillDone,
960 ' Quiet=',Quiet,
961 ' ClearCaches=',ClearCaches,
962 '']);
963 {$ENDIF}
964
965 // first check the default targetos, targetcpu of the default compiler
966 DefCompilerFilename:=EnvironmentOptions.GetParsedCompilerFilename;
967 if FileExistsCached(DefCompilerFilename) then
968 begin
969 {$IFDEF VerboseFPCSrcScan}
970 debugln(['TBuildManager.RescanCompilerDefines reading default compiler settings']);
971 {$ENDIF}
972 UnitSetCache:=CodeToolBoss.CompilerDefinesCache.FindUnitSet(
973 DefCompilerFilename,'','','',FPCSrcDir,true);
974 UnitSetCache.GetConfigCache(true);
975 end;
976
977 if CompilerFilename<>DefCompilerFilename then
978 IsCompilerExecutable(CompilerFilename,CompilerErrorMsg,CompilerKind,true);
979
980 // then check the project's compiler
981 if (CompilerErrorMsg<>'') then begin
982 Msg:='';
983 if (FBuildTarget<>nil)
984 and ([crCompile,crBuild]*FBuildTarget.CompilerOptions.CompileReasons<>[])
985 and (FBuildTarget.CompilerOptions.CompilerPath<>'')
986 then begin
987 ProjCompilerFilename:=FBuildTarget.GetCompilerFilename;
988 if not IsCompilerExecutable(ProjCompilerFilename,ProjCompilerErrorMsg,ProjCompilerKind,true)
989 then begin
990 Msg+='Project''s compiler: "'+ProjCompilerFilename+'": '+ProjCompilerErrorMsg+#13;
991 end;
992 end;
993
994 if not IsCompilerExecutable(DefCompilerFilename,DefCompilerErrorMsg,DefCompilerKind,true)
995 then begin
996 Msg+='Environment compiler: "'+DefCompilerFilename+'": '+DefCompilerErrorMsg+#13;
997 end;
998 if Msg='' then
999 Msg+='Compiler: "'+CompilerFilename+'": '+CompilerErrorMsg+#13;
1000
1001 debugln('Warning: (lazarus) [TBuildManager.RescanCompilerDefines]: invalid compiler:');
1002 debugln(Msg);
1003 if not Quiet then begin
1004 IDEMessageDialog('Error','There is no Free Pascal Compiler'
1005 +' (e.g. fpc'+ExeExt+' or ppc<cpu>'+ExeExt+') configured in the'
1006 +' project options. Codetools will not work properly.'#13
1007 +Msg,mtError,[mbOk]);
1008 end;
1009 UnitSetCache:=nil;
1010 exit;
1011 end;
1012
1013 // create a cache for the current project settings
1014 {$IFDEF VerboseFPCSrcScan}
1015 debugln(['TBuildManager.RescanCompilerDefines reading active compiler settings']);
1016 {$ENDIF}
1017 //debugln(['TBuildManager.RescanCompilerDefines ',CompilerFilename,' OS=',TargetOS,' CPU=',TargetCPU,' Options="',FPCOptions,'"']);
1018 UnitSetCache:=CodeToolBoss.CompilerDefinesCache.FindUnitSet(
1019 CompilerFilename,TargetOS,TargetCPU,FPCOptions,FPCSrcDir,true);
1020
1021 NeedUpdateFPCSrcCache:=false;
1022 //debugln(['TBuildManager.RescanCompilerDefines ',DirectoryExistsUTF8(FPCSrcDir),' ',(not WaitTillDone),' ',(not HasGUI)]);
1023 AsyncScanFPCSrcDir:='';
1024 if DirectoryExistsUTF8(FPCSrcDir) and ((not WaitTillDone) or (not HasGUI)) then
1025 begin
1026 // FPC sources are not needed
1027 // => disable scan
1028 FPCSrcCache:=UnitSetCache.GetSourceCache(false);
1029 if (FPCSrcCache<>nil) and (not FPCSrcCache.Valid) then
1030 begin
1031 NeedUpdateFPCSrcCache:=HasGUI;
1032 FPCSrcCache.Valid:=true;
1033 if NeedUpdateFPCSrcCache then
1034 begin
1035 // start background scan of fpc source directory
1036 //debugln(['TBuildManager.RescanCompilerDefines background scan: '+FPCSrcCache.Directory]);
1037 AsyncScanFPCSrcDir:=FPCSrcDir;
1038 end;
1039 end;
1040 end;
1041
1042 // scan compiler, fpc sources and create indices for quick lookup
1043 UnitSetCache.Init;
1044
1045 UnitSetChanged:=(FUnitSetChangeStamp=TFPCUnitSetCache.GetInvalidChangeStamp)
1046 or (FUnitSetChangeStamp<>UnitSetCache.ChangeStamp);
1047
1048 {$IFDEF VerboseFPCSrcScan}
1049 debugln(['TBuildManager.RescanCompilerDefines UnitSet changed=',UnitSetChanged,
1050 ' ClearCaches=',ClearCaches,
1051 ' CompilerFilename=',CompilerFilename,
1052 ' TargetOS=',TargetOS,
1053 ' TargetCPU=',TargetCPU,
1054 ' FPCOptions="',FPCOptions,'"',
1055 ' RealCompiler=',UnitSetCache.GetConfigCache(false).RealCompiler,
1056 ' EnvFPCSrcDir=',EnvironmentOptions.FPCSourceDirectory,
1057 ' FPCSrcDir=',FPCSrcDir,
1058 '']);
1059 {$ENDIF}
1060
1061 if UnitSetChanged then begin
1062 {$IFDEF VerboseFPCSrcScan}
1063 debugln(['TBuildManager.RescanCompilerDefines UnitSet changed => save scan results']);
1064 {$ENDIF}
1065 // save caches
1066 SaveCompilerDefinesCaches;
1067 FUnitSetChangeStamp:=UnitSetCache.ChangeStamp;
1068 end;
1069
1070 // rebuild the define templates
1071 HasTemplate:=CodeToolBoss.DefineTree.FindDefineTemplateByName(StdDefTemplFPC,true)<>nil;
1072 if UnitSetChanged or not HasTemplate then
1073 begin
1074 {$IFDEF VerboseFPCSrcScan}
1075 debugln(['TBuildManager.RescanCompilerDefines updating FPC template UnitSetChanged=',UnitSetChanged,' OldTemplateExists=',HasTemplate]);
1076 {$ENDIF}
1077 // create template for FPC settings
1078 ADefTempl:=CreateFPCTemplate(UnitSetCache,nil);
1079 AddTemplate(ADefTempl,false,
1080 'NOTE: Could not create Define Template for Free Pascal Compiler');
1081 end;
1082
1083 // create template for FPC source directory
1084 if HasGUI then
1085 begin
1086 HasTemplate:=CodeToolBoss.DefineTree.FindDefineTemplateByName(StdDefTemplFPCSrc,true)<>nil;
1087 if UnitSetChanged or not HasTemplate then
1088 begin
1089 {$IFDEF VerboseFPCSrcScan}
1090 debugln(['TBuildManager.RescanCompilerDefines updating FPC SRC template UnitSetChanged=',UnitSetChanged,' OldTemplateExists=',HasTemplate]);
1091 {$ENDIF}
1092 ADefTempl:=CreateFPCSourceTemplate(UnitSetCache,nil);
1093 AddTemplate(ADefTempl,false,lisNOTECouldNotCreateDefineTemplateForFreePascal);
1094 end;
1095
1096 // create compiler macros for the lazarus sources
1097 HasTemplate:=CodeToolBoss.DefineTree.FindDefineTemplateByName(StdDefTemplLazarusSources,true)<>nil;
1098 if (not HasTemplate)
1099 or (fBuildLazExtraOptions<>MiscellaneousOptions.BuildLazOpts.ExtraOptions)
1100 then begin
1101 {$IFDEF VerboseFPCSrcScan}
1102 debugln(['TBuildManager.RescanCompilerDefines updating Lazarus source template OldTemplateExists=',HasTemplate,' OldExtraOptions="',fBuildLazExtraOptions,'" NewExtraOptions="',MiscellaneousOptions.BuildLazOpts.ExtraOptions,'"']);
1103 {$ENDIF}
1104 fBuildLazExtraOptions:=MiscellaneousOptions.BuildLazOpts.ExtraOptions;
1105 ADefTempl:=CreateLazarusSourceTemplate(
1106 '$('+ExternalMacroStart+'LazarusDir)',
1107 '$('+ExternalMacroStart+'LCLWidgetType)',
1108 fBuildLazExtraOptions,nil);
1109 AddTemplate(ADefTempl,true,
1110 lisNOTECouldNotCreateDefineTemplateForLazarusSources);
1111 end;
1112 end;
1113
1114 CodeToolBoss.DefineTree.ClearCache;
1115
1116 if AsyncScanFPCSrcDir<>'' then begin
1117 // start scanning the fpc source directory in the background
1118 {$IFDEF VerboseFPCSrcScan}
1119 debugln(['TBuildManager.RescanCompilerDefines scanning fpc sources:',AsyncScanFPCSrcDir]);
1120 {$ENDIF}
1121 if FPCSrcScans=nil then
1122 FFPCSrcScans:=TFPCSrcScans.Create(Self);
1123 FPCSrcScans.Scan(AsyncScanFPCSrcDir);
1124 end;
1125
1126 if not Quiet then begin
1127 // check for common installation mistakes
1128 if not PPUFilesAndCompilerMatch then exit;
1129 if (UnitSetCache.GetCompilerKind=pcFPC) then begin
1130 // check if at least one fpc config is there
1131 if (UnitSetCache.GetFirstFPCCfg='') then begin
1132 IgnorePath:='MissingFPCCfg_'+TargetOS+'-'+TargetCPU;
1133 if (InputHistories<>nil) and (InputHistories.Ignores.Find(IgnorePath)=nil)
1134 then begin
1135 MsgResult:=IDEMessageDialog(lisCCOWarningCaption,
1136 lisTheCurrentFPCHasNoConfigFileItWillProbablyMissSome,
1137 mtWarning,[mbOk,mbIgnore]);
1138 if MsgResult=mrIgnore then
1139 InputHistories.Ignores.Add(IgnorePath,iiidIDERestart);
1140 end;
1141 end;
1142 if not FoundSystemPPU then begin
1143 // system.ppu is missing
1144 IDEMessageDialog(lisCCOErrorCaption,
1145 Format(lisTheProjectUsesTargetOSAndCPUTheSystemPpuForThisTar,
1146 [TargetOS, TargetCPU, LineEnding, LineEnding]),
1147 mtError,[mbOk]);
1148 end;
1149 end;
1150 end;
1151 end;
1152
CompilerOnDiskChangednull1153 function TBuildManager.CompilerOnDiskChanged: boolean;
1154 var
1155 CfgCache: TPCTargetConfigCache;
1156 begin
1157 Result:=false;
1158 if UnitSetCache=nil then exit;
1159 CfgCache:=UnitSetCache.GetConfigCache(false);
1160 if CfgCache=nil then exit;
1161 Result:=CfgCache.NeedsUpdate;
1162 end;
1163
1164 procedure TBuildManager.LoadCompilerDefinesCaches;
1165 var
1166 aFilename: String;
1167 XMLConfig: TXMLConfig;
1168 begin
1169 aFilename:=AppendPathDelim(GetPrimaryConfigPath)+'fpcdefines.xml';
1170 CopySecondaryConfigFile(ExtractFilename(aFilename));
1171 if not FileExistsUTF8(aFilename) then exit;
1172 try
1173 XMLConfig:=TXMLConfig.Create(aFilename);
1174 try
1175 CodeToolBoss.CompilerDefinesCache.LoadFromXMLConfig(XMLConfig,'');
1176 finally
1177 XMLConfig.Free;
1178 end;
1179 except
1180 on E: Exception do begin
1181 if ConsoleVerbosity>=0 then
1182 debugln(['Error: (lazarus) [LoadCompilerDefinesCaches] Error reading file '+aFilename+':'+E.Message]);
1183 end;
1184 end;
1185 end;
1186
1187 procedure TBuildManager.SaveCompilerDefinesCaches;
1188 var
1189 aFilename: String;
1190 XMLConfig: TXMLConfig;
1191 begin
1192 aFilename:=AppendPathDelim(GetPrimaryConfigPath)+'fpcdefines.xml';
1193 //debugln(['TBuildManager.SaveCompilerDefinesCaches check if save needed ...']);
1194 if FileExistsCached(aFilename)
1195 and (not CodeToolBoss.CompilerDefinesCache.NeedsSave) then
1196 exit;
1197 //debugln(['TBuildManager.SaveCompilerDefinesCaches saving ...']);
1198 try
1199 XMLConfig:=TXMLConfig.CreateClean(aFilename);
1200 try
1201 CodeToolBoss.CompilerDefinesCache.SaveToXMLConfig(XMLConfig,'');
1202 finally
1203 XMLConfig.Free;
1204 end;
1205 except
1206 on E: Exception do begin
1207 if ConsoleVerbosity>=0 then
1208 debugln(['Error: (lazarus) [SaveCompilerDefinesCaches] Error writing file '+aFilename+':'+E.Message]);
1209 end;
1210 end;
1211 end;
1212
DoCheckIfProjectNeedsCompilationnull1213 function TBuildManager.DoCheckIfProjectNeedsCompilation(AProject: TProject;
1214 out NeedBuildAllFlag: boolean; var Note: string): TModalResult;
1215 var
1216 CompilerFilename, CompilerParams, SrcFilename: string;
1217 StateFilename: String;
1218 StateFileAge: LongInt;
1219 AnUnitInfo: TUnitInfo;
1220 LFMFilename: String;
1221 IcoRes: TProjectIcon;
1222 aTargetFilename: String;
1223 DbgCap: String;
1224
1225 function EditorFileHasChanged: boolean;
1226 begin
1227 Result:=false;
1228 if AnUnitInfo.IsPartOfProject or AnUnitInfo.IsVirtual then exit;
1229 if not FileExistsCached(AnUnitInfo.Filename) then exit;
1230 if StateFileAge>=FileAgeCached(AnUnitInfo.Filename) then exit;
1231 if FilenameHasPascalExt(AnUnitInfo.Filename) then
1232 begin
1233 if (SearchDirectoryInSearchPath(AProject.CompilerOptions.GetUnitPath(false),
1234 ExtractFilePath(AnUnitInfo.Filename))>0)
1235 then begin
1236 Result:=true;
1237 if ConsoleVerbosity>=0 then
1238 DebugLn(DbgCap,'Editor Unit in project''s unit path has changed ',AProject.IDAsString,' ',AnUnitInfo.Filename);
1239 Note+='Editor unit "'+AnUnitInfo.Filename+'" in project''s unit search path is newer than state file:'+LineEnding
1240 +' File age="'+FileAgeToStr(FileAgeCached(AnUnitInfo.Filename))+'"'+LineEnding
1241 +' State file age="'+FileAgeToStr(StateFileAge)+'"'+LineEnding
1242 +' State file='+StateFilename+LineEnding;
1243 exit(true);
1244 end;
1245 end;
1246 if (SearchDirectoryInSearchPath(AProject.CompilerOptions.GetIncludePath(false),
1247 ExtractFilePath(AnUnitInfo.Filename))>0)
1248 then begin
1249 Result:=true;
1250 if ConsoleVerbosity>=0 then
1251 DebugLn(DbgCap,'Editor Src in project''s include path has changed ',AProject.IDAsString,' ',AnUnitInfo.Filename);
1252 Note+='Editor file "'+AnUnitInfo.Filename+'" in project''s include search path is newer than state file:'+LineEnding
1253 +' File age="'+FileAgeToStr(FileAgeCached(AnUnitInfo.Filename))+'"'+LineEnding
1254 +' State file age="'+FileAgeToStr(StateFileAge)+'"'+LineEnding
1255 +' State file='+StateFilename+LineEnding;
1256 exit(true);
1257 end;
1258 end;
1259
1260 begin
1261 NeedBuildAllFlag:=false;
1262 DbgCap:='Hint: (lazarus) Project needs building: ';
1263
1264 // get main source filename
1265 if not AProject.IsVirtual then begin
1266 SrcFilename:=CreateRelativePath(AProject.MainUnitInfo.Filename,
1267 AProject.Directory);
1268 end else begin
1269 SrcFilename:=GetTestUnitFilename(AProject.MainUnitInfo);
1270 end;
1271
1272 CompilerFilename:=AProject.GetCompilerFilename;
1273 //DebugLn([DbgCap,'CompilerFilename="',CompilerFilename,'" CompilerPath="',AProject.CompilerOptions.CompilerPath,'"']);
1274 // Note: use absolute paths, because some external tools resolve symlinked directories
1275 CompilerParams :=
1276 AProject.CompilerOptions.MakeOptionsString([ccloAbsolutePaths])
1277 + ' ' + PrepareCmdLineOption(SrcFilename);
1278 //DebugLn(DbgCap,'WorkingDir="',WorkingDir,'" SrcFilename="',SrcFilename,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'"');
1279
1280 // check state file
1281 StateFilename:=AProject.GetStateFilename;
1282 Result:=AProject.LoadStateFile(false);
1283 if Result<>mrOk then exit; // read error and user aborted
1284 if not (lpsfStateFileLoaded in AProject.StateFlags) then begin
1285 if ConsoleVerbosity>=0 then
1286 DebugLn(DbgCap,'No state file for ',AProject.IDAsString);
1287 Note+='State file "'+StateFilename+'" of '+AProject.IDAsString+' is missing.'+LineEnding;
1288 NeedBuildAllFlag:=true;
1289 exit(mrYes);
1290 end;
1291
1292 // check if build all (-B) is needed
1293 if (AProject.LastCompilerFilename<>CompilerFilename)
1294 or (ExtractFPCParamsForBuildAll(AProject.LastCompilerParams)
1295 <>ExtractFPCParamsForBuildAll(CompilerParams))
1296 or ((AProject.LastCompilerFileDate>0)
1297 and FileExistsCached(CompilerFilename)
1298 and (FileAgeCached(CompilerFilename)<>AProject.LastCompilerFileDate))
1299 then
1300 NeedBuildAllFlag:=true;
1301
1302 StateFileAge:=FileAgeCached(StateFilename);
1303
1304 // check main source file
1305 if FileExistsCached(SrcFilename) and (StateFileAge<FileAgeCached(SrcFilename)) then
1306 begin
1307 if ConsoleVerbosity>=0 then
1308 DebugLn(DbgCap,'SrcFile outdated ',AProject.IDAsString);
1309 Note+='Source file "'+SrcFilename+'" of '+AProject.IDAsString+' outdated:'+LineEnding
1310 +' Source age='+FileAgeToStr(FileAgeCached(SrcFilename))+LineEnding
1311 +' State file age='+FileAgeToStr(StateFileAge)+LineEnding
1312 +' State file='+StateFilename+LineEnding;
1313 exit(mrYes);
1314 end;
1315
1316 // check compiler and params
1317 if CompilerFilename<>AProject.LastCompilerFilename then begin
1318 if ConsoleVerbosity>=0 then begin
1319 DebugLn(DbgCap,'Compiler filename changed for ',AProject.IDAsString);
1320 DebugLn(' Old="',AProject.LastCompilerFilename,'"');
1321 DebugLn(' Now="',CompilerFilename,'"');
1322 end;
1323 Note+='Compiler filename changed for '+AProject.IDAsString+':'+LineEnding
1324 +' Old="'+AProject.LastCompilerFilename+'"'+LineEnding
1325 +' Now="'+CompilerFilename+'"'+LineEnding
1326 +' State file='+StateFilename+LineEnding;
1327 exit(mrYes);
1328 end;
1329 if not FileExistsCached(CompilerFilename) then begin
1330 if ConsoleVerbosity>=0 then begin
1331 DebugLn(DbgCap,'Compiler file not found for ',AProject.IDAsString);
1332 DebugLn(' File="',CompilerFilename,'"');
1333 end;
1334 Note+='Compiler file "'+CompilerFilename+'" not found for '+AProject.IDAsString+'.'+LineEnding;
1335 exit(mrYes);
1336 end;
1337 if FileAgeCached(CompilerFilename)<>AProject.LastCompilerFileDate then begin
1338 if ConsoleVerbosity>=0 then begin
1339 DebugLn(DbgCap,'Compiler file changed for ',AProject.IDAsString);
1340 DebugLn(' File="',CompilerFilename,'"');
1341 end;
1342 Note+='Compiler file "'+CompilerFilename+'" for '+AProject.IDAsString+' changed:'+LineEnding
1343 +' Old="'+FileAgeToStr(AProject.LastCompilerFileDate)+'"'+LineEnding
1344 +' Now="'+FileAgeToStr(FileAgeCached(CompilerFilename))+'"'+LineEnding
1345 +' State file='+StateFilename+LineEnding;
1346 exit(mrYes);
1347 end;
1348 if CompilerParams<>AProject.LastCompilerParams then begin
1349 if ConsoleVerbosity>=0 then begin
1350 DebugLn(DbgCap,'Compiler params changed for ',AProject.IDAsString);
1351 DebugLn(' Old="',AProject.LastCompilerParams,'"');
1352 DebugLn(' Now="',CompilerParams,'"');
1353 end;
1354 Note+='Compiler params changed for '+AProject.IDAsString+':'+LineEnding
1355 +' Old="'+AProject.LastCompilerParams+'"'+LineEnding
1356 +' Now="'+CompilerParams+'"'+LineEnding
1357 +' State file='+StateFilename+LineEnding;
1358 exit(mrYes);
1359 end;
1360
1361 // compiler and parameters are the same
1362 // => it is possible to quick compile without -B
1363 NeedBuildAllFlag:=false;
1364
1365 if not AProject.LastCompileComplete then begin
1366 if ConsoleVerbosity>=0 then
1367 DebugLn(DbgCap,'Compile was incomplete for ',AProject.IDAsString);
1368 Note+='Last compile was incomplete.'+LineEnding
1369 +' State file='+StateFilename+LineEnding;
1370 exit(mrYes);
1371 end;
1372
1373 // check all required packages
1374 Result:=PackageGraph.CheckCompileNeedDueToDependencies(AProject,
1375 AProject.FirstRequiredDependency,
1376 not (pfUseDesignTimePackages in AProject.Flags),
1377 StateFileAge,Note);
1378 if Result<>mrNo then exit;
1379
1380 // check project files
1381 AnUnitInfo:=AProject.FirstPartOfProject;
1382 while AnUnitInfo<>nil do begin
1383 if (not AnUnitInfo.IsVirtual) and FileExistsCached(AnUnitInfo.Filename) then
1384 begin
1385 if (StateFileAge<FileAgeCached(AnUnitInfo.Filename)) then begin
1386 if ConsoleVerbosity>=0 then
1387 DebugLn(DbgCap,'Src has changed ',AProject.IDAsString,' ',AnUnitInfo.Filename);
1388 Note+='File "'+AnUnitInfo.Filename+'" of '+AProject.IDAsString+' is newer than state file:'+LineEnding
1389 +' File age="'+FileAgeToStr(FileAgeCached(AnUnitInfo.Filename))+'"'+LineEnding
1390 +' State file age="'+FileAgeToStr(StateFileAge)+'"'+LineEnding
1391 +' State file='+StateFilename+LineEnding;
1392 exit(mrYes);
1393 end;
1394 if AnUnitInfo.ComponentName<>'' then begin
1395 LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lfm');
1396 if FileExistsCached(LFMFilename)
1397 and (StateFileAge<FileAgeCached(LFMFilename)) then begin
1398 if ConsoleVerbosity>=0 then
1399 DebugLn(DbgCap,'LFM has changed ',AProject.IDAsString,' ',LFMFilename);
1400 Note+='File "'+LFMFilename+'" of '+AProject.IDAsString+' is newer than state file:'+LineEnding
1401 +' File age="'+FileAgeToStr(FileAgeCached(LFMFilename))+'"'+LineEnding
1402 +' State file age="'+FileAgeToStr(StateFileAge)+'"'+LineEnding
1403 +' State file='+StateFilename+LineEnding;
1404 exit(mrYes);
1405 end;
1406 end;
1407 end;
1408 AnUnitInfo:=AnUnitInfo.NextPartOfProject;
1409 end;
1410
1411 // check all open editor files in unit/include path (maybe the user forgot
1412 // to add them to the project)
1413 AnUnitInfo:=AProject.FirstUnitWithEditorIndex;
1414 while AnUnitInfo<>nil do begin
1415 if EditorFileHasChanged then
1416 exit(mrYes);
1417 AnUnitInfo:=AnUnitInfo.NextUnitWithEditorIndex;
1418 end;
1419
1420 // check project resources
1421 IcoRes:=TProjectIcon(AProject.ProjResources[TProjectIcon]);
1422 if (IcoRes<>nil) and (not IcoRes.IsEmpty)
1423 and FilenameIsAbsolute(IcoRes.IcoFileName)
1424 and FileExistsCached(IcoRes.IcoFileName)
1425 and (StateFileAge<FileAgeCached(IcoRes.IcoFileName)) then begin
1426 if ConsoleVerbosity>=0 then
1427 debugln([DbgCap,'icon has changed ',
1428 AProject.IDAsString,' "',IcoRes.IcoFileName,'"']);
1429 Note+='Project''s ico file "'+IcoRes.IcoFileName+'" is newer than state file:'+LineEnding
1430 +' File age="'+FileAgeToStr(FileAgeCached(IcoRes.IcoFileName))+'"'+LineEnding
1431 +' State file age="'+FileAgeToStr(StateFileAge)+'"'+LineEnding
1432 +' State file='+StateFilename+LineEnding;
1433 exit(mrYes);
1434 end;
1435
1436 // check target file
1437 aTargetFilename:=AProject.CompilerOptions.CreateTargetFilename;
1438 //debugln(['TBuildManager.DoCheckIfProjectNeedsCompilation aTargetFilename=',aTargetFilename]);
1439 if (aTargetFilename<>'') and not FileExistsCached(aTargetFilename) then begin
1440 if ConsoleVerbosity>=0 then
1441 debugln([DbgCap,'missing target file "',aTargetFilename,'"']);
1442 Note+='Project''s target file "'+aTargetFilename+'" is missing.';
1443 exit(mrYes);
1444 end;
1445
1446 if not HasGUI then
1447 debugln(['Hint: (lazarus) Build Project: nothing to do.']);
1448 Result:=mrNo;
1449 end;
1450
1451 procedure TBuildManager.DoOnRescanFPCDirectoryCache(Sender: TObject);
1452 var
1453 Files: TStringList;
1454 FPCSrcDir: string;
1455 begin
1456 FPCSrcDir := EnvironmentOptions.GetParsedFPCSourceDirectory;
1457 Files := GatherFilesInFPCSources(FPCSrcDir, nil);
1458 if Files<>nil then
1459 try
1460 ApplyFPCSrcFiles(FPCSrcDir, Files);
1461 finally
1462 Files.Free;
1463 end;
1464 end;
1465
CheckAmbiguousSourcesnull1466 function TBuildManager.CheckAmbiguousSources(const AFilename: string;
1467 Compiling: boolean): TModalResult;
1468
1469 function DeleteAmbiguousFile(const AmbiguousFilename: string): TModalResult;
1470 begin
1471 if not DeleteFileUTF8(AmbiguousFilename) then begin
1472 Result:=IDEMessageDialog(lisErrorDeletingFile,
1473 Format(lisUnableToDeleteAmbiguousFile, [AmbiguousFilename]),
1474 mtError,[mbOk,mbAbort]);
1475 end else
1476 Result:=mrOk;
1477 end;
1478
1479 function RenameAmbiguousFile(const AmbiguousFilename: string): TModalResult;
1480 var
1481 NewFilename: string;
1482 begin
1483 NewFilename:=AmbiguousFilename+'.ambiguous';
1484 if not RenameFileUTF8(AmbiguousFilename,NewFilename) then
1485 begin
1486 Result:=IDEMessageDialog(lisErrorRenamingFile,
1487 Format(lisUnableToRenameAmbiguousFileTo,[AmbiguousFilename,LineEnding,NewFilename]),
1488 mtError,[mbOk,mbAbort]);
1489 end else
1490 Result:=mrOk;
1491 end;
1492
1493 function AddCompileWarning(const AmbiguousFilename: string): TModalResult;
1494 begin
1495 Result:=mrOk;
1496 if Compiling then begin
1497 IDEMessagesWindow.AddCustomMessage(mluError,
1498 Format('ambiguous file found: "%s". Source file is: "%s"',
1499 [AmbiguousFilename, AFilename]));
1500 end;
1501 end;
1502
1503 function CheckFile(const AmbiguousFilename: string): TModalResult;
1504 begin
1505 Result:=mrOk;
1506 if CompareFilenames(AFilename,AmbiguousFilename)=0 then exit;
1507 if not FileExistsUTF8(AmbiguousFilename) then exit;
1508 if Compiling then begin
1509 Result:=AddCompileWarning(AmbiguousFilename);
1510 exit;
1511 end;
1512 case EnvironmentOptions.AmbiguousFileAction of
1513 afaAsk:
1514 begin
1515 Result:=IDEMessageDialog(lisAmbiguousFileFound,
1516 Format(lisThereIsAFileWithTheSameNameAndASimilarExtension,
1517 [LineEnding, AFilename, LineEnding, AmbiguousFilename, LineEnding+LineEnding]),
1518 mtWarning,[mbYes,mbIgnore,mbAbort]);
1519 case Result of
1520 mrYes: Result:=DeleteAmbiguousFile(AmbiguousFilename);
1521 mrIgnore: Result:=mrOk;
1522 end;
1523 end;
1524
1525 afaAutoDelete:
1526 Result:=DeleteAmbiguousFile(AmbiguousFilename);
1527
1528 afaAutoRename:
1529 Result:=RenameAmbiguousFile(AmbiguousFilename);
1530
1531 afaWarnOnCompile:
1532 Result:=AddCompileWarning(AmbiguousFilename);
1533
1534 else
1535 Result:=mrOk;
1536 end;
1537 end;
1538
1539 var
1540 LowExt: string;
1541 i: integer;
1542 begin
1543 Result:=mrOk;
1544 if EnvironmentOptions.AmbiguousFileAction=afaIgnore then exit;
1545 if (EnvironmentOptions.AmbiguousFileAction=afaWarnOnCompile)
1546 and not Compiling then exit;
1547
1548 if FilenameHasPascalExt(AFilename) then begin
1549 LowExt:=lowercase(ExtractFileExt(AFilename));
1550 for i:=Low(PascalFileExt) to High(PascalFileExt) do begin
1551 if LowExt<>PascalFileExt[i] then begin
1552 Result:=CheckFile(ChangeFileExt(AFilename,PascalFileExt[i]));
1553 if Result<>mrOk then exit;
1554 end;
1555 end;
1556 end;
1557 end;
1558
DeleteAmbiguousFilesnull1559 function TBuildManager.DeleteAmbiguousFiles(const Filename: string): TModalResult;
1560 var
1561 ADirectory: String;
1562 FileInfo: TSearchRec;
1563 ShortFilename: String;
1564 CurFilename: String;
1565 IsPascalUnit: Boolean;
1566 AUnitName: String;
1567 begin
1568 if EnvironmentOptions.AmbiguousFileAction=afaIgnore then exit(mrOK);
1569 if EnvironmentOptions.AmbiguousFileAction in [afaAsk,afaAutoDelete,afaAutoRename]
1570 then begin
1571 ADirectory:=AppendPathDelim(ExtractFilePath(Filename));
1572 if FindFirstUTF8(ADirectory+GetAllFilesMask,faAnyFile,FileInfo)=0 then
1573 begin
1574 ShortFilename:=ExtractFileName(Filename);
1575 IsPascalUnit:=FilenameHasPascalExt(ShortFilename);
1576 AUnitName:=ExtractFilenameOnly(ShortFilename);
1577 repeat
1578 if (FileInfo.Name='.') or (FileInfo.Name='..')
1579 or (FileInfo.Name='')
1580 or ((FileInfo.Attr and faDirectory)<>0) then continue;
1581 if CompareFilenames(ShortFilename,FileInfo.Name)=0 then continue;
1582
1583 if (SysUtils.CompareText(ShortFilename,FileInfo.Name)=0)
1584 then begin
1585 // same name different case => ambiguous
1586 end else if IsPascalUnit and FilenameHasPascalExt(FileInfo.Name)
1587 and (SysUtils.CompareText(AUnitName,ExtractFilenameOnly(FileInfo.Name))=0)
1588 then begin
1589 // same unit name => ambiguous
1590 end else
1591 continue;
1592
1593 CurFilename:=ADirectory+FileInfo.Name;
1594 if EnvironmentOptions.AmbiguousFileAction=afaAsk then begin
1595 if IDEMessageDialog(lisDeleteAmbiguousFile,
1596 Format(lisAmbiguousFileFoundThisFileCanBeMistakenWithDelete,
1597 [CurFilename, LineEnding, ShortFilename, LineEnding+LineEnding]),
1598 mtConfirmation,[mbYes,mbNo])=mrNo
1599 then continue;
1600 end;
1601 if EnvironmentOptions.AmbiguousFileAction in [afaAutoDelete,afaAsk]
1602 then begin
1603 Result:=DeleteFileInteractive(CurFilename);
1604 if not (Result in [mrOK,mrIgnore]) then exit(mrCancel);
1605 end else if EnvironmentOptions.AmbiguousFileAction=afaAutoRename then
1606 begin
1607 Result:=BackupFileForWrite(CurFilename);
1608 if not (Result in [mrOK,mrIgnore]) then exit(mrCancel);
1609 if FileExistsUTF8(CurFilename) then begin
1610 Result:=DeleteFileInteractive(CurFilename);
1611 if not (Result in [mrOK,mrIgnore]) then exit(mrCancel);
1612 end;
1613 end;
1614 until FindNextUTF8(FileInfo)<>0;
1615 end;
1616 FindCloseUTF8(FileInfo);
1617 end;
1618 Result:=mrOk;
1619 end;
1620
1621 {-------------------------------------------------------------------------------
1622 function TBuildManager.CheckUnitPathForAmbiguousPascalFiles(
1623 const BaseDir, TheUnitPath, CompiledExt, ContextDescription: string
1624 ): TModalResult;
1625
1626 Collect all pascal files and all compiled units in the unit path and check
1627 for ambiguous files. For example: doubles.
1628 -------------------------------------------------------------------------------}
CheckUnitPathForAmbiguousPascalFilesnull1629 function TBuildManager.CheckUnitPathForAmbiguousPascalFiles(const BaseDir,
1630 TheUnitPath, CompiledExt, ContextDescription: string): TModalResult;
1631
1632 procedure FreeUnitTree(var Tree: TAVLTree);
1633 var
1634 ANode: TAVLTreeNode;
1635 AnUnitFile: PUnitFile;
1636 begin
1637 if Tree<>nil then begin
1638 ANode:=Tree.FindLowest;
1639 while ANode<>nil do begin
1640 AnUnitFile:=PUnitFile(ANode.Data);
1641 Dispose(AnUnitFile);
1642 ANode:=Tree.FindSuccessor(ANode);
1643 end;
1644 Tree.Free;
1645 Tree:=nil;
1646 end;
1647 end;
1648
1649 var
1650 EndPos: Integer;
1651 StartPos: Integer;
1652 CurDir: String;
1653 FileInfo: TSearchRec;
1654 SourceUnitTree, CompiledUnitTree: TAVLTree;
1655 ANode: TAVLTreeNode;
1656 CurUnitName: String;
1657 CurFilename: String;
1658 AnUnitFile: PUnitFile;
1659 CurUnitTree: TAVLTree;
1660 FileInfoNeedClose: Boolean;
1661 UnitPath: String;
1662 IgnoreAll: Boolean;
1663 begin
1664 Result:=mrOk;
1665 UnitPath:=TrimSearchPath(TheUnitPath,BaseDir,true);
1666
1667 SourceUnitTree:=TAVLTree.Create(TListSortCompare(@CompareUnitFiles));
1668 CompiledUnitTree:=TAVLTree.Create(TListSortCompare(@CompareUnitFiles));
1669 FileInfoNeedClose:=false;
1670 try
1671 // collect all units (.pas, .pp, compiled units)
1672 EndPos:=1;
1673 while EndPos<=length(UnitPath) do begin
1674 StartPos:=EndPos;
1675 while (StartPos<=length(UnitPath)) and (UnitPath[StartPos]=';') do
1676 inc(StartPos);
1677 EndPos:=StartPos;
1678 while (EndPos<=length(UnitPath)) and (UnitPath[EndPos]<>';') do
1679 inc(EndPos);
1680 if EndPos>StartPos then begin
1681 CurDir:=AppendPathDelim(TrimFilename(copy(UnitPath,StartPos,EndPos-StartPos)));
1682 FileInfoNeedClose:=true;
1683 if FindFirstUTF8(CurDir+GetAllFilesMask,faAnyFile,FileInfo)=0 then begin
1684 IgnoreAll:=false;
1685 repeat
1686 if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
1687 or ((FileInfo.Attr and faDirectory)<>0) then continue;
1688 if FilenameHasPascalExt(FileInfo.Name) then
1689 CurUnitTree:=SourceUnitTree
1690 else if FilenameExtIs(FileInfo.Name,CompiledExt,true) then
1691 CurUnitTree:=CompiledUnitTree
1692 else
1693 continue;
1694 CurUnitName:=ExtractFilenameOnly(FileInfo.Name);
1695 if not LazIsValidIdent(CurUnitName) then
1696 continue;
1697 CurFilename:=CurDir+FileInfo.Name;
1698 //DebugLn(['TBuildManager.CheckUnitPathForAmbiguousPascalFiles ',CurUnitName,' ',CurFilename]);
1699 // check if unit already found
1700 ANode:=CurUnitTree.FindKey(PChar(CurUnitName),
1701 TListSortCompare(@CompareUnitNameAndUnitFile));
1702 if (ANode<>nil) and (not IgnoreAll) then begin
1703 if ConsoleVerbosity>=0 then
1704 DebugLn(['Note: (lazarus) [TBuildManager.CheckUnitPathForAmbiguousPascalFiles] CurUnitName="',CurUnitName,'" CurFilename="',CurFilename,'" OtherUnitName="',PUnitFile(ANode.Data)^.FileUnitName,'" OtherFilename="',PUnitFile(ANode.Data)^.Filename,'"']);
1705 // pascal unit exists twice
1706 Result:=IDEQuestionDialog(lisAmbiguousUnitFound,
1707 Format(lisTheUnitExistsTwiceInTheUnitPathOfThe,[CurUnitName,ContextDescription])
1708 +LineEnding
1709 +LineEnding
1710 +'1. "'+PUnitFile(ANode.Data)^.Filename+'"'+LineEnding
1711 +'2. "'+CurFilename+'"'+LineEnding
1712 +LineEnding
1713 +lisHintCheckIfTwoPackagesContainAUnitWithTheSameName,
1714 mtWarning, [mrIgnore,
1715 mrYesToAll, lisIgnoreAll,
1716 mrAbort]);
1717 case Result of
1718 mrIgnore: ;
1719 mrYesToAll: IgnoreAll:=true;
1720 else exit;
1721 end;
1722 end;
1723 // add unit to tree
1724 New(AnUnitFile);
1725 AnUnitFile^.FileUnitName:=CurUnitName;
1726 AnUnitFile^.Filename:=CurFilename;
1727 CurUnitTree.Add(AnUnitFile);
1728 until FindNextUTF8(FileInfo)<>0;
1729 end;
1730 FindCloseUTF8(FileInfo);
1731 FileInfoNeedClose:=false;
1732 end;
1733 end;
1734 finally
1735 // clean up
1736 if FileInfoNeedClose then FindCloseUTF8(FileInfo);
1737 FreeUnitTree(SourceUnitTree);
1738 FreeUnitTree(CompiledUnitTree);
1739 end;
1740 Result:=mrOk;
1741 end;
1742
CreateProjectApplicationBundlenull1743 function TBuildManager.CreateProjectApplicationBundle: Boolean;
1744 var
1745 TargetExeName: string;
1746 begin
1747 Result := False;
1748 if Project1.MainUnitInfo = nil then
1749 Exit;
1750 TargetExeName := Project1.CompilerOptions.CreateTargetFilename;
1751
1752 if not (CreateApplicationBundle(TargetExeName, Project1.GetTitle, True, Project1) in
1753 [mrOk, mrIgnore]) then
1754 Exit;
1755 if not (CreateAppBundleSymbolicLink(TargetExeName, True) in [mrOk, mrIgnore]) then
1756 Exit;
1757 Result := True;
1758 end;
1759
BackupFileForWritenull1760 function TBuildManager.BackupFileForWrite(const Filename: string): TModalResult;
1761 var BackupFilename, CounterFilename: string;
1762 AText,ACaption:string;
1763 BackupInfo: TBackupInfo;
1764 FilePath, FileNameOnly, FileExt, SubDir: string;
1765 i: integer;
1766 IsPartOfProject: boolean;
1767 begin
1768 Result:=mrOk;
1769 SubDir:='';
1770 BackupFilename:='';
1771 if not (FileExistsUTF8(Filename)) then exit;
1772 // check if file in lpi
1773 IsPartOfProject:=(Project1<>nil)
1774 and (Project1.FindFile(Filename,[pfsfOnlyProjectFiles])<>nil);
1775 // check if file in source directory of project
1776 if (not IsPartOfProject) and (Project1<>nil)
1777 and (SearchDirectoryInSearchPath(ExtractFilePath(Filename),
1778 Project1.SourceDirectories.CreateSearchPathFromAllFiles)>0)
1779 then
1780 IsPartOfProject:=true;
1781 // check options
1782 if IsPartOfProject then
1783 BackupInfo:=EnvironmentOptions.BackupInfoProjectFiles
1784 else
1785 BackupInfo:=EnvironmentOptions.BackupInfoOtherFiles;
1786 if (BackupInfo.BackupType=bakNone)
1787 or ((BackupInfo.BackupType=bakSameName) and (BackupInfo.SubDirectory='')) then
1788 exit;
1789 // create backup
1790 FilePath:=ExtractFilePath(Filename);
1791 FileExt:=ExtractFileExt(Filename);
1792 FileNameOnly:=ExtractFilenameOnly(Filename);
1793 SubDir:=BackupInfo.SubDirectory;
1794 if BackupInfo.SubDirectory<>'' then
1795 GlobalMacroList.SubstituteStr(SubDir);
1796 if SubDir<>'' then begin
1797 if not FilenameIsAbsolute(SubDir) then
1798 SubDir:=TrimFilename(FilePath+SubDir);
1799 Result:=ForceDirectoryInteractive(SubDir,[mbRetry,mbIgnore]);
1800 if Result=mrCancel then exit;
1801 if Result=mrIgnore then Result:=mrOk;
1802 end;
1803 if BackupInfo.BackupType in
1804 [bakSymbolInFront,bakSymbolBehind,bakUserDefinedAddExt,bakSameName] then
1805 begin
1806 case BackupInfo.BackupType of
1807 bakSymbolInFront:
1808 BackupFilename:=FileNameOnly+'.~'+copy(FileExt,2,length(FileExt)-1);
1809 bakSymbolBehind:
1810 BackupFilename:=FileNameOnly+FileExt+'~';
1811 bakUserDefinedAddExt:
1812 BackupFilename:=FileNameOnly+FileExt+'.'+BackupInfo.AdditionalExtension;
1813 bakSameName:
1814 BackupFilename:=FileNameOnly+FileExt;
1815 end;
1816 if BackupInfo.SubDirectory<>'' then
1817 BackupFilename:=AppendPathDelim(SubDir)+BackupFilename
1818 else
1819 BackupFilename:=FilePath+BackupFilename;
1820 // remove old backup file
1821 repeat
1822 if FileExistsUTF8(BackupFilename) then begin
1823 if not DeleteFileUTF8(BackupFilename) then begin
1824 ACaption:=lisDeleteFileFailed;
1825 AText:=Format(lisUnableToRemoveOldBackupFile,[BackupFilename]);
1826 Result:=IDEMessageDialog(ACaption,AText,mtError,[mbAbort,mbRetry,mbIgnore]);
1827 if Result=mrAbort then exit;
1828 if Result=mrIgnore then Result:=mrOk;
1829 end;
1830 end;
1831 until Result<>mrRetry;
1832 end else begin
1833 // backup with counter
1834 if BackupInfo.SubDirectory<>'' then
1835 BackupFilename:=AppendPathDelim(SubDir)+FileNameOnly+FileExt+';'
1836 else
1837 BackupFilename:=Filename+';';
1838 if BackupInfo.MaxCounter<=0 then begin
1839 // search first non existing backup filename
1840 i:=1;
1841 while FileExistsUTF8(BackupFilename+IntToStr(i)) do inc(i);
1842 BackupFilename:=BackupFilename+IntToStr(i);
1843 end else begin
1844 // rename all backup files (increase number)
1845 i:=1;
1846 while FileExistsUTF8(BackupFilename+IntToStr(i))
1847 and (i<=BackupInfo.MaxCounter) do inc(i);
1848 if i>BackupInfo.MaxCounter then begin
1849 dec(i);
1850 CounterFilename:=BackupFilename+IntToStr(BackupInfo.MaxCounter);
1851 // remove old backup file
1852 repeat
1853 if FileExistsUTF8(CounterFilename) then begin
1854 if not DeleteFileUTF8(CounterFilename) then begin
1855 ACaption:=lisDeleteFileFailed;
1856 AText:=Format(lisUnableToRemoveOldBackupFile,[CounterFilename]);
1857 Result:=IDEMessageDialog(ACaption,AText,mtError,[mbAbort,mbRetry,mbIgnore]);
1858 if Result=mrAbort then exit;
1859 if Result=mrIgnore then Result:=mrOk;
1860 end;
1861 end;
1862 until Result<>mrRetry;
1863 end;
1864 // rename all old backup files
1865 dec(i);
1866 while i>=1 do begin
1867 repeat
1868 if not RenameFileUTF8(BackupFilename+IntToStr(i),
1869 BackupFilename+IntToStr(i+1)) then
1870 begin
1871 ACaption:=lisRenameFileFailed;
1872 AText:=Format(lisUnableToRenameFileTo,
1873 [BackupFilename+IntToStr(i), BackupFilename+IntToStr(i+1)]);
1874 Result:=IDEMessageDialog(ACaption,AText,mtError,
1875 [mbAbort,mbRetry,mbIgnore]);
1876 if Result=mrAbort then exit;
1877 if Result=mrIgnore then Result:=mrOk;
1878 end;
1879 until Result<>mrRetry;
1880 dec(i);
1881 end;
1882 BackupFilename:=BackupFilename+'1';
1883 end;
1884 end;
1885 // backup file
1886 repeat
1887 if not IDEProcs.BackupFileForWrite(Filename, BackupFilename) then
1888 begin
1889 ACaption := lisBackupFileFailed;
1890 AText := Format(lisUnableToBackupFileTo, [Filename, BackupFilename]);
1891 Result := IDEMessageDialog(ACaption,AText,mterror,[mbabort,mbretry,mbignore]);
1892 if Result = mrAbort then exit;
1893 if Result = mrIgnore then Result := mrOk;
1894 end
1895 else
1896 Result := mrOk;
1897 until Result <> mrRetry;
1898 end;
1899
GetResourceTypenull1900 function TBuildManager.GetResourceType(AnUnitInfo: TUnitInfo): TResourceType;
1901 begin
1902 if AnUnitInfo.Source = nil then
1903 AnUnitInfo.Source := CodeToolBoss.LoadFile(AnUnitInfo.Filename, True, False);
1904 if (AnUnitInfo.Source <> nil) and GuessResourceType(AnUnitInfo.Source, Result) then
1905 begin
1906 // guessed from source
1907 end
1908 else
1909 if AnUnitInfo.IsPartOfProject then
1910 begin
1911 // use project resource type
1912 Result := AnUnitInfo.Project.ProjResources.ResourceType;
1913 end
1914 else
1915 Result := rtLRS;
1916 end;
1917
FindLRSFilenamenull1918 function TBuildManager.FindLRSFilename(AnUnitInfo: TUnitInfo;
1919 UseDefaultIfNotFound: boolean): string;
1920 begin
1921 if AnUnitInfo.IsVirtual then begin
1922 Result:='';
1923 end else begin
1924 Result:=ExtractFileNameOnly(AnUnitInfo.Filename)+ResourceFileExt;
1925 Result:=FileUtil.SearchFileInPath(Result,'',
1926 CodeToolBoss.GetIncludePathForDirectory(ExtractFilePath(AnUnitInfo.Filename)),
1927 ';',[sffDontSearchInBasePath,sffSearchLoUpCase,sffFile]);
1928 end;
1929 if (Result='') and UseDefaultIfNotFound then
1930 Result:=GetDefaultLRSFilename(AnUnitInfo);
1931 end;
1932
GetDefaultLRSFilenamenull1933 function TBuildManager.GetDefaultLRSFilename(AnUnitInfo: TUnitInfo): string;
1934 var
1935 OutputDir: String;
1936 begin
1937 if AnUnitInfo.IsPartOfProject
1938 and (not AnUnitInfo.Project.IsVirtual)
1939 and (pfLRSFilesInOutputDirectory in Project1.Flags) then begin
1940 OutputDir:=AnUnitInfo.Project.GetOutputDirectory;
1941 if OutputDir<>'' then begin
1942 Result:=AppendPathDelim(OutputDir)
1943 +ExtractFileNameOnly(AnUnitInfo.Filename)+ResourceFileExt;
1944 exit;
1945 end;
1946 end;
1947 Result:=ChangeFileExt(AnUnitInfo.Filename,ResourceFileExt);
1948 end;
1949
UpdateLRSFromLFMnull1950 function TBuildManager.UpdateLRSFromLFM(AnUnitInfo: TUnitInfo;
1951 ShowAbort: boolean): TModalResult;
1952 var
1953 LFMFilename: String;
1954 LRSFilename: String;
1955 Dir: String;
1956 begin
1957 Result:=mrOk;
1958 // check if there is a .lfm file
1959 if AnUnitInfo.IsVirtual then exit;
1960 LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lfm');
1961 if not FileExistsCached(LFMFilename) then exit(mrOk);
1962 // check if there is a .lrs file
1963 LRSFilename:=FindLRSFilename(AnUnitInfo,true);
1964 if LRSFilename=LFMFilename then exit;
1965 // check if .lrs file is newer than .lfm file
1966 if FileExistsUTF8(LRSFilename)
1967 and (FileAgeUTF8(LFMFilename)<=FileAgeUTF8(LRSFilename))
1968 then exit;
1969 // the .lrs file does not exist, or is older than the .lfm file
1970 // -> update .lrs file
1971 Dir:=ExtractFilePath(LRSFilename);
1972 Result:=ForceDirectoryInteractive(Dir,[mbRetry]);
1973 if Result<>mrOk then exit;
1974 Result:=ConvertLFMToLRSFileInteractive(LFMFilename,LRSFilename,ShowAbort);
1975 end;
1976
UpdateProjectAutomaticFilesnull1977 function TBuildManager.UpdateProjectAutomaticFiles(TestDir: string): TModalResult;
1978 var
1979 AnUnitInfo: TUnitInfo;
1980 begin
1981 Result:=mrOk;
1982 // update project resource
1983 Project1.ProjResources.Regenerate(Project1.MainFileName, False, True, TestDir);
1984 AnUnitInfo := Project1.FirstPartOfProject;
1985 while AnUnitInfo<>nil do
1986 begin
1987 if AnUnitInfo.HasResources then begin
1988 case GetResourceType(AnUnitInfo) of
1989 rtLRS:
1990 begin
1991 Result := UpdateLRSFromLFM(AnUnitInfo,false);
1992 if Result = mrIgnore then Result:=mrOk;
1993 if Result <> mrOk then exit;
1994 end;
1995 rtRes: // This fixed encoding of source files but only if rtRes type. Why?
1996 begin // Source was read in every time although encoding is correct most of times.
1997 end;
1998 end;
1999 end;
2000 AnUnitInfo := AnUnitInfo.NextPartOfProject;
2001 end;
2002 end;
2003
MacroFuncMakeExenull2004 function TBuildManager.MacroFuncMakeExe(const Filename: string;
2005 const Data: PtrInt; var Abort: boolean): string;
2006 var
2007 CommaPos: SizeInt;
2008 CurTargetOS: String;
2009 CurFilename: String;
2010 begin
2011 CurFilename:=Filename;
2012 CommaPos:=System.Pos(',',CurFilename);
2013 CurTargetOS:='';
2014 if CommaPos>1 then begin
2015 // makeexe(targetos,filename)
2016 CurTargetOS:=UTF8LowerCase(LeftStr(CurFilename,CommaPos-1));
2017 if IsValidIdent(CurTargetOS) then begin
2018 if CurTargetOS='ide' then
2019 CurTargetOS:=GetCompiledTargetOS;
2020 System.Delete(CurFilename,1,CommaPos);
2021 end;
2022 end;
2023 if CurTargetOS='' then
2024 CurTargetOS:=GetTargetOS;
2025 Result:=MakeStandardExeFilename(CurTargetOS,CurFilename);
2026 //DebugLn('TMainIDE.MacroFuncMakeExe A ',Filename,' ',Result);
2027 end;
2028
MacroFuncMakeLibnull2029 function TBuildManager.MacroFuncMakeLib(const Filename: string;
2030 const Data: PtrInt; var Abort: boolean): string;
2031 begin
2032 Result:=MakeStandardLibFilename(GetTargetOS,Filename);
2033 end;
2034
MacroFuncInstantFPCCachenull2035 function TBuildManager.MacroFuncInstantFPCCache(const Param: string;
2036 const Data: PtrInt; var Abort: boolean): string;
2037 var
2038 Prog: String;
2039 List: TStringList;
2040 begin
2041 if not FMacroInstantFPCCacheValid then begin
2042 FMacroInstantFPCCache:='';
2043 FMacroInstantFPCCacheValid:=true;
2044 Prog:=FindDefaultExecutablePath('instantfpc'+GetExecutableExt);
2045 if Prog<>'' then begin
2046 List:=nil;
2047 try
2048 if ConsoleVerbosity>0 then
2049 debugln(['Hint: (lazarus) TBuildManager.MacroFuncInstantFPCCache ',Prog]);
2050 List:=RunTool(Prog,'--get-cache','',ConsoleVerbosity<1);
2051 if (List<>nil) and (List.Count>0) then
2052 FMacroInstantFPCCache:=List[0];
2053 List.Free;
2054 except
2055 on E: Exception do begin
2056 if ConsoleVerbosity>=0 then
2057 debugln(['Warning: (lazarus) [TBuildManager.MacroFuncInstantFPCCache] error running '+Prog+': '+E.Message]);
2058 end;
2059 end;
2060 end;
2061 if ConsoleVerbosity>=1 then
2062 debugln(['Hint: (lazarus) [TBuildManager.MacroFuncInstantFPCCache] ',FMacroInstantFPCCache]);
2063 end;
2064 Result:=FMacroInstantFPCCache;
2065 end;
2066
MacroFuncProjectnull2067 function TBuildManager.MacroFuncProject(const Param: string; const Data: PtrInt;
2068 var Abort: boolean): string;
2069 begin
2070 if Project1<>nil then begin
2071 if SysUtils.CompareText(Param,'SrcPath')=0 then
2072 Result:=Project1.CompilerOptions.GetSrcPath(false)
2073 else if SysUtils.CompareText(Param,'IncPath')=0 then
2074 Result:=Project1.CompilerOptions.GetIncludePath(false)
2075 else if SysUtils.CompareText(Param,'Namespaces')=0 then
2076 Result:=Project1.CompilerOptions.GetNamespacesParsed
2077 else if SysUtils.CompareText(Param,'UnitPath')=0 then
2078 Result:=Project1.CompilerOptions.GetUnitPath(false)
2079 else if SysUtils.CompareText(Param,'InfoFile')=0 then
2080 Result:=Project1.ProjectInfoFile
2081 else if SysUtils.CompareText(Param,'OutputDir')=0 then
2082 Result:=Project1.CompilerOptions.GetUnitOutPath(false)
2083 else begin
2084 Result:='<Invalid parameter for macro Project:'+Param+'>';
2085 if ConsoleVerbosity>=0 then
2086 debugln('Warning: (lazarus) [TMainIDE.MacroFuncProject]: ',Result);
2087 end;
2088 end else begin
2089 Result:='';
2090 end;
2091 end;
2092
MacroFuncLCLWidgetTypenull2093 function TBuildManager.MacroFuncLCLWidgetType(const Param: string;
2094 const Data: PtrInt; var Abort: boolean): string;
2095 begin
2096 if Data=CompilerOptionMacroPlatformIndependent then
2097 Result:='%(LCL_PLATFORM)'
2098 else
2099 Result:=GetLCLWidgetType;
2100 end;
2101
MacroFuncLazVernull2102 function TBuildManager.MacroFuncLazVer(const Param: string; const Data: PtrInt;
2103 var Abort: boolean): string;
2104 begin
2105 Result:=LazarusVersionStr;
2106 end;
2107
MacroFuncTargetCPUnull2108 function TBuildManager.MacroFuncTargetCPU(const Param: string;
2109 const Data: PtrInt; var Abort: boolean): string;
2110 begin
2111 if Data=CompilerOptionMacroPlatformIndependent then
2112 Result:='%(CPU_TARGET)'
2113 else if SysUtils.CompareText(Param,'IDE')=0 then
2114 Result:=GetCompiledTargetCPU
2115 else
2116 Result:=GetTargetCPU;
2117 end;
2118
MacroFuncTargetOSnull2119 function TBuildManager.MacroFuncTargetOS(const Param: string;
2120 const Data: PtrInt; var Abort: boolean): string;
2121 begin
2122 if Data=CompilerOptionMacroPlatformIndependent then
2123 Result:='%(OS_TARGET)'
2124 else if SysUtils.CompareText(Param,'IDE')=0 then
2125 Result:=GetCompiledTargetOS
2126 else
2127 Result:=GetTargetOS;
2128 end;
2129
MacroFuncIDEBuildOptionsnull2130 function TBuildManager.MacroFuncIDEBuildOptions(const Param: string;
2131 const Data: PtrInt; var Abort: boolean): string;
2132 begin
2133 if Data=CompilerOptionMacroPlatformIndependent then
2134 Result:=''
2135 else if (MiscellaneousOptions<>nil)
2136 and (MiscellaneousOptions.BuildLazOpts<>nil)
2137 then
2138 Result:=MiscellaneousOptions.BuildLazOpts.ExtraOptions
2139 else
2140 Result:='';
2141 end;
2142
MacroFuncPrimaryConfigPathnull2143 function TBuildManager.MacroFuncPrimaryConfigPath(const Param: string;
2144 const Data: PtrInt; var Abort: boolean): string;
2145 begin
2146 Result:=GetPrimaryConfigPath;
2147 end;
2148
MacroFuncSecondaryConfigPathnull2149 function TBuildManager.MacroFuncSecondaryConfigPath(const Param: string;
2150 const Data: PtrInt; var Abort: boolean): string;
2151 begin
2152 Result:=GetSecondaryConfigPath;
2153 end;
2154
MacroFuncFallbackOutputRootnull2155 function TBuildManager.MacroFuncFallbackOutputRoot(const Param: string;
2156 const Data: PtrInt; var Abort: boolean): string;
2157 begin
2158 Result:=AppendPathDelim(GetPrimaryConfigPath)+'lib';
2159 end;
2160
MacroFuncSrcOSnull2161 function TBuildManager.MacroFuncSrcOS(const Param: string; const Data: PtrInt;
2162 var Abort: boolean): string;
2163 begin
2164 if Data=CompilerOptionMacroPlatformIndependent then
2165 Result:='%(OS_TARGET)'
2166 else if Param<>'' then
2167 Result:=GetDefaultSrcOSForTargetOS(Param)
2168 else
2169 Result:=GetDefaultSrcOSForTargetOS(GetTargetOS);
2170 end;
2171
MacroFuncFPCVernull2172 function TBuildManager.MacroFuncFPCVer(const Param: string; const Data: PtrInt;
2173 var Abort: boolean): string;
2174
2175 function TryTarget(CompilerFilename, TargetOS, TargetCPU: String): boolean;
2176 var
2177 ConfigCache: TPCTargetConfigCache;
2178 begin
2179 Result:=false;
2180 ConfigCache:=CodeToolBoss.CompilerDefinesCache.ConfigCaches.Find(
2181 CompilerFilename,'',TargetOS,TargetCPU,true);
2182 if ConfigCache=nil then exit;
2183 if ConfigCache.NeedsUpdate then begin
2184 // ask compiler
2185 if not ConfigCache.Update(CodeToolBoss.CompilerDefinesCache.TestFilename,
2186 CodeToolBoss.CompilerDefinesCache.ExtraOptions,nil)
2187 then
2188 exit;
2189 end;
2190 FFPCVer:=ConfigCache.GetFPCVer;
2191 FFPC_FULLVERSION:=ConfigCache.GetFPC_FULLVERSION;
2192 Result:=FFPC_FULLVERSION>0;
2193 end;
2194
2195 procedure Compute;
2196 var
2197 TargetOS: String;
2198 TargetCPU: String;
2199 CompilerFilename, s: String;
2200 begin
2201 FFPC_FULLVERSION:=0;
2202 if OverrideFPCVer<>'' then begin
2203 FFPCVer:=OverrideFPCVer;
2204 FFPC_FULLVERSION:=FPCVersionToNumber(FFPCVer);
2205 exit;
2206 end;
2207 FFPCVer:={$I %FPCVERSION%}; // Version.Release.Patch
2208 if CodeToolBoss<>nil then begin
2209 // fetch the FPC version from the current compiler
2210 // Not from the fpc.exe, but from the real compiler
2211 CompilerFilename:=GetFPCompilerFilename;
2212 if not IsCTExecutable(CompilerFilename,s) then exit;
2213
2214 // 1. try with project target OS/CPU
2215 TargetOS:=GetTargetOS;
2216 TargetCPU:=GetTargetCPU;
2217 if IsPas2jsTargetOS(TargetOS) or IsPas2jsTargetCPU(TargetCPU) then
2218 // skip
2219 else if TryTarget(CompilerFilename,TargetOS,TargetCPU) then
2220 exit;
2221
2222 // 2. try with IDE target OS/CPU
2223 TargetOS:=GetCompiledTargetOS;
2224 TargetCPU:=GetCompiledTargetCPU;
2225 if TryTarget(CompilerFilename,TargetOS,TargetCPU) then exit;
2226
2227 // 3. try with no target OS/CPU - using whatever the compiler supports
2228 TargetOS:='';
2229 TargetCPU:='';
2230 if TryTarget(CompilerFilename,TargetOS,TargetCPU) then exit;
2231 end;
2232 FFPC_FULLVERSION:=FPCVersionToNumber(FFPCVer);
2233 end;
2234
2235 begin
2236 if FFPCVerChangeStamp<>CompilerParseStamp then
2237 begin
2238 Compute;
2239 FFPCVerChangeStamp:=CompilerParseStamp;
2240 {$IFDEF VerboseFPCSrcScan}
2241 debugln(['TBuildManager.MacroFuncFPCVer FPCVer=',FFPCVer,' FPC_FULLVERSION=',FFPC_FULLVERSION,' Stamp=',FFPCVerChangeStamp]);
2242 {$ENDIF}
2243 end;
2244 Result:=FFPCVer;
2245 end;
2246
MacroFuncFPC_FULLVERSIONnull2247 function TBuildManager.MacroFuncFPC_FULLVERSION(const Param: string;
2248 const Data: PtrInt; var Abort: boolean): string;
2249 begin
2250 if FFPCVerChangeStamp<>CompilerParseStamp then
2251 MacroFuncFPCVer(Param,Data,Abort);
2252 Result:=IntToStr(FFPC_FULLVERSION);
2253 end;
2254
MacroFuncParamsnull2255 function TBuildManager.MacroFuncParams(const Param: string; const Data: PtrInt;
2256 var Abort: boolean): string;
2257 begin
2258 if (Project1<>nil) and (Project1.RunParameterOptions.GetActiveMode<>nil) then
2259 Result:=Project1.RunParameterOptions.GetActiveMode.CmdLineParams
2260 else
2261 Result:='';
2262 end;
2263
MacroFuncProjFilenull2264 function TBuildManager.MacroFuncProjFile(const Param: string;
2265 const Data: PtrInt; var Abort: boolean): string;
2266 begin
2267 if Project1<>nil then
2268 Result:=Project1.MainFilename
2269 else
2270 Result:='';
2271 end;
2272
MacroFuncProjPathnull2273 function TBuildManager.MacroFuncProjPath(const Param: string;
2274 const Data: PtrInt; var Abort: boolean): string;
2275 begin
2276 if Project1<>nil then
2277 Result:=Project1.Directory
2278 else
2279 Result:='';
2280 end;
2281
MacroFuncTargetFilenull2282 function TBuildManager.MacroFuncTargetFile(const Param: string;
2283 const Data: PtrInt; var Abort: boolean): string;
2284 begin
2285 if Project1<>nil then
2286 Result:=GetProjectTargetFilename(Project1)
2287 else
2288 Result:='';
2289 end;
2290
MacroFuncOutputFilenull2291 function TBuildManager.MacroFuncOutputFile(const Param: string;
2292 const Data: PtrInt; var Abort: boolean): string;
2293 begin
2294 if Project1<>nil then
2295 Result:=Project1.CompilerOptions.CreateTargetFilename
2296 else
2297 Result:='';
2298 end;
2299
MacroFuncTargetCmdLinenull2300 function TBuildManager.MacroFuncTargetCmdLine(const Param: string;
2301 const Data: PtrInt; var Abort: boolean): string;
2302 begin
2303 Result:='';
2304 if (Project1<>nil) then begin
2305 if (Project1.RunParameterOptions.GetActiveMode<>nil) then
2306 Result:=Project1.RunParameterOptions.GetActiveMode.CmdLineParams;
2307 if Result='' then
2308 Result:=GetProjectTargetFilename(Project1)
2309 else
2310 Result:=GetProjectTargetFilename(Project1)+' '+Result;
2311 end;
2312 end;
2313
MacroFuncRunCmdLinenull2314 function TBuildManager.MacroFuncRunCmdLine(const Param: string;
2315 const Data: PtrInt; var Abort: boolean): string;
2316 begin
2317 if Project1<>nil then
2318 Result:=GetRunCommandLine
2319 else
2320 Result:='';
2321 end;
2322
MacroFuncProjPublishDirnull2323 function TBuildManager.MacroFuncProjPublishDir(const Param: string;
2324 const Data: PtrInt; var Abort: boolean): string;
2325 begin
2326 Result:=GetProjectPublishDir;
2327 end;
2328
MacroFuncProjUnitPathnull2329 function TBuildManager.MacroFuncProjUnitPath(const Param: string;
2330 const Data: PtrInt; var Abort: boolean): string;
2331 begin
2332 if Project1<>nil then
2333 Result:=Project1.CompilerOptions.GetUnitPath(false)
2334 else
2335 Result:='';
2336 end;
2337
MacroFuncProjIncPathnull2338 function TBuildManager.MacroFuncProjIncPath(const Param: string;
2339 const Data: PtrInt; var Abort: boolean): string;
2340 begin
2341 if Project1<>nil then
2342 Result:=Project1.CompilerOptions.GetIncludePath(false)
2343 else
2344 Result:='';
2345 end;
2346
MacroFuncProjNamespacesnull2347 function TBuildManager.MacroFuncProjNamespaces(const Param: string;
2348 const Data: PtrInt; var Abort: boolean): string;
2349 begin
2350 if Project1<>nil then
2351 begin
2352 Result:=MergeWithDelimiter(GetProjectDefaultNamespace,
2353 Project1.CompilerOptions.GetNamespacesParsed,';');
2354 end
2355 else
2356 Result:='';
2357 end;
2358
MacroFuncProjSrcPathnull2359 function TBuildManager.MacroFuncProjSrcPath(const Param: string;
2360 const Data: PtrInt; var Abort: boolean): string;
2361 begin
2362 if Project1<>nil then
2363 Result:=Project1.CompilerOptions.GetSrcPath(false)
2364 else
2365 Result:='';
2366 end;
2367
MacroFuncProjOutDirnull2368 function TBuildManager.MacroFuncProjOutDir(const Param: string;
2369 const Data: PtrInt; var Abort: boolean): string;
2370 begin
2371 if Project1<>nil then
2372 Result:=Project1.CompilerOptions.GetUnitOutPath(false)
2373 else
2374 Result:='';
2375 end;
2376
MacroFuncEnvnull2377 function TBuildManager.MacroFuncEnv(const Param: string; const Data: PtrInt;
2378 var Abort: boolean): string;
2379 begin
2380 Result:=GetEnvironmentVariableUTF8(Param);
2381 end;
2382
MacroFuncCompPathnull2383 function TBuildManager.MacroFuncCompPath(const s: string; const Data: PtrInt;
2384 var Abort: boolean): string;
2385 // if parameter is 'IDE' return the environment option
2386 // otherwise use active project's compiler
2387 begin
2388 Result:='';
2389 if CompareText(s,'IDE')<>0 then
2390 Result:=GetCompilerFilename;
2391
2392 if Result='' then
2393 Result:=EnvironmentOptions.GetParsedCompilerFilename;
2394 end;
2395
MacroFuncFPCMsgFilenull2396 function TBuildManager.MacroFuncFPCMsgFile(const Param: string;
2397 const Data: PtrInt; var Abort: boolean): string;
2398 begin
2399 Result:=EnvironmentOptions.GetParsedCompilerMessagesFilename;
2400 end;
2401
TBuildManager.MacroFuncMakenull2402 function TBuildManager.MacroFuncMake(const Param: string; const Data: PtrInt;
2403 var Abort: boolean): string;
2404 begin
2405 Result:=EnvironmentOptions.GetParsedMakeFilename;
2406 if Result='' then
2407 Result:=FindDefaultMakePath;
2408 end;
2409
CTMacroFuncProjectNamespacesnull2410 function TBuildManager.CTMacroFuncProjectNamespaces(Data: Pointer): boolean;
2411 var
2412 FuncData: PReadFunctionData;
2413 begin
2414 FuncData:=PReadFunctionData(Data);
2415 Result:=false;
2416 if Project1<>nil then begin
2417 FuncData^.Result:=MergeWithDelimiter(GetProjectDefaultNamespace,
2418 Project1.CompilerOptions.GetNamespacesParsed(),';');
2419 Result:=true;
2420 end;
2421 end;
2422
CTMacroFuncProjectUnitPathnull2423 function TBuildManager.CTMacroFuncProjectUnitPath(Data: Pointer): boolean;
2424 var
2425 FuncData: PReadFunctionData;
2426 begin
2427 FuncData:=PReadFunctionData(Data);
2428 Result:=false;
2429 if Project1<>nil then begin
2430 FuncData^.Result:=Project1.CompilerOptions.GetUnitPath(false);
2431 Result:=true;
2432 end;
2433 end;
2434
TBuildManager.CTMacroFuncProjectIncPathnull2435 function TBuildManager.CTMacroFuncProjectIncPath(Data: Pointer): boolean;
2436 var
2437 FuncData: PReadFunctionData;
2438 begin
2439 FuncData:=PReadFunctionData(Data);
2440 Result:=false;
2441 if Project1<>nil then begin
2442 FuncData^.Result:=
2443 Project1.CompilerOptions.GetIncludePath(false,coptParsed,true);
2444 Result:=true;
2445 end;
2446 end;
2447
CTMacroFuncProjectSrcPathnull2448 function TBuildManager.CTMacroFuncProjectSrcPath(Data: Pointer): boolean;
2449 var
2450 FuncData: PReadFunctionData;
2451 begin
2452 FuncData:=PReadFunctionData(Data);
2453 Result:=false;
2454 if Project1<>nil then begin
2455 FuncData^.Result:=Project1.CompilerOptions.GetSrcPath(false);
2456 Result:=true;
2457 end;
2458 end;
2459
2460 procedure TBuildManager.SetUnitSetCache(const AValue: TFPCUnitSetCache);
2461 begin
2462 if FUnitSetCache=AValue then exit;
2463 FUnitSetCache:=AValue;
2464 if UnitSetCache<>nil then begin
2465 FreeNotification(UnitSetCache);
2466 FUnitSetChangeStamp:=UnitSetCache.GetInvalidChangeStamp;
2467 end;
2468 end;
2469
TBuildManager.GetProjectDefaultNamespacenull2470 function TBuildManager.GetProjectDefaultNamespace: string;
2471 // called by codetools *before* parsing
2472 // Important: use only basiccodetools
2473 var
2474 AnUnitInfo: TUnitInfo;
2475 NameStart, NameEnd: Integer;
2476 Code: TCodeBuffer;
2477 ModuleType, ModuleName: string;
2478 NestedComments: boolean;
2479 begin
2480 Result:='';
2481 if Project1=nil then exit;
2482 if not (pfMainUnitIsPascalSource in Project1.Flags) then exit;
2483 AnUnitInfo:=Project1.MainUnitInfo;
2484 if AnUnitInfo=nil then exit;
2485 Code:=AnUnitInfo.Source;
2486 if Code=nil then exit;
2487 if (Code<>FProjectNameSpaceCode) or (Code.ChangeStep<>FProjectNameSpaceCodeChgStep) then
2488 begin
2489 // read namespace
2490 FProjectNameSpace:='';
2491 FProjectNameSpaceCode:=Code;
2492 FProjectNameSpaceCodeChgStep:=Code.ChangeStep;
2493 NestedComments:=CompareText(Project1.CompilerOptions.SyntaxMode,'delphi')<>0;
2494 ModuleName:=FindModuleNameInSource(Code.Source,ModuleType,NameStart,
2495 NameEnd,NestedComments);
2496 FProjectNameSpace:=ChompDottedIdentifier(ModuleName);
2497 end;
2498 Result:=FProjectNameSpace;
2499 end;
2500
2501 procedure TBuildManager.Notification(AComponent: TComponent;
2502 Operation: TOperation);
2503 begin
2504 inherited Notification(AComponent, Operation);
2505 if Operation=opRemove then begin
2506 if FUnitSetCache=AComponent then
2507 FUnitSetCache:=nil;
2508 end;
2509 end;
2510
OnGetBuildMacroValuesnull2511 function TBuildManager.OnGetBuildMacroValues(Options: TBaseCompilerOptions;
2512 IncludeSelf: boolean): TCTCfgScriptVariables;
2513 {off $DEFINE VerboseBuildMacros}
2514
2515 procedure AddAllInherited(FirstDependency: TPkgDependency;
2516 AddTo: TCTCfgScriptVariables);
2517 var
2518 List: TFPList;
2519 i: Integer;
2520 APackage: TLazPackage;
2521 Values: TCTCfgScriptVariables;
2522 OtherOpts: TPkgCompilerOptions;
2523 j: Integer;
2524 Macro: TLazBuildMacro;
2525 Value: PCTCfgScriptVariable;
2526 begin
2527 if FirstDependency=nil then exit;
2528 List:=nil;
2529 try
2530 PackageGraph.GetAllRequiredPackages(nil,FirstDependency,List);
2531 if List=nil then exit;
2532 for i:=0 to List.Count-1 do begin
2533 // add values of build macros of used package
2534 APackage:=TLazPackage(List[i]);
2535 OtherOpts:=APackage.CompilerOptions;
2536 if OtherOpts.BuildMacros=nil then continue;
2537 Values:=OnGetBuildMacroValues(OtherOpts,true);
2538 if Values=nil then continue;
2539 for j:=0 to OtherOpts.BuildMacros.Count-1 do begin
2540 Macro:=OtherOpts.BuildMacros[j];
2541 if Macro.Identifier='' then continue;
2542 Value:=Values.GetVariable(PChar(Macro.Identifier));
2543 if Value=nil then begin
2544 //debugln(['AddAllInherited InhPkg=',APackage.Name,' Macro="',Macro.Identifier,'" no value']);
2545 continue;
2546 end else begin
2547 //debugln(['AddAllInherited InhPkg=',APackage.Name,' Macro="',Macro.Identifier,'" Value="',dbgs(Value),'"']);
2548 AddTo.AddOverride(Value);
2549 end;
2550 end;
2551 end;
2552 finally
2553 List.Free;
2554 end;
2555 end;
2556
2557 procedure SetCmdLineOverrides(Values: TCTCfgScriptVariables);
2558 var
2559 Overrides: TStrings;
2560 i: Integer;
2561 begin
2562 // set overrides (e.g. command line parameters)
2563 Overrides:=GetBuildMacroOverrides;
2564 try
2565 for i:=0 to Overrides.Count-1 do
2566 Values.Values[Overrides.Names[i]]:=Overrides.ValueFromIndex[i];
2567 {$IFDEF VerboseBuildMacros}
2568 debugln(['TBuildManager.OnGetBuildMacroValues cmd line overrides=',dbgstr(Overrides.Text)]);
2569 {$ENDIF}
2570 finally
2571 Overrides.Free;
2572 end;
2573 end;
2574
2575 procedure SetDefaults(Values: TCTCfgScriptVariables);
2576 var
2577 s: String;
2578 begin
2579 // add the defaults
2580 // Note: see also ide/frames/compiler_buildmacro_options.pas procedure TCompOptBuildMacrosFrame.BuildMacrosTreeViewEdited
2581 // TargetOS
2582 if not Values.IsDefined('TargetOS') then begin
2583 s:='';
2584 if FBuildTarget<>nil then
2585 s:=FBuildTarget.CompilerOptions.TargetOS;
2586 if s='' then
2587 s:=fTargetOS;
2588 if s='' then begin
2589 {$IFDEF VerboseDefaultCompilerTarget}
2590 debugln(['SetDefaults WARNING: no TargetOS']);
2591 {$ENDIF}
2592 s:=GetCompiledTargetOS;
2593 end;
2594 Values.Values['TargetOS']:=s;
2595 end;
2596 // SrcOS
2597 if not Values.IsDefined('SrcOS') then begin
2598 s:=GetDefaultSrcOSForTargetOS(Result.Values['TargetOS']);
2599 Values.Values['SrcOS']:=s;
2600 end;
2601 // SrcOS2
2602 if not Result.IsDefined('SrcOS2') then begin
2603 s:=GetDefaultSrcOS2ForTargetOS(Result.Values['TargetOS']);
2604 Values.Values['SrcOS2']:=s;
2605 end;
2606 // TargetCPU
2607 if not Values.IsDefined('TargetCPU') then begin
2608 s:='';
2609 if FBuildTarget<>nil then
2610 s:=FBuildTarget.CompilerOptions.TargetCPU;
2611 if s='' then
2612 s:=fTargetCPU;
2613 Values.Values['TargetCPU']:=s;
2614 if s='' then begin
2615 {$IFDEF VerboseDefaultCompilerTarget}
2616 debugln(['SetDefaults WARNING: no TargetCPU']);
2617 {$ENDIF}
2618 s:=GetCompiledTargetCPU;
2619 end;
2620 end;
2621 end;
2622
2623 procedure ApplyMacroOverrides(Vars: TCTCfgScriptVariables);
2624 var
2625 Target: String;
2626 ActiveMode: String;
2627 begin
2628 ActiveMode:=GetActiveBuildModeName;
2629 Target:=GetModeMatrixTarget(Options);
2630 if EnvironmentOptions<>nil then
2631 ApplyBuildMatrixMacros(EnvironmentOptions.BuildMatrixOptions,Target,ActiveMode,Vars);
2632 if FBuildTarget<>nil then begin
2633 ApplyBuildMatrixMacros(FBuildTarget.BuildModes.SharedMatrixOptions,Target,ActiveMode,Vars);
2634 ApplyBuildMatrixMacros(FBuildTarget.BuildModes.SessionMatrixOptions,Target,ActiveMode,Vars);
2635 end;
2636 SetCmdLineOverrides(Vars);
2637 {$IFDEF VerboseBuildMacros}
2638 Vars.WriteDebugReport('OnGetBuildMacroValues after applying project values');
2639 {$ENDIF}
2640 SetDefaults(Vars);
2641 end;
2642
2643 var
2644 ParseOpts: TParsedCompilerOptions;
2645 Values: TCTCfgScriptVariables;
2646 begin
2647 Result:=nil;
2648
2649 ParseOpts:=Options.ParsedOpts;
2650 if ParseOpts=nil then exit;
2651
2652 if IncludeSelf then begin
2653 Result:=ParseOpts.MacroValues.Variables;
2654 if ParseOpts.MacroValuesStamp=BuildMacroChangeStamp then exit;
2655
2656 // compute macro values
2657
2658 if ParseOpts.MacroValuesParsing then begin
2659 if ConsoleVerbosity>=0 then
2660 debugln(['Warning: (lazarus) [TBuildManager.OnGetBuildMacroValues] cycle computing macros of ',dbgsname(Options.Owner)]);
2661 exit;
2662 end;
2663
2664 ParseOpts.MacroValuesParsing:=true;
2665 try
2666 Result.Clear;
2667
2668 // use inherited as default
2669 Values:=OnGetBuildMacroValues(Options,false);
2670
2671 // add macro values of self
2672 if Values<>nil then
2673 Result.Assign(Values);
2674 {$IF defined(VerboseBuildMacros) or defined(DebugLCLBaseConditionals)}
2675 if (Options.Owner is TLazPackage) and (TLazPackage(Options.Owner).Name='LCLBase') then
2676 Result.WriteDebugReport('TBuildManager.OnGetBuildMacroValues before execute: Conditionals="'+dbgstr(Options.Conditionals),'"');
2677 {$ENDIF}
2678 if not ParseOpts.MacroValues.Execute(Options.Conditionals) then begin
2679 if ConsoleVerbosity>=0 then
2680 debugln(['Error: (lazarus) [TBuildManager.OnGetBuildMacroValues] Error: ',ParseOpts.MacroValues.GetErrorStr(0)]);
2681 debugln(Options.Conditionals);
2682 end;
2683
2684 {$IFDEF VerboseBuildMacros}
2685 if (Options.Owner is TLazPackage) and (TLazPackage(Options.Owner).Name='LCL') then
2686 Result.WriteDebugReport('TBuildManager.OnGetBuildMacroValues executed: '+dbgstr(Options.Conditionals),' ');
2687 {$ENDIF}
2688
2689 // the macro values of the active project take precedence
2690 ApplyMacroOverrides(Result);
2691
2692 ParseOpts.MacroValuesStamp:=BuildMacroChangeStamp;
2693 finally
2694 ParseOpts.MacroValuesParsing:=false;
2695 end;
2696 end else begin
2697 Result:=ParseOpts.InheritedMacroValues;
2698 if ParseOpts.InheritedMacroValuesStamp=BuildMacroChangeStamp then exit;
2699
2700 // compute inherited values
2701 if ParseOpts.InheritedMacroValuesParsing then begin
2702 if ConsoleVerbosity>=0 then
2703 debugln(['Error: (lazarus) [TBuildManager.OnGetBuildMacroValues] cycle detected computing inherited macros of ',dbgsname(Options.Owner)]);
2704 exit;
2705 end;
2706 ParseOpts.InheritedMacroValuesParsing:=true;
2707 try
2708 Result.Clear;
2709
2710 // add inherited
2711 if (PackageGraph<>nil) then begin
2712 if Options.Owner is TProject then
2713 AddAllInherited(TProject(Options.Owner).FirstRequiredDependency,Result)
2714 else if Options.Owner is TLazPackage then
2715 AddAllInherited(TLazPackage(Options.Owner).FirstRequiredDependency,Result);
2716 end;
2717
2718 // the macro values of the active project take precedence
2719 ApplyMacroOverrides(Result);
2720
2721 ParseOpts.InheritedMacroValuesStamp:=BuildMacroChangeStamp;
2722 finally
2723 ParseOpts.InheritedMacroValuesParsing:=false;
2724 end;
2725 end;
2726 end;
2727
GetActiveBuildModeNamenull2728 function TBuildManager.GetActiveBuildModeName: string;
2729 begin
2730 if FBuildTarget<>nil then
2731 Result:=FBuildTarget.ActiveBuildMode.Identifier
2732 else
2733 Result:='default';
2734 end;
2735
2736 procedure TBuildManager.AppendMatrixCustomOption(Sender: TObject;
2737 var Options: string; Types: TBuildMatrixGroupTypes);
2738 var
2739 Target: String;
2740 ActiveMode: String;
2741 begin
2742 Target:=GetModeMatrixTarget(Sender);
2743 ActiveMode:=GetActiveBuildModeName;
2744 if bmgtEnvironment in Types then
2745 EnvironmentOptions.BuildMatrixOptions.AppendCustomOptions(Target,ActiveMode,Options);
2746 if FBuildTarget<>nil then begin
2747 if bmgtProject in Types then
2748 FBuildTarget.BuildModes.SharedMatrixOptions.AppendCustomOptions(Target,ActiveMode,Options);
2749 if bmgtSession in Types then
2750 FBuildTarget.BuildModes.SessionMatrixOptions.AppendCustomOptions(Target,ActiveMode,Options);
2751 end;
2752 end;
2753
2754 procedure TBuildManager.GetMatrixOutputDirectoryOverride(Sender: TObject;
2755 var OutDir: string; Types: TBuildMatrixGroupTypes);
2756 var
2757 Target: String;
2758 ActiveMode: String;
2759 begin
2760 Target:=GetModeMatrixTarget(Sender);
2761 ActiveMode:=GetActiveBuildModeName;
2762 if bmgtEnvironment in Types then
2763 EnvironmentOptions.BuildMatrixOptions.GetOutputDirectory(Target,ActiveMode,OutDir);
2764 if FBuildTarget<>nil then begin
2765 if bmgtProject in Types then
2766 FBuildTarget.BuildModes.SharedMatrixOptions.GetOutputDirectory(Target,ActiveMode,OutDir);
2767 if bmgtSession in Types then
2768 FBuildTarget.BuildModes.SessionMatrixOptions.GetOutputDirectory(Target,ActiveMode,OutDir);
2769 end;
2770 end;
2771
TBuildManager.GetModeMatrixTargetnull2772 function TBuildManager.GetModeMatrixTarget(Sender: TObject): string;
2773 begin
2774 Result:='';
2775 if Sender is TParsedCompilerOptions then
2776 Sender:=TParsedCompilerOptions(Sender).Owner;
2777 if Sender is TPkgAdditionalCompilerOptions then
2778 exit; // matrix options are added only to normal options
2779 if Sender is TPkgCompilerOptions then
2780 Sender:=TPkgCompilerOptions(Sender).Owner
2781 else if Sender is TProjectCompilerOptions then
2782 Sender:=TProjectCompilerOptions(Sender).Owner;
2783 if Sender is TProject then begin
2784 Result:=BuildMatrixProjectName;
2785 end else if Sender is TLazPackage then begin
2786 Result:=TLazPackage(Sender).Name;
2787 end else
2788 Result:=BuildMatrixIDEName;
2789 //debugln(['TBuildManager.GetModeMatrixTarget ',DbgSName(Sender),' Target="',Result,'"']);
2790 end;
2791
TBuildManager.EnvironmentOptionsIsGlobalModenull2792 function TBuildManager.EnvironmentOptionsIsGlobalMode(const Identifier: string
2793 ): boolean;
2794 begin
2795 Result:=true;
2796 if Project1=nil then exit;
2797 if Project1.BuildModes=nil then exit;
2798 // do not save enabled states of session modes
2799 Result:=not Project1.BuildModes.IsSessionMode(Identifier);
2800 end;
2801
2802 procedure TBuildManager.SetBuildTarget(const TargetOS, TargetCPU,
2803 LCLWidgetType: string; ScanFPCSrc: TScanModeFPCSources; Quiet: boolean);
2804
GetEffectiveLCLWidgetTypenull2805 function GetEffectiveLCLWidgetType: string;
2806 begin
2807 if OverrideLCLWidgetType<>'' then
2808 Result:=OverrideLCLWidgetType
2809 else if FBuildTarget<>nil then begin
2810 Result:=FBuildTarget.CompilerOptions.GetEffectiveLCLWidgetType
2811 end
2812 else
2813 Result:='';
2814 if (Result='') or (SysUtils.CompareText(Result,'default')=0) then
2815 Result:=GetLCLWidgetTypeName;
2816 Result:=lowercase(Result);
2817 end;
2818
2819 var
2820 OldTargetOS: String;
2821 OldTargetCPU: String;
2822 OldLCLWidgetType: String;
2823 PCTargetChanged: Boolean;
2824 LCLTargetChanged: Boolean;
2825 CompilerTargetOS: string;
2826 CompilerTargetCPU: string;
2827 CompQueryOptions: String;
2828 begin
2829 {$IFDEF VerboseDefaultCompilerTarget}
2830 debugln(['TBuildManager.SetBuildTarget TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" LCLWidgetType="',LCLWidgetType,'"']);
2831 {$ENDIF}
2832 OldTargetOS:=fTargetOS;
2833 OldTargetCPU:=fTargetCPU;
2834 OldLCLWidgetType:=fLCLWidgetType;
2835 OverrideTargetOS:=GetFPCTargetOS(TargetOS);
2836 OverrideTargetCPU:=GetFPCTargetCPU(TargetCPU);
2837 OverrideLCLWidgetType:=lowercase(LCLWidgetType);
2838
2839 // compute new TargetOS
2840 if OverrideTargetOS<>'' then
2841 fTargetOS:=OverrideTargetOS
2842 else if FBuildTarget<>nil then
2843 fTargetOS:=FBuildTarget.CompilerOptions.TargetOS
2844 else
2845 fTargetOS:='';
2846 if SysUtils.CompareText(fTargetOS,'default')=0 then
2847 fTargetOS:='';
2848
2849 // compute new TargetCPU
2850 if OverrideTargetCPU<>'' then
2851 fTargetCPU:=OverrideTargetCPU
2852 else if FBuildTarget<>nil then
2853 fTargetCPU:=FBuildTarget.CompilerOptions.TargetCPU
2854 else
2855 fTargetCPU:='';
2856 if SysUtils.CompareText(fTargetCPU,'default')=0 then
2857 fTargetCPU:='';
2858
2859 if (fTargetOS='') or (fTargetCPU='') then
2860 begin
2861 // use compiler default target
2862 CompQueryOptions:='';
2863 if fTargetCPU<>'' then
2864 CompQueryOptions:='-P'+GetFPCTargetCPU(fTargetCPU)
2865 else if fTargetOS<>'' then
2866 CompQueryOptions:='-T'+GetFPCTargetOS(fTargetOS);
2867 // Note: resolving the comiler filename requires macros
2868 CodeToolBoss.CompilerDefinesCache.ConfigCaches.GetDefaultCompilerTarget(
2869 GetCompilerFilename,CompQueryOptions,CompilerTargetOS,CompilerTargetCPU);
2870 if fTargetOS='' then
2871 fTargetOS:=CompilerTargetOS;
2872 if fTargetOS='' then
2873 fTargetOS:=GetCompiledTargetOS;
2874 if fTargetCPU='' then
2875 fTargetCPU:=CompilerTargetCPU;
2876 if fTargetCPU='' then
2877 fTargetCPU:=GetCompiledTargetCPU;
2878 // the macros were resolved with default values
2879 // => invalidate macros so they now use the actual values
2880 IncreaseBuildMacroChangeStamp;
2881 if ConsoleVerbosity>1 then
2882 debugln(['Hint: (lazarus) [TBuildManager.SetBuildTarget] OS=',fTargetOS,' CPU=',fTargetCPU,' CompQueryOptions=',CompQueryOptions,' DefaultOS=',CompilerTargetOS,' DefaultCPU=',CompilerTargetCPU]);
2883 end;
2884
2885 fTargetOS:=GetFPCTargetOS(fTargetOS);
2886 fTargetCPU:=GetFPCTargetCPU(fTargetCPU);
2887
2888 PCTargetChanged:=(OldTargetOS<>fTargetOS)
2889 or (OldTargetCPU<>fTargetCPU)
2890 or (CodeToolBoss.DefineTree.FindDefineTemplateByName(
2891 StdDefTemplLazarusSources,true)=nil);
2892 if PCTargetChanged then
2893 begin
2894 IncreaseBuildMacroChangeStamp;
2895 CodeToolBoss.DefineTree.ClearCache;
2896 end;
2897
2898 // compute new LCLWidgetType
2899 fLCLWidgetType:=GetEffectiveLCLWidgetType;
2900 LCLTargetChanged:=(OldLCLWidgetType<>fLCLWidgetType);
2901
2902 if PCTargetChanged or LCLTargetChanged then begin
2903 if ConsoleVerbosity>=0 then
2904 DebugLn(['Hint: (lazarus) [TBuildManager.SetBuildTarget] Old=',OldTargetCPU,
2905 '-',OldTargetOS,'-',OldLCLWidgetType,' New=',fTargetCPU,'-',fTargetOS,
2906 '-',fLCLWidgetType,' Changed: OS/CPU=',PCTargetChanged,' LCL=',LCLTargetChanged]);
2907 end;
2908 if LCLTargetChanged then
2909 CodeToolBoss.SetGlobalValue(ExternalMacroStart+'LCLWidgetType',fLCLWidgetType);
2910 if ScanFPCSrc<>smsfsSkip then
2911 RescanCompilerDefines(false,false,ScanFPCSrc=smsfsWaitTillDone,Quiet);
2912 //if (PackageGraph<>nil) and (PackageGraph.CodeToolsPackage<>nil) then
2913 // debugln(['TBuildManager.SetBuildTarget CODETOOLS OUTDIR=',PackageGraph.CodeToolsPackage.CompilerOptions.GetUnitOutPath(true,coptParsed),
2914 // ' ',PackageGraph.CodeToolsPackage.CompilerOptions.ParsedOpts.ParsedStamp[pcosOutputDir],' ',CompilerParseStamp]);
2915 end;
2916
2917 procedure TBuildManager.SetBuildTargetProject1;
2918 begin
2919 SetBuildTargetProject1(true);
2920 end;
2921
2922 procedure TBuildManager.SetBuildTargetProject1(Quiet: boolean;
2923 ScanFPCSrc: TScanModeFPCSources);
2924 begin
2925 //debugln(['TBuildManager.SetBuildTargetProject1 START']);
2926 FBuildTarget:=Project1;
2927 if FBuildTarget<>nil then
2928 FBuildTarget.IDEOptions.AddHandlerDestroy(@OnProjectDestroy);
2929 SetBuildTarget('','','',ScanFPCSrc,Quiet);
2930 end;
2931
2932 procedure TBuildManager.SetBuildTargetIDE(aQuiet: boolean);
2933 var
2934 NewTargetOS: String;
2935 NewTargetCPU: String;
2936 NewLCLWidgetSet: String;
2937 begin
2938 //debugln(['TBuildManager.SetBuildTargetIDE START']);
2939 FBuildTarget:=nil;
2940 with MiscellaneousOptions do begin
2941 NewTargetOS:=BuildLazOpts.TargetOS;
2942 NewTargetCPU:=BuildLazOpts.TargetCPU;
2943 NewLCLWidgetSet:=LCLPlatformDirNames[BuildLazOpts.TargetPlatform];
2944 end;
2945 if ConsoleVerbosity>=1 then
2946 debugln(['Hint: (lazarus) [TBuildManager.SetBuildTargetIDE] OS=',NewTargetOS,' CPU=',NewTargetCPU,' WS=',NewLCLWidgetSet]);
2947 SetBuildTarget(NewTargetOS,NewTargetCPU,NewLCLWidgetSet,smsfsBackground,aQuiet);
2948 end;
2949
BuildTargetIDEIsDefaultnull2950 function TBuildManager.BuildTargetIDEIsDefault: boolean;
2951 // check if current BuildLazarus creates the normal lazarus exe
2952 // aka not some cross compile
2953 var
2954 NewTargetOS: String;
2955 NewTargetCPU: String;
2956 NewLCLWidgetSet: TLCLPlatform;
2957 begin
2958 with MiscellaneousOptions do begin
2959 NewTargetOS:=BuildLazOpts.TargetOS;
2960 NewTargetCPU:=BuildLazOpts.TargetCPU;
2961 NewLCLWidgetSet:=BuildLazOpts.TargetPlatform;
2962 end;
2963 //debugln(['TBuildManager.BuildTargetIDEIsDefault NewTargetOS=',NewTargetOS,' Default=',GetDefaultTargetOS,' NewTargetCPU=',NewTargetCPU,' default=',GetDefaultTargetCPU,' ws=',LCLPlatformDisplayNames[NewLCLWidgetSet],' default=',LCLPlatformDisplayNames[GetDefaultLCLWidgetType]]);
2964 Result:=((NewTargetOS='') or (CompareText(NewTargetOS, GetCompiledTargetOS)=0))
2965 and ((NewTargetCPU='') or (CompareText(NewTargetCPU, GetCompiledTargetCPU)=0))
2966 and (NewLCLWidgetSet<>lpNoGUI);
2967 // Note: no need to check if CompilerFilename is the default
2968 end;
2969
2970 end.
2971
2972