lazarus-src-0.9.30.4 0.9.30.4-6 / usr / lib / lazarus / 0.9.30.4 / packager / packagelinks.pas

{
 /***************************************************************************
                            packagelinks.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:
    Package links helps the IDE to find package filenames by name.
    If you are searching for the dialog to see the package links: pkglinksdlg.pas

}
unit PackageLinks;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, AVL_Tree, Laz_XMLCfg, FileProcs, CodeToolManager,
  CodeCache, LCLProc, FileUtil, MacroIntf, PackageIntf, IDEProcs, DialogProcs,
  EnvironmentOpts, PackageDefs, LazConf;
  
const
  PkgLinksFileVersion = 2;

type

  { TPackageLink
    There are several types of package links.
    
    Global: These are collected from the lazarus source directory.
            EnvironmentOptions.LazarusDirectory+'packager/globallinks/*.lpl'
            This way packages can install/uninstall themselves to one lazarus
            source directory, and this lazarus directory can then be shared
            by several users/configs.
            
    User:   These are collected from the user config directory, from the file
            packagelinks.xml.
            These links are maintained by the IDE. Everytime the user opens a
            package a user link is created, so that the next time the package
            can be automatically opened. The list is checked by the IDE from
            time to time and missing packages are first marked and after several
            months deleted from the list.
  }

  TPkgLinkOrigin = (
    ploGlobal,
    ploUser
    );
  TPkgLinkOrigins = set of TPkgLinkOrigin;
  
const
  AllPkgLinkOrigins = [low(TPkgLinkOrigin)..high(TPkgLinkOrigin)];
  
type
  TPackageLink = class(TLazPackageID)
  private
    FAutoCheckExists: boolean;
    FFileDate: TDateTime;
    FFileDateValid: boolean;
    FFilename: string;
    FLastCheck: TDateTime;
    FLastCheckValid: boolean;
    FLastUsed: TDateTime;
    FNotFoundCount: integer;
    FOrigin: TPkgLinkOrigin;
    fReferenceCount: integer;
    procedure SetFilename(const AValue: string);
    procedure SetOrigin(const AValue: TPkgLinkOrigin);
  public
    constructor Create;
    destructor Destroy; override;
    function MakeSense: boolean;
    function GetEffectiveFilename: string;
    procedure Reference;
    procedure Release;
  public
    property Origin: TPkgLinkOrigin read FOrigin write SetOrigin;
    property Filename: string read FFilename write SetFilename;
    property AutoCheckExists: boolean read FAutoCheckExists write FAutoCheckExists;
    property NotFoundCount: integer read FNotFoundCount write FNotFoundCount;
    property LastCheckValid: boolean read FLastCheckValid write FLastCheckValid;
    property LastCheck: TDateTime read FLastCheck write FLastCheck;
    property FileDateValid: boolean read FFileDateValid write FFileDateValid;
    property FileDate: TDateTime read FFileDate write FFileDate;
    property LastUsed: TDateTime read FLastUsed write FLastUsed;
  end;


  { TPackageLinks }
  
  TPackageLinks = class;

  TPkgLinksState = (
    plsUserLinksNeedUpdate,
    plsGlobalLinksNeedUpdate
    );
  TPkgLinksStates = set of TPkgLinksState;
  
  TDependencyOwnerGetPkgFilename = function(PkgLinks: TPackageLinks;
                                 Dependency: TPkgDependency): boolean of object;

  TPackageLinks = class
  private
    FDependencyOwnerGetPkgFilename: TDependencyOwnerGetPkgFilename;
    FGlobalLinks: TAVLTree; // tree of global TPackageLink sorted for ID
    FModified: boolean;
    FUserLinksSortID: TAVLTree; // tree of user TPackageLink sorted for ID
    FUserLinksSortFile: TAVLTree; // tree of user TPackageLink sorted for
                                  // Filename and FileDate
    fUpdateLock: integer;
    FStates: TPkgLinksStates;
    function FindLeftMostNode(LinkTree: TAVLTree;
      const PkgName: string): TAVLTreeNode;
    function FindLinkWithPkgNameInTree(LinkTree: TAVLTree;
      const PkgName: string): TPackageLink;
    function FindLinkWithDependencyInTree(LinkTree: TAVLTree;
      Dependency: TPkgDependency): TPackageLink;
    function FindLinkWithPackageIDInTree(LinkTree: TAVLTree;
      APackageID: TLazPackageID): TPackageLink;
    procedure IteratePackagesInTree(MustExist: boolean; LinkTree: TAVLTree;
      Event: TIteratePackagesEvent);
    procedure SetModified(const AValue: boolean);
  public
    UserLinkLoadTime: longint;
    UserLinkLoadTimeValid: boolean;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function GetUserLinkFile(WithPath: boolean = true): string;
    function GetGlobalLinkDirectory: string;
    procedure UpdateGlobalLinks;
    procedure UpdateUserLinks;
    procedure UpdateAll;
    procedure RemoveOldUserLinks;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure SaveUserLinks;
    function NeedSaveUserLinks(const ConfigFilename: string): boolean;
    procedure WriteLinkTree(LinkTree: TAVLTree);
    function FindLinkWithPkgName(const PkgName: string): TPackageLink;
    function FindLinkWithDependency(Dependency: TPkgDependency): TPackageLink;
    function FindLinkWithPackageID(APackageID: TLazPackageID): TPackageLink;
    procedure IteratePackages(MustExist: boolean; Event: TIteratePackagesEvent;
                              Origins: TPkgLinkOrigins = AllPkgLinkOrigins);
    function AddUserLink(APackage: TLazPackage): TPackageLink;
    function AddUserLink(const PkgFilename, PkgName: string): TPackageLink;// do not this use if package is open in IDE
    procedure RemoveLink(APackageID: TLazPackageID);
  public
    property Modified: boolean read FModified write SetModified;
    property DependencyOwnerGetPkgFilename: TDependencyOwnerGetPkgFilename
                                           read FDependencyOwnerGetPkgFilename
                                           write FDependencyOwnerGetPkgFilename;
  end;
  
var
  PkgLinks: TPackageLinks = nil; // set by the PkgBoss

function ComparePackageLinks(Data1, Data2: Pointer): integer;


implementation


function ComparePackageLinks(Data1, Data2: Pointer): integer;
var
  Link1: TPackageLink;
  Link2: TPackageLink;
begin
  Link1:=TPackageLink(Data1);
  Link2:=TPackageLink(Data2);
  Result:=Link1.Compare(Link2);
end;

function ComparePackageIDAndLink(Key, Data: Pointer): integer;
var
  Link: TPackageLink;
  PkgID: TLazPackageID;
begin
  if Key=nil then
    Result:=-1
  else begin
    PkgID:=TLazPackageID(Key);
    Link:=TPackageLink(Data);
    Result:=PkgID.Compare(Link);
  end;
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:=CompareText(PkgName,Link.Name);
  end;
end;

function CompareLinksForFilenameAndFileAge(Data1, Data2: Pointer): integer;
var
  Link1: TPackageLink;
  Link2: TPackageLink;
begin
  Link1:=TPackageLink(Data1);
  Link2:=TPackageLink(Data2);
  // first compare filenames
  Result:=CompareFilenames(Link1.Filename,Link2.Filename);
  if Result<>0 then exit;
  // then compare file date
  if Link1.FileDateValid then begin
    if Link2.FileDateValid then begin
      if Link1.FileDate>Link2.FileDate then
        Result:=1
      else if Link1.FileDate<Link2.FileDate then
        Result:=-1;
    end else begin
      Result:=1;
    end;
  end else begin
    if Link2.FileDateValid then begin
      Result:=-1;
    end;
  end;
  if Result<>0 then exit;
  // finally compare version and name
  Result:=Link1.Compare(Link2);
end;

{ TPackageLink }

procedure TPackageLink.SetOrigin(const AValue: TPkgLinkOrigin);
begin
  if FOrigin=AValue then exit;
  FOrigin:=AValue;
end;

procedure TPackageLink.SetFilename(const AValue: string);
begin
  if FFilename=AValue then exit;
  FFilename:=TrimFilename(AValue);
end;

constructor TPackageLink.Create;
begin
  inherited Create;
  FAutoCheckExists:=true;
end;

destructor TPackageLink.Destroy;
begin
  //debugln('TPackageLink.Destroy ',IDAsString,' ',dbgs(Pointer(Self)));
  //if Origin=ploGlobal then RaiseException('');
  inherited Destroy;
end;

function TPackageLink.MakeSense: boolean;
begin
  Result:=(Name<>'') and IsValidIdent(Name)
           and PackageFileNameIsValid(Filename)
           and (CompareText(Name,ExtractFileNameOnly(Filename))=0);
end;

function TPackageLink.GetEffectiveFilename: string;
begin
  Result:=Filename;
  if (not FilenameIsAbsolute(Result))
  and (EnvironmentOptions.LazarusDirectory<>'') then
    Result:=TrimFilename(EnvironmentOptions.LazarusDirectory+PathDelim+Result);
end;

procedure TPackageLink.Reference;
begin
  inc(fReferenceCount);
end;

procedure TPackageLink.Release;
begin
  if fReferenceCount<=0 then RaiseGDBException('');
  dec(fReferenceCount);
  if fReferenceCount=0 then Free;
end;

{ TPackageLinks }

function TPackageLinks.FindLeftMostNode(LinkTree: TAVLTree;
  const PkgName: string): TAVLTreeNode;
// find left most link with PkgName
begin
  Result:=nil;
  if PkgName='' then exit;
  Result:=LinkTree.FindLeftMostKey(PChar(PkgName),@ComparePkgNameAndLink);
end;

constructor TPackageLinks.Create;
begin
  UserLinkLoadTimeValid:=false;
  FGlobalLinks:=TAVLTree.Create(@ComparePackageLinks);
  FUserLinksSortID:=TAVLTree.Create(@ComparePackageLinks);
  FUserLinksSortFile:=TAVLTree.Create(@CompareLinksForFilenameAndFileAge);
end;

destructor TPackageLinks.Destroy;
begin
  Clear;
  FGlobalLinks.Free;
  FUserLinksSortID.Free;
  FUserLinksSortFile.Free;
  inherited Destroy;
end;

procedure TPackageLinks.Clear;
begin
  FGlobalLinks.FreeAndClear;
  FUserLinksSortID.FreeAndClear;
  FUserLinksSortFile.Clear;
  FStates:=[plsUserLinksNeedUpdate,plsGlobalLinksNeedUpdate];
end;

function TPackageLinks.GetUserLinkFile(WithPath: boolean): string;
begin
  Result:='packagefiles.xml';
  if WithPath then
    Result:=AppendPathDelim(GetPrimaryConfigPath)+Result;
end;

function TPackageLinks.GetGlobalLinkDirectory: string;
begin
  Result:=AppendPathDelim(EnvironmentOptions.LazarusDirectory)
                                  +'packager'+PathDelim+'globallinks'+PathDelim;
end;

procedure TPackageLinks.UpdateGlobalLinks;

  function ParseFilename(const Filename: string;
    out PkgName: string; PkgVersion: TPkgVersion): boolean;
  // checks if filename has the form
  // <identifier>-<version>.lpl
  var
    StartPos: Integer;
    i: Integer;
    EndPos: Integer;
    ints: array[1..4] of integer;
  begin
    Result:=false;
    PkgName:='';
    if CompareFileExt(Filename,'.lpl',false)<>0 then exit;
    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','_','0'..'9']) do
      inc(StartPos);
    PkgName:=lowercase(copy(Filename,1,StartPos-1));
    // parse -
    if (StartPos>length(Filename)) or (Filename[StartPos]<>'-') then exit;
    inc(StartPos);
    // parse version (1-4 times 'int.')
    for i:=Low(ints) to High(ints) do ints[i]:=0;
    i:=Low(ints);
    while i<=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;
      if StartPos=length(Filename)-length('lpl') then break;
      inc(StartPos);
      inc(i);
    end;
    PkgVersion.Major:=ints[1];
    PkgVersion.Minor:=ints[2];
    PkgVersion.Release:=ints[3];
    PkgVersion.Build:=ints[4];
    Result:=true;
  end;

var
  GlobalLinksDir: String;
  FileInfo: TSearchRec;
  NewPkgName: string;
  PkgVersion: TPkgVersion;
  NewPkgLink: TPackageLink;
  sl: TStringList;
  CurFilename: String;
  NewFilename: string;
begin
  if fUpdateLock>0 then begin
    Include(FStates,plsGlobalLinksNeedUpdate);
    exit;
  end;
  Exclude(FStates,plsGlobalLinksNeedUpdate);
  
  FGlobalLinks.FreeAndClear;
  GlobalLinksDir:=GetGlobalLinkDirectory;
  //debugln('UpdateGlobalLinks A ',GlobalLinksDir);
  if FindFirstUTF8(GlobalLinksDir+'*.lpl', faAnyFile, FileInfo)=0 then begin
    PkgVersion:=TPkgVersion.Create;
    repeat
      CurFilename:=GlobalLinksDir+FileInfo.Name;
      //debugln('UpdateGlobalLinks B CurFilename=',CurFilename);
      if ((FileInfo.Attr and faDirectory)<>0)
      or (not ParseFilename(FileInfo.Name,NewPkgName,PkgVersion))
      then begin
        DebugLn('WARNING: suspicious pkg link file found (name): ',CurFilename);
        continue;
      end;
      NewFilename:='';
      sl:=TStringList.Create;
      try
        sl.LoadFromFile(UTF8ToSys(CurFilename));
        if sl.Count<=0 then begin
          DebugLn('WARNING: suspicious pkg link file found (content): ',CurFilename);
          continue;
        end;
        NewFilename:=SetDirSeparators(sl[0]);
      except
        on E: Exception do begin
          DebugLn('ERROR: unable to read pkg link file: ',CurFilename,' : ',E.Message);
        end;
      end;
      sl.Free;
      if NewFilename='' then continue;
      
      NewPkgLink:=TPackageLink.Create;
      NewPkgLink.Reference;
      NewPkgLink.Origin:=ploGlobal;
      NewPkgLink.Name:=NewPkgName;
      NewPkgLink.Version.Assign(PkgVersion);
      IDEMacros.SubstituteMacros(NewFilename);
      NewFilename:=TrimFilename(NewFilename);
      if (EnvironmentOptions.LazarusDirectory<>'')
      and (FileIsInDirectory(NewFilename,EnvironmentOptions.LazarusDirectory)) then
        NewFilename:=CreateRelativePath(NewFilename,EnvironmentOptions.LazarusDirectory);
      NewPkgLink.Filename:=NewFilename;
      //debugln('TPackageLinks.UpdateGlobalLinks PkgName="',NewPkgLink.Name,'" ',
      //  ' PkgVersion=',NewPkgLink.Version.AsString,
      //  ' Filename="',NewPkgLink.Filename,'"',
      //  ' MakeSense=',dbgs(NewPkgLink.MakeSense));
      if NewPkgLink.MakeSense then
        FGlobalLinks.Add(NewPkgLink)
      else
        NewPkgLink.Release;
      
    until FindNextUTF8(FileInfo)<>0;
    //WriteLinkTree(FGlobalLinks);
    if PkgVersion<>nil then PkgVersion.Free;
  end;
  FindCloseUTF8(FileInfo);
end;

procedure TPackageLinks.UpdateUserLinks;
var
  ConfigFilename: String;
  Path: String;
  XMLConfig: TXMLConfig;
  LinkCount: Integer;
  i: Integer;
  NewPkgLink: TPackageLink;
  ItemPath: String;
  FileVersion: LongInt;
begin
  if fUpdateLock>0 then begin
    Include(FStates,plsUserLinksNeedUpdate);
    exit;
  end;
  Exclude(FStates,plsUserLinksNeedUpdate);

  // check if file has changed
  ConfigFilename:=GetUserLinkFile;
  if UserLinkLoadTimeValid and FileExistsUTF8(ConfigFilename)
  and (FileAgeUTF8(ConfigFilename)=UserLinkLoadTime) then
    exit;
  
  // copy system default if needed
  CopySecondaryConfigFile(GetUserLinkFile(false));
  
  FUserLinksSortID.FreeAndClear;
  FUserLinksSortFile.Clear;
  FileVersion:=PkgLinksFileVersion;
  XMLConfig:=nil;
  try
    XMLConfig:=TXMLConfig.Create(ConfigFilename);
    
    Path:='UserPkgLinks/';
    FileVersion:=XMLConfig.GetValue(Path+'Version',0);
    LinkCount:=XMLConfig.GetValue(Path+'Count',0);
    for i:=1 to LinkCount do begin
      ItemPath:=Path+'Item'+IntToStr(i)+'/';
      NewPkgLink:=TPackageLink.Create;
      NewPkgLink.Reference;
      NewPkgLink.Origin:=ploUser;
      NewPkgLink.Name:=XMLConfig.GetValue(ItemPath+'Name/Value','');
      PkgVersionLoadFromXMLConfig(NewPkgLink.Version,XMLConfig,ItemPath+'Version/',
                                                          LazPkgXMLFileVersion);
      NewPkgLink.Filename:=XMLConfig.GetValue(ItemPath+'Filename/Value','');
      NewPkgLink.AutoCheckExists:=
                      XMLConfig.GetValue(ItemPath+'AutoCheckExists/Value',true);
                      
      NewPkgLink.LastCheckValid:=
                      XMLConfig.GetValue(ItemPath+'LastCheckValid/Value',false);
      if NewPkgLink.LastCheckValid then begin
        NewPkgLink.LastCheckValid:=
                 CfgStrToDate(XMLConfig.GetValue(ItemPath+'LastCheck/Value',''),
                              NewPkgLink.FLastCheck);
      end;
      
      NewPkgLink.FileDateValid:=
                       XMLConfig.GetValue(ItemPath+'FileDateValid/Value',false);
      if NewPkgLink.FileDateValid then begin
        NewPkgLink.FileDateValid:=
                  CfgStrToDate(XMLConfig.GetValue(ItemPath+'FileDate/Value',''),
                               NewPkgLink.FFileDate);
      end;
      
      NewPkgLink.NotFoundCount:=
                           XMLConfig.GetValue(ItemPath+'NotFoundCount/Value',0);
      if not CfgStrToDate(XMLConfig.GetValue(ItemPath+'LastUsed/Value',''),
                            NewPkgLink.FLastUsed)
      then
        NewPkgLink.FLastUsed := 0;

      if NewPkgLink.MakeSense then begin
        FUserLinksSortID.Add(NewPkgLink);
        FUserLinksSortFile.Add(NewPkgLink);
      end else
        NewPkgLink.Release;
    end;
    XMLConfig.Modified:=false;
    XMLConfig.Free;
    
    UserLinkLoadTime:=FileAgeUTF8(ConfigFilename);
    UserLinkLoadTimeValid:=true;
  except
    on E: Exception do begin
      DebugLn('NOTE: unable to read ',ConfigFilename,' ',E.Message);
      exit;
    end;
  end;
  RemoveOldUserLinks;
  Modified:=FileVersion<>PkgLinksFileVersion;
end;

procedure TPackageLinks.UpdateAll;
begin
  UpdateGlobalLinks;
  UpdateUserLinks;
end;

procedure TPackageLinks.RemoveOldUserLinks;
// search for links pointing to the same file but older version
var
  ANode: TAVLTreeNode;
  NextNode: TAVLTreeNode;
  OldPkgLink: TPackageLink;
  NewPkgLink: TPackageLink;
begin
  // sort UserLinks for filename
  ANode:=FUserLinksSortFile.FindLowest;
  while ANode<>nil do begin
    NextNode:=FUserLinksSortFile.FindSuccessor(ANode);
    if NextNode=nil then break;
    OldPkgLink:=TPackageLink(ANode.Data);
    NewPkgLink:=TPackageLink(NextNode.Data);
    if CompareFilenames(OldPkgLink.GetEffectiveFilename,
      NewPkgLink.GetEffectiveFilename)=0
    then begin
      // two links to the same file -> delete the older
      //debugln('TPackageLinks.RemoveOldUserLinks',
      // ' Newer=',NewPkgLink.IDAsString,'=',dbgs(Pointer(NewPkgLink)),
      // ' Older=',OldPkgLink.IDAsString,'=',dbgs(Pointer(OldPkgLink)));
      FUserLinksSortID.RemovePointer(OldPkgLink);
      FUserLinksSortFile.RemovePointer(OldPkgLink);
      OldPkgLink.Release;
    end;
    ANode:=NextNode;
  end;
end;

procedure TPackageLinks.BeginUpdate;
begin
  inc(fUpdateLock);
end;

procedure TPackageLinks.EndUpdate;
begin
  if fUpdateLock<=0 then RaiseException('TPackageLinks.EndUpdate');
  dec(fUpdateLock);
  if (plsGlobalLinksNeedUpdate in FStates) then UpdateGlobalLinks;
  if (plsUserLinksNeedUpdate in FStates) then UpdateUserLinks;
end;

procedure TPackageLinks.SaveUserLinks;
var
  ConfigFilename: String;
  Path: String;
  CurPkgLink: TPackageLink;
  XMLConfig: TXMLConfig;
  ANode: TAVLTreeNode;
  ItemPath: String;
  i: Integer;
  LazSrcDir: String;
  AFilename: String;
begin
  ConfigFilename:=GetUserLinkFile;
  
  // check if file needs saving
  if not NeedSaveUserLinks(ConfigFilename) then exit;
  //DebugLn(['TPackageLinks.SaveUserLinks saving ... ',ConfigFilename,' Modified=',Modified,' UserLinkLoadTimeValid=',UserLinkLoadTimeValid,' ',FileAgeUTF8(ConfigFilename)=UserLinkLoadTime]);

  LazSrcDir:=EnvironmentOptions.LazarusDirectory;

  XMLConfig:=nil;
  try
    XMLConfig:=TXMLConfig.CreateClean(ConfigFilename);

    Path:='UserPkgLinks/';
    XMLConfig.SetValue(Path+'Version',PkgLinksFileVersion);
    ANode:=FUserLinksSortID.FindLowest;
    i:=0;
    while ANode<>nil do begin
      inc(i);
      ItemPath:=Path+'Item'+IntToStr(i)+'/';
      CurPkgLink:=TPackageLink(ANode.Data);
      XMLConfig.SetDeleteValue(ItemPath+'Name/Value',CurPkgLink.Name,'');
      //debugln(['TPackageLinks.SaveUserLinks ',CurPkgLink.Name,' ',dbgs(Pointer(CurPkgLink))]);
      PkgVersionSaveToXMLConfig(CurPkgLink.Version,XMLConfig,ItemPath+'Version/');

      // save package files in lazarus directory relative
      AFilename:=CurPkgLink.Filename;
      if (LazSrcDir<>'') and FileIsInPath(AFilename,LazSrcDir) then begin
        AFilename:=CreateRelativePath(AFilename,LazSrcDir);
        //DebugLn(['TPackageLinks.SaveUserLinks ',AFilename]);
      end;
      XMLConfig.SetDeleteValue(ItemPath+'Filename/Value',AFilename,'');

      XMLConfig.SetDeleteValue(ItemPath+'LastCheckValid/Value',
                               CurPkgLink.LastCheckValid,false);
      if CurPkgLink.LastCheckValid then
        XMLConfig.SetDeleteValue(ItemPath+'LastCheck/Value',
                                 DateToCfgStr(CurPkgLink.LastCheck),'');
      XMLConfig.SetDeleteValue(ItemPath+'NotFoundCount/Value',
                               CurPkgLink.NotFoundCount,0);
      XMLConfig.SetDeleteValue(ItemPath+'LastUsed/Value',
                               DateToCfgStr(CurPkgLink.LastUsed),'');

      ANode:=FUserLinksSortID.FindSuccessor(ANode);
    end;
    XMLConfig.SetDeleteValue(Path+'Count',FUserLinksSortID.Count,0);
    
    InvalidateFileStateCache;
    XMLConfig.Flush;
    XMLConfig.Free;

    UserLinkLoadTime:=FileAgeUTF8(ConfigFilename);
    UserLinkLoadTimeValid:=true;
  except
    on E: Exception do begin
      DebugLn('NOTE: unable to read ',ConfigFilename,' ',E.Message);
      exit;
    end;
  end;
  Modified:=false;
end;

function TPackageLinks.NeedSaveUserLinks(const ConfigFilename: string): boolean;
begin
  Result:=Modified
          or (not UserLinkLoadTimeValid)
          or (not FileExistsCached(ConfigFilename))
          or (FileAgeCached(ConfigFilename)<>UserLinkLoadTime);
end;

procedure TPackageLinks.WriteLinkTree(LinkTree: TAVLTree);
var
  ANode: TAVLTreeNode;
  Link: TPackageLink;
begin
  if LinkTree=nil then exit;
  ANode:=LinkTree.FindLowest;
  while ANode<>nil do begin
    Link:=TPackageLink(ANode.Data);
    debugln('  ',Link.IDAsString);
    ANode:=LinkTree.FindSuccessor(ANode);
  end;
end;

function TPackageLinks.FindLinkWithPkgNameInTree(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.FindLinkWithDependencyInTree(LinkTree: TAVLTree;
  Dependency: TPkgDependency): TPackageLink;
var
  Link: TPackageLink;
  CurNode: TAVLTreeNode;
begin
  Result:=nil;
  if (Dependency=nil) or (not Dependency.MakeSense) then begin
    DebugLn(['TPackageLinks.FindLinkWithDependencyInTree Dependency makes no sense']);
    exit;
  end;
  // if there are several fitting the description, use the last used
  // and highest version
  CurNode:=FindLeftMostNode(LinkTree,Dependency.PackageName);
  while CurNode<>nil do begin
    Link:=TPackageLink(CurNode.Data);
    if Dependency.IsCompatible(Link.Version) then begin
      if Result=nil then
        Result:=Link
      else begin
        // there are two packages fitting
        if ((Link.LastUsed>Result.LastUsed)
            or (Link.Version.Compare(Result.Version)>0))
        and FileExistsCached(Link.GetEffectiveFilename) then
          Result:=Link; // this one is better
      end;
    end;
    CurNode:=LinkTree.FindSuccessor(CurNode);
    if CurNode=nil then break;
    if CompareText(TPackageLink(CurNode.Data).Name,Dependency.PackageName)<>0
    then begin
      CurNode:=nil;
      break;
    end;
  end;
end;

function TPackageLinks.FindLinkWithPackageIDInTree(LinkTree: TAVLTree;
  APackageID: TLazPackageID): TPackageLink;
var
  ANode: TAVLTreeNode;
begin
  ANode:=LinkTree.FindKey(APackageID,@ComparePackageIDAndLink);
  if ANode<>nil then
    Result:=TPackageLink(ANode.Data)
  else
    Result:=nil;
end;

procedure TPackageLinks.IteratePackagesInTree(MustExist: boolean;
  LinkTree: TAVLTree; Event: TIteratePackagesEvent);
var
  ANode: TAVLTreeNode;
  PkgLink: TPackageLink;
  AFilename: String;
begin
  ANode:=LinkTree.FindLowest;
  while ANode<>nil do begin
    PkgLink:=TPackageLink(ANode.Data);
    //debugln('TPackageLinks.IteratePackagesInTree PkgLink.Filename=',PkgLink.Filename);
    AFilename:=PkgLink.GetEffectiveFilename;
    if (not MustExist) or FileExistsUTF8(AFilename) then
      Event(PkgLink);
    ANode:=LinkTree.FindSuccessor(ANode);
  end;
end;

procedure TPackageLinks.SetModified(const AValue: boolean);
begin
  if FModified=AValue then exit;
  FModified:=AValue;
end;

function TPackageLinks.FindLinkWithPkgName(const PkgName: string): TPackageLink;
begin
  Result:=FindLinkWithPkgNameInTree(FUserLinksSortID,PkgName);
  if Result=nil then
    Result:=FindLinkWithPkgNameInTree(FGlobalLinks,PkgName);
end;

function TPackageLinks.FindLinkWithDependency(Dependency: TPkgDependency
  ): TPackageLink;
begin
  Result:=FindLinkWithDependencyInTree(FUserLinksSortID,Dependency);
  if Result=nil then
    Result:=FindLinkWithDependencyInTree(FGlobalLinks,Dependency);
  //if Result=nil then begin
    //debugln('TPackageLinks.FindLinkWithDependency A ',Dependency.AsString);
    // WriteLinkTree(FGlobalLinks);
  //end;
  // finally try the history lists of the Dependency Owner (Project/Package)
  if (Result=nil) and (Dependency.Owner<>nil)
  and Assigned(DependencyOwnerGetPkgFilename)
  and DependencyOwnerGetPkgFilename(Self,Dependency) then
    Result:=FindLinkWithDependencyInTree(FUserLinksSortID,Dependency);
end;

function TPackageLinks.FindLinkWithPackageID(APackageID: TLazPackageID
  ): TPackageLink;
begin
  Result:=FindLinkWithPackageIDInTree(FUserLinksSortID,APackageID);
  if Result=nil then
    Result:=FindLinkWithPackageIDInTree(FGlobalLinks,APackageID);
end;

procedure TPackageLinks.IteratePackages(MustExist: boolean;
  Event: TIteratePackagesEvent; Origins: TPkgLinkOrigins);
begin
  if ploUser in Origins then
    IteratePackagesInTree(MustExist,FUserLinksSortID,Event);
  if ploGlobal in Origins then
    IteratePackagesInTree(MustExist,FGlobalLinks,Event);
end;

function TPackageLinks.AddUserLink(APackage: TLazPackage): TPackageLink;
var
  OldLink: TPackageLink;
  NewLink: TPackageLink;
begin
  BeginUpdate;
  // check if link already exists
  OldLink:=FindLinkWithPackageID(APackage);
  if (OldLink<>nil) then begin
    // link exists -> check if it is already the right value
    if (OldLink.Compare(APackage)=0)
    and (OldLink.GetEffectiveFilename=APackage.Filename) then begin
      Result:=OldLink;
      Result.LastUsed:=Now;
      exit;
    end;
    RemoveLink(APackage);
  end;
  // add user link
  NewLink:=TPackageLink.Create;
  NewLink.Reference;
  NewLink.AssignID(APackage);
  NewLink.Filename:=APackage.Filename;
  if NewLink.MakeSense then begin
    FUserLinksSortID.Add(NewLink);
    FUserLinksSortFile.Add(NewLink);
    Modified:=true;
  end else begin
    NewLink.Release;
    NewLink:=nil;
  end;
  EndUpdate;
  Result:=NewLink;
  Result.LastUsed:=Now;
end;

function TPackageLinks.AddUserLink(const PkgFilename, PkgName: string
  ): TPackageLink;
var
  OldLink: TPackageLink;
  NewLink: TPackageLink;
  LPK: TXMLConfig;
  PkgVersion: TPkgVersion;
begin
  BeginUpdate;
  PkgVersion:=TPkgVersion.Create;
  LPK:=nil;
  try
    // load version
    LPK:=LoadXMLConfigViaCodeBuffer(PkgFilename);
    if LPK<>nil then
      PkgVersionLoadFromXMLConfig(PkgVersion,LPK);

    // check if link already exists
    OldLink:=FindLinkWithPkgName(PkgName);
    if (OldLink<>nil) then begin
      // link exists
      if CompareFilenames(OldLink.GetEffectiveFilename,PkgFilename)=0 then begin
        Result:=OldLink;
        Result.LastUsed:=Now;
        if LPK<>nil then
          Result.Version.Assign(PkgVersion);
        exit;
      end;
    end;
    // add user link
    NewLink:=TPackageLink.Create;
    NewLink.Reference;
    NewLink.Name:=PkgName;
    NewLink.Filename:=PkgFilename;
    if LPK<>nil then
      NewLink.Version.Assign(PkgVersion);
    if NewLink.MakeSense then begin
      FUserLinksSortID.Add(NewLink);
      FUserLinksSortFile.Add(NewLink);
      Modified:=true;
    end else begin
      NewLink.Release;
      NewLink:=nil;
    end;
    EndUpdate;
    Result:=NewLink;
    if Result<>nil then
      Result.LastUsed:=Now;
  finally
    PkgVersion.Free;
    LPK.Free;
  end;
end;

procedure TPackageLinks.RemoveLink(APackageID: TLazPackageID);
var
  ANode: TAVLTreeNode;
  OldLink: TPackageLink;
begin
  BeginUpdate;
  // remove from user links
  ANode:=FUserLinksSortID.FindKey(APackageID,@ComparePackageIDAndLink);
  if ANode<>nil then begin
    OldLink:=TPackageLink(ANode.Data);
    FUserLinksSortID.Delete(ANode);
    FUserLinksSortFile.RemovePointer(OldLink);
    OldLink.Release;
    Modified:=true;
  end;
  // remove from global links
  ANode:=FGlobalLinks.FindKey(APackageID,@ComparePackageIDAndLink);
  if ANode<>nil then begin
    OldLink:=TPackageLink(ANode.Data);
    FGlobalLinks.Delete(ANode);
    OldLink.Release;
    Modified:=true;
  end;
  EndUpdate;
end;


initialization
  PkgLinks:=nil;

end.