← Back to branch summary

~ubuntu-branches/ubuntu/vivid/lazarus/vivid-proposed

« back to all changes in this revision

Viewing changes to .pc/fix-compilation-with-fpc-2.6.2.patch/components/codetools/codetoolsstructs.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Paul Gevers
  • Date: 2014-04-25 12:57:26 UTC
  • mfrom: (1.1.12)
  • Revision ID: package-import@ubuntu.com-20140425125726-6zkdcnnbbleuuvwj
Tags: 1.2+dfsg-1
[ Abou Al Montacir ]
* Packaged QT4 based IDE and LCL units.

[ Paul Gevers ]
* New upstream release
* Drop obsolete patches + refresh spell_errors.diff
* Update dependencies and description for QT4 changes
* Improve deduplication in d/rules (adds lcl-qt4 -> lcl-gtk2 -> lcl-nogui)

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/fix-compilation-with-fpc-2.6.2.patch/components/codetools/codetoolsstructs.pas
1
 
{
2
 
 ***************************************************************************
3
 
 *                                                                         *
4
 
 *   This source is free software; you can redistribute it and/or modify   *
5
 
 *   it under the terms of the GNU General Public License as published by  *
6
 
 *   the Free Software Foundation; either version 2 of the License, or     *
7
 
 *   (at your option) any later version.                                   *
8
 
 *                                                                         *
9
 
 *   This code is distributed in the hope that it will be useful, but      *
10
 
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11
 
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12
 
 *   General Public License for more details.                              *
13
 
 *                                                                         *
14
 
 *   A copy of the GNU General Public License is available on the World    *
15
 
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16
 
 *   obtain it by writing to the Free Software Foundation,                 *
17
 
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
18
 
 *                                                                         *
19
 
 ***************************************************************************
20
 
 
21
 
  Author: Mattias Gaertner
22
 
 
23
 
  Abstract:
24
 
    Most codetools returns simple values like a single code position or a
25
 
    string. But some creates lists of data.
26
 
    This unit provides structures for complex results.
27
 
}
28
 
unit CodeToolsStructs;
29
 
 
30
 
{$mode objfpc}{$H+}
31
 
 
32
 
interface
33
 
 
34
 
uses
35
 
  Classes, SysUtils, FileProcs, AVL_Tree, BasicCodeTools;
36
 
  
37
 
type
38
 
  TResourcestringInsertPolicy = (
39
 
    rsipNone,          // do not add/insert
40
 
    rsipAppend,        // append at end
41
 
    rsipAlphabetically,// insert alphabetically
42
 
    rsipContext        // insert context sensitive
43
 
    );
44
 
 
45
 
  TPascalClassSection = (
46
 
    pcsPrivate,
47
 
    pcsProtected,
48
 
    pcsPublic,
49
 
    pcsPublished
50
 
    );
51
 
  TPascalClassSections = set of TPascalClassSection;
52
 
  
53
 
const
54
 
  AllPascalClassSections = [low(TPascalClassSection)..high(TPascalClassSection)];
55
 
  
56
 
const
57
 
  PascalClassSectionKeywords: array[TPascalClassSection] of string = (
58
 
    'private',
59
 
    'protected',
60
 
    'public',
61
 
    'published'
62
 
    );
63
 
 
64
 
type
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
 
  TPointerToPointerItem = record
85
 
    Key, Value: Pointer;
86
 
  end;
87
 
  PPointerToPointerItem = ^TPointerToPointerItem;
88
 
 
89
 
  { TPointerToPointerTree }
90
 
 
91
 
  TPointerToPointerTree = class
92
 
  private
93
 
    FTree: TAVLTree;// tree of PPointerToPointerItem
94
 
    function GetItems(Key: Pointer): Pointer;
95
 
    procedure SetItems(Key: Pointer; AValue: Pointer);
96
 
  protected
97
 
    procedure DisposeItem(p: PPointerToPointerItem); virtual;
98
 
  public
99
 
    constructor Create;
100
 
    destructor Destroy; override;
101
 
    procedure Clear; virtual;
102
 
    function Contains(Key: Pointer): boolean;
103
 
    procedure Remove(Key: Pointer); virtual;
104
 
    property Tree: TAVLTree read FTree; // tree of PPointerToPointerItem
105
 
    function GetNodeData(AVLNode: TAVLTreeNode): PPointerToPointerItem; inline;
106
 
    function Count: integer;
107
 
    function FindNode(Key: Pointer): TAVLTreeNode;
108
 
    procedure Add(Key, Value: Pointer); virtual;
109
 
    property Items[Key: Pointer]: Pointer read GetItems write SetItems; default;
110
 
  end;
111
 
 
112
 
  TStringMap = class;
113
 
 
114
 
  TStringMapItem = record
115
 
    Name: string;
116
 
  end;
117
 
  PStringMapItem = ^TStringMapItem;
118
 
 
119
 
  { TStringMapEnumerator }
120
 
 
121
 
  TStringMapEnumerator = class
122
 
  protected
123
 
    FTree: TAVLTree;
124
 
    FCurrent: TAVLTreeNode;
125
 
  public
126
 
    constructor Create(Tree: TAVLTree);
127
 
    function MoveNext: boolean;
128
 
    // "Current" is implemented by the descendant classes
129
 
  end;
130
 
 
131
 
  { TStringMap }
132
 
 
133
 
  TStringMap = class
134
 
  private
135
 
    FCompareKeyItemFunc: TListSortCompare;
136
 
    FTree: TAVLTree;// tree of PStringMapItem
137
 
    FCaseSensitive: boolean;
138
 
    function GetCompareItemsFunc: TListSortCompare;
139
 
  protected
140
 
    procedure DisposeItem(p: PStringMapItem); virtual;
141
 
    function ItemsAreEqual(p1, p2: PStringMapItem): boolean; virtual;
142
 
    function CreateCopy(Src: PStringMapItem): PStringMapItem; virtual;
143
 
  public
144
 
    constructor Create(TheCaseSensitive: boolean);
145
 
    destructor Destroy; override;
146
 
    procedure Clear; virtual;
147
 
    function Contains(const s: string): boolean;
148
 
    function ContainsIdentifier(P: PChar): boolean;
149
 
    function FindNodeWithIdentifierAsPrefix(P: PChar): TAVLTreeNode;
150
 
    procedure GetNames(List: TStrings);
151
 
    procedure Remove(const Name: string); virtual;
152
 
    property CaseSensitive: boolean read FCaseSensitive;
153
 
    property Tree: TAVLTree read FTree; // tree of PStringMapItem
154
 
    function GetNodeData(AVLNode: TAVLTreeNode): PStringMapItem; inline;
155
 
    function Count: integer;
156
 
    function FindNode(const s: string): TAVLTreeNode;
157
 
    function Equals(OtherTree: TStringMap): boolean; reintroduce;
158
 
    procedure Assign(Source: TStringMap); virtual;
159
 
    procedure WriteDebugReport; virtual;
160
 
    function CalcMemSize: PtrUint; virtual;
161
 
    property CompareItemsFunc: TListSortCompare read GetCompareItemsFunc;
162
 
    property CompareKeyItemFunc: TListSortCompare read FCompareKeyItemFunc;
163
 
    procedure SetCompareFuncs(
164
 
            const NewCompareItemsFunc, NewCompareKeyItemFunc: TListSortCompare);
165
 
  end;
166
 
 
167
 
  TStringToStringTreeItem = record
168
 
    Name: string;
169
 
    Value: string;
170
 
  end;
171
 
  PStringToStringTreeItem = ^TStringToStringTreeItem;
172
 
 
173
 
  TStringToStringTree = class;
174
 
 
175
 
  { TStringToStringTreeEnumerator }
176
 
 
177
 
  TStringToStringTreeEnumerator = class(TStringMapEnumerator)
178
 
  private
179
 
    function GetCurrent: PStringToStringTreeItem;
180
 
  public
181
 
    property Current: PStringToStringTreeItem read GetCurrent;
182
 
  end;
183
 
 
184
 
  { TStringToStringTree }
185
 
 
186
 
  TStringToStringTree = class(TStringMap)
187
 
  private
188
 
    function GetStrings(const s: string): string;
189
 
    procedure SetStrings(const s: string; const AValue: string);
190
 
  protected
191
 
    procedure DisposeItem(p: PStringMapItem); override;
192
 
    function ItemsAreEqual(p1, p2: PStringMapItem): boolean; override;
193
 
    function CreateCopy(Src: PStringMapItem): PStringMapItem; override;
194
 
  public
195
 
    function GetString(const Name: string; out Value: string): boolean;
196
 
    procedure Add(const Name, Value: string); virtual;
197
 
    property Strings[const s: string]: string read GetStrings write SetStrings; default;
198
 
    function GetNodeData(AVLNode: TAVLTreeNode): PStringToStringTreeItem; inline;
199
 
    function AsText: string;
200
 
    procedure WriteDebugReport; override;
201
 
    function CalcMemSize: PtrUint; override;
202
 
    function GetEnumerator: TStringToStringTreeEnumerator;
203
 
  end;
204
 
 
205
 
  TStringToPointerTree = class;
206
 
 
207
 
  TStringToPointerTreeItem = record
208
 
    Name: string;
209
 
    Value: Pointer;
210
 
  end;
211
 
  PStringToPointerTreeItem = ^TStringToPointerTreeItem;
212
 
 
213
 
  { TStringToPointerTreeEnumerator }
214
 
 
215
 
  TStringToPointerTreeEnumerator = class(TStringMapEnumerator)
216
 
  private
217
 
    function GetCurrent: PStringToPointerTreeItem;
218
 
  public
219
 
    property Current: PStringToPointerTreeItem read GetCurrent;
220
 
  end;
221
 
 
222
 
  { TStringToPointerTree - Tree contains PStringToPointerTreeItem }
223
 
 
224
 
  TStringToPointerTree = class(TStringMap)
225
 
  private
226
 
    FFreeValues: boolean;
227
 
    function GetItems(const s: string): Pointer;
228
 
    procedure SetItems(const s: string; AValue: Pointer);
229
 
  protected
230
 
    procedure DisposeItem(p: PStringMapItem); override;
231
 
    function ItemsAreEqual(p1, p2: PStringMapItem): boolean; override;
232
 
    function CreateCopy(Src: PStringMapItem): PStringMapItem; override;
233
 
  public
234
 
    function GetItem(const Name: string; out Value: Pointer): boolean;
235
 
    procedure Add(const Name: string; const Value: Pointer); virtual;
236
 
    property Items[const s: string]: Pointer read GetItems write SetItems; default;
237
 
    function GetNodeData(AVLNode: TAVLTreeNode): PStringToPointerTreeItem; inline;
238
 
    procedure Assign(Source: TStringMap); override;
239
 
    function GetEnumerator: TStringToPointerTreeEnumerator;
240
 
    property FreeValues: boolean read FFreeValues write FFreeValues;
241
 
  end;
242
 
 
243
 
  { TFilenameToStringTree }
244
 
 
245
 
  TFilenameToStringTree = class(TStringToStringTree)
246
 
  public
247
 
    constructor Create(CaseInsensitive: boolean); // false = system default
248
 
  end;
249
 
 
250
 
  { TFilenameToPointerTree }
251
 
 
252
 
  TFilenameToPointerTree = class(TStringToPointerTree)
253
 
  public
254
 
    constructor Create(CaseInsensitive: boolean); // false = system default
255
 
  end;
256
 
 
257
 
  TStringTree = class;
258
 
 
259
 
  { TStringTreeEnumerator }
260
 
 
261
 
  TStringTreeEnumerator = class
262
 
  private
263
 
    FTree: TStringTree;
264
 
    FCurrent: TAVLTreeNode;
265
 
    function GetCurrent: string;
266
 
  public
267
 
    constructor Create(Tree: TStringTree);
268
 
    function MoveNext: boolean;
269
 
    property Current: string read GetCurrent;
270
 
  end;
271
 
 
272
 
  { TStringTree }
273
 
 
274
 
  TStringTree = class
275
 
  public
276
 
    Tree: TAVLTree;
277
 
    constructor Create;
278
 
    destructor Destroy; override;
279
 
    procedure Clear;
280
 
    function FindNode(const s: string): TAVLTreeNode; inline;
281
 
    procedure ReplaceString(var s: string);
282
 
    function CalcMemSize: PtrUInt;
283
 
    function GetEnumerator: TStringTreeEnumerator;
284
 
  end;
285
 
 
286
 
type
287
 
  TCTComponentAccess = class(TComponent);
288
 
 
289
 
  { TComponentChildCollector }
290
 
 
291
 
  TComponentChildCollector = class
292
 
  private
293
 
    FChildren: TFPList;
294
 
    FRoot: TComponent;
295
 
    procedure AddChildComponent(Child: TComponent);
296
 
  public
297
 
    constructor Create;
298
 
    destructor Destroy; override;
299
 
    function GetComponents(RootComponent: TComponent; AddRoot: boolean = true): TFPList;
300
 
    property Children: TFPList read FChildren;
301
 
    property Root: TComponent read FRoot;
302
 
  end;
303
 
 
304
 
 
305
 
function ComparePointerToPointerItems(Data1, Data2: Pointer): integer;
306
 
function ComparePointerAndP2PItem(Key, Data: Pointer): integer;
307
 
 
308
 
// case sensitive
309
 
function CompareStringToStringItems(Data1, Data2: Pointer): integer;
310
 
function CompareStringAndStringToStringTreeItem(Key, Data: Pointer): integer;
311
 
function CompareIdentifierAndStringToStringTreeItem(Identifier, Data: Pointer): integer;
312
 
function CompareIdentifierPrefixAndStringToStringTreeItem(Identifier, Data: Pointer): integer;
313
 
 
314
 
// case insensitive
315
 
function CompareStringToStringItemsI(Data1, Data2: Pointer): integer;
316
 
function CompareStringAndStringToStringTreeItemI(Key, Data: Pointer): integer;
317
 
function CompareIdentifierAndStringToStringTreeItemI(Identifier, Data: Pointer): integer;
318
 
function CompareIdentifierPrefixAndStringToStringTreeItemI(Identifier, Data: Pointer): integer;
319
 
 
320
 
function CompareFilenameToStringItems(Data1, Data2: Pointer): integer;
321
 
function CompareFilenameAndFilenameToStringTreeItem(Key, Data: Pointer): integer;
322
 
 
323
 
function CompareFilenameToStringItemsI(Data1, Data2: Pointer): integer;
324
 
function CompareFilenameAndFilenameToStringTreeItemI(Key, Data: Pointer): integer;
325
 
 
326
 
function CompareAnsiStringPtrs(Data1, Data2: Pointer): integer;
327
 
 
328
 
{$IF FPC_FULLVERSION<20701}
329
 
  {$DEFINE EnableAVLFindPointerFix}
330
 
{$ENDIF}
331
 
function AVLFindPointer(Tree: TAVLTree; Data: Pointer): TAVLTreeNode; {$IFNDEF EnableAVLFindPointerFix}inline;{$ENDIF}
332
 
procedure AVLRemovePointer(Tree: TAVLTree; Data: Pointer); {$IFNDEF EnableAVLFindPointerFix}inline;{$ENDIF}
333
 
 
334
 
implementation
335
 
 
336
 
function ComparePointerToPointerItems(Data1, Data2: Pointer): integer;
337
 
var
338
 
  P2PItem1: PPointerToPointerItem absolute Data1;
339
 
  P2PItem2: PPointerToPointerItem absolute Data2;
340
 
begin
341
 
  Result:=ComparePointers(P2PItem1^.Key,P2PItem2^.Key);
342
 
end;
343
 
 
344
 
function ComparePointerAndP2PItem(Key, Data: Pointer): integer;
345
 
var
346
 
  P2PItem: PPointerToPointerItem absolute Data;
347
 
begin
348
 
  Result:=ComparePointers(Key,P2PItem^.Key);
349
 
end;
350
 
 
351
 
function CompareStringToStringItems(Data1, Data2: Pointer): integer;
352
 
begin
353
 
  Result:=CompareStr(PStringToStringTreeItem(Data1)^.Name,
354
 
                     PStringToStringTreeItem(Data2)^.Name);
355
 
end;
356
 
 
357
 
function CompareStringToStringItemsI(Data1, Data2: Pointer): integer;
358
 
begin
359
 
  Result:=CompareText(PStringToStringTreeItem(Data1)^.Name,
360
 
                      PStringToStringTreeItem(Data2)^.Name);
361
 
end;
362
 
 
363
 
function CompareFilenameToStringItems(Data1, Data2: Pointer): integer;
364
 
begin
365
 
  Result:=CompareFilenames(PStringToStringTreeItem(Data1)^.Name,
366
 
                           PStringToStringTreeItem(Data2)^.Name);
367
 
end;
368
 
 
369
 
function CompareStringAndStringToStringTreeItem(Key, Data: Pointer): integer;
370
 
begin
371
 
  Result:=CompareStr(String(Key),PStringToStringTreeItem(Data)^.Name);
372
 
end;
373
 
 
374
 
function CompareIdentifierAndStringToStringTreeItem(Identifier, Data: Pointer
375
 
  ): integer;
376
 
var
377
 
  Id: PChar absolute Identifier;
378
 
  Item: PStringToStringTreeItem absolute Data;
379
 
  IdLen: LongInt;
380
 
  ItemLen: PtrInt;
381
 
begin
382
 
  Result:=-CompareIdentifiersCaseSensitive(Id,PChar(Item^.Name));
383
 
  if Result=0 then begin
384
 
    IdLen:=GetIdentLen(Id);
385
 
    ItemLen:=length(Item^.Name);
386
 
    if IdLen=Itemlen then
387
 
      Result:=0
388
 
    else if IdLen>ItemLen then
389
 
      Result:=1
390
 
    else
391
 
      Result:=-1;
392
 
  end;
393
 
end;
394
 
 
395
 
function CompareIdentifierPrefixAndStringToStringTreeItem(Identifier,
396
 
  Data: Pointer): integer;
397
 
var
398
 
  Id: PChar absolute Identifier;
399
 
  Item: PStringToStringTreeItem absolute Data;
400
 
begin
401
 
  Result:=-CompareIdentifiersCaseSensitive(Id,PChar(Item^.Name));
402
 
end;
403
 
 
404
 
function CompareStringAndStringToStringTreeItemI(Key, Data: Pointer): integer;
405
 
begin
406
 
  Result:=CompareText(String(Key),PStringToStringTreeItem(Data)^.Name);
407
 
end;
408
 
 
409
 
function CompareIdentifierAndStringToStringTreeItemI(Identifier, Data: Pointer
410
 
  ): integer;
411
 
var
412
 
  Id: PChar absolute Identifier;
413
 
  Item: PStringToStringTreeItem absolute Data;
414
 
  IdLen: LongInt;
415
 
  ItemLen: PtrInt;
416
 
begin
417
 
  Result:=-CompareIdentifiers(Id,PChar(Item^.Name));
418
 
  if Result=0 then begin
419
 
    IdLen:=GetIdentLen(Id);
420
 
    ItemLen:=length(Item^.Name);
421
 
    if IdLen=Itemlen then
422
 
      Result:=0
423
 
    else if IdLen>ItemLen then
424
 
      Result:=1
425
 
    else
426
 
      Result:=-1;
427
 
  end;
428
 
end;
429
 
 
430
 
function CompareIdentifierPrefixAndStringToStringTreeItemI(Identifier,
431
 
  Data: Pointer): integer;
432
 
var
433
 
  Id: PChar absolute Identifier;
434
 
  Item: PStringToStringTreeItem absolute Data;
435
 
begin
436
 
  Result:=-CompareIdentifiers(Id,PChar(Item^.Name));
437
 
end;
438
 
 
439
 
function CompareFilenameAndFilenameToStringTreeItem(Key, Data: Pointer
440
 
  ): integer;
441
 
begin
442
 
  Result:=CompareFilenames(String(Key),PStringToStringTreeItem(Data)^.Name);
443
 
end;
444
 
 
445
 
function CompareFilenameToStringItemsI(Data1, Data2: Pointer): integer;
446
 
begin
447
 
  Result:=CompareFilenamesIgnoreCase(PStringToStringTreeItem(Data1)^.Name,
448
 
                                     PStringToStringTreeItem(Data2)^.Name);
449
 
end;
450
 
 
451
 
function CompareFilenameAndFilenameToStringTreeItemI(Key, Data: Pointer
452
 
  ): integer;
453
 
begin
454
 
  Result:=CompareFilenamesIgnoreCase(String(Key),
455
 
                                     PStringToStringTreeItem(Data)^.Name);
456
 
end;
457
 
 
458
 
function CompareAnsiStringPtrs(Data1, Data2: Pointer): integer;
459
 
begin
460
 
  Result:=CompareStr(AnsiString(Data1),AnsiString(Data2));
461
 
end;
462
 
 
463
 
function AVLFindPointer(Tree: TAVLTree; Data: Pointer): TAVLTreeNode;
464
 
begin
465
 
  {$IFDEF EnableAVLFindPointerFix}
466
 
  Result:=Tree.FindLeftMost(Data);
467
 
  while (Result<>nil) do begin
468
 
    if Result.Data=Data then break;
469
 
    Result:=Tree.FindSuccessor(Result);
470
 
    if Result=nil then exit;
471
 
    if Tree.OnCompare(Data,Result.Data)<>0 then exit(nil);
472
 
  end;
473
 
  {$ELSE}
474
 
  Result:=Tree.FindPointer(Data);
475
 
  {$ENDIF}
476
 
end;
477
 
 
478
 
procedure AVLRemovePointer(Tree: TAVLTree; Data: Pointer);
479
 
{$IFDEF EnableAVLFindPointerFix}
480
 
var
481
 
  Node: TAVLTreeNode;
482
 
{$ENDIF}
483
 
begin
484
 
  {$IFDEF EnableAVLFindPointerFix}
485
 
  Node:=AVLFindPointer(Tree,Data);
486
 
  if Node<>nil then
487
 
    Tree.Delete(Node);
488
 
  {$ELSE}
489
 
  Tree.RemovePointer(Data);
490
 
  {$ENDIF}
491
 
end;
492
 
 
493
 
{ TPointerToPointerTree }
494
 
 
495
 
function TPointerToPointerTree.GetItems(Key: Pointer): Pointer;
496
 
var
497
 
  Node: TAVLTreeNode;
498
 
begin
499
 
  Node:=FindNode(Key);
500
 
  if Node<>nil then
501
 
    Result:=PPointerToPointerItem(Node.Data)^.Value
502
 
  else
503
 
    Result:=nil;
504
 
end;
505
 
 
506
 
procedure TPointerToPointerTree.SetItems(Key: Pointer; AValue: Pointer);
507
 
var
508
 
  Node: TAVLTreeNode;
509
 
  NewItem: PPointerToPointerItem;
510
 
begin
511
 
  Node:=FindNode(Key);
512
 
  if Node<>nil then begin
513
 
    PPointerToPointerItem(Node.Data)^.Value:=AValue;
514
 
  end else begin
515
 
    New(NewItem);
516
 
    NewItem^.Key:=Key;
517
 
    NewItem^.Value:=AValue;
518
 
    FTree.Add(NewItem);
519
 
  end;
520
 
end;
521
 
 
522
 
procedure TPointerToPointerTree.DisposeItem(p: PPointerToPointerItem);
523
 
begin
524
 
  Dispose(p);
525
 
end;
526
 
 
527
 
constructor TPointerToPointerTree.Create;
528
 
begin
529
 
  FTree:=TMTAVLTree.Create(@ComparePointerToPointerItems);
530
 
end;
531
 
 
532
 
destructor TPointerToPointerTree.Destroy;
533
 
begin
534
 
  Clear;
535
 
  FreeAndNil(FTree);
536
 
  inherited Destroy;
537
 
end;
538
 
 
539
 
procedure TPointerToPointerTree.Clear;
540
 
var
541
 
  Node: TAVLTreeNode;
542
 
begin
543
 
  Node:=FTree.FindLowest;
544
 
  while Node<>nil do begin
545
 
    DisposeItem(PPointerToPointerItem(Node.Data));
546
 
    Node:=FTree.FindSuccessor(Node);
547
 
  end;
548
 
  FTree.Clear;
549
 
end;
550
 
 
551
 
function TPointerToPointerTree.Contains(Key: Pointer): boolean;
552
 
begin
553
 
  Result:=FindNode(Key)<>nil;
554
 
end;
555
 
 
556
 
procedure TPointerToPointerTree.Remove(Key: Pointer);
557
 
var
558
 
  Node: TAVLTreeNode;
559
 
  Item: PPointerToPointerItem;
560
 
begin
561
 
  Node:=FindNode(Key);
562
 
  if Node<>nil then begin
563
 
    Item:=PPointerToPointerItem(Node.Data);
564
 
    FTree.Delete(Node);
565
 
    DisposeItem(Item);
566
 
  end;
567
 
end;
568
 
 
569
 
function TPointerToPointerTree.GetNodeData(AVLNode: TAVLTreeNode
570
 
  ): PPointerToPointerItem;
571
 
begin
572
 
  Result:=PPointerToPointerItem(AVLNode.Data);
573
 
end;
574
 
 
575
 
function TPointerToPointerTree.Count: integer;
576
 
begin
577
 
  Result:=FTree.Count;
578
 
end;
579
 
 
580
 
function TPointerToPointerTree.FindNode(Key: Pointer): TAVLTreeNode;
581
 
begin
582
 
  Result:=FTree.FindKey(Key,@ComparePointerAndP2PItem);
583
 
end;
584
 
 
585
 
procedure TPointerToPointerTree.Add(Key, Value: Pointer);
586
 
begin
587
 
  Items[Key]:=Value;
588
 
end;
589
 
 
590
 
{ TMTAVLTree }
591
 
 
592
 
constructor TMTAVLTree.Create(OnCompareMethod: TListSortCompare);
593
 
begin
594
 
  inherited Create(OnCompareMethod);
595
 
  fNodeManager:=TMTAVLTreeNodeMemManager.Create;
596
 
  SetNodeManager(fNodeManager);
597
 
end;
598
 
 
599
 
destructor TMTAVLTree.Destroy;
600
 
begin
601
 
  inherited Destroy;
602
 
  FreeAndNil(fNodeManager);
603
 
end;
604
 
 
605
 
{ TMTAVLTreeNodeMemManager }
606
 
 
607
 
procedure TMTAVLTreeNodeMemManager.DisposeNode(ANode: TAVLTreeNode);
608
 
begin
609
 
  ANode.Free;
610
 
end;
611
 
 
612
 
function TMTAVLTreeNodeMemManager.NewNode: TAVLTreeNode;
613
 
begin
614
 
  Result:=TAVLTreeNode.Create;
615
 
end;
616
 
 
617
 
{ TFilenameToPointerTree }
618
 
 
619
 
constructor TFilenameToPointerTree.Create(CaseInsensitive: boolean);
620
 
begin
621
 
  inherited Create(true);
622
 
  if CaseInsensitive then
623
 
    SetCompareFuncs(@CompareFilenameToStringItemsI,
624
 
                    @CompareFilenameAndFilenameToStringTreeItemI)
625
 
  else
626
 
    SetCompareFuncs(@CompareFilenameToStringItems,
627
 
                    @CompareFilenameAndFilenameToStringTreeItem);
628
 
end;
629
 
 
630
 
{ TStringToPointerTree }
631
 
 
632
 
function TStringToPointerTree.GetItems(const s: string): Pointer;
633
 
var
634
 
  Node: TAVLTreeNode;
635
 
begin
636
 
  Node:=FindNode(s);
637
 
  if Node<>nil then
638
 
    Result:=PStringToPointerTreeItem(Node.Data)^.Value
639
 
  else
640
 
    Result:=nil;
641
 
end;
642
 
 
643
 
procedure TStringToPointerTree.SetItems(const s: string; AValue: Pointer);
644
 
var
645
 
  Node: TAVLTreeNode;
646
 
  NewItem: PStringToPointerTreeItem;
647
 
begin
648
 
  Node:=FindNode(s);
649
 
  if Node<>nil then begin
650
 
    NewItem:=PStringToPointerTreeItem(Node.Data);
651
 
    if FreeValues then
652
 
      TObject(NewItem^.Value).Free;
653
 
    NewItem^.Value:=AValue;
654
 
  end else begin
655
 
    New(NewItem);
656
 
    NewItem^.Name:=s;
657
 
    NewItem^.Value:=AValue;
658
 
    FTree.Add(NewItem);
659
 
  end;
660
 
end;
661
 
 
662
 
procedure TStringToPointerTree.DisposeItem(p: PStringMapItem);
663
 
var
664
 
  Item: PStringToPointerTreeItem absolute p;
665
 
begin
666
 
  if FreeValues then
667
 
    TObject(Item^.Value).Free;
668
 
  Dispose(Item);
669
 
end;
670
 
 
671
 
function TStringToPointerTree.ItemsAreEqual(p1, p2: PStringMapItem): boolean;
672
 
var
673
 
  Item1: PStringToPointerTreeItem absolute p1;
674
 
  Item2: PStringToPointerTreeItem absolute p2;
675
 
begin
676
 
  Result:=(Item1^.Name=Item2^.Name)
677
 
      and (Item1^.Value=Item2^.Value);
678
 
end;
679
 
 
680
 
function TStringToPointerTree.CreateCopy(Src: PStringMapItem): PStringMapItem;
681
 
var
682
 
  SrcItem: PStringToPointerTreeItem absolute Src;
683
 
  NewItem: PStringToPointerTreeItem;
684
 
begin
685
 
  New(NewItem);
686
 
  NewItem^.Name:=SrcItem^.Name;
687
 
  NewItem^.Value:=SrcItem^.Value;
688
 
  Result:=PStringMapItem(NewItem);
689
 
end;
690
 
 
691
 
function TStringToPointerTree.GetItem(const Name: string; out Value: Pointer
692
 
  ): boolean;
693
 
var
694
 
  Node: TAVLTreeNode;
695
 
begin
696
 
  Node:=FindNode(Name);
697
 
  if Node<>nil then begin
698
 
    Value:=PStringToPointerTreeItem(Node.Data)^.Value;
699
 
    Result:=true;
700
 
  end else begin
701
 
    Result:=false;
702
 
  end;
703
 
end;
704
 
 
705
 
procedure TStringToPointerTree.Add(const Name: string; const Value: Pointer);
706
 
begin
707
 
  Items[Name]:=Value;
708
 
end;
709
 
 
710
 
function TStringToPointerTree.GetNodeData(AVLNode: TAVLTreeNode
711
 
  ): PStringToPointerTreeItem;
712
 
begin
713
 
  Result:=PStringToPointerTreeItem(AVLNode.Data);
714
 
end;
715
 
 
716
 
procedure TStringToPointerTree.Assign(Source: TStringMap);
717
 
var
718
 
  Node: TAVLTreeNode;
719
 
  Item: PStringToPointerTreeItem;
720
 
begin
721
 
  if (Source=nil) or (Source.ClassType<>ClassType) then
722
 
    raise Exception.Create('invalid class');
723
 
  Clear;
724
 
  Node:=Source.Tree.FindLowest;
725
 
  while Node<>nil do begin
726
 
    Item:=PStringToPointerTreeItem(Node.Data);
727
 
    Items[Item^.Name]:=Item^.Value;
728
 
    Node:=Source.Tree.FindSuccessor(Node);
729
 
  end;
730
 
end;
731
 
 
732
 
function TStringToPointerTree.GetEnumerator: TStringToPointerTreeEnumerator;
733
 
begin
734
 
  Result:=TStringToPointerTreeEnumerator.Create(FTree);
735
 
end;
736
 
 
737
 
{ TStringMapEnumerator }
738
 
 
739
 
constructor TStringMapEnumerator.Create(Tree: TAVLTree);
740
 
begin
741
 
  FTree:=Tree;
742
 
end;
743
 
 
744
 
function TStringMapEnumerator.MoveNext: boolean;
745
 
begin
746
 
  if FCurrent=nil then
747
 
    FCurrent:=FTree.FindLowest
748
 
  else
749
 
    FCurrent:=FTree.FindSuccessor(FCurrent);
750
 
  Result:=FCurrent<>nil;
751
 
end;
752
 
 
753
 
{ TStringToPointerTreeEnumerator }
754
 
 
755
 
function TStringToPointerTreeEnumerator.GetCurrent: PStringToPointerTreeItem;
756
 
begin
757
 
  Result:=PStringToPointerTreeItem(FCurrent.Data);
758
 
end;
759
 
 
760
 
{ TStringMap }
761
 
 
762
 
function TStringMap.GetCompareItemsFunc: TListSortCompare;
763
 
begin
764
 
  Result:=Tree.OnCompare;
765
 
end;
766
 
 
767
 
function TStringMap.FindNode(const s: string): TAVLTreeNode;
768
 
begin
769
 
  Result:=FTree.FindKey(Pointer(s),FCompareKeyItemFunc);
770
 
end;
771
 
 
772
 
procedure TStringMap.DisposeItem(p: PStringMapItem);
773
 
begin
774
 
  Dispose(p);
775
 
end;
776
 
 
777
 
function TStringMap.ItemsAreEqual(p1, p2: PStringMapItem): boolean;
778
 
begin
779
 
  Result:=p1^.Name=p2^.Name;
780
 
end;
781
 
 
782
 
function TStringMap.CreateCopy(Src: PStringMapItem): PStringMapItem;
783
 
begin
784
 
  New(Result);
785
 
  Result^.Name:=Src^.Name;
786
 
end;
787
 
 
788
 
constructor TStringMap.Create(TheCaseSensitive: boolean);
789
 
begin
790
 
  FCaseSensitive:=TheCaseSensitive;
791
 
  if CaseSensitive then begin
792
 
    FCompareKeyItemFunc:=@CompareStringAndStringToStringTreeItem;
793
 
    FTree:=TMTAVLTree.Create(@CompareStringToStringItems);
794
 
  end else begin
795
 
    FCompareKeyItemFunc:=@CompareStringAndStringToStringTreeItemI;
796
 
    FTree:=TMTAVLTree.Create(@CompareStringToStringItemsI);
797
 
  end;
798
 
end;
799
 
 
800
 
destructor TStringMap.Destroy;
801
 
begin
802
 
  Clear;
803
 
  FTree.Free;
804
 
  FTree:=nil;
805
 
  inherited Destroy;
806
 
end;
807
 
 
808
 
procedure TStringMap.Clear;
809
 
var
810
 
  Node: TAVLTreeNode;
811
 
begin
812
 
  Node:=FTree.FindLowest;
813
 
  while Node<>nil do begin
814
 
    DisposeItem(PStringMapItem(Node.Data));
815
 
    Node:=FTree.FindSuccessor(Node);
816
 
  end;
817
 
  FTree.Clear;
818
 
end;
819
 
 
820
 
function TStringMap.Contains(const s: string): boolean;
821
 
begin
822
 
  Result:=FindNode(s)<>nil;
823
 
end;
824
 
 
825
 
function TStringMap.ContainsIdentifier(P: PChar): boolean;
826
 
begin
827
 
  if CaseSensitive then
828
 
    Result:=FTree.FindKey(p,@CompareIdentifierAndStringToStringTreeItem)<>nil
829
 
  else
830
 
    Result:=FTree.FindKey(p,@CompareIdentifierAndStringToStringTreeItemI)<>nil;
831
 
end;
832
 
 
833
 
function TStringMap.FindNodeWithIdentifierAsPrefix(P: PChar): TAVLTreeNode;
834
 
begin
835
 
  if CaseSensitive then
836
 
    Result:=FTree.FindKey(p,@CompareIdentifierPrefixAndStringToStringTreeItem)
837
 
  else
838
 
    Result:=FTree.FindKey(p,@CompareIdentifierPrefixAndStringToStringTreeItemI);
839
 
end;
840
 
 
841
 
procedure TStringMap.GetNames(List: TStrings);
842
 
var
843
 
  Node: TAVLTreeNode;
844
 
  Item: PStringMapItem;
845
 
begin
846
 
  Node:=Tree.FindLowest;
847
 
  while Node<>nil do begin
848
 
    Item:=PStringMapItem(Node.Data);
849
 
    List.Add(Item^.Name);
850
 
    Node:=Tree.FindSuccessor(Node);
851
 
  end;
852
 
end;
853
 
 
854
 
procedure TStringMap.Remove(const Name: string);
855
 
var
856
 
  Node: TAVLTreeNode;
857
 
  Item: PStringMapItem;
858
 
begin
859
 
  Node:=FindNode(Name);
860
 
  if Node<>nil then begin
861
 
    Item:=PStringMapItem(Node.Data);
862
 
    FTree.Delete(Node);
863
 
    DisposeItem(Item);
864
 
  end;
865
 
end;
866
 
 
867
 
function TStringMap.GetNodeData(AVLNode: TAVLTreeNode): PStringMapItem;
868
 
begin
869
 
  Result:=PStringMapItem(AVLNode.Data);
870
 
end;
871
 
 
872
 
function TStringMap.Count: integer;
873
 
begin
874
 
  Result:=Tree.Count;
875
 
end;
876
 
 
877
 
function TStringMap.Equals(OtherTree: TStringMap): boolean;
878
 
var
879
 
  Node: TAVLTreeNode;
880
 
  OtherNode: TAVLTreeNode;
881
 
  OtherItem: PStringMapItem;
882
 
  Item: PStringMapItem;
883
 
begin
884
 
  Result:=false;
885
 
  if (OtherTree=nil) or (OtherTree.ClassType<>ClassType) then exit;
886
 
  if Tree.Count<>OtherTree.Tree.Count then exit;
887
 
  Node:=Tree.FindLowest;
888
 
  OtherNode:=OtherTree.Tree.FindLowest;
889
 
  while Node<>nil do begin
890
 
    if OtherNode=nil then exit;
891
 
    Item:=PStringMapItem(Node.Data);
892
 
    OtherItem:=PStringMapItem(OtherNode.Data);
893
 
    if not ItemsAreEqual(Item,OtherItem) then exit;
894
 
    OtherNode:=OtherTree.Tree.FindSuccessor(OtherNode);
895
 
    Node:=Tree.FindSuccessor(Node);
896
 
  end;
897
 
  if OtherNode<>nil then exit;
898
 
  Result:=true;
899
 
end;
900
 
 
901
 
procedure TStringMap.Assign(Source: TStringMap);
902
 
var
903
 
  SrcNode: TAVLTreeNode;
904
 
  SrcItem: PStringMapItem;
905
 
begin
906
 
  if (Source=nil) or (Source.ClassType<>ClassType) then
907
 
    raise Exception.Create('invalid class');
908
 
  Clear;
909
 
  SrcNode:=Source.Tree.FindLowest;
910
 
  while SrcNode<>nil do begin
911
 
    SrcItem:=PStringMapItem(SrcNode.Data);
912
 
    Tree.Add(CreateCopy(SrcItem));
913
 
    SrcNode:=Source.Tree.FindSuccessor(SrcNode);
914
 
  end;
915
 
end;
916
 
 
917
 
procedure TStringMap.WriteDebugReport;
918
 
var
919
 
  Node: TAVLTreeNode;
920
 
  Item: PStringMapItem;
921
 
begin
922
 
  DebugLn(['TStringMap.WriteDebugReport ',Tree.Count]);
923
 
  Node:=Tree.FindLowest;
924
 
  while Node<>nil do begin
925
 
    Item:=PStringMapItem(Node.Data);
926
 
    DebugLn([Item^.Name]);
927
 
    Node:=Tree.FindSuccessor(Node);
928
 
  end;
929
 
end;
930
 
 
931
 
function TStringMap.CalcMemSize: PtrUint;
932
 
var
933
 
  Node: TAVLTreeNode;
934
 
  Item: PStringMapItem;
935
 
begin
936
 
  Result:=PtrUInt(InstanceSize)
937
 
    +PtrUInt(FTree.InstanceSize)
938
 
    +PtrUint(FTree.Count)*SizeOf(TAVLTreeNode);
939
 
  Node:=FTree.FindLowest;
940
 
  while Node<>nil do begin
941
 
    Item:=PStringMapItem(Node.Data);
942
 
    inc(Result,MemSizeString(Item^.Name)
943
 
       +SizeOf(TStringMapItem));
944
 
    Node:=FTree.FindSuccessor(Node);
945
 
  end;
946
 
end;
947
 
 
948
 
procedure TStringMap.SetCompareFuncs(const NewCompareItemsFunc,
949
 
  NewCompareKeyItemFunc: TListSortCompare);
950
 
begin
951
 
  FCompareKeyItemFunc:=NewCompareKeyItemFunc;
952
 
  Tree.OnCompare:=NewCompareItemsFunc;
953
 
end;
954
 
 
955
 
{ TStringToStringTreeEnumerator }
956
 
 
957
 
function TStringToStringTreeEnumerator.GetCurrent: PStringToStringTreeItem;
958
 
begin
959
 
  Result:=PStringToStringTreeItem(FCurrent.Data);
960
 
end;
961
 
 
962
 
{ TStringTreeEnumerator }
963
 
 
964
 
function TStringTreeEnumerator.GetCurrent: string;
965
 
begin
966
 
  Result:=AnsiString(FCurrent.Data);
967
 
end;
968
 
 
969
 
constructor TStringTreeEnumerator.Create(Tree: TStringTree);
970
 
begin
971
 
  FTree:=Tree;
972
 
end;
973
 
 
974
 
function TStringTreeEnumerator.MoveNext: boolean;
975
 
begin
976
 
  if FCurrent=nil then
977
 
    FCurrent:=FTree.Tree.FindLowest
978
 
  else
979
 
    FCurrent:=FTree.Tree.FindSuccessor(FCurrent);
980
 
  Result:=FCurrent<>nil;
981
 
end;
982
 
 
983
 
{ TStringToStringTree }
984
 
 
985
 
function TStringToStringTree.GetStrings(const s: string): string;
986
 
var
987
 
  Node: TAVLTreeNode;
988
 
begin
989
 
  Node:=FindNode(s);
990
 
  if Node<>nil then
991
 
    Result:=PStringToStringTreeItem(Node.Data)^.Value
992
 
  else
993
 
    Result:='';
994
 
end;
995
 
 
996
 
procedure TStringToStringTree.SetStrings(const s: string; const AValue: string);
997
 
var
998
 
  Node: TAVLTreeNode;
999
 
  NewItem: PStringToStringTreeItem;
1000
 
begin
1001
 
  Node:=FindNode(s);
1002
 
  if Node<>nil then begin
1003
 
    PStringToStringTreeItem(Node.Data)^.Value:=AValue;
1004
 
  end else begin
1005
 
    New(NewItem);
1006
 
    NewItem^.Name:=s;
1007
 
    NewItem^.Value:=AValue;
1008
 
    FTree.Add(NewItem);
1009
 
  end;
1010
 
end;
1011
 
 
1012
 
procedure TStringToStringTree.DisposeItem(p: PStringMapItem);
1013
 
var
1014
 
  Item: PStringToStringTreeItem absolute p;
1015
 
begin
1016
 
  Dispose(Item);
1017
 
end;
1018
 
 
1019
 
function TStringToStringTree.ItemsAreEqual(p1, p2: PStringMapItem): boolean;
1020
 
var
1021
 
  Item1: PStringToStringTreeItem absolute p1;
1022
 
  Item2: PStringToStringTreeItem absolute p2;
1023
 
begin
1024
 
  Result:=(Item1^.Name=Item2^.Name)
1025
 
      and (Item1^.Value=Item2^.Value);
1026
 
end;
1027
 
 
1028
 
function TStringToStringTree.CreateCopy(Src: PStringMapItem): PStringMapItem;
1029
 
var
1030
 
  SrcItem: PStringToStringTreeItem absolute Src;
1031
 
  NewItem: PStringToStringTreeItem;
1032
 
begin
1033
 
  New(NewItem);
1034
 
  NewItem^.Name:=SrcItem^.Name;
1035
 
  NewItem^.Value:=SrcItem^.Value;
1036
 
  Result:=PStringMapItem(NewItem);
1037
 
end;
1038
 
 
1039
 
function TStringToStringTree.GetString(const Name: string; out Value: string
1040
 
  ): boolean;
1041
 
var
1042
 
  Node: TAVLTreeNode;
1043
 
begin
1044
 
  Node:=FindNode(Name);
1045
 
  if Node<>nil then begin
1046
 
    Value:=PStringToStringTreeItem(Node.Data)^.Value;
1047
 
    Result:=true;
1048
 
  end else begin
1049
 
    Result:=false;
1050
 
  end;
1051
 
end;
1052
 
 
1053
 
procedure TStringToStringTree.Add(const Name, Value: string);
1054
 
begin
1055
 
  Strings[Name]:=Value;
1056
 
end;
1057
 
 
1058
 
function TStringToStringTree.GetNodeData(AVLNode: TAVLTreeNode
1059
 
  ): PStringToStringTreeItem;
1060
 
begin
1061
 
  Result:=PStringToStringTreeItem(AVLNode.Data);
1062
 
end;
1063
 
 
1064
 
function TStringToStringTree.AsText: string;
1065
 
var
1066
 
  Node: TAVLTreeNode;
1067
 
  Item: PStringToStringTreeItem;
1068
 
begin
1069
 
  Result:='';
1070
 
  Node:=Tree.FindLowest;
1071
 
  while Node<>nil do begin
1072
 
    Item:=PStringToStringTreeItem(Node.Data);
1073
 
    Result:=Result+Item^.Name+'='+Item^.Value+LineEnding;
1074
 
    Node:=Tree.FindSuccessor(Node);
1075
 
  end;
1076
 
end;
1077
 
 
1078
 
procedure TStringToStringTree.WriteDebugReport;
1079
 
var
1080
 
  Node: TAVLTreeNode;
1081
 
  Item: PStringToStringTreeItem;
1082
 
begin
1083
 
  DebugLn(['TStringToStringTree.WriteDebugReport ',Tree.Count]);
1084
 
  Node:=Tree.FindLowest;
1085
 
  while Node<>nil do begin
1086
 
    Item:=PStringToStringTreeItem(Node.Data);
1087
 
    DebugLn([Item^.Name,'=',Item^.Value]);
1088
 
    Node:=Tree.FindSuccessor(Node);
1089
 
  end;
1090
 
end;
1091
 
 
1092
 
function TStringToStringTree.CalcMemSize: PtrUint;
1093
 
var
1094
 
  Node: TAVLTreeNode;
1095
 
  Item: PStringToStringTreeItem;
1096
 
begin
1097
 
  Result:=PtrUInt(InstanceSize)
1098
 
    +PtrUInt(FTree.InstanceSize)
1099
 
    +PtrUint(FTree.Count)*SizeOf(TAVLTreeNode);
1100
 
  Node:=FTree.FindLowest;
1101
 
  while Node<>nil do begin
1102
 
    Item:=PStringToStringTreeItem(Node.Data);
1103
 
    inc(Result,MemSizeString(Item^.Name)
1104
 
       +MemSizeString(Item^.Value)
1105
 
       +SizeOf(TStringToStringTreeItem));
1106
 
    Node:=FTree.FindSuccessor(Node);
1107
 
  end;
1108
 
end;
1109
 
 
1110
 
function TStringToStringTree.GetEnumerator: TStringToStringTreeEnumerator;
1111
 
begin
1112
 
  Result:=TStringToStringTreeEnumerator.Create(FTree);
1113
 
end;
1114
 
 
1115
 
{ TFilenameToStringTree }
1116
 
 
1117
 
constructor TFilenameToStringTree.Create(CaseInsensitive: boolean);
1118
 
begin
1119
 
  inherited Create(true);
1120
 
  if CaseInsensitive then
1121
 
    SetCompareFuncs(@CompareFilenameToStringItemsI,
1122
 
                    @CompareFilenameAndFilenameToStringTreeItemI)
1123
 
  else
1124
 
    SetCompareFuncs(@CompareFilenameToStringItems,
1125
 
                    @CompareFilenameAndFilenameToStringTreeItem);
1126
 
end;
1127
 
 
1128
 
{ TStringTree }
1129
 
 
1130
 
constructor TStringTree.Create;
1131
 
begin
1132
 
  Tree:=TMTAVLTree.Create(@CompareAnsiStringPtrs);
1133
 
end;
1134
 
 
1135
 
destructor TStringTree.Destroy;
1136
 
begin
1137
 
  Clear;
1138
 
  FreeAndNil(Tree);
1139
 
  inherited Destroy;
1140
 
end;
1141
 
 
1142
 
procedure TStringTree.Clear;
1143
 
var
1144
 
  Node: TAVLTreeNode;
1145
 
begin
1146
 
  Node:=Tree.FindLowest;
1147
 
  while Node<>nil do begin
1148
 
    AnsiString(Node.Data):='';
1149
 
    Node:=Tree.FindSuccessor(Node);
1150
 
  end;
1151
 
  Tree.Clear;
1152
 
end;
1153
 
 
1154
 
function TStringTree.FindNode(const s: string): TAVLTreeNode;
1155
 
begin
1156
 
  Result:=Tree.Find(Pointer(s));
1157
 
end;
1158
 
 
1159
 
procedure TStringTree.ReplaceString(var s: string);
1160
 
var
1161
 
  Node: TAVLTreeNode;
1162
 
  h: String;
1163
 
begin
1164
 
  if GetStringRefCount(s)<=0 then exit;
1165
 
  Node:=FindNode(s);
1166
 
  if Node=nil then begin
1167
 
    // increase refcount
1168
 
    h:=s;
1169
 
    Tree.Add(Pointer(h));
1170
 
    Pointer(h):=nil; // keep refcount
1171
 
    //debugln(['TStringTree.ReplaceString new string: refcount=',GetStringRefCount(s)]);
1172
 
    //debugln(['TStringTree.ReplaceString NewString="',dbgstr(s),'"']);
1173
 
  end else begin
1174
 
    s:=AnsiString(Node.Data);
1175
 
    //debugln(['TStringTree.ReplaceString old string: refcount=',GetStringRefCount(s)]);
1176
 
    //debugln(['TStringTree.ReplaceString OldString="',dbgstr(s),'"']);
1177
 
  end;
1178
 
  //debugln(['TStringTree.ReplaceString ',GetStringRefCount(s),' ',Node<>nil]);
1179
 
end;
1180
 
 
1181
 
function TStringTree.CalcMemSize: PtrUInt;
1182
 
var
1183
 
  Node: TAVLTreeNode;
1184
 
begin
1185
 
  Result:=PtrUInt(InstanceSize)
1186
 
    +PtrUInt(Tree.InstanceSize)
1187
 
    +PtrUInt(TAVLTreeNode.InstanceSize)*PtrUInt(Tree.Count);
1188
 
  Node:=Tree.FindLowest;
1189
 
  while Node<>nil do begin
1190
 
    inc(Result,MemSizeString(AnsiString(Node.Data)));
1191
 
    Node:=Tree.FindSuccessor(Node);
1192
 
  end;
1193
 
end;
1194
 
 
1195
 
function TStringTree.GetEnumerator: TStringTreeEnumerator;
1196
 
begin
1197
 
  Result:=TStringTreeEnumerator.Create(Self);
1198
 
end;
1199
 
 
1200
 
{ TComponentChildCollector }
1201
 
 
1202
 
procedure TComponentChildCollector.AddChildComponent(Child: TComponent);
1203
 
var
1204
 
  OldRoot: TComponent;
1205
 
begin
1206
 
  //debugln(['TComponentChildCollector.AddChildComponent ',DbgSName(Child)]);
1207
 
  Children.Add(Child);
1208
 
  OldRoot := Root;
1209
 
  try
1210
 
    if csInline in Child.ComponentState then
1211
 
      FRoot := Child;
1212
 
    TCTComponentAccess(Child).GetChildren(@AddChildComponent,Root);
1213
 
  finally
1214
 
    FRoot := OldRoot;
1215
 
  end;
1216
 
end;
1217
 
 
1218
 
constructor TComponentChildCollector.Create;
1219
 
begin
1220
 
  FChildren:=TFPList.Create;
1221
 
end;
1222
 
 
1223
 
destructor TComponentChildCollector.Destroy;
1224
 
begin
1225
 
  FreeAndNil(FChildren);
1226
 
  inherited Destroy;
1227
 
end;
1228
 
 
1229
 
function TComponentChildCollector.GetComponents(RootComponent: TComponent;
1230
 
  AddRoot: boolean): TFPList;
1231
 
begin
1232
 
  Children.Clear;
1233
 
  if AddRoot then
1234
 
    Children.Add(RootComponent);
1235
 
  FRoot:=RootComponent;
1236
 
  TCTComponentAccess(RootComponent).GetChildren(@AddChildComponent,FRoot);
1237
 
  Result:=Children;
1238
 
end;
1239
 
 
1240
 
end.
1241