mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-14 10:59:11 +02:00
merge r50927 #ce69f57579: packagetabs: better sorting of groups (fix for linux)
git-svn-id: branches/fixes_1_6@50928 -
This commit is contained in:
parent
3fcb90a119
commit
ae4a2ed0cb
@ -33,7 +33,7 @@ uses
|
|||||||
Classes, SysUtils, Types, Contnrs, Controls, SrcEditorIntf, StdCtrls, Buttons,
|
Classes, SysUtils, Types, Contnrs, Controls, SrcEditorIntf, StdCtrls, Buttons,
|
||||||
ComCtrls, Forms, LazFileUtils, PackageIntf, Graphics, Menus, LazIDEIntf,
|
ComCtrls, Forms, LazFileUtils, PackageIntf, Graphics, Menus, LazIDEIntf,
|
||||||
ExtCtrls, IDEImagesIntf, Laz2_XMLCfg, IDECommands, LCLIntf,
|
ExtCtrls, IDEImagesIntf, Laz2_XMLCfg, IDECommands, LCLIntf,
|
||||||
IDEOptionsIntf, packagetabsstr, Clipbrd;
|
IDEOptionsIntf, packagetabsstr, Clipbrd, LCLProc;
|
||||||
|
|
||||||
type
|
type
|
||||||
TPackageTabButton = class(TSpeedButton)
|
TPackageTabButton = class(TSpeedButton)
|
||||||
@ -81,16 +81,28 @@ type
|
|||||||
constructor Create(aOwner: TComponent); override;
|
constructor Create(aOwner: TComponent); override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TPackageItem = class
|
TGroupType = (gtProject, gtPackage, gtOther);
|
||||||
|
TGroupItem = class
|
||||||
public
|
public
|
||||||
|
&Type: TGroupType;
|
||||||
|
Title: string;
|
||||||
Package: TIDEPackage;
|
Package: TIDEPackage;
|
||||||
GroupTabLabel: TGroupTabLabelClass;
|
GroupTabLabel: TGroupTabLabelClass;
|
||||||
Files: TStringList;
|
Files: TStringList;
|
||||||
|
|
||||||
constructor Create(APackage: TIDEPackage);
|
constructor Create(AType: TGroupType; const ATitle: string; APackage: TIDEPackage);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
end;
|
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)
|
TMenuItemCommand = class(TMenuItem)
|
||||||
public
|
public
|
||||||
IDECommand: Word;
|
IDECommand: Word;
|
||||||
@ -210,6 +222,9 @@ type
|
|||||||
ANoteBook: TPageControl):integer;
|
ANoteBook: TPageControl):integer;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function CompareGroupItem(const AGroupItem: TGroupItem; AType: TGroupType; APackage: TIDEPackage): Integer;
|
||||||
|
function CompareGroupItem(const AGroupItem1, AGroupItem2: TGroupItem): Integer;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -217,11 +232,66 @@ implementation
|
|||||||
var
|
var
|
||||||
xPackageTabPanels: TPackageTabPanels = nil;
|
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;
|
procedure Register;
|
||||||
begin
|
begin
|
||||||
xPackageTabPanels := TPackageTabPanels.Create(nil);
|
xPackageTabPanels := TPackageTabPanels.Create(nil);
|
||||||
end;
|
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 }
|
{ TSourceEditorWindowInterfaceHelper }
|
||||||
|
|
||||||
function TSourceEditorWindowInterfaceHelper.FindPageWithEditor(
|
function TSourceEditorWindowInterfaceHelper.FindPageWithEditor(
|
||||||
@ -479,17 +549,20 @@ begin
|
|||||||
Font.Style := Font.Style - [fsUnderline];
|
Font.Style := Font.Style - [fsUnderline];
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TPackageItem }
|
{ TGroupItem }
|
||||||
|
|
||||||
constructor TPackageItem.Create(APackage: TIDEPackage);
|
constructor TGroupItem.Create(AType: TGroupType; const ATitle: string;
|
||||||
|
APackage: TIDEPackage);
|
||||||
begin
|
begin
|
||||||
|
&Type := AType;
|
||||||
|
Title := ATitle;
|
||||||
Package := APackage;
|
Package := APackage;
|
||||||
Files := TStringList.Create;
|
Files := TStringList.Create;
|
||||||
Files.Sorted := True;
|
Files.Sorted := True;
|
||||||
Files.Duplicates := dupAccept;
|
Files.Duplicates := dupAccept;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TPackageItem.Destroy;
|
destructor TGroupItem.Destroy;
|
||||||
begin
|
begin
|
||||||
Files.Free;
|
Files.Free;
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
@ -705,12 +778,13 @@ procedure TPackageTabPanel.RecreateToolBar;
|
|||||||
var
|
var
|
||||||
I, L, xPkgIndex, xNewIndex, xOldIndex: Integer;
|
I, L, xPkgIndex, xNewIndex, xOldIndex: Integer;
|
||||||
xBtn, xActBtn: TPackageTabButton;
|
xBtn, xActBtn: TPackageTabButton;
|
||||||
xPackages: TStringList;
|
xPackages: TGroupList;
|
||||||
xPackage: TIDEPackage;
|
xPackage: TIDEPackage;
|
||||||
xEditor, xOldActive: TSourceEditorInterface;
|
xEditor, xOldActive: TSourceEditorInterface;
|
||||||
xLbl: TGroupTabLabel;
|
xLbl: TGroupTabLabel;
|
||||||
xPkgItem: TPackageItem;
|
xPkgItem: TGroupItem;
|
||||||
xPackageName: string;
|
xGroupTitle: string;
|
||||||
|
xGroupType: TGroupType;
|
||||||
begin
|
begin
|
||||||
FRecreateToolBar.FLastFiles.Clear;
|
FRecreateToolBar.FLastFiles.Clear;
|
||||||
FWindow.IncUpdateLock;
|
FWindow.IncUpdateLock;
|
||||||
@ -720,43 +794,43 @@ begin
|
|||||||
for I := FPanel.ControlCount-1 downto 0 do
|
for I := FPanel.ControlCount-1 downto 0 do
|
||||||
FPanel.Controls[I].Free;
|
FPanel.Controls[I].Free;
|
||||||
|
|
||||||
xPackages := TStringList.Create;
|
xPackages := TGroupList.Create;
|
||||||
try
|
try
|
||||||
xPackages.Sorted := True;
|
|
||||||
xPackages.Duplicates := dupIgnore;
|
|
||||||
xPackages.OwnsObjects := True;
|
|
||||||
|
|
||||||
for I := 0 to FWindow.Count-1 do
|
for I := 0 to FWindow.Count-1 do
|
||||||
begin
|
begin
|
||||||
xEditor := FWindow.Items[I];
|
xEditor := FWindow.Items[I];
|
||||||
FRecreateToolBar.FLastFiles.Add(xEditor.FileName);
|
FRecreateToolBar.FLastFiles.Add(xEditor.FileName);
|
||||||
xPackage := nil;
|
xPackage := nil;
|
||||||
if xEditor.GetProjectFile.IsPartOfProject then
|
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
|
begin
|
||||||
PackageEditingInterface.GetPackageOfSourceEditor(xPackage, xEditor);
|
PackageEditingInterface.GetPackageOfSourceEditor(xPackage, xEditor);
|
||||||
if (xPackage<>nil) and (xPackage.Name<>'') then
|
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;
|
||||||
end;
|
end;
|
||||||
xPkgIndex := xPackages.IndexOf(xPackageName);
|
if not xPackages.Find(xGroupType, xPackage, xPkgIndex) then
|
||||||
if xPkgIndex < 0 then
|
xPkgIndex := xPackages.Add(TGroupItem.Create(xGroupType, xGroupTitle, xPackage));
|
||||||
xPkgIndex := xPackages.AddObject(xPackageName, TPackageItem.Create(xPackage));
|
xPackages.Items[xPkgIndex].Files.AddObject(xEditor.PageCaption, xEditor);
|
||||||
TPackageItem(xPackages.Objects[xPkgIndex]).Files.AddObject(xEditor.PageCaption, xEditor);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
xNewIndex := 0;
|
xNewIndex := 0;
|
||||||
for I := 0 to xPackages.Count-1 do
|
for I := 0 to xPackages.Count-1 do
|
||||||
begin
|
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
|
begin
|
||||||
Delete(xPackageName, 1, 1);
|
|
||||||
xLbl := TProjectTabLabel.Create(Self);
|
xLbl := TProjectTabLabel.Create(Self);
|
||||||
if LazarusIDE.ActiveProject <> nil then
|
if LazarusIDE.ActiveProject <> nil then
|
||||||
begin
|
begin
|
||||||
@ -764,18 +838,19 @@ begin
|
|||||||
xLbl.ShowHint := True;
|
xLbl.ShowHint := True;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
High(Char):
|
gtOther:
|
||||||
begin
|
begin
|
||||||
Delete(xPackageName, 1, 1);
|
|
||||||
xLbl := TOtherTabLabel.Create(Self);
|
xLbl := TOtherTabLabel.Create(Self);
|
||||||
end;
|
end;
|
||||||
else
|
gtPackage:
|
||||||
xLbl := TPackageTabLabel.Create(Self);
|
begin
|
||||||
TPackageTabLabel(xLbl).Package := xPkgItem.Package;
|
xLbl := TPackageTabLabel.Create(Self);
|
||||||
xLbl.Hint := xPkgItem.Package.Filename;
|
TPackageTabLabel(xLbl).Package := xPkgItem.Package;
|
||||||
xLbl.ShowHint := True;
|
xLbl.Hint := xPkgItem.Package.Filename;
|
||||||
|
xLbl.ShowHint := True;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
xLbl.Caption := xPackageName;
|
xLbl.Caption := xPkgItem.Title;
|
||||||
xLbl.Parent := FPanel;
|
xLbl.Parent := FPanel;
|
||||||
xLbl.PopupMenu := FTabLabelMenu;
|
xLbl.PopupMenu := FTabLabelMenu;
|
||||||
xLbl.Height := TPackageTabButton.GetControlClassDefaultSize.cy;
|
xLbl.Height := TPackageTabButton.GetControlClassDefaultSize.cy;
|
||||||
@ -811,7 +886,7 @@ begin
|
|||||||
xBtn.Down := xEditor = xOldActive;
|
xBtn.Down := xEditor = xOldActive;
|
||||||
if xBtn.Down then
|
if xBtn.Down then
|
||||||
xActBtn := xBtn;
|
xActBtn := xBtn;
|
||||||
xBtn.IsOtherFile := xPackages[I][1] = High(Char); // ToDo: do it better...
|
xBtn.IsOtherFile := xPkgItem.&Type = gtOther;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
finally
|
finally
|
||||||
|
Loading…
Reference in New Issue
Block a user