← Back to branch summary

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

« back to all changes in this revision

Viewing changes to components/codetools/codetoolsstructs.pas

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

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/codetools/codetoolsstructs.pas
24
24
    Most codetools returns simple values like a single code position or a
25
25
    string. But some creates lists of data.
26
26
    This unit provides structures for complex results.
27
 
  
28
 
    TCodeXYPositions - a list of PCodeXYPosition
29
 
 
30
27
}
31
28
unit CodeToolsStructs;
32
29
 
35
32
interface
36
33
 
37
34
uses
38
 
  Classes, SysUtils, FileProcs, AVL_Tree, CodeCache, CodeAtom;
 
35
  Classes, SysUtils, FileProcs, AVL_Tree, BasicCodeTools;
39
36
  
40
37
type
41
38
  TResourcestringInsertPolicy = (
56
53
const
57
54
  AllPascalClassSections = [low(TPascalClassSection)..high(TPascalClassSection)];
58
55
  
59
 
type
60
 
 
61
 
  { TCodeXYPositions - a list of PCodeXYPosition }
62
 
 
63
 
  TCodeXYPositions = class
64
 
  private
65
 
    FItems: TFPList; // list of PCodeXYPosition, can be nil
66
 
    function GetCaretsXY(Index: integer): TPoint;
67
 
    function GetCodes(Index: integer): TCodeBuffer;
68
 
    function GetItems(Index: integer): PCodeXYPosition;
69
 
    procedure SetCaretsXY(Index: integer; const AValue: TPoint);
70
 
    procedure SetCodes(Index: integer; const AValue: TCodeBuffer);
71
 
    procedure SetItems(Index: integer; const AValue: PCodeXYPosition);
72
 
  public
73
 
    constructor Create;
74
 
    destructor Destroy; override;
75
 
    procedure Clear;
76
 
    function Add(const Position: TCodeXYPosition): integer;
77
 
    function Add(X,Y: integer; Code: TCodeBuffer): integer;
78
 
    procedure Assign(Source: TCodeXYPositions);
79
 
    function IsEqual(Source: TCodeXYPositions): boolean;
80
 
    function Count: integer;
81
 
    procedure Delete(Index: integer);
82
 
    function CreateCopy: TCodeXYPositions;
83
 
    function CalcMemSize: PtrUint;
84
 
  public
85
 
    property Items[Index: integer]: PCodeXYPosition
86
 
                                          read GetItems write SetItems; default;
87
 
    property CaretsXY[Index: integer]: TPoint read GetCaretsXY write SetCaretsXY;
88
 
    property Codes[Index: integer]: TCodeBuffer read GetCodes write SetCodes;
89
 
  end;
90
 
  
91
56
const
92
57
  PascalClassSectionKeywords: array[TPascalClassSection] of string = (
93
58
    'private',
96
61
    'published'
97
62
    );
98
63
 
99
 
 
100
64
type
101
 
  TStringToStringTreeItem = record
 
65
 
 
66
  { TMTAVLTreeNodeMemManager }
 
67
 
 
68
  TMTAVLTreeNodeMemManager = class(TAVLTreeNodeMemManager)
 
69
  public
 
70
    procedure DisposeNode(ANode: TAVLTreeNode); override;
 
71
    function NewNode: TAVLTreeNode; override;
 
72
  end;
 
73
 
 
74
  { TMTAVLTree - TAVLTree with a multithreaded node manager }
 
75
 
 
76
  TMTAVLTree = class(TAVLTree)
 
77
  protected
 
78
    fNodeManager: TAVLTreeNodeMemManager;
 
79
  public
 
80
    constructor Create(OnCompareMethod: TListSortCompare);
 
81
    destructor Destroy; override;
 
82
  end;
 
83
 
 
84
  TStringMap = class;
 
85
 
 
86
  TStringMapItem = record
102
87
    Name: string;
103
 
    Value: string;
104
 
  end;
105
 
  PStringToStringTreeItem = ^TStringToStringTreeItem;
106
 
 
107
 
  { TStringToStringTree }
108
 
 
109
 
  TStringToStringTree = class
 
88
  end;
 
89
  PStringMapItem = ^TStringMapItem;
 
90
 
 
91
  { TStringMapEnumerator }
 
92
 
 
93
  TStringMapEnumerator = class
 
94
  protected
 
95
    FTree: TAVLTree;
 
96
    FCurrent: TAVLTreeNode;
 
97
  public
 
98
    constructor Create(Tree: TAVLTree);
 
99
    function MoveNext: boolean;
 
100
    // "Current" is implemented by the descendant classes
 
101
  end;
 
102
 
 
103
  { TStringMap }
 
104
 
 
105
  TStringMap = class
110
106
  private
111
107
    FCompareKeyItemFunc: TListSortCompare;
112
 
    FTree: TAVLTree;// tree of PStringToStringTreeItem
 
108
    FTree: TAVLTree;// tree of PStringMapItem
113
109
    FCaseSensitive: boolean;
114
110
    function GetCompareItemsFunc: TListSortCompare;
115
 
    function GetStrings(const s: string): string;
116
 
    procedure SetStrings(const s: string; const AValue: string);
117
 
    function FindNode(const s: string): TAVLTreeNode;
 
111
  protected
 
112
    procedure DisposeItem(p: PStringMapItem); virtual;
 
113
    function ItemsAreEqual(p1, p2: PStringMapItem): boolean; virtual;
 
114
    function CreateCopy(Src: PStringMapItem): PStringMapItem; virtual;
118
115
  public
119
116
    constructor Create(TheCaseSensitive: boolean);
120
117
    destructor Destroy; override;
121
 
    procedure Clear;
 
118
    procedure Clear; virtual;
122
119
    function Contains(const s: string): boolean;
123
 
    function GetString(const Name: string; out Value: string): boolean;
124
 
    procedure Add(const Name, Value: string);
 
120
    function ContainsIdentifier(P: PChar): boolean;
 
121
    function FindNodeWithIdentifierAsPrefix(P: PChar): TAVLTreeNode;
125
122
    procedure GetNames(List: TStrings);
126
 
    procedure Remove(const Name: string);
127
 
    property Strings[const s: string]: string read GetStrings write SetStrings; default;
 
123
    procedure Remove(const Name: string); virtual;
128
124
    property CaseSensitive: boolean read FCaseSensitive;
129
 
    property Tree: TAVLTree read FTree;
130
 
    function AsText: string;
131
 
    function Equals(OtherTree: TStringToStringTree): boolean; reintroduce;
132
 
    procedure Assign(Source: TStringToStringTree);
133
 
    procedure WriteDebugReport;
134
 
    function CalcMemSize: PtrUint;
 
125
    property Tree: TAVLTree read FTree; // tree of PStringMapItem
 
126
    function Count: integer;
 
127
    function FindNode(const s: string): TAVLTreeNode;
 
128
    function Equals(OtherTree: TStringMap): boolean; reintroduce;
 
129
    procedure Assign(Source: TStringMap); virtual;
 
130
    procedure WriteDebugReport; virtual;
 
131
    function CalcMemSize: PtrUint; virtual;
135
132
    property CompareItemsFunc: TListSortCompare read GetCompareItemsFunc;
136
133
    property CompareKeyItemFunc: TListSortCompare read FCompareKeyItemFunc;
137
134
    procedure SetCompareFuncs(
138
135
            const NewCompareItemsFunc, NewCompareKeyItemFunc: TListSortCompare);
139
136
  end;
140
137
 
 
138
  TStringToStringTreeItem = record
 
139
    Name: string;
 
140
    Value: string;
 
141
  end;
 
142
  PStringToStringTreeItem = ^TStringToStringTreeItem;
 
143
 
 
144
  TStringToStringTree = class;
 
145
 
 
146
  { TStringToStringTreeEnumerator }
 
147
 
 
148
  TStringToStringTreeEnumerator = class(TStringMapEnumerator)
 
149
  private
 
150
    function GetCurrent: PStringToStringTreeItem;
 
151
  public
 
152
    property Current: PStringToStringTreeItem read GetCurrent;
 
153
  end;
 
154
 
 
155
  { TStringToStringTree }
 
156
 
 
157
  TStringToStringTree = class(TStringMap)
 
158
  private
 
159
    function GetStrings(const s: string): string;
 
160
    procedure SetStrings(const s: string; const AValue: string);
 
161
  protected
 
162
    procedure DisposeItem(p: PStringMapItem); override;
 
163
    function ItemsAreEqual(p1, p2: PStringMapItem): boolean; override;
 
164
    function CreateCopy(Src: PStringMapItem): PStringMapItem; override;
 
165
  public
 
166
    function GetString(const Name: string; out Value: string): boolean;
 
167
    procedure Add(const Name, Value: string); virtual;
 
168
    property Strings[const s: string]: string read GetStrings write SetStrings; default;
 
169
    function AsText: string;
 
170
    procedure WriteDebugReport; override;
 
171
    function CalcMemSize: PtrUint; override;
 
172
    function GetEnumerator: TStringToStringTreeEnumerator;
 
173
  end;
 
174
 
 
175
  TStringToPointerTree = class;
 
176
 
 
177
  TStringToPointerTreeItem = record
 
178
    Name: string;
 
179
    Value: Pointer;
 
180
  end;
 
181
  PStringToPointerTreeItem = ^TStringToPointerTreeItem;
 
182
 
 
183
  { TStringToPointerTreeEnumerator }
 
184
 
 
185
  TStringToPointerTreeEnumerator = class(TStringMapEnumerator)
 
186
  private
 
187
    function GetCurrent: PStringToPointerTreeItem;
 
188
  public
 
189
    property Current: PStringToPointerTreeItem read GetCurrent;
 
190
  end;
 
191
 
 
192
  { TStringToPointerTree }
 
193
 
 
194
  TStringToPointerTree = class(TStringMap)
 
195
  private
 
196
    FFreeValues: boolean;
 
197
    function GetItems(const s: string): Pointer;
 
198
    procedure SetItems(const s: string; AValue: Pointer);
 
199
  protected
 
200
    procedure DisposeItem(p: PStringMapItem); override;
 
201
    function ItemsAreEqual(p1, p2: PStringMapItem): boolean; override;
 
202
    function CreateCopy(Src: PStringMapItem): PStringMapItem; override;
 
203
  public
 
204
    function GetItem(const Name: string; out Value: Pointer): boolean;
 
205
    procedure Add(const Name: string; const Value: Pointer); virtual;
 
206
    property Items[const s: string]: Pointer read GetItems write SetItems; default;
 
207
    procedure Assign(Source: TStringMap); override;
 
208
    function GetEnumerator: TStringToPointerTreeEnumerator;
 
209
    property FreeValues: boolean read FFreeValues write FFreeValues;
 
210
  end;
 
211
 
141
212
  { TFilenameToStringTree }
142
213
 
143
214
  TFilenameToStringTree = class(TStringToStringTree)
144
215
  public
145
 
    constructor Create(CaseInsensitive: boolean);
 
216
    constructor Create(CaseInsensitive: boolean); // false = system default
 
217
  end;
 
218
 
 
219
  { TFilenameToPointerTree }
 
220
 
 
221
  TFilenameToPointerTree = class(TStringToPointerTree)
 
222
  public
 
223
    constructor Create(CaseInsensitive: boolean); // false = system default
 
224
  end;
 
225
 
 
226
  TStringTree = class;
 
227
 
 
228
  { TStringTreeEnumerator }
 
229
 
 
230
  TStringTreeEnumerator = class
 
231
  private
 
232
    FTree: TStringTree;
 
233
    FCurrent: TAVLTreeNode;
 
234
    function GetCurrent: string;
 
235
  public
 
236
    constructor Create(Tree: TStringTree);
 
237
    function MoveNext: boolean;
 
238
    property Current: string read GetCurrent;
146
239
  end;
147
240
 
148
241
  { TStringTree }
156
249
    function FindNode(const s: string): TAVLTreeNode; inline;
157
250
    procedure ReplaceString(var s: string);
158
251
    function CalcMemSize: PtrUInt;
 
252
    function GetEnumerator: TStringTreeEnumerator;
159
253
  end;
160
254
 
161
255
type
165
259
 
166
260
  TComponentChildCollector = class
167
261
  private
168
 
    FChilds: TFPList;
 
262
    FChildren: TFPList;
169
263
    FRoot: TComponent;
170
264
    procedure AddChildComponent(Child: TComponent);
171
265
  public
172
266
    constructor Create;
173
267
    destructor Destroy; override;
174
268
    function GetComponents(RootComponent: TComponent; AddRoot: boolean = true): TFPList;
175
 
    property Children: TFPList read FChilds;
 
269
    property Children: TFPList read FChildren;
176
270
    property Root: TComponent read FRoot;
177
271
  end;
178
 
  
 
272
 
 
273
// case sensitive
179
274
function CompareStringToStringItems(Data1, Data2: Pointer): integer;
180
275
function CompareStringAndStringToStringTreeItem(Key, Data: Pointer): integer;
 
276
function CompareIdentifierAndStringToStringTreeItem(Identifier, Data: Pointer): integer;
 
277
function CompareIdentifierPrefixAndStringToStringTreeItem(Identifier, Data: Pointer): integer;
181
278
 
 
279
// case insensitive
182
280
function CompareStringToStringItemsI(Data1, Data2: Pointer): integer;
183
281
function CompareStringAndStringToStringTreeItemI(Key, Data: Pointer): integer;
 
282
function CompareIdentifierAndStringToStringTreeItemI(Identifier, Data: Pointer): integer;
 
283
function CompareIdentifierPrefixAndStringToStringTreeItemI(Identifier, Data: Pointer): integer;
184
284
 
185
285
function CompareFilenameToStringItems(Data1, Data2: Pointer): integer;
186
286
function CompareFilenameAndFilenameToStringTreeItem(Key, Data: Pointer): integer;
190
290
 
191
291
function CompareAnsiStringPtrs(Data1, Data2: Pointer): integer;
192
292
 
 
293
{$IF FPC_FULLVERSION<20601}
 
294
  {$DEFINE EnableAVLFindPointerFix}
 
295
{$ENDIF}
 
296
function AVLFindPointer(Tree: TAVLTree; Data: Pointer): TAVLTreeNode; {$IFNDEF EnableAVLFindPointerFix}inline;{$ENDIF}
 
297
procedure AVLRemovePointer(Tree: TAVLTree; Data: Pointer); {$IFNDEF EnableAVLFindPointerFix}inline;{$ENDIF}
 
298
 
193
299
implementation
194
300
 
195
301
function CompareStringToStringItems(Data1, Data2: Pointer): integer;
215
321
  Result:=CompareStr(String(Key),PStringToStringTreeItem(Data)^.Name);
216
322
end;
217
323
 
 
324
function CompareIdentifierAndStringToStringTreeItem(Identifier, Data: Pointer
 
325
  ): integer;
 
326
var
 
327
  Id: PChar absolute Identifier;
 
328
  Item: PStringToStringTreeItem absolute Data;
 
329
  IdLen: LongInt;
 
330
  ItemLen: PtrInt;
 
331
begin
 
332
  Result:=-CompareIdentifiersCaseSensitive(Id,PChar(Item^.Name));
 
333
  if Result=0 then begin
 
334
    IdLen:=GetIdentLen(Id);
 
335
    ItemLen:=length(Item^.Name);
 
336
    if IdLen=Itemlen then
 
337
      Result:=0
 
338
    else if IdLen>ItemLen then
 
339
      Result:=1
 
340
    else
 
341
      Result:=-1;
 
342
  end;
 
343
end;
 
344
 
 
345
function CompareIdentifierPrefixAndStringToStringTreeItem(Identifier,
 
346
  Data: Pointer): integer;
 
347
var
 
348
  Id: PChar absolute Identifier;
 
349
  Item: PStringToStringTreeItem absolute Data;
 
350
begin
 
351
  Result:=-CompareIdentifiersCaseSensitive(Id,PChar(Item^.Name));
 
352
end;
 
353
 
218
354
function CompareStringAndStringToStringTreeItemI(Key, Data: Pointer): integer;
219
355
begin
220
356
  Result:=CompareText(String(Key),PStringToStringTreeItem(Data)^.Name);
221
357
end;
222
358
 
 
359
function CompareIdentifierAndStringToStringTreeItemI(Identifier, Data: Pointer
 
360
  ): integer;
 
361
var
 
362
  Id: PChar absolute Identifier;
 
363
  Item: PStringToStringTreeItem absolute Data;
 
364
  IdLen: LongInt;
 
365
  ItemLen: PtrInt;
 
366
begin
 
367
  Result:=-CompareIdentifiers(Id,PChar(Item^.Name));
 
368
  if Result=0 then begin
 
369
    IdLen:=GetIdentLen(Id);
 
370
    ItemLen:=length(Item^.Name);
 
371
    if IdLen=Itemlen then
 
372
      Result:=0
 
373
    else if IdLen>ItemLen then
 
374
      Result:=1
 
375
    else
 
376
      Result:=-1;
 
377
  end;
 
378
end;
 
379
 
 
380
function CompareIdentifierPrefixAndStringToStringTreeItemI(Identifier,
 
381
  Data: Pointer): integer;
 
382
var
 
383
  Id: PChar absolute Identifier;
 
384
  Item: PStringToStringTreeItem absolute Data;
 
385
begin
 
386
  Result:=-CompareIdentifiers(Id,PChar(Item^.Name));
 
387
end;
 
388
 
223
389
function CompareFilenameAndFilenameToStringTreeItem(Key, Data: Pointer
224
390
  ): integer;
225
391
begin
244
410
  Result:=CompareStr(AnsiString(Data1),AnsiString(Data2));
245
411
end;
246
412
 
247
 
{ TCodeXYPositions }
248
 
 
249
 
function TCodeXYPositions.GetItems(Index: integer): PCodeXYPosition;
250
 
begin
251
 
  Result:=PCodeXYPosition(FItems[Index]);
252
 
end;
253
 
 
254
 
function TCodeXYPositions.GetCaretsXY(Index: integer): TPoint;
255
 
var
256
 
  Item: PCodeXYPosition;
257
 
begin
258
 
  Item:=Items[Index];
259
 
  Result:=Point(Item^.X,Item^.Y);
260
 
end;
261
 
 
262
 
function TCodeXYPositions.GetCodes(Index: integer): TCodeBuffer;
263
 
var
264
 
  Item: PCodeXYPosition;
265
 
begin
266
 
  Item:=Items[Index];
267
 
  Result:=Item^.Code;
268
 
end;
269
 
 
270
 
procedure TCodeXYPositions.SetCaretsXY(Index: integer; const AValue: TPoint);
271
 
var
272
 
  Item: PCodeXYPosition;
273
 
begin
274
 
  Item:=Items[Index];
275
 
  Item^.X:=AValue.X;
276
 
  Item^.Y:=AValue.Y;
277
 
end;
278
 
 
279
 
procedure TCodeXYPositions.SetCodes(Index: integer; const AValue: TCodeBuffer);
280
 
var
281
 
  Item: PCodeXYPosition;
282
 
begin
283
 
  Item:=Items[Index];
284
 
  Item^.Code:=AValue;
285
 
end;
286
 
 
287
 
procedure TCodeXYPositions.SetItems(Index: integer;
288
 
  const AValue: PCodeXYPosition);
289
 
begin
290
 
  FItems[Index]:=AValue;
291
 
end;
292
 
 
293
 
constructor TCodeXYPositions.Create;
294
 
begin
295
 
 
296
 
end;
297
 
 
298
 
destructor TCodeXYPositions.Destroy;
299
 
begin
300
 
  Clear;
301
 
  FItems.Free;
302
 
  FItems:=nil;
 
413
function AVLFindPointer(Tree: TAVLTree; Data: Pointer): TAVLTreeNode;
 
414
begin
 
415
  {$IFDEF EnableAVLFindPointerFix}
 
416
  Result:=Tree.FindLeftMost(Data);
 
417
  while (Result<>nil) do begin
 
418
    if Result.Data=Data then break;
 
419
    Result:=Tree.FindSuccessor(Result);
 
420
    if Result=nil then exit;
 
421
    if Tree.OnCompare(Data,Result.Data)<>0 then exit(nil);
 
422
  end;
 
423
  {$ELSE}
 
424
  Result:=Tree.FindPointer(Data);
 
425
  {$ENDIF}
 
426
end;
 
427
 
 
428
procedure AVLRemovePointer(Tree: TAVLTree; Data: Pointer);
 
429
{$IFDEF EnableAVLFindPointerFix}
 
430
var
 
431
  Node: TAVLTreeNode;
 
432
{$ENDIF}
 
433
begin
 
434
  {$IFDEF EnableAVLFindPointerFix}
 
435
  Node:=AVLFindPointer(Tree,Data);
 
436
  if Node<>nil then
 
437
    Tree.Delete(Node);
 
438
  {$ELSE}
 
439
  Tree.RemovePointer(Data);
 
440
  {$ENDIF}
 
441
end;
 
442
 
 
443
{ TMTAVLTree }
 
444
 
 
445
constructor TMTAVLTree.Create(OnCompareMethod: TListSortCompare);
 
446
begin
 
447
  inherited Create(OnCompareMethod);
 
448
  fNodeManager:=TMTAVLTreeNodeMemManager.Create;
 
449
  SetNodeManager(fNodeManager);
 
450
end;
 
451
 
 
452
destructor TMTAVLTree.Destroy;
 
453
begin
303
454
  inherited Destroy;
304
 
end;
305
 
 
306
 
procedure TCodeXYPositions.Clear;
307
 
var
308
 
  i: Integer;
309
 
  Item: PCodeXYPosition;
310
 
begin
311
 
  if FItems<>nil then begin
312
 
    for i:=0 to FItems.Count-1 do begin
313
 
      Item:=Items[i];
314
 
      Dispose(Item);
315
 
    end;
316
 
    FItems.Clear;
 
455
  FreeAndNil(fNodeManager);
 
456
end;
 
457
 
 
458
{ TMTAVLTreeNodeMemManager }
 
459
 
 
460
procedure TMTAVLTreeNodeMemManager.DisposeNode(ANode: TAVLTreeNode);
 
461
begin
 
462
  ANode.Free;
 
463
end;
 
464
 
 
465
function TMTAVLTreeNodeMemManager.NewNode: TAVLTreeNode;
 
466
begin
 
467
  Result:=TAVLTreeNode.Create;
 
468
end;
 
469
 
 
470
{ TFilenameToPointerTree }
 
471
 
 
472
constructor TFilenameToPointerTree.Create(CaseInsensitive: boolean);
 
473
begin
 
474
  inherited Create(true);
 
475
  if CaseInsensitive then
 
476
    SetCompareFuncs(@CompareFilenameToStringItemsI,
 
477
                    @CompareFilenameAndFilenameToStringTreeItemI)
 
478
  else
 
479
    SetCompareFuncs(@CompareFilenameToStringItems,
 
480
                    @CompareFilenameAndFilenameToStringTreeItem);
 
481
end;
 
482
 
 
483
{ TStringToPointerTree }
 
484
 
 
485
function TStringToPointerTree.GetItems(const s: string): Pointer;
 
486
var
 
487
  Node: TAVLTreeNode;
 
488
begin
 
489
  Node:=FindNode(s);
 
490
  if Node<>nil then
 
491
    Result:=PStringToPointerTreeItem(Node.Data)^.Value
 
492
  else
 
493
    Result:=nil;
 
494
end;
 
495
 
 
496
procedure TStringToPointerTree.SetItems(const s: string; AValue: Pointer);
 
497
var
 
498
  Node: TAVLTreeNode;
 
499
  NewItem: PStringToPointerTreeItem;
 
500
begin
 
501
  Node:=FindNode(s);
 
502
  if Node<>nil then begin
 
503
    NewItem:=PStringToPointerTreeItem(Node.Data);
 
504
    if FreeValues then
 
505
      TObject(NewItem^.Value).Free;
 
506
    NewItem^.Value:=AValue;
 
507
  end else begin
 
508
    New(NewItem);
 
509
    NewItem^.Name:=s;
 
510
    NewItem^.Value:=AValue;
 
511
    FTree.Add(NewItem);
317
512
  end;
318
513
end;
319
514
 
320
 
function TCodeXYPositions.Add(const Position: TCodeXYPosition): integer;
321
 
var
322
 
  NewItem: PCodeXYPosition;
 
515
procedure TStringToPointerTree.DisposeItem(p: PStringMapItem);
 
516
var
 
517
  Item: PStringToPointerTreeItem absolute p;
 
518
begin
 
519
  if FreeValues then
 
520
    TObject(Item^.Value).Free;
 
521
  Dispose(Item);
 
522
end;
 
523
 
 
524
function TStringToPointerTree.ItemsAreEqual(p1, p2: PStringMapItem): boolean;
 
525
var
 
526
  Item1: PStringToPointerTreeItem absolute p1;
 
527
  Item2: PStringToPointerTreeItem absolute p2;
 
528
begin
 
529
  Result:=(Item1^.Name=Item2^.Name)
 
530
      and (Item1^.Value=Item2^.Value);
 
531
end;
 
532
 
 
533
function TStringToPointerTree.CreateCopy(Src: PStringMapItem): PStringMapItem;
 
534
var
 
535
  SrcItem: PStringToPointerTreeItem absolute Src;
 
536
  NewItem: PStringToPointerTreeItem;
323
537
begin
324
538
  New(NewItem);
325
 
  NewItem^:=Position;
326
 
  if FItems=nil then FItems:=TFPList.Create;
327
 
  Result:=FItems.Add(NewItem);
328
 
end;
329
 
 
330
 
function TCodeXYPositions.Add(X, Y: integer; Code: TCodeBuffer): integer;
331
 
var
332
 
  NewItem: TCodeXYPosition;
333
 
begin
334
 
  NewItem.X:=X;
335
 
  NewItem.Y:=Y;
336
 
  NewItem.Code:=Code;
337
 
  Result:=Add(NewItem);
338
 
end;
339
 
 
340
 
procedure TCodeXYPositions.Assign(Source: TCodeXYPositions);
341
 
var
342
 
  i: Integer;
343
 
begin
344
 
  if IsEqual(Source) then exit;
345
 
  Clear;
346
 
  for i:=0 to Source.Count-1 do
347
 
    Add(Source[i]^);
348
 
end;
349
 
 
350
 
function TCodeXYPositions.IsEqual(Source: TCodeXYPositions): boolean;
351
 
var
352
 
  SrcItem: TCodeXYPosition;
353
 
  CurItem: TCodeXYPosition;
354
 
  i: Integer;
355
 
begin
356
 
  if Source=Self then
357
 
    Result:=true
358
 
  else if (Source=nil) or (Source.Count<>Count) then
359
 
    Result:=false
360
 
  else begin
361
 
    for i:=0 to Count-1 do begin
362
 
      SrcItem:=Source[i]^;
363
 
      CurItem:=Items[i]^;
364
 
      if (SrcItem.X<>CurItem.X)
365
 
      or (SrcItem.Y<>CurItem.Y)
366
 
      or (SrcItem.Code<>CurItem.Code)
367
 
      then begin
368
 
        Result:=false;
369
 
        exit;
370
 
      end;
371
 
    end;
 
539
  NewItem^.Name:=SrcItem^.Name;
 
540
  NewItem^.Value:=SrcItem^.Value;
 
541
  Result:=PStringMapItem(NewItem);
 
542
end;
 
543
 
 
544
function TStringToPointerTree.GetItem(const Name: string; out Value: Pointer
 
545
  ): boolean;
 
546
var
 
547
  Node: TAVLTreeNode;
 
548
begin
 
549
  Node:=FindNode(Name);
 
550
  if Node<>nil then begin
 
551
    Value:=PStringToPointerTreeItem(Node.Data)^.Value;
372
552
    Result:=true;
 
553
  end else begin
 
554
    Result:=false;
373
555
  end;
374
556
end;
375
557
 
376
 
function TCodeXYPositions.Count: integer;
377
 
begin
378
 
  if FItems<>nil then
379
 
    Result:=FItems.Count
380
 
  else
381
 
    Result:=0;
382
 
end;
383
 
 
384
 
procedure TCodeXYPositions.Delete(Index: integer);
385
 
var
386
 
  Item: PCodeXYPosition;
387
 
begin
388
 
  Item:=Items[Index];
389
 
  Dispose(Item);
390
 
  FItems.Delete(Index);
391
 
end;
392
 
 
393
 
function TCodeXYPositions.CreateCopy: TCodeXYPositions;
394
 
begin
395
 
  Result:=TCodeXYPositions.Create;
396
 
  Result.Assign(Self);
397
 
end;
398
 
 
399
 
function TCodeXYPositions.CalcMemSize: PtrUint;
400
 
begin
401
 
  Result:=PtrUInt(InstanceSize);
402
 
  if FItems<>nil then
403
 
    inc(Result,PtrUInt(FItems.InstanceSize)
404
 
      +PtrUInt(FItems.Capacity)*SizeOf(TCodeXYPosition));
405
 
end;
406
 
 
407
 
{ TStringToStringTree }
408
 
 
409
 
function TStringToStringTree.GetStrings(const s: string): string;
 
558
procedure TStringToPointerTree.Add(const Name: string; const Value: Pointer);
 
559
begin
 
560
  Items[Name]:=Value;
 
561
end;
 
562
 
 
563
procedure TStringToPointerTree.Assign(Source: TStringMap);
410
564
var
411
565
  Node: TAVLTreeNode;
412
 
begin
413
 
  Node:=FindNode(s);
414
 
  if Node<>nil then
415
 
    Result:=PStringToStringTreeItem(Node.Data)^.Value
 
566
  Item: PStringToPointerTreeItem;
 
567
begin
 
568
  if (Source=nil) or (Source.ClassType<>ClassType) then
 
569
    raise Exception.Create('invalid class');
 
570
  Clear;
 
571
  Node:=Source.Tree.FindLowest;
 
572
  while Node<>nil do begin
 
573
    Item:=PStringToPointerTreeItem(Node.Data);
 
574
    Items[Item^.Name]:=Item^.Value;
 
575
    Node:=Source.Tree.FindSuccessor(Node);
 
576
  end;
 
577
end;
 
578
 
 
579
function TStringToPointerTree.GetEnumerator: TStringToPointerTreeEnumerator;
 
580
begin
 
581
  Result:=TStringToPointerTreeEnumerator.Create(FTree);
 
582
end;
 
583
 
 
584
{ TStringMapEnumerator }
 
585
 
 
586
constructor TStringMapEnumerator.Create(Tree: TAVLTree);
 
587
begin
 
588
  FTree:=Tree;
 
589
end;
 
590
 
 
591
function TStringMapEnumerator.MoveNext: boolean;
 
592
begin
 
593
  if FCurrent=nil then
 
594
    FCurrent:=FTree.FindLowest
416
595
  else
417
 
    Result:=''
418
 
end;
419
 
 
420
 
function TStringToStringTree.GetCompareItemsFunc: TListSortCompare;
 
596
    FCurrent:=FTree.FindSuccessor(FCurrent);
 
597
  Result:=FCurrent<>nil;
 
598
end;
 
599
 
 
600
{ TStringToPointerTreeEnumerator }
 
601
 
 
602
function TStringToPointerTreeEnumerator.GetCurrent: PStringToPointerTreeItem;
 
603
begin
 
604
  Result:=PStringToPointerTreeItem(FCurrent.Data);
 
605
end;
 
606
 
 
607
{ TStringMap }
 
608
 
 
609
function TStringMap.GetCompareItemsFunc: TListSortCompare;
421
610
begin
422
611
  Result:=Tree.OnCompare;
423
612
end;
424
613
 
425
 
procedure TStringToStringTree.SetStrings(const s: string; const AValue: string);
426
 
var
427
 
  Node: TAVLTreeNode;
428
 
  NewItem: PStringToStringTreeItem;
429
 
begin
430
 
  Node:=FindNode(s);
431
 
  if Node<>nil then begin
432
 
    PStringToStringTreeItem(Node.Data)^.Value:=AValue;
433
 
  end else begin
434
 
    New(NewItem);
435
 
    NewItem^.Name:=s;
436
 
    NewItem^.Value:=AValue;
437
 
    FTree.Add(NewItem);
438
 
  end;
439
 
end;
440
 
 
441
 
function TStringToStringTree.FindNode(const s: string): TAVLTreeNode;
442
 
begin
443
 
  Result:=FTree.FindKey(Pointer(s),FCompareKeyItemFunc)
444
 
end;
445
 
 
446
 
constructor TStringToStringTree.Create(TheCaseSensitive: boolean);
 
614
function TStringMap.FindNode(const s: string): TAVLTreeNode;
 
615
begin
 
616
  Result:=FTree.FindKey(Pointer(s),FCompareKeyItemFunc);
 
617
end;
 
618
 
 
619
procedure TStringMap.DisposeItem(p: PStringMapItem);
 
620
begin
 
621
  Dispose(p);
 
622
end;
 
623
 
 
624
function TStringMap.ItemsAreEqual(p1, p2: PStringMapItem): boolean;
 
625
begin
 
626
  Result:=p1^.Name=p2^.Name;
 
627
end;
 
628
 
 
629
function TStringMap.CreateCopy(Src: PStringMapItem): PStringMapItem;
 
630
begin
 
631
  New(Result);
 
632
  Result^.Name:=Src^.Name;
 
633
end;
 
634
 
 
635
constructor TStringMap.Create(TheCaseSensitive: boolean);
447
636
begin
448
637
  FCaseSensitive:=TheCaseSensitive;
449
638
  if CaseSensitive then begin
450
639
    FCompareKeyItemFunc:=@CompareStringAndStringToStringTreeItem;
451
 
    FTree:=TAVLTree.Create(@CompareStringToStringItems);
 
640
    FTree:=TMTAVLTree.Create(@CompareStringToStringItems);
452
641
  end else begin
453
642
    FCompareKeyItemFunc:=@CompareStringAndStringToStringTreeItemI;
454
 
    FTree:=TAVLTree.Create(@CompareStringToStringItemsI);
 
643
    FTree:=TMTAVLTree.Create(@CompareStringToStringItemsI);
455
644
  end;
456
645
end;
457
646
 
458
 
destructor TStringToStringTree.Destroy;
 
647
destructor TStringMap.Destroy;
459
648
begin
460
649
  Clear;
461
650
  FTree.Free;
463
652
  inherited Destroy;
464
653
end;
465
654
 
466
 
procedure TStringToStringTree.Clear;
 
655
procedure TStringMap.Clear;
467
656
var
468
657
  Node: TAVLTreeNode;
469
 
  Item: PStringToStringTreeItem;
470
658
begin
471
659
  Node:=FTree.FindLowest;
472
660
  while Node<>nil do begin
473
 
    Item:=PStringToStringTreeItem(Node.Data);
474
 
    Dispose(Item);
 
661
    DisposeItem(PStringMapItem(Node.Data));
475
662
    Node:=FTree.FindSuccessor(Node);
476
663
  end;
477
664
  FTree.Clear;
478
665
end;
479
666
 
480
 
function TStringToStringTree.Contains(const s: string): boolean;
 
667
function TStringMap.Contains(const s: string): boolean;
481
668
begin
482
669
  Result:=FindNode(s)<>nil;
483
670
end;
484
671
 
485
 
function TStringToStringTree.GetString(const Name: string; out Value: string
486
 
  ): boolean;
487
 
var
488
 
  Node: TAVLTreeNode;
489
 
begin
490
 
  Node:=FindNode(Name);
491
 
  if Node<>nil then begin
492
 
    Value:=PStringToStringTreeItem(Node.Data)^.Value;
493
 
    Result:=true;
494
 
  end else begin
495
 
    Result:=false;
496
 
  end;
497
 
end;
498
 
 
499
 
procedure TStringToStringTree.Add(const Name, Value: string);
500
 
begin
501
 
  Strings[Name]:=Value;
502
 
end;
503
 
 
504
 
procedure TStringToStringTree.GetNames(List: TStrings);
505
 
var
506
 
  Node: TAVLTreeNode;
507
 
  Item: PStringToStringTreeItem;
 
672
function TStringMap.ContainsIdentifier(P: PChar): boolean;
 
673
begin
 
674
  if CaseSensitive then
 
675
    Result:=FTree.FindKey(p,@CompareIdentifierAndStringToStringTreeItem)<>nil
 
676
  else
 
677
    Result:=FTree.FindKey(p,@CompareIdentifierAndStringToStringTreeItemI)<>nil;
 
678
end;
 
679
 
 
680
function TStringMap.FindNodeWithIdentifierAsPrefix(P: PChar): TAVLTreeNode;
 
681
begin
 
682
  if CaseSensitive then
 
683
    Result:=FTree.FindKey(p,@CompareIdentifierPrefixAndStringToStringTreeItem)
 
684
  else
 
685
    Result:=FTree.FindKey(p,@CompareIdentifierPrefixAndStringToStringTreeItemI);
 
686
end;
 
687
 
 
688
procedure TStringMap.GetNames(List: TStrings);
 
689
var
 
690
  Node: TAVLTreeNode;
 
691
  Item: PStringMapItem;
508
692
begin
509
693
  Node:=Tree.FindLowest;
510
694
  while Node<>nil do begin
511
 
    Item:=PStringToStringTreeItem(Node.Data);
 
695
    Item:=PStringMapItem(Node.Data);
512
696
    List.Add(Item^.Name);
513
697
    Node:=Tree.FindSuccessor(Node);
514
698
  end;
515
699
end;
516
700
 
517
 
procedure TStringToStringTree.Remove(const Name: string);
 
701
procedure TStringMap.Remove(const Name: string);
518
702
var
519
703
  Node: TAVLTreeNode;
520
 
  Item: PStringToStringTreeItem;
 
704
  Item: PStringMapItem;
521
705
begin
522
706
  Node:=FindNode(Name);
523
707
  if Node<>nil then begin
524
 
    Item:=PStringToStringTreeItem(Node.Data);
 
708
    Item:=PStringMapItem(Node.Data);
525
709
    FTree.Delete(Node);
526
710
    Dispose(Item);
527
711
  end;
528
712
end;
529
713
 
530
 
function TStringToStringTree.AsText: string;
531
 
var
532
 
  Node: TAVLTreeNode;
533
 
  Item: PStringToStringTreeItem;
 
714
function TStringMap.Count: integer;
534
715
begin
535
 
  Result:='';
536
 
  Node:=Tree.FindLowest;
537
 
  while Node<>nil do begin
538
 
    Item:=PStringToStringTreeItem(Node.Data);
539
 
    Result:=Result+Item^.Name+'='+Item^.Value+LineEnding;
540
 
    Node:=Tree.FindSuccessor(Node);
541
 
  end;
 
716
  Result:=Tree.Count;
542
717
end;
543
718
 
544
 
function TStringToStringTree.Equals(OtherTree: TStringToStringTree): boolean;
 
719
function TStringMap.Equals(OtherTree: TStringMap): boolean;
545
720
var
546
721
  Node: TAVLTreeNode;
547
722
  OtherNode: TAVLTreeNode;
548
 
  OtherItem: PStringToStringTreeItem;
549
 
  Item: PStringToStringTreeItem;
 
723
  OtherItem: PStringMapItem;
 
724
  Item: PStringMapItem;
550
725
begin
551
726
  Result:=false;
552
 
  if OtherTree=nil then exit;
 
727
  if (OtherTree=nil) or (OtherTree.ClassType<>ClassType) then exit;
553
728
  if Tree.Count<>OtherTree.Tree.Count then exit;
554
729
  Node:=Tree.FindLowest;
555
730
  OtherNode:=OtherTree.Tree.FindLowest;
556
731
  while Node<>nil do begin
557
732
    if OtherNode=nil then exit;
558
 
    Item:=PStringToStringTreeItem(Node.Data);
559
 
    OtherItem:=PStringToStringTreeItem(OtherNode.Data);
560
 
    if (Item^.Name<>OtherItem^.Name)
561
 
    or (Item^.Value<>OtherItem^.Value) then exit;
 
733
    Item:=PStringMapItem(Node.Data);
 
734
    OtherItem:=PStringMapItem(OtherNode.Data);
 
735
    if not ItemsAreEqual(Item,OtherItem) then exit;
562
736
    OtherNode:=OtherTree.Tree.FindSuccessor(OtherNode);
563
737
    Node:=Tree.FindSuccessor(Node);
564
738
  end;
566
740
  Result:=true;
567
741
end;
568
742
 
569
 
procedure TStringToStringTree.Assign(Source: TStringToStringTree);
 
743
procedure TStringMap.Assign(Source: TStringMap);
 
744
var
 
745
  SrcNode: TAVLTreeNode;
 
746
  SrcItem: PStringMapItem;
 
747
begin
 
748
  if (Source=nil) or (Source.ClassType<>ClassType) then
 
749
    raise Exception.Create('invalid class');
 
750
  Clear;
 
751
  SrcNode:=Source.Tree.FindLowest;
 
752
  while SrcNode<>nil do begin
 
753
    SrcItem:=PStringMapItem(SrcNode.Data);
 
754
    Tree.Add(CreateCopy(SrcItem));
 
755
    SrcNode:=Source.Tree.FindSuccessor(SrcNode);
 
756
  end;
 
757
end;
 
758
 
 
759
procedure TStringMap.WriteDebugReport;
 
760
var
 
761
  Node: TAVLTreeNode;
 
762
  Item: PStringMapItem;
 
763
begin
 
764
  DebugLn(['TStringMap.WriteDebugReport ',Tree.Count]);
 
765
  Node:=Tree.FindLowest;
 
766
  while Node<>nil do begin
 
767
    Item:=PStringMapItem(Node.Data);
 
768
    DebugLn([Item^.Name]);
 
769
    Node:=Tree.FindSuccessor(Node);
 
770
  end;
 
771
end;
 
772
 
 
773
function TStringMap.CalcMemSize: PtrUint;
 
774
var
 
775
  Node: TAVLTreeNode;
 
776
  Item: PStringMapItem;
 
777
begin
 
778
  Result:=PtrUInt(InstanceSize)
 
779
    +PtrUInt(FTree.InstanceSize)
 
780
    +PtrUint(FTree.Count)*SizeOf(TAVLTreeNode);
 
781
  Node:=FTree.FindLowest;
 
782
  while Node<>nil do begin
 
783
    Item:=PStringMapItem(Node.Data);
 
784
    inc(Result,MemSizeString(Item^.Name)
 
785
       +SizeOf(TStringMapItem));
 
786
    Node:=FTree.FindSuccessor(Node);
 
787
  end;
 
788
end;
 
789
 
 
790
procedure TStringMap.SetCompareFuncs(const NewCompareItemsFunc,
 
791
  NewCompareKeyItemFunc: TListSortCompare);
 
792
begin
 
793
  FCompareKeyItemFunc:=NewCompareKeyItemFunc;
 
794
  Tree.OnCompare:=NewCompareItemsFunc;
 
795
end;
 
796
 
 
797
{ TStringToStringTreeEnumerator }
 
798
 
 
799
function TStringToStringTreeEnumerator.GetCurrent: PStringToStringTreeItem;
 
800
begin
 
801
  Result:=PStringToStringTreeItem(FCurrent.Data);
 
802
end;
 
803
 
 
804
{ TStringTreeEnumerator }
 
805
 
 
806
function TStringTreeEnumerator.GetCurrent: string;
 
807
begin
 
808
  Result:=AnsiString(FCurrent.Data);
 
809
end;
 
810
 
 
811
constructor TStringTreeEnumerator.Create(Tree: TStringTree);
 
812
begin
 
813
  FTree:=Tree;
 
814
end;
 
815
 
 
816
function TStringTreeEnumerator.MoveNext: boolean;
 
817
begin
 
818
  if FCurrent=nil then
 
819
    FCurrent:=FTree.Tree.FindLowest
 
820
  else
 
821
    FCurrent:=FTree.Tree.FindSuccessor(FCurrent);
 
822
  Result:=FCurrent<>nil;
 
823
end;
 
824
 
 
825
{ TStringToStringTree }
 
826
 
 
827
function TStringToStringTree.GetStrings(const s: string): string;
 
828
var
 
829
  Node: TAVLTreeNode;
 
830
begin
 
831
  Node:=FindNode(s);
 
832
  if Node<>nil then
 
833
    Result:=PStringToStringTreeItem(Node.Data)^.Value
 
834
  else
 
835
    Result:=''
 
836
end;
 
837
 
 
838
procedure TStringToStringTree.SetStrings(const s: string; const AValue: string);
 
839
var
 
840
  Node: TAVLTreeNode;
 
841
  NewItem: PStringToStringTreeItem;
 
842
begin
 
843
  Node:=FindNode(s);
 
844
  if Node<>nil then begin
 
845
    PStringToStringTreeItem(Node.Data)^.Value:=AValue;
 
846
  end else begin
 
847
    New(NewItem);
 
848
    NewItem^.Name:=s;
 
849
    NewItem^.Value:=AValue;
 
850
    FTree.Add(NewItem);
 
851
  end;
 
852
end;
 
853
 
 
854
procedure TStringToStringTree.DisposeItem(p: PStringMapItem);
 
855
var
 
856
  Item: PStringToStringTreeItem absolute p;
 
857
begin
 
858
  Dispose(Item);
 
859
end;
 
860
 
 
861
function TStringToStringTree.ItemsAreEqual(p1, p2: PStringMapItem): boolean;
 
862
var
 
863
  Item1: PStringToStringTreeItem absolute p1;
 
864
  Item2: PStringToStringTreeItem absolute p2;
 
865
begin
 
866
  Result:=(Item1^.Name=Item2^.Name)
 
867
      and (Item1^.Value=Item2^.Value);
 
868
end;
 
869
 
 
870
function TStringToStringTree.CreateCopy(Src: PStringMapItem): PStringMapItem;
 
871
var
 
872
  SrcItem: PStringToStringTreeItem absolute Src;
 
873
  NewItem: PStringToStringTreeItem;
 
874
begin
 
875
  New(NewItem);
 
876
  NewItem^.Name:=SrcItem^.Name;
 
877
  NewItem^.Value:=SrcItem^.Value;
 
878
  Result:=PStringMapItem(NewItem);
 
879
end;
 
880
 
 
881
function TStringToStringTree.GetString(const Name: string; out Value: string
 
882
  ): boolean;
 
883
var
 
884
  Node: TAVLTreeNode;
 
885
begin
 
886
  Node:=FindNode(Name);
 
887
  if Node<>nil then begin
 
888
    Value:=PStringToStringTreeItem(Node.Data)^.Value;
 
889
    Result:=true;
 
890
  end else begin
 
891
    Result:=false;
 
892
  end;
 
893
end;
 
894
 
 
895
procedure TStringToStringTree.Add(const Name, Value: string);
 
896
begin
 
897
  Strings[Name]:=Value;
 
898
end;
 
899
 
 
900
function TStringToStringTree.AsText: string;
570
901
var
571
902
  Node: TAVLTreeNode;
572
903
  Item: PStringToStringTreeItem;
573
904
begin
574
 
  Clear;
575
 
  Node:=Source.Tree.FindLowest;
 
905
  Result:='';
 
906
  Node:=Tree.FindLowest;
576
907
  while Node<>nil do begin
577
908
    Item:=PStringToStringTreeItem(Node.Data);
578
 
    Strings[Item^.Name]:=Item^.Value;
579
 
    Node:=Source.Tree.FindSuccessor(Node);
 
909
    Result:=Result+Item^.Name+'='+Item^.Value+LineEnding;
 
910
    Node:=Tree.FindSuccessor(Node);
580
911
  end;
581
912
end;
582
913
 
612
943
  end;
613
944
end;
614
945
 
615
 
procedure TStringToStringTree.SetCompareFuncs(const NewCompareItemsFunc,
616
 
  NewCompareKeyItemFunc: TListSortCompare);
 
946
function TStringToStringTree.GetEnumerator: TStringToStringTreeEnumerator;
617
947
begin
618
 
  FCompareKeyItemFunc:=NewCompareKeyItemFunc;
619
 
  Tree.OnCompare:=NewCompareItemsFunc;
 
948
  Result:=TStringToStringTreeEnumerator.Create(FTree);
620
949
end;
621
950
 
622
951
{ TFilenameToStringTree }
668
997
  Node: TAVLTreeNode;
669
998
  h: String;
670
999
begin
 
1000
  if GetStringRefCount(s)<=0 then exit;
671
1001
  Node:=FindNode(s);
672
1002
  if Node=nil then begin
673
1003
    // increase refcount
674
1004
    h:=s;
675
1005
    Tree.Add(Pointer(h));
676
1006
    Pointer(h):=nil; // keep refcount
677
 
  end else
 
1007
    //debugln(['TStringTree.ReplaceString new string: refcount=',GetStringRefCount(s)]);
 
1008
    //debugln(['TStringTree.ReplaceString NewString="',dbgstr(s),'"']);
 
1009
  end else begin
678
1010
    s:=AnsiString(Node.Data);
 
1011
    //debugln(['TStringTree.ReplaceString old string: refcount=',GetStringRefCount(s)]);
 
1012
    //debugln(['TStringTree.ReplaceString OldString="',dbgstr(s),'"']);
 
1013
  end;
 
1014
  //debugln(['TStringTree.ReplaceString ',GetStringRefCount(s),' ',Node<>nil]);
679
1015
end;
680
1016
 
681
1017
function TStringTree.CalcMemSize: PtrUInt;
692
1028
  end;
693
1029
end;
694
1030
 
 
1031
function TStringTree.GetEnumerator: TStringTreeEnumerator;
 
1032
begin
 
1033
  Result:=TStringTreeEnumerator.Create(Self);
 
1034
end;
 
1035
 
695
1036
{ TComponentChildCollector }
696
1037
 
697
1038
procedure TComponentChildCollector.AddChildComponent(Child: TComponent);
712
1053
 
713
1054
constructor TComponentChildCollector.Create;
714
1055
begin
715
 
  FChilds:=TFPList.Create;
 
1056
  FChildren:=TFPList.Create;
716
1057
end;
717
1058
 
718
1059
destructor TComponentChildCollector.Destroy;
719
1060
begin
720
 
  FreeAndNil(FChilds);
 
1061
  FreeAndNil(FChildren);
721
1062
  inherited Destroy;
722
1063
end;
723
1064