paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-14 07:59:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented global and user package links

Browse Source 
git-svn-id: trunk@3995 -
This commit is contained in:
mattias 2003-04-01 22:49:47 +00:00
parent 785fa3ffb3
commit ea9a0852aa
5 changed files with 455 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
ide/editoroptions.pp
View File

@ -1039,8 +1039,15 @@ begin
if (not FileExists(ConfFileName)) then begin
writeln('NOTE: editor options config file not found - using defaults');
end;
XMLConfig:=TXMLConfig.Create(ConfFileName);
try
XMLConfig:=TXMLConfig.Create(ConfFileName);
except
on E: Exception do begin
writeln('WARNING: unable to read ',ConfFileName);
XMLConfig:=nil;
end;
end;
// set defaults
// General options

5
ide/lazconf.pp
View File

@ -52,7 +52,7 @@ uses
{ The primary config path is the local or user specific path.
If the primary config path does not exists, it will automatically be
created.
created by the IDE.
The secondary config path is for templates. The IDE will never write to it.
If a config file is not found in the primary config file, Lazarus will
copy the template file from the secondary config file. If there is no
@ -124,6 +124,9 @@ end.
{
$Log$
Revision 1.15 2003/04/01 22:49:47 mattias
implemented global and user package links
Revision 1.14 2003/03/13 10:11:41 mattias
fixed TControl.Show in design mode

4
packager/globallinks/README
View File

@ -3,8 +3,8 @@ This directory is used for global "package links".
"Package links" are used by the IDE whenever it searches the .lpk file of a
required package. The files should have filenames with the format
<pkgname>-<version>.lpl.
Where <pkgname> is a valid pascal identifier in lowercase and <version> is for
example 1.2.3.4 (four integers divided by point).
Where <pkgname> is a valid pascal identifier and <version> is for example
1.2.3.4 (four integers divided by point).
Each file should contain a single absolute filename.

106
packager/packagedefs.pas
View File

@ -65,6 +65,8 @@ type
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
FileVersion: integer);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
function Compare(Version2: TPkgVersion): integer;
procedure Assign(Source: TPkgVersion);
end;
@ -129,7 +131,8 @@ type
TPkgDependencyFlag = (
pdfMinVersion, // >= MinVersion
pdfMaxVersion // <= MaxVersion
pdfMaxVersion, // <= MaxVersion
pdfActive
);
TPkgDependencyFlags = set of TPkgDependencyFlag;
@ -150,6 +153,11 @@ type
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
FileVersion: integer);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
function MakeSense: boolean;
function IsCompatible(const Version: TPkgVersion): boolean;
function IsCompatible(const PkgName: string;
const Version: TPkgVersion): boolean;
function Compare(Dependency2: TPkgDependency): integer;
public
property PackageName: string read FPackageName write SetPackageName;
property Flags: TPkgDependencyFlags read FFlags write SetFlags;
@ -244,6 +252,7 @@ type
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
function IsVirtual: boolean;
procedure CheckInnerDependencies;
public
property Author: string read FAuthor write SetAuthor;
property AutoIncrementVersionOnBuild: boolean
@ -299,7 +308,7 @@ const
PkgFileFlag: array[TPkgFileFlag] of string = (
'pffHasRegisterProc');
PkgDependencyFlagNames: array[TPkgDependencyFlag] of string = (
'pdfMinVersion', 'pdfMaxVersion');
'pdfMinVersion', 'pdfMaxVersion', 'pdfActive');
LazPackageTypeNames: array[TLazPackageType] of string = (
'lptRunTime', 'lptDesignTime', 'lptRunAndDesignTime');
LazPackageTypeIdents: array[TLazPackageType] of string = (
@ -311,7 +320,7 @@ const
function PkgFileTypeIdentToType(const s: string): TPkgFileType;
function LazPackageTypeIdentToType(const s: string): TLazPackageType;
procedure SortDependencyList(Dependencies: TList);
implementation
@ -330,6 +339,40 @@ begin
Result:=lptRunTime;
end;
procedure SortDependencyList(Dependencies: TList);
var
Count: Integer;
i, j: Integer;
Dependency1: TPkgDependency;
Dependency2: TPkgDependency;
Sorted: Boolean;
begin
if (Dependencies=nil) or (Dependencies.Count<2) then exit;
// check if already sorted
Count:=Dependencies.Count;
Sorted:=true;
for i:=0 to Count-2 do begin
Dependency1:=TPkgDependency(Dependencies[i]);
Dependency2:=TPkgDependency(Dependencies[i+1]);
if Dependency1.Compare(Dependency2)>0 then begin
Sorted:=false;
break;
end;
end;
if Sorted then exit;
// bubble sort (slow, but dependency lists are normally sorted)
for i:=0 to Count-2 do begin
Dependency1:=TPkgDependency(Dependencies[i]);
for j:=i+1 to Count-1 do begin
Dependency2:=TPkgDependency(Dependencies[j]);
if Dependency1.Compare(Dependency2)>0 then begin
Dependencies.Exchange(i,j);
Dependency1:=TPkgDependency(Dependencies[i]);
end;
end;
end;
end;
{ TPkgFile }
procedure TPkgFile.SetFilename(const AValue: string);
@ -473,6 +516,39 @@ begin
XMLConfig.SetDeleteValue(Path+'MinVersion/Value',pdfMinVersion in FFlags,false);
end;
function TPkgDependency.MakeSense: boolean;
begin
Result:=(pdfActive in FFlags) and IsValidIdent(PackageName);
if Result
and (pdfMinVersion in FFlags) and (pdfMaxVersion in FFlags)
and (MinVersion.Compare(MaxVersion)>0) then
Result:=false;
end;
function TPkgDependency.IsCompatible(const Version: TPkgVersion): boolean;
begin
if ((pdfMinVersion in FFlags) and (MinVersion.Compare(Version)>0))
or ((pdfMaxVersion in FFlags) and (MaxVersion.Compare(Version)<0)) then
Result:=false
else
Result:=true;
end;
function TPkgDependency.IsCompatible(const PkgName: string;
const Version: TPkgVersion): boolean;
begin
Result:=(AnsiCompareText(PkgName,PackageName)=0) and IsCompatible(Version);
end;
function TPkgDependency.Compare(Dependency2: TPkgDependency): integer;
begin
Result:=AnsiCompareText(PackageName,Dependency2.PackageName);
if Result<>0 then exit;
Result:=MinVersion.Compare(Dependency2.MinVersion);
if Result<>0 then exit;
Result:=MaxVersion.Compare(Dependency2.MaxVersion);
end;
{ TPkgVersion }
procedure TPkgVersion.Clear;
@ -503,6 +579,22 @@ begin
XMLConfig.SetDeleteValue(Path+'Release',Release,0);
end;
function TPkgVersion.Compare(Version2: TPkgVersion): integer;
begin
Result:=Major-Version2.Major;
if Result=0 then Result:=Minor-Version2.Minor;
if Result=0 then Result:=Build-Version2.Build;
if Result=0 then Result:=Release-Version2.Release;
end;
procedure TPkgVersion.Assign(Source: TPkgVersion);
begin
Major:=Source.Major;
Minor:=Source.Minor;
Build:=Source.Build;
Release:=Source.Release;
end;
{ TLazPackage }
function TLazPackage.GetAutoIncrementVersionOnBuild: boolean;
@ -760,6 +852,7 @@ var
FileVersion);
List.Add(PkgDependency);
end;
SortDependencyList(List);
end;
procedure LoadFiles(const ThePath: string; List: TList);
@ -792,7 +885,7 @@ var
else
Exclude(FFlags,lpfOpenInIDE);
end;
begin
FileVersion:=XMLConfig.GetValue(Path+'Version',0);
if FileVersion=1 then ;
@ -871,6 +964,11 @@ begin
Result:=not FilenameIsAbsolute(Filename);
end;
procedure TLazPackage.CheckInnerDependencies;
begin
end;
{ TPkgComponent }
constructor TPkgComponent.Create(ThePkgFile: TPkgFile;

340
packager/packagelinks.pas
View File

@ -38,9 +38,12 @@ unit PackageLinks;
interface
uses
Classes, SysUtils;
Classes, SysUtils, AVL_Tree, Laz_XMLCfg, FileCtrl, IDEProcs, EnvironmentOpts,
PackageDefs, LazConf;
type
{ TPackageLink }
TPkgLinkOrigin = (
ploGlobal,
ploUser
@ -49,17 +52,80 @@ type
TPackageLink = class
private
FFilename: string;
FOrigin: TPkgLinkOrigin;
FPkgName: string;
FVersion: TPkgVersion;
procedure SetFilename(const AValue: string);
procedure SetOrigin(const AValue: TPkgLinkOrigin);
procedure SetPkgName(const AValue: string);
procedure SetVersion(const AValue: TPkgVersion);
public
constructor Create;
destructor Destroy; override;
function Compare(Link2: TPackageLink): integer;
public
property Origin: TPkgLinkOrigin read FOrigin write SetOrigin;
property PkgName: string read FPkgName write SetPkgName;
property Version: TPkgVersion read FVersion write SetVersion;
property Filename: string read FFilename write SetFilename;
end;
{ TPackageLinks }
TPackageLinks = class
private
FGlobalLinks: TAVLTree; // tree of TPackageLink
FUserLinks: TAVLTree; // tree of TPackageLink
function FindLeftMostNode(LinkTree: TAVLTree;
const PkgName: string): TAVLTreeNode;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure UpdateGlobalLinks;
procedure UpdateUserLinks;
procedure UpdateAll;
function FindPkgFileName(LinkTree: TAVLTree;
const PkgName: string): TPackageLink;
function FindPkgFilename(LinkTree: TAVLTree;
Dependency: TPkgDependency): TPackageLink;
function FindPkgFileName(const PkgName: string): TPackageLink;
function FindPkgFilename(Dependency: TPkgDependency): TPackageLink;
end;
implementation
const
UserPkgLinkFile = 'packagefiles.xml';
function ComparePackageLinks(Data1, Data2: Pointer): integer;
var
Link1: TPackageLink;
Link2: TPackageLink;
begin
Link1:=TPackageLink(Data1);
Link2:=TPackageLink(Data2);
Result:=Link1.Compare(Link2);
end;
function ComparePkgNameAndLink(Key, Data: Pointer): integer;
var
PkgName: String;
Link: TPackageLink;
begin
if Key=nil then
Result:=-1
else begin
PkgName:=AnsiString(Key);
Link:=TPackageLink(Data);
Result:=AnsiCompareText(PkgName,Link.PkgName);
end;
end;
{ TPackageLink }
procedure TPackageLink.SetOrigin(const AValue: TPkgLinkOrigin);
@ -68,15 +134,285 @@ begin
FOrigin:=AValue;
end;
procedure TPackageLink.SetFilename(const AValue: string);
begin
if FFilename=AValue then exit;
FFilename:=AValue;
end;
procedure TPackageLink.SetPkgName(const AValue: string);
begin
if FPkgName=AValue then exit;
FPkgName:=AValue;
end;
procedure TPackageLink.SetVersion(const AValue: TPkgVersion);
begin
if FVersion=AValue then exit;
FVersion:=AValue;
end;
constructor TPackageLink.Create;
begin
FVersion:=TPkgVersion.Create;
end;
destructor TPackageLink.Destroy;
begin
FVersion.Free;
inherited Destroy;
end;
function TPackageLink.Compare(Link2: TPackageLink): integer;
begin
Result:=AnsiCompareText(PkgName,Link2.PkgName);
if Result=0 then
Result:=Version.Compare(Link2.Version);
end;
{ TPackageLinks }
function TPackageLinks.FindLeftMostNode(LinkTree: TAVLTree;
const PkgName: string): TAVLTreeNode;
// find left most link with PkgName
var
PriorNode: TAVLTreeNode;
begin
Result:=nil;
if PkgName='' then exit;
Result:=LinkTree.FindKey(PChar(PkgName),@ComparePkgNameAndLink);
if Result=nil then exit;
// find left most
while Result<>nil do begin
PriorNode:=LinkTree.FindPrecessor(Result);
if (PriorNode=nil)
or (AnsiCompareText(TPackageLink(PriorNode.Data).PkgName,PkgName)<>0)
then
break;
Result:=PriorNode;
end;
end;
constructor TPackageLinks.Create;
begin
FGlobalLinks:=TAVLTree.Create(@ComparePackageLinks);
FUserLinks:=TAVLTree.Create(@ComparePackageLinks);
end;
destructor TPackageLinks.Destroy;
begin
Clear;
FGlobalLinks.Free;
FUserLinks.Free;
inherited Destroy;
end;
procedure TPackageLinks.Clear;
begin
FGlobalLinks.FreeAndClear;
FUserLinks.FreeAndClear;
end;
procedure TPackageLinks.UpdateGlobalLinks;
function ParseFilename(const Filename: string;
var PkgName: string; var PkgVersion: TPkgVersion): boolean;
// checks if filename has the form
// identifier-int.int.int.int.lpl
var
StartPos: Integer;
i: Integer;
EndPos: Integer;
ints: array[1..4] of integer;
begin
Result:=false;
StartPos:=1;
// parse identifier
if (StartPos>length(Filename))
or (not (Filename[StartPos] in ['a'..'z','A'..'Z'])) then exit;
inc(StartPos);
while (StartPos<=length(Filename))
and (Filename[StartPos] in ['a'..'z','A'..'Z']) do
inc(StartPos);
PkgName:=lowercase(copy(Filename,1,StartPos-1));
// parse -
if (StartPos>length(Filename)) or (Filename[StartPos]<>'-') then exit;
inc(StartPos);
// parse 4 times 'int.'
for i:=Low(ints) to High(ints) do begin
// parse int
EndPos:=StartPos;
while (EndPos<=length(Filename))
and (Filename[EndPos] in ['0'..'9']) do inc(EndPos);
ints[i]:=StrToIntDef(copy(Filename,StartPos,EndPos-StartPos),-1);
if (ints[i]<0) or (ints[i]>99999) then exit;
StartPos:=EndPos;
// parse .
if (StartPos>length(Filename)) or (Filename[StartPos]<>'.') then exit;
inc(StartPos);
end;
// parse lpl
if (AnsiCompareText(copy(Filename,StartPos,length(Filename)-StartPos+1),
'lpl')<>0) then exit;
PkgVersion.Major:=ints[1];
PkgVersion.Minor:=ints[2];
PkgVersion.Build:=ints[3];
PkgVersion.Release:=ints[4];
Result:=true;
end;
var
GlobalLinksDir: String;
FileInfo: TSearchRec;
NewPkgName: string;
PkgVersion: TPkgVersion;
NewPkgLink: TPackageLink;
sl: TStringList;
CurFilename: String;
NewFilename: string;
begin
FGlobalLinks.FreeAndClear;
GlobalLinksDir:=AppendPathDelim(EnvironmentOptions.LazarusDirectory)
+'packager'+PathDelim+'globallinks'+PathDelim;
if FindFirst(GlobalLinksDir+'*.lpl', faAnyFile, FileInfo)=0 then begin
PkgVersion:=TPkgVersion.Create;
repeat
CurFilename:=GlobalLinksDir+FileInfo.Name;
if ((FileInfo.Attr and faDirectory)<>0)
or (not ParseFilename(FileInfo.Name,NewPkgName,PkgVersion))
then begin
writeln('WARNING: suspicious pkg link file found (name): ',CurFilename);
continue;
end;
sl:=TStringList.Create;
try
sl.LoadFromFile(CurFilename);
if sl.Count<0 then begin
writeln('WARNING: suspicious pkg link file found (content): ',CurFilename);
continue;
end;
NewFilename:=sl[0];
except
on E: Exception do begin
writeln('ERROR: unable to read pkg link file: ',CurFilename,' : ',E.Message);
end;
end;
sl.Free;
NewPkgLink:=TPackageLink.Create;
NewPkgLink.PkgName:=NewPkgName;
NewPkgLink.Version.Assign(PkgVersion);
NewPkgLink.Filename:=NewFilename;
if IsValidIdent(NewPkgLink.PkgName) and FileExists(NewPkgLink.Filename)
then
FGlobalLinks.Add(NewPkgLink)
else
NewPkgLink.Free;
until FindNext(FileInfo)<>0;
if PkgVersion<>nil then PkgVersion.Free;
end;
FindClose(FileInfo);
end;
procedure TPackageLinks.UpdateUserLinks;
var
ConfigFilename: String;
Path: String;
XMLConfig: TXMLConfig;
LinkCount: Integer;
i: Integer;
NewPkgLink: TPackageLink;
ItemPath: String;
begin
FUserLinks.FreeAndClear;
ConfigFilename:=AppendPathDelim(GetPrimaryConfigPath)+'packagefiles.xml';
XMLConfig:=nil;
try
XMLConfig:=TXMLConfig.Create(ConfigFilename);
Path:='UserPkgLinks/';
LinkCount:=XMLConfig.GetValue(Path+'Count',0);
for i:=0 to LinkCount-1 do begin
ItemPath:=Path+'Item'+IntToStr(i)+'/';
NewPkgLink:=TPackageLink.Create;
NewPkgLink.PkgName:=XMLConfig.GetValue(ItemPath+'PkgName/Value','');
NewPkgLink.Version.LoadFromXMLConfig(XMLConfig,ItemPath+'Version/',
LazPkgXMLFileVersion);
NewPkgLink.Filename:=XMLConfig.GetValue(ItemPath+'Filename/Value','');
if IsValidIdent(NewPkgLink.PkgName) and FileExists(NewPkgLink.Filename)
then
FUserLinks.Add(NewPkgLink)
else
NewPkgLink.Free;
end;
except
on E: Exception do begin
writeln('WARNING: unable to read ',ConfigFilename);
exit;
end;
end;
if XMLConfig<>nil then XMLConfig.Free;
end;
procedure TPackageLinks.UpdateAll;
begin
UpdateGlobalLinks;
UpdateUserLinks;
end;
function TPackageLinks.FindPkgFileName(LinkTree: TAVLTree;
const PkgName: string): TPackageLink;
// find left most link with PkgName
var
CurNode: TAVLTreeNode;
begin
Result:=nil;
if PkgName='' then exit;
CurNode:=FindLeftMostNode(LinkTree,PkgName);
if CurNode=nil then exit;
Result:=TPackageLink(CurNode.Data);
end;
function TPackageLinks.FindPkgFilename(LinkTree: TAVLTree;
Dependency: TPkgDependency): TPackageLink;
var
Link: TPackageLink;
CurNode: TAVLTreeNode;
begin
Result:=nil;
if (Dependency=nil) or (not Dependency.MakeSense) then exit;
CurNode:=FindLeftMostNode(LinkTree,Dependency.PackageName);
while CurNode<>nil do begin
Link:=TPackageLink(CurNode.Data);
if Dependency.IsCompatible(Link.Version) then begin
Result:=Link;
break;
end;
CurNode:=LinkTree.FindSuccessor(CurNode);
if AnsiCompareText(TPackageLink(CurNode.Data).PkgName,Dependency.PackageName)
<>0
then begin
CurNode:=nil;
break;
end;
end;
end;
function TPackageLinks.FindPkgFileName(const PkgName: string): TPackageLink;
begin
Result:=FindPkgFileName(FUserLinks,PkgName);
if Result=nil then
Result:=FindPkgFileName(FGlobalLinks,PkgName);
end;
function TPackageLinks.FindPkgFilename(Dependency: TPkgDependency
): TPackageLink;
begin
Result:=FindPkgFileName(FUserLinks,Dependency);
if Result=nil then
Result:=FindPkgFileName(FGlobalLinks,Dependency);
end;
end.