mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-24 09:28:14 +02:00
4584 lines
159 KiB
ObjectPascal
4584 lines
159 KiB
ObjectPascal
{ $Id$ }
|
|
{
|
|
/***************************************************************************
|
|
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 <http://www.gnu.org/copyleft/gpl.html>. 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, FileProcs, FileUtil, LCLProc, Forms, Controls, Dialogs,
|
|
// codetools
|
|
AVL_Tree, Laz_XMLCfg, DefineTemplates, CodeCache, BasicCodeTools,
|
|
NonPascalCodeTools, SourceChanger, CodeToolManager,
|
|
// IDEIntf,
|
|
SrcEditorIntf, IDEExternToolIntf, IDEDialogs, IDEMsgIntf, PackageIntf,
|
|
LazIDEIntf,
|
|
// package registration
|
|
LazarusPackageIntf,
|
|
// IDE
|
|
LazarusIDEStrConsts, EnvironmentOpts, IDEProcs, LazConf, TransferMacros,
|
|
DialogProcs, IDETranslations, CompilerOptions, PackageLinks, PackageDefs,
|
|
ComponentReg, RegisterFCL, RegisterLCL, RegisterSynEdit, RegisterIDEIntf;
|
|
|
|
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
|
|
);
|
|
|
|
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;
|
|
TEndUpdateEvent = 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;
|
|
|
|
{ TLazPackageGraph }
|
|
|
|
TLazPackageGraph = class
|
|
private
|
|
FAbortRegistration: boolean;
|
|
fChanged: boolean;
|
|
FCodeToolsPackage: TLazPackage;
|
|
FDefaultPackage: TLazPackage;
|
|
FErrorMsg: string;
|
|
FFCLPackage: TLazPackage;
|
|
FIDEIntfPackage: TLazPackage;
|
|
FItems: TFPList; // unsorted list of TLazPackage
|
|
FLazarusBasePackages: TFPList;
|
|
FLCLPackage: TLazPackage;
|
|
FOnAddPackage: TPkgAddedEvent;
|
|
FOnBeginUpdate: TNotifyEvent;
|
|
FOnChangePackageName: TPkgChangeNameEvent;
|
|
FOnDeleteAmbiguousFiles: TPkgDeleteAmbiguousFiles;
|
|
FOnDeletePackage: TPkgDeleteEvent;
|
|
FOnDependencyModified: TDependencyModifiedEvent;
|
|
FOnEndUpdate: TEndUpdateEvent;
|
|
FOnTranslatePackage: TPkgTranslate;
|
|
FOnUninstallPackage: TPkgUninstall;
|
|
FRegistrationFile: TPkgFile;
|
|
FRegistrationPackage: TLazPackage;
|
|
FRegistrationUnitName: string;
|
|
FSynEditPackage: TLazPackage;
|
|
FLazControlsPackage: TLazPackage;
|
|
FTree: TAVLTree; // sorted tree of TLazPackage
|
|
FUpdateLock: integer;
|
|
function CreateFCLPackage: TLazPackage;
|
|
function CreateLCLPackage: TLazPackage;
|
|
function CreateSynEditPackage: TLazPackage;
|
|
function CreateLazControlsPackage: TLazPackage;
|
|
function CreateCodeToolsPackage: TLazPackage;
|
|
function CreateIDEIntfPackage: TLazPackage;
|
|
function CreateDefaultPackage: TLazPackage;
|
|
function CreateLazarusBasePackage(PkgName: string): TLazPackage;
|
|
function GetCount: Integer;
|
|
function GetPackages(Index: integer): TLazPackage;
|
|
procedure DoDependencyChanged(Dependency: TPkgDependency);
|
|
procedure SetAbortRegistration(const AValue: boolean);
|
|
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(const Msg, Directory: string);
|
|
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 Data: PtrInt;
|
|
var Abort: boolean): string;
|
|
function MacroFunctionPkgSrcPath(const s: string; const Data: PtrInt;
|
|
var Abort: boolean): string;
|
|
function MacroFunctionPkgUnitPath(const s: string; const Data: PtrInt;
|
|
var Abort: boolean): string;
|
|
function MacroFunctionPkgIncPath(const s: string; const Data: PtrInt;
|
|
var Abort: boolean): string;
|
|
function MacroFunctionCTPkgDir(Data: Pointer): boolean;
|
|
function MacroFunctionCTPkgSrcPath(Data: Pointer): boolean;
|
|
function MacroFunctionCTPkgUnitPath(Data: Pointer): boolean;
|
|
function MacroFunctionCTPkgIncPath(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 FindAPackageWithName(const PkgName: string;
|
|
IgnorePackage: TLazPackage): TLazPackage;
|
|
function FindBrokenDependencyPath(APackage: TLazPackage;
|
|
FirstDependency: TPkgDependency): TFPList;
|
|
function FindAllBrokenDependencies(APackage: TLazPackage;
|
|
FirstDependency: TPkgDependency): TFPList;
|
|
function FindCircleDependencyPath(APackage: TLazPackage;
|
|
FirstDependency: TPkgDependency): TFPList;
|
|
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;
|
|
var File1, File2: TPkgFile;
|
|
var 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, FindNewFile: 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 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 FindUnit(StartPackage: TLazPackage; const TheUnitName: string;
|
|
WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile;
|
|
function FindUnitInAllPackages(const TheUnitName: string;
|
|
IgnoreDeleted: boolean): TPkgFile;
|
|
function PackageCanBeReplaced(OldPackage, NewPackage: TLazPackage): boolean;
|
|
function PackageIsNeeded(APackage: TLazPackage): boolean;
|
|
function PackageNameExists(const PkgName: string;
|
|
IgnorePackage: TLazPackage): boolean;
|
|
procedure GetAllRequiredPackages(FirstDependency: TPkgDependency;
|
|
out List: TFPList); // for single search use FindDependencyRecursively
|
|
procedure GetConnectionsTree(FirstDependency: TPkgDependency;
|
|
var PkgList: TFPList; var Tree: TPkgPairTree);
|
|
function GetAutoCompilationOrder(APackage: TLazPackage;
|
|
FirstDependency: TPkgDependency;
|
|
Policies: TPackageUpdatePolicies): TFPList;
|
|
function GetBrokenDependenciesWhenChangingPkgID(APackage: TLazPackage;
|
|
const NewName: string; NewVersion: TPkgVersion): TFPList;
|
|
procedure GetPackagesChangedOnDisk(var ListOfPackages: TFPList);
|
|
procedure CalculateTopologicalLevels;
|
|
procedure SortDependencyListTopologically(
|
|
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(OldPackage, NewPackage: TLazPackage);
|
|
procedure ClosePackage(APackage: TLazPackage);
|
|
procedure CloseUnneededPackages;
|
|
procedure ChangePackageID(APackage: TLazPackage;
|
|
const NewName: string; NewVersion: TPkgVersion;
|
|
RenameDependencies: boolean);
|
|
function SavePackageCompiledState(APackage: TLazPackage;
|
|
const CompilerFilename, CompilerParams: string;
|
|
Complete, ShowAbort: boolean): TModalResult;
|
|
function LoadPackageCompiledState(APackage: TLazPackage;
|
|
IgnoreErrors, ShowAbort: boolean): TModalResult;
|
|
function CheckCompileNeedDueToDependencies(FirstDependency: TPkgDependency;
|
|
StateFileAge: longint): TModalResult;
|
|
function ExtractCompilerParamsForBuildAll(const CompParams: string): string;
|
|
function CheckIfPackageNeedsCompilation(APackage: TLazPackage;
|
|
const CompilerFilename, CompilerParams, SrcFilename: string;
|
|
out NeedBuildAllFlag: boolean): TModalResult;
|
|
function PreparePackageOutputDirectory(APackage: TLazPackage;
|
|
CleanUp: boolean): TModalResult;
|
|
function CheckAmbiguousPackageUnits(APackage: TLazPackage): TModalResult;
|
|
function SavePackageMainSource(APackage: TLazPackage;
|
|
Flags: TPkgCompileFlags; ShowAbort: boolean): TModalResult;
|
|
function CompileRequiredPackages(APackage: TLazPackage;
|
|
FirstDependency: TPkgDependency;
|
|
Globals: TGlobalCompilerOptions;
|
|
Policies: TPackageUpdatePolicies): TModalResult;
|
|
function CompilePackage(APackage: TLazPackage; Flags: TPkgCompileFlags;
|
|
ShowAbort: boolean;
|
|
Globals: TGlobalCompilerOptions = nil): TModalResult;
|
|
function ConvertPackageRSTFiles(APackage: TLazPackage): TModalResult;
|
|
function WriteMakeFile(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;
|
|
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 SetAbortRegistration;
|
|
property ErrorMsg: string read FErrorMsg write FErrorMsg;
|
|
|
|
property FCLPackage: TLazPackage read FFCLPackage;
|
|
property LCLPackage: TLazPackage read FLCLPackage;
|
|
property SynEditPackage: TLazPackage read FSynEditPackage;
|
|
property LazControlsPackage: TLazPackage read FLazControlsPackage;
|
|
property CodeToolsPackage: TLazPackage read FCodeToolsPackage;
|
|
property IDEIntfPackage: TLazPackage read FIDEIntfPackage;
|
|
property LazarusBasePackages: TFPList read FLazarusBasePackages;
|
|
property DefaultPackage: TLazPackage read FDefaultPackage;// fall back package for buggy/obsoleted stuff
|
|
|
|
property OnAddPackage: TPkgAddedEvent read FOnAddPackage write FOnAddPackage;
|
|
property OnBeginUpdate: TNotifyEvent read FOnBeginUpdate write FOnBeginUpdate;
|
|
property OnChangePackageName: TPkgChangeNameEvent read FOnChangePackageName
|
|
write FOnChangePackageName;
|
|
property OnDependencyModified: TDependencyModifiedEvent
|
|
read FOnDependencyModified write FOnDependencyModified;
|
|
property OnDeletePackage: TPkgDeleteEvent read FOnDeletePackage
|
|
write FOnDeletePackage;
|
|
property OnEndUpdate: TEndUpdateEvent 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 Packages[Index: integer]: TLazPackage read GetPackages; default; // see Count for the number
|
|
property RegistrationFile: TPkgFile read FRegistrationFile;
|
|
property RegistrationPackage: TLazPackage read FRegistrationPackage
|
|
write SetRegistrationPackage;
|
|
property RegistrationUnitName: string read FRegistrationUnitName;
|
|
property UpdateLock: integer read FUpdateLock;
|
|
end;
|
|
|
|
var
|
|
PackageGraph: TLazPackageGraph = nil;
|
|
|
|
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;
|
|
|
|
{ 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.SetAbortRegistration(const AValue: boolean);
|
|
begin
|
|
if FAbortRegistration=AValue then exit;
|
|
FAbortRegistration:=AValue;
|
|
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 not FileExistsUTF8(AFilename) then begin
|
|
DebugLn('invalid Package Link: file "'+AFilename+'" does not exist.');
|
|
PkgLink.FileDateValid:=false;
|
|
exit(mrCancel);
|
|
end;
|
|
try
|
|
PkgLink.FileDate:=FileDateToDateTime(FileAgeUTF8(AFilename));
|
|
PkgLink.FileDateValid:=true;
|
|
XMLConfig:=TXMLConfig.Create(nil);
|
|
NewPackage:=TLazPackage.Create;
|
|
NewPackage.Filename:=AFilename;
|
|
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('unable to read file "'+AFilename+'" ',E.Message);
|
|
Result:=mrCancel;
|
|
exit;
|
|
end;
|
|
end;
|
|
if not NewPackage.MakeSense then begin
|
|
DebugLn('invalid Package file "'+AFilename+'".');
|
|
exit(mrCancel);
|
|
end;
|
|
if SysUtils.CompareText(PkgLink.Name,NewPackage.Name)<>0 then exit;
|
|
// ok
|
|
Result:=mrOk;
|
|
Dependency.RequiredPackage:=NewPackage;
|
|
Dependency.LoadPackageResult:=lprSuccess;
|
|
OldPackage:=FindAPackageWithName(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(const Msg, Directory: string);
|
|
begin
|
|
if Assigned(IDEMessagesWindow) then
|
|
IDEMessagesWindow.AddMsg(Msg, Directory,-1)
|
|
else
|
|
DebugLn(['TLazPackageGraph.AddMessage Msg="',Msg,'" Directory="',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','',
|
|
'package directory. parameter is package id.',@MacroFunctionPkgDir,[]));
|
|
GlobalMacroList.Add(TTransferMacro.Create('PKGSRCPATH','',
|
|
'package source search path. parameter is package id.',
|
|
@MacroFunctionPkgSrcPath,[]));
|
|
GlobalMacroList.Add(TTransferMacro.Create('PKGUNITATH','',
|
|
'package unit search path. parameter is package id.',
|
|
@MacroFunctionPkgUnitPath,[]));
|
|
GlobalMacroList.Add(TTransferMacro.Create('PKGINCPATH','',
|
|
'package include files search path. parameter is package id.',
|
|
@MacroFunctionPkgIncPath,[]));
|
|
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);
|
|
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
|
|
BeginUpdate(true);
|
|
CurPkg:=Packages[Index];
|
|
CurPkg.Flags:=CurPkg.Flags+[lpfDestroying];
|
|
CurPkg.DefineTemplates.Active:=false;
|
|
|
|
if Assigned(OnDeletePackage) then OnDeletePackage(CurPkg);
|
|
|
|
if CurPkg=FCLPackage then
|
|
FFCLPackage:=nil
|
|
else if CurPkg=LCLPackage then
|
|
FLCLPackage:=nil
|
|
else if CurPkg=IDEIntfPackage then
|
|
FIDEIntfPackage:=nil
|
|
else if CurPkg=SynEditPackage then
|
|
FSynEditPackage:=nil
|
|
else if CurPkg=LazControlsPackage then
|
|
FLazControlsPackage:=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;
|
|
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 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.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.SourceDirectories.CreateSearchPathFromAllFiles;
|
|
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.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: TLazPackageGraph.GetPackageFromMacroParameter unknown package id "',TheID,'" PkgID.IDAsString="',PkgID.IDAsString,'"');
|
|
end;
|
|
end else begin
|
|
APackage:=nil;
|
|
DebugLn('WARNING: TLazPackageGraph.GetPackageFromMacroParameter invalid 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.FindAPackageWithName(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
|
|
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
|
|
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
|
|
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.FindFileInAllPackages(const TheFilename: string;
|
|
IgnoreDeleted, FindNewFile: boolean): TPkgFile;
|
|
var
|
|
Cnt: Integer;
|
|
i: Integer;
|
|
begin
|
|
Cnt:=Count;
|
|
for i:=0 to Cnt-1 do begin
|
|
Result:=Packages[i].FindPkgFile(TheFilename,IgnoreDeleted,
|
|
FindNewFile);
|
|
if Result<>nil then exit;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
procedure TLazPackageGraph.FindPossibleOwnersOfUnit(const TheFilename: string;
|
|
OwnerList: TFPList);
|
|
var
|
|
Cnt: Integer;
|
|
i: Integer;
|
|
APackage: TLazPackage;
|
|
PkgDirs: String;
|
|
SrcDir: String;
|
|
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 + base directory
|
|
PkgDirs:=APackage.CompilerOptions.GetParsedPath(pcosUnitPath,icoNone,false);
|
|
PkgDirs:=MergeSearchPaths(PkgDirs,APackage.SourceDirectories.CreateSearchPathFromAllFiles);
|
|
PkgDirs:=MergeSearchPaths(PkgDirs,APackage.Directory);
|
|
if FindPathInSearchPath(PChar(SrcDir),length(SrcDir),
|
|
PChar(PkgDirs),length(PkgDirs))<>nil
|
|
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;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FindUnitInAllPackages(Prefix,false)=nil then
|
|
Result:=Prefix
|
|
else begin
|
|
i:=1;
|
|
repeat
|
|
Result:=Prefix+IntToStr(i);
|
|
until FindUnitInAllPackages(Result,false)=nil;
|
|
end;
|
|
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;
|
|
|
|
function TLazPackageGraph.DependencyExists(Dependency: TPkgDependency;
|
|
Flags: TFindPackageFlags): boolean;
|
|
begin
|
|
Result:=true;
|
|
if FindNodeOfDependency(Dependency,Flags)<>nil then exit;
|
|
if FindAPackageWithName(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.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('');
|
|
exit;
|
|
end;
|
|
try
|
|
// check unitname
|
|
FRegistrationUnitName:=TheUnitName;
|
|
if not IsValidIdent(FRegistrationUnitName) then begin
|
|
RegistrationError(Format(lisPkgSysInvalidUnitname, [FRegistrationUnitName]
|
|
));
|
|
exit;
|
|
end;
|
|
// check unit file
|
|
FRegistrationFile:=FRegistrationPackage.FindUnit(FRegistrationUnitName,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(lisPkgSysUnitNotFound, ['"',
|
|
FRegistrationUnitName, '"']));
|
|
end else begin
|
|
if not (pffReportedAsRemoved in FRegistrationFile.Flags) then begin
|
|
RegistrationError(
|
|
Format(lisPkgSysUnitWasRemovedFromPackage, ['"',
|
|
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;
|
|
NewPkgComponent:=
|
|
FRegistrationPackage.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;
|
|
begin
|
|
// create nice and useful error message
|
|
|
|
// current registration package
|
|
if FRegistrationPackage=nil then begin
|
|
ErrorMsg:=lisPkgSysRegisterUnitWasCalledButNoPackageIsRegistering;
|
|
end else begin
|
|
ErrorMsg:='Package: "'+FRegistrationPackage.IDAsString+'"';
|
|
// current unitname
|
|
if FRegistrationUnitName<>'' then
|
|
ErrorMsg:=Format(lisPkgSysUnitName, [ErrorMsg, #13, '"',
|
|
FRegistrationUnitName, '"']);
|
|
// current file
|
|
if FRegistrationFile<>nil then
|
|
ErrorMsg:=Format(lisPkgSysFileName, [ErrorMsg, #13, '"',
|
|
FRegistrationFile.Filename, '"']);
|
|
end;
|
|
// append message
|
|
if Msg<>'' then
|
|
ErrorMsg:=ErrorMsg+#13#13+Msg;
|
|
// tell user
|
|
DlgResult:=MessageDlg(lisPkgSysRegistrationError,
|
|
ErrorMsg,mtError,[mbIgnore,mbAbort],0);
|
|
if DlgResult=mrAbort then
|
|
AbortRegistration:=true;
|
|
end;
|
|
|
|
function TLazPackageGraph.CreateFCLPackage: TLazPackage;
|
|
begin
|
|
Result:=TLazPackage.Create;
|
|
with Result do begin
|
|
AutoCreated:=true;
|
|
Name:='FCL';
|
|
Filename:=SetDirSeparators('$(FPCSrcDir)/');
|
|
Version.SetValues(1,0,0,0);
|
|
Author:='FPC team';
|
|
License:='LGPL-2';
|
|
AutoInstall:=pitStatic;
|
|
AutoUpdate:=pupManually;
|
|
Description:=lisPkgSysTheFCLFreePascalComponentLibraryProvidesTheBase;
|
|
PackageType:=lptRunAndDesignTime;
|
|
Installed:=pitStatic;
|
|
CompilerOptions.UnitOutputDirectory:='';
|
|
Translated:=SystemLanguageID1;
|
|
AddToProjectUsesSection:=false;
|
|
|
|
// add lazarus registration unit path
|
|
UsageOptions.UnitPath:=SetDirSeparators(
|
|
'$(LazarusDir)/packager/units/$(TargetCPU)-$(TargetOS)');
|
|
|
|
CompilerOptions.CustomOptions:='$(IDEBuildOptions)';
|
|
|
|
// add registering units
|
|
AddFile(SetDirSeparators('packages/fcl-db/src/base/db.pas'),'DB',pftUnit,[],cpBase);
|
|
AddFile(SetDirSeparators('packages/fcl-process/src/process.pp'),'Process',pftUnit,[],cpBase);
|
|
AddFile(SetDirSeparators('packages/fcl-process/src/simpleipc.pp'),'SimpleIPC',pftUnit,[],cpBase);
|
|
AddFile(SetDirSeparators('packages/fcl-xml/src/xmlcfg.pp'),'XMLCfg',pftUnit,[],cpBase);
|
|
AddFile(SetDirSeparators('packages/fcl-base/src/eventlog.pp'),'EventLog',pftUnit,[],cpBase);
|
|
|
|
// use the packager/units/lazaruspackageintf.o file as indicator,
|
|
// if FCL has been recompiled
|
|
OutputStateFile:=SetDirSeparators(
|
|
'$(LazarusDir)/packager/units/$(TargetCPU)-$(TargetOS)/lazaruspackageintf.o');
|
|
|
|
Modified:=false;
|
|
end;
|
|
end;
|
|
|
|
function TLazPackageGraph.CreateLCLPackage: TLazPackage;
|
|
|
|
procedure AddLCLLinkPaths(UsageOptions: TAdditionalCompilerOptions);
|
|
var
|
|
NewPath: string;
|
|
OldLibPath: String;
|
|
begin
|
|
NewPath:=GetDefaultLCLLibPaths('','',';');
|
|
OldLibPath:=UsageOptions.LibraryPath;
|
|
if OldLibPath<>'' then OldLibPath:=OldLibPath+';';
|
|
OldLibPath:=OldLibPath+NewPath;
|
|
UsageOptions.LibraryPath:=NewPath;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=TLazPackage.Create;
|
|
with Result do begin
|
|
AutoCreated:=true;
|
|
Name:='LCL';
|
|
Filename:=SetDirSeparators('$(LazarusDir)/lcl/');
|
|
Version.SetValues(1,0,0,0);
|
|
Author:='Lazarus';
|
|
License:='modified LGPL-2';
|
|
AutoInstall:=pitStatic;
|
|
AutoUpdate:=pupManually;
|
|
Description:=lisPkgSysTheLCLLazarusComponentLibraryContainsAllBase;
|
|
PackageType:=lptRunAndDesignTime;
|
|
Installed:=pitStatic;
|
|
CompilerOptions.OtherUnitFiles:='$(LazarusDir)/lcl/';
|
|
CompilerOptions.OtherUnitFiles:='$(LazarusDir)/lcl/widgetset/';
|
|
CompilerOptions.UnitOutputDirectory:='$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/';
|
|
POOutputDirectory:='languages';
|
|
Translated:=SystemLanguageID1;
|
|
LazDocPaths:=SetDirSeparators('$(LazarusDir)/docs/xml/lcl');
|
|
AddToProjectUsesSection:=false;
|
|
|
|
// add requirements
|
|
AddRequiredDependency(FCLPackage.CreateDependencyWithOwner(Result));
|
|
|
|
// register files
|
|
{$I pkgfileslcl.inc}
|
|
|
|
// add issues files
|
|
AddFile('interfaces/carbon/issues.xml','carbon-issues.xml',pftIssues,[],cpBase);
|
|
AddFile('interfaces/win32/issues.xml','win32-issues.xml',pftIssues,[],cpBase);
|
|
AddFile('interfaces/gtk/issues.xml','gtk-issues.xml',pftIssues,[],cpBase);
|
|
AddFile('interfaces/gtk2/issues.xml','gtk2-issues.xml',pftIssues,[],cpBase);
|
|
AddFile('interfaces/qt/issues.xml','qt-issues.xml',pftIssues,[],cpBase);
|
|
|
|
// increase priority by one, so that the LCL components are inserted to the
|
|
// left in the palette
|
|
for i:=0 to FileCount-1 do
|
|
inc(Files[i].ComponentPriority.Level);
|
|
|
|
// add unit paths
|
|
UsageOptions.UnitPath:=SetDirSeparators(
|
|
'$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS);'
|
|
+'$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)');
|
|
UsageOptions.CustomOptions:='-dLCL -dLCL$(LCLWidgetType)';
|
|
// add include path
|
|
CompilerOptions.IncludePath:=SetDirSeparators(
|
|
'$(LazarusDir)/lcl/include;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)');
|
|
AddLCLLinkPaths(UsageOptions);
|
|
CompilerOptions.CustomOptions:='$(IDEBuildOptions)';
|
|
|
|
// use the lcl/units/$(TargetCPU)-$(TargetOS)/alllclunits.o
|
|
// file as indicator, if LCL has been recompiled
|
|
OutputStateFile:=SetDirSeparators(
|
|
'$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/alllclunits.o');
|
|
|
|
Modified:=false;
|
|
end;
|
|
end;
|
|
|
|
function TLazPackageGraph.CreateSynEditPackage: TLazPackage;
|
|
begin
|
|
Result:=TLazPackage.Create;
|
|
with Result do begin
|
|
AutoCreated:=true;
|
|
Name:='SynEdit';
|
|
Filename:=SetDirSeparators('$(LazarusDir)/components/synedit/');
|
|
Version.SetValues(1,0,0,0);
|
|
Author:='SynEdit - http://sourceforge.net/projects/synedit/';
|
|
License:='LGPL-2';
|
|
AutoInstall:=pitStatic;
|
|
AutoUpdate:=pupManually;
|
|
Description:=lisPkgSysSynEditTheEditorComponentUsedByLazarus;
|
|
PackageType:=lptRunAndDesignTime;
|
|
Installed:=pitStatic;
|
|
CompilerOptions.UnitOutputDirectory:='';
|
|
POOutputDirectory:='languages';
|
|
Translated:=SystemLanguageID1;
|
|
LazDocPaths:=SetDirSeparators('$(LazarusDir)/components/synedit/docs/xml');
|
|
AddToProjectUsesSection:=false;
|
|
|
|
// add requirements
|
|
AddRequiredDependency(LCLPackage.CreateDependencyWithOwner(Result));
|
|
AddRequiredDependency(IDEIntfPackage.CreateDependencyWithOwner(Result));
|
|
|
|
// add units
|
|
AddFile('synedit.pp','SynEdit',pftUnit,[],cpBase);
|
|
AddFile('synedit.inc','',pftInclude,[],cpBase);
|
|
AddFile('syneditkeycmds.pp','SynEditKeyCmds',pftUnit,[],cpBase);
|
|
AddFile('syneditmousecmds.pp','SynEditMouseCmds',pftUnit,[],cpBase);
|
|
AddFile('syncompletion.pas','SynCompletion',pftUnit,[],cpBase);
|
|
AddFile('syneditautocomplete.pp','SynEditAutoComplete',pftUnit,[],cpBase);
|
|
AddFile('synmacrorecorder.pas','SynMacroRecorder',pftUnit,[],cpBase);
|
|
AddFile('synmemo.pas','SynMemo',pftUnit,[],cpBase);
|
|
AddFile('syneditsearch.pp','SynEditSearch',pftUnit,[],cpBase);
|
|
AddFile('syneditplugins.pas','SynEditPlugins',pftUnit,[],cpBase);
|
|
AddFile('syneditregexsearch.pas','SynEditRegExSearch',pftUnit,[],cpBase);
|
|
AddFile('synedittypes.pp','SynEditTypes',pftUnit,[],cpBase);
|
|
AddFile('syneditstrconst.pp','SynEditStrConst',pftUnit,[],cpBase);
|
|
AddFile('syneditexport.pas','SynEditExport',pftUnit,[],cpBase);
|
|
AddFile('synexporthtml.pas','SynExportHTML',pftUnit,[],cpBase);
|
|
AddFile('syneditmiscclasses.pp','SynEditMiscClasses',pftUnit,[],cpBase);
|
|
AddFile('syneditmiscprocs.pp','SynEditMiscProcs',pftUnit,[],cpBase);
|
|
AddFile('synbeautifier.pas','SynBeautifier',pftUnit,[],cpBase);
|
|
AddFile('synbeautifierpas.pas','SynBeautifierPas',pftUnit,[],cpBase);
|
|
AddFile('syneditmarks.pp','SynEditMarks',pftUnit,[],cpBase);
|
|
AddFile('synregexpr.pas','SynRegExpr',pftUnit,[],cpBase);
|
|
AddFile('syntextdrawer.pp','SynTextDrawer',pftUnit,[],cpBase);
|
|
AddFile('syneditpointclasses.pas','SynEditPointClasses',pftUnit,[],cpBase);
|
|
|
|
AddFile('syneditlines.pp','SynEditLines',pftUnit,[],cpBase);
|
|
AddFile('synedittextbase.pas','SynEditTextBase',pftUnit,[],cpBase);
|
|
AddFile('synedittextbuffer.pp','SynEditTextBuffer',pftUnit,[],cpBase);
|
|
AddFile('synedittextdoublewidthchars.pas','SynEditTextDoubleWidthChars',pftUnit,[],cpBase);
|
|
AddFile('synedittexttabexpander.pas','SynEditTextTabExpander',pftUnit,[],cpBase);
|
|
AddFile('synedittexttrimmer.pas','SynEditTextTrimmer',pftUnit,[],cpBase);
|
|
AddFile('syneditfoldedview.pp','SynEditTextTrimmer',pftUnit,[],cpBase);
|
|
|
|
AddFile('syneditmarkup.pp','SynEditMarkup',pftUnit,[],cpBase);
|
|
AddFile('syneditmarkupctrlmouselink.pp','SynEditMarkupCtrlMouseLink',pftUnit,[],cpBase);
|
|
AddFile('syneditmarkupselection.pp','SynEditMarkupSelection',pftUnit,[],cpBase);
|
|
AddFile('syneditmarkupspecialline.pp','SynEditMarkupSpecialLine',pftUnit,[],cpBase);
|
|
AddFile('syneditmarkupwordgroup.pp','SynEditMarkupWordGroup',pftUnit,[],cpBase);
|
|
AddFile('syneditmarkupbracket.pp','SynEditMarkupBracket',pftUnit,[],cpBase);
|
|
AddFile('syneditmarkuphighall.pp','SynEditMarkupHighAll',pftUnit,[],cpBase);
|
|
|
|
AddFile('synedithighlighter.pp','SynEditHighlighter',pftUnit,[],cpBase);
|
|
AddFile('synedithighlighterfoldbase.pp','SynEditHighlighterFoldBase',pftUnit,[],cpBase);
|
|
AddFile('synedithighlighterxmlbase.pas','SynEditHighlighterXMLBase',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterpas.pp','SynHighlighterPas',pftUnit,[],cpBase);
|
|
AddFile('synhighlightercpp.pp','SynHighlighterCPP',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterjava.pas','SynHighlighterJava',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterperl.pas','SynHighlighterPerl',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterhtml.pp','SynHighlighterHTML',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterxml.pas','SynHighlighterXML',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterlfm.pas','SynHighlighterLFM',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterdiff.pas','SynHighlighterDiff',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterunixshellscript.pas','SynHighlighterUNIXShellScript',
|
|
pftUnit,[],cpBase);
|
|
AddFile('synhighlightermulti.pas','SynHighlighterMulti',pftUnit,[],cpBase);
|
|
AddFile('synhighlightercss.pas','SynHighlighterCss',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterphp.pas','SynHighlighterPHP',pftUnit,[],cpBase);
|
|
AddFile('synhighlightertex.pas','SynHighlighterTeX',pftUnit,[],cpBase);
|
|
AddFile('synhighlightersql.pas','SynHighlighterSQL',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterpython.pas','SynHighlighterPython',pftUnit,[],cpBase);
|
|
AddFile('synhighlightervb.pas','SynHighlighterVB',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterany.pas','SynHighlighterAny',pftUnit,[],cpBase);
|
|
AddFile('synhighlighterhashentries.pas', 'SynHighlighterHashEntries', pftUnit,[], cpBase);
|
|
AddFile('synhighlighterjscript.pas', 'SynHighlighterJScript', pftUnit,[], cpBase);
|
|
AddFile('synhighlighterposition.pas', 'TSynPositionHighlighter', pftUnit,[], cpBase);
|
|
|
|
AddFile('syngutter.pas','SynGutter',pftUnit,[],cpBase);
|
|
AddFile('syngutterbase.pp','SynGutterBase',pftUnit,[],cpBase);
|
|
AddFile('syngutterchanges.pas','SynGutterChanges',pftUnit,[],cpBase);
|
|
AddFile('synguttercodefolding.pas','SynGutterCodeFolding',pftUnit,[],cpBase);
|
|
AddFile('syngutterlinenumber.pas','SynGutterLineNumber',pftUnit,[],cpBase);
|
|
AddFile('synguttermarks.pas','SynGutterMarks',pftUnit,[],cpBase);
|
|
|
|
AddFile('synpluginsyncronizededitbase.pp','SynPluginSyncronizedEditBase',pftUnit,[],cpBase);
|
|
AddFile('synpluginsyncroedit.pp','SynPluginSyncroEdit',pftUnit,[],cpBase);
|
|
AddFile('synplugintemplateedit.pp','SynPluginTemplateEdit',pftUnit,[],cpBase);
|
|
|
|
AddFile('syneditlazdsgn.pas','SynEditLazDsgn',pftUnit,[],cpBase);
|
|
AddFile('syndesignstringconstants.pas','SynDesignStringConstants',pftUnit,[],cpBase);
|
|
AddFile('synpropertyeditobjectlist.pas','SynPropertyEditObjectList',pftUnit,[],cpBase);
|
|
|
|
// add unit paths
|
|
UsageOptions.UnitPath:=SetDirSeparators(
|
|
'$(LazarusDir)/components/synedit/units/$(TargetCPU)-$(TargetOS)');
|
|
CompilerOptions.CustomOptions:='$(IDEBuildOptions)';
|
|
|
|
// use the components/units/..../allsyneditunits.o file as indicator,
|
|
// if synedit has been recompiled
|
|
OutputStateFile:=SetDirSeparators(
|
|
'$(LazarusDir)/components/synedit/units/$(TargetCPU)-$(TargetOS)/allsyneditunits.o');
|
|
|
|
Modified:=false;
|
|
end;
|
|
end;
|
|
|
|
function TLazPackageGraph.CreateLazControlsPackage: TLazPackage;
|
|
begin
|
|
Result:=TLazPackage.Create;
|
|
with Result do begin
|
|
AutoCreated:=true;
|
|
Name:='LazControls';
|
|
Filename:=SetDirSeparators('$(LazarusDir)/components/lazcontrols/lazcontrols.lpk');
|
|
Version.SetValues(0,0,0,0);
|
|
Author:='Martin Friebe';
|
|
License:='modified LGPL-2';
|
|
AutoInstall:=pitStatic;
|
|
AutoUpdate:=pupManually;
|
|
Description:='LCL controls for the Lazarus IDE';
|
|
PackageType:=lptRunAndDesignTime;
|
|
Installed:=pitStatic;
|
|
CompilerOptions.UnitOutputDirectory:='';
|
|
POOutputDirectory:='languages';
|
|
LazDocPaths:='docs';
|
|
Translated:=SystemLanguageID1;
|
|
AddToProjectUsesSection:=false;
|
|
|
|
// add requirements
|
|
AddRequiredDependency(LCLPackage.CreateDependencyWithOwner(Result));
|
|
|
|
// add units
|
|
AddFile('dividerbevel.pas','DividerBevel',pftUnit,[],cpBase);
|
|
|
|
CompilerOptions.CustomOptions:='$(IDEBuildOptions)';
|
|
|
|
// add unit paths
|
|
UsageOptions.UnitPath:=SetDirSeparators(
|
|
'$(LazarusDir)/components/lazcontrols/lib/$(TargetCPU)-$(TargetOS)');
|
|
|
|
// use the components/lazcontrols/lib/..../lazcontrols.o file as indicator,
|
|
// if lazcontrols have been recompiled
|
|
OutputStateFile:=SetDirSeparators(
|
|
'$(LazarusDir)/components/lazcontrols/lib/$(TargetCPU)-$(TargetOS)/lazcontrols.o');
|
|
|
|
Modified:=false;
|
|
end;
|
|
end;
|
|
|
|
function TLazPackageGraph.CreateCodeToolsPackage: TLazPackage;
|
|
begin
|
|
Result:=TLazPackage.Create;
|
|
with Result do begin
|
|
AutoCreated:=true;
|
|
Name:='CodeTools';
|
|
Filename:=SetDirSeparators('$(LazarusDir)/components/codetools/codetools.lpk');
|
|
Version.SetValues(1,0,1,0);
|
|
Author:='Mattias Gaertner';
|
|
License:='GPL-2';
|
|
AutoInstall:=pitStatic;
|
|
AutoUpdate:=pupManually;
|
|
Description:=lisPkgSysCodeToolsToolsAndFunctionsToParseBrowseAndEditPasc;
|
|
PackageType:=lptRunAndDesignTime;
|
|
Installed:=pitStatic;
|
|
CompilerOptions.UnitOutputDirectory:='';
|
|
POOutputDirectory:='languages';
|
|
LazDocPaths:='docs';
|
|
Translated:=SystemLanguageID1;
|
|
AddToProjectUsesSection:=false;
|
|
|
|
// add requirements
|
|
AddRequiredDependency(FCLPackage.CreateDependencyWithOwner(Result));
|
|
|
|
// add units
|
|
AddFile('basiccodetools.pas','BasicCodeTools',pftUnit,[],cpBase);
|
|
AddFile('ccodeparsertool.pas','CCodeParserTool',pftUnit,[],cpBase);
|
|
AddFile('codeatom.pas','CodeAtom',pftUnit,[],cpBase);
|
|
AddFile('codebeautifier.pas','CodeBeautifier',pftUnit,[],cpBase);
|
|
AddFile('codecache.pas','CodeCache',pftUnit,[],cpBase);
|
|
AddFile('codecompletiontool.pas','CodeCompletionTool',pftUnit,[],cpBase);
|
|
AddFile('codetemplatestool.pas','CodeTemplatesTool',pftUnit,[],cpBase);
|
|
AddFile('codetoolmanager.pas','CodeToolManager',pftUnit,[],cpBase);
|
|
AddFile('codetoolmemmanager.pas','CodeToolMemManager',pftUnit,[],cpBase);
|
|
AddFile('codetoolsconfig.pas','CodeToolsConfig',pftUnit,[],cpBase);
|
|
AddFile('codetoolsstrconsts.pas','CodeToolsStrConsts',pftUnit,[],cpBase);
|
|
AddFile('codetoolsstructs.pas','CodeToolsStructs',pftUnit,[],cpBase);
|
|
AddFile('codetree.pas','CodeTree',pftUnit,[],cpBase);
|
|
AddFile('customcodetool.pas','CustomCodeTool',pftUnit,[],cpBase);
|
|
AddFile('definetemplates.pas','DefineTemplates',pftUnit,[],cpBase);
|
|
AddFile('directorycacher.pas','DirectoryCacher',pftUnit,[],cpBase);
|
|
AddFile('eventcodetool.pas','EventCodeTool',pftUnit,[],cpBase);
|
|
AddFile('expreval.pas','ExprEval',pftUnit,[],cpBase);
|
|
AddFile('extractproctool.pas','ExtractProctool',pftUnit,[],cpBase);
|
|
AddFile('fileprocs.pas','FileProcs',pftUnit,[],cpBase);
|
|
AddFile('finddeclarationcache.pas','FindDeclarationCache',pftUnit,[],cpBase);
|
|
AddFile('finddeclarationtool.pas','FindDeclarationTool',pftUnit,[],cpBase);
|
|
AddFile('identcompletiontool.pas','IdentCompletionTool',pftUnit,[],cpBase);
|
|
AddFile('keywordfunclists.pas','KeywordFuncLists',pftUnit,[],cpBase);
|
|
AddFile('laz_dom.pas','Laz_DOM',pftUnit,[],cpBase);
|
|
AddFile('laz_xmlcfg.pas','Laz_XMLCfg',pftUnit,[],cpBase);
|
|
AddFile('laz_xmlread.pas','Laz_XMLRead',pftUnit,[],cpBase);
|
|
AddFile('laz_xmlstreaming.pas','Laz_XMLStreaming',pftUnit,[],cpBase);
|
|
AddFile('laz_xmlwrite.pas','Laz_XMLWrite',pftUnit,[],cpBase);
|
|
AddFile('lfmtrees.pas','LFMTrees',pftUnit,[],cpBase);
|
|
AddFile('linkscanner.pas','LinkScanner',pftUnit,[],cpBase);
|
|
AddFile('memcheck.pas','MemCheck',pftUnit,[],cpBase);
|
|
AddFile('methodjumptool.pas','MethodJumpTool',pftUnit,[],cpBase);
|
|
AddFile('multikeywordlisttool.pas','MultiKeywordListTool',pftUnit,[],cpBase);
|
|
AddFile('pascalparsertool.pas','PascalParserTool',pftUnit,[],cpBase);
|
|
AddFile('pascalreadertool.pas','PascalReaderTool',pftUnit,[],cpBase);
|
|
AddFile('resourcecodetool.pas','ResourceCodeTool',pftUnit,[],cpBase);
|
|
AddFile('sourcechanger.pas','SourceChanger',pftUnit,[],cpBase);
|
|
AddFile('sourcelog.pas','SourceLog',pftUnit,[],cpBase);
|
|
AddFile('stdcodetools.pas','StdCodeTools',pftUnit,[],cpBase);
|
|
|
|
CompilerOptions.CustomOptions:='$(IDEBuildOptions)';
|
|
|
|
// add unit paths
|
|
UsageOptions.UnitPath:=SetDirSeparators(
|
|
'$(LazarusDir)/components/codetools/units/$(TargetCPU)-$(TargetOS)');
|
|
|
|
// use the components/units/..../allcodetoolsunits.o file as indicator,
|
|
// if codetools have been recompiled
|
|
OutputStateFile:=SetDirSeparators(
|
|
'$(LazarusDir)/components/codetools/units/$(TargetCPU)-$(TargetOS)/allcodetoolsunits.o');
|
|
|
|
Modified:=false;
|
|
end;
|
|
end;
|
|
|
|
function TLazPackageGraph.CreateIDEIntfPackage: TLazPackage;
|
|
begin
|
|
Result:=TLazPackage.Create;
|
|
with Result do begin
|
|
AutoCreated:=true;
|
|
Name:='IDEIntf';
|
|
Filename:=SetDirSeparators('$(LazarusDir)/ideintf/');
|
|
Version.SetValues(1,0,0,0);
|
|
Author:='Lazarus';
|
|
License:='LGPL-2';
|
|
AutoInstall:=pitStatic;
|
|
AutoUpdate:=pupManually;
|
|
Description:='IDEIntf - the interface units for the IDE';
|
|
PackageType:=lptDesignTime;
|
|
Installed:=pitStatic;
|
|
CompilerOptions.UnitOutputDirectory:='';
|
|
POOutputDirectory:='languages';
|
|
Translated:=SystemLanguageID1;
|
|
LazDocPaths:='docs';
|
|
EnableI18N:=true;
|
|
AddToProjectUsesSection:=false;
|
|
|
|
// add requirements
|
|
AddRequiredDependency(LCLPackage.CreateDependencyWithOwner(Result));
|
|
|
|
// add units
|
|
AddFile('actionseditor.pas','ActionsEditor',pftUnit,[],cpBase);
|
|
AddFile('columndlg.pp','ColumnDlg',pftUnit,[],cpBase);
|
|
AddFile('componenteditors.pas','ComponentEditors',pftUnit,[],cpBase);
|
|
AddFile('componentreg.pas','ComponentReg',pftUnit,[],cpBase);
|
|
AddFile('componenttreeview.pas','ComponentTreeview',pftUnit,[],cpBase);
|
|
AddFile('baseideintf.pas','BaseIDEIntf',pftUnit,[],cpBase);
|
|
AddFile('dbpropedits.pas','DBPropEdits',pftUnit,[],cpBase);
|
|
AddFile('fieldseditor.pas','FieldsEditor',pftUnit,[],cpBase);
|
|
AddFile('formeditingintf.pas','FormEditingIntf',pftUnit,[],cpBase);
|
|
AddFile('frmselectprops.pas','FrmSelectProps',pftUnit,[],cpBase);
|
|
AddFile('graphpropedits.pas','GraphPropEdits',pftUnit,[],cpBase);
|
|
AddFile('helpfpdoc.pas','HelpFPDoc',pftUnit,[],cpBase);
|
|
AddFile('idecommands.pas','IDECommands',pftUnit,[],cpBase);
|
|
AddFile('ideimagesintf.pas','IDECommands',pftUnit,[],cpBase);
|
|
AddFile('ideoptionsintf.pas','IDECommands',pftUnit,[],cpBase);
|
|
AddFile('idewindowintf.pas','IDEWindowIntf',pftUnit,[pffHasRegisterProc],cpBase);
|
|
AddFile('imagelisteditor.pp','ImageListEditor',pftUnit,[],cpBase);
|
|
AddFile('lazideintf.pas','LazIDEIntf',pftUnit,[],cpBase);
|
|
AddFile('listviewpropedit.pp','ListViewPropEdit',pftUnit,[],cpBase);
|
|
AddFile('newitemintf.pas','NewItemIntf',pftUnit,[],cpBase);
|
|
AddFile('macrointf.pas','MacroIntf',pftUnit,[],cpBase);
|
|
AddFile('menuintf.pas','MenuIntf',pftUnit,[],cpBase);
|
|
AddFile('objectinspector.pp','ObjectInspector',pftUnit,[],cpBase);
|
|
AddFile('objinspstrconsts.pas','ObjInspStrConsts',pftUnit,[],cpBase);
|
|
AddFile('packageintf.pas','PackageIntf',pftUnit,[],cpBase);
|
|
AddFile('projectintf.pas','ProjectIntf',pftUnit,[],cpBase);
|
|
AddFile('propedits.pp','PropEdits',pftUnit,[],cpBase);
|
|
AddFile('srceditorintf.pas','SrcEditorIntf',pftUnit,[],cpBase);
|
|
AddFile('texttools.pas','TextTools',pftUnit,[],cpBase);
|
|
|
|
// add unit paths
|
|
UsageOptions.UnitPath:=SetDirSeparators(
|
|
'$(LazarusDir)/ideintf/units/$(TargetCPU)-$(TargetOS)');
|
|
|
|
CompilerOptions.CustomOptions:='$(IDEBuildOptions)';
|
|
|
|
// use the ideintf/units/$(TargetCPU)/$(TargetOS)/allideintf.o file
|
|
// as indicator, if ideintf has been recompiled
|
|
OutputStateFile:=SetDirSeparators(
|
|
'$(LazarusDir)/ideintf/units/$(TargetCPU)-$(TargetOS)/allideintf.o');
|
|
|
|
Modified:=false;
|
|
end;
|
|
end;
|
|
|
|
function TLazPackageGraph.CreateDefaultPackage: TLazPackage;
|
|
begin
|
|
Result:=TLazPackage.Create;
|
|
with Result do begin
|
|
AutoCreated:=true;
|
|
Name:='DefaultPackage';
|
|
Filename:=SetDirSeparators('$(LazarusDir)/components/custom/');
|
|
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:=SetDirSeparators('$(LazarusDir)/components/custom');
|
|
|
|
// add requirements
|
|
AddRequiredDependency(LCLPackage.CreateDependencyWithOwner(Result));
|
|
AddRequiredDependency(SynEditPackage.CreateDependencyWithOwner(Result));
|
|
|
|
Modified:=false;
|
|
end;
|
|
end;
|
|
|
|
function TLazPackageGraph.CreateLazarusBasePackage(PkgName: string
|
|
): TLazPackage;
|
|
begin
|
|
PkgName:=lowercase(PkgName);
|
|
if PkgName='fcl' then Result:=CreateFCLPackage
|
|
else if PkgName='lcl' then Result:=CreateLCLPackage
|
|
else if PkgName='ideintf' then Result:=CreateIDEIntfPackage
|
|
else if PkgName='synedit' then Result:=CreateSynEditPackage
|
|
else if PkgName='codetools' then Result:=CreateCodeToolsPackage
|
|
else if PkgName='lazcontrols' then Result:=CreateLazControlsPackage
|
|
else RaiseGDBException('');
|
|
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
|
|
SetBasePackage(FFCLPackage)
|
|
else if SysUtils.CompareText(APackage.Name,'LCL')=0 then
|
|
SetBasePackage(FLCLPackage)
|
|
else if SysUtils.CompareText(APackage.Name,'IDEIntf')=0 then
|
|
SetBasePackage(FIDEIntfPackage)
|
|
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(OldPackage, 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
|
|
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));
|
|
// 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('LCL');
|
|
LoadLazarusBasePackage('IDEIntf');
|
|
LoadLazarusBasePackage('SynEdit');
|
|
LoadLazarusBasePackage('CodeTools');
|
|
LoadLazarusBasePackage('LazControls');
|
|
// 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 (PackageName='') or (not IsValidIdent(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, '"', #13]),
|
|
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
|
|
SortDependencyListTopologically(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:='';
|
|
if not Assigned(OnGetAllRequiredPackages) then exit;
|
|
|
|
// get all required packages
|
|
PkgList:=nil;
|
|
OnGetAllRequiredPackages(PackageGraph.FirstAutoInstallDependency,PkgList);
|
|
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;
|
|
Dependency: TPkgDependency;
|
|
begin
|
|
ConfigDir:=AppendPathDelim(GetPrimaryConfigPath);
|
|
|
|
// create auto install package list for the Lazarus uses section
|
|
StaticPackagesInc:='';
|
|
Dependency:=FirstAutoInstallDependency;
|
|
while Dependency<>nil do begin
|
|
if (Dependency.RequiredPackage<>nil)
|
|
and (not Dependency.RequiredPackage.AutoCreated) then
|
|
StaticPackagesInc:=StaticPackagesInc
|
|
+ExtractFileNameOnly(Dependency.RequiredPackage.GetCompileSourceFilename)
|
|
+','+LineEnding;
|
|
Dependency:=Dependency.NextRequiresDependency;
|
|
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='lcl')
|
|
or (PackageName='synedit')
|
|
or (PackageName='ideintf')
|
|
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.FindCircleDependencyPath(APackage: TLazPackage;
|
|
FirstDependency: TPkgDependency): TFPList;
|
|
|
|
procedure FindCircle(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 lpfCircle in RequiredPackage.Flags then begin
|
|
// circle detected
|
|
PathList:=TFPList.Create;
|
|
PathList.Add(RequiredPackage);
|
|
exit;
|
|
end;
|
|
if not (lpfVisited in RequiredPackage.Flags) then begin
|
|
RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited,lpfCircle];
|
|
FindCircle(RequiredPackage.FirstRequiredDependency,PathList);
|
|
if PathList<>nil then begin
|
|
// circle detected
|
|
// -> add current package to list
|
|
PathList.Insert(0,RequiredPackage);
|
|
exit;
|
|
end;
|
|
RequiredPackage.Flags:=RequiredPackage.Flags-[lpfCircle];
|
|
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 circle free
|
|
for i:=FItems.Count-1 downto 0 do begin
|
|
Pkg:=TLazPackage(FItems[i]);
|
|
Pkg.Flags:=Pkg.Flags-[lpfVisited,lpfCircle];
|
|
end;
|
|
if APackage<>nil then begin
|
|
APackage.Flags:=APackage.Flags+[lpfVisited];
|
|
FirstDependency:=APackage.FirstRequiredDependency;
|
|
end;
|
|
FindCircle(FirstDependency,Result);
|
|
if (Result<>nil) and (APackage<>nil) then
|
|
Result.Insert(0,APackage);
|
|
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; var File1, File2: TPkgFile;
|
|
var 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)
|
|
const
|
|
FileTypes = PkgFileUnitTypes-[pftVirtualUnit];
|
|
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 FileTypes) 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 FileTypes)
|
|
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=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;
|
|
|
|
function TLazPackageGraph.GetAutoCompilationOrder(APackage: TLazPackage;
|
|
FirstDependency: TPkgDependency; Policies: TPackageUpdatePolicies): TFPList;
|
|
// Returns all required auto update packages, including indirect requirements.
|
|
// The packages will be in topological order, with the package that should be
|
|
// compiled first at the end.
|
|
|
|
procedure GetTopologicalOrder(Dependency: TPkgDependency);
|
|
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
|
|
RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited];
|
|
if RequiredPackage.AutoUpdate in Policies then begin
|
|
// add first all needed packages
|
|
GetTopologicalOrder(RequiredPackage.FirstRequiredDependency);
|
|
// then add this package
|
|
if Result=nil then Result:=TFPList.Create;
|
|
Result.Add(RequiredPackage);
|
|
end;
|
|
end;
|
|
end;
|
|
Dependency:=Dependency.NextRequiresDependency;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result:=nil;
|
|
MarkAllPackagesAsNotVisited;
|
|
if APackage<>nil then begin
|
|
APackage.Flags:=APackage.Flags+[lpfVisited];
|
|
FirstDependency:=APackage.FirstRequiredDependency;
|
|
end;
|
|
GetTopologicalOrder(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 begin
|
|
if not (lpfNeeded in Packages[i].Flags) then Delete(i);
|
|
end;
|
|
EndUpdate;
|
|
end;
|
|
|
|
procedure TLazPackageGraph.ChangePackageID(APackage: TLazPackage;
|
|
const NewName: string; NewVersion: TPkgVersion; RenameDependencies: boolean);
|
|
var
|
|
Dependency: TPkgDependency;
|
|
NextDependency: TPkgDependency;
|
|
OldPkgName: String;
|
|
begin
|
|
OldPkgName:=APackage.Name;
|
|
if (SysUtils.CompareText(OldPkgName,NewName)=0)
|
|
and (APackage.Version.Compare(NewVersion)=0) then begin
|
|
// ID does not change
|
|
// -> just rename
|
|
APackage.Name:=NewName;
|
|
fChanged:=true;
|
|
exit;
|
|
end;
|
|
|
|
// ID changed
|
|
|
|
BeginUpdate(true);
|
|
|
|
// 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);
|
|
EndUpdate;
|
|
end;
|
|
|
|
function TLazPackageGraph.SavePackageCompiledState(APackage: TLazPackage;
|
|
const CompilerFilename, CompilerParams: string; Complete, ShowAbort: boolean
|
|
): TModalResult;
|
|
var
|
|
XMLConfig: TXMLConfig;
|
|
StateFile: String;
|
|
CompilerFileDate: Integer;
|
|
begin
|
|
Result:=mrCancel;
|
|
StateFile:=APackage.GetStateFilename;
|
|
try
|
|
CompilerFileDate:=FileAgeCached(CompilerFilename);
|
|
|
|
APackage.LastCompilerFilename:=CompilerFilename;
|
|
APackage.LastCompilerFileDate:=CompilerFileDate;
|
|
APackage.LastCompilerParams:=CompilerParams;
|
|
APackage.LastCompileComplete:=Complete;
|
|
|
|
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);
|
|
InvalidateFileStateCache;
|
|
XMLConfig.Flush;
|
|
finally
|
|
XMLConfig.Free;
|
|
end;
|
|
APackage.LastStateFileName:=StateFile;
|
|
APackage.LastStateFileDate:=FileAgeUTF8(StateFile);
|
|
APackage.Flags:=APackage.Flags+[lpfStateFileLoaded];
|
|
except
|
|
on E: Exception do begin
|
|
Result:=IDEMessageDialogAb(lisPkgMangErrorWritingFile,
|
|
Format(lisPkgMangUnableToWriteStateFileOfPackageError, ['"', StateFile,
|
|
'"', #13, APackage.IDAsString, #13, 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;
|
|
begin
|
|
StateFile:=APackage.GetStateFilename;
|
|
if not FileExistsUTF8(StateFile) then begin
|
|
//DebugLn('TLazPackageGraph.LoadPackageCompiledState Statefile not found: ',StateFile);
|
|
APackage.Flags:=APackage.Flags-[lpfStateFileLoaded];
|
|
Result:=mrOk;
|
|
exit;
|
|
end;
|
|
|
|
// read the state file
|
|
StateFileAge:=FileAgeUTF8(StateFile);
|
|
if (not (lpfStateFileLoaded in APackage.Flags))
|
|
or (APackage.LastStateFileDate<>StateFileAge)
|
|
or (APackage.LastStateFileName<>StateFile) then begin
|
|
APackage.Flags:=APackage.Flags-[lpfStateFileLoaded];
|
|
try
|
|
XMLConfig:=TXMLConfig.Create(StateFile);
|
|
try
|
|
APackage.LastCompilerFilename:=XMLConfig.GetValue('Compiler/Value','');
|
|
APackage.LastCompilerFileDate:=XMLConfig.GetValue('Compiler/Date',0);
|
|
APackage.LastCompilerParams:=XMLConfig.GetValue('Params/Value','');
|
|
APackage.LastCompileComplete:=XMLConfig.GetValue('Complete/Value',true);
|
|
finally
|
|
XMLConfig.Free;
|
|
end;
|
|
APackage.LastStateFileName:=StateFile;
|
|
APackage.LastStateFileDate:=StateFileAge;
|
|
except
|
|
on E: Exception do begin
|
|
if IgnoreErrors then begin
|
|
Result:=mrOk;
|
|
end else begin
|
|
Result:=IDEMessageDialogAb(lisPkgMangErrorReadingFile,
|
|
Format(lisPkgMangUnableToReadStateFileOfPackageError, ['"',
|
|
StateFile, '"', #13, APackage.IDAsString, #13, E.Message]),
|
|
mtError,[mbCancel],ShowAbort);
|
|
end;
|
|
exit;
|
|
end;
|
|
end;
|
|
APackage.Flags:=APackage.Flags+[lpfStateFileLoaded];
|
|
end;
|
|
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function TLazPackageGraph.CheckCompileNeedDueToDependencies(
|
|
FirstDependency: TPkgDependency; StateFileAge: longint): TModalResult;
|
|
|
|
function GetOwnerID: string;
|
|
begin
|
|
OnGetDependencyOwnerDescription(FirstDependency,Result);
|
|
end;
|
|
|
|
var
|
|
Dependency: TPkgDependency;
|
|
RequiredPackage: TLazPackage;
|
|
OtherStateFile: String;
|
|
begin
|
|
Dependency:=FirstDependency;
|
|
if Dependency=nil then begin
|
|
Result:=mrNo;
|
|
exit;
|
|
end;
|
|
|
|
while Dependency<>nil do begin
|
|
if (Dependency.LoadPackageResult=lprSuccess) then begin
|
|
RequiredPackage:=Dependency.RequiredPackage;
|
|
// check compile state file of required package
|
|
if not RequiredPackage.AutoCreated then begin
|
|
Result:=LoadPackageCompiledState(RequiredPackage,false,true);
|
|
if Result<>mrOk then exit;
|
|
Result:=mrYes;
|
|
if not (lpfStateFileLoaded in RequiredPackage.Flags) then begin
|
|
DebugLn('TPkgManager.CheckCompileNeedDueToDependencies No state file for ',RequiredPackage.IDAsString);
|
|
exit;
|
|
end;
|
|
if StateFileAge<RequiredPackage.LastStateFileDate then begin
|
|
DebugLn('TPkgManager.CheckCompileNeedDueToDependencies Required ',
|
|
RequiredPackage.IDAsString,' State file is newer than ',
|
|
'State file ',GetOwnerID);
|
|
exit;
|
|
end;
|
|
end;
|
|
// check output state file of required package
|
|
if RequiredPackage.OutputStateFile<>'' then begin
|
|
OtherStateFile:=RequiredPackage.OutputStateFile;
|
|
GlobalMacroList.SubstituteStr(OtherStateFile);
|
|
if FileExistsUTF8(OtherStateFile)
|
|
and (FileAgeUTF8(OtherStateFile)>StateFileAge) then begin
|
|
DebugLn('TPkgManager.CheckCompileNeedDueToDependencies Required ',
|
|
RequiredPackage.IDAsString,' OtherState file "',OtherStateFile,'"'
|
|
,' is newer than State file ',GetOwnerID);
|
|
Result:=mrYes;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
Dependency:=Dependency.NextRequiresDependency;
|
|
end;
|
|
Result:=mrNo;
|
|
end;
|
|
|
|
function TLazPackageGraph.ExtractCompilerParamsForBuildAll(
|
|
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 -F -B -e -i -o -s -v }
|
|
var
|
|
EndPos: Integer;
|
|
StartPos: integer;
|
|
begin
|
|
Result:=CompParams;
|
|
EndPos:=1;
|
|
while ReadNextFPCParameter(Result,EndPos,StartPos) do begin
|
|
if (Result[StartPos]='-') and (StartPos<length(Result)) then begin
|
|
case Result[StartPos+1] of
|
|
'l','F','B','e','i','o','s','v':
|
|
begin
|
|
while (StartPos>1) and (Result[StartPos-1] in [' ',#9]) do
|
|
dec(StartPos);
|
|
//DebugLn(['TLazPackageGraph.ExtractCompilerParamsForBuildAll Removing: ',copy(Result,StartPos,EndPos-StartPos)]);
|
|
System.Delete(Result,StartPos,EndPos-StartPos);
|
|
EndPos:=StartPos;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TLazPackageGraph.CheckIfPackageNeedsCompilation(APackage: TLazPackage;
|
|
const CompilerFilename, CompilerParams, SrcFilename: string;
|
|
out NeedBuildAllFlag: boolean): TModalResult;
|
|
var
|
|
StateFilename: String;
|
|
StateFileAge: Integer;
|
|
i: Integer;
|
|
CurFile: TPkgFile;
|
|
NewOutputDir: String;
|
|
OutputDir: String;
|
|
begin
|
|
Result:=mrYes;
|
|
{$IFDEF VerbosePkgCompile}
|
|
debugln('TLazPackageGraph.CheckIfPackageNeedsCompilation A ',APackage.IDAsString);
|
|
{$ENDIF}
|
|
NeedBuildAllFlag:=false;
|
|
|
|
if APackage.AutoUpdate=pupManually then exit(mrNo);
|
|
|
|
if (APackage.LastCompilerFilename<>CompilerFilename)
|
|
or (ExtractCompilerParamsForBuildAll(APackage.LastCompilerParams)
|
|
<>ExtractCompilerParamsForBuildAll(CompilerParams))
|
|
or ((APackage.LastCompilerFileDate>0)
|
|
and FileExistsCached(CompilerFilename)
|
|
and (FileAgeUTF8(CompilerFilename)<>APackage.LastCompilerFileDate))
|
|
then
|
|
NeedBuildAllFlag:=true;
|
|
|
|
if (APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride='') then
|
|
begin
|
|
OutputDir:=APackage.GetOutputDirectory(false);
|
|
if not DirectoryIsWritableCached(OutputDir) then
|
|
begin
|
|
// the package uses the default output directory, but the default is
|
|
// not writable.
|
|
// => check the alternative
|
|
if Assigned(OnGetWritablePkgOutputDirectory) then begin
|
|
NewOutputDir:=OutputDir;
|
|
OnGetWritablePkgOutputDirectory(APackage,NewOutputDir);
|
|
if (NewOutputDir<>OutputDir) and (NewOutputDir<>'') then begin
|
|
StateFilename:=APackage.GetStateFilename(NewOutputDir);
|
|
if FileExistsCached(StateFilename) then begin
|
|
// the alternative output directory contains a state file
|
|
// this means the user has compiled his own version
|
|
// => use the alternative output directory
|
|
APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride:=NewOutputDir;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// check state file
|
|
StateFilename:=APackage.GetStateFilename;
|
|
Result:=LoadPackageCompiledState(APackage,false,true);
|
|
if Result<>mrOk then exit;
|
|
if not (lpfStateFileLoaded in APackage.Flags) then begin
|
|
DebugLn('TLazPackageGraph.CheckIfPackageNeedsCompilation No state file for ',APackage.IDAsString);
|
|
exit(mrYes);
|
|
end;
|
|
|
|
StateFileAge:=FileAgeUTF8(StateFilename);
|
|
|
|
// check main source file
|
|
if FileExistsUTF8(SrcFilename) and (StateFileAge<FileAgeUTF8(SrcFilename)) then
|
|
begin
|
|
DebugLn('TLazPackageGraph.CheckIfPackageNeedsCompilation SrcFile outdated ',APackage.IDAsString);
|
|
exit(mrYes);
|
|
end;
|
|
|
|
// check compiler and params
|
|
if CompilerFilename<>APackage.LastCompilerFilename then begin
|
|
DebugLn('TLazPackageGraph.CheckIfPackageNeedsCompilation Compiler filename changed for ',APackage.IDAsString);
|
|
DebugLn(' Old="',APackage.LastCompilerFilename,'"');
|
|
DebugLn(' Now="',CompilerFilename,'"');
|
|
exit(mrYes);
|
|
end;
|
|
if not FileExistsUTF8(CompilerFilename) then begin
|
|
DebugLn('TLazPackageGraph.CheckIfPackageNeedsCompilation Compiler filename not found for ',APackage.IDAsString);
|
|
DebugLn(' File="',CompilerFilename,'"');
|
|
exit(mrYes);
|
|
end;
|
|
if FileAgeUTF8(CompilerFilename)<>APackage.LastCompilerFileDate then begin
|
|
DebugLn('TLazPackageGraph.CheckIfPackageNeedsCompilation Compiler file changed for ',APackage.IDAsString);
|
|
DebugLn(' File="',CompilerFilename,'"');
|
|
exit(mrYes);
|
|
end;
|
|
if ExtractCompilerParamsForBuildAll(CompilerParams)
|
|
<>ExtractCompilerParamsForBuildAll(APackage.LastCompilerParams)
|
|
then begin
|
|
DebugLn('TLazPackageGraph.CheckIfPackageNeedsCompilation Compiler params changed for ',APackage.IDAsString);
|
|
DebugLn(' Old="',APackage.LastCompilerParams,'"');
|
|
DebugLn(' Now="',CompilerParams,'"');
|
|
exit(mrYes);
|
|
end;
|
|
|
|
// compiler and parameters are the same
|
|
// quick compile is possible
|
|
NeedBuildAllFlag:=false;
|
|
|
|
if not APackage.LastCompileComplete
|
|
then begin
|
|
DebugLn('TLazPackageGraph.CheckIfPackageNeedsCompilation Compile was incomplete for ',APackage.IDAsString);
|
|
exit(mrYes);
|
|
end;
|
|
|
|
// check all required packages
|
|
Result:=CheckCompileNeedDueToDependencies(APackage.FirstRequiredDependency,
|
|
StateFileAge);
|
|
if Result<>mrNo then exit;
|
|
|
|
// check package files
|
|
if StateFileAge<FileAgeUTF8(APackage.Filename) then begin
|
|
DebugLn('TLazPackageGraph.CheckIfPackageNeedsCompilation StateFile older than lpk ',APackage.IDAsString);
|
|
exit(mrYes);
|
|
end;
|
|
for i:=0 to APackage.FileCount-1 do begin
|
|
CurFile:=APackage.Files[i];
|
|
//debugln('TLazPackageGraph.CheckIfPackageNeedsCompilation CurFile.Filename="',CurFile.Filename,'" ',FileExistsUTF8(CurFile.Filename),' ',StateFileAge<FileAgeUTF8(CurFile.Filename));
|
|
if FileExistsUTF8(CurFile.Filename)
|
|
and (StateFileAge<FileAgeUTF8(CurFile.Filename)) then begin
|
|
DebugLn('TLazPackageGraph.CheckIfPackageNeedsCompilation Src has changed ',APackage.IDAsString,' ',CurFile.Filename);
|
|
exit(mrYes);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF VerbosePkgCompile}
|
|
debugln('TLazPackageGraph.CheckIfPackageNeedsCompilation END ',APackage.IDAsString);
|
|
{$ENDIF}
|
|
Result:=mrNo;
|
|
end;
|
|
|
|
function TLazPackageGraph.CompileRequiredPackages(APackage: TLazPackage;
|
|
FirstDependency: TPkgDependency; Globals: TGlobalCompilerOptions;
|
|
Policies: TPackageUpdatePolicies): TModalResult;
|
|
var
|
|
AutoPackages: TFPList;
|
|
i: Integer;
|
|
begin
|
|
{$IFDEF VerbosePkgCompile}
|
|
debugln('TLazPackageGraph.CompileRequiredPackages A ');
|
|
{$ENDIF}
|
|
AutoPackages:=PackageGraph.GetAutoCompilationOrder(APackage,FirstDependency,
|
|
Policies);
|
|
if AutoPackages<>nil then begin
|
|
//DebugLn('TLazPackageGraph.CompileRequiredPackages B Count=',IntToStr(AutoPackages.Count));
|
|
try
|
|
i:=0;
|
|
while i<AutoPackages.Count do begin
|
|
Result:=CompilePackage(TLazPackage(AutoPackages[i]),
|
|
[pcfDoNotCompileDependencies,pcfOnlyIfNeeded,
|
|
pcfDoNotSaveEditorFiles],false,Globals);
|
|
if Result<>mrOk then exit;
|
|
inc(i);
|
|
end;
|
|
finally
|
|
AutoPackages.Free;
|
|
end;
|
|
end;
|
|
{$IFDEF VerbosePkgCompile}
|
|
debugln('TLazPackageGraph.CompileRequiredPackages END ');
|
|
{$ENDIF}
|
|
Result:=mrOk;
|
|
end;
|
|
|
|
function TLazPackageGraph.CompilePackage(APackage: TLazPackage;
|
|
Flags: TPkgCompileFlags; ShowAbort: boolean; Globals: TGlobalCompilerOptions
|
|
): TModalResult;
|
|
|
|
function GetIgnoreIdentifier: string;
|
|
begin
|
|
Result:='install_package_compile_failed:'+APackage.Filename;
|
|
end;
|
|
|
|
var
|
|
PkgCompileTool: TIDEExternalToolOptions;
|
|
CompilerFilename: String;
|
|
CompilerParams: String;
|
|
EffectiveCompilerParams: String;
|
|
SrcFilename: String;
|
|
CompilePolicies: TPackageUpdatePolicies;
|
|
BlockBegan: Boolean;
|
|
NeedBuildAllFlag: Boolean;
|
|
CompileResult, MsgResult: TModalResult;
|
|
begin
|
|
Result:=mrCancel;
|
|
|
|
//DebugLn('TLazPackageGraph.CompilePackage A ',APackage.IDAsString,' Flags=',PkgCompileFlagsToString(Flags));
|
|
|
|
if APackage.AutoCreated then begin
|
|
DebugLn(['TLazPackageGraph.CompilePackage failed because autocreated: ',APackage.IDAsString]);
|
|
exit;
|
|
end;
|
|
|
|
BeginUpdate(false);
|
|
try
|
|
// automatically compile required packages
|
|
if not (pcfDoNotCompileDependencies in Flags) then begin
|
|
CompilePolicies:=[pupAsNeeded];
|
|
if pcfCompileDependenciesClean in Flags then
|
|
Include(CompilePolicies,pupOnRebuildingAll);
|
|
Result:=CompileRequiredPackages(APackage,nil,Globals,
|
|
CompilePolicies);
|
|
if Result<>mrOk then begin
|
|
DebugLn(['TLazPackageGraph.CompilePackage CompileRequiredPackages failed: ',APackage.IDAsString]);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
SrcFilename:=APackage.GetSrcFilename;
|
|
CompilerFilename:=APackage.GetCompilerFilename;
|
|
// Note: use absolute paths, because some external tools resolve symlinked directories
|
|
CompilerParams:=APackage.CompilerOptions.MakeOptionsString(Globals,
|
|
APackage.CompilerOptions.DefaultMakeOptionsFlags+[ccloAbsolutePaths])
|
|
+' '+CreateRelativePath(SrcFilename,APackage.Directory);
|
|
//DebugLn(['TLazPackageGraph.CompilePackage SrcFilename="',SrcFilename,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'" TargetCPU=',Globals.TargetCPU,' TargetOS=',Globals.TargetOS]);
|
|
|
|
// check if compilation is needed and if a clean build is needed
|
|
Result:=CheckIfPackageNeedsCompilation(APackage,
|
|
CompilerFilename,CompilerParams,
|
|
SrcFilename,NeedBuildAllFlag);
|
|
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(['TLazPackageGraph.CompilePackage CheckIfPackageNeedsCompilation failed: ',APackage.IDAsString]);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
BlockBegan:=IDEMessagesWindow<>nil;
|
|
if BlockBegan then
|
|
IDEMessagesWindow.BeginBlock;
|
|
try
|
|
if (LazarusIDE<>nil) then
|
|
LazarusIDE.MainBarSubTitle:=APackage.Name;
|
|
// auto increase version
|
|
// ToDo
|
|
|
|
Result:=PreparePackageOutputDirectory(APackage,pcfCleanCompile in Flags);
|
|
if Result<>mrOk then begin
|
|
DebugLn('TLazPackageGraph.CompilePackage PreparePackageOutputDirectory failed: ',APackage.IDAsString);
|
|
exit;
|
|
end;
|
|
|
|
// create package main source file
|
|
Result:=SavePackageMainSource(APackage,Flags,ShowAbort);
|
|
if Result<>mrOk then begin
|
|
DebugLn('TLazPackageGraph.CompilePackage SavePackageMainSource failed: ',APackage.IDAsString);
|
|
exit;
|
|
end;
|
|
|
|
// check ambiguous units
|
|
Result:=CheckAmbiguousPackageUnits(APackage);
|
|
if Result<>mrOk then begin
|
|
DebugLn('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('TLazPackageGraph.CompilePackage DoWriteMakefile failed: ',APackage.IDAsString);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// run compilation tool 'Before'
|
|
if not (pcfDoNotCompilePackage in Flags) then begin
|
|
Result:=APackage.CompilerOptions.ExecuteBefore.Execute(
|
|
APackage.Directory,'Executing command before');
|
|
if Result<>mrOk then begin
|
|
DebugLn(['TLazPackageGraph.CompilePackage ExecuteBefore failed: ',APackage.IDAsString]);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// create external tool to run the compiler
|
|
//DebugLn('TPkgManager.DoCompilePackage Compiler="',CompilerFilename,'"');
|
|
//DebugLn('TPkgManager.DoCompilePackage Params="',CompilerParams,'"');
|
|
//DebugLn('TPkgManager.DoCompilePackage WorkingDir="',APackage.Directory,'"');
|
|
|
|
if (not APackage.CompilerOptions.SkipCompiler)
|
|
and (not (pcfDoNotCompilePackage in Flags)) then begin
|
|
// check compiler filename
|
|
try
|
|
CheckIfFileIsExecutable(CompilerFilename);
|
|
except
|
|
on e: Exception do begin
|
|
DebugLn(['TLazPackageGraph.CompilePackage ',APackage.IDAsString,' ',e.Message]);
|
|
Result:=IDEMessageDialog(lisPkgManginvalidCompilerFilename,
|
|
Format(lisPkgMangTheCompilerFileForPackageIsNotAValidExecutable, [
|
|
APackage.IDAsString, #13, E.Message]),
|
|
mtError,[mbCancel,mbAbort]);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// change compiler parameters for compiling clean
|
|
EffectiveCompilerParams:=CompilerParams;
|
|
if (pcfCleanCompile in Flags) or NeedBuildAllFlag then begin
|
|
if EffectiveCompilerParams<>'' then
|
|
EffectiveCompilerParams:='-B '+EffectiveCompilerParams
|
|
else
|
|
EffectiveCompilerParams:='-B';
|
|
end;
|
|
|
|
PkgCompileTool:=TIDEExternalToolOptions.Create;
|
|
try
|
|
PkgCompileTool.Title:='Compiling package '+APackage.IDAsString;
|
|
PkgCompileTool.ScanOutputForFPCMessages:=true;
|
|
PkgCompileTool.ScanOutputForMakeMessages:=true;
|
|
PkgCompileTool.WorkingDirectory:=APackage.Directory;
|
|
PkgCompileTool.Filename:=CompilerFilename;
|
|
PkgCompileTool.CmdLineParams:=EffectiveCompilerParams;
|
|
|
|
// clear old errors
|
|
if SourceEditorManagerIntf<>nil then
|
|
SourceEditorManagerIntf.ClearErrorLines;
|
|
|
|
// compile package
|
|
CompileResult:=RunCompilerWithOptions(PkgCompileTool,APackage.CompilerOptions);
|
|
// write state file
|
|
Result:=SavePackageCompiledState(APackage,
|
|
CompilerFilename,CompilerParams,
|
|
CompileResult=mrOk,true);
|
|
if Result<>mrOk then begin
|
|
DebugLn(['TLazPackageGraph.CompilePackage SavePackageCompiledState failed: ',APackage.IDAsString]);
|
|
exit;
|
|
end;
|
|
Result:=CompileResult;
|
|
if Result<>mrOk then exit;
|
|
finally
|
|
// clean up
|
|
PkgCompileTool.Free;
|
|
end;
|
|
end;
|
|
|
|
// update .po files
|
|
if (APackage.POOutputDirectory<>'') then begin
|
|
Result:=ConvertPackageRSTFiles(APackage);
|
|
if Result<>mrOk then begin
|
|
IDEMessagesWindow.AddMsg('Error: updating po files failed for package '+APackage.IDAsString,APackage.Directory,-1);
|
|
DebugLn('TLazPackageGraph.CompilePackage ConvertPackageRSTFiles failed: ',APackage.IDAsString);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// run compilation tool 'After'
|
|
if not (pcfDoNotCompilePackage in Flags) then begin
|
|
Result:=APackage.CompilerOptions.ExecuteAfter.Execute(
|
|
APackage.Directory,'Executing command after');
|
|
if Result<>mrOk then begin
|
|
IDEMessagesWindow.AddMsg('Error: running ''compile after'' tool failed for package '+APackage.IDAsString,APackage.Directory,-1);
|
|
DebugLn(['TLazPackageGraph.CompilePackage ExecuteAfter failed: ',APackage.IDAsString]);
|
|
exit;
|
|
end;
|
|
end;
|
|
Result:=mrOk;
|
|
finally
|
|
if (LazarusIDE<>nil) then
|
|
LazarusIDE.MainBarSubTitle:='';
|
|
if BlockBegan and (IDEMessagesWindow<>nil) then
|
|
IDEMessagesWindow.EndBlock;
|
|
if Result<>mrOk then begin
|
|
if (APackage.AutoInstall<>pitNope)
|
|
and (OnUninstallPackage<>nil)
|
|
and (not IsStaticBasePackage(APackage.Name))
|
|
and (IgnoreQuestions<>nil)
|
|
and (IgnoreQuestions.Find(GetIgnoreIdentifier)=nil)
|
|
then begin
|
|
// a package needed for installation failed to compile
|
|
// -> ask user if the package should be removed from the installation
|
|
// list
|
|
MsgResult:=IDEMessageDialog(lisInstallationFailed,
|
|
Format(lisPkgMangThePackageFailedToCompileRemoveItFromTheInstallati,
|
|
['"', APackage.IDAsString, '"', #13]), mtConfirmation,
|
|
[mbYes,mbIgnore]);
|
|
if MsgResult=mrIgnore then
|
|
IgnoreQuestions.Add(GetIgnoreIdentifier,iiid24H)
|
|
else if MsgResult=mrYes then
|
|
begin
|
|
Result:=OnUninstallPackage(APackage,
|
|
[puifDoNotConfirm,puifDoNotBuildIDE],true);
|
|
end;
|
|
end;
|
|
end;
|
|
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(['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(['TLazPackageGraph.ConvertPackageRSTFiles skipping read only directory '+POOutputDirectory]);
|
|
exit(mrOK);
|
|
end;
|
|
|
|
PkgOutputDirectory:=AppendPathDelim(APackage.GetOutputDirectory);
|
|
if not ConvertRSTFiles(PkgOutputDirectory,POOutputDirectory, APackage.Name+'.po') then begin
|
|
DebugLn(['TLazPackageGraph.ConvertPackageRSTFiles FAILED: PkgOutputDirectory=',PkgOutputDirectory,' RSTOutputDirectory=',POOutputDirectory]);
|
|
exit(mrCancel);
|
|
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;
|
|
s:=copy(s,1,p-1)+ReplaceTxt+copy(s,p+length(SearchTxt),length(s));
|
|
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 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: String;
|
|
e: string;
|
|
SrcFilename: String;
|
|
MainUnitName: String;
|
|
MakefileFPCFilename: String;
|
|
UnitOutputPath: String;
|
|
UnitPath: String;
|
|
FPCMakeTool: TIDEExternalToolOptions;
|
|
CodeBuffer: TCodeBuffer;
|
|
MainSrcFile: String;
|
|
CustomOptions: String;
|
|
IncPath: String;
|
|
begin
|
|
Result:=mrCancel;
|
|
PathDelimNeedsReplace:=PathDelim<>'/';
|
|
|
|
MakefileFPCFilename:=AppendPathDelim(APackage.Directory)+'Makefile.fpc';
|
|
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 don't want to
|
|
// custom build
|
|
// => silently skip
|
|
DebugLn(['TPkgManager.DoWriteMakefile Skipping, because package directory is not writable: ',APackage.Directory]);
|
|
Result:=mrOk;
|
|
exit;
|
|
end;
|
|
|
|
SrcFilename:=APackage.GetSrcFilename;
|
|
MainUnitName:=lowercase(ExtractFileNameOnly((SrcFilename)));
|
|
UnitPath:=APackage.CompilerOptions.GetUnitPath(true,
|
|
coptParsedPlatformIndependent);
|
|
IncPath:=APackage.CompilerOptions.GetIncludePath(true,
|
|
coptParsedPlatformIndependent);
|
|
UnitOutputPath:=APackage.CompilerOptions.GetUnitOutPath(true,
|
|
coptParsedPlatformIndependent);
|
|
CustomOptions:=APackage.CompilerOptions.GetCustomOptions(
|
|
coptParsedPlatformIndependent);
|
|
s:=APackage.CompilerOptions.GetSyntaxOptionsString;
|
|
if s<>'' then
|
|
CustomOptions:=CustomOptions+' '+s;
|
|
// TODO: other options
|
|
|
|
//DebugLn('TPkgManager.DoWriteMakefile ',APackage.Name,' makefile UnitPath="',UnitPath,'"');
|
|
UnitPath:=ConvertLazarusToMakefileSearchPath(UnitPath);
|
|
IncPath:=ConvertLazarusToMakefileSearchPath(IncPath);
|
|
// remove path delimiter at the end, or else it will fail on windows
|
|
UnitOutputPath:=ConvertLazarusToMakefileDirectory(
|
|
ChompPathDelim(UnitOutputPath));
|
|
MainSrcFile:=CreateRelativePath(SrcFilename,APackage.Directory);
|
|
CustomOptions:=ConvertLazarusOptionsToMakefileOptions(CustomOptions);
|
|
|
|
|
|
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='+UnitPath+e;
|
|
if IncPath<>'' then
|
|
s:=s+'includedir='+IncPath+e;
|
|
s:=s+'options='+CustomOptions+e; // ToDo do the other options
|
|
s:=s+''+e;
|
|
s:=s+'[target]'+e;
|
|
s:=s+'units='+MainSrcFile+e;
|
|
//s:=s+'implicitunits=syntextdrawer'+e; // TODO list all unit names
|
|
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+'[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:=s+''+e;
|
|
s:=s+'[rules]'+e;
|
|
s:=s+'.PHONY: cleartarget all'+e;
|
|
s:=s+''+e;
|
|
s:=s+'cleartarget:'+e;
|
|
s:=s+' -$(DEL) $(COMPILER_UNITTARGETDIR)/'+MainUnitName+'$(PPUEXT)'+e;
|
|
s:=s+''+e;
|
|
s:=s+'all: cleartarget $(COMPILER_UNITTARGETDIR) '+MainUnitName+'$(PPUEXT)'+e;
|
|
|
|
//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 => no problem
|
|
exit(mrOk);
|
|
end;
|
|
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;
|
|
|
|
// call fpcmake to create the Makefile
|
|
FPCMakeTool:=TIDEExternalToolOptions.Create;
|
|
try
|
|
FPCMakeTool.Title:='Creating Makefile for package '+APackage.IDAsString;
|
|
FPCMakeTool.WorkingDirectory:=APackage.Directory;
|
|
FPCMakeTool.Filename:=FindFPCTool('fpcmake'+GetExecutableExt,
|
|
EnvironmentOptions.CompilerFilename);
|
|
FPCMakeTool.CmdLineParams:='-q -TAll';
|
|
FPCMakeTool.EnvironmentOverrides.Add(
|
|
'FPCDIR='+EnvironmentOptions.GetFPCSourceDirectory);
|
|
|
|
// clear old errors
|
|
SourceEditorManagerIntf.ClearErrorLines;
|
|
|
|
// compile package
|
|
Result:=RunExternalTool(FPCMakeTool);
|
|
if Result<>mrOk then begin
|
|
Result:=IDEMessageDialog(lisFpcmakeFailed,
|
|
Format(lisCallingToCreateMakefileFromFailed, [FPCMakeTool.Filename,
|
|
MakefileFPCFilename]),
|
|
mtError,[mbCancel]);
|
|
exit;
|
|
end;
|
|
finally
|
|
// clean up
|
|
FPCMakeTool.Free;
|
|
end;
|
|
|
|
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;
|
|
begin
|
|
// get default output directory
|
|
OutputDir:=APackage.GetOutputDirectory(false);
|
|
if Assigned(OnGetWritablePkgOutputDirectory) then begin
|
|
// check if default output directory is writable
|
|
NewOutputDir:=OutputDir;
|
|
OnGetWritablePkgOutputDirectory(APackage,NewOutputDir);
|
|
if NewOutputDir<>OutputDir then begin
|
|
// default output directory is not writable => redirect to another place
|
|
OutputDir:=NewOutputDir;
|
|
APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride:=OutputDir;
|
|
end else begin
|
|
// default output directory is writable => no redirect
|
|
APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride:='';
|
|
end;
|
|
end;
|
|
StateFile:=APackage.GetStateFilename;
|
|
PkgSrcDir:=ExtractFilePath(APackage.GetSrcFilename);
|
|
|
|
// create the output directory
|
|
if not ForceDirectory(OutputDir) then begin
|
|
Result:=IDEMessageDialog(lisPkgMangUnableToCreateDirectory,
|
|
Format(lisPkgMangUnableToCreateOutputDirectoryForPackage, ['"',
|
|
OutputDir, '"', #13, APackage.IDAsString]),
|
|
mtError,[mbCancel,mbAbort]);
|
|
exit;
|
|
end;
|
|
|
|
// delete old Compile State file
|
|
if FileExistsUTF8(StateFile) and not DeleteFileUTF8(StateFile) then begin
|
|
Result:=IDEMessageDialog(lisPkgMangUnableToDeleteFilename,
|
|
Format(lisPkgMangUnableToDeleteOldStateFileForPackage, ['"', StateFile,
|
|
'"', #13, APackage.IDAsString]),
|
|
mtError,[mbCancel,mbAbort]);
|
|
exit;
|
|
end;
|
|
APackage.Flags:=APackage.Flags-[lpfStateFileLoaded];
|
|
|
|
// create the package src directory
|
|
if not ForceDirectory(PkgSrcDir) then begin
|
|
Result:=IDEMessageDialog(lisPkgMangUnableToCreateDirectory,
|
|
Format(lisPkgMangUnableToCreatePackageSourceDirectoryForPackage, ['"',
|
|
PkgSrcDir, '"', #13, APackage.IDAsString]),
|
|
mtError,[mbCancel,mbAbort]);
|
|
exit;
|
|
end;
|
|
|
|
// clean up if wanted
|
|
if CleanUp then begin
|
|
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';
|
|
Result:=DeleteFileInteractive(OutputFileName,[mbIgnore,mbAbort]);
|
|
if Result in [mrCancel,mrAbort] then exit;
|
|
end;
|
|
end;
|
|
|
|
Result:=mrOk;
|
|
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, '"', #13, APackage.IDAsString, #13, #13]),
|
|
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
|
|
begin
|
|
Result:=mrCancel;
|
|
exit;
|
|
end;
|
|
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+'.ppw');
|
|
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;
|
|
OutputDir: String;
|
|
OldShortenSrc: String;
|
|
NeedsRegisterProcCall: boolean;
|
|
CurSrcUnitName: String;
|
|
NewShortenSrc: String;
|
|
BeautifyCodeOptions: TBeautifyCodeOptions;
|
|
begin
|
|
{$IFDEF VerbosePkgCompile}
|
|
debugln('TLazPackageGraph.SavePackageMainSource A');
|
|
{$ENDIF}
|
|
// check if package is ready for saving
|
|
OutputDir:=APackage.GetOutputDirectory;
|
|
if not DirPathExists(OutputDir) then begin
|
|
Result:=IDEMessageDialogAb(lisEnvOptDlgDirectoryNotFound,
|
|
Format(lisPkgMangPackageHasNoValidOutputDirectory, ['"',
|
|
APackage.IDAsString, '"', #13, '"', OutputDir, '"']),
|
|
mtError,[mbCancel],ShowAbort);
|
|
exit;
|
|
end;
|
|
|
|
SrcFilename:=APackage.GetSrcFilename;
|
|
|
|
// delete ambiguous files
|
|
Result:=DeleteAmbiguousFiles(SrcFilename);
|
|
if Result=mrAbort then begin
|
|
DebugLn('TLazPackageGraph.SavePackageMainSource DoDeleteAmbiguousFiles failed');
|
|
exit;
|
|
end;
|
|
|
|
// collect unitnames
|
|
e:=LineEnding;
|
|
UsedUnits:='';
|
|
RegistrationCode:='';
|
|
for i:=0 to APackage.FileCount-1 do begin
|
|
CurFile:=APackage.Files[i];
|
|
if CurFile.FileType=pftMainUnit then continue;
|
|
// update unitname
|
|
if FilenameIsPascalUnit(CurFile.Filename)
|
|
and (CurFile.FileType in PkgFileUnitTypes) then begin
|
|
NeedsRegisterProcCall:=CurFile.HasRegisterProc
|
|
and (APackage.PackageType in [lptDesignTime,lptRunAndDesignTime]);
|
|
if not (NeedsRegisterProcCall or CurFile.AddToUsesPkgSection) then
|
|
continue;
|
|
|
|
CurUnitName:=ExtractFileNameOnly(CurFile.Filename);
|
|
|
|
if CurUnitName=lowercase(CurUnitName) then begin
|
|
// the filename is all lowercase, so we can use the nicer unitname from
|
|
// the source.
|
|
|
|
CodeBuffer:=CodeToolBoss.LoadFile(CurFile.Filename,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<>'') and IsValidIdent(CurUnitName) then begin
|
|
if UsedUnits<>'' then
|
|
UsedUnits:=UsedUnits+', ';
|
|
UsedUnits:=UsedUnits+CurUnitName;
|
|
if NeedsRegisterProcCall then begin
|
|
RegistrationCode:=RegistrationCode+
|
|
' RegisterUnit('''+CurUnitName+''',@'+CurUnitName+'.Register);'+e;
|
|
end;
|
|
end else begin
|
|
AddMessage('WARNING: unit name invalid '+CurFile.Filename
|
|
+', package='+APackage.IDAsString,
|
|
APackage.Directory);
|
|
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;
|
|
if UsedUnits<>'' then UsedUnits:=UsedUnits+', ';
|
|
UsedUnits:=UsedUnits+'LazarusPackageIntf';
|
|
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)
|
|
PkgUnitName := ExtractFileNameOnly(SrcFilename);
|
|
if AnsiSameText(APackage.Name, PkgUnitName) then
|
|
PkgUnitName := APackage.Name;
|
|
Src:='unit '+ PkgUnitName +';'+e
|
|
+e
|
|
+'interface'+e
|
|
+e;
|
|
Src:=BeautifyCodeOptions.BeautifyStatement(Src,0);
|
|
Src:=HeaderSrc+Src;
|
|
if UsedUnits<>'' then
|
|
Src:=Src
|
|
+BreakString('uses'+e+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('TLazPackageGraph.SavePackageMainSource LoadCodeBuffer ',SrcFilename,' failed');
|
|
exit;
|
|
end;
|
|
OldShortenSrc:=CodeToolBoss.ExtractCodeWithoutComments(CodeBuffer);
|
|
NewShortenSrc:=CleanCodeFromComments(Src,
|
|
CodeToolBoss.GetNestedCommentsFlagForFile(CodeBuffer.Filename));
|
|
if CompareTextIgnoringSpace(OldShortenSrc,NewShortenSrc,true)=0 then begin
|
|
Result:=mrOk;
|
|
exit;
|
|
end;
|
|
if OldShortenSrc<>NewShortenSrc then begin
|
|
DebugLn('TLazPackageGraph.SavePackageMainSource Src changed ',dbgs(length(OldShortenSrc)),' ',dbgs(length(NewShortenSrc)));
|
|
end;
|
|
|
|
// save source
|
|
Result:=SaveStringToFile(SrcFilename,Src,[],lisPkgMangpackageMainSourceFile);
|
|
if Result<>mrOk then begin
|
|
DebugLn('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(
|
|
var ListOfPackages: TFPList);
|
|
// if package source is changed in IDE (codetools)
|
|
// then changes on disk are ignored
|
|
var
|
|
APackage: TLazPackage;
|
|
i: Integer;
|
|
begin
|
|
MarkNeededPackages;
|
|
for i:=FItems.Count-1 downto 0 do begin
|
|
APackage:=TLazPackage(FItems[i]);
|
|
if (not (lpfNeeded in APackage.Flags))
|
|
or APackage.ReadOnly or APackage.Modified
|
|
or (APackage.LPKSource=nil) then
|
|
continue;
|
|
if (not APackage.LPKSource.FileNeedsUpdate) then
|
|
continue;
|
|
if ListOfPackages=nil then
|
|
ListOfPackages:=TFPList.Create;
|
|
ListOfPackages.Add(APackage);
|
|
end;
|
|
end;
|
|
|
|
procedure TLazPackageGraph.CalculateTopologicalLevels;
|
|
|
|
procedure GetTopologicalOrder(CurDependency: TPkgDependency;
|
|
out MaxChildLevel: integer);
|
|
var
|
|
RequiredPackage: TLazPackage;
|
|
CurMaxChildLevel: integer;
|
|
begin
|
|
MaxChildLevel:=0;
|
|
while CurDependency<>nil do begin
|
|
if CurDependency.LoadPackageResult=lprSuccess then begin
|
|
RequiredPackage:=CurDependency.RequiredPackage;
|
|
if (not (lpfVisited in RequiredPackage.Flags)) then begin
|
|
RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited];
|
|
GetTopologicalOrder(RequiredPackage.FirstRequiredDependency,
|
|
CurMaxChildLevel);
|
|
RequiredPackage.TopologicalLevel:=CurMaxChildLevel+1;
|
|
end;
|
|
if RequiredPackage.TopologicalLevel>MaxChildLevel then
|
|
MaxChildLevel:=RequiredPackage.TopologicalLevel;
|
|
end;
|
|
CurDependency:=CurDependency.NextRequiresDependency;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
Pkg: TLazPackage;
|
|
CurMaxChildLevel: integer;
|
|
begin
|
|
for i:=FItems.Count-1 downto 0 do begin
|
|
Pkg:=TLazPackage(FItems[i]);
|
|
Pkg.Flags:=Pkg.Flags-[lpfVisited];
|
|
Pkg.TopologicalLevel:=0;
|
|
end;
|
|
for i:=FItems.Count-1 downto 0 do begin
|
|
Pkg:=TLazPackage(FItems[i]);
|
|
GetTopologicalOrder(Pkg.FirstRequiredDependency,CurMaxChildLevel);
|
|
Pkg.TopologicalLevel:=CurMaxChildLevel+1;
|
|
end;
|
|
end;
|
|
|
|
procedure TLazPackageGraph.SortDependencyListTopologically(
|
|
var FirstDependency: TPkgDependency; TopLevelFirst: boolean);
|
|
// Sort dependency list topologically.
|
|
// If TopLevelFirst is true then packages that needs others come first
|
|
var
|
|
Dependency: TPkgDependency;
|
|
BucketStarts: PInteger;
|
|
MaxLvl: Integer;
|
|
BucketCount: Integer;
|
|
DependencyCount: Integer;
|
|
Dependencies: PPkgDependency;
|
|
i: Integer;
|
|
j: Integer;
|
|
CurLvl: LongInt;
|
|
begin
|
|
CalculateTopologicalLevels;
|
|
|
|
// Bucket sort dependencies
|
|
MaxLvl:=0;
|
|
Dependency:=FirstDependency;
|
|
DependencyCount:=0;
|
|
while Dependency<>nil do begin
|
|
if Dependency.RequiredPackage<>nil then begin
|
|
if MaxLvl<Dependency.RequiredPackage.TopologicalLevel then
|
|
MaxLvl:=Dependency.RequiredPackage.TopologicalLevel;
|
|
end;
|
|
Dependency:=Dependency.NextRequiresDependency;
|
|
inc(DependencyCount);
|
|
end;
|
|
if (MaxLvl=0) or (DependencyCount<=1) then exit;
|
|
|
|
//debugln('TLazPackageGraph.SortDependencyListTopologically A MaxLvl=',dbgs(MaxLvl),' ',dbgs(DependencyCount));
|
|
// compute BucketStarts
|
|
BucketCount:=MaxLvl+1;
|
|
GetMem(BucketStarts,SizeOf(Integer)*BucketCount);
|
|
FillChar(BucketStarts^,SizeOf(Integer)*BucketCount,0);
|
|
Dependency:=FirstDependency;
|
|
while Dependency<>nil do begin
|
|
if Dependency.RequiredPackage<>nil then
|
|
CurLvl:=Dependency.RequiredPackage.TopologicalLevel
|
|
else
|
|
CurLvl:=0;
|
|
if CurLvl+1<BucketCount then
|
|
inc(BucketStarts[CurLvl+1]);
|
|
Dependency:=Dependency.NextRequiresDependency;
|
|
end;
|
|
for i:=2 to MaxLvl do
|
|
BucketStarts[i]:=BucketStarts[i]+BucketStarts[i-1];
|
|
BucketStarts[0]:=0;
|
|
|
|
// put Dependencies into buckets
|
|
GetMem(Dependencies,SizeOf(Pointer)*DependencyCount);
|
|
FillChar(Dependencies^,SizeOf(Pointer)*DependencyCount,0);
|
|
Dependency:=FirstDependency;
|
|
while Dependency<>nil 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 (i<j) do begin
|
|
Dependency:=Dependencies[i];
|
|
Dependencies[i]:=Dependencies[j];
|
|
Dependencies[j]:=Dependency;
|
|
inc(i);
|
|
dec(j);
|
|
end;
|
|
end;
|
|
|
|
// commit order
|
|
FirstDependency:=Dependencies[0];
|
|
for i:=0 to DependencyCount-1 do begin
|
|
Dependency:=Dependencies[i];
|
|
//debugln('TLazPackageGraph.SortDependencyListTopologically A ',Dependency.AsString);
|
|
if i=0 then
|
|
Dependency.PrevDependency[pdlRequires]:=nil
|
|
else
|
|
Dependency.PrevDependency[pdlRequires]:=Dependencies[i-1];
|
|
if i=DependencyCount-1 then
|
|
Dependency.NextDependency[pdlRequires]:=nil
|
|
else
|
|
Dependency.NextDependency[pdlRequires]:=Dependencies[i+1];
|
|
end;
|
|
|
|
// clean up
|
|
FreeMem(BucketStarts);
|
|
FreeMem(Dependencies);
|
|
end;
|
|
|
|
function TLazPackageGraph.CheckIfPackageCanBeClosed(APackage: TLazPackage
|
|
): boolean;
|
|
begin
|
|
MarkNeededPackages;
|
|
Result:=lpfNeeded in APackage.Flags;
|
|
end;
|
|
|
|
function TLazPackageGraph.PackageIsNeeded(APackage: TLazPackage): boolean;
|
|
// check if package is currently in use (installed, autoinstall, editor open,
|
|
// or used by a needed dependency)
|
|
// !!! it does not check if any needed package needs this package
|
|
begin
|
|
Result:=true;
|
|
// check if package is open, installed or will be installed
|
|
if (APackage.Installed<>pitNope) or (APackage.AutoInstall<>pitNope)
|
|
or ((APackage.Editor<>nil) and (APackage.Editor.Visible))
|
|
or (APackage.HoldPackageCount>0) then
|
|
begin
|
|
exit;
|
|
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);
|
|
|
|
// register IDE built-in packages (Note: codetools do not need this)
|
|
RegisterStaticPackage(FCLPackage,@RegisterFCL.Register);
|
|
RegisterStaticPackage(LCLPackage,@RegisterLCL.Register);
|
|
if Assigned(OnTranslatePackage) then OnTranslatePackage(CodeToolsPackage);
|
|
RegisterStaticPackage(IDEIntfPackage,@RegisterIDEIntf.Register);
|
|
RegisterStaticPackage(SynEditPackage,@RegisterSynEdit.Register);
|
|
|
|
// register custom IDE components
|
|
RegistrationPackage:=DefaultPackage;
|
|
if IDEComponentPalette<>nil then
|
|
IDEComponentPalette.RegisterCustomIDEComponents(@RegisterCustomIDEComponent);
|
|
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;
|
|
IncreaseCompilerParseStamp;
|
|
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);
|
|
EndUpdate;
|
|
end;
|
|
|
|
procedure TLazPackageGraph.ChangeDependency(Dependency,
|
|
NewDependency: TPkgDependency);
|
|
begin
|
|
if Dependency.Compare(NewDependency)=0 then exit;
|
|
BeginUpdate(true);
|
|
Dependency.Assign(NewDependency);
|
|
Dependency.LoadPackageResult:=lprUndefined;
|
|
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;
|
|
if OpenDependencyWithPackageLink(Dependency,PkgLink,false)<>mrOk then
|
|
PkgLinks.RemoveLink(PkgLink);
|
|
PkgLink.Release;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
ANode: TAVLTreeNode;
|
|
CurDir: String;
|
|
AFilename: String;
|
|
MsgResult: TModalResult;
|
|
APackage: TLazPackage;
|
|
PreferredFilename: string;
|
|
PkgLink: TPackageLink;
|
|
begin
|
|
if Dependency.LoadPackageResult=lprUndefined then begin
|
|
//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;
|
|
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
|
|
OpenFile(PreferredFilename);
|
|
end;
|
|
end;
|
|
if Dependency.LoadPackageResult=lprUndefined then begin
|
|
// no compatible package yet open
|
|
Dependency.RequiredPackage:=nil;
|
|
Dependency.LoadPackageResult:=lprNotFound;
|
|
APackage:=FindAPackageWithName(Dependency.PackageName,nil);
|
|
if APackage=nil then begin
|
|
// no package with same name open
|
|
// -> try package links
|
|
repeat
|
|
PkgLink:=PkgLinks.FindLinkWithDependency(Dependency);
|
|
if (PkgLink=nil) then break;
|
|
PkgLink.Reference;
|
|
try
|
|
MsgResult:=OpenDependencyWithPackageLink(Dependency,PkgLink,ShowAbort);
|
|
if MsgResult=mrOk then break;
|
|
PkgLinks.RemoveLink(PkgLink);
|
|
finally
|
|
PkgLink.Release;
|
|
end;
|
|
until MsgResult=mrAbort;
|
|
// try defaultfilename
|
|
if (Dependency.LoadPackageResult=lprNotFound)
|
|
and (Dependency.DefaultFilename<>'') then begin
|
|
AFilename:=Dependency.FindDefaultFilename;
|
|
if AFilename<>'' then begin
|
|
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
|
|
AFilename:=FindDiskFileCaseInsensitive(
|
|
AppendPathDelim(CurDir)+Dependency.PackageName+'.lpk');
|
|
if FileExistsCached(AFilename) then begin
|
|
OpenFile(AFilename);
|
|
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(['TLazPackageGraph.OpenDependency another package with wrong version is already open: Dependency=',Dependency.AsString,' Pkg=',APackage.IDAsString]);
|
|
Dependency.LoadPackageResult:=lprLoadError;
|
|
end;
|
|
end;
|
|
fChanged:=true;
|
|
EndUpdate;
|
|
end;
|
|
Result:=Dependency.LoadPackageResult;
|
|
end;
|
|
|
|
procedure TLazPackageGraph.OpenInstalledDependency(Dependency: TPkgDependency;
|
|
InstallType: TPackageInstallType; var Quiet: boolean);
|
|
var
|
|
BrokenPackage: TLazPackage;
|
|
CurResult: TModalResult;
|
|
BasePackage: TLazPackage;
|
|
begin
|
|
OpenDependency(Dependency,false);
|
|
if Dependency.LoadPackageResult<>lprSuccess then begin
|
|
// a valid lpk file of the installed package can not be found
|
|
if IsStaticBasePackage(Dependency.PackageName) then begin
|
|
// this is one of the Lazarus base packages
|
|
// auto create the built in version
|
|
BasePackage:=CreateLazarusBasePackage(Dependency.PackageName);
|
|
if BasePackage<>nil then begin
|
|
AddPackage(BasePackage);
|
|
//DebugLn('TLazPackageGraph.OpenInstalledDependency lpk not found using built-in ',BasePackage.IDAsString,' ',dbgs(ord(BasePackage.AutoInstall)));
|
|
if not Quiet then begin
|
|
// don't bother the user
|
|
end;
|
|
end;
|
|
end else begin
|
|
// -> create a broken package
|
|
BrokenPackage:=TLazPackage.Create;
|
|
with BrokenPackage do begin
|
|
BeginUpdate;
|
|
Missing:=true;
|
|
AutoCreated:=true;
|
|
Name:=Dependency.PackageName;
|
|
Filename:='';
|
|
Version.SetValues(0,0,0,0);
|
|
Author:='?';
|
|
License:='?';
|
|
AutoUpdate:=pupManually;
|
|
Description:=lisPkgSysThisPackageIsInstalledButTheLpkFileWasNotFound;
|
|
PackageType:=lptDesignTime;
|
|
Installed:=pitStatic;
|
|
AutoInstall:=pitNope;
|
|
CompilerOptions.UnitOutputDirectory:='';
|
|
|
|
// add lazarus registration unit path
|
|
UsageOptions.UnitPath:='';
|
|
|
|
Modified:=false;
|
|
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:=QuestionDlg(lisPkgSysPackageFileNotFound,
|
|
Format(lisPkgSysThePackageIsInstalledButNoValidPackageFileWasFound, ['"',
|
|
BrokenPackage.Name, '"', #13]),
|
|
mtError,[mrOk,mrYesToAll,'Skip these warnings'],0);
|
|
if CurResult=mrYesToAll then
|
|
Quiet:=true;
|
|
end;
|
|
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(
|
|
FirstDependency: TPkgDependency; out List: TFPList);
|
|
// returns packages in topological order, beginning with the top level package
|
|
|
|
procedure GetTopologicalOrder(CurDependency: TPkgDependency);
|
|
var
|
|
RequiredPackage: TLazPackage;
|
|
begin
|
|
while CurDependency<>nil do begin
|
|
//debugln('TLazPackageGraph.GetAllRequiredPackages A ',CurDependency.AsString,' ',dbgs(ord(CurDependency.LoadPackageResult)),' ',dbgs(ord(lprSuccess)));
|
|
if CurDependency.LoadPackageResult=lprSuccess then begin
|
|
//debugln('TLazPackageGraph.GetAllRequiredPackages B ',CurDependency.AsString);
|
|
RequiredPackage:=CurDependency.RequiredPackage;
|
|
if (not (lpfVisited in RequiredPackage.Flags)) then begin
|
|
RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited];
|
|
GetTopologicalOrder(RequiredPackage.FirstRequiredDependency);
|
|
// add package to list
|
|
if List=nil then List:=TFPList.Create;
|
|
List.Add(RequiredPackage);
|
|
end;
|
|
end;
|
|
CurDependency:=CurDependency.NextRequiresDependency;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
j: Integer;
|
|
begin
|
|
List:=nil;
|
|
MarkAllPackagesAsNotVisited;
|
|
// create topological list, beginning with the leaves
|
|
GetTopologicalOrder(FirstDependency);
|
|
// reverse list order
|
|
if List<>nil then begin
|
|
i:=0;
|
|
j:=List.Count-1;
|
|
while i<j do begin
|
|
List.Exchange(i,j);
|
|
inc(i);
|
|
dec(j);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TLazPackageGraph.GetConnectionsTree(FirstDependency: TPkgDependency;
|
|
var PkgList: TFPList; var Tree: TPkgPairTree);
|
|
|
|
procedure AddConnection(Pkg1, Pkg2: TLazPackage);
|
|
begin
|
|
if Pkg1=Pkg2 then exit;
|
|
if Tree=nil then
|
|
Tree:=TPkgPairTree.Create;
|
|
Tree.AddPairIfNotExists(Pkg1,Pkg2);
|
|
end;
|
|
|
|
procedure AddConnections(StartDependency: TPkgDependency);
|
|
// add every connection between owner and required package
|
|
// and between two childs
|
|
var
|
|
OwnerPackage: TLazPackage;
|
|
Dependency1: TPkgDependency;
|
|
Dependency2: TPkgDependency;
|
|
Pkg1: TLazPackage;
|
|
Pkg2: TLazPackage;
|
|
begin
|
|
if StartDependency=nil then exit;
|
|
if (StartDependency.Owner is TLazPackage) then
|
|
OwnerPackage:=TLazPackage(StartDependency.Owner)
|
|
else
|
|
OwnerPackage:=nil;
|
|
Dependency1:=StartDependency;
|
|
while Dependency1<>nil 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(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.
|
|
|
|
|