{ /*************************************************************************** packagesystem.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. * * * *************************************************************************** Author: Mattias Gaertner Abstract: The package registration. } unit PackageSystem; {$mode objfpc}{$H+} interface {off $DEFINE IDE_MEM_CHECK} {$DEFINE StopOnRegError} uses {$IFDEF IDE_MEM_CHECK} MemCheck, {$ENDIF} // FPC + LCL Classes, SysUtils, strutils, Forms, Controls, Dialogs, FileProcs, FileUtil, LCLProc, LazFileCache, Laz2_XMLCfg, LazLogger, LazFileUtils, LazUTF8, laz2_XMLRead, // codetools AVL_Tree, contnrs, DefineTemplates, CodeCache, BasicCodeTools, CodeToolsStructs, NonPascalCodeTools, SourceChanger, CodeToolManager, DirectoryCacher, // IDEIntf, IDEExternToolIntf, IDEDialogs, IDEMsgIntf, PackageIntf, CompOptsIntf, LazIDEIntf, MacroDefIntf, // package registration LazarusPackageIntf, // IDE LazarusIDEStrConsts, IDECmdLine, EnvironmentOpts, IDEProcs, LazConf, TransferMacros, DialogProcs, IDETranslations, CompilerOptions, PackageLinks, PackageDefs, ComponentReg, ProjectIntf; const MakefileCompileVersion = 2; // 2 : changed macro format from %() to $() type TFindPackageFlag = ( fpfSearchInInstalledPckgs, fpfSearchInAutoInstallPckgs, fpfSearchInPckgsWithEditor, fpfSearchInLoadedPkgs, fpfSearchInPkgLinks, fpfPkgLinkMustExist, // check if .lpk file exists fpfIgnoreVersion ); TFindPackageFlags = set of TFindPackageFlag; const fpfSearchEverywhere = [fpfSearchInInstalledPckgs,fpfSearchInAutoInstallPckgs, fpfSearchInPckgsWithEditor,fpfSearchInPkgLinks,fpfSearchInLoadedPkgs]; fpfSearchAllExisting = fpfSearchEverywhere+[fpfPkgLinkMustExist]; type TPkgUninstallFlag = ( puifDoNotConfirm, puifDoNotBuildIDE ); TPkgVerbosityFlag = ( pvPkgSearch // write debug messsages what packages are searched and found ); TPkgVerbosityFlags = set of TPkgVerbosityFlag; TPkgUninstallFlags = set of TPkgUninstallFlag; TPkgAddedEvent = procedure(APackage: TLazPackage) of object; TPkgDeleteEvent = procedure(APackage: TLazPackage) of object; TPkgUninstall = function(APackage: TLazPackage; Flags: TPkgUninstallFlags; ShowAbort: boolean): TModalResult of object; TPkgTranslate = procedure(APackage: TLazPackage) of object; TDependencyModifiedEvent = procedure(ADependency: TPkgDependency) of object; TPkgGraphEndUpdateEvent = procedure(Sender: TObject; GraphChanged: boolean) of object; TFindFPCUnitEvent = procedure(const AUnitName, Directory: string; var Filename: string) of object; TPkgDeleteAmbiguousFiles = function(const Filename: string): TModalResult of object; TOnBeforeCompilePackages = function(aPkgList: TFPList): TModalResult of object; TOnCheckInterPkgFiles = function(IDEObject: TObject; PkgList: TFPList; out FilesChanged: boolean): boolean of object; { TLazPkgGraphBuildItem } TLazPkgGraphBuildItem = class(TComponent) private FLazPackage: TLazPackage; fTools: TFPList; // list of TExternalTools function GetTools(Index: integer): TAbstractExternalTool; procedure SetLazPackage(AValue: TLazPackage); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Clear; function Add(Tool: TAbstractExternalTool): integer; function Count: integer; inline; function GetDummyTool: TAbstractExternalTool; function GetFirstOrDummy: TAbstractExternalTool; function GetLastOrDummy: TAbstractExternalTool; property Tools[Index: integer]: TAbstractExternalTool read GetTools; default; property LazPackage: TLazPackage read FLazPackage write SetLazPackage; end; TLazPkgGraphExtToolData = class(TIDEExternalToolData) public Pkg: TLazPackage; BuildItem: TLazPkgGraphBuildItem; SrcPPUFilename: string; CompilerFilename: string; CompilerParams: string; ErrorMessage: string; end; TLazPackageGraph = class; { TLazPackageGraphFileCachePackageInfo } TLazPackageGraphFileCachePackageInfo = record FileName: string; ChangeStamp: Integer; end; { TLazPackageGraphFileCache } TLazPackageGraphFileCache = class(TObject) private FGraph: TLazPackageGraph; FPackageInfo: array of TLazPackageGraphFileCachePackageInfo; FFilesList: TFilenameToPointerTree; FRemovedFilesList: TFilenameToPointerTree; function NeedsUpdate: Boolean; procedure Update; public constructor Create(AOwner: TLazPackageGraph); destructor Destroy; override; public function FindFileInAllPackages(TheFilename: string; IgnoreDeleted, FindVirtualFile: boolean): TPkgFile; end; { TLazPackageGraph } TLazPackageGraph = class(TPackageGraphInterface) private FAbortRegistration: boolean; fChanged: boolean; FCodeToolsPackage: TLazPackage; FDefaultPackage: TLazPackage; FErrorMsg: string; FFCLPackage: TLazPackage; FIDEIntfPackage: TLazPackage; FDebuggerIntfPackage: TLazPackage; FLazDebuggerGdbmiPackage: TLazPackage; FItems: TFPList; // unsorted list of TLazPackage FLazarusBasePackages: TFPList; FLazUtilsPackage: TLazPackage; FLCLBasePackage: TLazPackage; FLCLPackage: TLazPackage; FOnAddPackage: TPkgAddedEvent; FOnBeforeCompilePackages: TOnBeforeCompilePackages; FOnBeginUpdate: TNotifyEvent; FOnChangePackageName: TPkgChangeNameEvent; FOnCheckInterPkgFiles: TOnCheckInterPkgFiles; FOnDeleteAmbiguousFiles: TPkgDeleteAmbiguousFiles; FOnDeletePackage: TPkgDeleteEvent; FOnDependencyModified: TDependencyModifiedEvent; FOnEndUpdate: TPkgGraphEndUpdateEvent; FOnTranslatePackage: TPkgTranslate; FOnUninstallPackage: TPkgUninstall; FQuietRegistration: boolean; FRegistrationFile: TPkgFile; FRegistrationPackage: TLazPackage; FRegistrationUnitName: string; FSynEditPackage: TLazPackage; FLazControlsPackage: TLazPackage; FTree: TAVLTree; // sorted tree of TLazPackage FUpdateLock: integer; FLockedChangeStamp: int64; FVerbosity: TPkgVerbosityFlags; FFindFileCache: TLazPackageGraphFileCache; function CreateDefaultPackage: TLazPackage; function GetCount: Integer; function GetPackages(Index: integer): TLazPackage; procedure DoDependencyChanged(Dependency: TPkgDependency); procedure SetRegistrationPackage(const AValue: TLazPackage); procedure UpdateBrokenDependenciesToPackage(APackage: TLazPackage); function OpenDependencyWithPackageLink(Dependency: TPkgDependency; PkgLink: TPackageLink; ShowAbort: boolean): TModalResult; function DeleteAmbiguousFiles(const Filename: string): TModalResult; procedure AddMessage(TheUrgency: TMessageLineUrgency; const Msg, Filename: string); function OutputDirectoryIsWritable(APackage: TLazPackage; Directory: string; Verbose: boolean): boolean; function GetPackageCompilerParams(APackage: TLazPackage): string; function CheckIfCurPkgOutDirNeedsCompile(APackage: TLazPackage; CheckDependencies, SkipDesignTimePackages, GroupCompile: boolean; out NeedBuildAllFlag, ConfigChanged, DependenciesChanged: boolean; var Note: string): TModalResult; procedure InvalidateStateFile(APackage: TLazPackage); procedure OnExtToolBuildStopped(Sender: TObject); procedure PkgModify(Sender: TObject); protected procedure IncChangeStamp; override; public constructor Create; destructor Destroy; override; procedure Clear; procedure Delete(Index: integer); function Count: integer; // number of Packages procedure BeginUpdate(Change: boolean); procedure EndUpdate; function Updating: boolean; procedure RebuildDefineTemplates; function MacroFunctionPkgDir(const s: string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFunctionPkgSrcPath(const s: string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFunctionPkgUnitPath(const s: string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFunctionPkgIncPath(const s: string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFunctionPkgName(const s: string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFunctionPkgOutDir(const s: string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFunctionCTPkgDir(Data: Pointer): boolean; function MacroFunctionCTPkgSrcPath(Data: Pointer): boolean; function MacroFunctionCTPkgUnitPath(Data: Pointer): boolean; function MacroFunctionCTPkgIncPath(Data: Pointer): boolean; function MacroFunctionCTPkgName(Data: Pointer): boolean; function MacroFunctionCTPkgOutDir(Data: Pointer): boolean; function GetPackageFromMacroParameter(const TheID: string; out APackage: TLazPackage): boolean; public // searching function CheckIfPackageCanBeClosed(APackage: TLazPackage): boolean; function CreateUniquePkgName(const Prefix: string; IgnorePackage: TLazPackage): string; function CreateUniqueUnitName(const Prefix: string): string; function DependencyExists(Dependency: TPkgDependency; Flags: TFindPackageFlags): boolean; function FindBrokenDependencyPath(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; function FindAllBrokenDependencies(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; function FindCycleDependencyPath(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; function FindPath(StartPackage: TLazPackage; StartDependency: TPkgDependency; const EndPackageName: string): TFPList; function FindPkgOutputInFPCSearchPath(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; // find a package with auto compile and output dir is in FPC default search path function FindUnsavedDependencyPath(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; function FindNotInstalledRegisterUnits(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; function FindAutoInstallDependencyPath(ChildPackage: TLazPackage): TFPList; function FindAmbiguousUnits(APackage: TLazPackage; FirstDependency: TPkgDependency; out File1, File2: TPkgFile; out ConflictPkg: TLazPackage): boolean; function FindFPCConflictUnit(APackage: TLazPackage; FirstDependency: TPkgDependency; const Directory: string; OnFindFPCUnit: TFindFPCUnitEvent; var File1: TPkgFile; var ConflictPkg: TLazPackage): boolean; function FindFileInAllPackages(const TheFilename: string; IgnoreDeleted, FindVirtualFile: boolean): TPkgFile; procedure FindPossibleOwnersOfUnit(const TheFilename: string; OwnerList: TFPList); function FindLowestPkgNodeByName(const PkgName: string): TAVLTreeNode; function FindNextSameName(ANode: TAVLTreeNode): TAVLTreeNode; function FindNodeOfDependency(Dependency: TPkgDependency; Flags: TFindPackageFlags): TAVLTreeNode; function FindOpenPackage(Dependency: TPkgDependency; Flags: TFindPackageFlags): TLazPackage; function FindPackageWithName(const PkgName: string; IgnorePackage: TLazPackage): TLazPackage; function FindPackageWithFilename(const TheFilename: string): TLazPackage; function FindPackageWithID(PkgID: TLazPackageID): TLazPackage; function FindPackageWithIDMask(PkgIDMask: TLazPackageID): TLazPackage; function FindPackageProvidingName(FirstDependency: TPkgDependency; const Name: string): TLazPackage; function FindDependencyRecursively(FirstDependency: TPkgDependency; PkgID: TLazPackageID): TPkgDependency; function FindDependencyRecursively(FirstDependency: TPkgDependency; const PkgName: string): TPkgDependency; function FindConflictRecursively(FirstDependency: TPkgDependency; PkgID: TLazPackageID): TPkgDependency; function FindRuntimePkgOnlyRecursively(FirstDependency: TPkgDependency ): TPkgDependency; function FindUnit(StartPackage: TLazPackage; const TheUnitName: string; WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile; function FindUnitInAllPackages(const TheUnitName: string; IgnoreDeleted: boolean): TPkgFile; function GetMapSourceDirectoryToPackage(IgnorePackage: TLazPackage = nil): TFilenameToPointerTree; function EstimateCompileLoad(APackage: TLazPackage): int64; function PackageCanBeReplaced(OldPackage, NewPackage: TLazPackage): boolean; function PackageIsNeeded(APackage: TLazPackage): boolean; function PackageNameExists(const PkgName: string; IgnorePackage: TLazPackage): boolean; procedure GetConnectionsTree(FirstDependency: TPkgDependency; var PkgList: TFPList; var Tree: TPkgPairTree); function GetBrokenDependenciesWhenChangingPkgID(APackage: TLazPackage; const NewName: string; NewVersion: TPkgVersion): TFPList; procedure GetPackagesChangedOnDisk(out ListOfPackages: TStringList); // returns list of new filename and TLazPackage procedure GetAllRequiredPackages(APackage: TLazPackage; // if not nil then ignore FirstDependency and do not add APackage to Result FirstDependency: TPkgDependency; out List: TFPList; Flags: TPkgIntfRequiredFlags = []; MinPolicy: TPackageUpdatePolicy = low(TPackageUpdatePolicy) ); // for single search use FindDependencyRecursively procedure SortDependencyListTopologicallyOld( var FirstDependency: TPkgDependency; TopLevelFirst: boolean); procedure IterateAllComponentClasses(Event: TIterateComponentClassesEvent); procedure IterateComponentClasses(APackage: TLazPackage; Event: TIterateComponentClassesEvent; WithUsedPackages, WithRequiredPackages: boolean); procedure IteratePackages(Flags: TFindPackageFlags; Event: TIteratePackagesEvent); procedure IteratePackagesSorted(Flags: TFindPackageFlags; Event: TIteratePackagesEvent); procedure MarkAllPackagesAsNotVisited; procedure MarkAllDependencies(MarkPackages: boolean; AddMarkerFlags, RemoveMarkerFlags: TPkgMarkerFlags); procedure MarkAllRequiredPackages(FirstDependency: TPkgDependency); procedure MarkNeededPackages; procedure ConsistencyCheck; public // packages handling function CreateNewPackage(const Prefix: string): TLazPackage; procedure AddPackage(APackage: TLazPackage); procedure ReplacePackage(var OldPackage: TLazPackage; NewPackage: TLazPackage); procedure ClosePackage(APackage: TLazPackage); procedure CloseUnneededPackages; procedure ChangePackageID(APackage: TLazPackage; const NewName: string; NewVersion: TPkgVersion; RenameDependencies, RenameMacros: boolean); function SavePackageCompiledState(APackage: TLazPackage; const CompilerFilename, CompilerParams: string; Complete, MainPPUExists, ShowAbort: boolean): TModalResult; function LoadPackageCompiledState(APackage: TLazPackage; IgnoreErrors, ShowAbort: boolean): TModalResult; procedure SetFlagDependenciesNeedBuild(Pkg: TLazPackage); function CheckCompileNeedDueToFPCUnits(TheOwner: TObject; StateFileAge: longint; var Note: string): boolean; function CheckCompileNeedDueToDependencies(TheOwner: TObject; FirstDependency: TPkgDependency; SkipDesignTimePackages: boolean; StateFileAge: longint; var Note: string): TModalResult; function CheckIfPackageNeedsCompilation(APackage: TLazPackage; SkipDesignTimePackages, GroupCompile: boolean; out NeedBuildAllFlag: boolean; var Note: string): TModalResult; function PreparePackageOutputDirectory(APackage: TLazPackage; CleanUp: boolean): TModalResult; function GetFallbackOutputDir(APackage: TLazPackage): string; function CheckAmbiguousPackageUnits(APackage: TLazPackage): TModalResult; function SavePackageMainSource(APackage: TLazPackage; {%H-}Flags: TPkgCompileFlags; ShowAbort: boolean): TModalResult; function CompileRequiredPackages(APackage: TLazPackage; FirstDependency: TPkgDependency; SkipDesignTimePackages: boolean; Policy: TPackageUpdatePolicy): TModalResult; function CompilePackage(APackage: TLazPackage; Flags: TPkgCompileFlags; ShowAbort: boolean; BuildItem: TLazPkgGraphBuildItem = nil): TModalResult; function ConvertPackageRSTFiles(APackage: TLazPackage): TModalResult; function WriteMakefileCompiled(APackage: TLazPackage; TargetCompiledFile, UnitPath, IncPath, OtherOptions: string): TModalResult; function WriteMakeFile(APackage: TLazPackage): TModalResult; function WriteFpmake(APackage: TLazPackage): TModalResult; public // installed packages FirstAutoInstallDependency: TPkgDependency; procedure LoadStaticBasePackages; procedure LoadAutoInstallPackages(PkgList: TStringList); procedure SortAutoInstallDependencies; function GetIDEInstallPackageOptions( var InheritedOptionStrings: TInheritedCompOptsStrings): string; function SaveAutoInstallConfig: TModalResult;// for the uses section function IsStaticBasePackage(PackageName: string): boolean; procedure FreeAutoInstallDependencies; public // registration procedure RegisterUnitHandler(const TheUnitName: string; RegisterProc: TRegisterProc); procedure RegisterComponentsHandler(const Page: string; ComponentClasses: array of TComponentClass); procedure RegistrationError(const Msg: string); procedure RegisterStaticBasePackages; procedure RegisterStaticPackage(APackage: TLazPackage; RegisterProc: TRegisterProc); procedure RegisterDefaultPackageComponent(const Page, AUnitName: ShortString; ComponentClass: TComponentClass); procedure CallRegisterProc(RegisterProc: TRegisterProc); public // dependency handling procedure AddDependencyToPackage(APackage: TLazPackage; Dependency: TPkgDependency); procedure AddDependencyToPackage(APackage, RequiredPackage: TLazPackage); procedure RemoveDependencyFromPackage(APackage: TLazPackage; Dependency: TPkgDependency; AddToRemovedList: boolean); //procedure ChangeDependency(Dependency, NewDependency: TPkgDependency); function OpenDependency(Dependency: TPkgDependency; ShowAbort: boolean): TLoadPackageResult; function FindAlternativeLPK(APackage: TLazPackage): string; procedure OpenInstalledDependency(Dependency: TPkgDependency; InstallType: TPackageInstallType; var Quiet: boolean); procedure OpenRequiredDependencyList(FirstDependency: TPkgDependency); procedure MoveRequiredDependencyUp(ADependency: TPkgDependency); procedure MoveRequiredDependencyDown(ADependency: TPkgDependency); public // properties property AbortRegistration: boolean read FAbortRegistration write FAbortRegistration; property QuietRegistration: boolean read FQuietRegistration write FQuietRegistration; property ErrorMsg: string read FErrorMsg write FErrorMsg; property Packages[Index: integer]: TLazPackage read GetPackages; default; // see Count for the number property UpdateLock: integer read FUpdateLock; property Verbosity: TPkgVerbosityFlags read FVerbosity write FVerbosity; // base packages property FCLPackage: TLazPackage read FFCLPackage; property LCLBasePackage: TLazPackage read FLCLBasePackage; property LCLPackage: TLazPackage read FLCLPackage; property SynEditPackage: TLazPackage read FSynEditPackage; property LazControlsPackage: TLazPackage read FLazControlsPackage; property LazUtilsPackage: TLazPackage read FLazUtilsPackage; property CodeToolsPackage: TLazPackage read FCodeToolsPackage; property IDEIntfPackage: TLazPackage read FIDEIntfPackage; property DebuggerIntfPackage: TLazPackage read FDebuggerIntfPackage; property LazDebuggerGdbmiPackage: TLazPackage read FLazDebuggerGdbmiPackage; property LazarusBasePackages: TFPList read FLazarusBasePackages; property DefaultPackage: TLazPackage read FDefaultPackage;// fall back package for buggy/obsoleted stuff // events property OnAddPackage: TPkgAddedEvent read FOnAddPackage write FOnAddPackage; property OnBeginUpdate: TNotifyEvent read FOnBeginUpdate write FOnBeginUpdate; property OnChangePackageName: TPkgChangeNameEvent read FOnChangePackageName write FOnChangePackageName; property OnCheckInterPkgFiles: TOnCheckInterPkgFiles read FOnCheckInterPkgFiles write FOnCheckInterPkgFiles; property OnDependencyModified: TDependencyModifiedEvent read FOnDependencyModified write FOnDependencyModified; property OnDeletePackage: TPkgDeleteEvent read FOnDeletePackage write FOnDeletePackage; property OnEndUpdate: TPkgGraphEndUpdateEvent read FOnEndUpdate write FOnEndUpdate; property OnDeleteAmbiguousFiles: TPkgDeleteAmbiguousFiles read FOnDeleteAmbiguousFiles write FOnDeleteAmbiguousFiles; property OnTranslatePackage: TPkgTranslate read FOnTranslatePackage write FOnTranslatePackage; property OnUninstallPackage: TPkgUninstall read FOnUninstallPackage write FOnUninstallPackage; property OnBeforeCompilePackages: TOnBeforeCompilePackages read FOnBeforeCompilePackages write FOnBeforeCompilePackages; // set during calling Register procedures property RegistrationFile: TPkgFile read FRegistrationFile; property RegistrationPackage: TLazPackage read FRegistrationPackage write SetRegistrationPackage; property RegistrationUnitName: string read FRegistrationUnitName; end; var PackageGraph: TLazPackageGraph = nil; function ExtractFPCParamsForBuildAll(const CompParams: string): string; function ExtractMakefileCompiledParams(const CompParams: string; CreateReduced: boolean = false; BaseDir: string = ''; MakeRelative: boolean = false): TStringList; function RemoveFPCVerbosityParams(const CompParams: string): string; implementation procedure RegisterCustomIDEComponent(const Page, AUnitName: ShortString; ComponentClass: TComponentClass); begin PackageGraph.RegisterDefaultPackageComponent(Page,AUnitName,ComponentClass); end; procedure RegisterComponentsGlobalHandler(const Page: string; ComponentClasses: array of TComponentClass); begin PackageGraph.RegisterComponentsHandler(Page,ComponentClasses); end; procedure RegisterNoIconGlobalHandler(ComponentClasses: array of TComponentClass); begin PackageGraph.RegisterComponentsHandler('',ComponentClasses); end; function ExtractFPCParamsForBuildAll(const CompParams: string): string; { Some compiler flags require a clean build -B, because the compiler does not recompile/update some ppu itself. Remove all flags that do not require build all: -l logo -F file name and paths -B build all -e executable -i information -o name of the executable -s quick build option, do not call assembler and linker -v verbosity -X Executable } var EndPos: Integer; StartPos: integer; begin Result:=CompParams; EndPos:=1; while ReadNextFPCParameter(Result,EndPos,StartPos) do begin if (Result[StartPos]='-') and (StartPos1) and (Result[StartPos-1] in [' ',#9]) do dec(StartPos); //DebugLn(['ExtractFPCParamsForBuildAll Removing: ',copy(Result,StartPos,EndPos-StartPos)]); System.Delete(Result,StartPos,EndPos-StartPos); EndPos:=StartPos; end; end; end; end; Result:=UTF8Trim(Result,[]); end; function ExtractMakefileCompiledParams(const CompParams: string; CreateReduced: boolean; BaseDir: string; MakeRelative: boolean): TStringList; var AllPaths: TStringList; EndPos: Integer; StartPos: integer; Path: String; Reduced: String; i: Integer; procedure AddSearchPath(Typ: string); begin AllPaths.Values[Typ]:=MergeSearchPaths(AllPaths.Values[Typ],Path); end; procedure DeleteOption; begin while (EndPos<=length(Reduced)) and (Reduced[EndPos] in [' ',#9]) do inc(EndPos); //debugln(['DeleteOption "',copy(Reduced,StartPos,EndPos-StartPos),'"']); System.Delete(Reduced,StartPos,EndPos-StartPos); EndPos:=StartPos; end; begin Result:=TStringList.Create; Reduced:=''; AllPaths:=Result; EndPos:=1; while ReadNextFPCParameter(CompParams,EndPos,StartPos) do begin if (CompParams[StartPos]='-') and (StartPos'') and (Path[1] in ['''','"']) then Path:=AnsiDequotedStr(Path,Path[1]); case CompParams[StartPos+2] of 'u': begin AddSearchPath('UnitPath'); continue; end; 'U': begin AllPaths.Values['UnitOutputDir']:=Path; continue; end; 'i': begin AddSearchPath('IncPath'); continue; end; 'o': begin AddSearchPath('ObjectPath'); continue; end; 'l': begin AddSearchPath('LibPath'); continue; end; end; end; 'v': // verbosity continue; 'i','l': // information continue; 'B': // build clean continue; 'C': if (StartPos+2<=length(CompParams)) and (CompParams[StartPos+2]='g') and TargetNeedsFPCOptionCG(GetCompiledTargetOS,GetCompiledTargetCPU) then begin // the -Cg parameter is added automatically on Linux, but not in the // Makefile.compiled, because that is platform independent. // -> ignore continue; end; end; end; if Reduced<>'' then Reduced+=' '; Reduced+=copy(CompParams,StartPos,EndPos-StartPos); end; if BaseDir<>'' then begin for i:=0 to AllPaths.Count-1 do begin Path:=AllPaths.ValueFromIndex[i]; if MakeRelative then AllPaths[i]:=AllPaths.Names[i]+'='+CreateRelativeSearchPath(Path,BaseDir) else AllPaths[i]:=AllPaths.Names[i]+'='+CreateAbsoluteSearchPath(Path,BaseDir); end; end; if CreateReduced then AllPaths.Values['Reduced']:=UTF8Trim(Reduced,[]); end; function RemoveFPCVerbosityParams(const CompParams: string): string; { Some compiler flags have no impact on the produced files. Remove all flags that do not require a rebuild: -l -B -i -v } var EndPos: Integer; StartPos: integer; begin Result:=CompParams; EndPos:=1; while ReadNextFPCParameter(Result,EndPos,StartPos) do begin if (Result[StartPos]='-') and (StartPos1) and (Result[StartPos-1] in [' ',#9]) do dec(StartPos); //DebugLn(['ExtractFPCVerbosityParams Removing: ',copy(Result,StartPos,EndPos-StartPos)]); System.Delete(Result,StartPos,EndPos-StartPos); EndPos:=StartPos; end; end; end; end; Result:=UTF8Trim(Result,[]); end; { TLazPackageGraphFileCache } constructor TLazPackageGraphFileCache.Create(AOwner: TLazPackageGraph); begin inherited Create; FGraph := AOwner; SetLength(FPackageInfo, 0); FFilesList := TFilenameToPointerTree.Create(true); FRemovedFilesList := TFilenameToPointerTree.Create(true); end; destructor TLazPackageGraphFileCache.Destroy; begin SetLength(FPackageInfo, 0); FreeAndNil(FFilesList); FreeAndNil(FRemovedFilesList); inherited Destroy; end; function TLazPackageGraphFileCache.FindFileInAllPackages( TheFilename: string; IgnoreDeleted, FindVirtualFile: boolean): TPkgFile; procedure FindFileInStrList(const Files: TFilenameToPointerTree); begin Result:=TPkgFile(Files[TheFilename]); if (Result<>nil) and (not FindVirtualFile) and (not FilenameIsAbsolute(Result.Filename)) then Result := nil; end; begin Result:=nil; if NeedsUpdate then Update; FindFileInStrList(FFilesList); if Result<>nil then Exit; if not IgnoreDeleted then FindFileInStrList(FRemovedFilesList); end; function TLazPackageGraphFileCache.NeedsUpdate: Boolean; var I: Integer; begin if FGraph.Count <> Length(FPackageInfo) then Exit(True); for I := 0 to FGraph.Count-1 do if (FPackageInfo[I].ChangeStamp <> FGraph[I].ChangeStamp) or (FPackageInfo[I].FileName<>FGraph[I].Filename) then Exit(True); Result := False; end; procedure TLazPackageGraphFileCache.Update; var I, L: Integer; xPck: TLazPackage; begin SetLength(FPackageInfo, FGraph.Count); FFilesList.Clear; FRemovedFilesList.Clear; for I := 0 to FGraph.Count-1 do begin xPck := FGraph[I]; FPackageInfo[I].ChangeStamp := xPck.ChangeStamp; FPackageInfo[I].FileName := xPck.Filename; for L := 0 to xPck.FileCount-1 do begin FFilesList[xPck.Files[L].GetFullFilename]:=xPck.Files[L]; FFilesList[xPck.Files[L].Filename]:=xPck.Files[L]; end; for L := 0 to xPck.RemovedFilesCount-1 do begin FRemovedFilesList[xPck.RemovedFiles[L].GetFullFilename]:=xPck.RemovedFiles[L]; FRemovedFilesList[xPck.RemovedFiles[L].Filename]:=xPck.RemovedFiles[L]; end; end; end; { TLazPkgGraphBuildItem } // inline function TLazPkgGraphBuildItem.Count: integer; begin Result:=fTools.Count; end; function TLazPkgGraphBuildItem.GetDummyTool: TAbstractExternalTool; begin Result:=ExternalToolList.AddDummy('Dummy tool for building package '+LazPackage.Name); Add(Result); end; function TLazPkgGraphBuildItem.GetFirstOrDummy: TAbstractExternalTool; begin if Count>0 then Result:=TAbstractExternalTool(fTools[0]) else Result:=GetDummyTool; end; function TLazPkgGraphBuildItem.GetLastOrDummy: TAbstractExternalTool; begin if Count>0 then Result:=TAbstractExternalTool(fTools[Count-1]) else Result:=GetDummyTool; end; function TLazPkgGraphBuildItem.GetTools(Index: integer): TAbstractExternalTool; begin Result:=TAbstractExternalTool(fTools[Index]); end; procedure TLazPkgGraphBuildItem.SetLazPackage(AValue: TLazPackage); begin if FLazPackage=AValue then Exit; if FLazPackage<>nil then FLazPackage.RemoveFreeNotification(Self); FLazPackage:=AValue; if FLazPackage<>nil then FLazPackage.FreeNotification(Self); end; procedure TLazPkgGraphBuildItem.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if Operation=opRemove then begin if LazPackage=AComponent then LazPackage:=nil; end; end; constructor TLazPkgGraphBuildItem.Create(AOwner: TComponent); begin inherited; fTools:=TFPList.Create; end; destructor TLazPkgGraphBuildItem.Destroy; begin Clear; FreeAndNil(fTools); inherited Destroy; end; procedure TLazPkgGraphBuildItem.Clear; var i: Integer; Tool: TAbstractExternalTool; begin {$IFDEF VerboseCheckInterPkgFiles} debugln(['TLazPkgGraphBuildItem.Clear ',LazPackage.IDAsString]); {$ENDIF} for i:=Count-1 downto 0 do begin Tool:=Tools[i]; if Tool.Data is TLazPkgGraphExtToolData then TLazPkgGraphExtToolData(Tool.Data).BuildItem:=nil; Tool.Release(Self); end; fTools.Clear; end; function TLazPkgGraphBuildItem.Add(Tool: TAbstractExternalTool): integer; begin if Tool=nil then exit(-1); Tool.Reference(Self,'TLazPkgGraphBuildItem.Add'); if Tool.Data is TLazPkgGraphExtToolData then TLazPkgGraphExtToolData(Tool.Data).BuildItem:=Self; Result:=fTools.Add(Tool); end; { TLazPackageGraph } procedure TLazPackageGraph.DoDependencyChanged(Dependency: TPkgDependency); begin fChanged:=true; if Assigned(OnDependencyModified) then OnDependencyModified(Dependency); end; function TLazPackageGraph.GetPackages(Index: integer): TLazPackage; begin Result:=TLazPackage(FItems[Index]); end; procedure TLazPackageGraph.SetRegistrationPackage(const AValue: TLazPackage); begin if FRegistrationPackage=AValue then exit; FRegistrationPackage:=AValue; AbortRegistration:=false; LazarusPackageIntf.RegisterUnitProc:=@RegisterUnitHandler; RegisterComponentsProc:=@RegisterComponentsGlobalHandler; RegisterNoIconProc:=@RegisterNoIconGlobalHandler; end; procedure TLazPackageGraph.UpdateBrokenDependenciesToPackage( APackage: TLazPackage); var ANode: TAVLTreeNode; Dependency: TPkgDependency; begin BeginUpdate(false); ANode:=FindLowestPkgDependencyNodeWithName(APackage.Name); while ANode<>nil do begin Dependency:=TPkgDependency(ANode.Data); if (Dependency.LoadPackageResult<>lprSuccess) and Dependency.IsCompatible(APackage) then begin Dependency.LoadPackageResult:=lprUndefined; OpenDependency(Dependency,false); end; ANode:=FindNextPkgDependencyNodeWithSameName(ANode); end; EndUpdate; end; function TLazPackageGraph.OpenDependencyWithPackageLink( Dependency: TPkgDependency; PkgLink: TPackageLink; ShowAbort: boolean): TModalResult; var AFilename: String; NewPackage: TLazPackage; XMLConfig: TXMLConfig; Code: TCodeBuffer; OldPackage: TLazPackage; begin NewPackage:=nil; XMLConfig:=nil; BeginUpdate(false); try AFilename:=PkgLink.GetEffectiveFilename; if pvPkgSearch in Verbosity then debugln(['Info: (lazarus) Open dependency: trying "'+Dependency.PackageName+'" in '+dbgs(PkgLink.Origin)+' links: "'+PkgLink.GetEffectiveFilename+'" ...']); //debugln(['TLazPackageGraph.OpenDependencyWithPackageLink AFilename=',AFilename,' ',PkgLink.Origin=ploGlobal]); if not FileExistsUTF8(AFilename) then begin DebugLn('Note: (lazarus) Invalid Package Link: file "'+AFilename+'" does not exist.'); PkgLink.LPKFileDateValid:=false; exit(mrCancel); end; if pvPkgSearch in Verbosity then debugln(['Info: (lazarus) Open dependency: package file found: "'+AFilename+'". Parsing lpk ...']); try PkgLink.LPKFileDate:=FileDateToDateTimeDef(FileAgeUTF8(AFilename)); PkgLink.LPKFileDateValid:=true; XMLConfig:=TXMLConfig.Create(nil); NewPackage:=TLazPackage.Create; NewPackage.Filename:=AFilename; NewPackage.OnModifySilently := @PkgModify; Result:=LoadXMLConfigFromCodeBuffer(AFilename,XMLConfig, Code,[lbfUpdateFromDisk,lbfRevert],ShowAbort); if Result<>mrOk then exit; NewPackage.LoadFromXMLConfig(XMLConfig,'Package/'); NewPackage.LPKSource:=Code; except on E: Exception do begin DebugLn('Error: (lazarus) unable to read file "'+AFilename+'" ',E.Message); exit(mrCancel); end; end; if not NewPackage.IsMakingSense then begin DebugLn('Error: (lazarus) invalid package file "'+AFilename+'".'); exit(mrCancel); end; if SysUtils.CompareText(PkgLink.Name,NewPackage.Name)<>0 then begin DebugLn('Error: (lazarus) package file "'+AFilename+'" and name "'+NewPackage.Name+'" mismatch.'); exit(mrCancel); end; // ok if pvPkgSearch in Verbosity then debugln('Info: (lazarus) Open dependency ['+Dependency.PackageName+']: Success: "'+NewPackage.Filename+'"'); Result:=mrOk; Dependency.RequiredPackage:=NewPackage; Dependency.LoadPackageResult:=lprSuccess; OldPackage:=FindPackageWithName(NewPackage.Name,NewPackage); if OldPackage=nil then AddPackage(NewPackage) else ReplacePackage(OldPackage,NewPackage); finally if Result<>mrOk then NewPackage.Free; EndUpdate; FreeAndNil(XMLConfig); end; end; function TLazPackageGraph.DeleteAmbiguousFiles(const Filename: string ): TModalResult; begin if Assigned(OnDeleteAmbiguousFiles) then Result:=OnDeleteAmbiguousFiles(Filename) else Result:=mrOk; end; procedure TLazPackageGraph.AddMessage(TheUrgency: TMessageLineUrgency; const Msg, Filename: string); begin if Assigned(IDEMessagesWindow) then IDEMessagesWindow.AddCustomMessage(TheUrgency,Msg,Filename) else DebugLn([MessageLineUrgencyNames[TheUrgency],': (lazarus) ',Msg,' Filename="',Filename,'"']); end; function TLazPackageGraph.OutputDirectoryIsWritable(APackage: TLazPackage; Directory: string; Verbose: boolean): boolean; begin Result:=false; //debugln(['TLazPackageGraph.OutputDirectoryIsWritable ',Directory]); if not FilenameIsAbsolute(Directory) then exit; Directory:=ChompPathDelim(Directory); if not DirPathExistsCached(Directory) then begin // the directory does not exist => try creating it if not ForceDirectoriesUTF8(Directory) then begin if Verbose then begin IDEMessageDialog(lisPkgMangUnableToCreateDirectory, Format(lisPkgMangUnableToCreateOutputDirectoryForPackage, [Directory, LineEnding, APackage.IDAsString]), mtError,[mbCancel]); end; debugln(['Error: (lazarus) unable to create package output directory "',Directory,'" of package "',APackage.IDAsString,'"']); exit; end; Result:=true; end else Result:=DirectoryIsWritableCached(Directory); end; function TLazPackageGraph.GetPackageCompilerParams(APackage: TLazPackage ): string; begin Result:=APackage.CompilerOptions.MakeOptionsString( APackage.CompilerOptions.DefaultMakeOptionsFlags+[ccloAbsolutePaths]) +' '+CreateRelativePath(APackage.GetSrcFilename,APackage.Directory); end; constructor TLazPackageGraph.Create; begin OnGetAllRequiredPackages:=@GetAllRequiredPackages; FTree:=TAVLTree.Create(@CompareLazPackageID); FItems:=TFPList.Create; FLazarusBasePackages:=TFPList.Create; if GlobalMacroList<>nil then begin GlobalMacroList.Add(TTransferMacro.Create('PkgDir','', lisPkgMacroPackageDirectoryParameterIsPackageID, @MacroFunctionPkgDir, [])); GlobalMacroList.Add(TTransferMacro.Create('PkgSrcPath','', lisPkgMacroPackageSourceSearchPathParameterIsPackageID, @MacroFunctionPkgSrcPath,[])); GlobalMacroList.Add(TTransferMacro.Create('PkgUnitPath','', lisPkgMacroPackageUnitSearchPathParameterIsPackageID, @MacroFunctionPkgUnitPath,[])); GlobalMacroList.Add(TTransferMacro.Create('PkgIncPath','', lisPkgMacroPackageIncludeFilesSearchPathParameterIsPackageID, @MacroFunctionPkgIncPath,[])); GlobalMacroList.Add(TTransferMacro.Create('PkgName','', lisPkgMacroPackageNameParameterIsPackageID, @MacroFunctionPkgName,[])); GlobalMacroList.Add(TTransferMacro.Create('PkgOutDir','', lisPkgMacroPackageOutputDirectoryParameterIsPackageID, @MacroFunctionPkgOutDir,[])); end; end; destructor TLazPackageGraph.Destroy; begin if LazarusPackageIntf.RegisterUnitProc=@RegisterUnitHandler then LazarusPackageIntf.RegisterUnitProc:=nil; if RegisterComponentsProc=@RegisterComponentsGlobalHandler then RegisterComponentsProc:=nil; if RegisterNoIconProc=@RegisterNoIconGlobalHandler then RegisterNoIconProc:=nil; if OnGetAllRequiredPackages=@GetAllRequiredPackages then OnGetAllRequiredPackages:=nil; Clear; FreeAndNil(FDefaultPackage); FreeAndNil(FLazarusBasePackages); FreeAndNil(FItems); FreeAndNil(FTree); FreeAndNil(FFindFileCache); inherited Destroy; end; procedure TLazPackageGraph.Clear; var i: Integer; begin FLazarusBasePackages.Clear; for i:=FItems.Count-1 downto 0 do Delete(i); end; procedure TLazPackageGraph.Delete(Index: integer); var CurPkg: TLazPackage; begin CurPkg:=Packages[Index]; if lpfDestroying in CurPkg.Flags then exit; BeginUpdate(true); CurPkg.Flags:=CurPkg.Flags+[lpfDestroying]; CurPkg.DefineTemplates.Active:=false; if Assigned(OnDeletePackage) then OnDeletePackage(CurPkg); if CurPkg=FCLPackage then FFCLPackage:=nil else if CurPkg=LCLBasePackage then FLCLBasePackage:=nil else if CurPkg=LCLPackage then FLCLPackage:=nil else if CurPkg=IDEIntfPackage then FIDEIntfPackage:=nil else if CurPkg=DebuggerIntfPackage then FDebuggerIntfPackage:=nil else if CurPkg=LazDebuggerGdbmiPackage then FLazDebuggerGdbmiPackage:=nil else if CurPkg=SynEditPackage then FSynEditPackage:=nil else if CurPkg=LazControlsPackage then FLazControlsPackage:=nil else if CurPkg=LazUtilsPackage then FLazUtilsPackage:=nil else if CurPkg=CodeToolsPackage then FCodeToolsPackage:=nil; FLazarusBasePackages.Remove(CurPkg); FItems.Delete(Index); FTree.Remove(CurPkg); CurPkg.Free; EndUpdate; end; function TLazPackageGraph.Count: integer; begin Result:=FItems.Count; end; procedure TLazPackageGraph.BeginUpdate(Change: boolean); begin inc(FUpdateLock); if FUpdateLock=1 then begin fChanged:=Change; FLockedChangeStamp:=0; if Assigned(OnBeginUpdate) then OnBeginUpdate(Self); end else fChanged:=fChanged or Change; end; procedure TLazPackageGraph.EndUpdate; begin if FUpdateLock<=0 then RaiseException('TLazPackageGraph.EndUpdate'); dec(FUpdateLock); if FUpdateLock=0 then begin if FLockedChangeStamp>0 then IncChangeStamp; if Assigned(OnEndUpdate) then OnEndUpdate(Self,fChanged); end; end; function TLazPackageGraph.Updating: boolean; begin Result:=FUpdateLock>0; end; procedure TLazPackageGraph.RebuildDefineTemplates; var i: Integer; begin for i:=0 to Count-1 do Packages[i].DefineTemplates.AllChanged; end; function TLazPackageGraph.MacroFunctionPkgDir(const s: string; const Data: PtrInt; var Abort: boolean): string; var APackage: TLazPackage; begin if GetPackageFromMacroParameter(s,APackage) then Result:=APackage.Directory else Result:=''; end; function TLazPackageGraph.MacroFunctionPkgSrcPath(const s: string; const Data: PtrInt; var Abort: boolean): string; var APackage: TLazPackage; begin if GetPackageFromMacroParameter(s,APackage) then Result:=APackage.SourceDirectories.CreateSearchPathFromAllFiles else Result:=''; end; function TLazPackageGraph.MacroFunctionPkgUnitPath(const s: string; const Data: PtrInt; var Abort: boolean): string; var APackage: TLazPackage; begin if GetPackageFromMacroParameter(s,APackage) then Result:=APackage.GetUnitPath(false) else Result:=''; end; function TLazPackageGraph.MacroFunctionPkgIncPath(const s: string; const Data: PtrInt; var Abort: boolean): string; var APackage: TLazPackage; begin if GetPackageFromMacroParameter(s,APackage) then Result:=APackage.GetIncludePath(false) else Result:=''; end; function TLazPackageGraph.MacroFunctionPkgName(const s: string; const Data: PtrInt; var Abort: boolean): string; begin Result := s; end; function TLazPackageGraph.MacroFunctionPkgOutDir(const s: string; const Data: PtrInt; var Abort: boolean): string; var APackage: TLazPackage; begin if GetPackageFromMacroParameter(s,APackage) then Result:=APackage.GetOutputDirectory else Result:=''; end; function TLazPackageGraph.MacroFunctionCTPkgDir(Data: Pointer): boolean; var FuncData: PReadFunctionData; APackage: TLazPackage; begin FuncData:=PReadFunctionData(Data); Result:=GetPackageFromMacroParameter(FuncData^.Param,APackage); if Result then FuncData^.Result:=APackage.Directory; end; function TLazPackageGraph.MacroFunctionCTPkgSrcPath(Data: Pointer): boolean; var FuncData: PReadFunctionData; APackage: TLazPackage; begin FuncData:=PReadFunctionData(Data); Result:=GetPackageFromMacroParameter(FuncData^.Param,APackage); if Result then FuncData^.Result:=APackage.GetUnitPath(false)+';'+APackage.GetSrcPath(false); end; function TLazPackageGraph.MacroFunctionCTPkgUnitPath(Data: Pointer): boolean; var FuncData: PReadFunctionData; APackage: TLazPackage; begin FuncData:=PReadFunctionData(Data); Result:=GetPackageFromMacroParameter(FuncData^.Param,APackage); if Result then FuncData^.Result:=APackage.GetUnitPath(false); end; function TLazPackageGraph.MacroFunctionCTPkgIncPath(Data: Pointer): boolean; var FuncData: PReadFunctionData; APackage: TLazPackage; begin FuncData:=PReadFunctionData(Data); Result:=GetPackageFromMacroParameter(FuncData^.Param,APackage); if Result then FuncData^.Result:=APackage.GetIncludePath(false); end; function TLazPackageGraph.MacroFunctionCTPkgName(Data: Pointer): boolean; var FuncData: PReadFunctionData; begin FuncData:=PReadFunctionData(Data); FuncData^.Result:=GetIdentifier(PChar(FuncData^.Param)); Result:=true; end; function TLazPackageGraph.MacroFunctionCTPkgOutDir(Data: Pointer): boolean; var FuncData: PReadFunctionData; APackage: TLazPackage; begin FuncData:=PReadFunctionData(Data); Result:=GetPackageFromMacroParameter(FuncData^.Param,APackage); if Result then FuncData^.Result:=APackage.GetOutputDirectory; end; function TLazPackageGraph.GetPackageFromMacroParameter(const TheID: string; out APackage: TLazPackage): boolean; var PkgID: TLazPackageID; begin PkgID:=TLazPackageID.Create; if PkgID.StringToID(TheID) then begin APackage:=FindPackageWithIDMask(PkgID); if APackage=nil then begin DebugLn('Warning: (lazarus) unknown macro package id "',TheID,'"'); end; end else begin APackage:=nil; DebugLn('Warning: (lazarus) invalid macro package id "',TheID,'"'); end; PkgID.Free; Result:=APackage<>nil; end; function TLazPackageGraph.FindLowestPkgNodeByName(const PkgName: string ): TAVLTreeNode; var PriorNode: TAVLTreeNode; begin Result:=nil; if PkgName='' then exit; Result:=FTree.FindKey(PChar(PkgName),@CompareNameWithPackageID); while Result<>nil do begin PriorNode:=FTree.FindPrecessor(Result); if (PriorNode=nil) or (SysUtils.CompareText(PkgName,TLazPackage(PriorNode.Data).Name)<>0) then break; Result:=PriorNode; end; end; function TLazPackageGraph.FindNextSameName(ANode: TAVLTreeNode): TAVLTreeNode; var NextNode: TAVLTreeNode; begin Result:=nil; if ANode=nil then exit; NextNode:=FTree.FindSuccessor(ANode); if (NextNode=nil) or (SysUtils.CompareText(TLazPackage(ANode.Data).Name, TLazPackage(NextNode.Data).Name)<>0) then exit; Result:=NextNode; end; function TLazPackageGraph.FindNodeOfDependency(Dependency: TPkgDependency; Flags: TFindPackageFlags): TAVLTreeNode; var CurPkg: TLazPackage; begin // search in all packages with the same name Result:=FindLowestPkgNodeByName(Dependency.PackageName); while Result<>nil do begin CurPkg:=TLazPackage(Result.Data); // check version if (not (fpfIgnoreVersion in Flags)) and (not Dependency.IsCompatible(CurPkg)) then begin Result:=FindNextSameName(Result); continue; end; // check loaded packages if (fpfSearchInLoadedPkgs in Flags) then exit; // check installed packages if (fpfSearchInInstalledPckgs in Flags) and (CurPkg.Installed<>pitNope) then exit; // check autoinstall packages if (fpfSearchInAutoInstallPckgs in Flags) and (CurPkg.AutoInstall<>pitNope) then exit; // check packages with opened editor if (fpfSearchInPckgsWithEditor in Flags) and (CurPkg.Editor<>nil) then exit; // search next package node with same name Result:=FindNextSameName(Result); end; end; function TLazPackageGraph.FindOpenPackage(Dependency: TPkgDependency; Flags: TFindPackageFlags): TLazPackage; var ANode: TAVLTreeNode; begin ANode:=FindNodeOfDependency(Dependency,Flags); if ANode<>nil then Result:=TLazPackage(ANode.Data) else Result:=nil; end; function TLazPackageGraph.FindPackageWithName(const PkgName: string; IgnorePackage: TLazPackage): TLazPackage; var ANode: TAVLTreeNode; begin Result:=nil; ANode:=FindLowestPkgNodeByName(PkgName); if ANode<>nil then begin Result:=TLazPackage(ANode.Data); if Result=IgnorePackage then begin Result:=nil; ANode:=FindNextSameName(ANode); if ANode<>nil then Result:=TLazPackage(ANode.Data); end; end; end; function TLazPackageGraph.FindPackageWithID(PkgID: TLazPackageID): TLazPackage; var ANode: TAVLTreeNode; begin ANode:=FTree.Find(PkgID); if ANode<>nil then Result:=TLazPackage(ANode.Data) else Result:=nil; end; function TLazPackageGraph.FindPackageWithIDMask(PkgIDMask: TLazPackageID ): TLazPackage; var ANode: TAVLTreeNode; begin ANode:=FTree.FindKey(PkgIDMask,@ComparePkgIDMaskWithPackageID); if ANode<>nil then Result:=TLazPackage(ANode.Data) else Result:=nil; end; function TLazPackageGraph.FindPackageProvidingName( FirstDependency: TPkgDependency; const Name: string): TLazPackage; function Search(ADependency: TPkgDependency; out Found: TLazPackage ): boolean; begin Found:=nil; while ADependency<>nil do begin Found:=ADependency.RequiredPackage; //DebugLn(['Search ',Found.Name,' ',Found.ProvidesPackage(Name),' "',Found.Provides.Text,'"']); if (Found<>nil) and (not (lpfVisited in Found.Flags)) then begin Found.Flags:=Found.Flags+[lpfVisited]; if Found.ProvidesPackage(Name) or Search(Found.FirstRequiredDependency,Found) then exit(true); end; ADependency:=ADependency.NextRequiresDependency; end; Found:=nil; Result:=false; end; begin MarkAllPackagesAsNotVisited; Search(FirstDependency,Result); end; function TLazPackageGraph.FindDependencyRecursively( FirstDependency: TPkgDependency; PkgID: TLazPackageID): TPkgDependency; // returns one compatible dependency for PkgID function Find(CurDependency: TPkgDependency): TPkgDependency; var RequiredPackage: TLazPackage; begin while CurDependency<>nil do begin if CurDependency.IsCompatible(PkgID) then begin Result:=CurDependency; exit; end; if CurDependency.LoadPackageResult=lprSuccess then begin RequiredPackage:=CurDependency.RequiredPackage; if (not (lpfVisited in RequiredPackage.Flags)) then begin RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited]; Result:=Find(RequiredPackage.FirstRequiredDependency); if Result<>nil then exit; end; end; CurDependency:=CurDependency.NextRequiresDependency; end; Result:=nil; end; begin if FirstDependency=nil then exit(nil); MarkAllPackagesAsNotVisited; Result:=Find(FirstDependency); end; function TLazPackageGraph.FindDependencyRecursively( FirstDependency: TPkgDependency; const PkgName: string): TPkgDependency; // returns one compatible dependency for PkgName function Find(CurDependency: TPkgDependency): TPkgDependency; var RequiredPackage: TLazPackage; begin while CurDependency<>nil do begin if SysUtils.CompareText(CurDependency.PackageName,PkgName)=0 then begin Result:=CurDependency; exit; end; if CurDependency.LoadPackageResult=lprSuccess then begin RequiredPackage:=CurDependency.RequiredPackage; if (not (lpfVisited in RequiredPackage.Flags)) then begin RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited]; Result:=Find(RequiredPackage.FirstRequiredDependency); if Result<>nil then exit; end; end; CurDependency:=CurDependency.NextRequiresDependency; end; Result:=nil; end; begin if FirstDependency=nil then exit(nil); MarkAllPackagesAsNotVisited; Result:=Find(FirstDependency); end; function TLazPackageGraph.FindConflictRecursively( FirstDependency: TPkgDependency; PkgID: TLazPackageID): TPkgDependency; // returns one conflicting dependency for PkgID function Find(CurDependency: TPkgDependency): TPkgDependency; var RequiredPackage: TLazPackage; begin while CurDependency<>nil do begin if (SysUtils.CompareText(CurDependency.PackageName,PkgID.Name)=0) and (not CurDependency.IsCompatible(PkgID)) then begin Result:=CurDependency; exit; end; if CurDependency.LoadPackageResult=lprSuccess then begin RequiredPackage:=CurDependency.RequiredPackage; if (not (lpfVisited in RequiredPackage.Flags)) then begin RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited]; Result:=Find(RequiredPackage.FirstRequiredDependency); if Result<>nil then exit; end; end; CurDependency:=CurDependency.NextRequiresDependency; end; Result:=nil; end; begin if FirstDependency=nil then exit(nil); MarkAllPackagesAsNotVisited; Result:=Find(FirstDependency); end; function TLazPackageGraph.FindRuntimePkgOnlyRecursively( FirstDependency: TPkgDependency): TPkgDependency; // returns one dependency using a runtime only package function Find(CurDependency: TPkgDependency): TPkgDependency; var RequiredPackage: TLazPackage; begin while CurDependency<>nil do begin if CurDependency.LoadPackageResult=lprSuccess then begin RequiredPackage:=CurDependency.RequiredPackage; if (not (lpfVisited in RequiredPackage.Flags)) then begin if RequiredPackage.PackageType=lptRunTimeOnly then exit(CurDependency); RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited]; Result:=Find(RequiredPackage.FirstRequiredDependency); if Result<>nil then exit; end; end; CurDependency:=CurDependency.NextRequiresDependency; end; Result:=nil; end; begin if FirstDependency=nil then exit(nil); MarkAllPackagesAsNotVisited; Result:=Find(FirstDependency); end; function TLazPackageGraph.FindUnit(StartPackage: TLazPackage; const TheUnitName: string; WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile; var ADependency: TPkgDependency; ARequiredPackage: TLazPackage; begin Result:=StartPackage.FindUnit(TheUnitName,IgnoreDeleted); if Result<>nil then exit; // search also in all required packages if WithRequiredPackages then begin ADependency:=StartPackage.FirstRequiredDependency; while ADependency<>nil do begin ARequiredPackage:=FindOpenPackage(ADependency,[fpfSearchInInstalledPckgs]); if ARequiredPackage<>nil then begin Result:=ARequiredPackage.FindUnit(TheUnitName,IgnoreDeleted); if Result<>nil then exit; end; ADependency:=ADependency.NextRequiresDependency; end; end; end; function TLazPackageGraph.FindUnitInAllPackages( const TheUnitName: string; IgnoreDeleted: boolean): TPkgFile; var Cnt: Integer; i: Integer; begin Cnt:=Count; for i:=0 to Cnt-1 do begin Result:=FindUnit(Packages[i],TheUnitName,false,IgnoreDeleted); if Result<>nil then exit; end; Result:=nil; end; function TLazPackageGraph.GetMapSourceDirectoryToPackage( IgnorePackage: TLazPackage): TFilenameToPointerTree; var i: Integer; aPackage: TLazPackage; SearchPath: String; p: Integer; Dir: String; begin Result:=TFilenameToPointerTree.Create(false); for i:=0 to Count-1 do begin aPackage:=Packages[i]; if aPackage.IsVirtual then continue; if aPackage=IgnorePackage then continue; SearchPath:=aPackage.SourceDirectories.CreateSearchPathFromAllFiles; p:=1; repeat Dir:=GetNextDirectoryInSearchPath(SearchPath,p); if Dir='' then break; Dir:=ChompPathDelim(Dir); Result[Dir]:=aPackage; until false; end; end; function TLazPackageGraph.EstimateCompileLoad(APackage: TLazPackage): int64; var PkgFile: TPkgFile; i: Integer; begin Result:=1; for i:=0 to APackage.FileCount-1 do begin PkgFile:=APackage.Files[i]; if PkgFile.FileType in [pftUnit,pftMainUnit,pftInclude,pftLFM] then begin inc(Result,CodeToolBoss.DirectoryCachePool.FileSize(PkgFile.Filename)); end; end; end; function TLazPackageGraph.FindFileInAllPackages(const TheFilename: string; IgnoreDeleted, FindVirtualFile: boolean): TPkgFile; begin if FFindFileCache=nil then FFindFileCache := TLazPackageGraphFileCache.Create(Self); Result := FFindFileCache.FindFileInAllPackages(TheFilename, IgnoreDeleted, FindVirtualFile); end; procedure TLazPackageGraph.FindPossibleOwnersOfUnit(const TheFilename: string; OwnerList: TFPList); var Cnt: Integer; i: Integer; APackage: TLazPackage; SrcDir: String; function SrcDirInPath(Dirs: String): boolean; begin Result:=FindPathInSearchPath(PChar(SrcDir),length(SrcDir), PChar(Dirs),length(Dirs))<>nil; end; begin if not FilenameIsAbsolute(TheFilename) then exit; Cnt:=Count; SrcDir:=ExtractFilePath(TheFilename); for i:=0 to Cnt-1 do begin APackage:=Packages[i]; if APackage.IsVirtual then continue; // source directories + unit path without inherited paths + base directory + output directory if SrcDirInPath(APackage.CompilerOptions.GetParsedPath(pcosUnitPath,icoNone,false)) or SrcDirInPath(APackage.SourceDirectories.CreateSearchPathFromAllFiles) or SrcDirInPath(APackage.GetOutputDirectory) or SrcDirInPath(APackage.Directory) then OwnerList.Add(APackage); end; end; function TLazPackageGraph.FindPackageWithFilename(const TheFilename: string ): TLazPackage; var Cnt: Integer; i: Integer; begin Cnt:=Count; for i:=0 to Cnt-1 do begin Result:=Packages[i]; if Result.IsVirtual then continue; if CompareFilenames(TheFilename,Result.Filename)=0 then exit; end; Result:=nil; end; function TLazPackageGraph.CreateUniqueUnitName(const Prefix: string): string; begin Result:=Prefix; while FindUnitInAllPackages(Result,false)<>nil do Result:=CreateNextIdentifier(Result); end; function TLazPackageGraph.PackageNameExists(const PkgName: string; IgnorePackage: TLazPackage): boolean; var ANode: TAVLTreeNode; begin Result:=false; if PkgName<>'' then begin ANode:=FindLowestPkgNodeByName(PkgName); if (ANode<>nil) and (IgnorePackage=TLazPackage(ANode.Data)) then ANode:=FindNextSameName(ANode); Result:=ANode<>nil; end; end; procedure TLazPackageGraph.PkgModify(Sender: TObject); begin IncChangeStamp; end; function TLazPackageGraph.DependencyExists(Dependency: TPkgDependency; Flags: TFindPackageFlags): boolean; begin Result:=true; if FindNodeOfDependency(Dependency,Flags)<>nil then exit; if FindPackageWithName(Dependency.PackageName,nil)=nil then begin // no package with same name open // -> try package links if fpfSearchInPkgLinks in Flags then if PkgLinks.FindLinkWithDependency(Dependency)<>nil then exit; end else begin // there is already a package with this name open, but the wrong version end; Result:=false; end; function TLazPackageGraph.CreateUniquePkgName(const Prefix: string; IgnorePackage: TLazPackage): string; var i: Integer; begin // try Prefix alone if not PackageNameExists(Prefix,IgnorePackage) then begin Result:=Prefix; end else begin // try Prefix + number i:=1; while PackageNameExists(Prefix+IntToStr(i),IgnorePackage) do inc(i); Result:=Prefix+IntToStr(i); end; end; function TLazPackageGraph.CreateNewPackage(const Prefix: string): TLazPackage; begin BeginUpdate(true); Result:=TLazPackage.Create; Result.OnModifySilently:=@PkgModify; Result.Name:=CreateUniquePkgName(Prefix,nil); AddPackage(Result); EndUpdate; end; procedure TLazPackageGraph.ConsistencyCheck; begin CheckList(FItems,true,true,true); end; procedure TLazPackageGraph.RegisterUnitHandler(const TheUnitName: string; RegisterProc: TRegisterProc); begin if AbortRegistration then exit; ErrorMsg:=''; FRegistrationFile:=nil; FRegistrationUnitName:=''; // check package if FRegistrationPackage=nil then begin RegistrationError('Unit: '+TheUnitName); exit; end; try // check unitname FRegistrationUnitName:=TheUnitName; if not IsValidUnitName(FRegistrationUnitName) then begin RegistrationError(Format(lisPkgSysInvalidUnitname, [FRegistrationUnitName] )); exit; end; // check unit file FRegistrationFile:=FindUnit(FRegistrationPackage,FRegistrationUnitName,true,true); if FRegistrationFile=nil then begin if not (FRegistrationPackage.Missing) then begin // lpk exists, but file is missing => warn FRegistrationFile:= FRegistrationPackage.FindUnit(FRegistrationUnitName,false); if FRegistrationFile=nil then begin RegistrationError(Format( lisPkgSysUnitWasNotFoundInTheLpkFileProbablyThisLpkFileWasN, [ FRegistrationUnitName, LineEnding])); end else begin if not (pffReportedAsRemoved in FRegistrationFile.Flags) then begin RegistrationError( Format(lisPkgSysUnitWasRemovedFromPackageLpk, [ FRegistrationUnitName])); FRegistrationFile.Flags:=FRegistrationFile.Flags+[pffReportedAsRemoved]; end; end; end; exit; end; CallRegisterProc(RegisterProc); // clean up finally FRegistrationUnitName:=''; FRegistrationFile:=nil; end; end; procedure TLazPackageGraph.RegisterComponentsHandler(const Page: string; ComponentClasses: array of TComponentClass); var i: integer; CurComponent: TComponentClass; NewPkgComponent: TPkgComponent; CurClassname: string; begin {$IFDEF IDE_MEM_CHECK} CheckHeap('TLazPackageGraph.RegisterComponentsHandler Page='+Page); {$ENDIF} if AbortRegistration or (Low(ComponentClasses)>High(ComponentClasses)) then exit; ErrorMsg:=''; // check package if FRegistrationPackage=nil then begin RegistrationError(''); exit; end; // check unit file if FRegistrationFile=nil then begin RegistrationError(lisPkgSysCanNotRegisterComponentsWithoutUnit); exit; end; // register components for i:=Low(ComponentClasses) to High(ComponentClasses) do begin CurComponent:=ComponentClasses[i]; if (CurComponent=nil) then continue; {$IFNDEF StopOnRegError} try {$ENDIF} CurClassname:=CurComponent.Classname; if not IsValidIdent(CurClassname) then begin RegistrationError(lisPkgSysInvalidComponentClass); continue; end; {$IFNDEF StopOnRegError} except on E: Exception do begin RegistrationError(E.Message); continue; end; end; {$ENDIF} if (IDEComponentPalette<>nil) and (IDEComponentPalette.FindComponent(CurClassname)<>nil) then begin RegistrationError( Format(lisPkgSysComponentClassAlreadyDefined, [CurComponent.ClassName])); end; if AbortRegistration then exit; // add the component to the package owning the file // (e.g. a designtime package can register units of a runtime packages) NewPkgComponent:= FRegistrationFile.LazPackage.AddComponent(FRegistrationFile,Page,CurComponent); //debugln('TLazPackageGraph.RegisterComponentsHandler Page="',Page,'" CurComponent=',CurComponent.ClassName,' FRegistrationFile=',FRegistrationFile.Filename); if IDEComponentPalette<>nil then IDEComponentPalette.AddComponent(NewPkgComponent); end; end; procedure TLazPackageGraph.RegistrationError(const Msg: string); var DlgResult: Integer; IgnoreAll: Integer; begin // create nice and useful error message // current registration package if FRegistrationPackage=nil then begin ErrorMsg:=lisPkgSysRegisterUnitWasCalledButNoPackageIsRegistering; end else begin ErrorMsg:='Package: "'+FRegistrationPackage.IDAsString+'"'; if FRegistrationPackage.Missing then ErrorMsg:=Format(lisPkgSysTheLpkFileWasNotFound, [ErrorMsg, LineEnding]) else ErrorMsg:=Format(lisPkgSysLPKFilename, [ErrorMsg, LineEnding, FRegistrationPackage.Filename]); // current unitname if FRegistrationUnitName<>'' then ErrorMsg:=Format(lisPkgSysUnitName, [ErrorMsg, LineEnding, FRegistrationUnitName]); // current file if FRegistrationFile<>nil then ErrorMsg:=Format(lisPkgSysFileName, [ErrorMsg, LineEnding, FRegistrationFile.Filename]); end; // append message if Msg<>'' then ErrorMsg:=ErrorMsg+LineEnding+LineEnding+Msg; debugln(['Error: (lazarus) register failed: ',dbgstr(ErrorMsg)]); if AbortRegistration or QuietRegistration then exit; // tell user IgnoreAll:=mrLast+1; DlgResult:=IDEQuestionDialog(lisPkgSysPackageRegistrationError, ErrorMsg, mtError, [mrIgnore, IgnoreAll, lisIgnoreAll, mrAbort]); if DlgResult=IgnoreAll then QuietRegistration:=true; if DlgResult=mrAbort then AbortRegistration:=true; end; procedure TLazPackageGraph.OnExtToolBuildStopped(Sender: TObject); var PkgCompileTool: TAbstractExternalTool; Data: TLazPkgGraphExtToolData; aPackage: TLazPackage; SrcPPUFile: String; MsgResult: TModalResult; SrcPPUFileExists: Boolean; begin PkgCompileTool:=Sender as TAbstractExternalTool; Data:=PkgCompileTool.Data as TLazPkgGraphExtToolData; aPackage:=Data.Pkg; //debugln(['TLazPackageGraph.OnExtToolBuildStopped aPackage=',aPackage.IDAsString]); // check if main ppu file was created SrcPPUFile:=Data.SrcPPUFilename; SrcPPUFileExists:=(SrcPPUFile<>'') and FileExistsUTF8(SrcPPUFile); // write state file MsgResult:=SavePackageCompiledState(APackage, Data.CompilerFilename,Data.CompilerParams, PkgCompileTool.ErrorMessage='',SrcPPUFileExists,false); if MsgResult<>mrOk then begin Data.ErrorMessage:='SavePackageCompiledState failed'; PkgCompileTool.ErrorMessage:=Data.ErrorMessage; DebugLn(['Error: (lazarus) failed to write package .compiled file: ',APackage.IDAsString,' File=',aPackage.GetStateFilename]); exit; end; Data.ErrorMessage:=PkgCompileTool.ErrorMessage; if Data.ErrorMessage<>'' then exit; // update .po files if (APackage.POOutputDirectory<>'') then begin MsgResult:=ConvertPackageRSTFiles(APackage); if MsgResult<>mrOk then begin Data.ErrorMessage:='ConvertPackageRSTFiles failed'; PkgCompileTool.ErrorMessage:=Data.ErrorMessage; DebugLn('Error: (lazarus) failed to update .po files: ',APackage.IDAsString); IDEMessagesWindow.AddCustomMessage(mluError, Format(lisUpdatingPoFilesFailedForPackage, [APackage.IDAsString])); exit; end; end; end; function TLazPackageGraph.CreateDefaultPackage: TLazPackage; begin Result:=TLazPackage.Create; with Result do begin Missing:=true; UserReadOnly:=true; Name:='DefaultPackage'; Filename:=SetDirSeparators('$(LazarusDir)/components/custom/customdummy.lpk'); Version.SetValues(1,0,1,1); Author:='Anonymous'; AutoInstall:=pitStatic; AutoUpdate:=pupManually; Description:=lisPkgSysThisIsTheDefaultPackageUsedOnlyForComponents; PackageType:=lptDesignTime; Installed:=pitStatic; CompilerOptions.UnitOutputDirectory:=''; Translated:=SystemLanguageID1; // add unit paths UsageOptions.UnitPath:='$(PkgOutDir)'; // add requirements AddRequiredDependency(LCLPackage.CreateDependencyWithOwner(Result)); AddRequiredDependency(SynEditPackage.CreateDependencyWithOwner(Result)); Modified:=false; OnModifySilently:=@PkgModify; end; IncChangeStamp; end; function TLazPackageGraph.GetCount: Integer; begin Result:=FItems.Count; end; procedure TLazPackageGraph.AddPackage(APackage: TLazPackage); procedure SetBasePackage(var BasePackage: TLazPackage); begin if BasePackage=APackage then exit; if BasePackage<>nil then RaiseGDBException('TLazPackageGraph.AddPackage Pkg='+APackage.IDAsString+' conflicts with existing base package'); BasePackage:=APackage; end; var Dependency: TPkgDependency; begin BeginUpdate(true); FTree.Add(APackage); FItems.Add(APackage); if IsStaticBasePackage(APackage.Name) then begin APackage.Installed:=pitStatic; APackage.AutoInstall:=pitStatic; if SysUtils.CompareText(APackage.Name,'FCL')=0 then begin SetBasePackage(FFCLPackage); APackage.SetAllComponentPriorities(FCLCompPriority); end else if SysUtils.CompareText(APackage.Name,'LazUtils')=0 then SetBasePackage(FLazUtilsPackage) else if SysUtils.CompareText(APackage.Name,'LCLBase')=0 then begin SetBasePackage(FLCLBasePackage); APackage.SetAllComponentPriorities(LCLCompPriority); end else if SysUtils.CompareText(APackage.Name,'LCL')=0 then begin SetBasePackage(FLCLPackage); APackage.SetAllComponentPriorities(LCLCompPriority); end else if SysUtils.CompareText(APackage.Name,'IDEIntf')=0 then begin SetBasePackage(FIDEIntfPackage); APackage.SetAllComponentPriorities(IDEIntfCompPriority); end else if SysUtils.CompareText(APackage.Name,'DebuggerIntf')=0 then SetBasePackage(FDebuggerIntfPackage) else if SysUtils.CompareText(APackage.Name,'LazDebuggerGdbmi')=0 then SetBasePackage(FLazDebuggerGdbmiPackage) else if SysUtils.CompareText(APackage.Name,'SynEdit')=0 then SetBasePackage(FSynEditPackage) else if SysUtils.CompareText(APackage.Name,'LazControls')=0 then SetBasePackage(FLazControlsPackage) else if SysUtils.CompareText(APackage.Name,'CodeTools')=0 then SetBasePackage(FCodeToolsPackage); if FLazarusBasePackages.IndexOf(APackage)<0 then FLazarusBasePackages.Add(APackage); end; // open all required dependencies Dependency:=APackage.FirstRequiredDependency; while Dependency<>nil do begin OpenDependency(Dependency,false); Dependency:=Dependency.NextRequiresDependency; end; // update all missing dependencies UpdateBrokenDependenciesToPackage(APackage); // activate define templates APackage.DefineTemplates.Active:=true; if Assigned(OnAddPackage) then OnAddPackage(APackage); EndUpdate; end; procedure TLazPackageGraph.ReplacePackage(var OldPackage: TLazPackage; NewPackage: TLazPackage); procedure MoveInstalledComponents(OldPkgFile: TPkgFile); var NewPkgFile: TPkgFile; OldUnitName: String; PkgComponent: TPkgComponent; begin if (OldPkgFile.ComponentCount>0) then begin OldUnitName:=OldPkgFile.Unit_Name; if OldUnitName='' then RaiseException('MoveInstalledComponents'); NewPkgFile:=NewPackage.FindUnit(OldUnitName,false); if NewPkgFile=nil then begin NewPkgFile:=NewPackage.AddRemovedFile(OldPkgFile.Filename,OldUnitName, OldPkgFile.FileType,OldPkgFile.Flags, OldPkgFile.ComponentPriority.Category); end; while OldPkgFile.ComponentCount>0 do begin PkgComponent:=OldPkgFile.Components[0]; PkgComponent.PkgFile:=NewPkgFile; end; end; end; var OldInstalled: TPackageInstallType; OldAutoInstall: TPackageInstallType; OldEditor: TBasePackageEditor; i: Integer; begin if pvPkgSearch in Verbosity then debugln(['Info: (lazarus) replacing package "'+OldPackage.Filename+'" with "'+NewPackage.Filename+'"']); BeginUpdate(true); // save flags OldInstalled:=OldPackage.Installed; OldAutoInstall:=OldPackage.AutoInstall; OldEditor:=OldPackage.Editor; if OldEditor<>nil then begin OldEditor.LazPackage:=nil; end; // migrate components for i:=0 to OldPackage.FileCount-1 do MoveInstalledComponents(OldPackage.Files[i]); for i:=0 to OldPackage.RemovedFilesCount-1 do MoveInstalledComponents(OldPackage.RemovedFiles[i]); // delete old package Delete(fItems.IndexOf(OldPackage)); OldPackage:=nil; // restore flags NewPackage.Installed:=OldInstalled; NewPackage.AutoInstall:=OldAutoInstall; // add package to graph AddPackage(NewPackage); if OldEditor<>nil then begin OldEditor.LazPackage:=NewPackage; end; EndUpdate; end; procedure TLazPackageGraph.LoadStaticBasePackages; procedure LoadLazarusBasePackage(PkgName: string); var Dependency: TPkgDependency; Quiet: Boolean; begin if FindDependencyByNameInList(FirstAutoInstallDependency,pdlRequires, PkgName)<>nil then exit; Dependency:=TPkgDependency.Create; Dependency.Owner:=Self; Dependency.PackageName:=PkgName; Dependency.AddToList(FirstAutoInstallDependency,pdlRequires); Quiet:=false; OpenInstalledDependency(Dependency,pitStatic,Quiet); end; begin LoadLazarusBasePackage('FCL'); LoadLazarusBasePackage('LazUtils'); LoadLazarusBasePackage('LCLBase'); LoadLazarusBasePackage('LCL'); LoadLazarusBasePackage('SynEdit'); LoadLazarusBasePackage('IDEIntf'); LoadLazarusBasePackage('DebuggerIntf'); LoadLazarusBasePackage('LazDebuggerGdbmi'); LoadLazarusBasePackage('LazControls'); LoadLazarusBasePackage('CodeTools'); // the default package will be added on demand if FDefaultPackage=nil then FDefaultPackage:=CreateDefaultPackage; SortAutoInstallDependencies; // register them RegisterStaticBasePackages; end; procedure TLazPackageGraph.LoadAutoInstallPackages(PkgList: TStringList); var i: Integer; PackageName: string; Dependency: TPkgDependency; begin for i:=0 to PkgList.Count-1 do begin PackageName:=PkgList[i]; if not IsValidPkgName(PackageName) then continue; Dependency:=FindDependencyByNameInList(FirstAutoInstallDependency, pdlRequires,PackageName); //DebugLn('TLazPackageGraph.LoadAutoInstallPackages ',dbgs(Dependency),' ',PackageName); if Dependency<>nil then continue; Dependency:=TPkgDependency.Create; Dependency.Owner:=Self; Dependency.PackageName:=PackageName; Dependency.AddToList(FirstAutoInstallDependency,pdlRequires); if OpenDependency(Dependency,false)<>lprSuccess then begin IDEMessageDialog(lisPkgMangUnableToLoadPackage, Format(lisPkgMangUnableToOpenThePackage, [PackageName, LineEnding]), mtWarning,[mbOk]); continue; end; if not Dependency.RequiredPackage.Missing then Dependency.RequiredPackage.AutoInstall:=pitStatic; end; SortAutoInstallDependencies; end; procedure TLazPackageGraph.SortAutoInstallDependencies; begin // sort install dependencies, so that lower packages come first SortDependencyListTopologicallyOld(PackageGraph.FirstAutoInstallDependency, false); end; function TLazPackageGraph.GetIDEInstallPackageOptions( var InheritedOptionStrings: TInheritedCompOptsStrings): string; procedure AddOption(const s: string); begin if s='' then exit; if Result='' then Result:=s else Result:=Result+' '+s; end; var PkgList: TFPList; AddOptionsList: TFPList; ConfigDir: String; begin Result:=''; // get all required packages PkgList:=nil; GetAllRequiredPackages(nil,FirstAutoInstallDependency,PkgList,[pirCompileOrder]); if PkgList=nil then exit; // get all usage options AddOptionsList:=GetUsageOptionsList(PkgList); PkgList.Free; if AddOptionsList<>nil then begin // combine options of same type GatherInheritedOptions(AddOptionsList,coptParsed,InheritedOptionStrings); AddOptionsList.Free; end; // convert options to compiler parameters Result:=InheritedOptionsToCompilerParameters(InheritedOptionStrings,[]); // add activate-static-packages option AddOption('-dAddStaticPkgs'); // add include path to config directory ConfigDir:=AppendPathDelim(GetPrimaryConfigPath); AddOption(PrepareCmdLineOption('-Fi'+UTF8ToSys(ConfigDir))); end; function TLazPackageGraph.SaveAutoInstallConfig: TModalResult; var ConfigDir: String; StaticPackagesInc: String; StaticPckIncludeFile: String; PkgList: TFPList; APackage: TLazPackage; i: Integer; begin ConfigDir:=AppendPathDelim(GetPrimaryConfigPath); // create auto install package list for the Lazarus uses section PkgList:=nil; try GetAllRequiredPackages(nil,FirstAutoInstallDependency,PkgList,[pirCompileOrder]); StaticPackagesInc:=''; if PkgList<>nil then begin for i:=0 to PkgList.Count-1 do begin APackage:=TLazPackage(PkgList[i]); if (APackage=nil) or APackage.Missing or IsStaticBasePackage(APackage.Name) or (APackage.PackageType in [lptRunTime,lptRunTimeOnly]) then continue; StaticPackagesInc:=StaticPackagesInc +ExtractFileNameOnly(APackage.GetCompileSourceFilename) +','+LineEnding; end; end; finally PkgList.Free; end; StaticPckIncludeFile:=ConfigDir+'staticpackages.inc'; Result:=SaveStringToFile(StaticPckIncludeFile,StaticPackagesInc,[], lisPkgMangstaticPackagesConfigFile); end; function TLazPackageGraph.IsStaticBasePackage(PackageName: string ): boolean; begin PackageName:=lowercase(PackageName); Result:=(PackageName='fcl') or (PackageName='lazutils') or (PackageName='lclbase') or (PackageName='lcl') or (PackageName='synedit') or (PackageName='ideintf') or (PackageName='debuggerintf') or (PackageName='lazdebuggergdbmi') or (PackageName='codetools') or (PackageName='lazcontrols'); end; procedure TLazPackageGraph.FreeAutoInstallDependencies; var Dependency: TPkgDependency; begin while Assigned(PackageGraph.FirstAutoInstallDependency) do begin Dependency:=PackageGraph.FirstAutoInstallDependency; Dependency.RequiredPackage:=nil; Dependency.RemoveFromList(PackageGraph.FirstAutoInstallDependency,pdlRequires); Dependency.Free; end; end; procedure TLazPackageGraph.ClosePackage(APackage: TLazPackage); begin if (lpfDestroying in APackage.Flags) or PackageIsNeeded(APackage) then exit; CloseUnneededPackages; end; procedure TLazPackageGraph.MarkNeededPackages; var i: Integer; Pkg: TLazPackage; PkgStack: PLazPackage; StackPtr: Integer; RequiredPackage: TLazPackage; Dependency: TPkgDependency; begin if Count=0 then exit; // create stack GetMem(PkgStack,SizeOf(Pointer)*Count); StackPtr:=0; // put all needed packages on stack and set lpfNeeded for i:=0 to FItems.Count-1 do begin Pkg:=TLazPackage(FItems[i]); if PackageIsNeeded(Pkg) then begin Pkg.Flags:=Pkg.Flags+[lpfNeeded]; PkgStack[StackPtr]:=Pkg; inc(StackPtr); end else Pkg.Flags:=Pkg.Flags-[lpfNeeded]; end; // mark all needed packages while StackPtr>0 do begin // get needed package from stack dec(StackPtr); Pkg:=PkgStack[StackPtr]; // put all required packages on stack Dependency:=Pkg.FirstRequiredDependency; while Dependency<>nil do begin if Dependency.LoadPackageResult=lprSuccess then begin RequiredPackage:=Dependency.RequiredPackage; if (not (lpfNeeded in RequiredPackage.Flags)) then begin RequiredPackage.Flags:=RequiredPackage.Flags+[lpfNeeded]; PkgStack[StackPtr]:=RequiredPackage; inc(StackPtr); end; end; Dependency:=Dependency.NextRequiresDependency; end; end; // clean up FreeMem(PkgStack); end; function TLazPackageGraph.FindBrokenDependencyPath(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; // returns the first broken dependency (broken = not loaded) // the first items are TLazPackage, the last item is a TPkgDependency procedure FindBroken(Dependency: TPkgDependency; var PathList: TFPList); var RequiredPackage: TLazPackage; begin while Dependency<>nil do begin if Dependency.LoadPackageResult=lprSuccess then begin // dependency ok RequiredPackage:=Dependency.RequiredPackage; if not (lpfVisited in RequiredPackage.Flags) then begin RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited]; FindBroken(RequiredPackage.FirstRequiredDependency,PathList); if PathList<>nil then begin // broken dependency found // -> add current package to list PathList.Insert(0,RequiredPackage); exit; end; end; end else begin // broken dependency found PathList:=TFPList.Create; PathList.Add(Dependency); exit; end; Dependency:=Dependency.NextRequiresDependency; end; end; begin Result:=nil; if (Count=0) then exit; MarkAllPackagesAsNotVisited; if APackage<>nil then begin APackage.Flags:=APackage.Flags+[lpfVisited]; FirstDependency:=APackage.FirstRequiredDependency; end; FindBroken(FirstDependency,Result); if (Result<>nil) and (APackage<>nil) then Result.Insert(0,APackage); end; function TLazPackageGraph.FindAllBrokenDependencies(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; // returns the list of broken dependencies (TPkgDependency) procedure FindBroken(Dependency: TPkgDependency; var DepList: TFPList); var RequiredPackage: TLazPackage; begin while Dependency<>nil do begin if Dependency.LoadPackageResult=lprSuccess then begin // dependency ok RequiredPackage:=Dependency.RequiredPackage; if not (lpfVisited in RequiredPackage.Flags) then begin RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited]; FindBroken(RequiredPackage.FirstRequiredDependency,DepList); end; end else begin // broken dependency found if (DepList=nil) or (DepList.IndexOf(Dependency)<0) then begin if DepList=nil then DepList:=TFPList.Create; DepList.Add(Dependency); end; end; Dependency:=Dependency.NextRequiresDependency; end; end; begin Result:=nil; if (Count=0) then exit; MarkAllPackagesAsNotVisited; if APackage<>nil then begin APackage.Flags:=APackage.Flags+[lpfVisited]; FirstDependency:=APackage.FirstRequiredDependency; end; FindBroken(FirstDependency,Result); end; function TLazPackageGraph.FindCycleDependencyPath(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; procedure FindCycle(Dependency: TPkgDependency; var PathList: TFPList); var RequiredPackage: TLazPackage; begin while Dependency<>nil do begin if Dependency.LoadPackageResult=lprSuccess then begin // dependency ok RequiredPackage:=Dependency.RequiredPackage; if lpfCycle in RequiredPackage.Flags then begin // cycle detected PathList:=TFPList.Create; PathList.Add(RequiredPackage); exit; end; if not (lpfVisited in RequiredPackage.Flags) then begin RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited,lpfCycle]; FindCycle(RequiredPackage.FirstRequiredDependency,PathList); if PathList<>nil then begin // cycle detected // -> add current package to list PathList.Insert(0,RequiredPackage); exit; end; RequiredPackage.Flags:=RequiredPackage.Flags-[lpfCycle]; end; end; Dependency:=Dependency.NextRequiresDependency; end; end; var i: Integer; Pkg: TLazPackage; begin Result:=nil; if (Count=0) then exit; // mark all packages as not visited and cycle free for i:=FItems.Count-1 downto 0 do begin Pkg:=TLazPackage(FItems[i]); Pkg.Flags:=Pkg.Flags-[lpfVisited,lpfCycle]; end; if APackage<>nil then begin APackage.Flags:=APackage.Flags+[lpfVisited]; FirstDependency:=APackage.FirstRequiredDependency; end; FindCycle(FirstDependency,Result); if (Result<>nil) and (APackage<>nil) then Result.Insert(0,APackage); end; function TLazPackageGraph.FindPath(StartPackage: TLazPackage; StartDependency: TPkgDependency; const EndPackageName: string): TFPList; procedure Find(Dependency: TPkgDependency; var PathList: TFPList); var RequiredPackage: TLazPackage; begin while Dependency<>nil do begin if SysUtils.CompareText(Dependency.PackageName,EndPackageName)=0 then begin // path found PathList:=TFPList.Create; if Dependency.LoadPackageResult=lprSuccess then begin PathList.Add(Dependency.RequiredPackage); end else begin PathList.Add(Dependency); end; exit; end; if Dependency.LoadPackageResult=lprSuccess then begin // dependency ok RequiredPackage:=Dependency.RequiredPackage; if not (lpfVisited in RequiredPackage.Flags) then begin RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited]; Find(RequiredPackage.FirstRequiredDependency,PathList); if PathList<>nil then begin // path found // -> add current package to list PathList.Insert(0,RequiredPackage); exit; end; end; end; Dependency:=Dependency.NextRequiresDependency; end; end; begin Result:=nil; if (Count=0) then exit; MarkAllPackagesAsNotVisited; if StartPackage<>nil then begin StartPackage.Flags:=StartPackage.Flags+[lpfVisited]; StartDependency:=StartPackage.FirstRequiredDependency; end; Find(StartDependency,Result); if (Result<>nil) and (StartPackage<>nil) then Result.Insert(0,StartPackage); end; function TLazPackageGraph.FindPkgOutputInFPCSearchPath(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; var CfgCache: TFPCTargetConfigCache; function CheckPkg(Pkg: TLazPackage; var PathList: TFPList): boolean; var OutputDir: String; i: Integer; Dir: String; begin Result:=true; if (Pkg=nil) then exit; Pkg.Flags:=Pkg.Flags+[lpfVisited]; if (Pkg.FirstRequiredDependency=nil) or Pkg.IsVirtual or (Pkg.AutoUpdate<>pupAsNeeded) then exit; // this package is compiled automatically and has dependencies OutputDir:=ChompPathDelim(Pkg.GetOutputDirectory); if OutputDir='' then exit; for i:=0 to CfgCache.UnitPaths.Count-1 do begin Dir:=ChompPathDelim(CfgCache.UnitPaths[i]); if CompareFilenames(Dir,OutputDir)=0 then begin // this package changes the units in the default FPC search path // => a cycle, because the dependencies use FPC search path too Result:=false; PathList:=TFPList.Create; PathList.Add(Pkg); exit; end; end; end; procedure CheckDependencyList(Dependency: TPkgDependency; var PathList: TFPList); var RequiredPackage: TLazPackage; begin while Dependency<>nil do begin if Dependency.LoadPackageResult=lprSuccess then begin RequiredPackage:=Dependency.RequiredPackage; if not (lpfVisited in RequiredPackage.Flags) then begin if CheckPkg(RequiredPackage,PathList) then exit; CheckDependencyList(RequiredPackage.FirstRequiredDependency,PathList); if PathList<>nil then begin // cycle detected // -> add current package to list PathList.Insert(0,RequiredPackage); exit; end; end; end; Dependency:=Dependency.NextRequiresDependency; end; end; var UnitSet: TFPCUnitSetCache; begin Result:=nil; MarkAllPackagesAsNotVisited; UnitSet:=CodeToolBoss.GetUnitSetForDirectory(''); if UnitSet=nil then exit; CfgCache:=UnitSet.GetConfigCache(false); if (CfgCache=nil) or (CfgCache.UnitPaths=nil) then exit; if APackage<>nil then begin if not CheckPkg(APackage,Result) then exit; if FirstDependency=nil then FirstDependency:=APackage.FirstRequiredDependency; end; CheckDependencyList(FirstDependency,Result); end; function TLazPackageGraph.FindUnsavedDependencyPath(APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; procedure FindUnsaved(Dependency: TPkgDependency; var PathList: TFPList); var RequiredPackage: TLazPackage; begin while Dependency<>nil do begin if Dependency.LoadPackageResult=lprSuccess then begin // dependency ok RequiredPackage:=Dependency.RequiredPackage; if RequiredPackage.Modified then begin // unsaved package detected PathList:=TFPList.Create; PathList.Add(RequiredPackage); exit; end; if not (lpfVisited in RequiredPackage.Flags) then begin RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited]; FindUnsaved(RequiredPackage.FirstRequiredDependency,PathList); if PathList<>nil then begin // unsaved package detected // -> add current package to list PathList.Insert(0,RequiredPackage); exit; end; end; end; Dependency:=Dependency.NextRequiresDependency; end; end; begin Result:=nil; if (Count=0) or (APackage=nil) then exit; MarkAllPackagesAsNotVisited; if APackage<>nil then begin APackage.Flags:=APackage.Flags+[lpfVisited]; FirstDependency:=APackage.FirstRequiredDependency; end; FindUnsaved(FirstDependency,Result); if (Result<>nil) and (APackage<>nil) then Result.Insert(0,APackage); end; function TLazPackageGraph.FindNotInstalledRegisterUnits( APackage: TLazPackage; FirstDependency: TPkgDependency): TFPList; // returns the list of required units (TPkgFile) with a Register procedure, // that are not installed in the IDE procedure FindNotInstalledRegisterUnit(Dependency: TPkgDependency; var UnitList: TFPList); var RequiredPackage: TLazPackage; i: Integer; APkgFile: TPkgFile; begin while Dependency<>nil do begin if Dependency.LoadPackageResult=lprSuccess then begin // dependency ok RequiredPackage:=Dependency.RequiredPackage; if not (lpfVisited in RequiredPackage.Flags) then begin if RequiredPackage.Installed=pitNope then begin // package not installed for i:=0 to RequiredPackage.FileCount-1 do begin APkgFile:=RequiredPackage.Files[i]; if APkgFile.HasRegisterProc then begin // unit with register procedure -> add if UnitList=nil then UnitList:=TFPList.Create; UnitList.Add(APkgFile); end; end; end; RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited]; FindNotInstalledRegisterUnit(RequiredPackage.FirstRequiredDependency,UnitList); end; end; Dependency:=Dependency.NextRequiresDependency; end; end; begin Result:=nil; if (Count=0) then exit; MarkAllPackagesAsNotVisited; if APackage<>nil then begin APackage.Flags:=APackage.Flags+[lpfVisited]; FirstDependency:=APackage.FirstRequiredDependency; end; FindNotInstalledRegisterUnit(FirstDependency,Result); end; function TLazPackageGraph.FindAutoInstallDependencyPath( ChildPackage: TLazPackage): TFPList; procedure FindAutoInstallParent(APackage: TLazPackage); var ParentPackage: TLazPackage; Dependency: TPkgDependency; begin Dependency:=APackage.FirstUsedByDependency; while Dependency<>nil do begin if Dependency.Owner is TLazPackage then begin ParentPackage:=TLazPackage(Dependency.Owner); if not (lpfVisited in ParentPackage.Flags) then begin ParentPackage.Flags:=ParentPackage.Flags+[lpfVisited]; if ParentPackage.AutoInstall<>pitNope then begin // auto install parent found if Result=nil then Result:=TFPList.Create; Result.Add(ParentPackage); Result.Add(APackage); exit; end; FindAutoInstallParent(ParentPackage); if Result<>nil then begin // build path Result.Add(APackage); exit; end; end; end; Dependency:=Dependency.NextRequiresDependency; end; end; begin Result:=nil; MarkAllPackagesAsNotVisited; ChildPackage.Flags:=ChildPackage.Flags+[lpfVisited]; FindAutoInstallParent(ChildPackage); end; function TLazPackageGraph.FindAmbiguousUnits(APackage: TLazPackage; FirstDependency: TPkgDependency; out File1, File2: TPkgFile; out ConflictPkg: TLazPackage): boolean; // check if two connected packages have units with the same name // Connected means here: a Package1 is directly required by a Package2 // or: a Package1 and a Package2 are directly required by a Package3 // returns true, if ambiguous units found // There can either be a conflict between two files (File1,File2) // or between a file and a package (File1,ConflictPkg) var PackageTreeOfUnitTrees: TAVLTree; // tree of TPkgUnitsTree function GetUnitsTreeOfPackage(Pkg: TLazPackage): TPkgUnitsTree; var ANode: TAVLTreeNode; PkgFile: TPkgFile; i: Integer; begin // for first time: create PackageTreeOfUnitTrees if PackageTreeOfUnitTrees=nil then PackageTreeOfUnitTrees:=TAVLTree.Create(TListSortCompare(@CompareUnitsTree)); // search UnitsTree for package ANode:=PackageTreeOfUnitTrees.FindKey(Pkg, TListSortCompare(@ComparePackageWithUnitsTree)); if ANode<>nil then begin Result:=TPkgUnitsTree(ANode.Data); exit; end; // first time: create tree of units for Pkg Result:=TPkgUnitsTree.Create(Pkg); PackageTreeOfUnitTrees.Add(Result); for i:=0 to Pkg.FileCount-1 do begin PkgFile:=Pkg.Files[i]; if (PkgFile.FileType in PkgFileRealUnitTypes) and (PkgFile.Unit_Name<>'') then Result.Add(PkgFile); end; end; function FindAmbiguousUnitsBetween2Packages(Pkg1,Pkg2: TLazPackage): boolean; var i: Integer; PkgFile1: TPkgFile; PkgFile2: TPkgFile; UnitsTreeOfPkg2: TPkgUnitsTree; begin Result:=false; if Pkg1=Pkg2 then exit; if (Pkg1.FileCount=0) or (Pkg2.FileCount=0) then exit; UnitsTreeOfPkg2:=GetUnitsTreeOfPackage(Pkg2); // check if a unit of Pkg2 has the same name as Pkg1 PkgFile2:=UnitsTreeOfPkg2.FindPkgFileWithUnitName(Pkg1.Name); if PkgFile2<>nil then begin File1:=PkgFile2; ConflictPkg:=Pkg1; Result:=true; exit; end; for i:=0 to Pkg1.FileCount-1 do begin PkgFile1:=Pkg1.Files[i]; if (PkgFile1.FileType in PkgFileRealUnitTypes) and (PkgFile1.Unit_Name<>'') then begin // check if a unit of Pkg1 exists in Pkg2 PkgFile2:=UnitsTreeOfPkg2.FindPkgFileWithUnitName(PkgFile1.Unit_Name); if PkgFile2<>nil then begin File1:=PkgFile1; File2:=PkgFile2; Result:=true; exit; end; // check if a unit of Pkg1 has the same name as Pkg2 if SysUtils.CompareText(PkgFile1.Unit_Name,Pkg2.Name)=0 then begin File1:=PkgFile1; ConflictPkg:=Pkg2; Result:=true; exit; end; end; end; end; var PkgList: TFPList; ConnectionsTree: TPkgPairTree; ANode: TAVLTreeNode; Pair: TPkgPair; begin Result:=false; if APackage<>nil then begin FirstDependency:=APackage.FirstRequiredDependency; end; File1:=nil; File2:=nil; ConflictPkg:=nil; ConnectionsTree:=nil; PkgList:=nil; PackageTreeOfUnitTrees:=nil; GetConnectionsTree(FirstDependency,PkgList,ConnectionsTree); try if ConnectionsTree=nil then exit; ANode:=ConnectionsTree.FindLowest; while ANode<>nil do begin Pair:=TPkgPair(ANode.Data); Result:=FindAmbiguousUnitsBetween2Packages(Pair.Package1,Pair.Package2); if Result then exit; ANode:=ConnectionsTree.FindSuccessor(ANode); end; finally if PackageTreeOfUnitTrees<>nil then begin PackageTreeOfUnitTrees.FreeAndClear; PackageTreeOfUnitTrees.Free; end; ConnectionsTree.Free; PkgList.Free; end; Result:=false; end; function TLazPackageGraph.FindFPCConflictUnit(APackage: TLazPackage; FirstDependency: TPkgDependency; const Directory: string; OnFindFPCUnit: TFindFPCUnitEvent; var File1: TPkgFile; var ConflictPkg: TLazPackage): boolean; function CheckUnitName(const AnUnitName: string): boolean; var Filename: string; begin Result:=false; if AnUnitName='' then exit; Filename:=''; OnFindFPCUnit(AnUnitName,Directory,Filename); Result:=Filename<>''; end; function CheckDependencyList(ADependency: TPkgDependency): boolean; forward; function CheckPackage(Pkg1: TLazPackage): boolean; var Cnt: Integer; i: Integer; CurFile: TPkgFile; begin Result:=false; if (Pkg1=nil) or (lpfVisited in Pkg1.Flags) or (Pkg1=FFCLPackage) or (Pkg1=FLCLBasePackage) or (Pkg1=FLCLPackage) then exit; Pkg1.Flags:=Pkg1.Flags+[lpfVisited]; Result:=CheckUnitName(Pkg1.Name); if Result then begin ConflictPkg:=Pkg1; exit; end; Cnt:=Pkg1.FileCount; for i:=0 to Cnt-1 do begin CurFile:=Pkg1.Files[i]; if (CurFile.FileType in PkgFileRealUnitTypes) and (pffAddToPkgUsesSection in CurFile.Flags) then begin Result:=CheckUnitName(CurFile.Unit_Name); if Result then begin File1:=CurFile; exit; end; end; end; Result:=CheckDependencyList(Pkg1.FirstRequiredDependency); end; function CheckDependencyList(ADependency: TPkgDependency): boolean; begin Result:=false; while ADependency<>nil do begin Result:=CheckPackage(ADependency.RequiredPackage); if Result then exit; ADependency:=ADependency.NextDependency[pdlRequires]; end; end; begin Result:=false; if (Directory<>'') and not FilenameIsAbsolute(Directory) then RaiseGDBException(Directory); File1:=nil; ConflictPkg:=nil; MarkAllPackagesAsNotVisited; if APackage<>nil then Result:=CheckPackage(APackage) else Result:=CheckDependencyList(FirstDependency); end; procedure TLazPackageGraph.MarkAllPackagesAsNotVisited; var i: Integer; Pkg: TLazPackage; begin // mark all packages as not visited for i:=FItems.Count-1 downto 0 do begin Pkg:=TLazPackage(FItems[i]); Pkg.Flags:=Pkg.Flags-[lpfVisited]; end; end; procedure TLazPackageGraph.MarkAllDependencies( MarkPackages: boolean; AddMarkerFlags, RemoveMarkerFlags: TPkgMarkerFlags); var i: Integer; Pkg: TLazPackage; Dependency: TPkgDependency; begin // mark all dependencies of all packages as not visited for i:=FItems.Count-1 downto 0 do begin Pkg:=TLazPackage(FItems[i]); if MarkPackages then Pkg.Flags:=Pkg.Flags-[lpfVisited]; Dependency:=Pkg.FirstRequiredDependency; while Dependency<>nil do begin Dependency.MarkerFlags:= Dependency.MarkerFlags+AddMarkerFlags-RemoveMarkerFlags; Dependency:=Dependency.NextRequiresDependency; end; end; end; procedure TLazPackageGraph.MarkAllRequiredPackages( FirstDependency: TPkgDependency); var Dependency: TPkgDependency; RequiredPackage: TLazPackage; begin Dependency:=FirstDependency; while Dependency<>nil do begin if Dependency.LoadPackageResult=lprSuccess then begin RequiredPackage:=Dependency.RequiredPackage; if not (lpfVisited in RequiredPackage.Flags) then begin RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited]; MarkAllRequiredPackages(RequiredPackage.FirstRequiredDependency); end; end; Dependency:=Dependency.NextRequiresDependency; end; end; procedure TLazPackageGraph.CloseUnneededPackages; var i: Integer; begin BeginUpdate(false); MarkNeededPackages; for i:=FItems.Count-1 downto 0 do if not (lpfNeeded in Packages[i].Flags) then begin if ConsoleVerbosity>=0 then debugln(['Hint: closing unneeded package "',Packages[i].Name,'"']); Delete(i); end; EndUpdate; end; procedure TLazPackageGraph.ChangePackageID(APackage: TLazPackage; const NewName: string; NewVersion: TPkgVersion; RenameDependencies, RenameMacros: boolean); var Dependency: TPkgDependency; NextDependency: TPkgDependency; OldPkgName: String; i: Integer; Macro: TLazBuildMacro; RenamedMacros: TStringList; OldMacroName: String; BaseCompOpts: TBaseCompilerOptions; begin OldPkgName:=APackage.Name; if (OldPkgName=NewName) and (APackage.Version.Compare(NewVersion)=0) then exit; // fit exactly BeginUpdate(true); if RenameMacros then begin // rename macros RenamedMacros:=TStringList.Create; try for i:=0 to APackage.CompilerOptions.BuildMacros.Count-1 do begin Macro:=APackage.CompilerOptions.BuildMacros[i]; if SysUtils.CompareText(OldPkgName,copy(Macro.Identifier,1,length(OldPkgName)))=0 then begin OldMacroName:=Macro.Identifier; RenamedMacros.Add(OldMacroName); Macro.Identifier:=NewName+copy(OldMacroName,length(OldPkgName)+1,256); BaseCompOpts:=TBaseCompilerOptions(APackage.CompilerOptions); BaseCompOpts.RenameMacro(OldMacroName,Macro.Identifier,true); end; end; finally RenamedMacros.Free; end; end; // cut or fix all dependencies, that became incompatible Dependency:=APackage.FirstUsedByDependency; while Dependency<>nil do begin NextDependency:=Dependency.NextUsedByDependency; if not Dependency.IsCompatible(NewName,NewVersion) then begin if RenameDependencies then begin Dependency.MakeCompatible(NewName,NewVersion); if Assigned(OnDependencyModified) then OnDependencyModified(Dependency); end else begin // remove dependency from the used-by list of the required package Dependency.RequiredPackage:=nil; end; end; Dependency:=NextDependency; end; // change ID FTree.Remove(APackage); APackage.ChangeID(NewName,NewVersion); FTree.Add(APackage); // update old broken dependencies UpdateBrokenDependenciesToPackage(APackage); if Assigned(OnChangePackageName) then OnChangePackageName(APackage,OldPkgName); // no try-finally needed, because above fails only for fatal reasons EndUpdate; end; function TLazPackageGraph.SavePackageCompiledState(APackage: TLazPackage; const CompilerFilename, CompilerParams: string; Complete, MainPPUExists, ShowAbort: boolean): TModalResult; var XMLConfig: TXMLConfig; StateFile: String; CompilerFileDate: Integer; o: TPkgOutputDir; stats: PPkgLastCompileStats; begin Result:=mrCancel; StateFile:=APackage.GetStateFilename; try CompilerFileDate:=FileAgeCached(CompilerFilename); o:=APackage.GetOutputDirType; stats:=@APackage.LastCompile[o]; stats^.CompilerFilename:=CompilerFilename; stats^.CompilerFileDate:=CompilerFileDate; stats^.Params:=CompilerParams; stats^.Complete:=Complete; stats^.ViaMakefile:=false; XMLConfig:=TXMLConfig.CreateClean(StateFile); try XMLConfig.SetValue('Compiler/Value',CompilerFilename); XMLConfig.SetValue('Compiler/Date',CompilerFileDate); XMLConfig.SetValue('Params/Value',CompilerParams); XMLConfig.SetDeleteValue('Complete/Value',Complete,true); XMLConfig.SetDeleteValue('Complete/MainPPUExists',MainPPUExists,true); InvalidateFileStateCache; XMLConfig.Flush; finally XMLConfig.Free; end; stats^.StateFileName:=StateFile; stats^.StateFileDate:=FileAgeCached(StateFile); APackage.LastCompile[o].StateFileLoaded:=true; except on E: Exception do begin Result:=IDEMessageDialogAb(lisPkgMangErrorWritingFile, Format(lisPkgMangUnableToWriteStateFileOfPackageError, [StateFile, LineEnding, APackage.IDAsString, LineEnding, E.Message]), mtError,[mbCancel],ShowAbort); exit; end; end; Result:=mrOk; end; function TLazPackageGraph.LoadPackageCompiledState(APackage: TLazPackage; IgnoreErrors, ShowAbort: boolean): TModalResult; var XMLConfig: TXMLConfig; StateFile: String; StateFileAge: Integer; stats: PPkgLastCompileStats; o: TPkgOutputDir; MakefileValue: String; MakefileVersion: Integer; begin o:=APackage.GetOutputDirType; stats:=@APackage.LastCompile[o]; StateFile:=APackage.GetStateFilename; if not FileExistsCached(StateFile) then begin //DebugLn('TLazPackageGraph.LoadPackageCompiledState Statefile not found: ',StateFile); stats^.StateFileLoaded:=false; Result:=mrOk; exit; end; // read the state file StateFileAge:=FileAgeCached(StateFile); if (not stats^.StateFileLoaded) or (stats^.StateFileDate<>StateFileAge) or (stats^.StateFileName<>StateFile) then begin stats^.StateFileLoaded:=false; try XMLConfig:=TXMLConfig.Create(StateFile); try stats^.CompilerFilename:=XMLConfig.GetValue('Compiler/Value',''); stats^.CompilerFileDate:=XMLConfig.GetValue('Compiler/Date',0); stats^.Params:=XMLConfig.GetValue('Params/Value',''); stats^.Complete:=XMLConfig.GetValue('Complete/Value',true); stats^.MainPPUExists:=XMLConfig.GetValue('Complete/MainPPUExists',true); MakefileValue:=XMLConfig.GetValue('Makefile/Value',''); if (MakefileValue='') then stats^.ViaMakefile:=false else begin stats^.ViaMakefile:=true; MakefileVersion:=StrToIntDef(MakefileValue,0); if MakefileVersion<2 then begin // old versions used %( stats^.CompilerFilename:=StringReplace(stats^.CompilerFilename,'%(','$(',[rfReplaceAll]); stats^.Params:=StringReplace(stats^.Params,'%(','$(',[rfReplaceAll]); end; ForcePathDelims(stats^.CompilerFilename); ForcePathDelims(stats^.Params); end; finally XMLConfig.Free; end; stats^.StateFileName:=StateFile; stats^.StateFileDate:=StateFileAge; stats^.StateFileLoaded:=true; except on E: EXMLReadError do begin // invalid XML debugln(['Warning: (lazarus) package "',APackage.IDAsString,'": syntax error in ',StateFile,' => need clean build.']); stats^.Complete:=false; stats^.CompilerFilename:=''; stats^.StateFileName:=StateFile; stats^.StateFileDate:=StateFileAge; stats^.StateFileLoaded:=true; end; on E: Exception do begin if IgnoreErrors then begin Result:=mrOk; end else begin Result:=IDEMessageDialogAb(lisPkgMangErrorReadingFile, Format(lisPkgMangUnableToReadStateFileOfPackageError, [StateFile, LineEnding, APackage.IDAsString, LineEnding, E.Message]), mtError,[mbCancel],ShowAbort); end; exit; end; end; end; Result:=mrOk; end; function TLazPackageGraph.CheckCompileNeedDueToFPCUnits(TheOwner: TObject; StateFileAge: longint; var Note: string): boolean; var AProject: TLazProject; Pkg: TLazPackage; ID: String; Dir: string; UnitSetID: String; HasChanged: boolean; Cache: TFPCUnitSetCache; CfgCache: TFPCTargetConfigCache; Node: TAVLTreeNode; Item: PStringToStringTreeItem; Filename: String; UnitToSrcTree: TStringToStringTree; CurUnitName: String; PkgOutDirs: TFilenameToStringTree; i: Integer; begin Result:=false; if TheOwner=nil then exit; if TheOwner is TLazPackage then begin Pkg:=TLazPackage(TheOwner); if Pkg.IsVirtual then exit; Dir:=Pkg.DirectoryExpanded; ID:=Pkg.Name; end else if TheOwner is TLazProject then begin AProject:=TLazProject(TheOwner); Dir:=ExtractFilePath(AProject.ProjectInfoFile); ID:=ExtractFileName(AProject.ProjectInfoFile); end else exit; if (Dir='') or (not FilenameIsAbsolute(Dir)) then exit; UnitSetID:=CodeToolBoss.GetUnitSetIDForDirectory(Dir); if UnitSetID='' then exit; Cache:=CodeToolBoss.FPCDefinesCache.FindUnitSetWithID(UnitSetID,HasChanged,false); if Cache=nil then exit; CfgCache:=Cache.GetConfigCache(false); if CfgCache=nil then exit; if CfgCache.Units=nil then exit; UnitToSrcTree:=Cache.GetUnitToSourceTree(false); PkgOutDirs:=TFilenameToStringTree.Create(false); try for i:=0 to Count-1 do PkgOutDirs[AppendPathDelim(Packages[i].CompilerOptions.GetUnitOutPath(false))]:='1'; Node:=CfgCache.Units.Tree.FindLowest; while Node<>nil do begin Item:=PStringToStringTreeItem(Node.Data); Node:=CfgCache.Units.Tree.FindSuccessor(Node); Filename:=Item^.Value; if PkgOutDirs.Contains(ExtractFilePath(Filename)) then begin // a package output directory is in the global search path // => ignore continue; end; CurUnitName:=Item^.Name; if (UnitToSrcTree<>nil) and (UnitToSrcTree.Count>0) and (not UnitToSrcTree.Contains(CurUnitName)) then begin // this unit has no source in the FPC source directory // probably an user unit reachable through a unit path in fpc.cfg continue; end; if FileAgeCached(Filename)>StateFileAge then begin if ConsoleVerbosity>=-1 then debugln(['Hint: (lazarus) global unit "',Filename,'" is newer than state file of package ',ID]); Note+='Global unit "'+Filename+'" is newer than state file of '+ID+':'+LineEnding +' Unit age='+FileAgeToStr(FileAgeCached(Filename))+LineEnding +' State file age='+FileAgeToStr(StateFileAge)+LineEnding; exit(true); end; end; finally PkgOutDirs.Free; end; end; function TLazPackageGraph.CheckCompileNeedDueToDependencies(TheOwner: TObject; FirstDependency: TPkgDependency; SkipDesignTimePackages: boolean; StateFileAge: longint; var Note: string): TModalResult; function GetOwnerID: string; begin OnGetDependencyOwnerDescription(FirstDependency,Result); end; var Dependency: TPkgDependency; RequiredPackage: TLazPackage; OtherStateFile: String; o: TPkgOutputDir; begin Dependency:=FirstDependency; if Dependency=nil then begin // no dependencies // => check FPC units if CheckCompileNeedDueToFPCUnits(TheOwner,StateFileAge,Note) then exit(mrYes); Result:=mrNo; exit; end; while Dependency<>nil do begin if (Dependency.LoadPackageResult=lprSuccess) then begin RequiredPackage:=Dependency.RequiredPackage; if SkipDesignTimePackages and (RequiredPackage.PackageType=lptDesignTime) then begin // skip end else begin // check compile state file of required package if (not RequiredPackage.IsVirtual) and (not RequiredPackage.Missing) then begin Result:=LoadPackageCompiledState(RequiredPackage,false,true); if Result<>mrOk then begin // file broken, user was told that file is broken and user had a // choice of cancel or cancel all (=mrAbort). // File broken means that the pkgname.compiled file has an invalid // format, syntax error. The user or some external tool has altered // the file. Maybe on purpose. // The IDE should not silently replace the file. // => pass the mrcancel/mrabort to the caller Note+='unable to load state file of '+RequiredPackage.IDAsString; exit; end; Result:=mrYes; o:=RequiredPackage.GetOutputDirType; if not RequiredPackage.LastCompile[o].StateFileLoaded then begin DebugLn('Hint: (lazarus) Missing state file for ',RequiredPackage.IDAsString,': ',RequiredPackage.GetStateFilename); Note+='Package '+RequiredPackage.IDAsString+' has no state file "'+RequiredPackage.GetStateFilename+'".'+LineEnding; exit; end; if StateFileAgeStateFileAge) then begin DebugLn('Hint: (lazarus) State file of ',RequiredPackage.IDAsString,' "',OtherStateFile,'" (', FileAgeToStr(FileAgeCached(OtherStateFile)),')' ,' is newer than state file ',GetOwnerID,'(',FileAgeToStr(StateFileAge),')'); Note+='State file of used package is newer than state file:'+LineEnding +' Used package '+RequiredPackage.IDAsString+', file="'+OtherStateFile+'", ' +' age='+FileAgeToStr(FileAgeCached(OtherStateFile))+LineEnding +' package '+GetOwnerID+', age='+FileAgeToStr(StateFileAge)+LineEnding; Result:=mrYes; exit; end; end; end; end; end; Dependency:=Dependency.NextRequiresDependency; end; Result:=mrNo; end; function TLazPackageGraph.CheckIfPackageNeedsCompilation(APackage: TLazPackage; SkipDesignTimePackages, GroupCompile: boolean; out NeedBuildAllFlag: boolean; var Note: string): TModalResult; var OutputDir: String; NewOutputDir: String; ConfigChanged: boolean; DependenciesChanged: boolean; DefResult: TModalResult; OldNeedBuildAllFlag: Boolean; OldOverride: String; begin Result:=mrYes; {$IFDEF VerbosePkgCompile} debugln('TLazPackageGraph.CheckIfPackageNeedsCompilation A ',APackage.IDAsString); {$ENDIF} NeedBuildAllFlag:=false; if APackage.AutoUpdate=pupManually then exit(mrNo); // check the current output directory Result:=CheckIfCurPkgOutDirNeedsCompile(APackage, true,SkipDesignTimePackages,GroupCompile, NeedBuildAllFlag,ConfigChanged,DependenciesChanged,Note); if Result=mrNo then begin // the current output is valid exit; end; // the current output directory needs compilation if APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride='' then begin // the last compile was put to the normal/default output directory OutputDir:=APackage.GetOutputDirectory(false); if OutputDirectoryIsWritable(APackage,OutputDir,false) then begin // the normal output directory is writable => keep using it exit; end; debugln(['Hint: (lazarus) normal output directory of package ',APackage.IDAsString,' is not writable: "',OutputDir,'"']); // the normal output directory is not writable // => try the fallback directory NewOutputDir:=GetFallbackOutputDir(APackage); if (NewOutputDir=OutputDir) or (NewOutputDir='') then begin Note+='Normal output directory is not writable. There is no fallback.'+LineEnding; exit; end; Note+='Normal output directory is not writable, switching to fallback.'+LineEnding; APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride:=NewOutputDir; Result:=CheckIfCurPkgOutDirNeedsCompile(APackage, true,SkipDesignTimePackages,GroupCompile, NeedBuildAllFlag,ConfigChanged,DependenciesChanged,Note); end else begin // the last compile was put to the fallback output directory if not ConfigChanged then begin // some source files have changed, not the compiler parameters // => keep using the fallback directory exit; end; if DependenciesChanged then begin // dependencies have changed // => switching to the not writable default output directory is not possible // => keep using the fallback directory exit; end; // maybe the user switched the settings back to default // => try using the default output directory OldOverride:=APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride; APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride:=''; OldNeedBuildAllFlag:=NeedBuildAllFlag; DefResult:=CheckIfCurPkgOutDirNeedsCompile(APackage, true,SkipDesignTimePackages,GroupCompile, NeedBuildAllFlag,ConfigChanged,DependenciesChanged,Note); if DefResult=mrNo then begin // switching back to the not writable output directory requires no compile debugln(['Hint: (lazarus) switching back to the normal output directory: "',APackage.GetOutputDirectory,'" Package ',APackage.IDAsString]); Note+='Switching back to not writable output directory.'+LineEnding; exit(mrNo); end; // neither the default nor the fallback is valid // => switch back to the fallback APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride:=OldOverride; NeedBuildAllFlag:=OldNeedBuildAllFlag; end; end; function TLazPackageGraph.CheckIfCurPkgOutDirNeedsCompile( APackage: TLazPackage; CheckDependencies, SkipDesignTimePackages, GroupCompile: boolean; out NeedBuildAllFlag, ConfigChanged, DependenciesChanged: boolean; var Note: string): TModalResult; // returns: mrYes, mrNo, mrCancel, mrAbort var StateFilename: String; StateFileAge: Integer; i: Integer; CurFile: TPkgFile; LastParams: String; LastPaths: TStringList; CurPaths: TStringList; OldValue: string; NewValue: string; o: TPkgOutputDir; Stats: PPkgLastCompileStats; SrcPPUFile: String; AFilename: String; CompilerFilename, CompilerParams, SrcFilename: string; LFMFilename: String; ReducedParams: String; ReducedLastParams: String; begin Result:=mrYes; {$IFDEF VerbosePkgCompile} debugln('TLazPackageGraph.CheckIfCurPkgOutDirNeedsCompile A ',APackage.IDAsString); {$ENDIF} NeedBuildAllFlag:=false; ConfigChanged:=false; DependenciesChanged:=false; if APackage.AutoUpdate=pupManually then exit(mrNo); SrcFilename:=APackage.GetSrcFilename; CompilerFilename:=APackage.GetCompilerFilename; // Note: use absolute paths, because some external tools resolve symlinked directories CompilerParams:=GetPackageCompilerParams(APackage); o:=APackage.GetOutputDirType; Stats:=@APackage.LastCompile[o]; //debugln(['TLazPackageGraph.CheckIfCurPkgOutDirNeedsCompile Last="',ExtractCompilerParamsForBuildAll(APackage.LastCompilerParams),'" Now="',ExtractCompilerParamsForBuildAll(CompilerParams),'"']); // check state file StateFilename:=APackage.GetStateFilename; Result:=LoadPackageCompiledState(APackage,false,true); if Result<>mrOk then exit; // read error and user aborted if not Stats^.StateFileLoaded then begin // package was not compiled via Lazarus nor via Makefile/fpmake DebugLn('Hint: (lazarus) Missing state file of ',APackage.IDAsString,': ',StateFilename); Note+='Missing state file "'+StateFilename+'".'+LineEnding; NeedBuildAllFlag:=true; ConfigChanged:=true; exit(mrYes); end; // check if build all (-B) is needed if (Stats^.CompilerFilename<>CompilerFilename) or (ExtractFPCParamsForBuildAll(Stats^.Params) <>ExtractFPCParamsForBuildAll(CompilerParams)) or ((Stats^.CompilerFileDate>0) and FileExistsCached(CompilerFilename) and (FileAgeCached(CompilerFilename)<>Stats^.CompilerFileDate)) then begin NeedBuildAllFlag:=true; ConfigChanged:=true; end; if GroupCompile and (lpfNeedGroupCompile in APackage.Flags) then begin //debugln(['TLazPackageGraph.CheckIfCurPkgOutDirNeedsCompile dependencies will be rebuilt']); Note+='Dependencies will be rebuilt'; DependenciesChanged:=true; exit(mrYes); end; StateFileAge:=FileAgeUTF8(StateFilename); // check compiler and params LastParams:=APackage.GetLastCompilerParams(o); if Stats^.ViaMakefile then begin // the package was compiled via Makefile/fpmake if ConsoleVerbosity>=1 then debugln(['Hint: (lazarus) package ',APackage.IDAsString,' was compiled via "make" with parameters "',LastParams,'"']); CurPaths:=nil; LastPaths:=nil; try CurPaths:=ExtractMakefileCompiledParams(CompilerParams,true); LastPaths:=ExtractMakefileCompiledParams(LastParams,true); //debugln(['TLazPackageGraph.CheckIfCurPkgOutDirNeedsCompile CompilerParams="',CompilerParams,'" UnitPaths="',CurPaths.Values['UnitPath'],'"']); // compare custom options OldValue:=LastPaths.Values['Reduced']; NewValue:=CurPaths.Values['Reduced']; if NewValue<>OldValue then begin DebugLn('Hint: (lazarus) Compiler custom params changed for ',APackage.IDAsString); DebugLn(' Old="',OldValue,'"'); DebugLn(' Now="',NewValue,'"'); DebugLn(' State file="',Stats^.StateFileName,'"'); Note+='Compiler custom parameters changed:'+LineEnding +' Old="'+OldValue+'"'+LineEnding +' Now="'+NewValue+'"'+LineEnding +' State file="'+Stats^.StateFileName+'"'+LineEnding; ConfigChanged:=true; exit(mrYes); end; // compare unit paths OldValue:=TrimSearchPath(LastPaths.Values['UnitPath'],APackage.Directory,true); NewValue:=TrimSearchPath(CurPaths.Values['UnitPath'],APackage.Directory,true); if NewValue<>OldValue then begin DebugLn('Hint: (lazarus) Compiler unit paths changed for ',APackage.IDAsString); DebugLn(' Old="',OldValue,'"'); DebugLn(' Now="',NewValue,'"'); DebugLn(' State file="',Stats^.StateFileName,'"'); Note+='Compiler unit paths changed:'+LineEnding +' Old="'+OldValue+'"'+LineEnding +' Now="'+NewValue+'"'+LineEnding +' State file="'+Stats^.StateFileName+'"'+LineEnding; ConfigChanged:=true; exit(mrYes); end; // compare include paths OldValue:=TrimSearchPath(LastPaths.Values['IncPath'],APackage.Directory,true); NewValue:=TrimSearchPath(CurPaths.Values['IncPath'],APackage.Directory,true); if NewValue<>OldValue then begin DebugLn('Hint: (lazarus) Compiler include paths changed for ',APackage.IDAsString); DebugLn(' Old="',OldValue,'"'); DebugLn(' Now="',NewValue,'"'); DebugLn(' State file="',Stats^.StateFileName,'"'); Note+='Compiler include paths changed:'+LineEnding +' Old="'+OldValue+'"'+LineEnding +' Now="'+NewValue+'"'+LineEnding +' State file="'+Stats^.StateFileName+'"'+LineEnding; ConfigChanged:=true; exit(mrYes); end; finally CurPaths.Free; LastPaths.Free; end; end else begin ReducedParams:=RemoveFPCVerbosityParams(CompilerParams); ReducedLastParams:=RemoveFPCVerbosityParams(LastParams); if ReducedParams<>ReducedLastParams then begin // package was compiled by Lazarus DebugLn('Hint: (lazarus) Compiler params changed for ',APackage.IDAsString); DebugLn(' Old="',dbgstr(ReducedLastParams),'"'); DebugLn(' Now="',dbgstr(ReducedParams),'"'); DebugLn(' State file="',Stats^.StateFileName,'"'); Note+='Compiler parameters changed:'+LineEnding +' Old="'+dbgstr(ReducedLastParams)+'"'+LineEnding +' Now="'+dbgstr(ReducedParams)+'"'+LineEnding +' State file="'+Stats^.StateFileName+'"'+LineEnding; ConfigChanged:=true; exit(mrYes); end; end; if (not Stats^.ViaMakefile) and (CompilerFilename<>Stats^.CompilerFilename) then begin DebugLn('Hint: (lazarus) Compiler filename changed for ',APackage.IDAsString); DebugLn(' Old="',Stats^.CompilerFilename,'"'); DebugLn(' Now="',CompilerFilename,'"'); DebugLn(' State file="',Stats^.StateFileName,'"'); Note+='Compiler filename changed:'+LineEnding +' Old="'+Stats^.CompilerFilename+'"'+LineEnding +' Now="'+CompilerFilename+'"'+LineEnding +' State file="'+Stats^.StateFileName+'"'+LineEnding; exit(mrYes); end; if not FileExistsCached(CompilerFilename) then begin DebugLn('Hint: (lazarus) Compiler filename not found for ',APackage.IDAsString); DebugLn(' File="',CompilerFilename,'"'); DebugLn(' State file="',Stats^.StateFileName,'"'); Note+='Compiler file "'+CompilerFilename+'" not found.'+LineEnding +' State file="'+Stats^.StateFileName+'"'+LineEnding; exit(mrYes); end; if (not Stats^.ViaMakefile) and (FileAgeCached(CompilerFilename)<>Stats^.CompilerFileDate) then begin DebugLn('Hint: (lazarus) Compiler file changed for ',APackage.IDAsString); DebugLn(' File="',CompilerFilename,'"'); DebugLn(' State file="',Stats^.StateFileName,'"'); Note+='Compiler file "'+CompilerFilename+'" changed:'+LineEnding +' Old='+FileAgeToStr(Stats^.CompilerFileDate)+LineEnding +' Now='+FileAgeToStr(FileAgeCached(CompilerFilename))+LineEnding +' State file="'+Stats^.StateFileName+'"'+LineEnding; exit(mrYes); end; // check main source file if (SrcFilename<>'') then begin if not FileExistsCached(SrcFilename) then begin DebugLn('Hint: (lazarus) source file missing of ',APackage.IDAsString,': ',SrcFilename); Note+='Source file "'+SrcFilename+'" missing.'+LineEnding; exit(mrYes); end; if StateFileAgemrNo then begin DependenciesChanged:=true; exit(mrYes); end; end; // check package files if StateFileAgenil do begin if ADependency.Owner is TLazPackage then SetFlagDependenciesNeedBuild(TLazPackage(ADependency.Owner)); ADependency:=ADependency.NextUsedByDependency; end; end; function TLazPackageGraph.CompilePackage(APackage: TLazPackage; Flags: TPkgCompileFlags; ShowAbort: boolean; BuildItem: TLazPkgGraphBuildItem ): TModalResult; function GetIgnoreIdentifier: string; begin Result:='install_package_compile_failed:'+APackage.Filename; end; var PkgCompileTool: TAbstractExternalTool; FPCParser: TFPCParser; CompilerFilename: String; EffectiveCompilerParams: String; CompilePolicy: TPackageUpdatePolicy; NeedBuildAllFlag: Boolean; CompilerParams: String; Note: String; WorkingDir: String; ToolTitle: String; ExtToolData: TLazPkgGraphExtToolData; begin Result:=mrCancel; //DebugLn('TLazPackageGraph.CompilePackage A ',APackage.IDAsString,' Flags=',PkgCompileFlagsToString(Flags)); if APackage.IsVirtual then begin DebugLn(['Error: (lazarus) compile failed because virtual: ',APackage.Filename]); exit; end; BeginUpdate(false); try // automatically compile required packages if not (pcfDoNotCompileDependencies in Flags) then begin if pcfCompileDependenciesClean in Flags then CompilePolicy:=pupOnRebuildingAll else CompilePolicy:=pupAsNeeded; Result:=CompileRequiredPackages(APackage,nil, pcfSkipDesignTimePackages in Flags,CompilePolicy); if Result<>mrOk then begin DebugLn(['Error: (lazarus) Compile required packages failed: ',APackage.IDAsString]); exit; end; end; if not APackage.CompilerOptions.HasCommands then begin // package provides no compilation Result:=mrOk; exit; end; // check if compilation is needed and if a clean build is needed NeedBuildAllFlag:=false; Note:=''; Result:=CheckIfPackageNeedsCompilation(APackage, pcfSkipDesignTimePackages in Flags, pcfGroupCompile in Flags, NeedBuildAllFlag,Note); if Note<>'' then Note:='Compile reason: '+Note; if (pcfOnlyIfNeeded in Flags) then begin if Result=mrNo then begin //DebugLn(['TLazPackageGraph.CompilePackage ',APackage.IDAsString,' does not need compilation.']); Result:=mrOk; exit; end; if Result<>mrYes then begin DebugLn(['Error: (lazarus) [CheckIfPackageNeedsCompilation] failed: ',APackage.IDAsString]); exit; end; end; try if (BuildItem=nil) and (LazarusIDE<>nil) then LazarusIDE.MainBarSubTitle:=APackage.Name; if pcfGroupCompile in Flags then SetFlagDependenciesNeedBuild(APackage); // auto increase version // ToDo Result:=PreparePackageOutputDirectory(APackage,pcfCleanCompile in Flags); if Result<>mrOk then begin DebugLn('Error: (lazarus) [TLazPackageGraph.CompilePackage] PreparePackageOutputDirectory failed: ',APackage.IDAsString); exit; end; // create package main source file Result:=SavePackageMainSource(APackage,Flags,ShowAbort); if Result<>mrOk then begin DebugLn('Error: (lazarus) [TLazPackageGraph.CompilePackage] SavePackageMainSource failed: ',APackage.IDAsString); exit; end; // check ambiguous units Result:=CheckAmbiguousPackageUnits(APackage); if Result<>mrOk then begin DebugLn('Error: (lazarus) [TLazPackageGraph.CompilePackage} CheckAmbiguousPackageUnits failed: ',APackage.IDAsString); exit; end; // create Makefile if ((pcfCreateMakefile in Flags) or (APackage.CompilerOptions.CreateMakefileOnBuild)) then begin Result:=WriteMakeFile(APackage); if Result<>mrOk then begin DebugLn('Error: (lazarus) [TLazPackageGraph.CompilePackage] DoWriteMakefile failed: ',APackage.IDAsString); exit; end; end; // create fpmake.pp if ((pcfCreateFpmakeFile in Flags) or (APackage.CompilerOptions.CreateMakefileOnBuild)) then begin Result:=WriteFpmake(APackage); if Result<>mrOk then begin DebugLn('Error: (lazarus) [TLazPackageGraph.CompilePackage] DoWriteFpmakeFile failed: ',APackage.IDAsString); exit; end; end; // run compilation tool 'Before' if not (pcfDoNotCompilePackage in Flags) then begin WorkingDir:=APackage.Directory; ToolTitle:='Package '+APackage.IDAsString+': '+lisExecutingCommandBefore; if BuildItem<>nil then begin // run later BuildItem.Add(APackage.CompilerOptions.ExecuteBefore.CreateExtTool( WorkingDir,ToolTitle,Note)); end else begin // run now Result:=APackage.CompilerOptions.ExecuteBefore.Execute(WorkingDir, ToolTitle,Note); if Result<>mrOk then begin DebugLn(['Error: (lazarus) [TLazPackageGraph.CompilePackage] ExecuteBefore failed: ',APackage.IDAsString]); exit; end; end; end; // create external tool to run the compiler //DebugLn('TLazPackageGraph.CompilePackage WorkingDir="',APackage.Directory,'"'); if (not APackage.CompilerOptions.SkipCompiler) and (not (pcfDoNotCompilePackage in Flags)) then begin CompilerFilename:=APackage.GetCompilerFilename; // change compiler parameters for compiling clean CompilerParams:=GetPackageCompilerParams(APackage); EffectiveCompilerParams:=CompilerParams; if (pcfCleanCompile in Flags) or NeedBuildAllFlag then begin if EffectiveCompilerParams<>'' then EffectiveCompilerParams:='-B '+EffectiveCompilerParams else EffectiveCompilerParams:='-B'; end; PkgCompileTool:=ExternalToolList.Add(Format(lisPkgMangCompilePackage, [APackage.IDAsString])); ExtToolData:=TLazPkgGraphExtToolData.Create(IDEToolCompilePackage, APackage.Name,APackage.Filename); PkgCompileTool.Data:=ExtToolData; PkgCompileTool.FreeData:=true; if BuildItem<>nil then BuildItem.Add(PkgCompileTool) else PkgCompileTool.Reference(Self,Classname); try FPCParser:=TFPCParser(PkgCompileTool.AddParsers(SubToolFPC)); //debugln(['TLazPackageGraph.CompilePackage ',APackage.Name,' ',APackage.CompilerOptions.ShowHintsForUnusedUnitsInMainSrc,' ',APackage.MainUnit.Filename]); if (APackage.MainUnit<>nil) and (not APackage.CompilerOptions.ShowHintsForUnusedUnitsInMainSrc) then FPCParser.FilesToIgnoreUnitNotUsed.Add(APackage.MainUnit.Filename); FPCParser.HideHintsSenderNotUsed:=not APackage.CompilerOptions.ShowHintsForSenderNotUsed; FPCParser.HideHintsUnitNotUsedInMainSource:=not APackage.CompilerOptions.ShowHintsForUnusedUnitsInMainSrc; PkgCompileTool.AddParsers(SubToolMake); PkgCompileTool.Process.CurrentDirectory:=APackage.Directory; PkgCompileTool.Process.Executable:=CompilerFilename; PkgCompileTool.CmdLineParams:=EffectiveCompilerParams; PkgCompileTool.Hint:=Note; ExtToolData.Pkg:=APackage; ExtToolData.SrcPPUFilename:=APackage.GetSrcPPUFilename; ExtToolData.CompilerFilename:=CompilerFilename; ExtToolData.CompilerParams:=CompilerParams; PkgCompileTool.AddHandlerOnStopped(@OnExtToolBuildStopped); if BuildItem<>nil then begin // run later end else begin // run now PkgCompileTool.Execute; //debugln(['TLazPackageGraph.CompilePackage BEFORE WaitForExit: ',APackage.IDAsString]); PkgCompileTool.WaitForExit; //debugln(['TLazPackageGraph.CompilePackage AFTER WaitForExit: ',APackage.IDAsString,' ExtToolData.ErrorMessage=',ExtToolData.ErrorMessage]); if ExtToolData.ErrorMessage<>'' then exit(mrCancel); end; finally if BuildItem=nil then PkgCompileTool.Release(Self); end; end; // run compilation tool 'After' if not (pcfDoNotCompilePackage in Flags) then begin WorkingDir:=APackage.Directory; ToolTitle:='Package '+APackage.IDAsString+': '+lisExecutingCommandAfter; if BuildItem<>nil then begin // run later BuildItem.Add(APackage.CompilerOptions.ExecuteAfter.CreateExtTool( WorkingDir,ToolTitle,Note)); end else begin // run now Result:=APackage.CompilerOptions.ExecuteAfter.Execute(WorkingDir, ToolTitle,Note); if Result<>mrOk then begin DebugLn(['Error: (lazarus) [TLazPackageGraph.CompilePackage] ExecuteAfter failed: ',APackage.IDAsString]); // Note: messages window already contains error message exit; end; end; end; Result:=mrOk; finally if (BuildItem=nil) and (LazarusIDE<>nil) then LazarusIDE.MainBarSubTitle:=''; end; finally PackageGraph.EndUpdate; end; end; function TLazPackageGraph.ConvertPackageRSTFiles(APackage: TLazPackage ): TModalResult; var PkgOutputDirectory: String; POOutputDirectory: String; begin Result:=mrOK; if (APackage.POOutputDirectory='') then exit;// nothing to do POOutputDirectory:=AppendPathDelim(APackage.GetPOOutDirectory); // create output directory if not exists if not DirectoryExistsUTF8(POOutputDirectory) then begin Result:=ForceDirectoryInteractive(POOutputDirectory,[mbRetry,mbIgnore]); if Result<>mrOk then begin if Result=mrIgnore then Result:=mrOk; DebugLn(['Note: (lazarus) [TLazPackageGraph.ConvertPackageRSTFiles] unable to create directory ',POOutputDirectory]); exit; end; end; // find all .rst files in package output directory if not DirectoryIsWritableCached(POOutputDirectory) then begin // this package is read only DebugLn(['Warning: (lazarus) [TLazPackageGraph.ConvertPackageRSTFiles] skipping read only directory '+POOutputDirectory]); exit(mrOK); end; PkgOutputDirectory:=AppendPathDelim(APackage.GetOutputDirectory); if not ConvertRSTFiles(PkgOutputDirectory,POOutputDirectory) then begin DebugLn(['Error: (lazarus) [TLazPackageGraph.ConvertPackageRSTFiles] unable to update .po files PkgOutputDirectory=',PkgOutputDirectory,' RSTOutputDirectory=',POOutputDirectory]); exit(mrCancel); end; Result:=mrOK; end; function TLazPackageGraph.WriteMakefileCompiled(APackage: TLazPackage; TargetCompiledFile, UnitPath, IncPath, OtherOptions: string): TModalResult; var XMLConfig: TXMLConfig; s: String; begin try XMLConfig:=TXMLConfig.Create(TargetCompiledFile); try XMLConfig.SetValue('Makefile/Value',MakefileCompileVersion); s:=''; if UnitPath<>'' then s:=s+' -Fu'+SwitchPathDelims(UnitPath,pdsUnix); if IncPath<>'' then s:=s+' -Fi'+SwitchPathDelims(IncPath,pdsUnix); if OtherOptions<>'' then s:=s+' '+OtherOptions; // do no write the unit output directory // it is not needed because it is the location of the Makefile.compiled s:=s+' '+SwitchPathDelims(CreateRelativePath(APackage.GetSrcFilename,APackage.Directory),pdsUnix); if ConsoleVerbosity>1 then debugln(['Hint: (lazarus) writing Makefile.compiled IncPath="',IncPath,'" UnitPath="',UnitPath,'" Custom="',OtherOptions,'" Makefile.compiled="',TargetCompiledFile,'"']); XMLConfig.SetValue('Params/Value',s); if XMLConfig.Modified then begin InvalidateFileStateCache; XMLConfig.Flush; end; finally XMLConfig.Free; end; except on E: Exception do begin Result:=IDEMessageDialog(lisPkgMangErrorWritingFile, Format(lisPkgMangUnableToWriteStateFileOfPackageError, [TargetCompiledFile, LineEnding, APackage.IDAsString, LineEnding, E.Message]), mtError,[mbCancel],''); exit; end; end; Result:=mrOk; end; function TLazPackageGraph.WriteMakeFile(APackage: TLazPackage): TModalResult; var PathDelimNeedsReplace: Boolean; procedure Replace(var s: string; const SearchTxt, ReplaceTxt: string); var p: LongInt; begin repeat p:=Pos(SearchTxt,s); if p<=1 then break; ReplaceSubstring(s,p,length(SearchTxt),ReplaceTxt); until false; end; function ConvertPIMacrosToMakefileMacros(const s: string): string; begin Result:=s; Replace(Result,'%(','$('); end; function ConvertLazarusToMakefileSearchPath(const s: string): string; begin Result:=ConvertPIMacrosToMakefileMacros(s); Result:=CreateRelativeSearchPath(TrimSearchPath(Result,''),APackage.Directory); Replace(Result,';',' '); if PathDelimNeedsReplace then Replace(Result,PathDelim,'/'); end; function ConvertLazarusToMakefileCompiledSearchPath(const s: string): string; begin Result:=ConvertPIMacrosToMakefileMacros(s); Result:=CreateRelativeSearchPath(TrimSearchPath(Result,''),APackage.Directory); if PathDelimNeedsReplace then Replace(Result,PathDelim,'/'); end; function ConvertLazarusToMakefileDirectory(const s: string): string; begin Result:=ConvertPIMacrosToMakefileMacros(s); Result:=CreateRelativePath(TrimFilename(Result),APackage.Directory); if PathDelimNeedsReplace then Replace(Result,PathDelim,'/'); // trim trailing PathDelim, as windows does not like it Result:=ChompPathDelim(Result); end; function ConvertLazarusOptionsToMakefileOptions(const s: string): string; begin Result:=ConvertPIMacrosToMakefileMacros(s); if PathDelimNeedsReplace then Replace(Result,PathDelim,'/'); end; var s, Last: String; e: string; SrcFilename: String; MainUnitName: String; MakefileFPCFilename: String; UnitOutputPath: String; UnitPath: String; FPCMakeTool: TAbstractExternalTool; CodeBuffer: TCodeBuffer; MainSrcFile: String; CustomOptions: String; IncPath: String; MakefileCompiledFilename: String; OtherOptions: String; FormUnitPath: String; FormIncPath: String; Executable: String; DistCleanDir: String; begin Result:=mrCancel; PathDelimNeedsReplace:=PathDelim<>'/'; if not DirectoryIsWritableCached(APackage.Directory) then begin // The Makefile.fpc is only needed for custom building. // If the package directory is not writable, then the user does not want to // custom build // => silently skip DebugLn(['Error: (lazarus) Skipping writing Makefile, because package directory is not writable: ',APackage.Directory]); Result:=mrOk; exit; end; MakefileFPCFilename:=AppendPathDelim(APackage.Directory)+'Makefile.fpc'; MakefileCompiledFilename:=AppendPathDelim(APackage.Directory)+'Makefile.compiled'; SrcFilename:=APackage.GetSrcFilename; MainUnitName:=lowercase(ExtractFileNameOnly((SrcFilename))); UnitPath:=APackage.CompilerOptions.GetUnitPath(true, coptParsedPlatformIndependent); IncPath:=APackage.CompilerOptions.GetIncludePath(true, coptParsedPlatformIndependent,false); UnitOutputPath:=APackage.CompilerOptions.GetUnitOutPath(true, coptParsedPlatformIndependent); CustomOptions:=APackage.CompilerOptions.GetCustomOptions( coptParsedPlatformIndependent); OtherOptions:=APackage.CompilerOptions.MakeOptionsString( [ccloDoNotAppendOutFileOption,ccloNoMacroParams]); // remove path delimiter at the end, or else it will fail on windows UnitOutputPath:=ConvertLazarusToMakefileDirectory( ChompPathDelim(UnitOutputPath)); // "make distclean" should delete all variable output directories // For example if output directory is units/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) // distclean should delete units/* // It uses deltree, so make sure, that it does not delete ./* or ../* DistCleanDir:=UnitOutputPath; while Pos('$(',ExtractFilename(DistCleanDir))>0 do begin Last:=DistCleanDir; DistCleanDir:=ChompPathDelim(ExtractFilePath(DistCleanDir)); s:=ExtractFileName(DistCleanDir); if (s='') or (s='.') or (s='..') then begin DistCleanDir:=Last; break; end; end; s:=ExtractFileName(DistCleanDir); if (s='') or (s='.') or (s='..') then DistCleanDir:='' // do not delete potential source directories else DistCleanDir+='/*'; MainSrcFile:=CreateRelativePath(SrcFilename,APackage.Directory); CustomOptions:=ConvertLazarusOptionsToMakefileOptions(CustomOptions); OtherOptions:=ConvertLazarusOptionsToMakefileOptions(OtherOptions); if ConsoleVerbosity>0 then debugln(['Hint: (lazarus) [TLazPackageGraph.WriteMakeFile] Custom="',CustomOptions,'" Other="',OtherOptions,'"']); if CustomOptions<>'' then if OtherOptions<>'' then OtherOptions:=OtherOptions+' '+CustomOptions else OtherOptions:=CustomOptions; if ConsoleVerbosity>0 then debugln(['Hint: (lazarus) [TLazPackageGraph.WriteMakeFile] Other="',OtherOptions,'"']); // ---- Makefile.compiled ---------------------------------------------------- //DebugLn('TPkgManager.DoWriteMakefile ',APackage.Name,' makefile UnitPath="',UnitPath,'"'); FormUnitPath:=ConvertLazarusToMakefileCompiledSearchPath(UnitPath); FormIncPath:=ConvertLazarusToMakefileCompiledSearchPath(IncPath); Result:=WriteMakefileCompiled(APackage,MakefileCompiledFilename,FormUnitPath, FormIncPath,OtherOptions); if Result<>mrOK then exit; // ---- Makefile.fpc --------------------------------------------------------- //DebugLn('TPkgManager.DoWriteMakefile ',APackage.Name,' makefile UnitPath="',UnitPath,'"'); FormUnitPath:=ConvertLazarusToMakefileSearchPath(UnitPath); FormIncPath:=ConvertLazarusToMakefileSearchPath(IncPath); e:=LineEnding; s:=''; s:=s+'# File generated automatically by Lazarus Package Manager'+e; s:=s+'#'+e; s:=s+'# Makefile.fpc for '+APackage.IDAsString+e; s:=s+'#'+e; s:=s+'# This file was generated on '+DateToStr(Now)+''+e; s:=s+''+e; s:=s+'[package]'+e; s:=s+'name='+lowercase(APackage.Name)+e; s:=s+'version='+APackage.Version.AsString+e; s:=s+''+e; s:=s+'[compiler]'+e; s:=s+'unittargetdir='+UnitOutputPath+e; if UnitPath<>'' then s:=s+'unitdir='+FormUnitPath+e; if IncPath<>'' then s:=s+'includedir='+FormIncPath+e; s:=s+'options='+OtherOptions+' $(DBG_OPTIONS)'+e; s:=s+''+e; s:=s+'[target]'+e; s:=s+'units='+MainSrcFile+e; s:=s+''+e; s:=s+'[clean]'+e; s:=s+'files=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) \'+e; s:=s+' $(wildcard $(COMPILER_UNITTARGETDIR)/*$(PPUEXT)) \'+e; s:=s+' $(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) \'+e; if (TrimFilename(UnitOutputPath)<>'') and (TrimFilename(UnitOutputPath)<>'.') then begin s:=s+' $(wildcard $(COMPILER_UNITTARGETDIR)/*.lfm) \'+e; s:=s+' $(wildcard $(COMPILER_UNITTARGETDIR)/*.res) \'+e; end; s:=s+' $(wildcard $(COMPILER_UNITTARGETDIR)/*.compiled) \'+e; s:=s+' $(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))'+e; s:=s+''+e; s:=s+'[prerules]'+e; s:=s+'# LCL Platform'+e; s:=s+'ifndef LCL_PLATFORM'+e; s:=s+'ifeq ($(OS_TARGET),win32)'+e; s:=s+'LCL_PLATFORM=win32'+e; s:=s+'else'+e; s:=s+'ifeq ($(OS_TARGET),win64)'+e; s:=s+'LCL_PLATFORM=win32'+e; s:=s+'else'+e; s:=s+'ifeq ($(OS_TARGET),darwin)'+e; s:=s+'LCL_PLATFORM=carbon'+e; s:=s+'else'+e; s:=s+'LCL_PLATFORM=gtk2'+e; s:=s+'endif'+e; s:=s+'endif'+e; s:=s+'endif'+e; s:=s+'endif'+e; s:=s+'export LCL_PLATFORM'+e; s+=e; s:=s+'DBG_OPTIONS='+e; s:=s+'ifeq ($(OS_TARGET),darwin)'+e; s:=s+'DBG_OPTIONS=-gw'+e; s:=s+'endif'+e; s:=s+''+e; s:=s+'[rules]'+e; s:=s+'.PHONY: cleartarget compiled all'+e; s:=s+''+e; s:=s+'cleartarget:'+e; s:=s+' -$(DEL) $(COMPILER_UNITTARGETDIR)/'+MainUnitName+'$(PPUEXT)'+e; s:=s+''+e; s:=s+'compiled:'+e; s:=s+' $(CPPROG) -f Makefile.compiled $(COMPILER_UNITTARGETDIR)/'+APackage.Name+'.compiled'+e; s:=s+''+e; s:=s+'all: cleartarget $(COMPILER_UNITTARGETDIR) '+MainUnitName+'$(PPUEXT) compiled'+e; if DistCleanDir<>'' then begin s:=s+''+e; s:=s+'distclean: clean'+e; s:=s+' ${DELTREE} '+DistCleanDir+e; end; //DebugLn('TPkgManager.DoWriteMakefile [',s,']'); CodeBuffer:=CodeToolBoss.LoadFile(MakefileFPCFilename,true,true); if CodeBuffer=nil then begin CodeBuffer:=CodeToolBoss.CreateFile(MakefileFPCFilename); if CodeBuffer=nil then begin if not DirectoryIsWritableCached(ExtractFilePath(MakefileFPCFilename)) then begin // the package source is read only => ignore exit(mrOk); end; debugln(['Error: (lazarus) [TLazPackageGraph.WriteMakeFile] unable to create file '+MakefileFPCFilename]); exit(mrCancel); end; end; if ExtractCodeFromMakefile(CodeBuffer.Source)=ExtractCodeFromMakefile(s) then begin // Makefile.fpc not changed Result:=mrOk; exit; end; CodeBuffer.Source:=s; //debugln('TPkgManager.DoWriteMakefile MakefileFPCFilename="',MakefileFPCFilename,'"'); Result:=SaveCodeBufferToFile(CodeBuffer,MakefileFPCFilename); if Result<>mrOk then begin if not DirectoryIsWritableCached(ExtractFilePath(MakefileFPCFilename)) then begin // the package source is read only => no problem Result:=mrOk; end; exit; end; Executable:=FindFPCTool('fpcmake'+GetExecutableExt, EnvironmentOptions.GetParsedCompilerFilename); if not FileIsExecutableCached(Executable) then Executable:='fpcmake'+GetExecutableExt; // call fpcmake to create the Makefile FPCMakeTool:=ExternalToolList.Add( Format(lisIDEInfoCreatingMakefileForPackage, [APackage.IDAsString])); FPCMakeTool.Process.CurrentDirectory:=APackage.Directory; FPCMakeTool.Process.Executable:=Executable; FPCMakeTool.CmdLineParams:='-q -TAll'; FPCMakeTool.EnvironmentOverrides.Add( 'FPCDIR='+EnvironmentOptions.GetParsedFPCSourceDirectory); FPCMakeTool.Execute; FPCMakeTool.WaitForExit; Result:=mrOk; end; function TLazPackageGraph.WriteFpmake(APackage: TLazPackage): TModalResult; var PathDelimNeedsReplace: Boolean; function ConvertPIMacrosToMakefileMacros(const s: string): string; begin result := StringsReplace(s, ['%(LCL_PLATFORM)', '%(CPU_TARGET)', '%(OS_TARGET)'], ['$(LCLWidgetType)','$(CPU)', '$(OS)'],[rfReplaceAll, rfIgnoreCase]); result := StringReplace(result,'%(','$(',[rfReplaceAll]); end; function ConvertLazarusToFpmakeSearchPath(const s: string): string; begin Result:=ConvertPIMacrosToMakefileMacros(s); Result:=CreateRelativeSearchPath(TrimSearchPath(Result,''),APackage.Directory); if PathDelimNeedsReplace then Result:=StringReplace(Result,PathDelim,'/',[rfReplaceAll]); end; function ConvertLazarusToMakefileDirectory(const s: string): string; begin Result:=ConvertPIMacrosToMakefileMacros(s); Result:=CreateRelativePath(TrimFilename(Result),APackage.Directory); if PathDelimNeedsReplace then Result:=StringReplace(Result,PathDelim,'/',[rfReplaceAll]); // trim trailing PathDelim, as windows does not like it Result:=ChompPathDelim(Result); end; function StringToFpmakeOptionGroup(const OptionName,Options:string; OptPrefix: string = ''): string; var sl: TStrings; i: Integer; begin result := ''; sl := SplitString(Options,';'); try for i := 0 to sl.Count-1 do result := result + OptionName+'('''+OptPrefix+sl.Strings[i]+''');'+LineEnding; finally sl.Free; end; end; function ConvertLazarusOptionsToFpmakeOptions(const s: string): string; begin Result:=ConvertPIMacrosToMakefileMacros(s); Result := StringReplace(Result,' ',';',[rfReplaceAll]); if PathDelimNeedsReplace then Result:=StringReplace(Result,PathDelim,'/',[rfReplaceAll]); end; var s: String; e: string; SrcFilename: String; FpmakeFPCFilename: String; UnitPath: String; CodeBuffer: TCodeBuffer; MainSrcFile: String; CustomOptions: String; IncPath: String; OtherOptions: String; i: Integer; ARequirement: TPkgDependency; FPmakeCompiledFilename: String; begin Result:=mrCancel; PathDelimNeedsReplace:=PathDelim<>'/'; if not DirectoryIsWritableCached(APackage.Directory) then begin // The fpmake.pp is only needed for custom building. // If the package directory is not writable, then the user does not want to // custom build // => silently skip DebugLn(['Note: (lazarus) Skipping writing fpmake.pp, because package directory is not writable: ',APackage.Directory]); Result:=mrOk; exit; end; FpmakeFPCFilename:=AppendPathDelim(APackage.Directory)+'fpmake.pp'; FPmakeCompiledFilename:=AppendPathDelim(APackage.Directory)+APackage.Name+'.compiled'; SrcFilename:=APackage.GetSrcFilename; UnitPath:=APackage.CompilerOptions.ParsedOpts.GetParsedPIValue(pcosUnitPath); UnitPath:=CreateRelativeSearchPath(UnitPath,APackage.CompilerOptions.BaseDirectory); UnitPath:=MergeSearchPaths(UnitPath, '.'); IncPath:=APackage.CompilerOptions.GetIncludePath(true, coptParsedPlatformIndependent,false); CustomOptions:=APackage.CompilerOptions.GetCustomOptions( coptParsedPlatformIndependent); if ConsoleVerbosity>0 then debugln('Hint: (lazarus) Writing fpmake.pp: CustomOptions (orig): ',CustomOptions); OtherOptions:=APackage.CompilerOptions.MakeOptionsString( [ccloDoNotAppendOutFileOption,ccloNoMacroParams]); if ConsoleVerbosity>0 then debugln('Hint: (lazarus) Writing fpmake.pp: OtherOptions (orig): ',OtherOptions); // write compiled file Result:=WriteMakefileCompiled(APackage,FPmakeCompiledFilename,UnitPath, IncPath,OtherOptions); if Result<>mrOK then exit; //DebugLn('TPkgManager.DoWriteMakefile ',APackage.Name,' makefile UnitPath="',UnitPath,'"'); UnitPath:=ConvertLazarusToFpmakeSearchPath(UnitPath); IncPath:=ConvertLazarusToFpmakeSearchPath(IncPath); // remove path delimiter at the end, or else it will fail on windows MainSrcFile:=CreateRelativePath(SrcFilename,APackage.Directory); CustomOptions:=ConvertLazarusOptionsToFpmakeOptions(CustomOptions); if ConsoleVerbosity>0 then debugln('Hint: (lazarus) Writing fpmake.pp: CustomOptions (fpmake format): ',CustomOptions); OtherOptions:=ConvertLazarusOptionsToFpmakeOptions(OtherOptions); if ConsoleVerbosity>0 then debugln('Hint: (lazarus) Writing fpmake.pp: OtherOptions (fpmake format): ',OtherOptions); e:=LineEnding; s:=''; s:=s+'{'+e; s:=s+' File generated automatically by Lazarus Package Manager'+e; s:=s+''+e; s:=s+' fpmake.pp for '+APackage.IDAsString+e; s:=s+''+e; s:=s+' This file was generated on '+DateToStr(Now)+''+e; s:=s+'}'+e; s:=s+''+e; s:=s+'{$ifndef ALLPACKAGES} '+e; s:=s+'{$mode objfpc}{$H+}'+e; s:=s+'program fpmake;'+e; s:=s+''+e; s:=s+'uses fpmkunit;'+e; s:=s+'{$endif ALLPACKAGES}'+e; s:=s+''+e; s:=s+'procedure add_'+APackage.Name+'(const ADirectory: string);'+e; s:=s+''+e; s:=s+'var'+e; s:=s+' P : TPackage;'+e; s:=s+' T : TTarget;'+e; s:=s+''+e; s:=s+'begin'+e; s:=s+' with Installer do'+e; s:=s+' begin'+e; s:=s+' P:=AddPackage('''+lowercase(APackage.Name)+''');'+e; s:=s+' P.Version:='''+APackage.Version.AsString+''';'+e; s:=s+''+e; s:=s+' P.Directory:=ADirectory;'+e; s:=s+''+e; if APackage.PackageType in [lptDesignTime, lptRunAndDesignTime] then s:=s+' P.Flags.Add(''LazarusDsgnPkg'');'+e+e; ARequirement := APackage.FirstRequiredDependency; while assigned(ARequirement) do begin s:=s+' P.Dependencies.Add('''+lowercase(ARequirement.PackageName)+''');'+e; ARequirement := ARequirement.NextRequiresDependency; end; s := s + StringToFpmakeOptionGroup(' P.Options.Add',OtherOptions); s := s + StringToFpmakeOptionGroup(' P.Options.Add',CustomOptions); s := s + StringToFpmakeOptionGroup(' P.IncludePath.Add',IncPath); s := s + StringToFpmakeOptionGroup(' P.UnitPath.Add', UnitPath); s:=s+' T:=P.Targets.AddUnit('''+MainSrcFile+''');'+e; for i := 0 to APackage.FileCount-1 do if (APackage.Files[i].FileType=pftUnit) then s:=s+' t.Dependencies.AddUnit('''+ExtractFileNameOnly(APackage.Files[i].Filename)+''');'+e; s:=s+''+e; for i := 0 to APackage.FileCount-1 do if (APackage.Files[i].FileType=pftUnit) then begin if (pffAddToPkgUsesSection in APackage.Files[i].Flags) then s:=s+' T:=P.Targets.AddUnit('''+CreateRelativePath(APackage.Files[i].Filename,APackage.Directory)+''');'+e else begin s:=s+' P.Targets.AddImplicitUnit('''+CreateRelativePath(APackage.Files[i].Filename,APackage.Directory)+''');'+e; end; end; s:=s+''+e; s:=s+' // copy the compiled file, so the IDE knows how the package was compiled'+e; s:=s+' P.InstallFiles.Add('''+ExtractFileName(FPmakeCompiledFilename)+''',AllOSes,''$(unitinstalldir)'');'+e; s:=s+''+e; s:=s+' end;'+e; s:=s+'end;'+e; s:=s+''+e; s:=s+'{$ifndef ALLPACKAGES}'+e; s:=s+'begin'+e; s:=s+' add_'+APackage.Name+'('''');'+e; s:=s+' Installer.Run;'+e; s:=s+'end.'+e; s:=s+'{$endif ALLPACKAGES}'+e; CodeBuffer:=CodeToolBoss.LoadFile(FpmakeFPCFilename,true,true); if CodeBuffer=nil then begin CodeBuffer:=CodeToolBoss.CreateFile(FpmakeFPCFilename); if CodeBuffer=nil then begin if not DirectoryIsWritableCached(ExtractFilePath(FpmakeFPCFilename)) then begin // the package source is read only => ignore exit(mrOk); end; debugln(['Error: (lazarus) unable to create fpmake.pp file '+FpmakeFPCFilename]); exit(mrCancel); end; end; if ExtractCodeFromMakefile(CodeBuffer.Source)=ExtractCodeFromMakefile(s) then begin // nothing important has changed in fpmake.pp => do not write to disk Result:=mrOk; exit; end; CodeBuffer.Source:=s; //debugln('TPkgManager.DoWriteMakefile MakefileFPCFilename="',FpmakeFPCFilename,'"'); Result:=SaveCodeBufferToFile(CodeBuffer,FpmakeFPCFilename); if Result<>mrOk then begin if not DirectoryIsWritableCached(ExtractFilePath(FpmakeFPCFilename)) then begin // the package source is read only => skip silently Result:=mrOk; end; exit; end; if ConsoleVerbosity>0 then debugln(['Hint: (lazarus) wrote fpmake.pp: ',FpmakeFPCFilename]); Result:=mrOk; end; function TLazPackageGraph.PreparePackageOutputDirectory(APackage: TLazPackage; CleanUp: boolean): TModalResult; var OutputDir: String; StateFile: String; PkgSrcDir: String; i: Integer; CurFile: TPkgFile; OutputFileName: String; NewOutputDir: String; DeleteAllFilesInOutputDir: Boolean; DirCache: TCTDirectoryCache; CleanFiles: TStrings; begin // get output directory OutputDir:=APackage.GetOutputDirectory; //debugln(['TLazPackageGraph.PreparePackageOutputDirectory OutputDir="',OutputDir,'"']); DeleteAllFilesInOutputDir:=false; if not OutputDirectoryIsWritable(APackage,OutputDir,false) then begin // the normal output directory is not writable // => use the fallback directory NewOutputDir:=GetFallbackOutputDir(APackage); if (NewOutputDir=OutputDir) or (NewOutputDir='') then begin debugln(['Error: (lazarus) [TLazPackageGraph.PreparePackageOutputDirectory] failed to create writable directory: ',OutputDir]); exit(mrCancel); end; APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride:=NewOutputDir; OutputDir:=APackage.GetOutputDirectory; if not OutputDirectoryIsWritable(APackage,OutputDir,true) then begin debugln(['Error: (lazarus) [TLazPackageGraph.PreparePackageOutputDirectory] failed to create writable directory: ',OutputDir]); Result:=mrCancel; end; DeleteAllFilesInOutputDir:=true; end else if APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride<>'' then // package is already using the fallback directory DeleteAllFilesInOutputDir:=true else if CleanUp then begin // package is not using the fallback directory // check if the output directory contains sources DeleteAllFilesInOutputDir:=APackage.HasSeparateOutputDirectory; end; //debugln(['TLazPackageGraph.PreparePackageOutputDirectory ',APackage.Name,' DeleteAllFilesInOutputDir=',DeleteAllFilesInOutputDir]); StateFile:=APackage.GetStateFilename; PkgSrcDir:=ExtractFilePath(APackage.GetSrcFilename); // delete old Compile State file if FileExistsUTF8(StateFile) and not DeleteFileUTF8(StateFile) then begin Result:=IDEMessageDialog(lisPkgMangUnableToDeleteFilename, Format(lisPkgMangUnableToDeleteOldStateFileForPackage, [StateFile, LineEnding, APackage.IDAsString]), mtError,[mbCancel,mbAbort]); exit; end; InvalidateFileStateCache(StateFile); InvalidateStateFile(APackage); // create the package src directory if not ForceDirectoriesUTF8(PkgSrcDir) then begin Result:=IDEMessageDialog(lisPkgMangUnableToCreateDirectory, Format(lisPkgMangUnableToCreatePackageSourceDirectoryForPackage, [PkgSrcDir, LineEnding, APackage.IDAsString]), mtError,[mbCancel,mbAbort]); exit; end; // clean up if wanted if CleanUp then begin if DeleteAllFilesInOutputDir then begin // delete all files in output directory DirCache:=CodeToolBoss.DirectoryCachePool.GetCache(OutputDir,true,false); if DirCache<>nil then begin CleanFiles:=TStringList.Create; try DirCache.GetFiles(CleanFiles,false); for i:=0 to CleanFiles.Count-1 do begin OutputFileName:=AppendPathDelim(OutputDir)+CleanFiles[i]; if ConsoleVerbosity>1 then debugln(['Hint: (lazarus) cleaning up package output directory of '+APackage.IDAsString+': '+OutputFileName]); Result:=DeleteFileInteractive(OutputFileName,[mbIgnore,mbAbort]); if Result in [mrCancel,mrAbort] then exit; end; finally CleanFiles.Free; end; end; end else begin // delete .ppu/.o file of each registered unit for i:=0 to APackage.FileCount-1 do begin CurFile:=APackage.Files[i]; if not (CurFile.FileType in PkgFileUnitTypes) then continue; OutputFileName:=AppendPathDelim(OutputDir)+CurFile.Unit_Name+'.ppu'; if ConsoleVerbosity>1 then debugln(['Hint: (lazarus) cleaning up package output directory of '+APackage.IDAsString+': '+OutputFileName]); Result:=DeleteFileInteractive(OutputFileName,[mbIgnore,mbAbort]); if Result in [mrCancel,mrAbort] then exit; OutputFileName:=ChangeFileExt(OutputFileName,'.o'); if ConsoleVerbosity>1 then debugln(['Hint: (lazarus) cleaning up package output directory of '+APackage.IDAsString+': '+OutputFileName]); Result:=DeleteFileInteractive(OutputFileName,[mbIgnore,mbAbort]); if Result in [mrCancel,mrAbort] then exit; end; end; InvalidateFileStateCache; end; Result:=mrOk; end; function TLazPackageGraph.GetFallbackOutputDir(APackage: TLazPackage): string; var Dir: String; begin // use the default output directory, if it is relative // (this way the fallback creates the same amount of target directories) Dir:=APackage.CompilerOptions.ParsedOpts.Values[pcosOutputDir].UnparsedValue; Dir:=APackage.SubstitutePkgMacros(Dir,false); if FilenameIsAbsolute(Dir) then begin // it is not relative => create a default one Dir:='$(TargetOS)-$(TargetCPU)'; end; Dir:='$(FallbackOutputRoot)'+PathDelim+APackage.Name+PathDelim+Dir; GlobalMacroList.SubstituteStr(Dir); Dir:=TrimFilename(Dir); if ConsoleVerbosity>=0 then debugln(['Hint: (lazarus) Fallback output directory of ',APackage.Name,': ',Dir]); Result:=Dir; end; function TLazPackageGraph.CheckAmbiguousPackageUnits(APackage: TLazPackage ): TModalResult; var i: Integer; CurFile: TPkgFile; CurUnitName: String; SrcDirs: String; PkgDir: String; PkgOutputDir: String; YesToAll: Boolean; function CheckFile(const ShortFilename: string): TModalResult; var AmbiguousFilename: String; SearchFlags: TSearchFileInPathFlags; begin Result:=mrOk; SearchFlags:=[]; if CompareFilenames(PkgDir,PkgOutputDir)=0 then Include(SearchFlags,sffDontSearchInBasePath); repeat AmbiguousFilename:=SearchFileInPath(ShortFilename,PkgDir,SrcDirs,';', SearchFlags); if (AmbiguousFilename='') then exit; if not YesToAll then Result:=IDEMessageDialog(lisAmbiguousUnitFound, Format(lisTheFileWasFoundInOneOfTheSourceDirectoriesOfThePac, [AmbiguousFilename, LineEnding, APackage.IDAsString, LineEnding+LineEnding]), mtWarning,[mbYes,mbYesToAll,mbNo,mbAbort]) else Result:=mrYesToAll; if Result=mrNo then Result:=mrOk; if Result in [mrYes,mrYesToAll] then begin YesToAll:=Result=mrYesToAll; if (not DeleteFileUTF8(AmbiguousFilename)) and (IDEMessageDialog(lisPkgMangDeleteFailed, Format(lisDeletingOfFileFailed, [AmbiguousFilename]), mtError, [mbIgnore, mbCancel])<>mrIgnore) then exit(mrCancel); Result:=mrOk; end else break; until false; end; begin Result:=mrOk; YesToAll:=False; // search in every source directory for compiled versions of the units // A source directory is a directory with a used unit and it is not the output // directory SrcDirs:=APackage.GetSourceDirs(true,true); PkgOutputDir:=AppendPathDelim(APackage.GetOutputDirectory); SrcDirs:=RemoveSearchPaths(SrcDirs,PkgOutputDir); if SrcDirs='' then exit; PkgDir:=AppendPathDelim(APackage.Directory); for i:=0 to APackage.FileCount-1 do begin CurFile:=APackage.Files[i]; if CurFile.FileType<>pftUnit then continue; CurUnitName:=lowercase(CurFile.Unit_Name); if CurUnitName='' then continue; Result:=CheckFile(CurUnitName+'.ppu'); if Result<>mrOk then exit; Result:=CheckFile(CurUnitName+'.ppl'); if Result<>mrOk then exit; end; Result:=mrOk; end; function TLazPackageGraph.SavePackageMainSource(APackage: TLazPackage; Flags: TPkgCompileFlags; ShowAbort: boolean): TModalResult; var PkgUnitName, SrcFilename, UsedUnits, Src: String; i: Integer; e: String; CurFile: TPkgFile; CodeBuffer: TCodeBuffer; CurUnitName: String; RegistrationCode: String; HeaderSrc: String; OldShortenSrc: String; NeedsRegisterProcCall: boolean; CurSrcUnitName: String; NewShortenSrc: String; BeautifyCodeOptions: TBeautifyCodeOptions; AddedUnitNames: TStringToStringTree; AFilename: String; procedure UseUnit(AnUnitName: string); begin if AddedUnitNames.Contains(AnUnitName) then exit; if CompareDottedIdentifiers(PChar(AnUnitName),PChar(PkgUnitName))=0 then exit; AddedUnitNames.Add(AnUnitName,''); if UsedUnits<>'' then UsedUnits:=UsedUnits+', '; UsedUnits:=UsedUnits+AnUnitName; end; begin {$IFDEF VerbosePkgCompile} debugln('TLazPackageGraph.SavePackageMainSource A'); {$ENDIF} SrcFilename:=APackage.GetSrcFilename; // delete ambiguous files Result:=DeleteAmbiguousFiles(SrcFilename); if Result=mrAbort then begin DebugLn('Error: (lazarus) [TLazPackageGraph.SavePackageMainSource} DoDeleteAmbiguousFiles failed'); exit; end; // get unit name PkgUnitName := ExtractFileNameOnly(SrcFilename); if CompareDottedIdentifiers(PChar(APackage.Name), PChar(PkgUnitName))=0 then PkgUnitName := APackage.Name; // collect unitnames e:=LineEnding; UsedUnits:=''; RegistrationCode:=''; AddedUnitNames:=TStringToStringTree.Create(false); try for i:=0 to APackage.FileCount-1 do begin CurFile:=APackage.Files[i]; if CurFile.FileType=pftMainUnit then continue; // update unitname AFilename:=CurFile.GetFullFilename; if FilenameIsPascalUnit(AFilename) and (CurFile.FileType in PkgFileUnitTypes) then begin NeedsRegisterProcCall:=CurFile.HasRegisterProc and (APackage.PackageType in [lptDesignTime,lptRunAndDesignTime]); AFilename:=CodeToolBoss.DirectoryCachePool.FindDiskFilename(AFilename,true); CurUnitName:=ExtractFileNameOnly(AFilename); if not (NeedsRegisterProcCall or CurFile.AddToUsesPkgSection) then continue; if CurUnitName=lowercase(CurUnitName) then begin // the filename is all lowercase, so we can use the nicer unitname from // the source. CodeBuffer:=CodeToolBoss.LoadFile(AFilename,false,false); if CodeBuffer<>nil then begin // if the unit is edited, the unitname is probably already cached CurSrcUnitName:=CodeToolBoss.GetCachedSourceName(CodeBuffer); // if not then parse it if SysUtils.CompareText(CurSrcUnitName,CurUnitName)<>0 then CurSrcUnitName:=CodeToolBoss.GetSourceName(CodeBuffer,false); // if it makes sense, update unitname if SysUtils.CompareText(CurSrcUnitName,CurFile.Unit_Name)=0 then CurFile.Unit_Name:=CurSrcUnitName; end; if SysUtils.CompareText(CurUnitName,CurFile.Unit_Name)=0 then CurUnitName:=CurFile.Unit_Name else CurFile.Unit_Name:=CurUnitName; end; if (CurUnitName='') or (not IsValidUnitName(CurUnitName)) then begin AddMessage(mluError,Format('invalid unit name in package %s',[APackage.IDAsString]),CurFile.Filename); continue; end; UseUnit(CurUnitName); if NeedsRegisterProcCall then begin RegistrationCode:=RegistrationCode+ ' RegisterUnit('''+CurUnitName+''',@'+CurUnitName+'.Register);'+e; end; end; end; // append registration code only for design time packages if (APackage.PackageType in [lptDesignTime,lptRunAndDesignTime]) then begin RegistrationCode:= 'procedure Register;'+e +'begin'+e +RegistrationCode +'end;'+e +e +'initialization'+e +' RegisterPackage('''+APackage.Name+''',@Register);' +e; UseUnit('LazarusPackageIntf'); end; finally AddedUnitNames.Free; end; // create source BeautifyCodeOptions:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions; // keep in english to avoid svn updates HeaderSrc:= '{ This file was automatically created by Lazarus. Do not edit!'+e +' This source is only used to compile and install the package.'+e +' }'+e+e; // leave the unit case the same as the package name (e.g: package name LazReport, unit name lazreport) Src:='unit '+ PkgUnitName +';'+e +e +'interface'+e +e; Src:=BeautifyCodeOptions.BeautifyStatement(Src,0); Src:=HeaderSrc+Src; if UsedUnits<>'' then Src:=Src +'uses'+e +BreakString(GetIndentStr(BeautifyCodeOptions.Indent)+UsedUnits+';', BeautifyCodeOptions.LineLength,BeautifyCodeOptions.Indent)+e +e; Src:=Src+BeautifyCodeOptions.BeautifyStatement( 'implementation'+e +e +RegistrationCode +'end.'+e,0); // check if old code is already uptodate Result:=LoadCodeBuffer(CodeBuffer,SrcFilename,[lbfQuiet,lbfCheckIfText, lbfUpdateFromDisk,lbfCreateClearOnError],ShowAbort); if Result<>mrOk then begin DebugLn('Error: (lazarus) [TLazPackageGraph.SavePackageMainSource] LoadCodeBuffer ',SrcFilename,' failed'); exit; end; // ignore comments OldShortenSrc:=CodeToolBoss.ExtractCodeWithoutComments(CodeBuffer,true); NewShortenSrc:=CleanCodeFromComments(Src, CodeToolBoss.GetNestedCommentsFlagForFile(CodeBuffer.Filename),true); // ignore case and spaces if CompareTextIgnoringSpace(OldShortenSrc,NewShortenSrc,false)=0 then begin Result:=mrOk; exit; end; if OldShortenSrc<>NewShortenSrc then begin {$IFDEF VerbosePkgCompile} DebugLn('TLazPackageGraph.SavePackageMainSource Src changed ',dbgs(length(OldShortenSrc)),' ',dbgs(length(NewShortenSrc))); {$ENDIF} end; // save source Result:=SaveStringToFile(SrcFilename,Src,[],lisPkgMangpackageMainSourceFile); if Result<>mrOk then begin DebugLn('Error: (lazarus) [TLazPackageGraph.SavePackageMainSource] SaveStringToFile ',SrcFilename,' failed'); exit; end; Result:=mrOk; end; function TLazPackageGraph.GetBrokenDependenciesWhenChangingPkgID( APackage: TLazPackage; const NewName: string; NewVersion: TPkgVersion ): TFPList; var Dependency: TPkgDependency; begin Result:=TFPList.Create; // find all dependencies, that will become incompatible Dependency:=APackage.FirstUsedByDependency; while Dependency<>nil do begin if not Dependency.IsCompatible(NewName,NewVersion) then Result.Add(Dependency); Dependency:=Dependency.NextUsedByDependency; end; end; procedure TLazPackageGraph.GetPackagesChangedOnDisk(out ListOfPackages: TStringList); // if package source is changed in IDE (codetools) // then changes on disk are ignored var APackage: TLazPackage; i: Integer; NewFilename: String; HaveUpdatedGlobalPkgLinks: Boolean; procedure UpdateGlobalLinks; begin if not HaveUpdatedGlobalPkgLinks then begin PkgLinks.UpdateGlobalLinks; HaveUpdatedGlobalPkgLinks:=true; end; end; begin ListOfPackages:=nil; MarkNeededPackages; HaveUpdatedGlobalPkgLinks:=false; for i:=FItems.Count-1 downto 0 do begin APackage:=TLazPackage(FItems[i]); if (not (lpfNeeded in APackage.Flags)) or APackage.Modified or APackage.IsVirtual then continue; NewFilename:=APackage.Filename; if FileExistsCached(APackage.Filename) then begin if (APackage.LPKSource<>nil) and (not APackage.LPKSource.FileNeedsUpdate) then continue; // a lpk has changed, this might include dependencies => reload lpl files UpdateGlobalLinks; end else begin // lpk has vanished -> search alternative => reload lpl files UpdateGlobalLinks; NewFilename:=PackageGraph.FindAlternativeLPK(APackage); if (NewFilename='') and (APackage.Missing or (APackage.LPKSource=nil)) then continue; // no lpk found again => do not show again end; if ListOfPackages=nil then ListOfPackages:=TStringList.Create; ListOfPackages.AddObject(NewFilename,APackage); end; end; procedure TLazPackageGraph.IncChangeStamp; begin {$push}{$R-} // range check off if FUpdateLock = 0 then Inc(FChangeStamp) else Inc(FLockedChangeStamp) {$pop} end; procedure TLazPackageGraph.SortDependencyListTopologicallyOld( var FirstDependency: TPkgDependency; TopLevelFirst: boolean); // Sort dependency list topologically. // If TopLevelFirst is true then packages that need others come first var Dependency: TPkgDependency; BucketStarts: PInteger; MaxLvl: Integer; BucketCount: Integer; DependencyCount: Integer; Dependencies: PPkgDependency; i: Integer; j: Integer; CurLvl: LongInt; List: TFPList; begin GetAllRequiredPackages(nil,FirstDependency,List); List.Free; // Bucket sort dependencies MaxLvl:=0; Dependency:=FirstDependency; DependencyCount:=0; while Dependency<>nil do begin if Dependency.RequiredPackage<>nil then begin if MaxLvlnil do begin if Dependency.RequiredPackage<>nil then CurLvl:=Dependency.RequiredPackage.TopologicalLevel else CurLvl:=0; if CurLvl+1nil do begin if Dependency.RequiredPackage<>nil then CurLvl:=Dependency.RequiredPackage.TopologicalLevel else CurLvl:=0; if Dependencies[BucketStarts[CurLvl]]<>nil then RaiseException(''); Dependencies[BucketStarts[CurLvl]]:=Dependency; inc(BucketStarts[CurLvl]); Dependency:=Dependency.NextRequiresDependency; end; // optional: reverse order if TopLevelFirst then begin i:=0; j:=DependencyCount-1; while (ipitNope) or (APackage.AutoInstall<>pitNope) or APackage.Modified or (APackage.Editor<>nil) or (APackage.HoldPackageCount>0) then begin exit; end; // check if used by project ADependency:=APackage.FirstUsedByDependency; while ADependency<>nil do begin if ADependency.Owner is TLazProject then exit; ADependency:=ADependency.NextUsedByDependency; end; Result:=false; end; function TLazPackageGraph.PackageCanBeReplaced( OldPackage, NewPackage: TLazPackage): boolean; begin if SysUtils.CompareText(OldPackage.Name,NewPackage.Name)<>0 then RaiseException('TLazPackageGraph.PackageCanBeReplaced'); Result:=true; end; procedure TLazPackageGraph.RegisterStaticBasePackages; begin BeginUpdate(true); // IDE built-in packages if Assigned(OnTranslatePackage) then OnTranslatePackage(CodeToolsPackage); // register custom IDE components RegistrationPackage:=DefaultPackage; {$IFDEF CustomIDEComps} if IDEComponentPalette<>nil then IDEComponentPalette.RegisterCustomIDEComponents(@RegisterCustomIDEComponent); {$ENDIF} if DefaultPackage.FileCount=0 then begin FreeThenNil(FDefaultPackage); end else begin DefaultPackage.Name:=CreateUniquePkgName('DefaultPackage',DefaultPackage); AddPackage(DefaultPackage); end; RegistrationPackage:=nil; EndUpdate; end; procedure TLazPackageGraph.RegisterStaticPackage(APackage: TLazPackage; RegisterProc: TRegisterProc); begin if AbortRegistration then exit; //DebugLn(['TLazPackageGraph.RegisterStaticPackage ',APackage.IDAsString]); RegistrationPackage:=APackage; if Assigned(OnTranslatePackage) then OnTranslatePackage(APackage); CallRegisterProc(RegisterProc); APackage.Registered:=true; RegistrationPackage:=nil; end; procedure TLazPackageGraph.RegisterDefaultPackageComponent(const Page, AUnitName: ShortString; ComponentClass: TComponentClass); var PkgFile: TPkgFile; NewPkgFilename: String; begin PkgFile:=FDefaultPackage.FindUnit(AUnitName,true); if PkgFile=nil then begin NewPkgFilename:=AUnitName+'.pas'; PkgFile:=FDefaultPackage.AddFile(NewPkgFilename,AUnitName,pftUnit,[], cpOptional); end; FRegistrationFile:=PkgFile; RegisterComponentsHandler(Page,[ComponentClass]); end; procedure TLazPackageGraph.CallRegisterProc(RegisterProc: TRegisterProc); begin if AbortRegistration then exit; // check registration procedure if RegisterProc=nil then begin RegistrationError(lisPkgSysRegisterProcedureIsNil); exit; end; {$IFNDEF StopOnRegError} try {$ENDIF} // call the registration procedure RegisterProc(); {$IFNDEF StopOnRegError} except on E: Exception do begin RegistrationError(E.Message); end; end; {$ENDIF} end; procedure TLazPackageGraph.AddDependencyToPackage(APackage: TLazPackage; Dependency: TPkgDependency); begin BeginUpdate(true); APackage.AddRequiredDependency(Dependency); Dependency.LoadPackageResult:=lprUndefined; OpenDependency(Dependency,false); EndUpdate; end; procedure TLazPackageGraph.AddDependencyToPackage(APackage, RequiredPackage: TLazPackage); var NewDependency: TPkgDependency; begin NewDependency:=TPkgDependency.Create; NewDependency.PackageName:=RequiredPackage.Name; AddDependencyToPackage(APackage,NewDependency); end; procedure TLazPackageGraph.RemoveDependencyFromPackage(APackage: TLazPackage; Dependency: TPkgDependency; AddToRemovedList: boolean); begin BeginUpdate(true); if AddToRemovedList then APackage.RemoveRequiredDependency(Dependency) else APackage.DeleteRequiredDependency(Dependency); IncreaseBuildMacroChangeStamp; EndUpdate; end; { procedure TLazPackageGraph.ChangeDependency(Dependency, NewDependency: TPkgDependency); begin if Dependency.Compare(NewDependency)=0 then exit; BeginUpdate(true); Dependency.Assign(NewDependency); Dependency.LoadPackageResult:=lprUndefined; IncreaseBuildMacroChangeStamp; OpenDependency(Dependency,false); DoDependencyChanged(Dependency); EndUpdate; end; } function TLazPackageGraph.OpenDependency(Dependency: TPkgDependency; ShowAbort: boolean): TLoadPackageResult; procedure OpenFile(AFilename: string); var PkgLink: TPackageLink; begin PkgLink:=PkgLinks.AddUserLink(AFilename,Dependency.PackageName); if (PkgLink<>nil) then begin PkgLink.Reference; try if OpenDependencyWithPackageLink(Dependency,PkgLink,false)<>mrOk then PkgLinks.RemoveUserLink(PkgLink); finally PkgLink.Release; end; end; end; var ANode: TAVLTreeNode; CurDir: String; AFilename: String; MsgResult: TModalResult; APackage: TLazPackage; PreferredFilename: string; PkgLink: TPackageLink; IgnoreFiles: TFilenameToStringTree; i: Integer; begin if Dependency.LoadPackageResult=lprUndefined then begin if pvPkgSearch in Verbosity then debugln('Info: (lazarus) Open dependency '+Dependency.AsString(true,true)+' ...'); //debugln(['TLazPackageGraph.OpenDependency ',Dependency.PackageName,' ',Dependency.DefaultFilename,' Prefer=',Dependency.PreferDefaultFilename]); BeginUpdate(false); // search compatible package in opened packages ANode:=FindNodeOfDependency(Dependency,fpfSearchEverywhere); if (ANode<>nil) then begin // there is already a package that fits name and version APackage:=TLazPackage(ANode.Data); Dependency.RequiredPackage:=APackage; Dependency.LoadPackageResult:=lprSuccess; if pvPkgSearch in Verbosity then debugln(['Info: (lazarus) Open dependency ['+Dependency.PackageName+']: Success: was already loaded']); end; // load preferred package if (Dependency.DefaultFilename<>'') and Dependency.PreferDefaultFilename then begin PreferredFilename:=Dependency.FindDefaultFilename; //debugln(['TLazPackageGraph.OpenDependency checking preferred Prefer=',PreferredFilename]); if (PreferredFilename<>'') and ((Dependency.RequiredPackage=nil) or ((Dependency.RequiredPackage.FindUsedByDepPrefer(Dependency)=nil) and (CompareFilenames(PreferredFilename,Dependency.RequiredPackage.Filename)<>0))) then begin if pvPkgSearch in Verbosity then debugln(['Info: (lazarus) Open dependency ['+Dependency.PackageName+']: trying resolved preferred filename: "'+PreferredFilename+'" ...']); OpenFile(PreferredFilename); end; end; if Dependency.LoadPackageResult=lprUndefined then begin // no compatible package yet open Dependency.RequiredPackage:=nil; Dependency.LoadPackageResult:=lprNotFound; APackage:=FindPackageWithName(Dependency.PackageName,nil); if APackage=nil then begin // no package with same name open // -> try package links IgnoreFiles:=nil; try repeat PkgLink:=PkgLinks.FindLinkWithDependency(Dependency,IgnoreFiles); if (PkgLink=nil) then break; //debugln(['TLazPackageGraph.OpenDependency PkgLink=',PkgLink.GetEffectiveFilename,' global=',PkgLink.Origin=ploGlobal]); PkgLink.Reference; try MsgResult:=OpenDependencyWithPackageLink(Dependency,PkgLink,ShowAbort); if MsgResult=mrOk then break; if IgnoreFiles=nil then IgnoreFiles:=TFilenameToStringTree.Create(false); IgnoreFiles[PkgLink.GetEffectiveFilename]:='1'; PkgLinks.RemoveUserLink(PkgLink); finally PkgLink.Release; end; until MsgResult=mrAbort; finally IgnoreFiles.Free; end; // try defaultfilename if (Dependency.LoadPackageResult=lprNotFound) and (Dependency.DefaultFilename<>'') then begin AFilename:=Dependency.FindDefaultFilename; if AFilename<>'' then begin if pvPkgSearch in Verbosity then debugln(['Info: (lazarus) Open dependency ['+Dependency.PackageName+']: trying resolved default filename: "'+PreferredFilename+'" ...']); OpenFile(AFilename); end; end; // try in owner directory (some projects put all their packages into // one directory) if Dependency.LoadPackageResult=lprNotFound then begin CurDir:=GetDependencyOwnerDirectory(Dependency); if (CurDir<>'') then begin if pvPkgSearch in Verbosity then debugln(['Info: (lazarus) Open dependency ['+Dependency.PackageName+']: trying in owner directory "'+AppendPathDelim(CurDir)+'" ...']); AFilename:=CodeToolBoss.DirectoryCachePool.FindDiskFilename( AppendPathDelim(CurDir)+Dependency.PackageName+'.lpk'); if FileExistsCached(AFilename) then begin OpenFile(AFilename); end; end; end; // try a package that provides this package if Dependency.LoadPackageResult=lprNotFound then begin for i:=0 to Count-1 do begin APackage:=Packages[i]; if APackage=Dependency.Owner then continue; if APackage.ProvidesPackage(Dependency.PackageName) then begin Dependency.RequiredPackage:=APackage; Dependency.LoadPackageResult:=lprSuccess; if pvPkgSearch in Verbosity then debugln(['Info: (lazarus) Open dependency ['+Dependency.PackageName+']: Success. Package "'+APackage.IDAsString+'" provides '+Dependency.AsString]); break; end; end; end; end else begin // there is already a package with this name, but wrong version open // -> unable to load this dependency due to conflict debugln('Error: (lazarus) Open dependency found incompatible package: searched for '+Dependency.AsString(true)+', but found '+APackage.IDAsString); if IsStaticBasePackage(APackage.Name) then begin debugln(['Note: (lazarus) LazarusDir="',EnvironmentOptions.GetParsedLazarusDirectory,'"']); // wrong base package if (EnvironmentOptions.LazarusDirectory='') or (not DirPathExistsCached(EnvironmentOptions.GetParsedLazarusDirectory)) then begin // the lazarus directory is not set debugln(['Note: (lazarus) The Lazarus directory is not set. Pass parameter --lazarusdir.']); end else if not DirPathExistsCached(PkgLinks.GetGlobalLinkDirectory) then begin debugln(['Note: (lazarus) The lpl directory is missing. Check that the Lazarus (--lazarusdir) directory is correct.']); end; end; if APackage.Missing then begin debugln(['Note: (lazarus) The lpk (',APackage.Filename,') is missing for dependency=',Dependency.AsString]) end; Dependency.LoadPackageResult:=lprLoadError; end; end; fChanged:=true; IncreaseBuildMacroChangeStamp; EndUpdate; end; Result:=Dependency.LoadPackageResult; end; function TLazPackageGraph.FindAlternativeLPK(APackage: TLazPackage): string; var IgnoreFiles: TFilenameToStringTree; procedure IgnoreLPK(LPKFilename: string); begin IgnoreFiles[LPKFilename]:='1'; end; function ParseLPK(var LPKFilename: string; Version: TPkgVersion): boolean; var Code: TCodeBuffer; XMLConfig: TXMLConfig; Path: String; FileVersion: Integer; begin Result:=false; LPKFilename:=TrimFilename(LPKFilename); if IgnoreFiles[LPKFilename]='1' then exit; IgnoreLPK(LPKFilename); if not FilenameIsAbsolute(LPKFilename) then exit; Code:=CodeToolBoss.LoadFile(LPKFilename,true,false); if Code=nil then exit; try XMLConfig:=TXMLConfig.CreateWithSource(LPKFilename,Code.Source); try Path:='Package/'; FileVersion:=XMLConfig.GetValue(Path+'Version',0); PkgVersionLoadFromXMLConfig(Version,XMLConfig,Path+'Version/',FileVersion); Result:=true; finally XMLConfig.Free; end; except on E: Exception do begin debugln(['Error: (lazarus) error reading "'+LPKFilename+'": '+E.Message]); end; end; end; var Dependency: TPkgDependency; Version: TPkgVersion; PkgLink: TPackageLink; Filename: String; BaseDir: String; begin Version:=TPkgVersion.Create; IgnoreFiles:=TFilenameToStringTree.Create(false); try // first check for preferred filenames in dependencies Dependency:=APackage.FirstUsedByDependency; while Dependency<>nil do begin if (Dependency.DefaultFilename<>'') and Dependency.PreferDefaultFilename then begin Result:=Dependency.FindDefaultFilename; if ParseLPK(Result,Version) then exit; end; Dependency:=Dependency.NextUsedByDependency; end; // find nearest package link to old lpk // for example // if old was /path/to/lazarus/comp/bla.lpk // then a /path/to/lazarus/comp/design/bla.lpk // is better than a /path/to/other/lazarus/comp/bla.lpk Dependency:=APackage.FirstUsedByDependency; if Dependency<>nil then begin Result:=''; BaseDir:=TrimFilename(APackage.Directory); repeat PkgLink:=PkgLinks.FindLinkWithDependency(Dependency,IgnoreFiles); if PkgLink=nil then break; Filename:=PkgLink.GetEffectiveFilename; if ParseLPK(Filename,Version) then begin // candidate found if (Result='') or (length(CreateRelativePath(Filename,BaseDir))'' then exit; end; // last check for default filenames in dependencies Dependency:=APackage.FirstUsedByDependency; while Dependency<>nil do begin if (Dependency.DefaultFilename<>'') and (not Dependency.PreferDefaultFilename) then begin Result:=Dependency.FindDefaultFilename; if ParseLPK(Result,Version) then exit; end; Dependency:=Dependency.NextUsedByDependency; end; // nothing found via dependencies // search in links PkgLink:=PkgLinks.FindLinkWithPkgName(APackage.Name,IgnoreFiles); if PkgLink<>nil then begin Result:=PkgLink.GetEffectiveFilename; exit; end; finally IgnoreFiles.Free; Version.Free; end; Result:=''; end; procedure TLazPackageGraph.OpenInstalledDependency(Dependency: TPkgDependency; InstallType: TPackageInstallType; var Quiet: boolean); var BrokenPackage: TLazPackage; CurResult: TModalResult; IsBasePkg: Boolean; begin OpenDependency(Dependency,false); if Dependency.LoadPackageResult<>lprSuccess then begin // a valid lpk file of the installed package can not be found IsBasePkg:=IsStaticBasePackage(Dependency.PackageName); // -> create a broken package BrokenPackage:=TLazPackage.Create; with BrokenPackage do begin BeginUpdate; Missing:=true; UserReadOnly:=true; Name:=Dependency.PackageName; Filename:=''; Version.SetValues(0,0,0,0); Author:='?'; License:='?'; AutoUpdate:=pupManually; Description:=lisPkgSysThisPackageIsInstalledButTheLpkFileWasNotFound; PackageType:=lptDesignTime; Installed:=pitStatic; AutoInstall:=pitNope; if IsBasePkg then AutoInstall:=pitStatic else AutoInstall:=pitNope; CompilerOptions.UnitOutputDirectory:=''; // add lazarus registration unit path UsageOptions.UnitPath:=''; Modified:=false; OnModifySilently:=@PkgModify; EndUpdate; end; AddPackage(BrokenPackage); //DebugLn('TLazPackageGraph.OpenInstalledDependency ',BrokenPackage.IDAsString,' ',dbgs(ord(BrokenPackage.AutoInstall))); if (not Quiet) and DirPathExistsCached(PkgLinks.GetGlobalLinkDirectory) then begin // tell the user CurResult:=IDEQuestionDialog(lisPkgSysPackageFileNotFound, Format(lisPkgSysThePackageIsInstalledButNoValidPackageFileWasFound, [BrokenPackage.Name, LineEnding]), mtError, [mrOk, mrYesToAll, lisSkipTheseWarnings]); if CurResult=mrYesToAll then Quiet:=true; end; // open it if OpenDependency(Dependency,false)<>lprSuccess then RaiseException('TLazPackageGraph.OpenInstalledDependency'); end; Dependency.RequiredPackage.Installed:=InstallType; end; procedure TLazPackageGraph.OpenRequiredDependencyList( FirstDependency: TPkgDependency); var Dependency: TPkgDependency; begin Dependency:=FirstDependency; while Dependency<>nil do begin OpenDependency(Dependency,false); Dependency:=Dependency.NextRequiresDependency; end; end; procedure TLazPackageGraph.MoveRequiredDependencyUp(ADependency: TPkgDependency); begin if (ADependency=nil) or (ADependency.Removed) or (ADependency.Owner=nil) or (ADependency.PrevRequiresDependency=nil) or (not (ADependency.Owner is TLazPackage)) then exit; BeginUpdate(true); TLazPackage(ADependency.Owner).MoveRequiredDependencyUp(ADependency); EndUpdate; end; procedure TLazPackageGraph.MoveRequiredDependencyDown(ADependency: TPkgDependency); begin if (ADependency=nil) or (ADependency.Removed) or (ADependency.Owner=nil) or (ADependency.NextRequiresDependency=nil) or (not (ADependency.Owner is TLazPackage)) then exit; BeginUpdate(true); TLazPackage(ADependency.Owner).MoveRequiredDependencyDown(ADependency); EndUpdate; end; procedure TLazPackageGraph.IterateComponentClasses(APackage: TLazPackage; Event: TIterateComponentClassesEvent; WithUsedPackages, WithRequiredPackages: boolean); var ARequiredPackage: TLazPackage; ADependency: TPkgDependency; begin APackage.IterateComponentClasses(Event,WithUsedPackages); // iterate through all required packages if WithRequiredPackages then begin ADependency:=APackage.FirstRequiredDependency; while ADependency<>nil do begin ARequiredPackage:=FindOpenPackage(ADependency,[fpfSearchInInstalledPckgs]); if ARequiredPackage<>nil then begin ARequiredPackage.IterateComponentClasses(Event,false); end; ADependency:=ADependency.NextRequiresDependency; end; end; end; procedure TLazPackageGraph.IterateAllComponentClasses( Event: TIterateComponentClassesEvent); var Cnt: Integer; i: Integer; begin Cnt:=Count; for i:=0 to Cnt-1 do IterateComponentClasses(Packages[i],Event,false,false); end; procedure TLazPackageGraph.IteratePackages(Flags: TFindPackageFlags; Event: TIteratePackagesEvent); var CurPkg: TLazPackage; i: Integer; begin // iterate opened packages for i:=0 to FItems.Count-1 do begin CurPkg:=Packages[i]; // check installed packages if ((fpfSearchInInstalledPckgs in Flags) and (CurPkg.Installed<>pitNope)) // check autoinstall packages or ((fpfSearchInAutoInstallPckgs in Flags) and (CurPkg.AutoInstall<>pitNope)) // check packages with opened editor or ((fpfSearchInPckgsWithEditor in Flags) and (CurPkg.Editor<>nil)) then begin Event(CurPkg); end; end; // iterate in package links if (fpfSearchInPkgLinks in Flags) then begin PkgLinks.IteratePackages(fpfPkgLinkMustExist in Flags,Event); end; end; procedure TLazPackageGraph.IteratePackagesSorted(Flags: TFindPackageFlags; Event: TIteratePackagesEvent); var ANode: TAVLTreeNode; CurPkg: TLazPackage; begin ANode:=FTree.FindLowest; while ANode<>nil do begin CurPkg:=TLazPackage(ANode.Data); // check installed packages if ((fpfSearchInInstalledPckgs in Flags) and (CurPkg.Installed<>pitNope)) // check autoinstall packages or ((fpfSearchInAutoInstallPckgs in Flags) and (CurPkg.AutoInstall<>pitNope)) // check packages with opened editor or ((fpfSearchInPckgsWithEditor in Flags) and (CurPkg.Editor<>nil)) then Event(CurPkg); ANode:=FTree.FindSuccessor(ANode); end; end; procedure TLazPackageGraph.GetAllRequiredPackages(APackage: TLazPackage; FirstDependency: TPkgDependency; out List: TFPList; Flags: TPkgIntfRequiredFlags; MinPolicy: TPackageUpdatePolicy); // returns packages in topological order, beginning with the top level package procedure GetTopologicalOrder(CurDependency: TPkgDependency; out HighestLevel: integer); var RequiredPackage: TLazPackage; Dependency: TPkgDependency; DepLevel: integer; begin HighestLevel:=0; while CurDependency<>nil do begin Dependency:=CurDependency; CurDependency:=CurDependency.NextRequiresDependency; //debugln('TLazPackageGraph.GetAllRequiredPackages A ',Dependency.AsString,' ',dbgs(ord(Dependency.LoadPackageResult)),' ',dbgs(ord(lprSuccess))); if Dependency.LoadPackageResult<>lprSuccess then continue; //debugln('TLazPackageGraph.GetAllRequiredPackages B ',Dependency.AsString); RequiredPackage:=Dependency.RequiredPackage; if (lpfVisited in RequiredPackage.Flags) then begin // already visited if HighestLevelnil then begin FirstDependency:=APackage.FirstRequiredDependency; APackage.Flags:=APackage.Flags+[lpfVisited]; end; // create topological list, beginning with the leaves GetTopologicalOrder(FirstDependency,DepLevel); if List=nil then exit; MergeSort(List,@CompareLazPackageTopologicallyAndName); if not (pirCompileOrder in Flags) then begin // reverse list order i:=0; j:=List.Count-1; while inil do begin Pkg1:=Dependency1.RequiredPackage; if Pkg1<>nil then begin // add connection between owner and required package if OwnerPackage<>nil then AddConnection(OwnerPackage,Pkg1); // add connections between any two direct required packages Dependency2:=StartDependency; while Dependency2<>nil do begin Pkg2:=Dependency2.RequiredPackage; if Pkg2<>nil then AddConnection(Pkg1,Pkg2); Dependency2:=Dependency2.NextDependency[pdlRequires]; end; end; Dependency1:=Dependency1.NextDependency[pdlRequires]; end; end; var i: Integer; Pkg: TLazPackage; begin if Tree<>nil then Tree.FreeAndClear; GetAllRequiredPackages(nil,FirstDependency,PkgList); if PkgList=nil then exit; AddConnections(FirstDependency); for i:=0 to PkgList.Count-1 do begin Pkg:=TLazPackage(PkgList[i]); AddConnections(Pkg.FirstRequiredDependency); end; end; initialization PackageGraph:=nil; end.