// TODO make AdjustMarks work for deletion // TODO read-only buffers? not that useful and usually actively annoying... unit buffers; {$M+} {$RANGECHECKS OFF} interface uses sysutils, classes, math, interfaces, marks, undos; const cLineBreak = #10; // data in the text buffer type EBufferCopyException = class(Exception) end; TTextBuffer = class; TTextMark = class(TInterfacedObject, ITextMark, IInterface, ICloneable) private fAffinity : TTextMarkAffinity; fPosition : Cardinal; // does not take the gap into account so is not invalidated when the gap moves fTextBuffer : TTextBuffer; fPositionChanged : TTextMarkPositionChanged; //fVisualRevision : Cardinal; //fVisualX : Cardinal; //fVisualY : Cardinal; fPreviousMark : TTextMark; fNextMark : TTextMark; fOrderNumberInParent : Cardinal; { this is used to keep the marks sorted. } protected function GetPosition : Cardinal; { semi-virtual. } procedure SetPosition(value : Cardinal); function GetAffinity : TTextMarkAffinity; procedure SetAffinity(value : TTextMarkAffinity); function GetPositionChanged : TTextMarkPositionChanged; procedure SetPositionChanged(value : TTextMarkPositionChanged); procedure EmitPositionChanged; inline; function GetBuffer : TTextBuffer; published property Position : Cardinal read GetPosition write SetPosition; property PositionChanged : TTextMarkPositionChanged read GetPositionChanged write SetPositionChanged; procedure DissociateBuffer; property Affinity : TTextMarkAffinity read GetAffinity write SetAffinity; public destructor Destroy; override; property PreviousMark : TTextMark read fPreviousMark write fPreviousMark; // in (ascending "Position") order. property NextMark : TTextMark read fNextMark write fNextMark; // in (ascending "Position") order. property OrderNumberInParent : Cardinal read fOrderNumberInParent write fOrderNumberInParent; // semi-private. published constructor Create(aTextBuffer : TTextBuffer; aPosition : Cardinal = 0; aAffinity : TTextMarkAffinity = afBeginning); function Clone : ICloneable; end; TReconstructableTextMark = class(TTextMark, IReconstructableTextMark, ITextMark, IInterface, ICloneable) published procedure Recover; virtual; abstract; { call SetPosition(xy) in there to fix your own position. } function GetPosition : Cardinal; { semi-override. } end; TTextBufferItem = Char; PTextBufferItem = ^TTextBufferItem; TInternalBuffer = array of TTextBufferItem; PInternalBuffer = ^TInternalBuffer; TTextBufferBlockIteratorItem = class; ITextBufferBlockIterator = interface function GetSize() : Cardinal; // left, that is. function Next : TTextBufferBlockIteratorItem; { nil = EOF } property Size : Cardinal read GetSize; // total size in editor items that are left. end; ITextBuffer = interface // TODO maybe add #"Clear" (= #"Delete"(Beginning, End1);) function Range(aBeginning, aEnd1 : Cardinal) : ITextBufferBlockIterator; overload; function GetItem(aPosition : Cardinal) : TTextBufferItem; function GetEnd1 : Cardinal; property End1 : Cardinal read GetEnd1; procedure DeleteRange(aBeginning : Cardinal; aEnd : Cardinal); procedure DeleteCount(aPosition : Cardinal; aCount : Cardinal); procedure Insert(aPosition : Cardinal; aValue : UTF8String); overload; procedure Insert(aPosition : Cardinal; aValue : Char); overload; procedure Insert(aPosition : Cardinal; aValue : PChar; aCount : Cardinal); overload; // not 0-terminated. function GetModified : TTextBufferModified; procedure SetModified(aCallback : TTextBufferModified); { TODO this should be a list of callbacks, ideally. } property Modified : TTextBufferModified read GetModified write SetModified; // TODO the views actually have a much easier time when they get notified of every change (insertion|deletion|modification, point) as it happens. // TODO use #Range iterator protocol instead, or modify #Range to support virtual sub-buffers. function Find(aBeginning, aEnd1 : Cardinal; text : UTF8String; out oPosition : Cardinal) : Boolean; function FindLast(aBeginning, aEnd1 : Cardinal; text : UTF8String; out oPosition : Cardinal) : Boolean; function Debug(aExtraMark : ITextMark) : UTF8String; function GetUndoLogger : IUndoLogger; procedure SetUndoLogger(const aLogger : IUndoLogger); property UndoLogger : IUndoLogger read GetUndoLogger write SetUndoLogger; function CreateTextMark(aPosition : Cardinal; aAffinity : TTextMarkAffinity = afBeginning) : ITextMark; end; TGapAwarePosition = Cardinal; // internal. VERY private. TTextBufferRanges = array[0..1] of record // private. VERY private. Beginning : TGapAwarePosition; End1 : TGapAwarePosition; end; TFindDirection = (fdForward, fdBackward); // private so far. TTextBufferBlockIteratorItem = class private fBlockStart : PTextBufferItem; fSize : Cardinal; __fDummy : Cardinal; __fDummy2 : Cardinal; public property Beginning : PTextBufferItem read fBlockStart write fBlockStart; // read-write for #"TTextBuffer", read-only for all others. property Size : Cardinal read fSize write fSize; // read-write for #"TTextBuffer", read-only for all others. end; TTextBufferBlockIterator = class(TInterfacedObject, ITextBufferBlockIterator, ICloneable) private fBuffer : TTextBuffer; // TODO add read-only property. fRanges : TTextBufferRanges; // TODO add read-only property? fRangeIndex : Cardinal; // no. fItem : TTextBufferBlockIteratorItem; // reused over and over again, yeah yeah. fRemaining : Cardinal; public destructor Destroy; override; protected function GetSize() : Cardinal; // left, that is. published constructor Create(aBuffer : TTextBuffer; aRanges : TTextBufferRanges; aRangeIndex : Cardinal = 0); function Clone : ICloneable; function Next : TTextBufferBlockIteratorItem; // actually returns either #"nil" or an array slice. property Size : Cardinal; end; TTextBuffer = class(TInterfacedObject, ITextBuffer, IInterface) private fMarks : TList; // of TTextMark, sorted by position. { Reconstructable Marks. These are an optimization that allows the buffer mover to skip all reconstructable marks and instead just set a flag so that they will recalculate their own position later on when their position is first queried. } fReconstructableMarks : TList; // of TReconstructableTextMark, sorted by position. fReconstructableMarksDirtyStartingFromPosition : Cardinal; // the Mark.Position from which reconstructable marks' positions are currently wrong and should be recalculated. fIterators : TList; // of ITextBufferBlockIterators fBuffer : TInternalBuffer; // Byte; fBufferSize : Cardinal; fGapBeginning : Cardinal; // TODO: rename to 'fGapPosition' ? fGapEnd : Cardinal; // exclusive fModified : TTextBufferModified; fUndoLogger : IUndoLogger; fEnd1 : Cardinal; protected { This is here as an optimization ONLY so that "EmitModified" can be inlined. The buffer doesn't actually know "files" or whether the data is currently in one such "file", if you want it to, derive one that does. } fBModified : Boolean; protected procedure CheckSanity; function InternalFind(aBeginning, aEnd1 : TGapAwarePosition; text : UTF8String; findDirection : TFindDirection; out oPosition : TGapAwarePosition) : Boolean; procedure Grow(aNewSize : Cardinal); //inline; procedure Resize(aNewSize : Cardinal); inline; procedure MoveGapTo(aPosition : Cardinal; aMinSize : Cardinal); function GapAwarePosition(aPosition : Cardinal) : TGapAwarePosition; inline; function GetEnd1() : Cardinal; procedure AdjustMarks(aBeginning : TGapAwarePosition; aInsertedLength : Integer); procedure EmitModified(aAction : TTextBufferAction; aPosition : Cardinal; aCount : Cardinal; aValue : PChar); inline; function InternalRange(aBeginning, aEnd1 : TGapAwarePosition) : TTextBufferRanges; overload; procedure Copy(var aSource : TTextBufferRanges; var aDestination : TTextBufferRanges; aCount : Cardinal); procedure LogInsertion(aBeginning : Cardinal; const aValue : UTF8String); procedure LogDeletion(aBeginning : Cardinal; aCount : Cardinal); public destructor Destroy; override; procedure RegisterMark(aMark : TTextMark); // semi-private. procedure UnregisterMark(aMark : TTextMark); // semi-private. procedure SortMark(aMark : TTextMark); // used by "TTextMark". semi-private. procedure RegisterIterator(aIterator : TTextBufferBlockIterator); // semi-private. procedure UnregisterIterator(aIterator : TTextBufferBlockIterator); // semi-private. function GetModified : TTextBufferModified; procedure SetModified(aCallback : TTextBufferModified); function GetUndoLogger : IUndoLogger; procedure SetUndoLogger(const aLogger : IUndoLogger); published function Debug(aExtraMark : ITextMark) : UTF8String; // FIXME remove. constructor Create; function GetItem(aPosition : Cardinal) : TTextBufferItem; function Range(aBeginning, aEnd1 : Cardinal) : ITextBufferBlockIterator; overload; property End1 : Cardinal read GetEnd1; property Modified : TTextBufferModified read GetModified write SetModified; property UndoLogger : IUndoLogger read GetUndoLogger write SetUndoLogger; procedure Insert(aPosition : Cardinal; aValue : UTF8String); overload; procedure Insert(aPosition : Cardinal; aValue : Char); overload; procedure Insert(aPosition : Cardinal; aValue : PChar; aCount : Cardinal); overload; // not 0-terminated. procedure DeleteRange(aBeginning : Cardinal; aEnd : Cardinal); procedure DeleteCount(aPosition : Cardinal; aCount : Cardinal); // TODO use #Range iterator protocol instead, or modify #Range to support virtual sub-buffers. function Find(aBeginning, aEnd1 : Cardinal; text : UTF8String; out oPosition : Cardinal) : Boolean; function FindLast(aBeginning, aEnd1 : Cardinal; text : UTF8String; out oPosition : Cardinal) : Boolean; function CreateTextMark(aPosition : Cardinal; aAffinity : TTextMarkAffinity = afBeginning) : ITextMark; end; implementation uses debug; { TTextMark } constructor TTextMark.Create(aTextBuffer : TTextBuffer; aPosition : Cardinal = 0; aAffinity : TTextMarkAffinity = afBeginning); begin fPosition := aPosition; fAffinity := aAffinity; aTextBuffer.RegisterMark(Self); fTextBuffer := aTextBuffer; end; function TTextMark.GetAffinity : TTextMarkAffinity; begin Result := fAffinity; end; procedure TTextMark.SetAffinity(value : TTextMarkAffinity); begin fAffinity := value; end; destructor TTextMark.Destroy; begin if Assigned(fTextBuffer) then fTextBuffer.UnregisterMark(Self); // unlink from linked list. if Assigned(PreviousMark) then PreviousMark.NextMark := NextMark; if Assigned(NextMark) then NextMark.PreviousMark := PreviousMark; inherited; end; function TTextMark.Clone : ICloneable; begin Result := TTextMark.Create(fTextBuffer, fPosition); end; function TTextMark.GetPosition : Cardinal; begin Result := fPosition; end; function TReconstructableTextMark.GetPosition : Cardinal; begin Result := inherited GetPosition; if Result <= GetBuffer.fReconstructableMarksDirtyStartingFromPosition then Self.Recover; Result := inherited GetPosition; // TODO fix up fBuffer.fReconstructableTextMarksDirtyStartingFromPosition after checking that no other marks are dirty. end; procedure TTextMark.SetPosition(value : Cardinal); begin if (value = fPosition) then Exit; fPosition := value; EmitPositionChanged; end; procedure TTextMark.EmitPositionChanged; inline; var vMark : TTextMark; vPreviousMark : TTextMark; vNextMark : TTextMark; vPosition : Cardinal; begin if Assigned(fPositionChanged) then fPositionChanged(Self); // find the node that is supposed to come before this one. vMark := Self; vPosition := fPosition; vMark := vMark.PreviousMark; // assert(Assigned(vMark)); except for beginning and end node. while Assigned(vMark) do begin if vMark.Position < vPosition then Break; vMark := vMark.PreviousMark; end; // => vMark. vPreviousMark := vMark; // find the node that is supposed to come after this one. vMark := Self; vMark := vMark.NextMark; while Assigned(vMark) do begin if vMark.Position > vPosition then Break; vMark := vMark.NextMark; end; // => vMark. vNextMark := vMark; if Self.PreviousMark <> vPreviousMark then begin if Assigned(vPreviousMark) then begin if Assigned(vPreviousMark.NextMark) then vPreviousMark.NextMark.PreviousMark := vPreviousMark; vPreviousMark.NextMark := Self; end; Self.PreviousMark := vPreviousMark; end; if Self.NextMark <> vNextMark then begin if Assigned(vNextMark) then begin if Assigned(vNextMark.PreviousMark) then vNextMark.PreviousMark.NextMark := vNextMark; vNextMark.PreviousMark := Self; end; Self.NextMark := vNextMark; end; { sanity check. } vMark := Self.PreviousMark; while Assigned(vMark) do begin assert(vMark.Position <= vPosition); vMark := vMark.PreviousMark; end; vMark := Self.NextMark; while Assigned(vMark) do begin assert(vMark.Position >= vPosition); vMark := vMark.NextMark; end; if Assigned(fTextBuffer) then fTextBuffer.SortMark(Self); end; function TTextMark.GetBuffer : TTextBuffer; begin Result := fTextBuffer; end; function TTextMark.GetPositionChanged : TTextMarkPositionChanged; begin Result := fPositionChanged; end; procedure TTextMark.SetPositionChanged(value : TTextMarkPositionChanged); begin fPositionChanged := value; end; procedure TTextMark.DissociateBuffer; begin fTextBuffer := nil; end; { TTextBuffer } const StandardGapSize = 10; MaximumGapSize = 8000; constructor TTextBuffer.Create; begin fGapEnd := StandardGapSize; fGapBeginning := 0; fMarks := TList.Create; fReconstructableMarks := TList.Create; fReconstructableMarksDirtyStartingFromPosition := High(Cardinal); { none. } fIterators := TList.Create; fBufferSize := StandardGapSize; SetLength(fBuffer, fBufferSize); //vEnd1 := TTextMark.Create(Self, 0, afEnd); //fBeginning := TTextMark.Create(Self, 0, afBeginning); // already done speed optimization fMarks.Add(fBeginning); // already done fMarks.Add(vEnd1); fUndoLogger := TUndoLogger.Create(); end; procedure FreeMarks(aMarks : TList); var vMark : TTextMark; vTempMarks : TList; iMark : Integer; begin vTempMarks := TList.Create; if aMarks.Count > 0 then for iMark := aMarks.Count - 1 downto 0 do begin vMark := TTextMark(aMarks[iMark]); vTempMarks.Add(vMark); end; if vTempMarks.Count > 0 then for iMark := 0 to vTempMarks.Count - 1 do begin vMark := TTextMark(vTempMarks[iMark]); vMark.DissociateBuffer; // FreeAndNil(vMark); end; FreeAndNil(vTempMarks); end; destructor TTextBuffer.Destroy; begin // FIXME is that correct? FreeMarks(fReconstructableMarks); FreeMarks(fMarks); FreeAndNil(fIterators); FreeAndNil(fReconstructableMarks); FreeAndNil(fMarks); inherited; end; function EmptyInternalRange : TTextBufferRanges; inline; begin Result[0].Beginning := 0; Result[0].End1 := 0; Result[1].Beginning := 0; Result[1].End1 := 0; end; { aBeginning inclusive. aEnd1 exclusive. The result will have the block to the LEFT of the gap at index 0. The block to the RIGHT of the gap at index 1. Always. } function TTextBuffer.InternalRange(aBeginning, aEnd1 : TGapAwarePosition) : TTextBufferRanges; overload; var vIntersectionStart : TGapAwarePosition; vIntersectionEnd1 : TGapAwarePosition; begin Dump(Format('aBeginningORIG %d aEnd %d Gap %d:%d', [aBeginning, aEnd1, fGapBeginning, fGapEnd])); if aEnd1 > fBufferSize then aEnd1 := fBufferSize; if aBeginning >= aEnd1 then begin Result := EmptyInternalRange; Exit; end; Assert((aBeginning >= 0) and (aBeginning <= fBufferSize)); Assert((aEnd1 >= 0) and (aEnd1 <= fBufferSize)); if aBeginning = fGapBeginning then // end user is not interested in gap Inc(aBeginning, fGapEnd - fGapBeginning); assert(fGapEnd >= fGapBeginning); //SetLength(Result, fBufferSize - (fGapEnd - fGapBeginning)); { TODO intersect (aBeginning, aEnd1) with (fGapBeginning, fGapEnd) } if aBeginning >= aEnd1 then begin Result := EmptyInternalRange; Exit; end; Assert(aBeginning < aEnd1); // this has been ensured above, but just as one more documentation Assert(fGapBeginning <= fGapEnd); // this "cannot happen", but better be safe than sorry vIntersectionStart := Max(aBeginning, fGapBeginning); vIntersectionEnd1 := Min(aEnd1, fGapEnd); Dump(Format('aBeginning %d vIntersection %d:%d aEnd %d Gap %d:%d', [aBeginning, vIntersectionStart, vIntersectionEnd1, aEnd1, fGapBeginning, fGapEnd])); // aBeginning 10 vIntersection 10:10 aEnd 14775 Gap 3:10 Result[0].Beginning := aBeginning; Result[1].End1 := aEnd1; if vIntersectionStart = vIntersectionEnd1 then begin { the intersection is of size 0. } if aBeginning < fGapBeginning then begin // keep records that are on the left of the gap on the left. Result[0].End1 := aEnd1; Result[1].Beginning := aEnd1; Result[1].End1 := aEnd1; end else begin Result[0].End1 := aBeginning; Result[1].Beginning := aBeginning; Result[1].End1 := aEnd1; end; end else if vIntersectionStart < vIntersectionEnd1 then begin // there actually *is* an intersection of size > 0. Result[0].End1 := vIntersectionStart; Result[1].Beginning := vIntersectionEnd1; end else begin // there is no intersection. if aEnd1 <= fGapBeginning then begin // range is completely to the left of the gap. Result[0].End1 := aEnd1; Result[1].Beginning := fGapEnd; Result[1].End1 := fGapEnd; end else if aBeginning >= fGapEnd then begin // range is completely to the right of the gap. Result[0].Beginning := fGapBeginning; Result[0].End1 := fGapBeginning; Result[1].Beginning := aBeginning; end else begin // what the f***. // aBeginning 0 vIntersection 40:40 aEnd 41 Gap 40:40 assert((aEnd1 <= fGapBeginning) or (aBeginning >= fGapEnd)); end; end; // aBeginning 0 vIntersection 14765:14765 aEnd 14765 Gap 14765:14770 if vIntersectionStart <> vIntersectionEnd1 then begin if Result[0].End1 > fGapBeginning then begin Dump(Format(' Gap [%d, %d[', [fGapBeginning, fGapEnd])); assert(Result[0].End1 <= fGapBeginning); { this sometimes fails. FIXME. } end; assert(Result[1].Beginning >= fGapEnd); end; Dump(Format('Result => Range [%d:%d[, [%d:%d[, gap [%d:%d[', [Result[0].Beginning, Result[0].End1, Result[1].Beginning, Result[1].End1, fGapBeginning, fGapEnd])); end; function TTextBuffer.GetItem(aPosition : Cardinal) : TTextBufferItem; var fGPosition : TGapAwarePosition; begin fGPosition := GapAwarePosition(aPosition); if (fGPosition >= 0) and (fGPosition < fEnd1) then Result := fBuffer[fGPosition] else raise ERangeError.Create('index out of range'); end; function TTextBuffer.Range(aBeginning, aEnd1 : Cardinal) : ITextBufferBlockIterator; begin Result := TTextBufferBlockIterator.Create(Self, InternalRange(GapAwarePosition(aBeginning), GapAwarePosition(aEnd1))); end; { do NOT call this with the gap intersecting. in the Result, if there is something to the right of the gap, it's at the slot at index 1. } function TTextBuffer.InternalFind(aBeginning, aEnd1 : TGapAwarePosition; text : UTF8String; findDirection : TFindDirection; out oPosition : TGapAwarePosition) : Boolean; var iChar : TGapAwarePosition; sChar : Char; begin Result := False; Dump(Format('InternalFind [%d:%d[ Gap [%d:%d[', [aBeginning, aEnd1, fGapBeginning, fGapEnd])); assert(Length(text) = 1); // everything else unsupported so far. sChar := text[1]; if (findDirection = fdForward) then begin if aBeginning < aEnd1 then begin for iChar := aBeginning to aEnd1 - 1 do begin if (fBuffer[iChar] = sChar) then begin oPosition := iChar; Result := True; Break; end; end; end; end else begin if aBeginning < aEnd1 then begin for iChar := aEnd1 - 1 downto aBeginning do begin if (fBuffer[iChar] = sChar) then begin oPosition := iChar; Result := True; Break; end; end; end; end; end; // TODO use #Range iterator protocol instead, or modify #Range to support virtual sub-buffers. function TTextBuffer.Find(aBeginning, aEnd1 : Cardinal; text : UTF8String; out oPosition : Cardinal) : Boolean; var vBlocks : TTextBufferRanges; begin vBlocks := Self.InternalRange(GapAwarePosition(aBeginning), GapAwarePosition(aEnd1)); Result := False; assert(Length(text) = 1); // untested for everything else Result := Self.InternalFind(vBlocks[0].Beginning, vBlocks[0].End1, text, fdForward, {out} oPosition); if not Result then begin Dump(Format('trying to find in second block. Range [%d:%d[, [%d:%d[, gap [%d:%d[', [vBlocks[0].Beginning, vBlocks[0].End1, vBlocks[1].Beginning, vBlocks[1].End1, fGapBeginning, fGapEnd])); Result := Self.InternalFind(vBlocks[1].Beginning, vBlocks[1].End1, text, fdForward, {out} oPosition); if Result then begin assert(oPosition >= fGapEnd); Dec(oPosition, (fGapEnd - fGapBeginning)); // FIXME end; end else begin Dump(Format('found in first block. Range [%d:%d[, [%d:%d[, gap [%d:%d[', [vBlocks[0].Beginning, vBlocks[0].End1, vBlocks[1].Beginning, vBlocks[1].End1, fGapBeginning, fGapEnd])); end; end; // TODO use #Range iterator protocol instead, or modify #Range to support virtual sub-buffers? function TTextBuffer.FindLast(aBeginning, aEnd1 : Cardinal; text : UTF8String; out oPosition : Cardinal) : Boolean; var tBlocks : TTextBufferRanges; begin tBlocks := Self.InternalRange(GapAwarePosition(aBeginning), GapAwarePosition(aEnd1)); Result := False; assert(Length(text) = 1); // untested for everything else Result := Self.InternalFind(tBlocks[0].Beginning, tBlocks[0].End1, text, fdBackward, {out} oPosition); if not Result then begin Result := Self.InternalFind(tBlocks[1].Beginning, tBlocks[1].End1, text, fdBackward, {out} oPosition); if Result then begin Dec(oPosition, (fGapEnd - fGapBeginning)); end; end; end; { returns a "chunky" value that is >= #aValue. Useful for reducing the count of memory reallocations } function Chunky(aValue : Cardinal) : Cardinal; inline; begin // I use #StandardGapSize for no particular reason other than making debugging harder :-> Result := ((aValue + StandardGapSize - 1) div StandardGapSize) * StandardGapSize; // round up end; { aLeastBufferSize: the buffer size, without counting the existing gap } procedure TTextBuffer.Grow(aNewSize : Cardinal); //inline; begin if aNewSize <= fBufferSize then Exit; Self.Resize(aNewSize); end; procedure TTextBuffer.Resize(aNewSize : Cardinal); inline; var tLeastBufferSize : Cardinal; begin if fBufferSize = aNewSize then Exit; fBufferSize := aNewSize; tLeastBufferSize := Chunky(fBufferSize); if Cardinal(Length(fBuffer)) < tLeastBufferSize then SetLength(fBuffer, tLeastBufferSize); end; { Moves the gap to the indicated position (#aPosition + #aOffset), resizes the gap so it is at least #aMinSize big. Implementation notes: The gap is there in order to reduce the number of memory block moves to a minimum. This is especially true if the new position is within the gap and the gap shrinks by the offset into the gap, necessiting no memory moves at all until the entire gap is used up. i.e. old gap 12[.....]34 new gap 123[....]34 when moving a gap from [g.b, g.e) to [G.b, G.e), data to be moved has to be between: 1. [min(g.b, G.b), max(g.b, G.b)), and 2. [min(g.e, G.e), max(g.e, G.e)) } procedure TTextBuffer.MoveGapTo(aPosition : Cardinal; aMinSize : Cardinal); var fDirectCopyCount : Cardinal; fGapBeginningOffset : Cardinal; fOldSize : Cardinal; fNewGapBeginning : Cardinal; fNewGapEnd : Cardinal; fIntermediateSize : Integer; fFinalSize : Integer; function min(a, b : Cardinal) : Cardinal; inline; begin if a < b then Result := a else Result := b end; function max(a, b : Integer) : Integer; inline; begin if (a >= b) then Result := a else Result := b end; begin fOldSize := fBufferSize; fNewGapBeginning := aPosition; fNewGapEnd := Chunky(fNewGapBeginning + aMinSize); fFinalSize := fOldSize + (fNewGapEnd - fNewGapBeginning) - (fGapEnd - fGapBeginning); if (fGapBeginning = fNewGapBeginning) then begin fIntermediateSize := max(fFinalSize, fOldSize); Grow(fIntermediateSize); Move(fBuffer[fGapEnd], fBuffer[fNewGapEnd], fOldSize - fGapEnd); end else if (fGapBeginning < fNewGapBeginning) then begin fGapBeginningOffset := fNewGapBeginning - fGapBeginning; fIntermediateSize := max(fFinalSize, max(fGapEnd + fGapBeginningOffset, fOldSize)); Grow(fIntermediateSize); if (fGapEnd + fGapBeginningOffset < min(fNewGapBeginning, fOldSize)) then begin // intersection //Dump(Format('Move from [%d,%d) to [%d,%d) and move from [%d,%d) intersect.', [fGapEnd, fGapEnd + fGapBeginningOffset, fGapBeginning, fNewGapBeginning, fGapEnd + fGapBeginningOffset, fOldSize])); // A and B cross, reverse order. // A oldBufferIndex: [fGapEnd+fGapBeginningOffset:fOldSize) if fGapEnd + fGapBeginningOffset <> fNewGapEnd then Move(fBuffer[fGapEnd + fGapBeginningOffset], fBuffer[fNewGapEnd], fOldSize - fGapEnd - fGapBeginningOffset); // B newBufferIndex: [fGapBeginning:fNewGapBeginning) if fGapEnd <> fGapBeginning then Move(fBuffer[fGapEnd], fBuffer[fGapBeginning], fGapBeginningOffset); end else begin // B newBufferIndex: [fGapBeginning:fNewGapBeginning) if fGapEnd <> fGapBeginning then Move(fBuffer[fGapEnd], fBuffer[fGapBeginning], fGapBeginningOffset); // A oldBufferIndex: [fGapEnd+fGapBeginningOffset:fOldSize) if fGapEnd + fGapBeginningOffset <> fNewGapEnd then Move(fBuffer[fGapEnd + fGapBeginningOffset], fBuffer[fNewGapEnd], fOldSize - fGapEnd - fGapBeginningOffset); end; end else if (fGapBeginning > fNewGapBeginning) then begin fIntermediateSize := max(fFinalSize, max(fGapBeginning, fOldSize)); Grow(fIntermediateSize); if (max(fNewGapEnd, fGapEnd) < min(fNewGapEnd - fNewGapBeginning + fGapBeginning, fOldSize)) then begin // A and B cross, reverse order. //Dump(Format('Move3 from [%d,%d) to [%d,%d) and move from [%d,%d) intersect.', [fNewGapBeginning, fGapBeginning, fNewGapEnd, fNewGapEnd + fGapBeginning - fNewGapBeginning, fGapEnd, fOldSize])); // A oldBufferIndex: [fGapEnd:fOldSize) if fGapEnd <> (fNewGapEnd - fNewGapBeginning) + fGapBeginning then Move(fBuffer[fGapEnd], fBuffer[(fNewGapEnd - fNewGapBeginning) + fGapBeginning], fOldSize - fGapEnd); // B newBufferIndex: [fNewGapEnd:fNewGapEnd + fGapBeginning - fNewGapBeginning) if fNewGapBeginning <> fNewGapEnd then Move(fBuffer[fNewGapBeginning], fBuffer[fNewGapEnd], fGapBeginning - fNewGapBeginning); end else begin // B newBufferIndex: [fNewGapEnd:fNewGapEnd + fGapBeginning - fNewGapBeginning) if fNewGapBeginning <> fNewGapEnd then Move(fBuffer[fNewGapBeginning], fBuffer[fNewGapEnd], fGapBeginning - fNewGapBeginning); // A oldBufferIndex: [fGapEnd:fOldSize) if fGapEnd <> (fNewGapEnd - fNewGapBeginning) + fGapBeginning then Move(fBuffer[fGapEnd], fBuffer[(fNewGapEnd - fNewGapBeginning) + fGapBeginning], fOldSize - fGapEnd); end; end; Resize(fFinalSize); fGapBeginning := fNewGapBeginning; fGapEnd := fNewGapEnd; FillChar(fBuffer[fGapBeginning], fGapEnd - fGapBeginning, 0); CheckSanity(); end; {$IFDEF OLD} procedure TTextBuffer.MoveGapTo(aPosition : Cardinal; aMinSize : Cardinal); var vPosition : Cardinal; // non-gap position vEndPosition : Cardinal; // non-gap position tGapBeginningOffset : Integer; tPreviousGapSize : Cardinal; tNewGapSize : Cardinal; tResizedGapEnd : Cardinal; tPreviousBufferSize : Cardinal; begin Dump(Format('Gap %d:%d', [fGapBeginning, fGapEnd])); tPreviousGapSize := fGapEnd - fGapBeginning; tPreviousBufferSize := fBufferSize; { find the bounds of the new gap in the buffer } vPosition := aPosition; //if aMinSize < tPreviousGapSize then // aMinSize := tPreviousGapSize; vEndPosition := Chunky(vPosition + aMinSize); Dump(Format('Gap to be moved to %d:%d', [vPosition, vEndPosition])); { make sure that at least the gap fits in the buffer (neccessary, but not sufficient) } // if vEndPosition > fBufferSize then // Self.Grow(vEndPosition); // grow when we are at the end. // TODO also shrink the buffer when we can? //assert(vEndPosition <= fBufferSize); if (vPosition = fGapBeginning) and (vEndPosition <= fGapEnd) then begin // gap already at the correct place and big enough. Dump('already correct.'); Exit; end; // too much: Self.Grow(fBufferSize + tValueLength); // = Self.Grow((vEndPosition - fGapBeginning) + fBufferSize - (fGapEnd - fGapBeginning)); Self.Grow(fBufferSize + (vEndPosition - vPosition) - tPreviousGapSize); // Self.Grow(fBufferSize + (vEndPosition - fGapEnd)); { resize the gap } //CheckSanity; tNewGapSize := vEndPosition - vPosition; if tPreviousGapSize <> tNewGapSize then begin { resized } // as a first step, resize the old gap in place. tResizedGapEnd := fGapBeginning + tNewGapSize; //Assert(fBufferSize >= tPreviousBufferSize - vEndPosition); Dump(Format('resizing old gap from %d:%d to %d:%d (size %d)', [fGapBeginning, fGapEnd, fGapBeginning, tResizedGapEnd, tResizedGapEnd - fGapEnd])); Move(fBuffer[fGapEnd], fBuffer[tResizedGapEnd], tPreviousBufferSize - fGapEnd); if tResizedGapEnd <= fGapEnd then FillChar(fBuffer[tPreviousBufferSize + tResizedGapEnd - fGapEnd], fBufferSize - (tPreviousBufferSize + tResizedGapEnd - fGapEnd), 0); fGapEnd := tResizedGapEnd; end; { move the beginning of the gap (and whatever was before/after it) } tGapBeginningOffset := Integer(vPosition) - Integer(fGapBeginning); if tGapBeginningOffset > 0 then begin { move gap to the right } Move(fBuffer[fGapEnd], fBuffer[fGapBeginning], tGapBeginningOffset); //Move(fBuffer[fGapEnd + tGapBeginningOffset], fBuffer[fGapEnd], fBufferSize - (fGapEnd + tGapBeginningOffset)); end else if tGapBeginningOffset < 0 then begin { move gap to the left } Move(fBuffer[vPosition], fBuffer[vEndPosition], -tGapBeginningOffset); // Assert(fGapEnd - tGapBeginningOffset + fBufferSize - fGapEnd <= fBufferSize); // Assert(tGapBeginningOffset + fBufferSize <= fBufferSize); //Move(fBuffer[fGapEnd], fBuffer[fGapEnd - tGapBeginningOffset], fBufferSize - (fGapEnd - tGapBeginningOffset)); //Move(fBuffer[vPosition], fBuffer[fGapEnd], -tGapBeginningOffset); { 123A------------B45678 123C------------D45678 OK 123A------------B45678 123C--------D456789abc OK (larger) 123A------------B45678 123A---------------D45678 123456C------------D78 123A------------B45678 123A---------------D45678 1C------------D2345678 ---A------------B----- -C-----------------D-- ---A------------B----- -------C-----D-------- ---A------------B----- ------------------C--D ---A------------B----- C-D------------------- } end; // just in case FillChar(fBuffer[vPosition], vEndPosition - vPosition, 0); fGapBeginning := vPosition; fGapEnd := vEndPosition; CheckSanity; end; {$ENDIF} procedure TTextBuffer.CheckSanity; var i : Cardinal; begin // TODO only do this when debugging: if fBufferSize > 0 then for i := 0 to fBufferSize - 1 do begin if (fBuffer[i] = #0) and ((i < fGapBeginning) or (i >= fGapEnd)) then begin Dump(Format('BROKEN at %d (size would be %d)', [i, fBufferSize])); Halt(1); end; end; end; procedure TTextBuffer.SortMark(aMark : TTextMark); var ixMark : Integer; begin ixMark := fMarks.IndexOf(aMark); if ixMark = -1 then Abort; // TODO sort "fMarks". end; { returns: index in list that has a mark with position closest to #"aPosition". } function FindMarkInsertIndex(vMarks : TList; aPosition : Cardinal) : Cardinal; var i : Integer; begin // TODO use binary search. if vMarks.Count > 0 then for i := 0 to vMarks.Count - 1 do begin if aPosition >= TTextMark(vMarks[i]).Position then Break end else i := 0; Result := i; end; { returns: index in list that has a mark with position closest to #"aPosition". } function FindMark(vMarks : TList; aPosition : Cardinal) : Cardinal; var i : Integer; begin // TODO use binary search. if vMarks.Count > 0 then for i := 0 to vMarks.Count - 1 do begin if aPosition >= TTextMark(vMarks[i]).Position then Break end else i := 0; Result := i; end; procedure TTextBuffer.RegisterMark(aMark : TTextMark); // semi-private var vIndex : Cardinal; vMarks : TList; vOtherIndex : Cardinal; begin if aMark is TReconstructableTextMark then vMarks := fReconstructableMarks else vMarks := fMarks; if vMarks.IndexOf(aMark) > -1 then Abort; vIndex := FindMarkInsertIndex(vMarks, aMark.Position); aMark.OrderNumberInParent := vIndex; // vIndex := vMarks.Count; vMarks.Insert(vIndex, aMark); if vMarks.Count > 0 then for vOtherIndex := vMarks.Count - 1 downto vIndex + 1 do TTextMark(vMarks[vOtherIndex]).OrderNumberInParent := vOtherIndex; assert(TTextMark(vMarks[vIndex]) = aMark); end; procedure TTextBuffer.UnregisterMark(aMark : TTextMark); var vMarks : TList; vIndex : Cardinal; vOtherIndex : Cardinal; begin if aMark is TReconstructableTextMark then vMarks := fReconstructableMarks else vMarks := fMarks; vIndex := aMark.OrderNumberInParent; vMarks.Delete(vIndex); //vMarks.Remove(aMark); { just in case. FIXME remove this and use the above as a speed optimization. } if vMarks.Count > 0 then for vOtherIndex := vIndex to vMarks.Count - 1 do TTextMark(vMarks[vOtherIndex]).OrderNumberInParent := vOtherIndex; end; procedure TTextBuffer.RegisterIterator(aIterator : TTextBufferBlockIterator); // semi-private. begin if fIterators.IndexOf(aIterator) > -1 then Abort; fIterators.Add(aIterator); end; procedure TTextBuffer.UnregisterIterator(aIterator : TTextBufferBlockIterator); // semi-private. begin fIterators.Remove(aIterator); end; { aBeginning: start adjusting marks with this gap-aware position. Note that no beginning should be inside the gap. aInsertedLength: increment the position of all marks >= aBeginning by #aInsertedLength } procedure TTextBuffer.AdjustMarks(aBeginning : TGapAwarePosition; aInsertedLength : Integer); var iTextMark : Integer; vPosition : Cardinal; // non-gap position vMark : TTextMark; vBeginning : Cardinal; begin { TODO maybe make this "AdjustMarks(aBeginning : Cardinal, non-gap-aware)" or even "AdjustMarks(aBeginning : ITextMark; : Integer; ...)" ? } vBeginning := aBeginning; if (vBeginning > fGapBeginning) and (vBeginning < fGapEnd) then { you really don't want that, otherwise the marks will end up far far too much to the right. } vBeginning := fGapEnd; if fMarks.Count > 0 then begin iTextMark := 0; while (iTextMark < fMarks.Count) do begin vMark := TTextMark(fMarks[iTextMark]); vPosition := vMark.Position; if ((vPosition = vBeginning) and (vMark.Affinity = afEnd)) or (vPosition > vBeginning) then begin if aInsertedLength > 0 then vMark.Position := vPosition + Cardinal(aInsertedLength) else if aInsertedLength < 0 then begin // FIXME if vPosition >= Cardinal(-aInsertedLength) then vMark.Position := vPosition - Cardinal(-aInsertedLength) else vMark.Position := 0; end; end; // FIXME handle afAnchoredToNextCharacter (once the character to the right of the mark is deleted, delete mark). Inc(iTextMark); end; end; // NOTE also moves end if the buffer grew. end; procedure TTextBuffer.Insert(aPosition : Cardinal; aValue : UTF8String); begin Self.Insert(aPosition, PChar(aValue), Length(aValue)); end; { end is exclusive } procedure TTextBuffer.DeleteRange(aBeginning : Cardinal; aEnd : Cardinal); var vCount : Cardinal; begin if aBeginning < aEnd then begin vCount := aEnd - aBeginning; Self.DeleteCount(aBeginning, vCount); end; end; procedure TTextBuffer.Copy(var aSource : TTextBufferRanges; var aDestination : TTextBufferRanges; aCount : Cardinal); var vSourceIndex, vDestinationIndex : Cardinal; vSourcePosition, vDestinationPosition : TGapAwarePosition; begin { FIXME do this block-wise. } { FIXME make this work for the case when the source positions are SMALLER than the destination positions (scroll effect). } vSourceIndex := 0; vSourcePosition := aSource[vSourceIndex].Beginning; vDestinationIndex := 0; vDestinationPosition := aDestination[vDestinationIndex].Beginning; while aCount > 0 do begin while (vSourcePosition >= aSource[vSourceIndex].End1) do begin if vSourceIndex >= High(aSource) then begin // whoops. raise EBufferCopyException.Create('not enough data left in source block'); end; Inc(vSourceIndex); vSourcePosition := aSource[vSourceIndex].Beginning; end; while (vDestinationPosition >= aSource[vDestinationIndex].End1) do begin if vDestinationIndex >= High(aDestination) then begin // whoops. raise EBufferCopyException.Create('not enough space left in destination block'); end; Inc(vDestinationIndex); vDestinationPosition := aDestination[vDestinationIndex].Beginning; end; fBuffer[vDestinationPosition] := fBuffer[vSourcePosition]; Dec(aCount); Inc(vDestinationPosition); Inc(vSourcePosition); end; end; procedure TTextBuffer.DeleteCount(aPosition : Cardinal; aCount : Cardinal); var vBeginning : TGapAwarePosition; vEnd : TGapAwarePosition; vOffset : TGapAwarePosition; vIntersectionStart : Cardinal; vIntersectionEnd1 : Cardinal; begin // TODO don't delete more than is there. { FIXME Deletion should take care not to move text unneccessarily. i. e. keep the number of memory block moves to a minimum. Deletion only modifies the position of text that comes *after* the beginning of the deletion. Hence it depends on the size of the block (beginning of the deletion, size of buffer). If that block is smaller than the gap, move the block. Otherwise move and/or grow the gap. Prefer growing the gap as long as possible and useful. Ensure that the gap size does not exceed the maximum gap size to conserve memory. } Self.LogDeletion(aPosition, aCount); // FIXME make this work properly. vBeginning := GapAwarePosition(aPosition); // where the block to be deleted starts. vEnd := GapAwarePosition(aPosition + aCount); // where the block to be deleted ends. if vBeginning = fGapBeginning then Inc(vBeginning, fGapEnd - fGapBeginning); assert(vEnd <= fBufferSize); vOffset := vEnd - vBeginning; vIntersectionStart := Max(vBeginning, fGapBeginning); vIntersectionEnd1 := Min(vEnd, fGapEnd); if vIntersectionStart < vIntersectionEnd1 then begin // TODO limit growth of the gap. { optimized path: when the deletion range is adjacent to the gap. } assert(vIntersectionStart = fGapBeginning); assert(vIntersectionEnd1 = fGapEnd); if vIntersectionStart = fGapBeginning { TODO and some gap size limit is not exceeded } then begin assert(vBeginning <= fGapBeginning); fGapBeginning := vBeginning; FillChar(fBuffer[fGapBeginning], vIntersectionStart - fGapBeginning, 0); { for better debugging. } vIntersectionStart := fGapBeginning; end; if vIntersectionEnd1 = fGapEnd { TODO and some gap size limit is not exceeded } then begin assert(vEnd >= fGapEnd); fGapEnd := vEnd; FillChar(fBuffer[vIntersectionEnd1], fGapEnd - vIntersectionEnd1, 0); { for better debugging. } vIntersectionEnd1 := fGapEnd; end; { normal path. } // TODO. end else begin // TODO if it makes sense, maybe MAKE it intersect (move the gap). // TODO move only the non-gap parts so that it's faster? Move(fBuffer[vEnd], fBuffer[vBeginning], fBufferSize - vEnd); Self.Resize(fBufferSize - vOffset); if vBeginning >= fGapEnd then begin // gap not affected. end else if { vBeginning < fGapEnd and } vEnd <= fGapBeginning then begin Dec(fGapBeginning, vOffset); Dec(fGapEnd, vOffset); end else begin { intersection with gap exists. } fGapBeginning := vEnd; fGapEnd := vEnd; end; // TODO what if: [Sb data[Gb..Ge ]Se] (S selection, G gap). end; { BROKEN } Self.AdjustMarks(vEnd, -aCount); Self.EmitModified(baDelete, aPosition, aCount, nil); Dec(fEnd1, aCount); end; procedure TTextBuffer.Insert(aPosition : Cardinal; aValue : Char); var vPosition : TGapAwarePosition; begin LogInsertion(aPosition, aValue); Self.MoveGapTo(aPosition, SizeOf(aValue)); vPosition := GapAwarePosition(aPosition); fBuffer[vPosition] := aValue; Inc(fGapBeginning); Assert(fGapBeginning <= fBufferSize); // ARGH Self.MoveGapTo(aPosition, SizeOf(aValue), 0); Self.AdjustMarks(vPosition, SizeOf(aValue)); Self.EmitModified(baInsert, aPosition, 1, nil); Inc(fEnd1); end; procedure TTextBuffer.Insert(aPosition : Cardinal; aValue : PChar; aCount : Cardinal); // not 0-terminated. var vBeginning : TGapAwarePosition; tValueLength : Cardinal; i : Cardinal; begin LogInsertion(aPosition, aValue); tValueLength := aCount; if tValueLength = 0 then Exit; Self.MoveGapTo(aPosition, tValueLength); vBeginning := GapAwarePosition(aPosition); assert(Cardinal(Length(fBuffer)) >= vBeginning + tValueLength); if tValueLength > 0 then for i := 0 to tValueLength - 1 do fBuffer[vBeginning + i] := aValue[i]; // Move(aValue, fBuffer[Self.PositionFromTextMark(aPosition)]); Inc(fGapBeginning, tValueLength); Assert(fGapBeginning <= fBufferSize); Self.AdjustMarks(vBeginning, tValueLength); Self.EmitModified(baInsert, aPosition, aCount, aValue); Inc(fEnd1, aCount); end; procedure TTextBuffer.LogInsertion(aBeginning : Cardinal; const aValue : UTF8String); begin if not Assigned(fUndoLogger) then Exit; fUndoLogger.LogInsertion(aBeginning, aValue); end; procedure TTextBuffer.LogDeletion(aBeginning : Cardinal; aCount : Cardinal); var VIterator : ITextBufferBlockIterator; VItem : TTextBufferBlockIteratorItem; VText : UTF8String; begin if not Assigned(fUndoLogger) then Exit; VIterator := Range(aBeginning, aBeginning + aCount); // FIXME chunk this into small pieces to add to the buffer. repeat VItem := VIterator.Next; if Assigned(VItem) then begin SetLength(VText, VItem.Size); Move(VItem.Beginning^, VText[1], VItem.Size); fUndoLogger.LogDeletion(aBeginning, VText); end; until VItem = nil; end; procedure TTextBuffer.EmitModified(aAction : TTextBufferAction; aPosition : Cardinal; aCount : Cardinal; aValue : PChar); inline; begin fBModified := True; // this is here as an optimization so this can be inlined. The buffer doesn't actually know "files" or whether the data is currently in one such "file". // TODO if fIterators.Count > 0 then Warn... fModified(Self, aAction, aPosition, aCount, aValue); end; { Calculates an actual position (index into #fBuffer) from a text mark. If there is a gap, it is taken into account. If the mark was exactly on the gap, the returned index can point at the *beginning* of the gap. Other positions inside the gap are not returned. FIXME } function TTextBuffer.GapAwarePosition(aPosition : Cardinal) : TGapAwarePosition; inline; begin if aPosition <= fGapBeginning then Result := aPosition else Result := aPosition + (fGapEnd - fGapBeginning); end; function TTextBuffer.GetEnd1 : Cardinal; begin Result := fEnd1; //Result := fBufferSize - (fGapEnd - fGapBeginning); end; function TTextBuffer.GetModified : TTextBufferModified; begin Result := fModified; end; procedure TTextBuffer.SetModified(aCallback : TTextBufferModified); begin fModified := aCallback; end; function TTextBuffer.Debug(aExtraMark : ITextMark) : UTF8String; var iPosition : Cardinal; { gap-aware } function WriteAt(x : TGapAwarePosition; printX : Cardinal; character : Char) : UTF8String; var iSpacing : Cardinal; begin Result := ''; for iSpacing := 1 to x do begin Result := Result + ' '; end; Result := Result + character; Result := Result + ' '; Result := Result + IntToStr(printX); Result := Result + Buffers.cLineBreak; end; var character : Char; begin Result := ''; Exit; Result := Result + Buffers.cLineBreak; for iPosition := 0 to fBufferSize - 1 do begin character := fBuffer[iPosition]; if Ord(character) >= 32 then Result := Result + character else Result := Result + '?'; end; Result := Result + Buffers.cLineBreak; Result := Result + WriteAt(fGapBeginning, fGapBeginning, 'G'); Result := Result + WriteAt(fGapEnd, fGapEnd, 'g'); //Result := Result + WriteAt(fBufferSize, fEnd1.Position, 'E'); Result := Result + WriteAt(fBufferSize, fBufferSize, 'S'); if Assigned(aExtraMark) then Result := Result + WriteAt(GapAwarePosition(aExtraMark.Position), aExtraMark.Position, 'C'); Result := Result + Buffers.cLineBreak; end; function TTextBuffer.GetUndoLogger : IUndoLogger; begin Result := fUndoLogger; end; procedure TTextBuffer.SetUndoLogger(const aLogger : IUndoLogger); begin fUndoLogger := aLogger; end; function TTextBuffer.CreateTextMark(aPosition : Cardinal; aAffinity : TTextMarkAffinity = afBeginning) : ITextMark; begin Result := TTextMark.Create(Self, aPosition, aAffinity); end; { TTextBufferBlockIterator } // TTextBufferBlockIterator = class(TInterfacedObject, ISimpleBlockIterator, ICloneable) constructor TTextBufferBlockIterator.Create(aBuffer : TTextBuffer; aRanges : TTextBufferRanges; aRangeIndex : Cardinal = 0); var VIndex : Cardinal; begin fItem := TTextBufferBlockIteratorItem.Create; fRanges := aRanges; fRangeIndex := aRangeIndex; //SetLength(fRanges, 0); aBuffer.RegisterIterator(Self); fBuffer := aBuffer; fRemaining := 0; for VIndex := fRangeIndex to High(aRanges) do Inc(fRemaining, fRanges[VIndex].End1 - fRanges[VIndex].Beginning); end; destructor TTextBufferBlockIterator.Destroy; begin if Assigned(fBuffer) then fBuffer.UnregisterIterator(Self); if Assigned(fItem) then FreeAndNil(fItem); inherited Destroy; end; function TTextBufferBlockIterator.GetSize() : Cardinal; // left, that is. begin Result := fRemaining; end; function TTextBufferBlockIterator.Clone : ICloneable; begin Result := TTextBufferBlockIterator.Create(fBuffer, fRanges, fRangeIndex); end; function TTextBufferBlockIterator.Next : TTextBufferBlockIteratorItem; // actually returns either #"nil" or an array slice. var vBeginning : TGapAwarePosition; vEnd1 : TGapAwarePosition; begin if fRangeIndex >= Length(fRanges) then begin Result := nil; Exit; end; vBeginning := fRanges[fRangeIndex].Beginning; vEnd1 := fRanges[fRangeIndex].End1; fItem.Beginning := @fBuffer.fBuffer[vBeginning]; if vBeginning <= vEnd1 then fItem.Size := vEnd1 - vBeginning else fItem.Size := 0; Inc(fRangeIndex); Result := fItem; Dec(fRemaining, fItem.Size); end; end.