merge r50927 #ce69f57579: packagetabs: better sorting of groups (fix for linux)

git-svn-id: branches/fixes_1_6@50928 -

components/packagetabs/packagetabs_impl.pas

@@ -33,7 +33,7 @@ uses
   Classes, SysUtils, Types, Contnrs, Controls, SrcEditorIntf, StdCtrls, Buttons,
   ComCtrls, Forms, LazFileUtils, PackageIntf, Graphics, Menus, LazIDEIntf,
   ExtCtrls, IDEImagesIntf, Laz2_XMLCfg, IDECommands, LCLIntf,
-  IDEOptionsIntf, packagetabsstr, Clipbrd;
+  IDEOptionsIntf, packagetabsstr, Clipbrd, LCLProc;
 
 type
   TPackageTabButton = class(TSpeedButton)
@@ -81,16 +81,28 @@ type
     constructor Create(aOwner: TComponent); override;
   end;
 
-  TPackageItem = class
+  TGroupType = (gtProject, gtPackage, gtOther);
+  TGroupItem = class
   public
+    &Type: TGroupType;
+    Title: string;
     Package: TIDEPackage;
     GroupTabLabel: TGroupTabLabelClass;
     Files: TStringList;
 
-    constructor Create(APackage: TIDEPackage);
+    constructor Create(AType: TGroupType; const ATitle: string; APackage: TIDEPackage);
     destructor Destroy; override;
   end;
 
+  TGroupList = class(TObjectList)
+  private
+    function GetPackage(Index: Integer): TGroupItem;
+  public
+    function Find(AType: TGroupType; APackage: TIDEPackage; out Index: Integer): Boolean;
+    property Items[Index: Integer]: TGroupItem read GetPackage;
+    function Add(AItem: TGroupItem): Integer;
+  end;
+
   TMenuItemCommand = class(TMenuItem)
   public
     IDECommand: Word;
@@ -210,6 +222,9 @@ type
       ANoteBook: TPageControl):integer;
   end;
 
+function CompareGroupItem(const AGroupItem: TGroupItem; AType: TGroupType; APackage: TIDEPackage): Integer;
+function CompareGroupItem(const AGroupItem1, AGroupItem2: TGroupItem): Integer;
+
 procedure Register;
 
 implementation
@@ -217,11 +232,66 @@ implementation
 var
   xPackageTabPanels: TPackageTabPanels = nil;
 
+function CompareGroupItem(const AGroupItem: TGroupItem; AType: TGroupType;
+  APackage: TIDEPackage): Integer;
+begin
+  Result := Ord(AType)-Ord(AGroupItem.&Type);
+  if Result<>0 then
+    Exit;
+  if AType = gtPackage then
+    Result := ComparePointers(AGroupItem.Package, APackage);
+end;
+
+function CompareGroupItem(const AGroupItem1, AGroupItem2: TGroupItem): Integer;
+begin
+  Result := CompareGroupItem(AGroupItem1, AGroupItem2.&Type, AGroupItem2.Package);
+end;
+
 procedure Register;
 begin
   xPackageTabPanels := TPackageTabPanels.Create(nil);
 end;
 
+{ TGroupList }
+
+function TGroupList.Add(AItem: TGroupItem): Integer;
+begin
+  if Find(AItem.&Type,AItem.Package, Result) then
+    raise Exception.Create('TGroupList.Add: the same item is already in the list.');
+  Self.Insert(Result,AItem);
+end;
+
+function TGroupList.GetPackage(Index: Integer): TGroupItem;
+begin
+  Result := TGroupItem(inherited GetItem(Index));
+end;
+
+function TGroupList.Find(AType: TGroupType; APackage: TIDEPackage; out
+  Index: Integer): Boolean;
+var
+  L, R, I, xCompareRes: Integer;
+begin
+  Result := False;
+  L := 0;
+  R := Count-1;
+  while L<=R do
+  begin
+    I := L+(R-L) div 2;
+    xCompareRes := CompareGroupItem(Items[I], AType, APackage);
+    if (xCompareRes>0) then
+      L := I+1
+    else begin
+      R := I-1;
+      if xCompareRes=0 then
+      begin
+        Result := True;
+        L := I; // forces end of while loop
+      end;
+    end;
+  end;
+  Index := L;
+end;
+
 { TSourceEditorWindowInterfaceHelper }
 
 function TSourceEditorWindowInterfaceHelper.FindPageWithEditor(
@@ -479,17 +549,20 @@ begin
   Font.Style := Font.Style - [fsUnderline];
 end;
 
-{ TPackageItem }
+{ TGroupItem }
 
-constructor TPackageItem.Create(APackage: TIDEPackage);
+constructor TGroupItem.Create(AType: TGroupType; const ATitle: string;
+  APackage: TIDEPackage);
 begin
+  &Type := AType;
+  Title := ATitle;
   Package := APackage;
   Files := TStringList.Create;
   Files.Sorted := True;
   Files.Duplicates := dupAccept;
 end;
 
-destructor TPackageItem.Destroy;
+destructor TGroupItem.Destroy;
 begin
   Files.Free;
   inherited Destroy;
@@ -705,12 +778,13 @@ procedure TPackageTabPanel.RecreateToolBar;
 var
   I, L, xPkgIndex, xNewIndex, xOldIndex: Integer;
   xBtn, xActBtn: TPackageTabButton;
-  xPackages: TStringList;
+  xPackages: TGroupList;
   xPackage: TIDEPackage;
   xEditor, xOldActive: TSourceEditorInterface;
   xLbl: TGroupTabLabel;
-  xPkgItem: TPackageItem;
+  xPkgItem: TGroupItem;
-  xPackageName: string;
+  xGroupTitle: string;
+  xGroupType: TGroupType;
 begin
   FRecreateToolBar.FLastFiles.Clear;
   FWindow.IncUpdateLock;
@@ -720,43 +794,43 @@ begin
     for I := FPanel.ControlCount-1 downto 0 do
       FPanel.Controls[I].Free;
 
-    xPackages := TStringList.Create;
+    xPackages := TGroupList.Create;
     try
-      xPackages.Sorted := True;
-      xPackages.Duplicates := dupIgnore;
-      xPackages.OwnsObjects := True;
-
       for I := 0 to FWindow.Count-1 do
       begin
         xEditor := FWindow.Items[I];
         FRecreateToolBar.FLastFiles.Add(xEditor.FileName);
         xPackage := nil;
         if xEditor.GetProjectFile.IsPartOfProject then
-          xPackageName := Low(Char)+LazarusIDE.ActiveProject.GetTitleOrName // ToDo: better sorting...
+        begin
-        else
+          xGroupType := gtProject;
+          xGroupTitle := LazarusIDE.ActiveProject.GetTitleOrName
+        end else
         begin
           PackageEditingInterface.GetPackageOfSourceEditor(xPackage, xEditor);
           if (xPackage<>nil) and (xPackage.Name<>'') then
-            xPackageName := xPackage.Name
+          begin
-          else
+            xGroupType := gtPackage;
-            xPackageName := High(Char) + sOther; // ToDo: better sorting...
+            xGroupTitle := xPackage.Name;
+          end else
+          begin
+            xGroupType := gtOther;
+            xGroupTitle := sOther;
           end;
-        xPkgIndex := xPackages.IndexOf(xPackageName);
+        end;
-        if xPkgIndex < 0 then
+        if not xPackages.Find(xGroupType, xPackage, xPkgIndex) then
-          xPkgIndex := xPackages.AddObject(xPackageName, TPackageItem.Create(xPackage));
+          xPkgIndex := xPackages.Add(TGroupItem.Create(xGroupType, xGroupTitle, xPackage));
-        TPackageItem(xPackages.Objects[xPkgIndex]).Files.AddObject(xEditor.PageCaption, xEditor);
+        xPackages.Items[xPkgIndex].Files.AddObject(xEditor.PageCaption, xEditor);
       end;
 
       xNewIndex := 0;
       for I := 0 to xPackages.Count-1 do
       begin
-        xPkgItem := TPackageItem(xPackages.Objects[I]);
+        xPkgItem := xPackages.Items[I];
 
-        xPackageName := xPackages[I];
+        case xPkgItem.&Type of
-        case xPackageName[1] of
+          gtProject:
-          Low(Char):
           begin
-            Delete(xPackageName, 1, 1);
             xLbl := TProjectTabLabel.Create(Self);
             if LazarusIDE.ActiveProject <> nil then
             begin
@@ -764,18 +838,19 @@ begin
               xLbl.ShowHint := True;
             end;
           end;
-          High(Char):
+          gtOther:
           begin
-            Delete(xPackageName, 1, 1);
             xLbl := TOtherTabLabel.Create(Self);
           end;
-        else
+          gtPackage:
+          begin
             xLbl := TPackageTabLabel.Create(Self);
             TPackageTabLabel(xLbl).Package := xPkgItem.Package;
             xLbl.Hint := xPkgItem.Package.Filename;
             xLbl.ShowHint := True;
           end;
-        xLbl.Caption := xPackageName;
+        end;
+        xLbl.Caption := xPkgItem.Title;
         xLbl.Parent := FPanel;
         xLbl.PopupMenu := FTabLabelMenu;
         xLbl.Height := TPackageTabButton.GetControlClassDefaultSize.cy;
@@ -811,7 +886,7 @@ begin
           xBtn.Down := xEditor = xOldActive;
           if xBtn.Down then
             xActBtn := xBtn;
-          xBtn.IsOtherFile := xPackages[I][1] = High(Char); // ToDo: do it better...
+          xBtn.IsOtherFile := xPkgItem.&Type = gtOther;
         end;
       end;
     finally