~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to packager/packagelinks.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
39
39
interface
40
40
 
41
41
uses
42
 
  Classes, SysUtils, AVL_Tree, Laz_XMLCfg, FileProcs, CodeToolManager,
43
 
  CodeCache, LCLProc, FileUtil, MacroIntf, PackageIntf, IDEProcs, DialogProcs,
44
 
  EnvironmentOpts, PackageDefs, LazConf;
 
42
  Classes, SysUtils, Laz2_XMLCfg, FileProcs, CodeToolManager, CodeToolsStructs,
 
43
  LCLProc, FileUtil, AvgLvlTree, lazutf8classes, MacroIntf, PackageIntf,
 
44
  IDEProcs, EnvironmentOpts, PackageDefs, LazConf;
45
45
  
46
46
const
47
47
  PkgLinksFileVersion = 2;
126
126
  TPackageLinks = class
127
127
  private
128
128
    FDependencyOwnerGetPkgFilename: TDependencyOwnerGetPkgFilename;
129
 
    FGlobalLinks: TAVLTree; // tree of global TPackageLink sorted for ID
130
 
    FModified: boolean;
131
 
    FUserLinksSortID: TAVLTree; // tree of user TPackageLink sorted for ID
132
 
    FUserLinksSortFile: TAVLTree; // tree of user TPackageLink sorted for
133
 
                                  // Filename and FileDate
 
129
    FGlobalLinks: TAvgLvlTree; // tree of global TPackageLink sorted for ID
 
130
    FChangeStamp: integer;
 
131
    FSavedChangeStamp: integer;
 
132
    FUserLinksSortID: TAvgLvlTree; // tree of user TPackageLink sorted for ID
 
133
    FUserLinksSortFile: TAvgLvlTree; // tree of user TPackageLink sorted for
 
134
                                     // Filename and FileDate
134
135
    fUpdateLock: integer;
135
136
    FStates: TPkgLinksStates;
136
 
    function FindLeftMostNode(LinkTree: TAVLTree;
137
 
      const PkgName: string): TAVLTreeNode;
138
 
    function FindLinkWithPkgNameInTree(LinkTree: TAVLTree;
 
137
    function FindLeftMostNode(LinkTree: TAvgLvlTree;
 
138
      const PkgName: string): TAvgLvlTreeNode;
 
139
    function FindLinkWithPkgNameInTree(LinkTree: TAvgLvlTree;
139
140
      const PkgName: string): TPackageLink;
140
 
    function FindLinkWithDependencyInTree(LinkTree: TAVLTree;
141
 
      Dependency: TPkgDependency): TPackageLink;
142
 
    function FindLinkWithPackageIDInTree(LinkTree: TAVLTree;
 
141
    function FindLinkWithDependencyInTree(LinkTree: TAvgLvlTree;
 
142
      Dependency: TPkgDependency; IgnoreFiles: TFilenameToStringTree): TPackageLink;
 
143
    function FindLinkWithPackageIDInTree(LinkTree: TAvgLvlTree;
143
144
      APackageID: TLazPackageID): TPackageLink;
144
 
    procedure IteratePackagesInTree(MustExist: boolean; LinkTree: TAVLTree;
 
145
    function GetModified: boolean;
 
146
    procedure IteratePackagesInTree(MustExist: boolean; LinkTree: TAvgLvlTree;
145
147
      Event: TIteratePackagesEvent);
146
148
    procedure SetModified(const AValue: boolean);
147
149
  public
158
160
    procedure RemoveOldUserLinks;
159
161
    procedure BeginUpdate;
160
162
    procedure EndUpdate;
 
163
    function IsUpdating: boolean;
161
164
    procedure SaveUserLinks;
162
165
    function NeedSaveUserLinks(const ConfigFilename: string): boolean;
163
 
    procedure WriteLinkTree(LinkTree: TAVLTree);
 
166
    procedure WriteLinkTree(LinkTree: TAvgLvlTree);
164
167
    function FindLinkWithPkgName(const PkgName: string): TPackageLink;
165
 
    function FindLinkWithDependency(Dependency: TPkgDependency): TPackageLink;
 
168
    function FindLinkWithDependency(Dependency: TPkgDependency;
 
169
                        IgnoreFiles: TFilenameToStringTree = nil): TPackageLink;
166
170
    function FindLinkWithPackageID(APackageID: TLazPackageID): TPackageLink;
167
171
    procedure IteratePackages(MustExist: boolean; Event: TIteratePackagesEvent;
168
172
                              Origins: TPkgLinkOrigins = AllPkgLinkOrigins);
169
173
    function AddUserLink(APackage: TLazPackage): TPackageLink;
170
174
    function AddUserLink(const PkgFilename, PkgName: string): TPackageLink;// do not this use if package is open in IDE
171
 
    procedure RemoveLink(APackageID: TLazPackageID);
 
175
    procedure RemoveUserLink(Link: TPackageLink);
 
176
    procedure RemoveUserLinks(APackageID: TLazPackageID);
 
177
    procedure IncreaseChangeStamp;
172
178
  public
173
 
    property Modified: boolean read FModified write SetModified;
 
179
    property Modified: boolean read GetModified write SetModified;
 
180
    property ChangeStamp: integer read FChangeStamp;
174
181
    property DependencyOwnerGetPkgFilename: TDependencyOwnerGetPkgFilename
175
182
                                           read FDependencyOwnerGetPkgFilename
176
183
                                           write FDependencyOwnerGetPkgFilename;
282
289
 
283
290
function TPackageLink.MakeSense: boolean;
284
291
begin
285
 
  Result:=(Name<>'') and IsValidIdent(Name)
 
292
  Result:=(Name<>'') and IsValidUnitName(Name)
286
293
           and PackageFileNameIsValid(Filename)
287
294
           and (CompareText(Name,ExtractFileNameOnly(Filename))=0);
288
295
end;
290
297
function TPackageLink.GetEffectiveFilename: string;
291
298
begin
292
299
  Result:=Filename;
293
 
  if (not FilenameIsAbsolute(Result))
294
 
  and (EnvironmentOptions.LazarusDirectory<>'') then
295
 
    Result:=TrimFilename(EnvironmentOptions.LazarusDirectory+PathDelim+Result);
 
300
  if (not FilenameIsAbsolute(Result)) then
 
301
    Result:=TrimFilename(EnvironmentOptions.GetParsedLazarusDirectory+PathDelim+Result);
296
302
end;
297
303
 
298
304
procedure TPackageLink.Reference;
309
315
 
310
316
{ TPackageLinks }
311
317
 
312
 
function TPackageLinks.FindLeftMostNode(LinkTree: TAVLTree;
313
 
  const PkgName: string): TAVLTreeNode;
 
318
function TPackageLinks.FindLeftMostNode(LinkTree: TAvgLvlTree;
 
319
  const PkgName: string): TAvgLvlTreeNode;
314
320
// find left most link with PkgName
315
321
begin
316
322
  Result:=nil;
321
327
constructor TPackageLinks.Create;
322
328
begin
323
329
  UserLinkLoadTimeValid:=false;
324
 
  FGlobalLinks:=TAVLTree.Create(@ComparePackageLinks);
325
 
  FUserLinksSortID:=TAVLTree.Create(@ComparePackageLinks);
326
 
  FUserLinksSortFile:=TAVLTree.Create(@CompareLinksForFilenameAndFileAge);
 
330
  FGlobalLinks:=TAvgLvlTree.Create(@ComparePackageLinks);
 
331
  FUserLinksSortID:=TAvgLvlTree.Create(@ComparePackageLinks);
 
332
  FUserLinksSortFile:=TAvgLvlTree.Create(@CompareLinksForFilenameAndFileAge);
 
333
  FSavedChangeStamp:=CTInvalidChangeStamp;
 
334
  FChangeStamp:=CTInvalidChangeStamp;
327
335
end;
328
336
 
329
337
destructor TPackageLinks.Destroy;
352
360
 
353
361
function TPackageLinks.GetGlobalLinkDirectory: string;
354
362
begin
355
 
  Result:=AppendPathDelim(EnvironmentOptions.LazarusDirectory)
 
363
  Result:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory)
356
364
                                  +'packager'+PathDelim+'globallinks'+PathDelim;
357
365
end;
358
366
 
413
421
  NewPkgName: string;
414
422
  PkgVersion: TPkgVersion;
415
423
  NewPkgLink: TPackageLink;
416
 
  sl: TStringList;
 
424
  sl: TStringListUTF8;
417
425
  CurFilename: String;
418
426
  NewFilename: string;
419
427
begin
425
433
  
426
434
  FGlobalLinks.FreeAndClear;
427
435
  GlobalLinksDir:=GetGlobalLinkDirectory;
428
 
  //debugln('UpdateGlobalLinks A ',GlobalLinksDir);
429
436
  if FindFirstUTF8(GlobalLinksDir+'*.lpl', faAnyFile, FileInfo)=0 then begin
430
437
    PkgVersion:=TPkgVersion.Create;
431
438
    repeat
438
445
        continue;
439
446
      end;
440
447
      NewFilename:='';
441
 
      sl:=TStringList.Create;
 
448
      sl:=TStringListUTF8.Create;
442
449
      try
443
 
        sl.LoadFromFile(UTF8ToSys(CurFilename));
 
450
        sl.LoadFromFile(CurFilename);
444
451
        if sl.Count<=0 then begin
445
452
          DebugLn('WARNING: suspicious pkg link file found (content): ',CurFilename);
446
453
          continue;
453
460
      end;
454
461
      sl.Free;
455
462
      if NewFilename='' then continue;
456
 
      
 
463
      //debugln(['TPackageLinks.UpdateGlobalLinks NewFilename="',NewFilename,'"']);
 
464
 
457
465
      NewPkgLink:=TPackageLink.Create;
458
466
      NewPkgLink.Reference;
459
467
      NewPkgLink.Origin:=ploGlobal;
460
468
      NewPkgLink.Name:=NewPkgName;
461
469
      NewPkgLink.Version.Assign(PkgVersion);
462
470
      IDEMacros.SubstituteMacros(NewFilename);
 
471
      //debugln(['TPackageLinks.UpdateGlobalLinks EnvironmentOptions.LazarusDirectory=',EnvironmentOptions.LazarusDirectory]);
463
472
      NewFilename:=TrimFilename(NewFilename);
464
 
      if (EnvironmentOptions.LazarusDirectory<>'')
465
 
      and (FileIsInDirectory(NewFilename,EnvironmentOptions.LazarusDirectory)) then
466
 
        NewFilename:=CreateRelativePath(NewFilename,EnvironmentOptions.LazarusDirectory);
 
473
      if (FileIsInDirectory(NewFilename,EnvironmentOptions.GetParsedLazarusDirectory)) then
 
474
        NewFilename:=CreateRelativePath(NewFilename,EnvironmentOptions.GetParsedLazarusDirectory);
467
475
      NewPkgLink.Filename:=NewFilename;
468
476
      //debugln('TPackageLinks.UpdateGlobalLinks PkgName="',NewPkgLink.Name,'" ',
469
477
      //  ' PkgVersion=',NewPkgLink.Version.AsString,
500
508
 
501
509
  // check if file has changed
502
510
  ConfigFilename:=GetUserLinkFile;
503
 
  if UserLinkLoadTimeValid and FileExistsUTF8(ConfigFilename)
504
 
  and (FileAgeUTF8(ConfigFilename)=UserLinkLoadTime) then
 
511
  if UserLinkLoadTimeValid and FileExistsCached(ConfigFilename)
 
512
  and (FileAgeCached(ConfigFilename)=UserLinkLoadTime) then
505
513
    exit;
506
514
  
507
515
  // copy system default if needed
509
517
  
510
518
  FUserLinksSortID.FreeAndClear;
511
519
  FUserLinksSortFile.Clear;
 
520
  IncreaseChangeStamp;
512
521
  FileVersion:=PkgLinksFileVersion;
513
522
  XMLConfig:=nil;
514
523
  try
582
591
procedure TPackageLinks.RemoveOldUserLinks;
583
592
// search for links pointing to the same file but older version
584
593
var
585
 
  ANode: TAVLTreeNode;
586
 
  NextNode: TAVLTreeNode;
 
594
  ANode: TAvgLvlTreeNode;
 
595
  NextNode: TAvgLvlTreeNode;
587
596
  OldPkgLink: TPackageLink;
588
597
  NewPkgLink: TPackageLink;
589
598
begin
622
631
  if (plsUserLinksNeedUpdate in FStates) then UpdateUserLinks;
623
632
end;
624
633
 
 
634
function TPackageLinks.IsUpdating: boolean;
 
635
begin
 
636
  Result:=fUpdateLock>0;
 
637
end;
 
638
 
625
639
procedure TPackageLinks.SaveUserLinks;
626
640
var
627
641
  ConfigFilename: String;
628
642
  Path: String;
629
643
  CurPkgLink: TPackageLink;
630
644
  XMLConfig: TXMLConfig;
631
 
  ANode: TAVLTreeNode;
 
645
  ANode: TAvgLvlTreeNode;
632
646
  ItemPath: String;
633
647
  i: Integer;
634
648
  LazSrcDir: String;
640
654
  if not NeedSaveUserLinks(ConfigFilename) then exit;
641
655
  //DebugLn(['TPackageLinks.SaveUserLinks saving ... ',ConfigFilename,' Modified=',Modified,' UserLinkLoadTimeValid=',UserLinkLoadTimeValid,' ',FileAgeUTF8(ConfigFilename)=UserLinkLoadTime]);
642
656
 
643
 
  LazSrcDir:=EnvironmentOptions.LazarusDirectory;
 
657
  LazSrcDir:=EnvironmentOptions.GetParsedLazarusDirectory;
644
658
 
645
659
  XMLConfig:=nil;
646
660
  try
703
717
          or (FileAgeCached(ConfigFilename)<>UserLinkLoadTime);
704
718
end;
705
719
 
706
 
procedure TPackageLinks.WriteLinkTree(LinkTree: TAVLTree);
 
720
procedure TPackageLinks.WriteLinkTree(LinkTree: TAvgLvlTree);
707
721
var
708
 
  ANode: TAVLTreeNode;
 
722
  ANode: TAvgLvlTreeNode;
709
723
  Link: TPackageLink;
710
724
begin
711
725
  if LinkTree=nil then exit;
717
731
  end;
718
732
end;
719
733
 
720
 
function TPackageLinks.FindLinkWithPkgNameInTree(LinkTree: TAVLTree;
 
734
function TPackageLinks.FindLinkWithPkgNameInTree(LinkTree: TAvgLvlTree;
721
735
  const PkgName: string): TPackageLink;
722
736
// find left most link with PkgName
723
737
var
724
 
  CurNode: TAVLTreeNode;
 
738
  CurNode: TAvgLvlTreeNode;
725
739
begin
726
740
  Result:=nil;
727
741
  if PkgName='' then exit;
730
744
  Result:=TPackageLink(CurNode.Data);
731
745
end;
732
746
 
733
 
function TPackageLinks.FindLinkWithDependencyInTree(LinkTree: TAVLTree;
734
 
  Dependency: TPkgDependency): TPackageLink;
 
747
function TPackageLinks.FindLinkWithDependencyInTree(LinkTree: TAvgLvlTree;
 
748
  Dependency: TPkgDependency; IgnoreFiles: TFilenameToStringTree): TPackageLink;
735
749
var
736
750
  Link: TPackageLink;
737
 
  CurNode: TAVLTreeNode;
 
751
  CurNode: TAvgLvlTreeNode;
738
752
begin
739
753
  Result:=nil;
740
754
  if (Dependency=nil) or (not Dependency.MakeSense) then begin
746
760
  CurNode:=FindLeftMostNode(LinkTree,Dependency.PackageName);
747
761
  while CurNode<>nil do begin
748
762
    Link:=TPackageLink(CurNode.Data);
749
 
    if Dependency.IsCompatible(Link.Version) then begin
 
763
    if Dependency.IsCompatible(Link.Version)
 
764
    and ((IgnoreFiles=nil) or (not IgnoreFiles.Contains(Link.GetEffectiveFilename)))
 
765
    then begin
750
766
      if Result=nil then
751
767
        Result:=Link
752
768
      else begin
767
783
  end;
768
784
end;
769
785
 
770
 
function TPackageLinks.FindLinkWithPackageIDInTree(LinkTree: TAVLTree;
 
786
function TPackageLinks.FindLinkWithPackageIDInTree(LinkTree: TAvgLvlTree;
771
787
  APackageID: TLazPackageID): TPackageLink;
772
788
var
773
 
  ANode: TAVLTreeNode;
 
789
  ANode: TAvgLvlTreeNode;
774
790
begin
775
791
  ANode:=LinkTree.FindKey(APackageID,@ComparePackageIDAndLink);
776
792
  if ANode<>nil then
779
795
    Result:=nil;
780
796
end;
781
797
 
 
798
function TPackageLinks.GetModified: boolean;
 
799
begin
 
800
  Result:=FSavedChangeStamp<>FChangeStamp;
 
801
end;
 
802
 
782
803
procedure TPackageLinks.IteratePackagesInTree(MustExist: boolean;
783
 
  LinkTree: TAVLTree; Event: TIteratePackagesEvent);
 
804
  LinkTree: TAvgLvlTree; Event: TIteratePackagesEvent);
784
805
var
785
 
  ANode: TAVLTreeNode;
 
806
  ANode: TAvgLvlTreeNode;
786
807
  PkgLink: TPackageLink;
787
808
  AFilename: String;
788
809
begin
799
820
 
800
821
procedure TPackageLinks.SetModified(const AValue: boolean);
801
822
begin
802
 
  if FModified=AValue then exit;
803
 
  FModified:=AValue;
 
823
  if Modified=AValue then exit;
 
824
  if not AValue then
 
825
    FSavedChangeStamp:=FChangeStamp
 
826
  else
 
827
    IncreaseChangeStamp;
804
828
end;
805
829
 
806
830
function TPackageLinks.FindLinkWithPkgName(const PkgName: string): TPackageLink;
810
834
    Result:=FindLinkWithPkgNameInTree(FGlobalLinks,PkgName);
811
835
end;
812
836
 
813
 
function TPackageLinks.FindLinkWithDependency(Dependency: TPkgDependency
814
 
  ): TPackageLink;
 
837
function TPackageLinks.FindLinkWithDependency(Dependency: TPkgDependency;
 
838
  IgnoreFiles: TFilenameToStringTree): TPackageLink;
815
839
begin
816
 
  Result:=FindLinkWithDependencyInTree(FUserLinksSortID,Dependency);
 
840
  Result:=FindLinkWithDependencyInTree(FUserLinksSortID,Dependency,IgnoreFiles);
817
841
  if Result=nil then
818
 
    Result:=FindLinkWithDependencyInTree(FGlobalLinks,Dependency);
 
842
    Result:=FindLinkWithDependencyInTree(FGlobalLinks,Dependency,IgnoreFiles);
819
843
  //if Result=nil then begin
820
844
    //debugln('TPackageLinks.FindLinkWithDependency A ',Dependency.AsString);
821
845
    // WriteLinkTree(FGlobalLinks);
824
848
  if (Result=nil) and (Dependency.Owner<>nil)
825
849
  and Assigned(DependencyOwnerGetPkgFilename)
826
850
  and DependencyOwnerGetPkgFilename(Self,Dependency) then
827
 
    Result:=FindLinkWithDependencyInTree(FUserLinksSortID,Dependency);
 
851
    Result:=FindLinkWithDependencyInTree(FUserLinksSortID,Dependency,IgnoreFiles);
828
852
end;
829
853
 
830
854
function TPackageLinks.FindLinkWithPackageID(APackageID: TLazPackageID
850
874
  NewLink: TPackageLink;
851
875
begin
852
876
  BeginUpdate;
853
 
  // check if link already exists
854
 
  OldLink:=FindLinkWithPackageID(APackage);
855
 
  if (OldLink<>nil) then begin
856
 
    // link exists -> check if it is already the right value
857
 
    if (OldLink.Compare(APackage)=0)
858
 
    and (OldLink.GetEffectiveFilename=APackage.Filename) then begin
859
 
      Result:=OldLink;
860
 
      Result.LastUsed:=Now;
861
 
      exit;
862
 
    end;
863
 
    RemoveLink(APackage);
864
 
  end;
865
 
  // add user link
866
 
  NewLink:=TPackageLink.Create;
867
 
  NewLink.Reference;
868
 
  NewLink.AssignID(APackage);
869
 
  NewLink.Filename:=APackage.Filename;
870
 
  if NewLink.MakeSense then begin
871
 
    FUserLinksSortID.Add(NewLink);
872
 
    FUserLinksSortFile.Add(NewLink);
873
 
    Modified:=true;
874
 
  end else begin
875
 
    NewLink.Release;
876
 
    NewLink:=nil;
877
 
  end;
878
 
  EndUpdate;
879
 
  Result:=NewLink;
880
 
  Result.LastUsed:=Now;
 
877
  try
 
878
    // check if link already exists
 
879
    OldLink:=FindLinkWithPackageID(APackage);
 
880
    if (OldLink<>nil) then begin
 
881
      // link exists -> check if it is already the right value
 
882
      if (OldLink.Compare(APackage)=0)
 
883
      and (OldLink.GetEffectiveFilename=APackage.Filename) then begin
 
884
        Result:=OldLink;
 
885
        Result.LastUsed:=Now;
 
886
        exit;
 
887
      end;
 
888
      RemoveUserLinks(APackage);
 
889
    end;
 
890
    // add user link
 
891
    NewLink:=TPackageLink.Create;
 
892
    NewLink.Reference;
 
893
    NewLink.AssignID(APackage);
 
894
    NewLink.Filename:=APackage.Filename;
 
895
    if NewLink.MakeSense then begin
 
896
      FUserLinksSortID.Add(NewLink);
 
897
      FUserLinksSortFile.Add(NewLink);
 
898
      IncreaseChangeStamp;
 
899
    end else begin
 
900
      NewLink.Release;
 
901
      NewLink:=nil;
 
902
    end;
 
903
    Result:=NewLink;
 
904
    Result.LastUsed:=Now;
 
905
  finally
 
906
    EndUpdate;
 
907
  end;
881
908
end;
882
909
 
883
910
function TPackageLinks.AddUserLink(const PkgFilename, PkgName: string
888
915
  LPK: TXMLConfig;
889
916
  PkgVersion: TPkgVersion;
890
917
begin
891
 
  BeginUpdate;
892
918
  PkgVersion:=TPkgVersion.Create;
893
919
  LPK:=nil;
 
920
  BeginUpdate;
894
921
  try
895
922
    // load version
896
923
    LPK:=LoadXMLConfigViaCodeBuffer(PkgFilename);
919
946
    if NewLink.MakeSense then begin
920
947
      FUserLinksSortID.Add(NewLink);
921
948
      FUserLinksSortFile.Add(NewLink);
922
 
      Modified:=true;
 
949
      IncreaseChangeStamp;
923
950
    end else begin
924
951
      NewLink.Release;
925
952
      NewLink:=nil;
926
953
    end;
927
 
    EndUpdate;
928
954
    Result:=NewLink;
929
955
    if Result<>nil then
930
956
      Result.LastUsed:=Now;
931
957
  finally
 
958
    EndUpdate;
932
959
    PkgVersion.Free;
933
960
    LPK.Free;
934
961
  end;
935
962
end;
936
963
 
937
 
procedure TPackageLinks.RemoveLink(APackageID: TLazPackageID);
938
 
var
939
 
  ANode: TAVLTreeNode;
 
964
procedure TPackageLinks.RemoveUserLink(Link: TPackageLink);
 
965
var
 
966
  ANode: TAvgLvlTreeNode;
 
967
begin
 
968
  BeginUpdate;
 
969
  try
 
970
    // remove from user links
 
971
    ANode:=FUserLinksSortFile.FindPointer(Link);
 
972
    if ANode<>nil then begin
 
973
      FUserLinksSortID.RemovePointer(Link);
 
974
      FUserLinksSortFile.RemovePointer(Link);
 
975
      Link.Release;
 
976
      IncreaseChangeStamp;
 
977
    end;
 
978
  finally
 
979
    EndUpdate;
 
980
  end;
 
981
end;
 
982
 
 
983
procedure TPackageLinks.RemoveUserLinks(APackageID: TLazPackageID);
 
984
var
 
985
  ANode: TAvgLvlTreeNode;
940
986
  OldLink: TPackageLink;
941
987
begin
942
988
  BeginUpdate;
943
 
  // remove from user links
944
 
  ANode:=FUserLinksSortID.FindKey(APackageID,@ComparePackageIDAndLink);
945
 
  if ANode<>nil then begin
946
 
    OldLink:=TPackageLink(ANode.Data);
947
 
    FUserLinksSortID.Delete(ANode);
948
 
    FUserLinksSortFile.RemovePointer(OldLink);
949
 
    OldLink.Release;
950
 
    Modified:=true;
951
 
  end;
952
 
  // remove from global links
953
 
  ANode:=FGlobalLinks.FindKey(APackageID,@ComparePackageIDAndLink);
954
 
  if ANode<>nil then begin
955
 
    OldLink:=TPackageLink(ANode.Data);
956
 
    FGlobalLinks.Delete(ANode);
957
 
    OldLink.Release;
958
 
    Modified:=true;
959
 
  end;
960
 
  EndUpdate;
 
989
  try
 
990
    // remove from user links
 
991
    repeat
 
992
      ANode:=FUserLinksSortID.FindKey(APackageID,@ComparePackageIDAndLink);
 
993
      if ANode=nil then exit;
 
994
      OldLink:=TPackageLink(ANode.Data);
 
995
      FUserLinksSortID.Delete(ANode);
 
996
      FUserLinksSortFile.RemovePointer(OldLink);
 
997
      OldLink.Release;
 
998
      IncreaseChangeStamp;
 
999
    until false;
 
1000
  finally
 
1001
    EndUpdate;
 
1002
  end;
961
1003
end;
962
1004
 
 
1005
procedure TPackageLinks.IncreaseChangeStamp;
 
1006
begin
 
1007
  CTIncreaseChangeStamp(FChangeStamp);
 
1008
end;
963
1009
 
964
1010
initialization
965
1011
  PkgLinks:=nil;