{ $Id: helpmanager.pas 9796 2006-09-02 21:10:32Z mattias $ } { /*************************************************************************** buildmanager.pas ---------------- ***************************************************************************/ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** } unit BuildManager; {$mode objfpc}{$H+} interface uses Classes, SysUtils, AVL_Tree, // LCL LConvEncoding, InterfaceBase, LCLProc, Dialogs, FileUtil, Forms, Controls, // codetools ExprEval, BasicCodeTools, CodeToolManager, DefineTemplates, CodeCache, CodeToolsCfgScript, Laz_XMLCfg, CodeToolsStructs, // IDEIntf SrcEditorIntf, ProjectIntf, MacroIntf, IDEDialogs, IDEExternToolIntf, CompOptsIntf, LazIDEIntf, // IDE LazarusIDEStrConsts, DialogProcs, IDEProcs, CodeToolsOptions, InputHistory, EditDefineTree, ProjectResources, MiscOptions, LazConf, EnvironmentOpts, TransferMacros, CompilerOptions, OutputFilter, Compiler, FPCSrcScan, PackageDefs, PackageSystem, Project, BaseBuildManager, ApplicationBundle, BuildProfileManager; type TBMScanFPCSources = ( bmsfsSkip, bmsfsWaitTillDone, // scan now and wait till finished bmsfsBackground // start in background ); { TBuildManager } TBuildManager = class(TBaseBuildManager) private CurrentParsedCompilerOption: TParsedCompilerOptions; FUnitSetCache: TFPCUnitSetCache; function OnSubstituteCompilerOption(Options: TParsedCompilerOptions; const UnparsedValue: string; PlatformIndependent: boolean): string; function MacroFuncEnv(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncFPCVer(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncLCLWidgetType(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncMake(const Param: string; const Data: PtrInt; var Abort: boolean): string;// make utility function MacroFuncMakeExe(const Filename: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncMakeLib(const Filename: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncParams(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncProject(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncProjFile(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncProjIncPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncProjOutDir(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncProjPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncProjPublishDir(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncProjSrcPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncProjUnitPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncRunCmdLine(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncSrcOS(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncTargetCmdLine(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncTargetCPU(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncTargetFile(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncTargetOS(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncIDEBuildOptions(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncPrimaryConfigPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncSecondaryConfigPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; function MacroFuncFallbackOutputRoot(const Param: string; const Data: PtrInt; var Abort: boolean): string; function CTMacroFuncProjectUnitPath(Data: Pointer): boolean; function CTMacroFuncProjectIncPath(Data: Pointer): boolean; function CTMacroFuncProjectSrcPath(Data: Pointer): boolean; procedure OnCmdLineCreate(var CmdLine: string; var Abort: boolean); function OnRunCompilerWithOptions(ExtTool: TIDEExternalToolOptions; CompOptions: TBaseCompilerOptions): TModalResult; procedure SetUnitSetCache(const AValue: TFPCUnitSetCache); protected fTargetOS: string; fTargetCPU: string; fLCLWidgetType: string; OverrideTargetOS: string; OverrideTargetCPU: string; OverrideLCLWidgetType: string; FUnitSetChangeStamp: integer; FFPCSrcScans: TFPCSrcScans; // Macro FPCVer FFPCVer: string; FFPCVerChangeStamp: integer; procedure Notification(AComponent: TComponent; Operation: TOperation); override; function OnGetBuildMacroValues(Options: TBaseCompilerOptions; IncludeSelf: boolean): TCTCfgScriptVariables; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetupTransferMacros; procedure SetupCompilerInterface; procedure SetupInputHistories; function GetBuildMacroOverride(const MacroName: string): string; override; function GetBuildMacroOverrides: TStrings; override; function GetTargetOS: string; override; function GetTargetCPU: string; override; function GetLCLWidgetType: string; override; function GetRunCommandLine: string; override; function GetProjectPublishDir: string; override; function GetProjectTargetFilename(aProject: TProject): string; override; function GetProjectUsesAppBundle: Boolean; override; function GetTestProjectFilename(aProject: TProject): string; override; function GetTestUnitFilename(AnUnitInfo: TUnitInfo): string; override; function GetTestBuildDirectory: string; override; function IsTestUnitFilename(const AFilename: string): boolean; override; function GetTargetUnitFilename(AnUnitInfo: TUnitInfo): string; override; procedure UpdateEnglishErrorMsgFilename; procedure RescanCompilerDefines(ResetBuildTarget, ClearCaches, WaitTillDone, Quiet: boolean); override; function CompilerOnDiskChanged: boolean; override; procedure LoadFPCDefinesCaches; procedure SaveFPCDefinesCaches; property UnitSetCache: TFPCUnitSetCache read FUnitSetCache write SetUnitSetCache; function CheckAmbiguousSources(const AFilename: string; Compiling: boolean): TModalResult; override; function DeleteAmbiguousFiles(const Filename:string ): TModalResult; override; function CheckUnitPathForAmbiguousPascalFiles(const BaseDir, TheUnitPath, CompiledExt, ContextDescription: string ): TModalResult; override; function CreateProjectApplicationBundle: Boolean; override; function BackupFile(const Filename: string): TModalResult; override; function GetResourceType(AnUnitInfo: TUnitInfo): TResourceType; function FindLRSFilename(AnUnitInfo: TUnitInfo; UseDefaultIfNotFound: boolean): string; function GetDefaultLRSFilename(AnUnitInfo: TUnitInfo): string; function UpdateLRSFromLFM(AnUnitInfo: TUnitInfo; ShowAbort: boolean): TModalResult; function UpdateProjectAutomaticFiles(TestDir: string): TModalResult; override; // methods for building IDE (will be changed when project groups are there) procedure SetBuildTarget(const TargetOS, TargetCPU, LCLWidgetType: string; ScanFPCSrc: TBMScanFPCSources; Quiet: boolean); procedure SetBuildTargetProject1(Quiet: boolean; ScanFPCSrc: TBMScanFPCSources = bmsfsBackground); procedure SetBuildTargetIDE; function BuildTargetIDEIsDefault: boolean; property FPCSrcScans: TFPCSrcScans read FFPCSrcScans; end; var MainBuildBoss: TBuildManager = nil; TheCompiler: TCompiler = nil; TheOutputFilter: TOutputFilter = nil; implementation type TUnitFile = record FileUnitName: string; Filename: string; end; PUnitFile = ^TUnitFile; procedure BMLazConfMacroFunction(var s: string); begin GlobalMacroList.SubstituteStr(s); end; function CompareUnitFiles(UnitFile1, UnitFile2: PUnitFile): integer; begin Result:=CompareIdentifierPtrs(Pointer(UnitFile1^.FileUnitName), Pointer(UnitFile2^.FileUnitName)); end; function CompareUnitNameAndUnitFile(UnitName: PChar; UnitFile: PUnitFile): integer; begin Result:=CompareIdentifierPtrs(Pointer(UnitName),Pointer(UnitFile^.FileUnitName)); end; { TBuildManager } function TBuildManager.OnSubstituteCompilerOption( Options: TParsedCompilerOptions; const UnparsedValue: string; PlatformIndependent: boolean): string; begin CurrentParsedCompilerOption:=Options; Result:=UnparsedValue; if PlatformIndependent then GlobalMacroList.SubstituteStr(Result,CompilerOptionMacroPlatformIndependent) else GlobalMacroList.SubstituteStr(Result,CompilerOptionMacroNormal); end; constructor TBuildManager.Create(AOwner: TComponent); begin FFPCVerChangeStamp:=InvalidParseStamp; MainBuildBoss:=Self; inherited Create(AOwner); fTargetOS:=GetDefaultTargetOS; fTargetCPU:=GetDefaultTargetCPU; fLCLWidgetType:=LCLPlatformDirNames[GetDefaultLCLWidgetType]; FUnitSetChangeStamp:=TFPCUnitSetCache.GetInvalidChangeStamp; OnBackupFileInteractive:=@BackupFile; RunCompilerWithOptions:=@OnRunCompilerWithOptions; GetBuildMacroValues:=@OnGetBuildMacroValues; end; destructor TBuildManager.Destroy; begin FreeAndNil(FFPCSrcScans); LazConfMacroFunc:=nil; OnBackupFileInteractive:=nil; FreeAndNil(InputHistories); inherited Destroy; MainBuildBoss:=nil; end; procedure TBuildManager.SetupTransferMacros; begin LazConfMacroFunc:=@BMLazConfMacroFunction; GlobalMacroList:=TTransferMacroList.Create; IDEMacros:=TLazIDEMacros.Create; CompilerOptions.OnParseString:=@OnSubstituteCompilerOption; // environment EnvironmentOptions.InitMacros(GlobalMacroList); // project GlobalMacroList.Add(TTransferMacro.Create('Project','', lisProjectMacroProperties,@MacroFuncProject,[])); GlobalMacroList.Add(TTransferMacro.Create('LCLWidgetType','', lisLCLWidgetType,@MacroFuncLCLWidgetType,[])); GlobalMacroList.Add(TTransferMacro.Create('TargetCPU','', lisTargetCPU,@MacroFuncTargetCPU,[])); GlobalMacroList.Add(TTransferMacro.Create('TargetOS','', lisTargetOS,@MacroFuncTargetOS,[])); GlobalMacroList.Add(TTransferMacro.Create('SrcOS','', lisSrcOS,@MacroFuncSrcOS,[])); GlobalMacroList.Add(TTransferMacro.Create('FPCVer','', lisFPCVersionEG222, @MacroFuncFPCVer, [])); GlobalMacroList.Add(TTransferMacro.Create('Params','', lisCommandLineParamsOfProgram,@MacroFuncParams,[])); GlobalMacroList.Add(TTransferMacro.Create('ProjFile','', lisProjectFilename,@MacroFuncProjFile,[])); GlobalMacroList.Add(TTransferMacro.Create('ProjPath','', lisProjectDirectory,@MacroFuncProjPath,[])); GlobalMacroList.Add(TTransferMacro.Create('TargetFile','', lisTargetFilenameOfProject,@MacroFuncTargetFile,[])); GlobalMacroList.Add(TTransferMacro.Create('TargetCmdLine','', lisTargetFilenamePlusParams,@MacroFuncTargetCmdLine,[])); GlobalMacroList.Add(TTransferMacro.Create('RunCmdLine','', lisLaunchingCmdLine,@MacroFuncRunCmdLine,[])); GlobalMacroList.Add(TTransferMacro.Create('ProjPublishDir','', lisPublishProjDir,@MacroFuncProjPublishDir,[])); GlobalMacroList.Add(TTransferMacro.Create('ProjUnitPath','', lisProjectUnitPath,@MacroFuncProjUnitPath,[])); GlobalMacroList.Add(TTransferMacro.Create('ProjIncPath','', lisProjectIncPath,@MacroFuncProjIncPath,[])); GlobalMacroList.Add(TTransferMacro.Create('ProjSrcPath','', lisProjectSrcPath,@MacroFuncProjSrcPath,[])); GlobalMacroList.Add(TTransferMacro.Create('ProjOutDir','', lisProjectOutDir,@MacroFuncProjOutDir,[])); GlobalMacroList.Add(TTransferMacro.Create('Env','', lisEnvironmentVariableNameAsParameter, @MacroFuncEnv, [])); GlobalMacroList.Add(TTransferMacro.Create('MakeExe','', lisMakeExe,@MacroFuncMakeExe,[])); GlobalMacroList.Add(TTransferMacro.Create('MakeLib','', lisMakeExe,@MacroFuncMakeLib,[])); GlobalMacroList.Add(TTransferMacro.Create('Make','', lisPathOfTheMakeUtility, @MacroFuncMake, [])); GlobalMacroList.Add(TTransferMacro.Create('IDEBuildOptions','', lisIDEBuildOptions, @MacroFuncIDEBuildOptions, [])); GlobalMacroList.Add(TTransferMacro.Create('PrimaryConfiPath','', lisPrimaryConfigPath, @MacroFuncPrimaryConfigPath, [])); GlobalMacroList.Add(TTransferMacro.Create('SecondaryConfigPath','', lisSecondaryConfigPath, @MacroFuncSecondaryConfigPath, [])); GlobalMacroList.Add(TTransferMacro.Create('FallbackOutputRoot','', lisSecondaryConfigPath, @MacroFuncFallbackOutputRoot, [])); // codetools macro functions CodeToolBoss.DefineTree.MacroFunctions.AddExtended( 'PROJECTUNITPATH',nil,@CTMacroFuncProjectUnitPath); CodeToolBoss.DefineTree.MacroFunctions.AddExtended( 'PROJECTINCPATH',nil,@CTMacroFuncProjectIncPath); CodeToolBoss.DefineTree.MacroFunctions.AddExtended( 'PROJECTSRCPATH',nil,@CTMacroFuncProjectSrcPath); end; procedure TBuildManager.SetupCompilerInterface; begin TheCompiler := TCompiler.Create; with TheCompiler do begin OnCommandLineCreate:=@OnCmdLineCreate; OutputFilter:=TheOutputFilter; end; end; procedure TBuildManager.SetupInputHistories; begin if InputHistories<>nil then exit; InputHistories:=TInputHistories.Create; with InputHistories do begin SetLazarusDefaultFilename; Load; end; end; function TBuildManager.GetBuildMacroOverride(const MacroName: string): string; begin Result:=''; if SysUtils.CompareText(MacroName,'TargetOS')=0 then Result:=OverrideTargetOS else if SysUtils.CompareText(MacroName,'TargetCPU')=0 then Result:=OverrideTargetCPU else if SysUtils.CompareText(MacroName,'LCLWidgetType')=0 then Result:=OverrideLCLWidgetType; end; function TBuildManager.GetBuildMacroOverrides: TStrings; begin Result:=TStringList.Create; if OverrideTargetOS<>'' then Result.Values['TargetOS']:=OverrideTargetOS; if OverrideTargetCPU<>'' then Result.Values['TargetCPU']:=OverrideTargetCPU; if OverrideLCLWidgetType<>'' then Result.Values['LCLWidgetType']:=OverrideLCLWidgetType; end; function TBuildManager.GetTargetOS: string; begin Result:=fTargetOS; end; function TBuildManager.GetTargetCPU: string; begin Result:=fTargetCPU; //debugln(['TBuildManager.GetTargetCPU ',Result]); end; function TBuildManager.GetLCLWidgetType: string; begin Result:=fLCLWidgetType; end; function TBuildManager.GetRunCommandLine: string; var TargetFileName: string; function GetTargetFilename: String; begin Result := GetProjectTargetFilename(Project1); if GetProjectUsesAppBundle then begin // return command line to Application Bundle (darwin only) Result := ExtractFileNameWithoutExt(Result) + '.app'; end; end; begin if Project1.RunParameterOptions.UseLaunchingApplication then Result := Project1.RunParameterOptions.LaunchingApplicationPathPlusParams else Result := ''; if Result='' then begin Result:=Project1.RunParameterOptions.CmdLineParams; if GlobalMacroList.SubstituteStr(Result) then begin TargetFileName:='"'+GetTargetFilename+'"'; if Result='' then Result:=TargetFileName else Result:=TargetFilename+' '+Result; end else Result:=''; end else begin if not GlobalMacroList.SubstituteStr(Result) then Result:=''; end; end; function TBuildManager.GetProjectPublishDir: string; begin if Project1=nil then begin Result:=''; exit; end; Result:=Project1.PublishOptions.DestinationDirectory; if GlobalMacroList.SubstituteStr(Result) then begin if FilenameIsAbsolute(Result) then begin Result:=AppendPathDelim(TrimFilename(Result)); end else begin Result:=''; end; end else begin Result:=''; end; end; function TBuildManager.GetProjectTargetFilename(aProject: TProject): string; begin Result:=''; if aProject=nil then exit; Result:=aProject.RunParameterOptions.HostApplicationFilename; if Result='' then begin if aProject.IsVirtual then Result:=GetTestProjectFilename(aProject) else begin if aProject.MainUnitID>=0 then begin Result := aProject.CompilerOptions.CreateTargetFilename(aProject.MainFilename); end; end; end; end; function TBuildManager.GetProjectUsesAppBundle: Boolean; begin Result := (Project1.RunParameterOptions.HostApplicationFilename = '') and (GetTargetOS = 'darwin') and Project1.UseAppBundle; end; function TBuildManager.GetTestProjectFilename(aProject: TProject): string; var TestDir: String; begin Result:=''; if aProject=nil then exit; if (aProject.MainUnitID<0) then exit; Result:=GetTestUnitFilename(aProject.MainUnitInfo); if Result='' then exit; Result:=aProject.CompilerOptions.CreateTargetFilename(Result); if Result='' then exit; if (not FilenameIsAbsolute(Result)) then begin TestDir:=GetTestBuildDirectory; if TestDir='' then exit; Result:=TestDir+Result; end; end; function TBuildManager.GetTestUnitFilename(AnUnitInfo: TUnitInfo): string; var TestDir: String; begin Result:=''; if AnUnitInfo=nil then exit; TestDir:=GetTestBuildDirectory; if TestDir='' then exit; Result:=ExtractFilename(AnUnitInfo.Filename); if Result='' then exit; Result:=TestDir+Result; end; function TBuildManager.GetTestBuildDirectory: string; begin Result:=EnvironmentOptions.GetTestBuildDirectory; end; function TBuildManager.IsTestUnitFilename(const AFilename: string): boolean; var TestDir: string; begin Result:=false; if Project1.IsVirtual then begin TestDir:=GetTestBuildDirectory; Result:=FileIsInPath(AFilename,TestDir); end; end; function TBuildManager.GetTargetUnitFilename(AnUnitInfo: TUnitInfo): string; begin if Project1.IsVirtual then Result:=GetTestUnitFilename(AnUnitInfo) else Result:=AnUnitInfo.Filename; end; procedure TBuildManager.UpdateEnglishErrorMsgFilename; begin if EnvironmentOptions.LazarusDirectory<>'' then begin CodeToolBoss.DefinePool.EnglishErrorMsgFilename:= AppendPathDelim(EnvironmentOptions.LazarusDirectory)+ SetDirSeparators('components/codetools/fpc.errore.msg'); CodeToolBoss.FPCDefinesCache.ExtraOptions:= '-Fr'+CodeToolBoss.DefinePool.EnglishErrorMsgFilename; end; end; procedure TBuildManager.RescanCompilerDefines(ResetBuildTarget, ClearCaches, WaitTillDone, Quiet: boolean); var TargetOS, TargetCPU: string; CompilerFilename: String; FPCSrcDir: string; ADefTempl: TDefineTemplate; FPCSrcCache: TFPCSourceCache; NeedUpdateFPCSrcCache: Boolean; IgnorePath: String; MsgResult: TModalResult; AsyncScanFPCSrcDir: String; procedure AddTemplate(ADefTempl: TDefineTemplate; AddToPool: boolean; const ErrorMsg: string); begin if ADefTempl = nil then begin DebugLn(''); DebugLn(ErrorMsg); end else begin if AddToPool then CodeToolBoss.DefinePool.Add(ADefTempl.CreateCopy(false,true,true)); CodeToolBoss.DefineTree.ReplaceRootSameName(ADefTempl); end; end; function FoundSystemPPU: boolean; var ConfigCache: TFPCTargetConfigCache; AFilename: string; begin Result:=false; ConfigCache:=UnitSetCache.GetConfigCache(false); if ConfigCache=nil then exit; if ConfigCache.Units=nil then exit; AFilename:=ConfigCache.Units['system']; if AFilename='' then exit; if CompareFileExt(AFilename,'.ppu',false)<>0 then exit; Result:=true; end; function PPUFilesAndCompilerMatch: boolean; // check if compiler is in another directory than the ppu files // for example: a 'make install' installs to /usr/local/lib/fpc // while the rpm/deb packages install to /usr/lib var Cfg: TFPCTargetConfigCache; Filename: String; begin Cfg:=UnitSetCache.GetConfigCache(false); if Cfg=nil then exit(true); if Cfg.RealCompiler='' then begin debugln(['PPUFilesAndCompilerMatch Compiler=',Cfg.Compiler,' RealComp=',Cfg.RealCompiler,' InPath=',Cfg.RealCompilerInPath]); IDEMessageDialog(lisCCOErrorCaption, Format( lisCompilerDoesNotSupportTarget, [Cfg.Compiler, Cfg.TargetOS, Cfg. TargetCPU]), mtError,[mbOk]); exit(false); end; Filename:=ReadAllLinks(Cfg.RealCompiler,false); if (Filename='') then begin IDEMessageDialog('Error','Compiler executable is missing: '+Cfg.RealCompiler, mtError,[mbOk]); exit(false); end; Result:=true; end; begin if ClearCaches then begin { $IFDEF VerboseFPCSrcScan} debugln(['TBuildManager.RescanCompilerDefines clear caches']); { $ENDIF} CodeToolBoss.FPCDefinesCache.ConfigCaches.Clear; CodeToolBoss.FPCDefinesCache.SourceCaches.Clear; end; if ResetBuildTarget then SetBuildTarget('','','',bmsfsSkip,true); // start the compiler and ask for his settings // provide an english message file UpdateEnglishErrorMsgFilename; // use current TargetOS, TargetCPU, compilerfilename and FPC source dir TargetOS:=GetTargetOS; TargetCPU:=GetTargetCPU; CompilerFilename:=EnvironmentOptions.GetCompilerFilename; FPCSrcDir:=EnvironmentOptions.GetFPCSourceDirectory; // needs FPCVer macro {$IFDEF VerboseFPCSrcScan} debugln(['TMainIDE.RescanCompilerDefines A ', ' CompilerFilename=',CompilerFilename, ' TargetOS=',TargetOS, ' TargetCPU=',TargetCPU, ' EnvFPCSrcDir=',EnvironmentOptions.FPCSourceDirectory, ' FPCSrcDir=',FPCSrcDir, ' WaitTillDone=',WaitTillDone, ' Quiet=',Quiet, '']); {$ENDIF} if CompilerFilename='' then begin UnitSetCache:=nil; exit; end; UnitSetCache:=CodeToolBoss.FPCDefinesCache.FindUnitSet( CompilerFilename,TargetOS,TargetCPU,'',FPCSrcDir,true); NeedUpdateFPCSrcCache:=false; //debugln(['TBuildManager.RescanCompilerDefines ',DirectoryExistsUTF8(FPCSrcDir),' ',(not WaitTillDone),' ',(not HasGUI)]); AsyncScanFPCSrcDir:=''; if DirectoryExistsUTF8(FPCSrcDir) and ((not WaitTillDone) or (not HasGUI)) then begin // FPC sources are not needed // => disable scan FPCSrcCache:=UnitSetCache.GetSourceCache(false); if (FPCSrcCache<>nil) and (not FPCSrcCache.Valid) then begin NeedUpdateFPCSrcCache:=HasGUI; FPCSrcCache.Valid:=true; if NeedUpdateFPCSrcCache then begin // start background scan of fpc source directory //debugln(['TBuildManager.RescanCompilerDefines background scan '+FPCSrcCache.Directory]); AsyncScanFPCSrcDir:=FPCSrcDir; end; end; end; // scan compiler, fpc sources and create indices for quick lookup UnitSetCache.Init; if (FUnitSetChangeStamp=TFPCUnitSetCache.GetInvalidChangeStamp) or (FUnitSetChangeStamp<>UnitSetCache.ChangeStamp) then begin {$IFDEF VerboseFPCSrcScan} debugln(['TBuildManager.RescanCompilerDefines nothing changed']); {$ENDIF} // save caches SaveFPCDefinesCaches; end; FUnitSetChangeStamp:=UnitSetCache.ChangeStamp; {$IFDEF VerboseFPCSrcScan} debugln(['TBuildManager.RescanCompilerDefines UnitSet changed => rebuilding defines', ' ClearCaches=',ClearCaches, ' CompilerFilename=',CompilerFilename, ' TargetOS=',TargetOS, ' TargetCPU=',TargetCPU, ' RealCompiler=',UnitSetCache.GetConfigCache(false).RealCompiler, ' EnvFPCSrcDir=',EnvironmentOptions.FPCSourceDirectory, ' FPCSrcDir=',FPCSrcDir, '']); {$ENDIF} // rebuild the define templates // create template for FPC settings ADefTempl:=CreateFPCTemplate(UnitSetCache,nil); AddTemplate(ADefTempl,false, 'NOTE: Could not create Define Template for Free Pascal Compiler'); // create template for FPC source directory ADefTempl:=CreateFPCSourceTemplate(UnitSetCache,nil); AddTemplate(ADefTempl,false,lisNOTECouldNotCreateDefineTemplateForFreePascal); // create compiler macros for the lazarus sources if CodeToolBoss.DefineTree.FindDefineTemplateByName(StdDefTemplLazarusSrcDir, true)=nil then begin ADefTempl:=CreateLazarusSourceTemplate( '$('+ExternalMacroStart+'LazarusDir)', '$('+ExternalMacroStart+'LCLWidgetType)', MiscellaneousOptions.BuildLazOpts.ExtraOptions,nil); AddTemplate(ADefTempl,true, lisNOTECouldNotCreateDefineTemplateForLazarusSources); end; CodeToolBoss.DefineTree.ClearCache; if AsyncScanFPCSrcDir<>'' then begin // start scanning the fpc source directory in the background if FPCSrcScans=nil then FFPCSrcScans:=TFPCSrcScans.Create(Self); FPCSrcScans.Scan(AsyncScanFPCSrcDir); end; if not Quiet then begin // check for common installation mistakes if not PPUFilesAndCompilerMatch then exit; if (UnitSetCache<>nil) then begin // check if at least one fpc config is there if UnitSetCache.GetFirstFPCCfg='' then begin IgnorePath:='MissingFPCCfg_'+TargetOS+'-'+TargetCPU; if (InputHistories<>nil) and (InputHistories.Ignores.Find(IgnorePath)=nil) then begin MsgResult:=IDEMessageDialog(lisCCOWarningCaption, lisTheCurrentFPCHasNoConfigFileItWillProbablyMissSome, mtWarning,[mbOk,mbIgnore]); if MsgResult=mrIgnore then InputHistories.Ignores.Add(IgnorePath,iiidIDERestart); end; end; end else if not FoundSystemPPU then begin // system.ppu is missing IDEMessageDialog(lisCCOErrorCaption, Format(lisTheProjectUsesTargetOSAndCPUTheSystemPpuForThisTar, [ TargetOS, TargetCPU, #13, #13]), mtError,[mbOk]); end; end; end; function TBuildManager.CompilerOnDiskChanged: boolean; var CfgCache: TFPCTargetConfigCache; begin Result:=false; if UnitSetCache=nil then exit; CfgCache:=UnitSetCache.GetConfigCache(false); if CfgCache=nil then exit; Result:=CfgCache.NeedsUpdate; end; procedure TBuildManager.LoadFPCDefinesCaches; var aFilename: String; XMLConfig: TXMLConfig; begin aFilename:=AppendPathDelim(GetPrimaryConfigPath)+'fpcdefines.xml'; CopySecondaryConfigFile(ExtractFilename(aFilename)); if not FileExistsUTF8(aFilename) then exit; try XMLConfig:=TXMLConfig.Create(aFilename); try CodeToolBoss.FPCDefinesCache.LoadFromXMLConfig(XMLConfig,''); finally XMLConfig.Free; end; except on E: Exception do begin debugln(['LoadFPCDefinesCaches Error loadinf file '+aFilename+':'+E.Message]); end; end; end; procedure TBuildManager.SaveFPCDefinesCaches; var aFilename: String; XMLConfig: TXMLConfig; begin aFilename:=AppendPathDelim(GetPrimaryConfigPath)+'fpcdefines.xml'; //debugln(['TBuildManager.SaveFPCDefinesCaches check if save needed ...']); if FileExistsCached(aFilename) and (not CodeToolBoss.FPCDefinesCache.NeedsSave) then exit; //debugln(['TBuildManager.SaveFPCDefinesCaches saving ...']); try XMLConfig:=TXMLConfig.CreateClean(aFilename); try CodeToolBoss.FPCDefinesCache.SaveToXMLConfig(XMLConfig,''); finally XMLConfig.Free; end; except on E: Exception do begin debugln(['LoadFPCDefinesCaches Error loading file '+aFilename+':'+E.Message]); end; end; end; function TBuildManager.CheckAmbiguousSources(const AFilename: string; Compiling: boolean): TModalResult; function DeleteAmbiguousFile(const AmbiguousFilename: string): TModalResult; begin if not DeleteFileUTF8(AmbiguousFilename) then begin Result:=IDEMessageDialog(lisErrorDeletingFile, Format(lisUnableToDeleteAmbiguousFile, ['"', AmbiguousFilename, '"']), mtError,[mbOk,mbAbort]); end else Result:=mrOk; end; function RenameAmbiguousFile(const AmbiguousFilename: string): TModalResult; var NewFilename: string; begin NewFilename:=AmbiguousFilename+'.ambiguous'; if not RenameFileUTF8(AmbiguousFilename,NewFilename) then begin Result:=IDEMessageDialog(lisErrorRenamingFile, Format(lisUnableToRenameAmbiguousFileTo, ['"', AmbiguousFilename, '"', #13, '"', NewFilename, '"']), mtError,[mbOk,mbAbort]); end else Result:=mrOk; end; function AddCompileWarning(const AmbiguousFilename: string): TModalResult; begin Result:=mrOk; if Compiling then begin TheOutputFilter.ReadConstLine( Format(lisWarningAmbiguousFileFoundSourceFileIs, ['"', AmbiguousFilename, '"', '"', AFilename, '"']), true); end; end; function CheckFile(const AmbiguousFilename: string): TModalResult; begin Result:=mrOk; if CompareFilenames(AFilename,AmbiguousFilename)=0 then exit; if not FileExistsUTF8(AmbiguousFilename) then exit; if Compiling then begin Result:=AddCompileWarning(AmbiguousFilename); exit; end; case EnvironmentOptions.AmbiguousFileAction of afaAsk: begin Result:=IDEMessageDialog(lisAmbiguousFileFound, Format(lisThereIsAFileWithTheSameNameAndASimilarExtension, [#13, AFilename, #13, AmbiguousFilename, #13, #13]), mtWarning,[mbYes,mbIgnore,mbAbort]); case Result of mrYes: Result:=DeleteAmbiguousFile(AmbiguousFilename); mrIgnore: Result:=mrOk; end; end; afaAutoDelete: Result:=DeleteAmbiguousFile(AmbiguousFilename); afaAutoRename: Result:=RenameAmbiguousFile(AmbiguousFilename); afaWarnOnCompile: Result:=AddCompileWarning(AmbiguousFilename); else Result:=mrOk; end; end; var Ext, LowExt: string; i: integer; begin Result:=mrOk; if EnvironmentOptions.AmbiguousFileAction=afaIgnore then exit; if (EnvironmentOptions.AmbiguousFileAction=afaWarnOnCompile) and not Compiling then exit; if FilenameIsPascalUnit(AFilename) then begin Ext:=ExtractFileExt(AFilename); LowExt:=lowercase(Ext); for i:=Low(PascalFileExt) to High(PascalFileExt) do begin if LowExt<>PascalFileExt[i] then begin Result:=CheckFile(ChangeFileExt(AFilename,PascalFileExt[i])); if Result<>mrOk then exit; end; end; end; end; function TBuildManager.DeleteAmbiguousFiles(const Filename: string): TModalResult; var ADirectory: String; FileInfo: TSearchRec; ShortFilename: String; CurFilename: String; IsPascalUnit: Boolean; AUnitName: String; begin Result:=mrOk; if EnvironmentOptions.AmbiguousFileAction=afaIgnore then exit; if EnvironmentOptions.AmbiguousFileAction in [afaAsk,afaAutoDelete,afaAutoRename] then begin ADirectory:=AppendPathDelim(ExtractFilePath(Filename)); if FindFirstUTF8(ADirectory+GetAllFilesMask,faAnyFile,FileInfo)=0 then begin ShortFilename:=ExtractFileName(Filename); IsPascalUnit:=FilenameIsPascalUnit(ShortFilename); AUnitName:=ExtractFilenameOnly(ShortFilename); repeat if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') or ((FileInfo.Attr and faDirectory)<>0) then continue; if CompareFilenames(ShortFilename,FileInfo.Name)=0 then continue; if (SysUtils.CompareText(ShortFilename,FileInfo.Name)=0) then begin // same name different case => ambiguous end else if IsPascalUnit and FilenameIsPascalUnit(FileInfo.Name) and (SysUtils.CompareText(AUnitName,ExtractFilenameOnly(FileInfo.Name))=0) then begin // same unit name => ambiguous end else continue; CurFilename:=ADirectory+FileInfo.Name; if EnvironmentOptions.AmbiguousFileAction=afaAsk then begin if IDEMessageDialog(lisDeleteAmbiguousFile, Format(lisAmbiguousFileFoundThisFileCanBeMistakenWithDelete, ['"', CurFilename, '"', #13, '"', ShortFilename, '"', #13, #13]), mtConfirmation,[mbYes,mbNo])=mrNo then continue; end; if EnvironmentOptions.AmbiguousFileAction in [afaAutoDelete,afaAsk] then begin if not DeleteFileUTF8(CurFilename) then begin IDEMessageDialog(lisDeleteFileFailed, Format(lisPkgMangUnableToDeleteFile, ['"', CurFilename, '"']), mtError,[mbOk]); end; end else if EnvironmentOptions.AmbiguousFileAction=afaAutoRename then begin Result:=BackupFile(CurFilename); if Result=mrAbort then exit; Result:=mrOk; end; until FindNextUTF8(FileInfo)<>0; end; FindCloseUTF8(FileInfo); end; end; {------------------------------------------------------------------------------- function TBuildManager.CheckUnitPathForAmbiguousPascalFiles( const BaseDir, TheUnitPath, CompiledExt, ContextDescription: string ): TModalResult; Collect all pascal files and all compiled units in the unit path and check for ambiguous files. For example: doubles. -------------------------------------------------------------------------------} function TBuildManager.CheckUnitPathForAmbiguousPascalFiles(const BaseDir, TheUnitPath, CompiledExt, ContextDescription: string): TModalResult; procedure FreeUnitTree(var Tree: TAVLTree); var ANode: TAVLTreeNode; AnUnitFile: PUnitFile; begin if Tree<>nil then begin ANode:=Tree.FindLowest; while ANode<>nil do begin AnUnitFile:=PUnitFile(ANode.Data); Dispose(AnUnitFile); ANode:=Tree.FindSuccessor(ANode); end; Tree.Free; Tree:=nil; end; end; var EndPos: Integer; StartPos: Integer; CurDir: String; FileInfo: TSearchRec; SourceUnitTree, CompiledUnitTree: TAVLTree; ANode: TAVLTreeNode; CurUnitName: String; CurFilename: String; AnUnitFile: PUnitFile; CurUnitTree: TAVLTree; FileInfoNeedClose: Boolean; UnitPath: String; IgnoreAll: Boolean; begin Result:=mrOk; UnitPath:=TrimSearchPath(TheUnitPath,BaseDir,true); SourceUnitTree:=TAVLTree.Create(TListSortCompare(@CompareUnitFiles)); CompiledUnitTree:=TAVLTree.Create(TListSortCompare(@CompareUnitFiles)); FileInfoNeedClose:=false; try // collect all units (.pas, .pp, compiled units) EndPos:=1; while EndPos<=length(UnitPath) do begin StartPos:=EndPos; while (StartPos<=length(UnitPath)) and (UnitPath[StartPos]=';') do inc(StartPos); EndPos:=StartPos; while (EndPos<=length(UnitPath)) and (UnitPath[EndPos]<>';') do inc(EndPos); if EndPos>StartPos then begin CurDir:=AppendPathDelim(TrimFilename(copy( UnitPath,StartPos,EndPos-StartPos))); FileInfoNeedClose:=true; if FindFirstUTF8(CurDir+GetAllFilesMask,faAnyFile,FileInfo)=0 then begin IgnoreAll:=false; repeat if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') or ((FileInfo.Attr and faDirectory)<>0) then continue; if FilenameIsPascalUnit(FileInfo.Name) then CurUnitTree:=SourceUnitTree else if (CompareFileExt(FileInfo.Name,CompiledExt,false)=0) then CurUnitTree:=CompiledUnitTree else continue; CurUnitName:=ExtractFilenameOnly(FileInfo.Name); if (CurUnitName='') or (not IsValidIdent(CurUnitName)) then continue; CurFilename:=CurDir+FileInfo.Name; //DebugLn(['TBuildManager.CheckUnitPathForAmbiguousPascalFiles ',CurUnitName,' ',CurFilename]); // check if unit already found ANode:=CurUnitTree.FindKey(PChar(CurUnitName), TListSortCompare(@CompareUnitNameAndUnitFile)); if (ANode<>nil) and (not IgnoreAll) then begin DebugLn(['TBuildManager.CheckUnitPathForAmbiguousPascalFiles CurUnitName="',CurUnitName,'" CurFilename="',CurFilename,'" OtherUnitName="',PUnitFile(ANode.Data)^.FileUnitName,'" OtherFilename="',PUnitFile(ANode.Data)^.Filename,'"']); // pascal unit exists twice Result:=QuestionDlg(lisAmbiguousUnitFound2, Format(lisTheUnitExistsTwiceInTheUnitPathOfThe, [CurUnitName, ContextDescription]) +#13 +#13 +'1. "'+PUnitFile(ANode.Data)^.Filename+'"'#13 +'2. "'+CurFilename+'"'#13 +#13 +lisHintCheckIfTwoPackagesContainAUnitWithTheSameName, mtWarning, [mrIgnore, mrYesToAll, lisIgnoreAll, mrAbort], 0); case Result of mrIgnore: ; mrYesToAll: IgnoreAll:=true; else exit; end; end; // add unit to tree New(AnUnitFile); AnUnitFile^.FileUnitName:=CurUnitName; AnUnitFile^.Filename:=CurFilename; CurUnitTree.Add(AnUnitFile); until FindNextUTF8(FileInfo)<>0; end; FindCloseUTF8(FileInfo); FileInfoNeedClose:=false; end; end; finally // clean up if FileInfoNeedClose then FindCloseUTF8(FileInfo); FreeUnitTree(SourceUnitTree); FreeUnitTree(CompiledUnitTree); end; Result:=mrOk; end; function TBuildManager.CreateProjectApplicationBundle: Boolean; var TargetExeName: string; begin Result := False; if Project1.MainUnitInfo = nil then Exit; if Project1.IsVirtual then TargetExeName := GetTestBuildDirectory + ExtractFilename(Project1.MainUnitInfo.Filename) else TargetExeName := Project1.CompilerOptions.CreateTargetFilename( Project1.MainFilename); if not (CreateApplicationBundle(TargetExeName, Project1.Title, True) in [mrOk, mrIgnore]) then Exit; if not (CreateAppBundleSymbolicLink(TargetExeName, True) in [mrOk, mrIgnore]) then Exit; Result := True; end; function TBuildManager.BackupFile(const Filename: string): TModalResult; var BackupFilename, CounterFilename: string; AText,ACaption:string; BackupInfo: TBackupInfo; FilePath, FileNameOnly, FileExt, SubDir: string; i: integer; IsPartOfProject: boolean; begin Result:=mrOk; if not (FileExistsUTF8(Filename)) then exit; // check if file in lpi IsPartOfProject:=(Project1<>nil) and (Project1.FindFile(Filename,[pfsfOnlyProjectFiles])<>nil); // check if file in source directory of project if (not IsPartOfProject) and (Project1<>nil) and (SearchDirectoryInSearchPath(ExtractFilePath(Filename), Project1.SourceDirectories.CreateSearchPathFromAllFiles)>0) then IsPartOfProject:=true; // check options if IsPartOfProject then BackupInfo:=EnvironmentOptions.BackupInfoProjectFiles else BackupInfo:=EnvironmentOptions.BackupInfoOtherFiles; if (BackupInfo.BackupType=bakNone) or ((BackupInfo.BackupType=bakSameName) and (BackupInfo.SubDirectory='')) then exit; // create backup FilePath:=ExtractFilePath(Filename); FileExt:=ExtractFileExt(Filename); FileNameOnly:=ExtractFilenameOnly(Filename); if BackupInfo.SubDirectory<>'' then begin SubDir:=FilePath+BackupInfo.SubDirectory; repeat if not DirPathExists(SubDir) then begin if not CreateDirUTF8(SubDir) then begin Result:=IDEMessageDialog(lisCCOWarningCaption, Format(lisUnableToCreateBackupDirectory, ['"',SubDir, '"']) ,mtWarning,[mbAbort,mbRetry,mbIgnore]); if Result=mrAbort then exit; if Result=mrIgnore then Result:=mrOk; end; end; until Result<>mrRetry; end; if BackupInfo.BackupType in [bakSymbolInFront,bakSymbolBehind,bakUserDefinedAddExt,bakSameName] then begin case BackupInfo.BackupType of bakSymbolInFront: BackupFilename:=FileNameOnly+'.~'+copy(FileExt,2,length(FileExt)-1); bakSymbolBehind: BackupFilename:=FileNameOnly+FileExt+'~'; bakUserDefinedAddExt: BackupFilename:=FileNameOnly+FileExt+'.'+BackupInfo.AdditionalExtension; bakSameName: BackupFilename:=FileNameOnly+FileExt; end; if BackupInfo.SubDirectory<>'' then BackupFilename:=SubDir+PathDelim+BackupFilename else BackupFilename:=FilePath+BackupFilename; // remove old backup file repeat if FileExistsUTF8(BackupFilename) then begin if not DeleteFileUTF8(BackupFilename) then begin ACaption:=lisDeleteFileFailed; AText:=Format(lisUnableToRemoveOldBackupFile, ['"', BackupFilename, '"']); Result:=IDEMessageDialog(ACaption,AText,mtError, [mbAbort,mbRetry,mbIgnore]); if Result=mrAbort then exit; if Result=mrIgnore then Result:=mrOk; end; end; until Result<>mrRetry; end else begin // backup with counter if BackupInfo.SubDirectory<>'' then BackupFilename:=SubDir+PathDelim+FileNameOnly+FileExt+';' else BackupFilename:=Filename+';'; if BackupInfo.MaxCounter<=0 then begin // search first non existing backup filename i:=1; while FileExistsUTF8(BackupFilename+IntToStr(i)) do inc(i); BackupFilename:=BackupFilename+IntToStr(i); end else begin // rename all backup files (increase number) i:=1; while FileExistsUTF8(BackupFilename+IntToStr(i)) and (i<=BackupInfo.MaxCounter) do inc(i); if i>BackupInfo.MaxCounter then begin dec(i); CounterFilename:=BackupFilename+IntToStr(BackupInfo.MaxCounter); // remove old backup file repeat if FileExistsUTF8(CounterFilename) then begin if not DeleteFileUTF8(CounterFilename) then begin ACaption:=lisDeleteFileFailed; AText:=Format(lisUnableToRemoveOldBackupFile, ['"', CounterFilename, '"']); Result:=MessageDlg(ACaption,AText,mtError, [mbAbort,mbRetry,mbIgnore],0); if Result=mrAbort then exit; if Result=mrIgnore then Result:=mrOk; end; end; until Result<>mrRetry; end; // rename all old backup files dec(i); while i>=1 do begin repeat if not RenameFileUTF8(BackupFilename+IntToStr(i), BackupFilename+IntToStr(i+1)) then begin ACaption:=lisRenameFileFailed; AText:=Format(lisUnableToRenameFileTo, ['"', BackupFilename+IntToStr (i), '"', '"', BackupFilename+IntToStr(i+1), '"']); Result:=MessageDlg(ACaption,AText,mtError, [mbAbort,mbRetry,mbIgnore],0); if Result=mrAbort then exit; if Result=mrIgnore then Result:=mrOk; end; until Result<>mrRetry; dec(i); end; BackupFilename:=BackupFilename+'1'; end; end; // backup file repeat if not IDEProcs.BackupFile(Filename, BackupFilename) then begin ACaption := lisBackupFileFailed; AText := Format(lisUnableToBackupFileTo, ['"', Filename, '"', '"', BackupFilename, '"']); Result := IDEMessageDialog(ACaption,AText,mterror,[mbabort,mbretry,mbignore]); if Result = mrAbort then exit; if Result = mrIgnore then Result := mrOk; end else Result := mrOk; until Result <> mrRetry; end; function TBuildManager.GetResourceType(AnUnitInfo: TUnitInfo): TResourceType; begin if AnUnitInfo.Source = nil then AnUnitInfo.Source := CodeToolBoss.LoadFile(AnUnitInfo.Filename, True, False); if (AnUnitInfo.Source <> nil) and GuessResourceType(AnUnitInfo.Source, Result) then begin // guessed from source end else if AnUnitInfo.IsPartOfProject then begin // use project resource type Result := Project1.Resources.ResourceType; end else Result := rtLRS; end; function TBuildManager.FindLRSFilename(AnUnitInfo: TUnitInfo; UseDefaultIfNotFound: boolean): string; begin if AnUnitInfo.IsVirtual then begin Result:=''; end else begin Result:=ExtractFileNameOnly(AnUnitInfo.Filename)+ResourceFileExt; Result:=FileUtil.SearchFileInPath(Result,'', CodeToolBoss.GetIncludePathForDirectory(ExtractFilePath(AnUnitInfo.Filename)), ';',[sffDontSearchInBasePath,sffSearchLoUpCase]); end; if (Result='') and UseDefaultIfNotFound then Result:=GetDefaultLRSFilename(AnUnitInfo); end; function TBuildManager.GetDefaultLRSFilename(AnUnitInfo: TUnitInfo): string; var OutputDir: String; begin if AnUnitInfo.IsPartOfProject and (not Project1.IsVirtual) and (pfLRSFilesInOutputDirectory in Project1.Flags) then begin OutputDir:=Project1.GetOutputDirectory; if OutputDir<>'' then begin Result:=AppendPathDelim(OutputDir) +ExtractFileNameOnly(AnUnitInfo.Filename)+ResourceFileExt; exit; end; end; Result:=ChangeFileExt(AnUnitInfo.Filename,ResourceFileExt); end; function TBuildManager.UpdateLRSFromLFM(AnUnitInfo: TUnitInfo; ShowAbort: boolean): TModalResult; var LFMFilename: String; LRSFilename: String; Dir: String; begin Result:=mrOk; // check if there is a .lfm file if AnUnitInfo.IsVirtual then exit; LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lfm'); if not FileExistsCached(LFMFilename) then exit(mrOk); // check if there is a .lrs file LRSFilename:=FindLRSFilename(AnUnitInfo,true); if LRSFilename=LFMFilename then exit; // check if .lrs file is newer than .lfm file if FileExistsUTF8(LRSFilename) and (FileAgeUTF8(LFMFilename)<=FileAgeUTF8(LRSFilename)) then exit; // the .lrs file does not exist, or is older than the .lfm file // -> update .lrs file Dir:=ExtractFilePath(LRSFilename); Result:=ForceDirectoryInteractive(Dir,[mbRetry]); if Result<>mrOk then exit; Result:=ConvertLFMToLRSFileInteractive(LFMFilename,LRSFilename,ShowAbort); end; function TBuildManager.UpdateProjectAutomaticFiles(TestDir: string): TModalResult; var AnUnitInfo: TUnitInfo; Code: TCodeBuffer; begin // update project resource Project1.Resources.Regenerate(Project1.MainFileName, False, True, TestDir); AnUnitInfo := Project1.FirstPartOfProject; while AnUnitInfo<>nil do begin if AnUnitInfo.HasResources then begin case GetResourceType(AnUnitInfo) of rtLRS: begin Result := UpdateLRSFromLFM(AnUnitInfo,false); if Result = mrIgnore then Result:=mrOk; if Result <> mrOk then exit; end; rtRes: if (AnUnitInfo.Source=nil) and (not AnUnitInfo.IsVirtual) then begin AnUnitInfo.Source:=CodeToolBoss.LoadFile(AnUnitInfo.Filename,true,false); Code:=AnUnitInfo.Source; if (Code<>nil) and (Code.DiskEncoding<>EncodingUTF8) then begin DebugLn(['TBuildManager.UpdateProjectAutomaticFiles fixing encoding of ',Code.Filename,' from ',Code.DiskEncoding,' to ',EncodingUTF8]); Code.DiskEncoding:=EncodingUTF8; if not Code.Save then begin DebugLn(['TBuildManager.UpdateProjectAutomaticFiles failed to save file ',Code.Filename]); end; end; end; end; end; AnUnitInfo := AnUnitInfo.NextPartOfProject; end; end; function TBuildManager.MacroFuncMakeExe(const Filename: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=MakeStandardExeFilename(GetTargetOS,Filename); //DebugLn('TMainIDE.MacroFuncMakeExe A ',Filename,' ',Result); end; function TBuildManager.MacroFuncMakeLib(const Filename: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=MakeStandardLibFilename(GetTargetOS,Filename); end; function TBuildManager.MacroFuncProject(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then begin if SysUtils.CompareText(Param,'SrcPath')=0 then Result:=Project1.CompilerOptions.GetSrcPath(false) else if SysUtils.CompareText(Param,'IncPath')=0 then Result:=Project1.CompilerOptions.GetIncludePath(false) else if SysUtils.CompareText(Param,'UnitPath')=0 then Result:=Project1.CompilerOptions.GetUnitPath(false) else if SysUtils.CompareText(Param,'InfoFile')=0 then Result:=Project1.ProjectInfoFile else if SysUtils.CompareText(Param,'OutputDir')=0 then Result:=Project1.CompilerOptions.GetUnitOutPath(false) else begin Result:=''; debugln('WARNING: TMainIDE.MacroFuncProject: ',Result); end; end else begin Result:=''; end; end; function TBuildManager.MacroFuncLCLWidgetType(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Data=CompilerOptionMacroPlatformIndependent then Result:='%(LCL_PLATFORM)' else Result:=GetLCLWidgetType; end; function TBuildManager.MacroFuncTargetCPU(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Data=CompilerOptionMacroPlatformIndependent then Result:='%(CPU_TARGET)' else Result:=GetTargetCPU; end; function TBuildManager.MacroFuncTargetOS(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Data=CompilerOptionMacroPlatformIndependent then Result:='%(OS_TARGET)' else Result:=GetTargetOS; end; function TBuildManager.MacroFuncIDEBuildOptions(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Data=CompilerOptionMacroPlatformIndependent then Result:='' else if (MiscellaneousOptions<>nil) and (MiscellaneousOptions.BuildLazOpts<>nil) then Result:=MiscellaneousOptions.BuildLazOpts.ExtraOptions else Result:=''; end; function TBuildManager.MacroFuncPrimaryConfigPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=GetPrimaryConfigPath; end; function TBuildManager.MacroFuncSecondaryConfigPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=GetSecondaryConfigPath; end; function TBuildManager.MacroFuncFallbackOutputRoot(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=AppendPathDelim(GetPrimaryConfigPath)+'lib'; end; function TBuildManager.MacroFuncSrcOS(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Data=CompilerOptionMacroPlatformIndependent then Result:='%(OS_TARGET)' else Result:=GetDefaultSrcOSForTargetOS(GetTargetOS); end; function TBuildManager.MacroFuncFPCVer(const Param: string; const Data: PtrInt; var Abort: boolean): string; function Compute: string; var TargetOS: String; TargetCPU: String; CompilerFilename: String; ConfigCache: TFPCTargetConfigCache; begin Result:={$I %FPCVERSION%}; // Version.Release.Patch if CodeToolBoss<>nil then begin // fetch the FPC version from the current compiler // Not from the fpc.exe, but from the real compiler CompilerFilename:=EnvironmentOptions.GetCompilerFilename; if CompilerFilename='' then exit; TargetOS:=GetTargetOS; TargetCPU:=GetTargetCPU; ConfigCache:=CodeToolBoss.FPCDefinesCache.ConfigCaches.Find( CompilerFilename,'',TargetOS,TargetCPU,true); if ConfigCache=nil then exit; if ConfigCache.NeedsUpdate then begin // ask compiler if not ConfigCache.Update(CodeToolBoss.FPCDefinesCache.TestFilename, CodeToolBoss.FPCDefinesCache.ExtraOptions,nil) then exit; end; Result:=ConfigCache.GetFPCVer; end; end; begin if FFPCVerChangeStamp<>CompilerParseStamp then begin FFPCVer:=Compute; FFPCVerChangeStamp:=CompilerParseStamp; {$IFDEF VerboseFPCSrcScan} debugln(['TBuildManager.MacroFuncFPCVer ',FFPCVer]); {$ENDIF} end; Result:=FFPCVer; end; function TBuildManager.MacroFuncParams(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then Result:=Project1.RunParameterOptions.CmdLineParams else Result:=''; end; function TBuildManager.MacroFuncProjFile(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then Result:=Project1.MainFilename else Result:=''; end; function TBuildManager.MacroFuncProjPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then Result:=Project1.ProjectDirectory else Result:=''; end; function TBuildManager.MacroFuncTargetFile(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then Result:=GetProjectTargetFilename(Project1) else Result:=''; end; function TBuildManager.MacroFuncTargetCmdLine(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then begin Result:=Project1.RunParameterOptions.CmdLineParams; if Result='' then Result:=GetProjectTargetFilename(Project1) else Result:=GetProjectTargetFilename(Project1)+' '+Result; end else Result:=''; end; function TBuildManager.MacroFuncRunCmdLine(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then Result:=GetRunCommandLine else Result:=''; end; function TBuildManager.MacroFuncProjPublishDir(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then Result:=GetProjectPublishDir else Result:=''; end; function TBuildManager.MacroFuncProjUnitPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then Result:=Project1.CompilerOptions.GetUnitPath(false) else Result:=''; end; function TBuildManager.MacroFuncProjIncPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then Result:=Project1.CompilerOptions.GetIncludePath(false) else Result:=''; end; function TBuildManager.MacroFuncProjSrcPath(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then Result:=Project1.CompilerOptions.GetSrcPath(false) else Result:=''; end; function TBuildManager.MacroFuncProjOutDir(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin if Project1<>nil then Result:=Project1.CompilerOptions.GetUnitOutPath(false) else Result:=''; end; function TBuildManager.MacroFuncEnv(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=GetEnvironmentVariableUTF8(Param); end; function TBuildManager.MacroFuncMake(const Param: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=EnvironmentOptions.MakeFilename; if (Result<>'') and (not FilenameIsAbsolute(Result)) then Result:=FindDefaultExecutablePath(Result); if Result='' then Result:=FindDefaultMakePath; end; function TBuildManager.CTMacroFuncProjectUnitPath(Data: Pointer): boolean; var FuncData: PReadFunctionData; begin FuncData:=PReadFunctionData(Data); Result:=false; if Project1<>nil then begin FuncData^.Result:=Project1.CompilerOptions.GetUnitPath(false); Result:=true; end; end; function TBuildManager.CTMacroFuncProjectIncPath(Data: Pointer): boolean; var FuncData: PReadFunctionData; begin FuncData:=PReadFunctionData(Data); Result:=false; if Project1<>nil then begin FuncData^.Result:= Project1.CompilerOptions.GetIncludePath(false,coptParsed,true); Result:=true; end; end; function TBuildManager.CTMacroFuncProjectSrcPath(Data: Pointer): boolean; var FuncData: PReadFunctionData; begin FuncData:=PReadFunctionData(Data); Result:=false; if Project1<>nil then begin FuncData^.Result:=Project1.CompilerOptions.GetSrcPath(false); Result:=true; end; end; procedure TBuildManager.OnCmdLineCreate(var CmdLine: string; var Abort: boolean); // replace all transfer macros in command line begin Abort:=not GlobalMacroList.SubstituteStr(CmdLine); end; function TBuildManager.OnRunCompilerWithOptions( ExtTool: TIDEExternalToolOptions; CompOptions: TBaseCompilerOptions ): TModalResult; begin if SourceEditorManagerIntf<>nil then SourceEditorManagerIntf.ClearErrorLines; Result:=EnvironmentOptions.ExternalTools.Run(ExtTool,GlobalMacroList,false, CompOptions); if LazarusIDE<>nil then LazarusIDE.DoCheckFilesOnDisk; end; procedure TBuildManager.SetUnitSetCache(const AValue: TFPCUnitSetCache); begin if FUnitSetCache=AValue then exit; FUnitSetCache:=AValue; if UnitSetCache<>nil then begin FreeNotification(UnitSetCache); FUnitSetChangeStamp:=UnitSetCache.GetInvalidChangeStamp; end; end; procedure TBuildManager.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if Operation=opRemove then begin if FUnitSetCache=AComponent then FUnitSetCache:=nil; end; end; function TBuildManager.OnGetBuildMacroValues(Options: TBaseCompilerOptions; IncludeSelf: boolean): TCTCfgScriptVariables; procedure AddAllInherited(FirstDependency: TPkgDependency; AddTo: TCTCfgScriptVariables); var List: TFPList; i: Integer; APackage: TLazPackage; Values: TCTCfgScriptVariables; OtherOpts: TPkgCompilerOptions; j: Integer; Macro: TLazBuildMacro; Value: PCTCfgScriptVariable; begin if FirstDependency=nil then exit; List:=nil; try PackageGraph.GetAllRequiredPackages(FirstDependency,List); if List=nil then exit; for i:=0 to List.Count-1 do begin // add values of build macros of used package APackage:=TLazPackage(List[i]); OtherOpts:=APackage.CompilerOptions; if OtherOpts.BuildMacros=nil then continue; Values:=OnGetBuildMacroValues(OtherOpts,true); if Values=nil then continue; for j:=0 to OtherOpts.BuildMacros.Count-1 do begin Macro:=OtherOpts.BuildMacros[j]; if Macro.Identifier='' then continue; Value:=Values.GetVariable(PChar(Macro.Identifier)); if Value=nil then begin //debugln(['AddAllInherited InhPkg=',APackage.Name,' Macro="',Macro.Identifier,'" no value']); continue; end else begin //debugln(['AddAllInherited InhPkg=',APackage.Name,' Macro="',Macro.Identifier,'" Value="',dbgs(Value),'"']); AddTo.AddOverride(Value); end; end; end; finally List.Free; end; end; procedure SetProjectMacroValues; var Values: TCTCfgScriptVariables; begin Values:=OnGetBuildMacroValues(nil,false); if Values<>nil then OnGetBuildMacroValues.AddOverrides(Values); end; var ParseOpts: TParsedCompilerOptions; Values: TCTCfgScriptVariables; Overrides: TStrings; i: Integer; s: String; aName: string; aValue: String; begin Result:=nil; if Options=nil then begin // return the values of the active project if (Project1=nil) or (Project1.MacroValues=nil) then exit; Result:=Project1.MacroValues.CfgVars; if Project1.MacroValues.CfgVarsBuildMacroStamp=BuildMacroChangeStamp then exit; // rebuild project macros Result.Clear; for i:=0 to Project1.MacroValues.Count-1 do begin aName:=Project1.MacroValues.Names[i]; aValue:=Project1.MacroValues.ValueFromIndex(i); Result.Define(PChar(aName),aValue); end; Project1.MacroValues.CfgVarsBuildMacroStamp:=BuildMacroChangeStamp; // set overrides Overrides:=GetBuildMacroOverrides; try for i:=0 to Overrides.Count-1 do Result.Values[Overrides.Names[i]]:=Overrides.ValueFromIndex[i]; //debugln(['TBuildManager.OnGetBuildMacroValues Overrides=',dbgstr(Overrides.Text)]); finally Overrides.Free; end; // add the defaults // Note: see also ide/frames/compiler_buildmacro_options.pas procedure TCompOptBuildMacrosFrame.BuildMacrosTreeViewEdited if not Result.IsDefined('TargetOS') then begin s:=Project1.CompilerOptions.TargetOS; if s='' then s:=GetDefaultTargetOS; Result.Values['TargetOS']:=s; end; if not Result.IsDefined('SrcOS') then begin s:=GetDefaultSrcOSForTargetOS(Result.Values['TargetOS']); Result.Values['SrcOS']:=s; end; if not Result.IsDefined('SrcOS2') then begin s:=GetDefaultSrcOS2ForTargetOS(Result.Values['TargetOS']); Result.Values['SrcOS2']:=s; end; if not Result.IsDefined('TargetCPU') then begin s:=Project1.CompilerOptions.TargetCPU; if s='' then s:=GetDefaultTargetCPU; Result.Values['TargetCPU']:=s; end; if Result.Values['LCLWidgetType']='' then begin Result.Values['LCLWidgetType']:= Project1.CompilerOptions.GetEffectiveLCLWidgetType; end; //Result.WriteDebugReport('OnGetBuildMacroValues project values'); exit; end; ParseOpts:=Options.ParsedOpts; if ParseOpts=nil then exit; if IncludeSelf then begin Result:=ParseOpts.MacroValues.Variables; if ParseOpts.MacroValuesStamp<>BuildMacroChangeStamp then begin // compute macro values if ParseOpts.MacroValuesParsing then begin debugln(['TBuildManager.OnGetBuildMacroValues circle computing macros of ',dbgsname(Options.Owner)]); exit; end; ParseOpts.MacroValuesParsing:=true; try Result.Clear; // use inherited as default Values:=OnGetBuildMacroValues(Options,false); // add macro values of self if Values<>nil then Result.Assign(Values); //Result.WriteDebugReport('TPkgManager.OnGetBuildMacroValues before execute: '+dbgstr(Options.Conditionals),' '); if not ParseOpts.MacroValues.Execute(Options.Conditionals) then begin debugln(['TPkgManager.OnGetBuildMacroValues Error: ',ParseOpts.MacroValues.GetErrorStr(0)]); debugln(Options.Conditionals); end; //Result.WriteDebugReport('TPkgManager.OnGetBuildMacroValues executed: '+dbgstr(Options.Conditionals),' '); // the macro values of the active project take precedence SetProjectMacroValues; ParseOpts.MacroValuesStamp:=BuildMacroChangeStamp; finally ParseOpts.MacroValuesParsing:=false; end; end; end else begin Result:=ParseOpts.InheritedMacroValues; if ParseOpts.InheritedMacroValuesStamp<>BuildMacroChangeStamp then begin // compute inherited values if ParseOpts.InheritedMacroValuesParsing then begin debugln(['TPkgManager.OnGetBuildMacroValues circle computing inherited macros of ',dbgsname(Options.Owner)]); exit; end; ParseOpts.InheritedMacroValuesParsing:=true; try Result.Clear; // add inherited if (PackageGraph<>nil) then begin if Options.Owner is TProject then AddAllInherited(TProject(Options.Owner).FirstRequiredDependency,Result) else if Options.Owner is TLazPackage then AddAllInherited(TLazPackage(Options.Owner).FirstRequiredDependency,Result); end; // the macro values of the active project take precedence SetProjectMacroValues; ParseOpts.InheritedMacroValuesStamp:=BuildMacroChangeStamp; finally ParseOpts.InheritedMacroValuesParsing:=false; end; end; end; end; procedure TBuildManager.SetBuildTarget(const TargetOS, TargetCPU, LCLWidgetType: string; ScanFPCSrc: TBMScanFPCSources; Quiet: boolean); var OldTargetOS: String; OldTargetCPU: String; OldLCLWidgetType: String; FPCTargetChanged: Boolean; LCLTargetChanged: Boolean; begin OldTargetOS:=fTargetOS; OldTargetCPU:=fTargetCPU; OldLCLWidgetType:=fLCLWidgetType; OverrideTargetOS:=GetFPCTargetOS(TargetOS); OverrideTargetCPU:=GetFPCTargetCPU(TargetCPU); OverrideLCLWidgetType:=lowercase(LCLWidgetType); // compute new TargetOS if OverrideTargetOS<>'' then fTargetOS:=OverrideTargetOS else if Project1<>nil then fTargetOS:=Project1.CompilerOptions.TargetOS else fTargetOS:=''; if (fTargetOS='') or (SysUtils.CompareText(fTargetOS,'default')=0) then fTargetOS:=GetDefaultTargetOS; fTargetOS:=GetFPCTargetOS(fTargetOS); // compute new TargetCPU if OverrideTargetCPU<>'' then fTargetCPU:=OverrideTargetCPU else if Project1<>nil then fTargetCPU:=Project1.CompilerOptions.TargetCPU else fTargetCPU:=''; if (fTargetCPU='') or (SysUtils.CompareText(fTargetCPU,'default')=0) then fTargetCPU:=GetDefaultTargetCPU; fTargetCPU:=GetFPCTargetCPU(fTargetCPU); // compute new LCLWidgetType if OverrideLCLWidgetType<>'' then fLCLWidgetType:=OverrideLCLWidgetType else if Project1<>nil then fLCLWidgetType:=Project1.CompilerOptions.GetEffectiveLCLWidgetType else fLCLWidgetType:=''; if (fLCLWidgetType='') or (SysUtils.CompareText(fLCLWidgetType,'default')=0) then fLCLWidgetType:=LCLPlatformDirNames[GetDefaultLCLWidgetType]; fLCLWidgetType:=lowercase(fLCLWidgetType); FPCTargetChanged:=(OldTargetOS<>fTargetOS) or (OldTargetCPU<>fTargetCPU) or (CodeToolBoss.DefineTree.FindDefineTemplateByName( StdDefTemplLazarusSrcDir,true)=nil); LCLTargetChanged:=(OldLCLWidgetType<>fLCLWidgetType); if FPCTargetChanged or LCLTargetChanged then begin //DebugLn('TMainIDE.SetBuildTarget Old=',OldTargetCPU,'-',OldTargetOS,'-',OldLCLWidgetType, // ' New=',fTargetCPU,'-',fTargetOS,'-',fLCLWidgetType,' FPC=',dbgs(FPCTargetChanged),' LCL=',dbgs(LCLTargetChanged)); IncreaseBuildMacroChangeStamp; end; if LCLTargetChanged then CodeToolBoss.SetGlobalValue(ExternalMacroStart+'LCLWidgetType',fLCLWidgetType); if FPCTargetChanged and (ScanFPCSrc<>bmsfsSkip) then RescanCompilerDefines(false,false,ScanFPCSrc=bmsfsWaitTillDone,Quiet); //if (PackageGraph<>nil) and (PackageGraph.CodeToolsPackage<>nil) then debugln(['TBuildManager.SetBuildTarget CODETOOLS OUTDIR=',PackageGraph.CodeToolsPackage.CompilerOptions.GetUnitOutPath(true,coptParsed),' ',PackageGraph.CodeToolsPackage.CompilerOptions.ParsedOpts.ParsedStamp[pcosOutputDir],' ',CompilerParseStamp]); end; procedure TBuildManager.SetBuildTargetProject1(Quiet: boolean; ScanFPCSrc: TBMScanFPCSources); begin SetBuildTarget('','','',ScanFPCSrc,Quiet); end; procedure TBuildManager.SetBuildTargetIDE; var NewTargetOS: String; NewTargetCPU: String; NewLCLWidgetSet: String; begin with MiscellaneousOptions do begin NewTargetOS:=BuildLazOpts.TargetOS; NewTargetCPU:=BuildLazOpts.TargetCPU; NewLCLWidgetSet:=LCLPlatformDirNames[BuildLazOpts.TargetPlatform]; end; if (NewTargetOS='') or (NewTargetOS='default') then NewTargetOS:=GetDefaultTargetOS; if (NewTargetCPU='') or (NewTargetCPU='default') then NewTargetCPU:=GetDefaultTargetCPU; debugln(['TBuildManager.SetBuildTargetIDE OS=',NewTargetOS,' CPU=',NewTargetCPU,' WS=',NewLCLWidgetSet]); SetBuildTarget(NewTargetOS,NewTargetCPU,NewLCLWidgetSet,bmsfsBackground,false); end; function TBuildManager.BuildTargetIDEIsDefault: boolean; var NewTargetOS: String; NewTargetCPU: String; NewLCLWidgetSet: TLCLPlatform; BuildIDE: Boolean; begin with MiscellaneousOptions do begin NewTargetOS:=LowerCase(BuildLazOpts.TargetOS); NewTargetCPU:=LowerCase(BuildLazOpts.TargetCPU); NewLCLWidgetSet:=BuildLazOpts.TargetPlatform; BuildIDE:=BuildLazProfiles.CurrentIdeMode in [mmBuild,mmCleanBuild]; end; //debugln(['TBuildManager.BuildTargetIDEIsDefault NewTargetOS=',NewTargetOS,' Default=',GetDefaultTargetOS,' NewTargetCPU=',NewTargetCPU,' default=',GetDefaultTargetCPU,' ws=',LCLPlatformDisplayNames[NewLCLWidgetSet],' default=',LCLPlatformDisplayNames[GetDefaultLCLWidgetType]]); Result:=BuildIDE and ((NewTargetOS='') or (NewTargetOS=GetDefaultTargetOS)) and ((NewTargetCPU='') or (NewTargetCPU=GetDefaultTargetCPU)) and (NewLCLWidgetSet<>lpNoGUI); end; end.