paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-02 14:32:36 +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_fakeframe.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_reg_dockedformeditor.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.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.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.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
Classes, SysUtils,
{$IFDEF USE_GENERICS_COLLECTIONS}
Generics.Defaults,
{$ENDIF}
// LCL
Forms, Controls,
// IdeIntf
@ -178,8 +175,7 @@ type
{ TDesignedNonControlFormImpl }
function TDesignedNonControlFormImpl.GetPublishedBounds(AIndex: Integer
): Integer;
function TDesignedNonControlFormImpl.GetPublishedBounds(AIndex: Integer): Integer;
var
LBounds, LClientRect: TRect;
LMediator: TDesignerMediator;
@ -487,8 +483,7 @@ begin
Result := True;
end;
procedure TFakeCustomNonControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer
);
procedure TFakeCustomNonControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
begin
SetDesignerFormBounds(ALeft, ATop, AWidth, AHeight);
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.

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

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

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

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

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

@ -10,8 +10,8 @@ interface
uses
sparta_reg_DockedFormEditor, sparta_DesignedForm, sparta_Resizer,
sparta_ResizerFrame, SpartaAPI, sparta_FakeCustom, sparta_FakeForm,
sparta_FakeFrame, sparta_FakeNonControl, sparta_MainIDE, sparta_HashUtils,
sparta_strconsts, LazarusPackageIntf;
sparta_FakeFrame, sparta_FakeNonControl, sparta_MainIDE, sparta_strconsts,
LazarusPackageIntf;
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)
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,
for details about the copyright.
@ -24,7 +24,7 @@
**********************************************************************}
unit Generics.Collections;
unit sparta_Generics.Collections;
{$MODE DELPHI}{$H+}
{$MACRO ON}
@ -41,27 +41,9 @@ unit Generics.Collections;
interface
uses
RtlConsts, Classes, SysUtils, Generics.MemoryExpanders, Generics.Defaults,
Generics.Helpers, 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
}
RtlConsts, Classes, SysUtils,
sparta_Generics.MemoryExpanders, sparta_Generics.Defaults,
sparta_Generics.Helpers, sparta_Generics.Strings;
{.$define EXTRA_WARNINGS}
{.$define ENABLE_METHODS_WITH_TEnumerableWithPointers}
@ -698,7 +680,10 @@ type
procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); inline;
procedure NodeNotify(ANode: PNode; ACollectionNotification: TCollectionNotification; ADispose: boolean); inline;
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
procedure WriteStr(AStream: TStream; const AText: string);
public type
@ -761,14 +746,17 @@ type
destructor Destroy; override;
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 AKey: TKey; constref AValue: TValue): PNode; overload; inline;
function Remove(constref AKey: TKey; ADisposeNode: boolean = true): boolean;
function ExtractPair(constref AKey: TKey; ADisposeNode: boolean = true): TTreePair; overload;
function ExtractPair(constref ANode: PNode; ADispose: boolean = true): TTreePair; overload;
function ExtractNode(constref AKey: TKey; ADisposeNode: boolean): PNode; overload;
function ExtractNode(ANode: PNode; ADispose: boolean): PNode; overload;
function Extract(constref AKey: TKey; ADisposeNode: boolean): PNode;
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 DeleteArray(const AArray: TArray<PNode>; ADispose: boolean = true); inline;
function GetEnumerator: TPairEnumerator;
property Nodes: TNodeCollection read GetNodeCollection;
@ -801,6 +789,8 @@ type
end;
TAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, TEmptyRecord>)
public
property Items; default;
end;
TIndexedAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, SizeInt>)
@ -827,6 +817,7 @@ type
protected
property OnKeyNotify;
property OnValueNotify;
property Items;
public type
TItemEnumerator = TKeyEnumerator;
public
@ -947,6 +938,7 @@ type
function Add(constref AValue: T): Boolean; override;
function Remove(constref AValue: T): Boolean; override;
function Extract(constref AValue: T): T; override;
function PeekPtr(constref AValue: T): PT;
procedure Clear; override;
function Contains(constref AValue: T): Boolean; override;
@ -2359,7 +2351,7 @@ end;
{ TCustomSet<T> }
function TCustomSet<T>.DoGetEnumerator: Generics.Collections.TEnumerator<T>;
function TCustomSet<T>.DoGetEnumerator: TEnumerator<T>;
begin
Result := GetEnumerator;
end;
@ -3338,6 +3330,21 @@ begin
Result := TValueCollection(FValues);
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;
begin
FComparer := TComparer<TKey>.Default;
@ -3402,6 +3409,15 @@ begin
Result := ANode=InternalAdd(ANode, false);
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;
begin
Result := NewNode;
@ -3449,7 +3465,7 @@ begin
Result.Value := DoRemove(ANode, cnExtracted, ADispose);
end;
function TCustomAVLTreeMap<TREE_CONSTRAINTS>.ExtractNode(constref AKey: TKey; ADisposeNode: boolean): PNode;
function TCustomAVLTreeMap<TREE_CONSTRAINTS>.Extract(constref AKey: TKey; ADisposeNode: boolean): PNode;
begin
Result:=Find(AKey);
if Result<>nil then
@ -3469,11 +3485,31 @@ begin
Result := ANode;
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);
begin
DoRemove(ANode, cnRemoved, ADispose);
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);
begin
if (FRoot<>nil) and ADisposeNodes then
@ -4109,6 +4145,17 @@ begin
Result := Default(T);
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;
begin
FInternalDictionary.Clear;

81
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)
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,
for details about the copyright.
@ -24,7 +24,7 @@
**********************************************************************}
unit Generics.Defaults;
unit sparta_Generics.Defaults;
{$MODE DELPHI}{$H+}
{$POINTERMATH ON}
@ -39,7 +39,8 @@ unit Generics.Defaults;
interface
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
IComparer<T> = interface
@ -229,8 +230,8 @@ type
_Release: CodePointer;
Equals: CodePointer;
GetHashCode: CodePointer;
__Reserved: Pointer; // initially or TExtendedEqualityComparerVMT compatibility
// (important when ExtendedEqualityComparer is calling Binary method)
__Reserved: CodePointer; // initially or TExtendedEqualityComparerVMT compatibility
// (important when ExtendedEqualityComparer is calling Binary method)
__ClassRef: THashFactoryClass; // hidden field in VMT. For class ref THashFactoryClass
end;
@ -512,6 +513,7 @@ type
TExtendedHashService = class(THashService)
public
class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override;
class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract;
end;
@ -865,7 +867,25 @@ type
class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
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
class function GetHashService: THashServiceClass; 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;
end;
TDefaultHashFactory = TmORMotHashFactory;
TDefaultHashFactory = TGenericsHashFactory;
TDefaultGenericInterface = (giComparer, giEqualityComparer, giExtendedEqualityComparer);
@ -2168,6 +2188,13 @@ begin
Result.SelectorInstance := ASelectorInstance;
end;
{ TExtendedHashService }
class function TExtendedHashService.LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;
begin
Result := LookupExtendedEqualityComparer(ATypeInfo, ASize);
end;
{ THashService }
class function THashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer;
@ -2796,18 +2823,44 @@ begin
Result := DelphiHashLittle(AKey, ASize, AInitVal);
end;
{ TmORMotHashFactory }
{ TGenericsHashFactory }
class function TmORMotHashFactory.GetHashService: THashServiceClass;
class function TGenericsHashFactory.GetHashService: THashServiceClass;
begin
Result := THashService<TmORMotHashFactory>;
Result := THashService<TGenericsHashFactory>;
end;
class function TmORMotHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
class function TGenericsHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
begin
Result := mORMotHasher(AInitVal, AKey, ASize);
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 }
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)
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,
for details about the copyright.
@ -24,7 +24,7 @@
**********************************************************************}
unit Generics.Hashes;
unit sparta_Generics.Hashes;
{$MODE DELPHI}{$H+}
{$POINTERMATH ON}
@ -38,6 +38,44 @@ interface
uses
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
// http://burtleburtle.net/bob/c/lookup3.c
function HashWord(
@ -72,7 +110,9 @@ function SimpleChecksumHash(AKey: Pointer; ALength: SizeInt): UInt32;
// https://code.google.com/p/hedgewars/source/browse/hedgewars/adler32.pas
function Adler32(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
THasher = function(crc: cardinal; buf: Pointer; len: cardinal): cardinal;
@ -927,27 +967,6 @@ begin
Result := Int32(c);
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
function ToByte(value: cardinal): cardinal; inline;
begin
@ -1156,8 +1175,13 @@ asm
{$endif}
end;
{$endif CPUX64}
{$else not CPUINTEL}
function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;
begin
result := xxHash32Pascal(crc, P, len);
end;
{$endif CPUINTEL}
const
PRIME32_1 = 2654435761;
PRIME32_2 = 2246822519;
@ -1171,7 +1195,7 @@ begin
result := RolDWord(value, 13);
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;
PLimit, PEnd: PAnsiChar;
begin
@ -1193,7 +1217,12 @@ begin
end else
result := crc + PRIME32_5;
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);
result := RolDWord(result, 17) * PRIME32_4;
inc(P, 4);
@ -1209,7 +1238,6 @@ begin
result := result * PRIME32_3;
result := result xor (result shr 16);
end;
{$endif CPUINTEL}
{$ifdef CPUINTEL}
@ -1583,7 +1611,7 @@ begin
begin
InitializeCrc32ctab;
crc32c := @crc32cfast;
mORMotHasher := @xxHash32;
mORMotHasher := @{$IFDEF CPUINTEL}xxHash32{$ELSE}xxHash32Pascal{$ENDIF};
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)
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,
for details about the copyright.
@ -16,7 +16,7 @@
**********************************************************************}
unit Generics.Helpers;
unit sparta_Generics.Helpers;
{$MODE DELPHI}{$H+}
{$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)
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,
for details about the copyright.
@ -16,7 +16,7 @@
**********************************************************************}
unit Generics.MemoryExpanders;
unit sparta_Generics.MemoryExpanders;
// Memory expanders
{$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)
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,
for details about the copyright.
@ -16,7 +16,7 @@
**********************************************************************}
unit Generics.Strings;
unit sparta_Generics.Strings;
{$mode objfpc}{$H+}

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -5,8 +5,13 @@ unit sparta_MultiplyResizer;
interface
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;
type

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

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

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

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