paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-23 11:28:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

Sparta: Rename units in sparta_Generics to avoid name clash with units in FPC sources. Update to latest Generics Collections code. Eliminate USE_GENERICS_COLLECTIONS define.

Browse Source 
git-svn-id: trunk@62042 -
This commit is contained in:
juha 2019-10-13 07:24:58 +00:00
parent 8074bbd776
commit 1b50e06c5b
21 changed files with 283 additions and 574 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
.gitattributes vendored
View File

@ -4447,7 +4447,6 @@ components/sparta/dockedformeditor/source/sparta_fakecustom.pas svneol=native#te
components/sparta/dockedformeditor/source/sparta_fakeform.pas svneol=native#text/pascal components/sparta/dockedformeditor/source/sparta_fakeform.pas svneol=native#text/pascal
components/sparta/dockedformeditor/source/sparta_fakeframe.pas svneol=native#text/pascal components/sparta/dockedformeditor/source/sparta_fakeframe.pas svneol=native#text/pascal
components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas svneol=native#text/pascal components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas svneol=native#text/pascal
components/sparta/dockedformeditor/source/sparta_hashutils.pas svneol=native#text/pascal
components/sparta/dockedformeditor/source/sparta_mainide.pas svneol=native#text/pascal components/sparta/dockedformeditor/source/sparta_mainide.pas svneol=native#text/pascal
components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas svneol=native#text/pascal components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas svneol=native#text/pascal
components/sparta/dockedformeditor/source/sparta_resizer.pas svneol=native#text/pascal components/sparta/dockedformeditor/source/sparta_resizer.pas svneol=native#text/pascal
@ -4457,14 +4456,14 @@ components/sparta/dockedformeditor/source/spartaapi.pas svneol=native#text/pasca
components/sparta/dockedformeditor/sparta_dockedformeditor.lpk svneol=native#text/plain components/sparta/dockedformeditor/sparta_dockedformeditor.lpk svneol=native#text/plain
components/sparta/dockedformeditor/sparta_dockedformeditor.pas svneol=native#text/pascal components/sparta/dockedformeditor/sparta_dockedformeditor.pas svneol=native#text/pascal
components/sparta/dockedformeditor/sparta_strconsts.pas svneol=native#text/pascal components/sparta/dockedformeditor/sparta_strconsts.pas svneol=native#text/pascal
components/sparta/generics/source/generics.collections.pas svneol=native#text/pascal
components/sparta/generics/source/generics.defaults.pas svneol=native#text/pascal
components/sparta/generics/source/generics.hashes.pas svneol=native#text/pascal
components/sparta/generics/source/generics.helpers.pas svneol=native#text/pascal
components/sparta/generics/source/generics.memoryexpanders.pas svneol=native#text/pascal
components/sparta/generics/source/generics.strings.pas svneol=native#text/pascal
components/sparta/generics/source/inc/generics.dictionaries.inc svneol=native#text/plain components/sparta/generics/source/inc/generics.dictionaries.inc svneol=native#text/plain
components/sparta/generics/source/inc/generics.dictionariesh.inc svneol=native#text/plain components/sparta/generics/source/inc/generics.dictionariesh.inc svneol=native#text/plain
components/sparta/generics/source/sparta_generics.collections.pas svneol=native#text/pascal
components/sparta/generics/source/sparta_generics.defaults.pas svneol=native#text/pascal
components/sparta/generics/source/sparta_generics.hashes.pas svneol=native#text/pascal
components/sparta/generics/source/sparta_generics.helpers.pas svneol=native#text/pascal
components/sparta/generics/source/sparta_generics.memoryexpanders.pas svneol=native#text/pascal
components/sparta/generics/source/sparta_generics.strings.pas svneol=native#text/pascal
components/sparta/generics/sparta_generics.lpk svneol=native#text/plain components/sparta/generics/sparta_generics.lpk svneol=native#text/plain
components/sparta/generics/sparta_generics.pas svneol=native#text/pascal components/sparta/generics/sparta_generics.pas svneol=native#text/pascal
components/sparta/mdi/source/sparta_abstractresizer.pas svneol=native#text/pascal components/sparta/mdi/source/sparta_abstractresizer.pas svneol=native#text/pascal

9
components/sparta/dockedformeditor/source/sparta_fakecustom.pas
View File

@ -18,9 +18,6 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
{$IFDEF USE_GENERICS_COLLECTIONS}
Generics.Defaults,
{$ENDIF}
// LCL // LCL
Forms, Controls, Forms, Controls,
// IdeIntf // IdeIntf
@ -178,8 +175,7 @@ type
{ TDesignedNonControlFormImpl } { TDesignedNonControlFormImpl }
function TDesignedNonControlFormImpl.GetPublishedBounds(AIndex: Integer function TDesignedNonControlFormImpl.GetPublishedBounds(AIndex: Integer): Integer;
): Integer;
var var
LBounds, LClientRect: TRect; LBounds, LClientRect: TRect;
LMediator: TDesignerMediator; LMediator: TDesignerMediator;
@ -487,8 +483,7 @@ begin
Result := True; Result := True;
end; end;
procedure TFakeCustomNonControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer procedure TFakeCustomNonControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
);
begin begin
SetDesignerFormBounds(ALeft, ATop, AWidth, AHeight); SetDesignerFormBounds(ALeft, ATop, AWidth, AHeight);
end; end;

30
components/sparta/dockedformeditor/source/sparta_hashutils.pas
View File

@ -1,30 +0,0 @@
unit sparta_HashUtils;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils;
{$IFNDEF USE_GENERICS_COLLECTIONS}
type
THash_TObject = record
class function Hash(A: TObject; B: SizeUInt): SizeUInt; static;
end;
{$ENDIF}
implementation
{$IFNDEF USE_GENERICS_COLLECTIONS}
class function THash_TObject.Hash(A: TObject; B: SizeUInt): SizeUInt;
begin
if A = nil then
Exit($2A and (b - 1));
Result := A.GetHashCode() and (b - 1);
end;
{$ENDIF}
end.

368
components/sparta/dockedformeditor/source/sparta_mainide.pas
View File

@ -18,10 +18,10 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
{$IFDEF USE_GENERICS_COLLECTIONS} {$IF FPC_FULLVERSION>=30200}
Generics.Collections, Generics.Defaults, Generics.Collections, Generics.Defaults,
{$ELSE} {$ELSE}
ghashmap, sparta_HashUtils, gvector, sparta_Generics.Collections, sparta_Generics.Defaults,
{$ENDIF} {$ENDIF}
contnrs, contnrs,
// LCL // LCL
@ -46,25 +46,15 @@ type
FLastScreenshot: TBitmap; FLastScreenshot: TBitmap;
FPopupParent: TSourceEditorWindowInterface; FPopupParent: TSourceEditorWindowInterface;
FHiding: boolean; FHiding: boolean;
{$IFDEF USE_GENERICS_COLLECTIONS}
FFormImages: TList<TImage>; FFormImages: TList<TImage>;
{$ELSE}
FFormImages: TList;
{$ENDIF}
procedure WndMethod(var Msg: TLMessage); procedure WndMethod(var Msg: TLMessage);
procedure SetPopupParent(AVal: TSourceEditorWindowInterface); procedure SetPopupParent(AVal: TSourceEditorWindowInterface);
procedure DoAddForm; procedure DoAddForm;
procedure FormChangeBounds(Sender: TObject); procedure FormChangeBounds(Sender: TObject);
public public
{$IFDEF USE_GENERICS_COLLECTIONS}
class var AddFormEvents: TList<TNotifyEvent>; class var AddFormEvents: TList<TNotifyEvent>;
{$ELSE}
class var AddFormEvents: TVector<TNotifyEvent>;
{$ENDIF}
class constructor Init; class constructor Init;
class destructor Finit; class destructor Finit;
procedure AddFormImage(AImage: TImage); procedure AddFormImage(AImage: TImage);
procedure RemoveFormImage(AImage: TImage); procedure RemoveFormImage(AImage: TImage);
procedure RepaintFormImages; procedure RepaintFormImages;
@ -101,11 +91,7 @@ type
private private
FActiveDesignFormData: TDesignFormData; FActiveDesignFormData: TDesignFormData;
FForm: TSourceEditorWindowInterface; FForm: TSourceEditorWindowInterface;
{$IFDEF USE_GENERICS_COLLECTIONS}
FPageCtrlList: TDictionary<TSourceEditorInterface, TModulePageControl>; FPageCtrlList: TDictionary<TSourceEditorInterface, TModulePageControl>;
{$ELSE}
FPageCtrlList: THashmap<TSourceEditorInterface, TModulePageControl, THash_TObject>;
{$ENDIF}
FLastTopParent: TControl; FLastTopParent: TControl;
procedure SetActiveDesignFormData(const AValue: TDesignFormData); procedure SetActiveDesignFormData(const AValue: TDesignFormData);
@ -188,15 +174,9 @@ type
var var
normForms: Classes.TList; // normal forms normForms: Classes.TList; // normal forms
dsgnForms: Classes.TList; // design forms dsgnForms: Classes.TList; // design forms
{$IFDEF USE_GENERICS_COLLECTIONS}
SourceEditorWindows: TObjectDictionary<TSourceEditorWindowInterface, TSourceEditorWindowData>; SourceEditorWindows: TObjectDictionary<TSourceEditorWindowInterface, TSourceEditorWindowData>;
{$ELSE}
SourceEditorWindows: THashmap<TSourceEditorWindowInterface, TSourceEditorWindowData, THash_TObject>;
{$ENDIF}
LastActiveSourceEditorWindow: TSourceEditorWindowInterface = nil; LastActiveSourceEditorWindow: TSourceEditorWindowInterface = nil;
LastActiveSourceEditor: TSourceEditorInterface = nil; LastActiveSourceEditor: TSourceEditorInterface = nil;
BoundInitialized: Boolean; BoundInitialized: Boolean;
function FindModulePageControl(AForm: TSourceEditorWindowInterface): TModulePageControl; overload; function FindModulePageControl(AForm: TSourceEditorWindowInterface): TModulePageControl; overload;
@ -262,29 +242,11 @@ end;
function AbsoluteFindModulePageControl(ASrcEditor: TSourceEditorInterface): TModulePageControl; function AbsoluteFindModulePageControl(ASrcEditor: TSourceEditorInterface): TModulePageControl;
var var
LSEWD: TSourceEditorWindowData; LSEWD: TSourceEditorWindowData;
{$IFnDEF USE_GENERICS_COLLECTIONS}
LIterator: THashmap<TSourceEditorWindowInterface, TSourceEditorWindowData, THash_TObject>.TIterator;
{$ENDIF}
begin begin
Result := nil; Result := nil;
{$IFDEF USE_GENERICS_COLLECTIONS}
for LSEWD in SourceEditorWindows.Values do for LSEWD in SourceEditorWindows.Values do
if LSEWD.FPageCtrlList.ContainsKey(ASrcEditor) then if LSEWD.FPageCtrlList.ContainsKey(ASrcEditor) then
Exit(LSEWD.FPageCtrlList[ASrcEditor]); Exit(LSEWD.FPageCtrlList[ASrcEditor]);
{$ELSE}
LIterator := SourceEditorWindows.Iterator;
if LIterator <> nil then
try
repeat
LSEWD := LIterator.Value;
if LSEWD.FPageCtrlList.contains(ASrcEditor) then
Exit(LSEWD.FPageCtrlList[ASrcEditor]);
until not LIterator.next;
finally
LIterator.Free;
end;
{$ENDIF}
end; end;
function FindSourceEditorForDesigner(ADesigner: TIDesigner): TSourceEditorInterface; function FindSourceEditorForDesigner(ADesigner: TIDesigner): TSourceEditorInterface;
@ -325,11 +287,7 @@ procedure RefreshAllSourceWindowsModulePageControl;
var var
LWindow: TSourceEditorWindowInterface; LWindow: TSourceEditorWindowInterface;
LPageCtrl: TModulePageControl; LPageCtrl: TModulePageControl;
{$IFnDEF USE_GENERICS_COLLECTIONS}
LIterator: THashmap<TSourceEditorWindowInterface, TSourceEditorWindowData, THash_TObject>.TIterator;
{$ENDIF}
begin begin
{$IFDEF USE_GENERICS_COLLECTIONS}
for LWindow in SourceEditorWindows.Keys do for LWindow in SourceEditorWindows.Keys do
begin begin
LPageCtrl := FindModulePageControl(LWindow); LPageCtrl := FindModulePageControl(LWindow);
@ -347,32 +305,6 @@ begin
else else
LPageCtrl.HideDesignPage; LPageCtrl.HideDesignPage;
end; end;
{$ELSE}
LIterator := SourceEditorWindows.Iterator;
if LIterator <> nil then
try
repeat
LWindow := LIterator.Key;
LPageCtrl := FindModulePageControl(LWindow);
// for example LPageCtrl is nil when we clone module to new window
if (LPageCtrl = nil) or (csDestroying in LWindow.ComponentState) then
Continue;
if LWindow.ActiveEditor = nil then
LPageCtrl.HideDesignPage
else
if LWindow.ActiveEditor.GetDesigner(True) <> nil then
// TODO some check function: is displayed right form?
LPageCtrl.ShowDesignPage
else
LPageCtrl.HideDesignPage;
until not LIterator.next;
finally
LIterator.Free;
end;
{$ENDIF}
end; end;
// sometimes at some level of initialization form can not contain TIDesigner // sometimes at some level of initialization form can not contain TIDesigner
@ -396,16 +328,10 @@ function FindDesignFormData(AModulePageCtrl: TModulePageControl): TDesignFormDat
var var
LSourceWindow: TSourceEditorWindowInterface; LSourceWindow: TSourceEditorWindowInterface;
LSourceEditor: TSourceEditorInterface; LSourceEditor: TSourceEditorInterface;
{$IFnDEF USE_GENERICS_COLLECTIONS}
LIterator: THashmap<TSourceEditorWindowInterface, TSourceEditorWindowData, THash_TObject>.TIterator;
{$ENDIF}
begin begin
Result := nil; Result := nil;
if AModulePageCtrl = nil then if AModulePageCtrl = nil then
Exit; Exit;
{$IFDEF USE_GENERICS_COLLECTIONS}
for LSourceWindow in SourceEditorWindows.Keys do for LSourceWindow in SourceEditorWindows.Keys do
begin begin
if AModulePageCtrl.Owner = LSourceWindow then if AModulePageCtrl.Owner = LSourceWindow then
@ -419,28 +345,6 @@ begin
Exit; Exit;
end; end;
end; end;
{$ELSE}
LIterator := SourceEditorWindows.Iterator;
if LIterator <> nil then
try
repeat
LSourceWindow := LIterator.Key;
if AModulePageCtrl.Owner = LSourceWindow then
begin
LSourceEditor := LSourceWindow.ActiveEditor;
if LSourceEditor = nil then
Exit;
Result := FindDesignFormData(LSourceEditor.GetDesigner(True));
Exit;
end;
until not LIterator.next;
finally
LIterator.Free;
end;
{$ENDIF}
end; end;
{ TDesignFormData } { TDesignFormData }
@ -515,11 +419,7 @@ end;
class constructor TDesignFormData.Init; class constructor TDesignFormData.Init;
begin begin
{$IFDEF USE_GENERICS_COLLECTIONS}
AddFormEvents := TList<TNotifyEvent>.Create; AddFormEvents := TList<TNotifyEvent>.Create;
{$ELSE}
AddFormEvents := TVector<TNotifyEvent>.Create;
{$ENDIF}
end; end;
class destructor TDesignFormData.Finit; class destructor TDesignFormData.Finit;
@ -552,21 +452,10 @@ end;
procedure TDesignFormData.DoAddForm; procedure TDesignFormData.DoAddForm;
var var
{$IFDEF USE_GENERICS_COLLECTIONS}
ne: TNotifyEvent; ne: TNotifyEvent;
{$ELSE}
i: Integer;
{$ENDIF}
begin begin
{$IFDEF USE_GENERICS_COLLECTIONS}
for ne in AddFormEvents do for ne in AddFormEvents do
ne(Self); ne(Self);
{$ELSE}
if AddFormEvents.Size > 0 then // Arithmetic overflow without a test. Size = unsigned.
for i := 0 to AddFormEvents.Size-1 do
AddFormEvents[i](Self);
{$ENDIF}
end; end;
procedure TDesignFormData.FormChangeBounds(Sender: TObject); procedure TDesignFormData.FormChangeBounds(Sender: TObject);
@ -587,11 +476,7 @@ begin
if FForm.Form is TFakeForm then if FForm.Form is TFakeForm then
begin begin
{$IFDEF USE_GENERICS_COLLECTIONS}
FFormImages := TList<TImage>.Create; FFormImages := TList<TImage>.Create;
{$ELSE}
FFormImages := TList.Create;
{$ENDIF}
DoAddForm; DoAddForm;
end; end;
end; end;
@ -717,11 +602,7 @@ end;
constructor TSourceEditorWindowData.Create(AForm: TSourceEditorWindowInterface); constructor TSourceEditorWindowData.Create(AForm: TSourceEditorWindowInterface);
begin begin
FForm := AForm; FForm := AForm;
{$IFDEF USE_GENERICS_COLLECTIONS}
FPageCtrlList := TDictionary<TSourceEditorInterface, TModulePageControl>.Create; FPageCtrlList := TDictionary<TSourceEditorInterface, TModulePageControl>.Create;
{$ELSE}
FPageCtrlList := THashmap<TSourceEditorInterface, TModulePageControl, THash_TObject>.Create;
{$ENDIF}
end; end;
destructor TSourceEditorWindowData.Destroy; destructor TSourceEditorWindowData.Destroy;
@ -750,21 +631,13 @@ end;
procedure TSourceEditorWindowData.AddPageCtrl(ASrcEditor: TSourceEditorInterface; APage: TModulePageControl); procedure TSourceEditorWindowData.AddPageCtrl(ASrcEditor: TSourceEditorInterface; APage: TModulePageControl);
begin begin
{$IFDEF USE_GENERICS_COLLECTIONS}
FPageCtrlList.Add(ASrcEditor, APage); FPageCtrlList.Add(ASrcEditor, APage);
{$ELSE}
FPageCtrlList.insert(ASrcEditor, APage);
{$ENDIF}
APage.Pages[1].OnChangeBounds:=OnChangeBounds; APage.Pages[1].OnChangeBounds:=OnChangeBounds;
end; end;
procedure TSourceEditorWindowData.RemovePageCtrl(ASrcEditor: TSourceEditorInterface); procedure TSourceEditorWindowData.RemovePageCtrl(ASrcEditor: TSourceEditorInterface);
begin begin
{$IFDEF USE_GENERICS_COLLECTIONS}
FPageCtrlList.Remove(ASrcEditor); FPageCtrlList.Remove(ASrcEditor);
{$ELSE}
FPageCtrlList.Delete(ASrcEditor);
{$ENDIF}
end; end;
{ TDTXTabMaster } { TDTXTabMaster }
@ -981,10 +854,6 @@ var
LSEWD: TSourceEditorWindowData; LSEWD: TSourceEditorWindowData;
mpc: TModulePageControl; mpc: TModulePageControl;
LFormData: TDesignFormData; LFormData: TDesignFormData;
{$IFnDEF USE_GENERICS_COLLECTIONS}
LIterator: THashmap<TSourceEditorWindowInterface, TSourceEditorWindowData, THash_TObject>.TIterator;
LIterator2: THashmap<TSourceEditorInterface, TModulePageControl, THash_TObject>.TIterator;
{$ENDIF}
begin begin
Form.Parent := nil; Form.Parent := nil;
Application.ProcessMessages; // For TFrame - System Error. Code: 1400. Invalid window handle. Application.ProcessMessages; // For TFrame - System Error. Code: 1400. Invalid window handle.
@ -992,7 +861,6 @@ begin
LFormData := FindDesignFormData(Form); LFormData := FindDesignFormData(Form);
dsgnForms.Remove(LFormData); dsgnForms.Remove(LFormData);
{$IFDEF USE_GENERICS_COLLECTIONS}
for LSEWD in SourceEditorWindows.Values do for LSEWD in SourceEditorWindows.Values do
begin begin
if LSEWD.ActiveDesignFormData <> nil then if LSEWD.ActiveDesignFormData <> nil then
@ -1004,34 +872,6 @@ begin
if mpc.DesignFormData.Form.Form = Form then if mpc.DesignFormData.Form.Form = Form then
mpc.DesignFormData := nil; mpc.DesignFormData := nil;
end; end;
{$ELSE}
LIterator := SourceEditorWindows.Iterator;
if LIterator <> nil then
try
repeat
LSEWD := LIterator.Value;
if LSEWD.ActiveDesignFormData <> nil then
if LSEWD.ActiveDesignFormData.Form.Form = Form then
LSEWD.FActiveDesignFormData := nil; // important - we can't call OnChange tab, because tab don't exist anymore
LIterator2 := LSEWD.FPageCtrlList.Iterator;
if LIterator2 <> nil then
try
repeat
mpc := LIterator2.Value;
if mpc.DesignFormData <> nil then
if mpc.DesignFormData.Form.Form = Form then
mpc.DesignFormData := nil;
until not LIterator2.next;
finally
LIterator2.Free;
end;
until not LIterator.next;
finally
LIterator.Free;
end;
{$ENDIF}
LFormData.Free; LFormData.Free;
end; end;
@ -1055,11 +895,7 @@ begin
if Sender.ClassNameIs('TSourceNotebook') then if Sender.ClassNameIs('TSourceNotebook') then
begin begin
LSourceEditorWindow := Sender as TSourceEditorWindowInterface; LSourceEditorWindow := Sender as TSourceEditorWindowInterface;
{$IFDEF USE_GENERICS_COLLECTIONS}
SourceEditorWindows.Add(LSourceEditorWindow, TSourceEditorWindowData.Create(LSourceEditorWindow)); SourceEditorWindows.Add(LSourceEditorWindow, TSourceEditorWindowData.Create(LSourceEditorWindow));
{$ELSE}
SourceEditorWindows.insert(LSourceEditorWindow, TSourceEditorWindowData.Create(LSourceEditorWindow));
{$ENDIF}
end; end;
end; end;
@ -1071,12 +907,7 @@ begin
for p in dsgnForms do for p in dsgnForms do
if f.FForm.LastActiveSourceWindow = Sender then if f.FForm.LastActiveSourceWindow = Sender then
f.FForm.LastActiveSourceWindow := nil; f.FForm.LastActiveSourceWindow := nil;
{$IFDEF USE_GENERICS_COLLECTIONS}
SourceEditorWindows.Remove(Sender as TSourceEditorWindowInterface); SourceEditorWindows.Remove(Sender as TSourceEditorWindowInterface);
{$ELSE}
SourceEditorWindows[Sender as TSourceEditorWindowInterface].Free;
SourceEditorWindows.Delete(Sender as TSourceEditorWindowInterface);
{$ENDIF}
if LastActiveSourceEditorWindow = Sender then if LastActiveSourceEditorWindow = Sender then
LastActiveSourceEditorWindow := nil; LastActiveSourceEditorWindow := nil;
end; end;
@ -1088,20 +919,10 @@ var
LDesignedForm: IDesignedForm; LDesignedForm: IDesignedForm;
begin begin
LWindow := Sender as TSourceEditorWindowInterface; LWindow := Sender as TSourceEditorWindowInterface;
{$IFDEF USE_GENERICS_COLLECTIONS}
if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) or if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) or
(LWindowData.ActiveDesignFormData = nil) (LWindowData.ActiveDesignFormData = nil)
then then
Exit; Exit;
{$ELSE}
if not SourceEditorWindows.contains(LWindow) then
Exit;
LWindowData := SourceEditorWindows[LWindow];
if LWindowData.ActiveDesignFormData = nil then
Exit;
{$ENDIF}
LDesignedForm := LWindowData.ActiveDesignFormData as IDesignedForm; LDesignedForm := LWindowData.ActiveDesignFormData as IDesignedForm;
LDesignedForm.ShowWindow; LDesignedForm.ShowWindow;
end; end;
@ -1113,20 +934,10 @@ var
LDesignedForm: IDesignedForm; LDesignedForm: IDesignedForm;
begin begin
LWindow := Sender as TSourceEditorWindowInterface; LWindow := Sender as TSourceEditorWindowInterface;
{$IFDEF USE_GENERICS_COLLECTIONS}
if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) or if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) or
(LWindowData.ActiveDesignFormData = nil) (LWindowData.ActiveDesignFormData = nil)
then then
Exit; Exit;
{$ELSE}
if not SourceEditorWindows.contains(LWindow) then
Exit;
LWindowData := SourceEditorWindows[LWindow];
if LWindowData.ActiveDesignFormData = nil then
Exit;
{$ENDIF}
LDesignedForm := LWindowData.ActiveDesignFormData as IDesignedForm; LDesignedForm := LWindowData.ActiveDesignFormData as IDesignedForm;
LDesignedForm.HideWindow; LDesignedForm.HideWindow;
end; end;
@ -1144,9 +955,6 @@ class procedure TSpartaMainIDE.EditorActivated(Sender: TObject);
var var
LDesigner: TIDesigner; LDesigner: TIDesigner;
LSourceEditor: TSourceEditorInterface; LSourceEditor: TSourceEditorInterface;
{$IFnDEF USE_GENERICS_COLLECTIONS}
LIterator: THashmap<TSourceEditorInterface, TModulePageControl, THash_TObject>.TIterator;
{$ENDIF}
function LastSourceEditorNotFound: boolean; function LastSourceEditorNotFound: boolean;
var var
@ -1155,8 +963,6 @@ var
begin begin
if (LastActiveSourceEditorWindow = nil) or (LastActiveSourceEditor = nil) then if (LastActiveSourceEditorWindow = nil) or (LastActiveSourceEditor = nil) then
Exit(False); Exit(False);
{$IFDEF USE_GENERICS_COLLECTIONS}
for se in SourceEditorWindows[LastActiveSourceEditorWindow].FPageCtrlList.Keys do for se in SourceEditorWindows[LastActiveSourceEditorWindow].FPageCtrlList.Keys do
begin begin
Result := True; Result := True;
@ -1173,30 +979,6 @@ var
Exit; Exit;
end; end;
end; end;
{$ELSE}
LIterator := SourceEditorWindows[LastActiveSourceEditorWindow].FPageCtrlList.Iterator;
if LIterator <> nil then
try
repeat
se := LIterator.Key;
Result := True;
for i := 0 to LastActiveSourceEditorWindow.Count - 1 do
if se = LastActiveSourceEditorWindow.Items[i] then
begin
Result := False;
Break;
end;
if Result then
begin
LastActiveSourceEditor := se; // after moving code editor into other window, sometimes IDE switch to other tab :\ damn... this line prevent this.
Exit;
end;
until not LIterator.next;
finally
LIterator.Free;
end;
{$ENDIF}
Result := False; Result := False;
end; end;
@ -1401,13 +1183,7 @@ class procedure TSpartaMainIDE.TabChange(Sender: TObject);
var var
LActiveSourceWindow: TSourceEditorWindowInterface; LActiveSourceWindow: TSourceEditorWindowInterface;
w: TSourceEditorWindowInterface; w: TSourceEditorWindowInterface;
{$IFDEF USE_GENERICS_COLLECTIONS}
p: TPair<TSourceEditorInterface, TModulePageControl>; p: TPair<TSourceEditorInterface, TModulePageControl>;
{$ELSE}
p: THashmap<TSourceEditorInterface, TModulePageControl, THash_TObject>.TPair;
LIterator: THashmap<TSourceEditorWindowInterface, TSourceEditorWindowData, THash_TObject>.TIterator;
LIterator2: THashmap<TSourceEditorInterface, TModulePageControl, THash_TObject>.TIterator;
{$ENDIF}
LDesigner: TIDesigner; LDesigner: TIDesigner;
LFormData: TDesignFormData; LFormData: TDesignFormData;
LPageCtrl: TModulePageControl; LPageCtrl: TModulePageControl;
@ -1425,18 +1201,12 @@ begin
begin begin
LDesigner := LActiveSourceWindow.ActiveEditor.GetDesigner(True); LDesigner := LActiveSourceWindow.ActiveEditor.GetDesigner(True);
LFormData := FindDesignFormData(LDesigner); LFormData := FindDesignFormData(LDesigner);
if (LFormData <> nil)
{$IFDEF USE_GENERICS_COLLECTIONS} and SourceEditorWindows.TryGetValue(LActiveSourceWindow, LSourceWndData) then
if (LFormData <> nil) and SourceEditorWindows.TryGetValue(LActiveSourceWindow, LSourceWndData) then
begin begin
case LPageCtrl.ActivePageIndex of case LPageCtrl.ActivePageIndex of
0: 0: LSourceWndData.ActiveDesignFormData := nil;
begin 1: begin // deactivate design tab in other page control :)
LSourceWndData.ActiveDesignFormData := nil;
end;
1:
begin
// deactivate design tab in other page control :)
for w in SourceEditorWindows.Keys do for w in SourceEditorWindows.Keys do
if w = LActiveSourceWindow then if w = LActiveSourceWindow then
Continue Continue
@ -1446,88 +1216,24 @@ begin
begin begin
IDETabMaster.ShowCode(p.Key); IDETabMaster.ShowCode(p.Key);
end; end;
LSourceWndData.ActiveDesignFormData := LFormData; LSourceWndData.ActiveDesignFormData := LFormData;
// to handle windows with different size // enable autosizing after creating a new form
LPageCtrl.BoundToDesignTabSheet;
end;
end;
end;
{$ELSE}
if (LFormData <> nil) and SourceEditorWindows.contains(LActiveSourceWindow) then
begin
LSourceWndData := SourceEditorWindows[LActiveSourceWindow];
case LPageCtrl.ActivePageIndex of
0:
begin
LSourceWndData.ActiveDesignFormData := nil;
end;
1:
begin
// deactivate design tab in other page control :)
LIterator := SourceEditorWindows.Iterator;
if LIterator <> nil then
try
repeat
w := LIterator.Key;
if w = LActiveSourceWindow then
Continue
else
begin
LIterator2 := SourceEditorWindows[w].FPageCtrlList.Iterator;
if LIterator2 <> nil then
try
repeat
p := LIterator2.Data;
if (p.Value.DesignFormData = LFormData) and (p.Value <> Sender) then
IDETabMaster.ShowCode(p.Key);
until not LIterator2.next;
finally
LIterator2.Free;
end;
end;
until not LIterator.next;
finally
LIterator.Free;
end;
LSourceWndData.ActiveDesignFormData := LFormData;
// enable autosizing after creating a new form, see issue #32207
TDTXTabMaster(IDETabMaster).EnableAutoSizing(LFormData.Form.Form); TDTXTabMaster(IDETabMaster).EnableAutoSizing(LFormData.Form.Form);
// to handle windows with different size // to handle windows with different size
LPageCtrl.BoundToDesignTabSheet; LPageCtrl.BoundToDesignTabSheet;
end; end;
end; end;
end; end;
{$ENDIF}
end; end;
end; end;
class procedure TSpartaMainIDE.GlobalOnChangeBounds(Sender: TObject); class procedure TSpartaMainIDE.GlobalOnChangeBounds(Sender: TObject);
var var
sewd: TSourceEditorWindowData; sewd: TSourceEditorWindowData;
{$IFnDEF USE_GENERICS_COLLECTIONS}
LIterator: THashmap<TSourceEditorWindowInterface, TSourceEditorWindowData, THash_TObject>.TIterator;
{$ENDIF}
begin begin
{$IFDEF USE_GENERICS_COLLECTIONS}
for sewd in SourceEditorWindows.Values do for sewd in SourceEditorWindows.Values do
begin
sewd.OnChangeBounds(Sender); sewd.OnChangeBounds(Sender);
end; end;
{$ELSE}
LIterator := SourceEditorWindows.Iterator;
if LIterator <> nil then
try
repeat
sewd := LIterator.Value;
sewd.OnChangeBounds(Sender)
until not LIterator.next;
finally
LIterator.Free;
end;
{$ENDIF}
end;
class procedure TSpartaMainIDE.GlobalSNOnChangeBounds(Sender: TObject); class procedure TSpartaMainIDE.GlobalSNOnChangeBounds(Sender: TObject);
var var
@ -1539,14 +1245,8 @@ begin
LWindow := Sender as TSourceEditorWindowInterface; LWindow := Sender as TSourceEditorWindowInterface;
// dock/undock event :) // dock/undock event :)
{$IFDEF USE_GENERICS_COLLECTIONS}
if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) then if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) then
Exit; Exit;
{$ELSE}
if not SourceEditorWindows.contains(LWindow) then
Exit;
LWindowData := SourceEditorWindows[LWindow];
{$ENDIF}
if LWindowData.FLastTopParent <> LWindow.GetTopParent then if LWindowData.FLastTopParent <> LWindow.GetTopParent then
begin begin
LWindowData.FLastTopParent := LWindow.GetTopParent; LWindowData.FLastTopParent := LWindow.GetTopParent;
@ -1597,26 +1297,17 @@ var
LPageCtrl, p: TModulePageControl; LPageCtrl, p: TModulePageControl;
w: TSourceEditorWindowInterface; w: TSourceEditorWindowInterface;
e: TSourceEditorInterface; e: TSourceEditorInterface;
{$IFnDEF USE_GENERICS_COLLECTIONS}
LIterator: THashmap<TSourceEditorWindowInterface, TSourceEditorWindowData, THash_TObject>.TIterator;
{$ENDIF}
begin begin
LForm := FindDesignFormData(TCustomForm(Sender).Designer); LForm := FindDesignFormData(TCustomForm(Sender).Designer);
if LForm = nil then if (LForm = nil) or LForm.FHiding then
Exit; Exit;
if LForm.FHiding then
Exit;
LPageCtrl := FindModulePageControl(SourceEditorManagerIntf.ActiveEditor); LPageCtrl := FindModulePageControl(SourceEditorManagerIntf.ActiveEditor);
if LPageCtrl = nil then if LPageCtrl = nil then
Exit; // it should not happen but who knows :P Lazarus IDE is sometimes mischievous Exit; // it should not happen but who knows :P Lazarus IDE is sometimes mischievous
if AComponentPaletteClassSelected then if AComponentPaletteClassSelected then
begin begin
// if form is already opened do nothing, if not then show form for active module. // if form is already opened do nothing, if not then show form for active module.
{$IFDEF USE_GENERICS_COLLECTIONS}
for w in SourceEditorWindows.Keys do for w in SourceEditorWindows.Keys do
begin begin
e := w.ActiveEditor; e := w.ActiveEditor;
@ -1627,26 +1318,7 @@ begin
if p.PageIndex = 1 then if p.PageIndex = 1 then
Exit; Exit;
end; end;
{$ELSE}
LIterator := SourceEditorWindows.Iterator;
if LIterator <> nil then
try
repeat
w := LIterator.Key;
e := w.ActiveEditor;
if (e = nil) or (e.GetDesigner(True) <> LForm.Form.Form.Designer) then
Continue;
p := FindModulePageControl(e);
if p.PageIndex = 1 then
Exit;
until not LIterator.next;
finally
LIterator.Free;
end; end;
{$ENDIF}
end;
IDETabMaster.ShowDesigner(SourceEditorManagerIntf.ActiveEditor); IDETabMaster.ShowDesigner(SourceEditorManagerIntf.ActiveEditor);
end; end;
@ -1749,37 +1421,13 @@ begin
end; end;
end; end;
{$IFnDEF USE_GENERICS_COLLECTIONS}
class procedure FreeSourceEditorWindowsValues;
var
LIterator: THashmap<TSourceEditorWindowInterface, TSourceEditorWindowData, THash_TObject>.TIterator;
begin
LIterator := SourceEditorWindows.Iterator;
if LIterator <> nil then
try
repeat
LIterator.Value.Free;
until not LIterator.next;
finally
LIterator.Free;
end;
end;
{$ENDIF}
initialization initialization
dsgnForms := Classes.TList.Create; dsgnForms := Classes.TList.Create;
{$IFDEF USE_GENERICS_COLLECTIONS}
SourceEditorWindows := TObjectDictionary<TSourceEditorWindowInterface, TSourceEditorWindowData>.Create([doOwnsValues]); SourceEditorWindows := TObjectDictionary<TSourceEditorWindowInterface, TSourceEditorWindowData>.Create([doOwnsValues]);
{$ELSE}
SourceEditorWindows := THashmap<TSourceEditorWindowInterface, TSourceEditorWindowData, THash_TObject>.Create();
{$ENDIF}
normForms := Classes.TList.Create; normForms := Classes.TList.Create;
finalization finalization
normForms.Free; normForms.Free;
{$IFnDEF USE_GENERICS_COLLECTIONS}
FreeSourceEditorWindowsValues;
{$ENDIF}
SourceEditorWindows.Free; SourceEditorWindows.Free;
FreeAndNil(dsgnForms); FreeAndNil(dsgnForms);
end. end.

8
components/sparta/dockedformeditor/sparta_dockedformeditor.lpk
View File

@ -22,7 +22,7 @@
<CustomOptions Value="$(IDEBuildOptions)"/> <CustomOptions Value="$(IDEBuildOptions)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
<Files Count="12"> <Files Count="11">
<Item1> <Item1>
<Filename Value="source\sparta_reg_dockedformeditor.pas"/> <Filename Value="source\sparta_reg_dockedformeditor.pas"/>
<HasRegisterProc Value="True"/> <HasRegisterProc Value="True"/>
@ -65,13 +65,9 @@
<UnitName Value="sparta_MainIDE"/> <UnitName Value="sparta_MainIDE"/>
</Item10> </Item10>
<Item11> <Item11>
<Filename Value="source\sparta_hashutils.pas"/>
<UnitName Value="sparta_HashUtils"/>
</Item11>
<Item12>
<Filename Value="sparta_strconsts.pas"/> <Filename Value="sparta_strconsts.pas"/>
<UnitName Value="sparta_strconsts"/> <UnitName Value="sparta_strconsts"/>
</Item12> </Item11>
</Files> </Files>
<i18n> <i18n>
<EnableI18N Value="True"/> <EnableI18N Value="True"/>

4
components/sparta/dockedformeditor/sparta_dockedformeditor.pas
View File

@ -10,8 +10,8 @@ interface
uses uses
sparta_reg_DockedFormEditor, sparta_DesignedForm, sparta_Resizer, sparta_reg_DockedFormEditor, sparta_DesignedForm, sparta_Resizer,
sparta_ResizerFrame, SpartaAPI, sparta_FakeCustom, sparta_FakeForm, sparta_ResizerFrame, SpartaAPI, sparta_FakeCustom, sparta_FakeForm,
sparta_FakeFrame, sparta_FakeNonControl, sparta_MainIDE, sparta_HashUtils, sparta_FakeFrame, sparta_FakeNonControl, sparta_MainIDE, sparta_strconsts,
sparta_strconsts, LazarusPackageIntf; LazarusPackageIntf;
implementation implementation

107
components/sparta/generics/source/generics.collections.pas → components/sparta/generics/source/sparta_generics.collections.pas
View File

@ -1,11 +1,11 @@
{ {
This file is part of the Free Pascal run time library. This file is part of the Free Pascal/NewPascal run time library.
Copyright (c) 2014 by Maciej Izak (hnb) Copyright (c) 2014 by Maciej Izak (hnb)
member of the Free Sparta development team (http://freesparta.com) member of the NewPascal development team (http://newpascal.org)
Copyright(c) 2004-2014 DaThoX Copyright(c) 2004-2018 DaThoX
It contains the Free Pascal generics library It contains the generics collections library
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -24,7 +24,7 @@
**********************************************************************} **********************************************************************}
unit Generics.Collections; unit sparta_Generics.Collections;
{$MODE DELPHI}{$H+} {$MODE DELPHI}{$H+}
{$MACRO ON} {$MACRO ON}
@ -41,27 +41,9 @@ unit Generics.Collections;
interface interface
uses uses
RtlConsts, Classes, SysUtils, Generics.MemoryExpanders, Generics.Defaults, RtlConsts, Classes, SysUtils,
Generics.Helpers, Generics.Strings; sparta_Generics.MemoryExpanders, sparta_Generics.Defaults,
sparta_Generics.Helpers, sparta_Generics.Strings;
{ FPC BUGS related to Generics.* (54 bugs, 19 fixed)
REGRESSION: 26483, 26481
FIXED REGRESSION: 26480, 26482
CRITICAL: 24848(!!!), 24872(!), 25607(!), 26030, 25917, 25918, 25620, 24283, 24254, 24287 (Related to? 24872)
IMPORTANT: 23862(!), 24097, 24285, 24286 (Similar to? 24285), 24098, 24609 (RTL inconsistency), 24534,
25606, 25614, 26177, 26195
OTHER: 26484, 24073, 24463, 25593, 25596, 25597, 25602, 26181 (or MYBAD?)
CLOSED BUT IMO STILL TO FIX: 25601(!), 25594
FIXED: 25610(!), 24064, 24071, 24282, 24458, 24867, 24871, 25604, 25600, 25605, 25598, 25603, 25929, 26176, 26180,
26193, 24072
MYBAD: 24963, 25599
}
{ LAZARUS BUGS related to Generics.* (7 bugs, 0 fixed)
CRITICAL: 25613
OTHER: 25595, 25612, 25615, 25617, 25618, 25619
}
{.$define EXTRA_WARNINGS} {.$define EXTRA_WARNINGS}
{.$define ENABLE_METHODS_WITH_TEnumerableWithPointers} {.$define ENABLE_METHODS_WITH_TEnumerableWithPointers}
@ -698,7 +680,10 @@ type
procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); inline; procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); inline;
procedure NodeNotify(ANode: PNode; ACollectionNotification: TCollectionNotification; ADispose: boolean); inline; procedure NodeNotify(ANode: PNode; ACollectionNotification: TCollectionNotification; ADispose: boolean); inline;
procedure SetValue(var AValue: TValue; constref ANewValue: TValue); procedure SetValue(var AValue: TValue; constref ANewValue: TValue);
function GetItem(const AKey: TKey): TValue;
procedure SetItem(const AKey: TKey; const AValue: TValue);
property Items[Index: TKey]: TValue read GetItem write SetItem;
// for reporting // for reporting
procedure WriteStr(AStream: TStream; const AText: string); procedure WriteStr(AStream: TStream; const AText: string);
public type public type
@ -761,14 +746,17 @@ type
destructor Destroy; override; destructor Destroy; override;
function AddNode(ANode: PNode): boolean; overload; inline; function AddNode(ANode: PNode): boolean; overload; inline;
function AddNodeArray(const AArray: TArray<PNode>): boolean; overload; inline;
function Add(constref APair: TTreePair): PNode; overload; inline; function Add(constref APair: TTreePair): PNode; overload; inline;
function Add(constref AKey: TKey; constref AValue: TValue): PNode; overload; inline; function Add(constref AKey: TKey; constref AValue: TValue): PNode; overload; inline;
function Remove(constref AKey: TKey; ADisposeNode: boolean = true): boolean; function Remove(constref AKey: TKey; ADisposeNode: boolean = true): boolean;
function ExtractPair(constref AKey: TKey; ADisposeNode: boolean = true): TTreePair; overload; function ExtractPair(constref AKey: TKey; ADisposeNode: boolean = true): TTreePair; overload;
function ExtractPair(constref ANode: PNode; ADispose: boolean = true): TTreePair; overload; function ExtractPair(constref ANode: PNode; ADispose: boolean = true): TTreePair; overload;
function ExtractNode(constref AKey: TKey; ADisposeNode: boolean): PNode; overload; function Extract(constref AKey: TKey; ADisposeNode: boolean): PNode;
function ExtractNode(ANode: PNode; ADispose: boolean): PNode; overload; function ExtractNode(ANode: PNode; ADispose: boolean): PNode;
function ExtractNodeArray(const AArray: TArray<PNode>; ADispose: boolean): TArray<PNode>; overload;
procedure Delete(ANode: PNode; ADispose: boolean = true); inline; procedure Delete(ANode: PNode; ADispose: boolean = true); inline;
procedure DeleteArray(const AArray: TArray<PNode>; ADispose: boolean = true); inline;
function GetEnumerator: TPairEnumerator; function GetEnumerator: TPairEnumerator;
property Nodes: TNodeCollection read GetNodeCollection; property Nodes: TNodeCollection read GetNodeCollection;
@ -801,6 +789,8 @@ type
end; end;
TAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, TEmptyRecord>) TAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, TEmptyRecord>)
public
property Items; default;
end; end;
TIndexedAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, SizeInt>) TIndexedAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, SizeInt>)
@ -827,6 +817,7 @@ type
protected protected
property OnKeyNotify; property OnKeyNotify;
property OnValueNotify; property OnValueNotify;
property Items;
public type public type
TItemEnumerator = TKeyEnumerator; TItemEnumerator = TKeyEnumerator;
public public
@ -947,6 +938,7 @@ type
function Add(constref AValue: T): Boolean; override; function Add(constref AValue: T): Boolean; override;
function Remove(constref AValue: T): Boolean; override; function Remove(constref AValue: T): Boolean; override;
function Extract(constref AValue: T): T; override; function Extract(constref AValue: T): T; override;
function PeekPtr(constref AValue: T): PT;
procedure Clear; override; procedure Clear; override;
function Contains(constref AValue: T): Boolean; override; function Contains(constref AValue: T): Boolean; override;
@ -2359,7 +2351,7 @@ end;
{ TCustomSet<T> } { TCustomSet<T> }
function TCustomSet<T>.DoGetEnumerator: Generics.Collections.TEnumerator<T>; function TCustomSet<T>.DoGetEnumerator: TEnumerator<T>;
begin begin
Result := GetEnumerator; Result := GetEnumerator;
end; end;
@ -3338,6 +3330,21 @@ begin
Result := TValueCollection(FValues); Result := TValueCollection(FValues);
end; end;
function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetItem(const AKey: TKey): TValue;
var
LNode: PNode;
begin
LNode := Find(AKey);
if not Assigned(LNode) then
raise EAVLTree.CreateRes(@SDictionaryKeyDoesNotExist);
result := LNode.Value;
end;
procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.SetItem(const AKey: TKey; const AValue: TValue);
begin
Find(AKey).Value := AValue;
end;
constructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Create; constructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Create;
begin begin
FComparer := TComparer<TKey>.Default; FComparer := TComparer<TKey>.Default;
@ -3402,6 +3409,15 @@ begin
Result := ANode=InternalAdd(ANode, false); Result := ANode=InternalAdd(ANode, false);
end; end;
function TCustomAVLTreeMap<TREE_CONSTRAINTS>.AddNodeArray(const AArray: TArray<PNode>): boolean;
var
LNode: PNode;
begin
result := true;
for LNode in AArray do
result := result and AddNode(LNode);
end;
function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Add(constref APair: TTreePair): PNode; function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Add(constref APair: TTreePair): PNode;
begin begin
Result := NewNode; Result := NewNode;
@ -3449,7 +3465,7 @@ begin
Result.Value := DoRemove(ANode, cnExtracted, ADispose); Result.Value := DoRemove(ANode, cnExtracted, ADispose);
end; end;
function TCustomAVLTreeMap<TREE_CONSTRAINTS>.ExtractNode(constref AKey: TKey; ADisposeNode: boolean): PNode; function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Extract(constref AKey: TKey; ADisposeNode: boolean): PNode;
begin begin
Result:=Find(AKey); Result:=Find(AKey);
if Result<>nil then if Result<>nil then
@ -3469,11 +3485,31 @@ begin
Result := ANode; Result := ANode;
end; end;
function TCustomAVLTreeMap<TREE_CONSTRAINTS>.ExtractNodeArray(const AArray: TArray<PNode>; ADispose: boolean): TArray<PNode>;
var
LNode: PNode;
begin
for LNode in AArray do
ExtractNode(LNode, ADispose);
if ADispose then
Result := nil
else
Result := AArray;
end;
procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.Delete(ANode: PNode; ADispose: boolean); procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.Delete(ANode: PNode; ADispose: boolean);
begin begin
DoRemove(ANode, cnRemoved, ADispose); DoRemove(ANode, cnRemoved, ADispose);
end; end;
procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.DeleteArray(const AArray: TArray<PNode>; ADispose: boolean);
var
LNode: PNode;
begin
for LNode in AArray do
Delete(LNode, ADispose);
end;
procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.Clear(ADisposeNodes: Boolean); procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.Clear(ADisposeNodes: Boolean);
begin begin
if (FRoot<>nil) and ADisposeNodes then if (FRoot<>nil) and ADisposeNodes then
@ -4109,6 +4145,17 @@ begin
Result := Default(T); Result := Default(T);
end; end;
function TSortedHashSet<T>.PeekPtr(constref AValue: T): PT;
var
LIndex: SizeInt;
begin
LIndex := FInternalDictionary.FindBucketIndex(@AValue);
if LIndex >= 0 then
result := FInternalDictionary.FItems[LIndex].Pair.Key
else
result := nil;
end;
procedure TSortedHashSet<T>.Clear; procedure TSortedHashSet<T>.Clear;
begin begin
FInternalDictionary.Clear; FInternalDictionary.Clear;

79
components/sparta/generics/source/generics.defaults.pas → components/sparta/generics/source/sparta_generics.defaults.pas
View File

@ -1,11 +1,11 @@
{ {
This file is part of the Free Pascal run time library. This file is part of the Free Pascal/NewPascal run time library.
Copyright (c) 2014 by Maciej Izak (hnb) Copyright (c) 2014 by Maciej Izak (hnb)
member of the Free Sparta development team (http://freesparta.com) member of the NewPascal development team (http://newpascal.org)
Copyright(c) 2004-2014 DaThoX Copyright(c) 2004-2018 DaThoX
It contains the Free Pascal generics library It contains the generics collections library
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -24,7 +24,7 @@
**********************************************************************} **********************************************************************}
unit Generics.Defaults; unit sparta_Generics.Defaults;
{$MODE DELPHI}{$H+} {$MODE DELPHI}{$H+}
{$POINTERMATH ON} {$POINTERMATH ON}
@ -39,7 +39,8 @@ unit Generics.Defaults;
interface interface
uses uses
Classes, SysUtils, Generics.Hashes, TypInfo, Variants, Math, Generics.Strings, Generics.Helpers; Classes, SysUtils, TypInfo, Variants, Math,
sparta_Generics.Hashes, sparta_Generics.Strings, sparta_Generics.Helpers;
type type
IComparer<T> = interface IComparer<T> = interface
@ -229,7 +230,7 @@ type
_Release: CodePointer; _Release: CodePointer;
Equals: CodePointer; Equals: CodePointer;
GetHashCode: CodePointer; GetHashCode: CodePointer;
__Reserved: Pointer; // initially or TExtendedEqualityComparerVMT compatibility __Reserved: CodePointer; // initially or TExtendedEqualityComparerVMT compatibility
// (important when ExtendedEqualityComparer is calling Binary method) // (important when ExtendedEqualityComparer is calling Binary method)
__ClassRef: THashFactoryClass; // hidden field in VMT. For class ref THashFactoryClass __ClassRef: THashFactoryClass; // hidden field in VMT. For class ref THashFactoryClass
end; end;
@ -512,6 +513,7 @@ type
TExtendedHashService = class(THashService) TExtendedHashService = class(THashService)
public public
class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override;
class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract; class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract;
end; end;
@ -865,7 +867,25 @@ type
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override; class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
end; end;
TmORMotHashFactory = class(THashFactory) { TGenericsHashFactory }
TGenericsHashFactory = class(THashFactory)
public
class function GetHashService: THashServiceClass; override;
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
end;
{ TxxHash32HashFactory }
TxxHash32HashFactory = class(THashFactory)
public
class function GetHashService: THashServiceClass; override;
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
end;
{ TxxHash32PascalHashFactory }
TxxHash32PascalHashFactory = class(THashFactory)
public public
class function GetHashService: THashServiceClass; override; class function GetHashService: THashServiceClass; override;
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override; class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
@ -936,7 +956,7 @@ type
class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); override; class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); override;
end; end;
TDefaultHashFactory = TmORMotHashFactory; TDefaultHashFactory = TGenericsHashFactory;
TDefaultGenericInterface = (giComparer, giEqualityComparer, giExtendedEqualityComparer); TDefaultGenericInterface = (giComparer, giEqualityComparer, giExtendedEqualityComparer);
@ -2168,6 +2188,13 @@ begin
Result.SelectorInstance := ASelectorInstance; Result.SelectorInstance := ASelectorInstance;
end; end;
{ TExtendedHashService }
class function TExtendedHashService.LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;
begin
Result := LookupExtendedEqualityComparer(ATypeInfo, ASize);
end;
{ THashService } { THashService }
class function THashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; class function THashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
@ -2796,18 +2823,44 @@ begin
Result := DelphiHashLittle(AKey, ASize, AInitVal); Result := DelphiHashLittle(AKey, ASize, AInitVal);
end; end;
{ TmORMotHashFactory } { TGenericsHashFactory }
class function TmORMotHashFactory.GetHashService: THashServiceClass; class function TGenericsHashFactory.GetHashService: THashServiceClass;
begin begin
Result := THashService<TmORMotHashFactory>; Result := THashService<TGenericsHashFactory>;
end; end;
class function TmORMotHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32; class function TGenericsHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
begin begin
Result := mORMotHasher(AInitVal, AKey, ASize); Result := mORMotHasher(AInitVal, AKey, ASize);
end; end;
{ TxxHash32HashFactory }
class function TxxHash32HashFactory.GetHashService: THashServiceClass;
begin
Result := THashService<TxxHash32HashFactory>;
end;
class function TxxHash32HashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt;
AInitVal: UInt32): UInt32;
begin
Result := xxHash32(AInitVal, AKey, ASize);
end;
{ TxxHash32PascalHashFactory }
class function TxxHash32PascalHashFactory.GetHashService: THashServiceClass;
begin
Result := THashService<TxxHash32PascalHashFactory>;
end;
class function TxxHash32PascalHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt;
AInitVal: UInt32): UInt32;
begin
Result := xxHash32Pascal(AInitVal, AKey, ASize);
end;
{ TAdler32HashFactory } { TAdler32HashFactory }
class function TAdler32HashFactory.GetHashService: THashServiceClass; class function TAdler32HashFactory.GetHashService: THashServiceClass;

92
components/sparta/generics/source/generics.hashes.pas → components/sparta/generics/source/sparta_generics.hashes.pas
View File

@ -1,11 +1,11 @@
{ {
This file is part of the Free Pascal run time library. This file is part of the Free Pascal/NewPascal run time library.
Copyright (c) 2014 by Maciej Izak (hnb) Copyright (c) 2014 by Maciej Izak (hnb)
member of the Free Sparta development team (http://freesparta.com) member of the NewPascal development team (http://newpascal.org)
Copyright(c) 2004-2014 DaThoX Copyright(c) 2004-2018 DaThoX
It contains the Free Pascal generics library It contains the generics collections library
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -24,7 +24,7 @@
**********************************************************************} **********************************************************************}
unit Generics.Hashes; unit sparta_Generics.Hashes;
{$MODE DELPHI}{$H+} {$MODE DELPHI}{$H+}
{$POINTERMATH ON} {$POINTERMATH ON}
@ -38,6 +38,44 @@ interface
uses uses
Classes, SysUtils; Classes, SysUtils;
{ Warning: the following set of macro code
that decides to use assembler or normal code
needs to stay after the _INTERFACE keyword
because FPC_PIC macro is only set after this keyword,
as it can be modified before by the global $PIC preprocessor directive.
Pierre Muller 2018/07/04 }
{$ifdef FPC_PIC}
{$define DISABLE_X86_CPUINTEL}
{$endif FPC_PIC}
{$if defined(OPENBSD) or defined(EMX) or defined(OS2)}
{ These targets have old GNU assemblers that }
{ do not support all instructions used in assembler code below }
{$define DISABLE_X86_CPUINTEL}
{$endif}
{$ifdef CPU64}
{$define PUREPASCAL}
{$ifdef CPUX64}
{$define CPUINTEL}
{$ASMMODE INTEL}
{$endif CPUX64}
{$else}
{$ifdef CPUX86}
{$ifndef DISABLE_X86_CPUINTEL}
{$define CPUINTEL}
{$ASMMODE INTEL}
{$else}
{ Assembler code uses references to static
variables with are not PIC ready }
{$define PUREPASCAL}
{$endif}
{$else CPUX86}
{$define PUREPASCAL}
{$endif}
{$endif CPU64}
// Original version of Bob Jenkins Hash // Original version of Bob Jenkins Hash
// http://burtleburtle.net/bob/c/lookup3.c // http://burtleburtle.net/bob/c/lookup3.c
function HashWord( function HashWord(
@ -72,7 +110,9 @@ function SimpleChecksumHash(AKey: Pointer; ALength: SizeInt): UInt32;
// https://code.google.com/p/hedgewars/source/browse/hedgewars/adler32.pas // https://code.google.com/p/hedgewars/source/browse/hedgewars/adler32.pas
function Adler32(AKey: Pointer; ALength: SizeInt): UInt32; function Adler32(AKey: Pointer; ALength: SizeInt): UInt32;
function sdbm(AKey: Pointer; ALength: SizeInt): UInt32; function sdbm(AKey: Pointer; ALength: SizeInt): UInt32;
function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal; function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;{$IFNDEF CPUINTEL}inline;{$ENDIF}
// pure pascal implementation of xxHash32
function xxHash32Pascal(crc: cardinal; P: Pointer; len: integer): cardinal;
type type
THasher = function(crc: cardinal; buf: Pointer; len: cardinal): cardinal; THasher = function(crc: cardinal; buf: Pointer; len: cardinal): cardinal;
@ -927,27 +967,6 @@ begin
Result := Int32(c); Result := Int32(c);
end; end;
{$ifdef CPU64}
{$define PUREPASCAL}
{$ifdef CPUX64}
{$define CPUINTEL}
{$ASMMODE INTEL}
{$endif CPUX64}
{$else}
{$ifdef CPUX86}
{$ifndef FPC_PIC}
{$define CPUINTEL}
{$ASMMODE INTEL}
{$else}
{ Assembler code uses references to static
variables with are not PIC ready }
{$define PUREPASCAL}
{$endif}
{$else CPUX86}
{$define PUREPASCAL}
{$endif}
{$endif CPU64}
{$ifdef CPUARM} // circumvent FPC issue on ARM {$ifdef CPUARM} // circumvent FPC issue on ARM
function ToByte(value: cardinal): cardinal; inline; function ToByte(value: cardinal): cardinal; inline;
begin begin
@ -1156,8 +1175,13 @@ asm
{$endif} {$endif}
end; end;
{$endif CPUX64} {$endif CPUX64}
{$else not CPUINTEL} {$else not CPUINTEL}
function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;
begin
result := xxHash32Pascal(crc, P, len);
end;
{$endif CPUINTEL}
const const
PRIME32_1 = 2654435761; PRIME32_1 = 2654435761;
PRIME32_2 = 2246822519; PRIME32_2 = 2246822519;
@ -1171,7 +1195,7 @@ begin
result := RolDWord(value, 13); result := RolDWord(value, 13);
end; end;
function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal; function xxHash32Pascal(crc: cardinal; P: Pointer; len: integer): cardinal;
var c1, c2, c3, c4: cardinal; var c1, c2, c3, c4: cardinal;
PLimit, PEnd: PAnsiChar; PLimit, PEnd: PAnsiChar;
begin begin
@ -1193,7 +1217,12 @@ begin
end else end else
result := crc + PRIME32_5; result := crc + PRIME32_5;
inc(result, len); inc(result, len);
while P <= PEnd - 4 do begin { Use "P + 4 <= PEnd" instead of "P <= PEnd - 4" to avoid crashes in case P = nil.
When P = nil,
then "PtrUInt(PEnd - 4)" is 4294967292,
so the condition "P <= PEnd - 4" would be satisfied,
and the code would try to access PCardinal(nil)^ causing a SEGFAULT. }
while P + 4 <= PEnd do begin
inc(result, PCardinal(P)^ * PRIME32_3); inc(result, PCardinal(P)^ * PRIME32_3);
result := RolDWord(result, 17) * PRIME32_4; result := RolDWord(result, 17) * PRIME32_4;
inc(P, 4); inc(P, 4);
@ -1209,7 +1238,6 @@ begin
result := result * PRIME32_3; result := result * PRIME32_3;
result := result xor (result shr 16); result := result xor (result shr 16);
end; end;
{$endif CPUINTEL}
{$ifdef CPUINTEL} {$ifdef CPUINTEL}
@ -1583,7 +1611,7 @@ begin
begin begin
InitializeCrc32ctab; InitializeCrc32ctab;
crc32c := @crc32cfast; crc32c := @crc32cfast;
mORMotHasher := @xxHash32; mORMotHasher := @{$IFDEF CPUINTEL}xxHash32{$ELSE}xxHash32Pascal{$ENDIF};
end; end;
end. end.

10
components/sparta/generics/source/generics.helpers.pas → components/sparta/generics/source/sparta_generics.helpers.pas
View File

@ -1,11 +1,11 @@
{ {
This file is part of the Free Pascal run time library. This file is part of the Free Pascal/NewPascal run time library.
Copyright (c) 2014 by Maciej Izak (hnb) Copyright (c) 2014 by Maciej Izak (hnb)
member of the Free Sparta development team (http://freesparta.com) member of the NewPascal development team (http://newpascal.org)
Copyright(c) 2004-2014 DaThoX Copyright(c) 2004-2018 DaThoX
It contains the Free Pascal generics library It contains the generics collections library
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -16,7 +16,7 @@
**********************************************************************} **********************************************************************}
unit Generics.Helpers; unit sparta_Generics.Helpers;
{$MODE DELPHI}{$H+} {$MODE DELPHI}{$H+}
{$MODESWITCH TYPEHELPERS} {$MODESWITCH TYPEHELPERS}

10
components/sparta/generics/source/generics.memoryexpanders.pas → components/sparta/generics/source/sparta_generics.memoryexpanders.pas
View File

@ -1,11 +1,11 @@
{ {
This file is part of the Free Pascal run time library. This file is part of the Free Pascal/NewPascal run time library.
Copyright (c) 2014 by Maciej Izak (hnb) Copyright (c) 2014 by Maciej Izak (hnb)
member of the Free Sparta development team (http://freesparta.com) member of the NewPascal development team (http://newpascal.org)
Copyright(c) 2004-2014 DaThoX Copyright(c) 2004-2018 DaThoX
It contains the Free Pascal generics library It contains the generics collections library
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -16,7 +16,7 @@
**********************************************************************} **********************************************************************}
unit Generics.MemoryExpanders; unit sparta_Generics.MemoryExpanders;
// Memory expanders // Memory expanders
{$mode delphi} {$mode delphi}

10
components/sparta/generics/source/generics.strings.pas → components/sparta/generics/source/sparta_generics.strings.pas
View File

@ -1,11 +1,11 @@
{ {
This file is part of the Free Pascal run time library. This file is part of the Free Pascal/NewPascal run time library.
Copyright (c) 2014 by Maciej Izak (hnb) Copyright (c) 2014 by Maciej Izak (hnb)
member of the Free Sparta development team (http://freesparta.com) member of the NewPascal development team (http://newpascal.org)
Copyright(c) 2004-2014 DaThoX Copyright(c) 2004-2018 DaThoX
It contains the Free Pascal generics library It contains the generics collections library
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -16,7 +16,7 @@
**********************************************************************} **********************************************************************}
unit Generics.Strings; unit sparta_Generics.Strings;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}

12
components/sparta/generics/sparta_generics.lpk
View File

@ -14,27 +14,27 @@
</CompilerOptions> </CompilerOptions>
<Files Count="8"> <Files Count="8">
<Item1> <Item1>
<Filename Value="source\generics.collections.pas"/> <Filename Value="source\sparta_generics.collections.pas"/>
<UnitName Value="Generics.Collections"/> <UnitName Value="Generics.Collections"/>
</Item1> </Item1>
<Item2> <Item2>
<Filename Value="source\generics.defaults.pas"/> <Filename Value="source\sparta_generics.defaults.pas"/>
<UnitName Value="Generics.Defaults"/> <UnitName Value="Generics.Defaults"/>
</Item2> </Item2>
<Item3> <Item3>
<Filename Value="source\generics.hashes.pas"/> <Filename Value="source\sparta_generics.hashes.pas"/>
<UnitName Value="Generics.Hashes"/> <UnitName Value="Generics.Hashes"/>
</Item3> </Item3>
<Item4> <Item4>
<Filename Value="source\generics.helpers.pas"/> <Filename Value="source\sparta_generics.helpers.pas"/>
<UnitName Value="Generics.Helpers"/> <UnitName Value="Generics.Helpers"/>
</Item4> </Item4>
<Item5> <Item5>
<Filename Value="source\generics.memoryexpanders.pas"/> <Filename Value="source\sparta_generics.memoryexpanders.pas"/>
<UnitName Value="Generics.MemoryExpanders"/> <UnitName Value="Generics.MemoryExpanders"/>
</Item5> </Item5>
<Item6> <Item6>
<Filename Value="source\generics.strings.pas"/> <Filename Value="source\sparta_generics.strings.pas"/>
<UnitName Value="Generics.Strings"/> <UnitName Value="Generics.Strings"/>
</Item6> </Item6>
<Item7> <Item7>

6
components/sparta/generics/sparta_generics.pas
View File

@ -4,11 +4,13 @@
unit sparta_Generics; unit sparta_Generics;
{$warn 5023 off : no warning about unused units}
interface interface
uses uses
Generics.Collections, Generics.Defaults, Generics.Hashes, Generics.Helpers, sparta_Generics.Collections, sparta_Generics.Defaults,
Generics.MemoryExpanders, Generics.Strings; sparta_Generics.Hashes, sparta_Generics.Helpers,
sparta_Generics.MemoryExpanders, sparta_Generics.Strings;
implementation implementation

4
components/sparta/mdi/source/sparta_abstractresizer.pas
View File

@ -5,8 +5,8 @@ unit sparta_AbstractResizer;
interface interface
uses uses
Classes, SysUtils, Controls, ExtCtrls, Forms, Math, StdCtrls, Buttons, Dialogs, Classes, SysUtils, Math,
LCLType, LCLType, Controls, ExtCtrls, Forms, StdCtrls, Buttons, Dialogs,
sparta_InterfacesMDI, sparta_BasicResizeFrame, sparta_MDI_StrConsts; sparta_InterfacesMDI, sparta_BasicResizeFrame, sparta_MDI_StrConsts;
type type

5
components/sparta/mdi/source/sparta_basicfakecustom.pas
View File

@ -5,8 +5,9 @@ unit sparta_BasicFakeCustom;
interface interface
uses uses
Classes, SysUtils, Controls, Forms, sparta_InterfacesMDI, LCLIntf, Classes, SysUtils,
LCLType, sparta_FormBackgroundForMDI; LCLType, LCLIntf, Controls, Forms,
sparta_InterfacesMDI, sparta_FormBackgroundForMDI;
type type

6
components/sparta/mdi/source/sparta_basicresizeframe.pas
View File

@ -5,8 +5,10 @@ unit sparta_BasicResizeFrame;
interface interface
uses uses
Classes, contnrs, SysUtils, FileUtil, Forms, Controls, ExtCtrls, StdCtrls, Classes, Types, contnrs, SysUtils, Math,
Graphics, LCLType, lclintf, Menus, LMessages, Math, Types, sparta_InterfacesMDI; FileUtil,
LCLType, LCLIntf, LMessages, Forms, Controls, ExtCtrls, StdCtrls, Graphics, Menus,
sparta_InterfacesMDI;
type type
TPositioningCode = (pcPositioning, pcPositioningEnd); TPositioningCode = (pcPositioning, pcPositioningEnd);

6
components/sparta/mdi/source/sparta_basicresizer.pas
View File

@ -5,9 +5,9 @@ unit sparta_BasicResizer;
interface interface
uses uses
Classes, SysUtils, Controls, ExtCtrls, sparta_BasicResizeFrame, Forms, StdCtrls, Classes, SysUtils,
LCLType, Buttons, Dialogs, LCLType, Controls, ExtCtrls, Forms, StdCtrls, Buttons, Dialogs,
sparta_InterfacesMDI, sparta_AbstractResizer; sparta_BasicResizeFrame, sparta_InterfacesMDI, sparta_AbstractResizer;
type type

9
components/sparta/mdi/source/sparta_multiplyresizer.pas
View File

@ -5,8 +5,13 @@ unit sparta_MultiplyResizer;
interface interface
uses uses
Forms, Classes, SysUtils, Controls, Generics.Collections, LMessages, Classes, SysUtils,
Forms, Controls, LMessages,
{$IF FPC_FULLVERSION>=30200}
Generics.Collections,
{$ELSE}
sparta_Generics.Collections,
{$ENDIF}
sparta_AbstractResizer, sparta_InterfacesMDI, sparta_BasicResizeFrame; sparta_AbstractResizer, sparta_InterfacesMDI, sparta_BasicResizeFrame;
type type

50
components/sparta/smartformeditor/source/sparta_componentpalette.pas
View File

@ -19,10 +19,10 @@ interface
uses uses
Forms, Classes, SysUtils, Controls, ComCtrls, ComponentReg, ExtCtrls, Buttons, Forms, Classes, SysUtils, Controls, ComCtrls, ComponentReg, ExtCtrls, Buttons,
Math, LazIDEIntf, PropEdits, LResources, LCLType, Graphics, Math, LazIDEIntf, PropEdits, LResources, LCLType, Graphics,
{$IFDEF USE_GENERICS_COLLECTIONS} {$IF FPC_FULLVERSION>=30200}
Generics.Collections, Generics.Collections,
{$ELSE} {$ELSE}
ghashmap, sparta_HashUtils, sparta_Generics.Collections,
{$ENDIF} {$ENDIF}
FormEditingIntf, IDEImagesIntf; FormEditingIntf, IDEImagesIntf;
@ -43,14 +43,9 @@ type
TComponentsPalette = class(TComponent) TComponentsPalette = class(TComponent)
private private
pcComponents: TPageControl; pcComponents: TPageControl;
FFilter: string; FFilter: string;
FRoot: TPersistent; FRoot: TPersistent;
{$IFDEF USE_GENERICS_COLLECTIONS}
FPages: TDictionary<TTabSheet, TPageData>; FPages: TDictionary<TTabSheet, TPageData>;
{$ELSE}
FPages: THashmap<TTabSheet, TPageData, THash_TObject>;
{$ENDIF}
FLastForm: TCustomForm; FLastForm: TCustomForm;
FIgnoreRoot: Boolean; FIgnoreRoot: Boolean;
@ -228,11 +223,7 @@ var
i, j: Integer; i, j: Integer;
LCtrl: TControl; LCtrl: TControl;
LPComponents: TPanel; LPComponents: TPanel;
{$IFDEF USE_GENERICS_COLLECTIONS}
LButtons: TList<TControl>; LButtons: TList<TControl>;
{$ELSE}
LButtons: TList;
{$ENDIF}
LVisibleButtons: Integer; LVisibleButtons: Integer;
LCompName: string; LCompName: string;
LSearchResult: TTabSheet; LSearchResult: TTabSheet;
@ -280,11 +271,7 @@ begin
// use filter ! // use filter !
else else
begin begin
{$IFDEF USE_GENERICS_COLLECTIONS}
LButtons := TList<TControl>.Create; LButtons := TList<TControl>.Create;
{$ELSE}
LButtons := TList.Create;
{$ENDIF}
for i := 1 to pcComponents.PageCount - 1 do for i := 1 to pcComponents.PageCount - 1 do
begin begin
LPComponents := FPages[pcComponents.Pages[i]].FComponents; LPComponents := FPages[pcComponents.Pages[i]].FComponents;
@ -341,11 +328,7 @@ var
LUpDown: TUpDown; LUpDown: TUpDown;
LLines: Integer; LLines: Integer;
begin begin
{$IFDEF USE_GENERICS_COLLECTIONS}
if (pcComponents.ActivePage = nil) or (not FPages.ContainsKey(pcComponents.ActivePage)) then if (pcComponents.ActivePage = nil) or (not FPages.ContainsKey(pcComponents.ActivePage)) then
{$ELSE}
if (pcComponents.ActivePage = nil) or (not FPages.contains(pcComponents.ActivePage)) then
{$ENDIF}
Exit; Exit;
LPComponents := FPages[pcComponents.ActivePage].FComponents; LPComponents := FPages[pcComponents.ActivePage].FComponents;
@ -417,11 +400,7 @@ begin
IDEComponentPalette.AddHandlerComponentAdded(ComponentAdded); IDEComponentPalette.AddHandlerComponentAdded(ComponentAdded);
GlobalDesignHook.AddHandlerSetSelection(OnDesignSetSelection); GlobalDesignHook.AddHandlerSetSelection(OnDesignSetSelection);
{$IFDEF USE_GENERICS_COLLECTIONS}
FPages := TDictionary<TTabSheet, TPageData>.Create; FPages := TDictionary<TTabSheet, TPageData>.Create;
{$ELSE}
FPages := THashmap<TTabSheet, TPageData, THash_TObject>.Create;
{$ENDIF}
pcComponents := TPageControl.Create(AOwner); pcComponents := TPageControl.Create(AOwner);
pcComponents.Parent := AParent; pcComponents.Parent := AParent;
@ -566,19 +545,10 @@ procedure TComponentsPalette.UpdateComponentsList;
LPComponents.Top := 0; LPComponents.Top := 0;
LPComponents.AnchorSideBottom.Control := LPage; LPComponents.AnchorSideBottom.Control := LPage;
LPComponents.AnchorSideBottom.Side := asrBottom; LPComponents.AnchorSideBottom.Side := asrBottom;
LPComponents.ChildSizing.Layout := cclLeftToRightThenTopToBottom; LPComponents.ChildSizing.Layout := cclLeftToRightThenTopToBottom;
LPComponents.BevelOuter := bvNone; LPComponents.BevelOuter := bvNone;
LUpDown.Visible := False; LUpDown.Visible := False;
{$IFDEF USE_GENERICS_COLLECTIONS}
FPages.Add(LPage, TPageData.Create(LUpDown, LPComponents, LButton)); FPages.Add(LPage, TPageData.Create(LUpDown, LPComponents, LButton));
{$ELSE}
FPages.insert(LPage, TPageData.Create(LUpDown, LPComponents, LButton));
{$ENDIF}
// not each page has components - for example: searching result // not each page has components - for example: searching result
if (APage = nil) or (not APage.Visible) then if (APage = nil) or (not APage.Visible) then
@ -598,7 +568,6 @@ procedure TComponentsPalette.UpdateComponentsList;
LIcon.Free; LIcon.Free;
Hint := Format('%s' + sLineBreak + '(%s)', [LClass.ClassName, LClass.UnitName]); Hint := Format('%s' + sLineBreak + '(%s)', [LClass.ClassName, LClass.UnitName]);
ShowHint := True; ShowHint := True;
Flat := True; Flat := True;
GroupIndex := 1; GroupIndex := 1;
@ -622,42 +591,29 @@ var
begin begin
if FRoot = nil then if FRoot = nil then
Exit; Exit;
{$IFDEF USE_GENERICS_COLLECTIONS}
FPages.Clear; FPages.Clear;
{$ELSE}
FPages.Free;
FPages := THashmap<TTabSheet, TPageData, THash_TObject>.Create;
{$ENDIF}
if Assigned(IDEComponentPalette) then if Assigned(IDEComponentPalette) then
begin begin
for i := pcComponents.PageCount - 1 downto 0 do for i := pcComponents.PageCount - 1 downto 0 do
pcComponents.Pages[i].Free; pcComponents.Pages[i].Free;
CreatePage('Search result', nil); CreatePage('Search result', nil);
for i := 0 to IDEComponentPalette.Pages.Count-1 do for i := 0 to IDEComponentPalette.Pages.Count-1 do
begin begin
LPage := IDEComponentPalette.Pages[i]; LPage := IDEComponentPalette.Pages[i];
if not LPage.Visible then if not LPage.Visible then
Continue; Continue;
CreatePage(LPage.PageName, LPage); CreatePage(LPage.PageName, LPage);
end; end;
end; end;
pcComponentsResize(nil); pcComponentsResize(nil);
RefreshSearchResult; RefreshSearchResult;
end; end;
procedure TComponentsPalette.OnDesignSetSelection( procedure TComponentsPalette.OnDesignSetSelection(const ASelection: TPersistentSelectionList);
const ASelection: TPersistentSelectionList);
begin begin
// to replace original components palette // to replace original components palette
if not FIgnoreRoot or (csDestroying in ComponentState) then if not FIgnoreRoot or (csDestroying in ComponentState) then
Exit; Exit;
Root := GlobalDesignHook.LookupRoot; Root := GlobalDesignHook.LookupRoot;
end; end;

11
components/sparta/toolsapi/source/designeditors.pas
View File

@ -5,8 +5,15 @@ unit DesignEditors;
interface interface
uses uses
Classes, SysUtils, ComponentEditors, PropEdits, DesignIntf, DesignMenus, Generics.Defaults, Classes, SysUtils, TypInfo, IniFiles,
TypInfo, IniFiles, Menus; Menus,
ComponentEditors, PropEdits,
{$IF FPC_FULLVERSION>=30200}
Generics.Defaults,
{$ELSE}
sparta_Generics.Defaults,
{$ENDIF}
DesignIntf, DesignMenus;
type type