File: textstrings.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (871 lines) | stat: -rw-r--r-- 23,999 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
{
 /***************************************************************************
                                textstrings.pas
                                ---------------
                             Component Library Code

 ***************************************************************************/

 *****************************************************************************
  This file is part of LazUtils.

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************

  TTextStrings is a TStrings descendent that is optimized for handling the
  complete text as whole (instead of as line by line as in TStringList).

  TCustomMemoStrings is a TStrings descendent which works around the behavior
  of TMemo.Lines, which contains the text with wordwrap line endings, in order
  to store the text in the LFM without those wordwrap line endings. See bug 30659
}
unit TextStrings;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  // LazUtils
  LazUtf8Classes, LazUtilsStrConsts;

type
  { TTextStrings }

  TTextLineRange = record
    Line: string; // cached line as string
    TheObject: TObject; // user data
    StartPos: integer; // start of line in Text
    EndPos: integer; // end of line in Text (= start of newline character(s))
  end;
  PTextLineRange = ^TTextLineRange;

  TCustomMemoStrings = class(TStrings)
  protected
    procedure DoReadData(Reader: TReader); virtual;
    procedure DoWriteData(Writer: TWriter); virtual;
    procedure DefineProperties(Filer: TFiler); override;
  end;

  TTextStrings = class(TCustomMemoStrings)
  private
    FOnChange: TNotifyEvent;
    FOnChanging: TNotifyEvent;
  protected
    FArraysValid: boolean;
    FLineCount: integer;
    FLineCapacity: integer;
    FLineRanges: PTextLineRange;// array of TTextLineRange
    FText: string;
    FUpdateCount: integer;
    FChangedWhileUpdate: boolean;
    function GetTextStr: string; override;
    procedure SetTextStr(const AValue: string); override;
    procedure BuildArrays; virtual;
    function GetCount: Integer; override;
    procedure Changed; virtual;
    procedure Changing; virtual;
    function Get(Index: Integer): string; override;
    procedure ClearArrays;
    function GetObject(Index: Integer): TObject; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure PutObject(Index: Integer; AnObject: TObject); override;
    function GetLineLen(Index: integer; IncludeNewLineChars: boolean): integer; inline;
    function GetLineEnd(Index: integer; IncludeNewLineChars: boolean): integer;
    function CountLineEndings(const s: string): integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear; override;
    procedure SetText(TheText: PChar); override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure Delete(Index: Integer); override;
    procedure Exchange(Index1, Index2: Integer); override;
    procedure Move(CurIndex, NewIndex: Integer); override;
    procedure MakeTextBufferUnique;
    procedure BeginUpdate;
    procedure EndUpdate;
    function GetText: PChar; override;
    function IndexOf(const S: string): Integer; override;
    function Add(const S: string): Integer; override;
    function AddObject(const S: string; AObject: TObject): Integer; override;
    procedure AddStrings(TheStrings: TStrings); override;
    procedure LoadFromFile(const FileName: string); override;
    procedure SaveToFile(const FileName: string); override;
  public
    property Text: string read FText write SetTextStr;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
  end;

implementation

{ TCustomMemoStrings }

procedure TCustomMemoStrings.DoReadData(Reader: TReader);
begin
  Reader.ReadListBegin;
  BeginUpdate;
  try
    Clear;
    while not Reader.EndOfList do
      Add(Reader.ReadString);
  finally
    EndUpdate;
  end;
  Reader.ReadListEnd;
end;

procedure TCustomMemoStrings.DoWriteData(Writer: TWriter);
var
  i: Integer;
  lStringsNoWordWrap: TStringList;
begin
  lStringsNoWordWrap := TStringList.Create;
  try
    lStringsNoWordWrap.Text := Text;

    Writer.WriteListBegin;
    for i := 0 to lStringsNoWordWrap.Count - 1 do
      Writer.WriteString(lStringsNoWordWrap.Strings[i]);
    Writer.WriteListEnd;
  finally
    lStringsNoWordWrap.Free;
  end;
end;

procedure TCustomMemoStrings.DefineProperties(Filer: TFiler);
var
  HasData: Boolean;
begin
  HasData := Count > 0;
  Filer.DefineProperty('Strings', @DoReadData, @DoWriteData, HasData);
end;

{ TTextStrings }

function TTextStrings.GetTextStr: string;
begin
  Result:=FText;
end;

procedure TTextStrings.SetTextStr(const AValue: string);
begin
  if FText=AValue then exit;
  FText:=AValue;
  FArraysValid:=false;
end;

procedure TTextStrings.BuildArrays;
var
  p, line: integer;
  l: Integer;
  ArraySize: Integer;
begin
  if FArraysValid then exit;
  ClearArrays;
  FArraysValid:=true;
  // count line ends
  FLineCount:=CountLineEndings(FText);
  l:=length(FText);
  if (FText<>'') and (not (FText[l] in [#10,#13])) then
    inc(FLineCount);
  FLineCapacity:=FLineCount;
  // build line range list
  if FLineCount>0 then begin
    ArraySize:=FLineCount*SizeOf(TTextLineRange);
    GetMem(FLineRanges,ArraySize);
    FillByte(FLineRanges^,ArraySize,0);
    p:=1;
    line:=0;
    FLineRanges[line].StartPos:=1;
    FLineRanges[FLineCount-1].EndPos:=l+1;
    while (p<=l) do begin
      if (not (FText[p] in [#10,#13])) then begin
        inc(p);
      end else begin
        // new line
        FLineRanges[line].EndPos:=p;
        inc(line);
        inc(p);
        if (p<=l) and (FText[p] in [#10,#13])
        and (FText[p]<>FText[p-1]) then
          inc(p);
        if line<FLineCount then
          FLineRanges[line].StartPos:=p;
      end;
    end;
  end;
end;

function TTextStrings.GetCount: Integer;
begin
  if not FArraysValid then BuildArrays;
  Result:=FLineCount;
end;

procedure TTextStrings.Changed;
// called after text changed
begin
  if (FUpdateCount>0) then begin
    FChangedWhileUpdate:=true;
    exit;
  end;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TTextStrings.Changing;
begin
  if FUpdateCount=0 then
    if Assigned(FOnChanging) then
      FOnChanging(Self);
end;

function TTextStrings.Get(Index: Integer): string;
var
  Line: PTextLineRange;
begin
  if not FArraysValid then BuildArrays;
  if (Index<0) or (Index>=FLineCount) then
    Error(lrsListIndexExceedsBounds, Index);
  Line:=@FLineRanges[Index];
  if (Line^.Line='')
  and (Line^.StartPos<Line^.EndPos) then begin
    Line^.Line:=copy(FText,Line^.StartPos,Line^.EndPos-Line^.StartPos);
  end;
  Result:=Line^.Line;
end;

procedure TTextStrings.ClearArrays;
var
  i: Integer;
begin
  FArraysValid:=false;
  if FLineRanges<>nil then begin
    for i:=0 to FLineCount-1 do
      FLineRanges[i].Line:='';
    FreeMem(FLineRanges);
    FLineRanges:=nil;
  end;
  FLineCapacity:=0;
end;

function TTextStrings.GetObject(Index: Integer): TObject;
begin
  if FArraysValid then begin
    if (Index<0) or (Index>=FLineCount) then
      Error(lrsListIndexExceedsBounds, Index);
    Result:=FLineRanges[Index].TheObject;
  end else
    Result:=nil;
end;

procedure TTextStrings.Put(Index: Integer; const S: string);
var
  OldLineLen: Integer;
  NewLineLen: Integer;
  Movement: Integer;
  OldStartPos: LongInt;
  OldEndPos: LongInt;
  MoveLen: Integer;
  i: Integer;
  NewEndPos: Integer;
begin
  if not FArraysValid then BuildArrays;
  if (Index<0) or (Index>=FLineCount) then
    Error(lrsListIndexExceedsBounds, Index);
  OldStartPos:=FLineRanges[Index].StartPos;
  OldEndPos:=FLineRanges[Index].EndPos;
  NewLineLen:=length(s);
  OldLineLen:=OldEndPos-OldStartPos;
  Movement:=NewLineLen-OldLineLen;
  NewEndPos:=OldEndPos+Movement;
  // move text behind
  MoveLen := Length(FText) - OldEndPos + 1;
  if (Movement<>0) and (MoveLen>0) then
  begin
    if Movement > 0 then
      SetLength(FText, Length(FText) + Movement);
    System.Move(FText[OldEndPos], FText[NewEndPos], MoveLen);
    if Movement < 0 then
      SetLength(FText, Length(FText) + Movement);

    for i := Index + 1 to FLineCount - 1 do
    begin
      inc(FLineRanges[i].StartPos, Movement);
      inc(FLineRanges[i].EndPos, Movement);
    end;
  end;
  FLineRanges[Index].EndPos:=NewEndPos;
  // copy text
  if NewLineLen>0 then
    System.Move(S[1],FText[OldStartPos],NewLineLen);
  FLineRanges[Index].Line:=S;
  // check if arrays need rebuild
  i:=NewLineLen;
  while (i>0) and (not (S[i] in [#10,#13])) do dec(i);
  if i>0 then begin
    // S contains new line chars => rebuild needed
    FArraysValid:=false;
  end;
end;

procedure TTextStrings.PutObject(Index: Integer; AnObject: TObject);
begin
  if not FArraysValid then BuildArrays;
  if (Index<0) or (Index>=FLineCount) then
    Error(lrsListIndexExceedsBounds, Index);
  FLineRanges[Index].TheObject:=AnObject;
end;

function TTextStrings.GetLineLen(Index: integer; IncludeNewLineChars: boolean
  ): integer;
begin
  Result:=GetLineEnd(Index,IncludeNewLineChars)-FLineRanges[Index].StartPos;
end;

function TTextStrings.GetLineEnd(Index: integer; IncludeNewLineChars: boolean
  ): integer;
begin
  if not FArraysValid then BuildArrays;
  if not IncludeNewLineChars then
    Result:=FLineRanges[Index].EndPos
  else if Index=FLineCount-1 then
    Result:=length(FText)+1
  else
    Result:=FLineRanges[Index+1].StartPos;
end;

function TTextStrings.CountLineEndings(const s: string): integer;
var
  p: Integer;
  l: Integer;
begin
  Result:=0;
  l:=length(s);
  p:=1;
  while p<=l do begin
    if s[p] in [#10,#13] then
    begin
      inc(Result);
      inc(p);
      if (p<=l) and (s[p] in [#10,#13]) and (s[p-1]<>s[p]) then
        inc(p);
    end else begin
      inc(p);
    end;
  end;
end;

constructor TTextStrings.Create;
begin
  inherited Create;
  CheckSpecialChars;
end;

destructor TTextStrings.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TTextStrings.Clear;
begin
  ClearArrays;
  FLineCount:=0;
  FText:='';
end;

procedure TTextStrings.SetText(TheText: PChar);
begin
  if FText=TheText then exit;
  FText:=TheText;
  FArraysValid:=false;
end;

procedure TTextStrings.Insert(Index: Integer; const S: string);

  procedure RaiseOutOfBounds;
  begin
    raise EListError.Create('insert index '+IntToStr(Index)+' out of bounds '+IntToStr(FLineCount));
  end;

var
  NewStartPos: Integer;
  NewLineCharCount: Integer;
  NewLineLen: Integer;
  i: Integer;
  SEndsInNewLine: boolean;
  Range: PTextLineRange;
  NewCapacity: Integer;
begin
  if not FArraysValid then BuildArrays;
  NewLineLen:=length(S);
  SEndsInNewLine:=(S<>'') and (S[NewLineLen] in [#10,#13]);
  if Index<FLineCount then
  begin
    if Index<0 then
      RaiseOutOfBounds;
    NewStartPos:=FLineRanges[Index].StartPos;
  end else begin
    if Index>FLineCount then
      RaiseOutOfBounds;
    NewStartPos:=length(FText)+1;
  end;
  NewLineCharCount:=0;
  if SEndsInNewLine then begin
    inc(NewLineCharCount);
    if (NewLineLen>1)
    and (S[NewLineLen-1] in [#10,#13])
    and (S[NewLineLen-1]<>S[NewLineLen]) then
      inc(NewLineCharCount);
    System.Insert(S,FText,NewStartPos);
  end else begin
    // append missing newline char
    System.Insert(S+LineEnding,FText,NewStartPos);
    NewLineCharCount:=length(LineEnding);
    inc(NewLineLen,NewLineCharCount);
  end;
  // adjust arrays
  if FLineCount=FLineCapacity then begin
    if FLineCapacity<8 then
      NewCapacity:=8
    else
      NewCapacity:=FLineCapacity shl 1;
    ReAllocMem(FLineRanges,SizeOf(TTextLineRange)*NewCapacity);
    FillByte(FLineRanges[FLineCapacity],SizeOf(TTextLineRange)*(NewCapacity-FLineCapacity),0);
    FLineCapacity:=NewCapacity;
  end;
  if Index<FLineCount then begin
    System.Move(FLineRanges[Index],FLineRanges[Index+1],
                (FLineCount-Index)*SizeOf(TTextLineRange));
    FillByte(FLineRanges[Index],SizeOf(TTextLineRange),0);
    for i:=Index+1 to FLineCount do begin
      inc(FLineRanges[i].StartPos,NewLineLen);
      inc(FLineRanges[i].EndPos,NewLineLen);
    end;
  end;
  inc(FLineCount);
  Range:=@FLineRanges[Index];
  Range^.Line:=S;
  Range^.StartPos:=NewStartPos;
  Range^.EndPos:=NewStartPos+NewLineLen-NewLineCharCount;
end;

procedure TTextStrings.Delete(Index: Integer);
var
  OldLineLen: Integer;
  OldStartPos: Integer;
  i: Integer;
begin
  if not FArraysValid then BuildArrays;
  if (Index<0) or (Index>=FLineCount) then
    Error(lrsListIndexExceedsBounds, Index);
  // adjust text
  OldLineLen:=GetLineLen(Index,true);
  if OldLineLen>0 then begin
    OldStartPos:=FLineRanges[Index].StartPos;
    System.Delete(FText,OldStartPos,OldLineLen);
  end;
  // adjust arrays
  dec(FLineCount);
  FLineRanges[Index].Line:='';
  if Index<FLineCount then begin
    System.Move(FLineRanges[Index+1],FLineRanges[Index],
         (FLineCount-Index)*SizeOf(TTextLineRange));
    for i:=Index to FLineCount-1 do begin
      dec(FLineRanges[i].StartPos,OldLineLen);
      dec(FLineRanges[i].EndPos,OldLineLen);
    end;
  end;
  // clear last element
  FillByte(FLineRanges[FLineCount],SizeOf(TTextLineRange),0);
end;

procedure TTextStrings.Exchange(Index1, Index2: Integer);
var
  LineLen1: Integer;
  LineLen2: Integer;
  buf: Pointer;
  Dummy: Integer;
  OldBetweenStart: Integer;
  NewBetweenStart: Integer;
  BetweenLength: Integer;
  StartPos1: LongInt;
  StartPos2: LongInt;
  i: Integer;
  Movement: Integer;
  Obj: TObject;
  LineShortLen1: LongInt;
  LineShortLen2: LongInt;
  Line1: PTextLineRange;
  Line2: PTextLineRange;
begin
  // check values
  if Index1=Index2 then exit;
  if Index1<0 then
    Error(lrsListIndexExceedsBounds, Index1);
  if Index2<0 then
    Error(lrsListIndexExceedsBounds, Index2);
  if not FArraysValid then BuildArrays;
  if Index1>=FLineCount then
    Error(lrsListIndexExceedsBounds, Index1);
  if Index2>=FLineCount then
    Error(lrsListIndexExceedsBounds, Index2);

  // make sure Index1<Index2
  if Index1>Index2 then begin
    Dummy:=Index1;
    Index1:=Index2;
    Index2:=Dummy;
  end;

  Line1:=@FLineRanges[Index1];
  Line2:=@FLineRanges[Index2];

  // adjust text
  MakeTextBufferUnique;

  if (Index2=FLineCount-1) and (Line2^.EndPos>length(FText))
  then begin
    // The last line should be exchanged,
    // but Text has no new line character(s) at the end
    // => add LineEnding
    FText:=FText+LineEnding;
  end;

  // get line lengths including new line chars
  LineLen1:=GetLineLen(Index1,true);
  LineLen2:=GetLineLen(Index2,true);
  if (LineLen1<1) and (LineLen2<1) then exit;
  LineShortLen1:=GetLineLen(Index1,false);
  LineShortLen2:=GetLineLen(Index2,false);

  // save the bigger line
  StartPos1:=Line1^.StartPos;
  StartPos2:=Line2^.StartPos;
  if LineLen1>=LineLen2 then begin
    GetMem(buf,LineLen1);
    System.Move(FText[StartPos1],buf^,LineLen1);
  end else begin
    GetMem(buf,LineLen2);
    System.Move(FText[StartPos2],buf^,LineLen2);
  end;

  // move text in between
  OldBetweenStart:=StartPos1+LineLen1;
  BetweenLength:=StartPos2-OldBetweenStart;
  NewBetweenStart:=StartPos1+LineLen2;
  Movement:=NewBetweenStart-OldBetweenStart;
  if (BetweenLength>0) and (Movement<>0) then
    System.Move(FText[OldBetweenStart],FText[NewBetweenStart],BetweenLength);

  // move both lines
  Line1^.Line:='';
  Line2^.Line:='';
  if LineLen1>=LineLen2 then begin
    System.Move(FText[StartPos2],FText[StartPos1],LineLen2);
    System.Move(buf^,FText[StartPos2+Movement],LineLen1);
  end else begin
    System.Move(FText[StartPos1],FText[StartPos2+Movement],LineLen1);
    System.Move(buf^,FText[StartPos1],LineLen2);
  end;

  // adjust line ranges
  if Movement<>0 then
  begin
    Line1^.EndPos:=Line1^.StartPos+LineShortLen2;
    inc(Line2^.StartPos,Movement);
    Line2^.EndPos:=Line2^.StartPos+LineShortLen1;
    for i:=Index1+1 to Index2-1 do begin
      inc(FLineRanges[i].StartPos,Movement);
      inc(FLineRanges[i].EndPos,Movement);
    end;
  end;

  // exchange TheObject
  Obj:=Line1^.TheObject;
  Line1^.TheObject:=Line2^.TheObject;
  Line2^.TheObject:=Obj;

  // clean up
  FreeMem(buf);
end;

procedure TTextStrings.Move(CurIndex, NewIndex: Integer);
var
  SrcPos1: LongInt;
  SrcPos2: LongInt;
  SrcPos3: LongInt;
  LineStr: String;
  LineLen: Integer;
  i: LongInt;
  Obj: TObject;
  LineShortLen: LongInt;
  Line: PTextLineRange;
begin
  // check values
  if CurIndex=NewIndex then exit;
  if CurIndex<0 then
    Error(lrsListIndexExceedsBounds, CurIndex);
  if NewIndex<0 then
    Error(lrsListIndexExceedsBounds, NewIndex);
  if not FArraysValid then BuildArrays;
  if CurIndex>=FLineCount then
    Error(lrsListIndexExceedsBounds, CurIndex);
  if NewIndex>=FLineCount then
    Error(lrsListIndexExceedsBounds, NewIndex);

  // adjust text
  MakeTextBufferUnique;

  if CurIndex<NewIndex then
  begin
    // move to higher index
    if (NewIndex=FLineCount-1) and (FLineRanges[NewIndex].EndPos>length(FText))
    then begin
      // CurIndex should be moved to the end,
      // but Text has no new line character(s) at the end
      // => add LineEnding
      FText:=FText+LineEnding;
    end;
    SrcPos1:=FLineRanges[CurIndex].StartPos;
    SrcPos2:=FLineRanges[CurIndex+1].StartPos;
    SrcPos3:=GetLineEnd(NewIndex,true);
    // store current line with line end
    LineLen:=SrcPos2-SrcPos1;
    LineShortLen:=GetLineLen(CurIndex,false);
    LineStr:=copy(FText,SrcPos1,LineLen);
    Obj:=FLineRanges[CurIndex].TheObject;
    // move lines -1
    System.Move(FText[SrcPos2],FText[SrcPos1],SrcPos3-SrcPos2);
    for i:=CurIndex+1 to NewIndex do begin
      dec(FLineRanges[i].StartPos,LineLen);
      dec(FLineRanges[i].EndPos,LineLen);
    end;
    System.Move(FLineRanges[CurIndex+1],FLineRanges[CurIndex],
                SizeOf(TTextLineRange)*(NewIndex-CurIndex));
    // put current line at new position
    i:=SrcPos3-LineLen;
    System.Move(LineStr[1],FText[i],LineLen);
    Line:=@FLineRanges[NewIndex];
    Line^.StartPos:=i;
    Line^.EndPos:=i+LineShortLen;
    Pointer(Line^.Line):=nil; // this will be updated on demand, see Get
    Line^.TheObject:=Obj;
  end else begin
    // move to lower index
    if (CurIndex=FLineCount-1) and (FLineRanges[CurIndex].EndPos>length(FText))
    then begin
      // CurIndex should be moved from the end,
      // but Text has no new line character(s) at the end
      // => add LineEnding
      FText:=FText+LineEnding;
    end;
    SrcPos1:=FLineRanges[NewIndex].StartPos;
    SrcPos2:=FLineRanges[CurIndex].StartPos;
    SrcPos3:=GetLineEnd(CurIndex,true);
    // store current line with line end
    LineLen:=SrcPos3-SrcPos2;
    LineShortLen:=GetLineLen(CurIndex,false);
    LineStr:=copy(FText,SrcPos2,LineLen);
    Obj:=FLineRanges[CurIndex].TheObject;
    // move lines +1
    System.Move(FText[SrcPos1],FText[SrcPos1+LineLen],SrcPos2-SrcPos1);
    for i:=CurIndex-1 downto NewIndex do begin
      inc(FLineRanges[i].StartPos,LineLen);
      inc(FLineRanges[i].EndPos,LineLen);
    end;
    System.Move(FLineRanges[NewIndex],FLineRanges[NewIndex+1],
                SizeOf(TTextLineRange)*(CurIndex-NewIndex));
    // put current line at new position
    System.Move(LineStr[1],FText[SrcPos1],LineLen);
    Line:=@FLineRanges[NewIndex];
    Line^.StartPos:=SrcPos1;
    Line^.EndPos:=SrcPos1+LineShortLen;
    Pointer(Line^.Line):=nil; // this will be updated on demand, see Get
    Line^.TheObject:=Obj;
  end;
end;

procedure TTextStrings.MakeTextBufferUnique;
begin
  // make string unique (refcount=1) to be able to edit it directly
  UniqueString(FText);
end;

procedure TTextStrings.BeginUpdate;
begin
  inc(FUpdateCount);
end;

procedure TTextStrings.EndUpdate;

  procedure RaiseUpdateCount;
  begin
    raise Exception.Create('TTextStrings.EndUpdate');
  end;

begin
  if FUpdateCount<=0 then RaiseUpdateCount;
  dec(FUpdateCount);
  if FUpdateCount=0 then begin
    if FChangedWhileUpdate then
      Changed;
  end;
end;

function TTextStrings.GetText: PChar;
begin
  Result:=PChar(FText);
end;

function TTextStrings.IndexOf(const S: string): Integer;
begin
  Result:=inherited IndexOf(S);
end;

function TTextStrings.Add(const S: string): Integer;
begin
  Result:=AddObject(S,nil);
end;

function TTextStrings.AddObject(const S: string; AObject: TObject): Integer;
var
  e: String;
  NewLineCount: Integer;
  OldTxtLen: Integer;
  p: Integer;
  l: Integer;
begin
  Result:=Count;
  if (FText<>'') and (not (FText[length(FText)] in [#10,#13])) then
    e:=LineEnding
  else
    e:='';
  OldTxtLen:=length(FText);
  FText:=Text+e+S+LineEnding;
  if AObject<>nil then
    BuildArrays;
  if FArraysValid then
  begin
    // update FLineRanges
    NewLineCount:=FLineCount+CountLineEndings(S)+1;
    if NewLineCount>FLineCapacity then begin
      FLineCapacity:=FLineCapacity*2+10;
      if FLineCapacity<NewLineCount then
        FLineCapacity:=NewLineCount;
      ReAllocMem(FLineRanges,SizeOf(TTextLineRange)*FLineCapacity);
      FillByte(FLineRanges[FLineCount],SizeOf(TTextLineRange)*(FLineCapacity-FLineCount),0);
    end;
    FLineRanges[FLineCount].TheObject:=AObject;
    p:=OldTxtLen+length(e)+1;
    l:=length(FText);
    while FLineCount<NewLineCount do begin
      FLineRanges[FLineCount].StartPos:=p;
      while (p<=l) and (not (FText[p] in [#10,#13])) do
        inc(p);
      FLineRanges[FLineCount].EndPos:=p;
      inc(p);
      if (p<=l) and (FText[p] in [#10,#13]) and (FText[p]<>FText[p-1]) then
        inc(p);
      inc(FLineCount);
    end;
  end;
end;

procedure TTextStrings.AddStrings(TheStrings: TStrings);
var
  s: String;
  i: Integer;
  AddEachLine: Boolean;
  SrcTextStrings: TTextStrings;
  SrcItem: PTextLineRange;
  DstItem: PTextLineRange;
begin
  if TheStrings.Count=0 then exit;
  if FLineCount=0 then begin
    if TheStrings is TTextStrings then begin
      // copy Text, lineranges
      SrcTextStrings:=TTextStrings(TheStrings);
      FText:=SrcTextStrings.Text;
      ClearArrays;
      if not SrcTextStrings.FArraysValid then exit;
      // copy line range list
      FLineCount:=SrcTextStrings.Count;
      FLineCapacity:=FLineCount;
      FLineRanges:=AllocMem(FLineCount*SizeOf(TTextLineRange));
      SrcItem:=SrcTextStrings.FLineRanges;
      DstItem:=FLineRanges;
      for i:=0 to FLineCount-1 do begin
        DstItem^:=SrcItem^;
        inc(SrcItem);
        inc(DstItem);
      end;
      FArraysValid:=true;
      exit;
    end;
  end;
  AddEachLine:=false;
  if FArraysValid then begin
    for i:=0 to FLineCount-1 do
      if FLineRanges[i].TheObject<>nil then begin
        // old objects have to be kept
        AddEachLine:=true;
        break;
      end;
  end;
  if not AddEachLine then begin
    for i:=0 to TheStrings.Count-1 do begin
      if TheStrings.Objects[i]<>nil then begin
        // new objects have to be kept
        AddEachLine:=true;
        break;
      end;
    end;
  end;
  if AddEachLine then begin
    // append line by line, this can be very slow
    for i:=0 to TheStrings.Count-1 do
      AddObject(TheStrings[i],TheStrings.Objects[i]);
  end else begin
    // append the whole text at once
    // Beware: #10,#13 characters in lines are now converted to multiple lines
    if (FText<>'') and (not (FText[length(FText)] in [#10,#13])) then
      s:=LineEnding
    else
      s:='';
    FArraysValid:=false;
    FText:=FText+s+TheStrings.Text;
    BuildArrays;
  end;
end;

procedure TTextStrings.LoadFromFile(const FileName: string);
var
  TheStream: TFileStreamUTF8;
begin
  TheStream:=TFileStreamUtf8.Create(FileName,fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(TheStream);
  finally
    TheStream.Free;
  end;
end;

procedure TTextStrings.SaveToFile(const FileName: string);
var
  TheStream: TFileStreamUTF8;
begin
  TheStream:=TFileStreamUtf8.Create(FileName,fmCreate);
  try
    SaveToStream(TheStream);
  finally
    TheStream.Free;
  end;
end;

end.