implemented global and user package links

git-svn-id: trunk@3995 -

ide/editoroptions.pp

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

ide/lazconf.pp

@@ -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
 

packager/globallinks/README

@@ -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
+Where <pkgname> is a valid pascal identifier and <version> is for example
-example 1.2.3.4 (four integers divided by point).
+1.2.3.4 (four integers divided by point).
 Each file should contain a single absolute filename.
 
 

packager/packagedefs.pas

@@ -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);
@@ -871,6 +964,11 @@ begin
   Result:=not FilenameIsAbsolute(Filename);
 end;
 
+procedure TLazPackage.CheckInnerDependencies;
+begin
+
+end;
+
 { TPkgComponent }
 
 constructor TPkgComponent.Create(ThePkgFile: TPkgFile;

packager/packagelinks.pas

@@ -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.