diff --git a/ide/packages/idedebugger/idedebuggerwatchresprinter.pas b/ide/packages/idedebugger/idedebuggerwatchresprinter.pas
index e8eaf6f35d..3ef04274ef 100644
--- a/ide/packages/idedebugger/idedebuggerwatchresprinter.pas
+++ b/ide/packages/idedebugger/idedebuggerwatchresprinter.pas
@@ -7,8 +7,8 @@ interface
uses
Classes, SysUtils, Math, IdeDebuggerWatchResult, IdeDebuggerUtils, IdeDebuggerDisplayFormats,
- IdeDebuggerBase, IdeDebuggerStringConstants, IdeDebuggerValueFormatter, LazDebuggerIntf, LazUTF8,
- IdeDebuggerWatchValueIntf, StrUtils, LazDebuggerUtils;
+ IdeDebuggerBase, IdeDebuggerStringConstants, IdeDebuggerValueFormatter, IdeDebuggerWatchResUtils,
+ LazDebuggerIntf, LazUTF8, IdeDebuggerWatchValueIntf, StrUtils, LazDebuggerUtils;
type
@@ -103,12 +103,12 @@ type
const ANumFormat: TResolvedDisplayFormatNum;
PrintNil: Boolean = False
): String;
- function PrintArray(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String;
- function PrintStruct(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String;
- function PrintConverted(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String;
- function PrintProc(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
+ function PrintArray(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): TStringBuilderPart;
+ function PrintStruct(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): TStringBuilderPart;
+ function PrintConverted(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): TStringBuilderPart;
+ function PrintProc(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): TStringBuilderPart;
- function PrintWatchValueEx(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String;
+ function PrintWatchValueEx(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): TStringBuilderPart;
public
constructor Create;
destructor Destroy; override;
@@ -601,7 +601,8 @@ begin
end;
function TWatchResultPrinter.PrintArray(AResValue: TWatchResultData;
- const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String;
+ const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String
+ ): TStringBuilderPart;
type
TIntegerArray = array of integer;
@@ -695,11 +696,11 @@ var
CouldHide, OldCurrentArrayLenShown, LoopCurrentArrayLenShown, CouldSingleLine,
ShowMultiLine: Boolean;
MultiLine: TWatchDisplayFormatMultiline;
- Results: array of string;
PrefixIdxList: TIntegerArray;
LenPrefix: TWatchDisplayFormatArrayLen;
ArrayTypes: TLzDbgArrayTypes;
EntryVal: TWatchResultData;
+ R2: PString;
begin
inc(FCurrentMultilineLvl);
if (ANestLvl > FDeepestArray) then
@@ -709,17 +710,18 @@ begin
tn := AResValue.TypeName;
if (AResValue.Count = 0) and (AResValue.DataAddress = 0) then begin
if (ADispFormat.Struct.DataFormat = vdfStructFull) then
- Result := AResValue.TypeName + '(nil)'
+ Result.RawAsStringPtr^ := AResValue.TypeName + '(nil)'
else
- Result := 'nil';
+ Result.RawAsString := 'nil';
exit;
end;
if (ADispFormat.Struct.ShowPointerFormat = vdfStructPointerOnly) then begin
- Result := '$'+IntToHex(AResValue.DataAddress, HexDigicCount(AResValue.DataAddress, 4, True));
+ R2 := Result.RawAsStringPtr;
+ R2^ := '$'+IntToHex(AResValue.DataAddress, HexDigicCount(AResValue.DataAddress, 4, True));
if tn <> '' then
- Result := tn + '(' + Result + ')';
+ R2^ := tn + '(' + R2^ + ')';
exit;
end;
end;
@@ -781,16 +783,6 @@ begin
ArrayTypes := [Low(TLzDbgArrayType)..High(TLzDbgArrayType)];
end;
-
-
- Cnt := AResValue.Count;
- CutOff := (Cnt < AResValue.ArrayLength);
- if CutOff then begin
- SetLength(Results, Cnt+1);
- end
- else
- SetLength(Results, Cnt);
-
if ShowLen then begin
if ShowCombined then begin
CheckArrayIndexes(AResValue, PrefixIdxList, PrefixIdxCnt, ArrayTypes);
@@ -813,106 +805,115 @@ begin
LenStr := Format(drsLen2, [LenStr]);
end;
end;
+ CouldHide := LenPrefix.HideLen and (AResValue.ArrayLength <= LenPrefix.HideLenThresholdCnt);
+
+ if AResValue.ArrayLength = 0 then begin
+ if ShowLen and not CouldHide then
+ Result.RawAsStringPtr^ := LenStr + '()'
+ else
+ Result.RawAsString := '()';
+ exit;
+ end;
+
+ Cnt := AResValue.Count;
+ CutOff := (Cnt < AResValue.ArrayLength);
+ if CutOff then begin
+ Result.RawPartCount := Cnt + 1;
+ end
+ else
+ Result.RawPartCount := Cnt;
LoopCurrentArrayLenShown := FCurrentArrayLenShown;
FCurrentArrayLenShown := False;
- CouldHide := LenPrefix.HideLen and (AResValue.ArrayLength <= LenPrefix.HideLenThresholdCnt);
HideLenEach := Max(1, LenPrefix.HideLenThresholdEach);
MaxLen := 1000*1000 div Max(1, ANestLvl*4);
Len := 0;
- if Cnt > 0 then begin
+ if Cnt > 0 then
dec(FElementCount);
- for i := 0 to Cnt - 1 do begin
- AResValue.SetSelectedIndex(i);
- ElemCnt := FElementCount;
- EntryVal := AResValue.SelectedEntry;
- Results[i] := PrintWatchValueEx(EntryVal, ADispFormat, ANestLvl, AWatchedExpr);
- Len := Len + Length(Results[i]) + SepLen;
+ for i := 0 to Cnt - 1 do begin
+ AResValue.SetSelectedIndex(i);
+ ElemCnt := FElementCount;
+ EntryVal := AResValue.SelectedEntry;
+ Result.RawParts[i] := PrintWatchValueEx(EntryVal, ADispFormat, ANestLvl, AWatchedExpr);
+ Len := Len + Result.PartsTotalLen[i] + SepLen;
- if CouldHide and (
- ( (LenPrefix.HideLenThresholdLen > 0) and
- (Length(Results[i]) > LenPrefix.HideLenThresholdLen)
- ) or
- (FElementCount - ElemCnt > HideLenEach) or
- ( (LenPrefix.HideLenThresholdEach = 0) and (EntryVal.ValueKind in [rdkArray, rdkStruct]) )
- )
- then
- CouldHide := False;
-
- if CouldSingleLine and (
- ( (MultiLine.ForceSingleLineThresholdLen > 0) and
- (Length(Results[i]) > MultiLine.ForceSingleLineThresholdLen)
- ) or
- (FElementCount - ElemCnt > ForceSingleLineEach) or
- ( (MultiLine.ForceSingleLineThresholdEach = 0) and (EntryVal.ValueKind in [rdkArray, rdkStruct]) )
- )
- then
- CouldSingleLine := False;
-
- if Len > MaxLen then begin
- CutOff := True;
- Cnt := i+1;
- SetLength(Results, Cnt+1);
- end;
- end;
-
- if FCurrentArrayLenShown then
+ if CouldHide and (
+ ( (LenPrefix.HideLenThresholdLen > 0) and
+ (Result.PartsTotalLen[i] > LenPrefix.HideLenThresholdLen)
+ ) or
+ (FElementCount - ElemCnt > HideLenEach) or
+ ( (LenPrefix.HideLenThresholdEach = 0) and (EntryVal.ValueKind in [rdkArray, rdkStruct]) )
+ )
+ then
CouldHide := False;
- FCurrentArrayLenShown := FCurrentArrayLenShown or LoopCurrentArrayLenShown;
- if FHasLineBreak or
- ( ( (ANestLvl < FDeepestArray) or (MultiLine.ForceSingleLineReverseDepth <= 1) ) and
- (AResValue.FieldCount > MultiLine.ForceSingleLineThresholdStructFld) ) or
- (Min(FDeepestMultilineLvl, MultiLine.MaxMultiLineDepth) - FCurrentMultilineLvl >= MultiLine.ForceSingleLineReverseDepth)
+ if CouldSingleLine and (
+ ( (MultiLine.ForceSingleLineThresholdLen > 0) and
+ (Result.PartsTotalLen[i] > MultiLine.ForceSingleLineThresholdLen)
+ ) or
+ (FElementCount - ElemCnt > ForceSingleLineEach) or
+ ( (MultiLine.ForceSingleLineThresholdEach = 0) and (EntryVal.ValueKind in [rdkArray, rdkStruct]) )
+ )
then
CouldSingleLine := False;
- if CutOff then begin
- Results[Cnt] := '...';
- inc(Cnt);
+ if Len > MaxLen then begin
+ CutOff := True;
+ Cnt := i+1;
+ Result.RawChangePartCount(Cnt+1);
end;
+ end;
- if ShowMultiLine and not CouldSingleLine then begin
- if (rpfIndent in FFormatFlags) then begin
- sep := ',' + FLineSeparator + FIndentString;
- sep2 := FLineSeparator + FIndentString;
- end
- else begin
- sep := ',' + FLineSeparator;
- sep2 := FLineSeparator;
- end;
- if Cnt > 1 then
- FHasLineBreak := True;
+ if FCurrentArrayLenShown then
+ CouldHide := False;
+ FCurrentArrayLenShown := FCurrentArrayLenShown or LoopCurrentArrayLenShown;
+
+ if FHasLineBreak or
+ ( ( (ANestLvl < FDeepestArray) or (MultiLine.ForceSingleLineReverseDepth <= 1) ) and
+ (AResValue.FieldCount > MultiLine.ForceSingleLineThresholdStructFld) ) or
+ (Min(FDeepestMultilineLvl, MultiLine.MaxMultiLineDepth) - FCurrentMultilineLvl >= MultiLine.ForceSingleLineReverseDepth)
+ then
+ CouldSingleLine := False;
+
+ if CutOff then begin
+ Result.RawPartsAsString[Cnt] := '...';
+ inc(Cnt);
+ end;
+
+ if ShowMultiLine and not CouldSingleLine then begin
+ if (rpfIndent in FFormatFlags) then begin
+ sep := ',' + FLineSeparator + FIndentString;
+ sep2 := FLineSeparator + FIndentString;
end
else begin
- sep := ', ';
- sep2 := '';
+ sep := ',' + FLineSeparator;
+ sep2 := FLineSeparator;
end;
-
- if (Cnt > 1) and (not CouldSingleLine) then
- Results[Cnt-1] := Results[Cnt-1] + sep2 +')'
- else
- Results[Cnt-1] := Results[Cnt-1] +')';
-
- if CouldHide and
- (ANestLvl - FCurrentOuterMostArrayLvl >= LenPrefix.HideLenKeepDepth)
- then
- ShowLen := False;
- if ShowLen then begin
- Results[0] := LenStr + sep2 + '(' + Results[0];
- FCurrentArrayLenShown := True;
- end
- else
- Results[0] := '(' + Results[0];
-
- Result := AnsiString.Join(sep, Results);
+ if Result.RawPartCount > 1 then
+ FHasLineBreak := True;
end
else begin
- if ShowLen then
- Result := LenStr + '()'
- else
- Result := '()';
+ sep := ', ';
+ sep2 := '';
end;
+ Result.RawSeparator := sep;
+
+ //if (Cnt > 1) and (not CouldSingleLine) then
+ if FHasLineBreak and (not CouldSingleLine) then
+ Result.RawPostfix := sep2 +')'
+ else
+ Result.RawPostfix := ')';
+
+ if CouldHide and
+ (ANestLvl - FCurrentOuterMostArrayLvl >= LenPrefix.HideLenKeepDepth)
+ then
+ ShowLen := False;
+ if ShowLen then begin
+ Result.RawPrefix := LenStr + sep2 + '(';
+ FCurrentArrayLenShown := True;
+ end
+ else
+ Result.RawPrefix := '(';
if OldHasLineBreak then
FHasLineBreak := True;
@@ -927,7 +928,8 @@ begin
end;
function TWatchResultPrinter.PrintStruct(AResValue: TWatchResultData;
- const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String;
+ const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String
+ ): TStringBuilderPart;
const
VisibilityNames: array [TLzDbgFieldVisibility] of string = (
'', 'private', 'protected', 'public', 'published'
@@ -939,48 +941,51 @@ var
vis, sep, tn, Header, we, CurIndentString: String;
InclVisSect, OldHasLineBreak, CouldSingleLine, ShowMultiLine: Boolean;
MultiLine: TWatchDisplayFormatMultiline;
- Results: array of string;
FldIdx, Len, ForceSingleLineEach, ElemCnt, SepLen: Integer;
+ RR: TStringBuilderPart;
begin
inc(FCurrentMultilineLvl);
Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue);
- Result := '';
tn := AResValue.TypeName;
+ Header := '';
if (AResValue.StructType in [dstClass, dstInterface])
then begin
if (AResValue.DataAddress = 0) then begin
- //Result := PrintNumber(0, 0, FTargetAddressSize, Resolved.Num2);
- Result := 'nil';
+ //Header := PrintNumber(0, 0, FTargetAddressSize, Resolved.Num2);
if (Resolved.Address.TypeFormat = vdfAddressTyped) and (tn <> '') then
- Result := tn + '(' + Result + ')';
+ Result.RawAsStringPtr^ := tn + '(nil)'
+ else
+ Result.RawAsString := 'nil';
exit;
end;
if (Resolved.Struct.ShowPointerFormat <> vdfStructPointerOff) or (AResValue.FieldCount = 0)
then begin
// TODO: for 32 bit target, sign extend the 2nd argument
- Result := PrintNumber(AResValue.DataAddress, Int64(AResValue.DataAddress), FTargetAddressSize, Resolved.Num2, True);
+ Header := PrintNumber(AResValue.DataAddress, Int64(AResValue.DataAddress), FTargetAddressSize, Resolved.Num2, True);
if (Resolved.Address.TypeFormat = vdfAddressTyped) and (tn <> '') then begin
- Result := tn + '(' + Result + ')';
+ Header := tn + '(' + Header + ')';
tn := '';
end;
- if (Resolved.Struct.ShowPointerFormat = vdfStructPointerOnly) or (AResValue.FieldCount = 0) then
+ if (Resolved.Struct.ShowPointerFormat = vdfStructPointerOnly) or (AResValue.FieldCount = 0) then begin
+ Result.RawAsString := Header;
exit;
- end;
- end;
- Header := Result;
- Result := '';
+ end;
- if Header <> '' then
- Header := Header + ': ';
- if (Resolved.Struct.DataFormat <> vdfStructFull) and
- not(AResValue.StructType in [dstClass, dstInterface])
+ if Header <> '' then
+ Header := Header + ': ';
+ end;
+ end
+ else
+ if (Resolved.Struct.DataFormat <> vdfStructFull)
+ //and not(AResValue.StructType in [dstClass, dstInterface])
then
tn := '';
+
if AResValue.FieldCount = 0 then begin
- Result := Header + tn + '()';
+ Result.RawAsStringPtr^ := Header + tn + '()';
exit;
end;
@@ -1016,16 +1021,12 @@ begin
inc(FldIdx);
if InclVisSect then
inc(FldIdx);
- SetLength(Results, AResValue.FieldCount * FldIdx+1);
+ Result.RawPartCount := AResValue.FieldCount * FldIdx;
FldIdx := 0;
- if (Header <> '') or (tn <> '') then begin
- Results[FldIdx] := Header + tn + '(';
- inc(FldIdx);
- end;
Len := 0;
for FldInfo in AResValue do begin
if Len > 1 + 1000*1000 div Max(1, ANestLvl*4) then begin
- Results[FldIdx] := '...';
+ Result.RawPartsAsString[FldIdx] := '...';
inc(FldIdx);
break;
end;
@@ -1037,8 +1038,8 @@ begin
if (Resolved.Struct.DataFormat = vdfStructFull) and (FldOwner <> nil) and (FldOwner.DirectFieldCount > 0) and
(AResValue.StructType in [dstClass, dstInterface, dstObject]) // record has no inheritance
then begin
- Results[FldIdx] := '{' + FldOwner.TypeName + '}';
- Len := Len + Length(Results[FldIdx]) + SepLen;
+ Result.RawPartsAsString[FldIdx] := '{' + FldOwner.TypeName + '}';
+ Len := Len + Result.PartsTotalLen[FldIdx] + SepLen;
inc(FldIdx);
inc(FElementCount);
end;
@@ -1046,21 +1047,31 @@ begin
if InclVisSect and (vis <> VisibilityNames[FldInfo.FieldVisibility]) then begin
vis := VisibilityNames[FldInfo.FieldVisibility];
- Results[FldIdx] := vis;
- Len := Len + Length(Results[FldIdx]) + SepLen;
+ Result.RawPartsAsString[FldIdx] := vis;
+ Len := Len + Result.PartsTotalLen[FldIdx] + SepLen;
inc(FldIdx);
inc(FElementCount);
end;
ElemCnt := FElementCount;
- Results[FldIdx] := PrintWatchValueEx(FldInfo.Field, ADispFormat, ANestLvl, we + UpperCase(FldInfo.FieldName)) + ';';
- if Resolved.Struct.DataFormat <> vdfStructValOnly then
- Results[FldIdx] := FldInfo.FieldName + ': ' + Results[FldIdx];
- Len := Len + Length(Results[FldIdx]) + SepLen;
+
+ if Resolved.Struct.DataFormat <> vdfStructValOnly then begin
+ RR.RawPartCount := 2;
+ RR.RawPartsAsString[0] := FldInfo.FieldName;
+ RR.RawSeparator := ': ';
+ RR.RawParts[1] := PrintWatchValueEx(FldInfo.Field, ADispFormat, ANestLvl, we + UpperCase(FldInfo.FieldName));
+ end
+ else begin
+ RR.RawPartCount := 1;
+ RR.RawParts[0] := PrintWatchValueEx(FldInfo.Field, ADispFormat, ANestLvl, we + UpperCase(FldInfo.FieldName));
+ end;
+ RR.RawPostfix := '; ';
+ Result.RawParts[FldIdx] := RR;
+ Len := Len + RR.TotalLen + SepLen;
if CouldSingleLine and (
( (MultiLine.ForceSingleLineThresholdLen > 0) and
- (Length(Results[FldIdx]) > MultiLine.ForceSingleLineThresholdLen)
+ (Result.PartsTotalLen[FldIdx] > MultiLine.ForceSingleLineThresholdLen)
) or
(FElementCount - ElemCnt > ForceSingleLineEach) or
( (MultiLine.ForceSingleLineThresholdEach = 0) and (FldInfo.Field.ValueKind in [rdkArray, rdkStruct]) )
@@ -1071,7 +1082,7 @@ begin
inc(FldIdx);
end;
- SetLength(Results, FldIdx);
+ Result.RawChangePartCount(FldIdx);
if FHasLineBreak or
(Min(FDeepestMultilineLvl, MultiLine.MaxMultiLineDepth) - FCurrentMultilineLvl > MultiLine.ForceSingleLineReverseDepth)
then
@@ -1085,29 +1096,33 @@ begin
end
else
sep := ' ';
+ Result.RawSeparator := sep;
-
- dec(FldIdx);
if FHasLineBreak then
- Results[FldIdx] := Results[FldIdx] + sep + ')'
+ Result.RawPostfix := sep + ')'
else
- Results[FldIdx] := Results[FldIdx] + ')';
+ Result.RawPostfix := ')';
- if not ((Header <> '') or (tn <> '')) then
- Results[0] := '(' + Results[0];
+ if (Header <> '') or (tn <> '') then begin
+ Result.RawPrefix := Header + tn + '(' + Sep;
+ FHasLineBreak := sep <> ' ';
+ end
+ else
+ Result.RawPrefix := '(';
- Result := AnsiString.Join(sep, Results);
-
- if ((FldIdx > 0) and (Sep <> ' ')) or OldHasLineBreak then
+ if ((Result.RawPartCount > 1) and (Sep <> ' ')) or OldHasLineBreak then
FHasLineBreak := True;
FIndentString := CurIndentString;
end;
function TWatchResultPrinter.PrintConverted(AResValue: TWatchResultData;
- const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String;
+ const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String
+ ): TStringBuilderPart;
begin
- if AResValue.FieldCount = 0 then
- exit('Error: No result');
+ if AResValue.FieldCount = 0 then begin
+ Result.RawAsString := 'Error: No result';
+ exit;
+ end;
if (AResValue.FieldCount = 1) or
( (AResValue.Fields[0].Field <> nil) and
@@ -1119,31 +1134,35 @@ begin
end;
if (AResValue.FieldCount > 1) then begin
- Result := PrintWatchValueEx(AResValue.Fields[1].Field, ADispFormat, ANestLvl, AWatchedExpr);
if (AResValue.Fields[0].Field = nil) or
(AResValue.Fields[0].Field.ValueKind <> rdkError) or
(AResValue.Fields[0].Field.AsString <> '')
- then
- Result := Result + ' { '
- + PrintWatchValueEx(AResValue.Fields[0].Field, ADispFormat, ANestLvl, AWatchedExpr)
- + ' }';
+ then begin
+ Result.RawPartCount := 4;
+ Result.RawParts[0] := PrintWatchValueEx(AResValue.Fields[1].Field, ADispFormat, ANestLvl, AWatchedExpr);
+ Result.RawPartsAsString[1] := ' { ';
+ Result.RawParts[2] := PrintWatchValueEx(AResValue.Fields[0].Field, ADispFormat, ANestLvl, AWatchedExpr);
+ Result.RawPartsAsString[3] := ' }';
+ end
+ else
+ Result := PrintWatchValueEx(AResValue.Fields[1].Field, ADispFormat, ANestLvl, AWatchedExpr);
exit;
end;
- Result := 'Error: No result';
+ Result.RawAsString := 'Error: No result';
end;
function TWatchResultPrinter.PrintProc(AResValue: TWatchResultData;
- const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
+ const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): TStringBuilderPart;
var
Resolved: TResolvedDisplayFormat;
- s: String;
+ s, R: String;
begin
Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue);
- Result := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, TargetAddressSize, Resolved.Num2, True);
+ R := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, TargetAddressSize, Resolved.Num2, True);
if AResValue.AsString <> '' then
- Result := Result + ' = ' + AResValue.AsString;
+ R := R + ' = ' + AResValue.AsString;
if ANestLvl > 0 then begin
s := AResValue.TypeName;
@@ -1156,13 +1175,15 @@ begin
if s <> '' then
if AResValue.ValueKind in [rdkFunctionRef, rdkProcedureRef] then
- Result := Result + ': '+s
+ R := R + ': '+s
else
- Result := s + ' AT ' +Result;
+ R := s + ' AT ' +R;
+ Result.RawAsString := R;
end;
function TWatchResultPrinter.PrintWatchValueEx(AResValue: TWatchResultData;
- const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String;
+ const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String
+ ): TStringBuilderPart;
function PrintChar: String;
var
@@ -1260,11 +1281,12 @@ function TWatchResultPrinter.PrintWatchValueEx(AResValue: TWatchResultData;
var
PointerValue: TWatchResultDataPointer absolute AResValue;
- ResTypeName: String;
+ ResTypeName, R: String;
PtrDeref, PtrDeref2, OldCurrentResValue, OldParentResValue: TWatchResultData;
Resolved: TResolvedDisplayFormat;
n, OldCurrentMultilineLvl: Integer;
StoredSettings: TWatchResStoredSettings;
+ R2: PString;
begin
inc(ANestLvl);
OldCurrentResValue := FCurrentResValue;
@@ -1274,10 +1296,14 @@ begin
FCurrentResValue := AResValue;
inc(FElementCount);
try
- if ANestLvl > MAX_ALLOWED_NEST_LVL then
- exit('...');
- if AResValue = nil then
- exit('???');
+ if ANestLvl > MAX_ALLOWED_NEST_LVL then begin
+ Result.RawAsString := '...';
+ exit;
+ end;
+ if AResValue = nil then begin
+ Result.RawAsString := '???';
+ exit;
+ end;
if FCurrentValueFormatter <> nil then begin
StoreSetting(StoredSettings);
@@ -1288,8 +1314,10 @@ begin
FWatchedExprInFormatter := AWatchedExpr;
//
try
- if FCurrentValueFormatter.FormatValue(AResValue, ADispFormat, ANestLvl, Self, Result, FWatchedVarName, AWatchedExpr) then
+ R2 := Result.RawAsStringPtr;
+ if FCurrentValueFormatter.FormatValue(AResValue, ADispFormat, ANestLvl, Self, R2^, FWatchedVarName, AWatchedExpr) then begin
exit;
+ end;
finally
FNextCallIsValueFormatter := False;
RestoreSetting(StoredSettings);
@@ -1298,33 +1326,36 @@ begin
else
FCurrentValueFormatter := FNextValueFormatter;
- Result := '';
+ Result.Init;
case AResValue.ValueKind of
rdkError:
begin
- Result := 'Error: ' + AResValue.AsString;
if rpfClearMultiLine in FFormatFlags then
- Result := ClearMultiline(Result);
+ Result.RawAsStringPtr^ := 'Error: ' + ClearMultiline(AResValue.AsString)
+ else
+ Result.RawAsStringPtr^ := 'Error: ' + AResValue.AsString;
end;
rdkUnknown:
- Result := 'Error: Unknown';
+ Result.RawAsStringPtr^ := 'Error: Unknown';
rdkPrePrinted: begin
- Result := AResValue.AsString;
if rpfClearMultiLine in FFormatFlags then
- Result := ClearMultiline(Result);
+ Result.RawAsStringPtr^ := AResValue.AsString
+ else
+ Result.RawAsStringPtr^ := ClearMultiline(AResValue.AsString);
end;
rdkSignedNumVal,
rdkUnsignedNumVal: begin
Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue);
- Result := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, AResValue.ByteSize, Resolved.Num1);
+ R2 := Result.RawAsStringPtr;
+ R2^ := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, AResValue.ByteSize, Resolved.Num1);
if Resolved.Num2.Visible then begin
- Result := Result +' = ' +
+ R2^ := R2^ +' = ' +
PrintNumber(AResValue.AsQWord, AResValue.AsInt64, AResValue.ByteSize, Resolved.Num2);
end;
end;
rdkPointerVal: begin
Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue);
- Result := '';
+ R := '';
PtrDeref := PointerValue.DerefData;
if (Resolved.Pointer.DerefFormat = vdfPointerDerefOnly) then
@@ -1332,7 +1363,7 @@ begin
if (Resolved.Pointer.DerefFormat <> vdfPointerDerefOnly) or (PtrDeref = nil) then begin
n := AResValue.ByteSize;
if n = 0 then n := FTargetAddressSize;
- Result := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, n, Resolved.Num2, True);
+ R := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, n, Resolved.Num2, True);
if Resolved.Pointer.Address.TypeFormat = vdfAddressTyped then begin
ResTypeName := AResValue.TypeName;
if (ResTypeName = '') and (PtrDeref <> nil) then begin
@@ -1341,50 +1372,63 @@ begin
ResTypeName := '^'+ResTypeName;
end;
if ResTypeName <> '' then
- Result := ResTypeName + '(' + Result + ')';
+ R := ResTypeName + '(' + R + ')';
end;
end;
if (Resolved.Pointer.DerefFormat <> vdfPointerDerefOff) and (PtrDeref <> nil) then begin
while (PtrDeref.ValueKind = rdkPointerVal) and (PtrDeref.DerefData <> nil) do begin
PtrDeref2 := PtrDeref;
- Result := Result + '^';
+ R := R + '^';
PtrDeref := PtrDeref.DerefData;
end;
- if PtrDeref <> nil then
- Result := Result + '^: ' + PrintWatchValueEx(PtrDeref, ADispFormat, ANestLvl, AWatchedExpr+'^')
- else
- Result := Result + ': ' + PrintWatchValueEx(PtrDeref2, ADispFormat, ANestLvl, AWatchedExpr+'^');
- end;
+ Result.RawPartCount := 2;
+ if PtrDeref <> nil then begin
+ R := R + '^: ';
+ Result.RawParts[1] := PrintWatchValueEx(PtrDeref, ADispFormat, ANestLvl, AWatchedExpr+'^');
+ end
+ else begin
+ R := R + ': ';
+ Result.RawParts[1] := PrintWatchValueEx(PtrDeref2, ADispFormat, ANestLvl, AWatchedExpr+'^');
+ end;
+ Result.RawPartsAsString[0] := R;
+ end
+ else
+ Result.RawAsString := R;
end;
rdkFloatVal: begin
Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue);
if Resolved.Float.NumFormat = vdfFloatScientific then
case AResValue.FloatPrecission of
- dfpSingle: Result := FloatToStrF(AResValue.AsFloat, ffExponent, 9, 0);
- dfpDouble: Result := FloatToStrF(AResValue.AsFloat, ffExponent, 17, 0);
- dfpExtended: Result := FloatToStrF(AResValue.AsFloat, ffExponent, 21, 0);
+ dfpSingle: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffExponent, 9, 0);
+ dfpDouble: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffExponent, 17, 0);
+ dfpExtended: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffExponent, 21, 0);
end
else
case AResValue.FloatPrecission of
- dfpSingle: Result := FloatToStrF(AResValue.AsFloat, ffGeneral, 9, 0);
- dfpDouble: Result := FloatToStrF(AResValue.AsFloat, ffGeneral, 17, 0);
- dfpExtended: Result := FloatToStrF(AResValue.AsFloat, ffGeneral, 21, 0);
+ dfpSingle: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffGeneral, 9, 0);
+ dfpDouble: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffGeneral, 17, 0);
+ dfpExtended: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffGeneral, 21, 0);
end;
end;
- rdkChar: Result := PrintChar;
- rdkString: Result := QuoteText(AResValue.AsString);
- rdkWideString: Result := QuoteWideText(AResValue.AsWideString);
- rdkBool: Result := PrintBool;
+ rdkChar: Result.RawAsStringPtr^ := PrintChar;
+ rdkString: Result.RawAsStringPtr^ := QuoteText(AResValue.AsString);
+ rdkWideString: Result.RawAsStringPtr^ := QuoteWideText(AResValue.AsWideString);
+ rdkBool: Result.RawAsStringPtr^ := PrintBool;
rdkEnum, rdkEnumVal:
- Result := PrintEnum;
- rdkSet: Result := PrintSet;
+ Result.RawAsStringPtr^ := PrintEnum;
+ rdkSet: Result.RawAsStringPtr^ := PrintSet;
rdkPCharOrString: begin
+ Result.RawPartCount := 4;
AResValue.SetSelectedIndex(0); // pchar res
- Result := 'PChar: ' + PrintWatchValueEx(AResValue.SelectedEntry, ADispFormat, ANestLvl, AWatchedExpr);
+ Result.RawPartsAsString[0] := 'PChar: ';
+ Result.RawParts[1] := PrintWatchValueEx(AResValue.SelectedEntry, ADispFormat, ANestLvl, AWatchedExpr);
AResValue.SetSelectedIndex(1); // string res
- Result := Result + FLineSeparator
- + 'String: ' + PrintWatchValueEx(AResValue.SelectedEntry, ADispFormat, ANestLvl, AWatchedExpr);
+ if rpfClearMultiLine in FFormatFlags then
+ Result.RawPartsAsString[2] := ' - String: '
+ else
+ Result.RawPartsAsString[2] := FLineSeparator + 'String: ';
+ Result.RawParts[3] := PrintWatchValueEx(AResValue.SelectedEntry, ADispFormat, ANestLvl, AWatchedExpr);
end;
rdkArray: Result := PrintArray(AResValue, ADispFormat, ANestLvl, AWatchedExpr);
rdkStruct: Result := PrintStruct(AResValue, ADispFormat, ANestLvl, AWatchedExpr);
@@ -1419,6 +1463,8 @@ end;
function TWatchResultPrinter.PrintWatchValue(AResValue: TWatchResultData;
const ADispFormat: TWatchDisplayFormat; const AWatchedExpr: String): String;
+var
+ Res: TStringBuilderPart;
begin
FNextValueFormatter := nil;
if FOnlyValueFormatter <> nil then
@@ -1443,7 +1489,9 @@ begin
FCurrentMultilineLvl := 0;
FDeepestMultilineLvl := 0;
FDeepestArray := 0;
- Result := PrintWatchValueEx(AResValue, ADispFormat, -1, FWatchedVarName);
+ Res := PrintWatchValueEx(AResValue, ADispFormat, -1, FWatchedVarName);
+ Result := Res.GetFullString;
+ Res.FreeAll;
end;
function TWatchResultPrinter.PrintWatchValueIntf(AResValue: IWatchResultDataIntf;
@@ -1451,6 +1499,7 @@ function TWatchResultPrinter.PrintWatchValueIntf(AResValue: IWatchResultDataIntf
var
AResValObj: TWatchResultData;
IncLvl: Integer;
+ Res: TStringBuilderPart;
begin
AResValObj := TWatchResultData(AResValue.GetInternalObject);
FNextValueFormatter := nil;
@@ -1470,7 +1519,9 @@ begin
if FNextCallIsValueFormatter then begin
FNextCallIsValueFormatter := False;
- Result := PrintWatchValueEx(AResValObj, ADispFormat, FInValFormNestLevel - 1 + IncLvl, FWatchedExprInFormatter); // This will increase it by one, compared to the value given to the formatter
+ Res := PrintWatchValueEx(AResValObj, ADispFormat, FInValFormNestLevel - 1 + IncLvl, FWatchedExprInFormatter); // This will increase it by one, compared to the value given to the formatter
+ Result := Res.GetFullString;
+ Res.FreeAll;
end
else begin
// TOOD: full init? Or Call PrintWatchValueEx ?
@@ -1481,7 +1532,9 @@ begin
FCurrentMultilineLvl := 0;
FDeepestMultilineLvl := 0;
FDeepestArray := 0;
- Result := PrintWatchValueEx(AResValObj, ADispFormat, -1, FWatchedExprInFormatter);
+ Res := PrintWatchValueEx(AResValObj, ADispFormat, -1, FWatchedExprInFormatter);
+ Result := Res.GetFullString;
+ Res.FreeAll;
end;
end;
diff --git a/ide/packages/idedebugger/idedebuggerwatchresutils.pas b/ide/packages/idedebugger/idedebuggerwatchresutils.pas
index 2e2a77c895..add337111e 100644
--- a/ide/packages/idedebugger/idedebuggerwatchresutils.pas
+++ b/ide/packages/idedebugger/idedebuggerwatchresutils.pas
@@ -1,6 +1,8 @@
unit IdeDebuggerWatchResUtils;
{$mode objfpc}{$H+}
+{$IFDEF INLINE_OFF}{ $INLINE OFF}{$ENDIF}
+{$ModeSwitch advancedrecords}
interface
@@ -8,6 +10,140 @@ uses
Classes, SysUtils, IdeDebuggerWatchResult, LazDebuggerIntf,
IdeDebuggerWatchValueIntf;
+type
+
+ PStringBuilderPart = ^TStringBuilderPart;
+
+ { TStringBuilderPart }
+
+ TStringBuilderPart = record// object
+ private type
+ PHeader = ^THeader;
+ THeader = record
+ FTotalLen, FCount: Integer;
+ FPrefix, FPostfix, FSeparator: String;
+ end;
+ private const
+ HD_SIZE = sizeof(THeader);
+ private
+ FData: Pointer;
+ FType: (sbfString, sbfStringList, sbfPartList);
+ function GetAsString: String; inline;
+ function GetStringCount: Integer; inline;
+ function GetStrings(AnIndex: Integer): String; inline;
+ function GetPartCount: Integer; inline;
+ function GetParts(AnIndex: Integer): TStringBuilderPart; inline;
+ function GetPartsAsString(AnIndex: Integer): String; inline;
+ function GetPartsTotalLen(AnIndex: Integer): Integer; inline;
+ function GetPostfix: String; inline;
+ function GetPrefix: String; inline;
+ function GetSeparator: String; inline;
+ function GetRawPartsPtr(AnIndex: Integer): PStringBuilderPart; inline;
+ function GetTotalLen: integer; inline;
+ procedure SetAsString(const AValue: String); inline;
+ procedure SetStringCount(AValue: Integer); inline;
+ procedure SetStrings(AnIndex: Integer; const AValue: String); inline;
+ procedure SetPartCount(AValue: Integer); inline;
+ procedure SetParts(AnIndex: Integer; AValue: TStringBuilderPart); inline;
+ procedure SetPartsAsString(AnIndex: Integer; const AValue: String); inline;
+ procedure SetPostfix(const AValue: String); inline;
+ procedure SetPrefix(const AValue: String); inline;
+ procedure SetSeparator(const AValue: String); inline;
+ procedure SetRawAsString(const AValue: String); inline;
+ procedure SetRawStringCount(AValue: Integer); inline;
+ procedure SetRawStrings(AnIndex: Integer; const AValue: String); inline;
+ procedure SetRawPartCount(AValue: Integer); inline;
+ procedure SetRawParts(AnIndex: Integer; const AValue: TStringBuilderPart); inline;
+ procedure SetRawPartsAsString(AnIndex: Integer; const AValue: String);
+ procedure SetRawPostfix(const AValue: String); inline;
+ procedure SetRawPrefix(const AValue: String); inline;
+ procedure SetRawSeparator(const AValue: String); inline;
+ procedure DoFreeAll;
+ procedure WriteTo(var ADest: PChar);
+ public
+ procedure Init; inline; // Similar to "RawAsString := ''"
+ procedure FreeAll; inline;
+ function GetFullString: String;
+ property TotalLen: integer read GetTotalLen;
+
+ public
+ (* * Init: New TStringBuilderPart must be initialized with "Init"
+ * Strings[], Parts[], PartsAsString:
+ - Must only be accessed when the builder has been set to the matching
+ list type using StringCount or PartCount (index must be in range / no checks)
+ * Parts[]:
+ - Must not be changed inline.
+ - They must be assigned a new TStringBuilderPart that has its final value
+ - Once assigned changes can be made using PartAsString, AppendToPart, PrependToPart
+ * Prefix, PostFix, Separator:
+ - Must only be accessed when the builder is a list
+ *)
+
+ (* *** Single String sbfString *** *)
+ property AsString: String read GetAsString write SetAsString;
+
+ (* *** List of String sbfStringList *** *)
+ property StringCount: Integer read GetStringCount write SetStringCount;
+ procedure ChangeStringCount(ANewCount: Integer; ATrim: Boolean = False);
+ property Strings[AnIndex: Integer]: String read GetStrings write SetStrings;
+
+ (* *** List of embedded Parts (sub-builders) sbfPartList *** *)
+ property PartCount: Integer read GetPartCount write SetPartCount;
+ procedure ChangePartCount(ANewCount: Integer; ATrim: Boolean = False);
+ property Parts[AnIndex: Integer]: TStringBuilderPart read GetParts write SetParts;
+ // Set the "AsString" of a part that is already in the list
+ property PartsAsString[AnIndex: Integer]: String read GetPartsAsString write SetPartsAsString;
+ property PartsTotalLen[AnIndex: Integer]: Integer read GetPartsTotalLen;
+
+ // Append/Prepend to a part (either to the string, or Pre/FPostFix
+ procedure PrependToPart(AnIndex: Integer; const AValue: String);
+ procedure AppendToPart(AnIndex: Integer; const AValue: String);
+
+ (* *** List ... *** *)
+ property Prefix: String read GetPrefix write SetPrefix;
+ property Postfix: String read GetPostfix write SetPostfix;
+ property Separator: String read GetSeparator write SetSeparator;
+
+ public
+ (* *** RAW ACCESS ***
+ * All data must be user initialized
+ - The following methods will initialize data. (They are "write once". They must not be used to modify data):
+ Init, RawAsString, RawPartCount, RawStringCount, RawPartsAsString
+ * Once data/type (string, string-list, part-list) has been set/chosen, it must not be changed anymore
+ * RawParts:
+ - Each Part in "RawParts" must be either
+ - assigned once (with a part that has its data already)
+ - set with "PartAsString"
+ - Once a sub-part has been added, it must not be replaced
+ - Once a sub-part has been added, it must not be modified anymore
+ (except with Prepend/AppendToPart)
+ - Once a sub-part has been added, it is owned and must not be freed by itself
+ - Once a value has been set (subvalue, post/Rawprefix, ...), it must not be changed
+ - Change...Count is only to cut off uninitialized entries. (data will not be freed, if it had been assigned)
+ - Before "FreeAll": All strings/Rawparts must have been initialized (use RawChangeCount to cut off uninitialized entries)
+ *** Ptr / Pointer to String ***
+ * Using the builders string variable (via pointer) allows the compiler to reduce temporary string vars
+ *)
+ (* *** Single String sbfString *** *)
+ property RawAsString: String read GetAsString write SetRawAsString;
+ function RawAsStringPtr: PString;
+ (* *** List of String sbfStringList *** *)
+ property RawStringCount: Integer read GetStringCount write SetRawStringCount;
+ procedure RawChangeStringCount(ANewCount: Integer);
+ property RawStrings[AnIndex: Integer]: String read GetStrings write SetRawStrings;
+ (* *** List of embedded RawParts (sub-builders) sbfPartList *** *)
+ property RawPartCount: Integer read GetPartCount write SetRawPartCount;
+ procedure RawChangePartCount(ANewCount: Integer);
+ property RawParts[AnIndex: Integer]: TStringBuilderPart read GetParts write SetRawParts;
+ property RawPartsPtr[AnIndex: Integer]: PStringBuilderPart read GetRawPartsPtr;
+ // Set the "RawAsString" of a part that is already in the list (if it has no value yet)
+ property RawPartsAsString[AnIndex: Integer]: String read GetPartsAsString write SetRawPartsAsString;
+ (* *** List ... *** *)
+ property RawPrefix: String read GetPrefix write SetRawPrefix;
+ property RawPostfix: String read GetPostfix write SetRawPostfix;
+ property RawSeparator: String read GetSeparator write SetRawSeparator;
+ end;
+
function ExtractProcResFromMethod(AMethodRes: TWatchResultData): TWatchResultData;
function ExtractInstanceResFromMethod(AMethodRes: TWatchResultData): TWatchResultData;
@@ -47,5 +183,503 @@ begin
Result := AMethodRes.Fields[1].Field;
end;
+{ TStringBuilderPart }
+
+function TStringBuilderPart.GetAsString: String;
+begin
+ if FType = sbfString then
+ Result := String(FData)
+ else
+ Result := '';
+end;
+
+function TStringBuilderPart.GetStringCount: Integer;
+begin
+ if (FType = sbfStringList) and (FData <> nil) then
+ Result := PHeader(FData)^.FCount
+ else
+ Result := 0;
+end;
+
+function TStringBuilderPart.GetStrings(AnIndex: Integer): String;
+begin
+ Result := PString(FData + HD_SIZE)[AnIndex];
+end;
+
+function TStringBuilderPart.GetPartCount: Integer;
+begin
+ if (FType = sbfPartList) and (FData <> nil) then
+ Result := PHeader(FData)^.FCount
+ else
+ Result := 0;
+end;
+
+function TStringBuilderPart.GetParts(AnIndex: Integer): TStringBuilderPart;
+begin
+ Result := PStringBuilderPart(FData + HD_SIZE)[AnIndex];
+end;
+
+function TStringBuilderPart.GetPartsAsString(AnIndex: Integer): String;
+var
+ p: PStringBuilderPart;
+begin
+ p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
+ if p^.FType = sbfString then
+ Result := String(p^.FData)
+ else
+ Result := '';
+end;
+
+function TStringBuilderPart.GetPartsTotalLen(AnIndex: Integer): Integer;
+var
+ p: PStringBuilderPart;
+begin
+ p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
+ if p^.FType = sbfString then
+ Result := Length(String(p^.FData))
+ else
+ Result := PHeader(p^.FData)^.FTotalLen;
+end;
+
+function TStringBuilderPart.GetPostfix: String;
+begin
+ if (FType <> sbfString) and (FData <> nil) then
+ Result := PHeader(FData)^.FPostfix
+ else
+ Result := '';
+end;
+
+function TStringBuilderPart.GetPrefix: String;
+begin
+ if (FType <> sbfString) and (FData <> nil) then
+ Result := PHeader(FData)^.FPostfix
+ else
+ Result := '';
+end;
+
+function TStringBuilderPart.GetSeparator: String;
+begin
+ if (FType <> sbfString) and (FData <> nil) then
+ Result := PHeader(FData)^.FSeparator
+ else
+ Result := '';
+end;
+
+function TStringBuilderPart.GetRawPartsPtr(AnIndex: Integer): PStringBuilderPart;
+begin
+ Result := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
+end;
+
+function TStringBuilderPart.GetTotalLen: integer;
+begin
+ if (FType <> sbfString) and (FData <> nil) then
+ Result := PHeader(FData)^.FTotalLen
+ else
+ Result := Length(string(FData));
+end;
+
+procedure TStringBuilderPart.SetAsString(const AValue: String);
+begin
+ if FType <> sbfString then FreeAll;
+ FType := sbfString;
+ String(FData) := AValue;
+end;
+
+procedure TStringBuilderPart.SetStringCount(AValue: Integer);
+begin
+ if FType = sbfStringList then begin
+ ChangeStringCount(AValue, PHeader(FData)^.FCount > 2 * AValue);
+ end
+ else begin
+ if FData <> nil then
+ FreeAll;
+ FType := sbfStringList;
+ FData := AllocMem(HD_SIZE + AValue * SizeOf(string));
+ PHeader(FData)^.FCount := AValue;
+ end;
+end;
+
+procedure TStringBuilderPart.SetStrings(AnIndex: Integer; const AValue: String);
+var
+ ps: PString;
+begin
+ ps := @PString(FData + HD_SIZE)[AnIndex];
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen - Length(ps^) + Length(AValue);
+ ps^ := AValue;
+end;
+
+procedure TStringBuilderPart.SetPartCount(AValue: Integer);
+begin
+ if FType = sbfPartList then begin
+ ChangePartCount(AValue, PHeader(FData)^.FCount > 2 * AValue);
+ end
+ else begin
+ if FData <> nil then
+ FreeAll;
+ FType := sbfPartList;
+ FData := AllocMem(HD_SIZE + AValue * SizeOf(TStringBuilderPart));
+ PHeader(FData)^.FCount := AValue;
+ end;
+end;
+
+procedure TStringBuilderPart.SetParts(AnIndex: Integer; AValue: TStringBuilderPart);
+var
+ pp: PStringBuilderPart;
+begin
+ pp := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen - pp^.TotalLen + AValue.TotalLen;
+ pp^ := AValue;
+end;
+
+procedure TStringBuilderPart.SetPartsAsString(AnIndex: Integer; const AValue: String);
+var
+ p: PStringBuilderPart;
+ t: Integer;
+begin
+ p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
+ t := PHeader(FData)^.FTotalLen;
+ if p^.FType <> sbfString then begin
+ t := t - + p^.TotalLen;
+ p^.FreeAll;
+ end
+ else
+ t := t - Length(String(p^.FData));
+
+ p^.FType := sbfString;
+ String(p^.FData) := AValue;
+ t := t + Length(AValue);
+ PHeader(FData)^.FTotalLen := t;
+end;
+
+procedure TStringBuilderPart.SetPostfix(const AValue: String);
+begin
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen - Length(PHeader(FData)^.FPostfix) + Length(AValue);
+ PHeader(FData)^.FPostfix := AValue;
+end;
+
+procedure TStringBuilderPart.SetPrefix(const AValue: String);
+begin
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen - Length(PHeader(FData)^.FPrefix) + Length(AValue);
+ PHeader(FData)^.FPrefix := AValue;
+end;
+
+procedure TStringBuilderPart.SetSeparator(const AValue: String);
+begin
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + (Length(AValue) - Length(PHeader(FData)^.FSeparator)) * (PHeader(FData)^.FCount - 1);
+ PHeader(FData)^.FSeparator := AValue;
+end;
+
+procedure TStringBuilderPart.SetRawAsString(const AValue: String);
+begin
+ FType := sbfString;
+ FData := nil;
+ String(FData) := AValue;
+end;
+
+procedure TStringBuilderPart.SetRawStringCount(AValue: Integer);
+begin
+ FType := sbfStringList;
+ FData := GetMem(HD_SIZE + AValue * SizeOf(string));
+ FillChar(FData^,HD_SIZE,0);
+ PHeader(FData)^.FCount := AValue;
+end;
+
+procedure TStringBuilderPart.SetRawStrings(AnIndex: Integer; const AValue: String);
+begin
+ PString(FData + HD_SIZE)[AnIndex] := AValue;
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
+end;
+
+procedure TStringBuilderPart.SetRawPartCount(AValue: Integer);
+begin
+ FType := sbfPartList;
+ FData := GetMem(HD_SIZE + AValue * SizeOf(TStringBuilderPart));
+ FillChar(FData^,HD_SIZE,0);
+ PHeader(FData)^.FCount := AValue;
+end;
+
+procedure TStringBuilderPart.SetRawParts(AnIndex: Integer; const AValue: TStringBuilderPart);
+begin
+ PStringBuilderPart(FData + HD_SIZE)[AnIndex] := AValue;
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + AValue.TotalLen;
+end;
+
+procedure TStringBuilderPart.SetRawPartsAsString(AnIndex: Integer; const AValue: String);
+var
+ p: PStringBuilderPart;
+begin
+ p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
+ p^.FType := sbfString;
+ p^.FData := nil;
+ String(p^.FData) := AValue;
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
+end;
+
+procedure TStringBuilderPart.SetRawPostfix(const AValue: String);
+begin
+ PHeader(FData)^.FPostfix := AValue;
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
+end;
+
+procedure TStringBuilderPart.SetRawPrefix(const AValue: String);
+begin
+ PHeader(FData)^.FPrefix := AValue;
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
+end;
+
+procedure TStringBuilderPart.SetRawSeparator(const AValue: String);
+begin
+ PHeader(FData)^.FSeparator := AValue;
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue) * (PHeader(FData)^.FCount - 1);
+end;
+
+procedure TStringBuilderPart.DoFreeAll;
+var
+ ps: PString;
+ pp: PStringBuilderPart;
+ i: Integer;
+begin
+ case FType of
+ //sbfString:
+ // Finalize(String(FData));
+ sbfStringList: begin
+ Finalize(PHeader(FData)^.FPrefix);
+ Finalize(PHeader(FData)^.FPostfix);
+ Finalize(PHeader(FData)^.FSeparator);
+ ps := PString(FData + HD_SIZE);
+ for i := 0 to PHeader(FData)^.FCount - 1 do begin
+ Finalize(ps^);
+ inc(ps);
+ end;
+ Freemem(FData);
+ end;
+ sbfPartList: begin
+ Finalize(PHeader(FData)^.FPrefix);
+ Finalize(PHeader(FData)^.FPostfix);
+ Finalize(PHeader(FData)^.FSeparator);
+ pp := PStringBuilderPart(FData + HD_SIZE);
+ for i := 0 to PHeader(FData)^.FCount - 1 do begin
+ if pp^.FType = sbfString then
+ Finalize(String(pp^.FData))
+ else
+ //if pp^.FData <> nil then
+ pp^.DoFreeAll;
+ inc(pp);
+ end;
+ Freemem(FData);
+ end;
+ end;
+end;
+
+procedure TStringBuilderPart.WriteTo(var ADest: PChar);
+var
+ ps: PString;
+ pp: PStringBuilderPart;
+ i, c: Integer;
+ txt: PChar;
+ len: Integer;
+begin
+ if FData = nil then
+ exit;
+
+ case FType of
+ sbfString: begin
+ len := Length(String(FData));
+ move(FData^, ADest^, len);
+ inc(ADest, len);
+ end;
+ sbfStringList: begin
+ len := Length(PHeader(FData)^.FPrefix);
+ if len > 0 then begin
+ move(PChar(PHeader(FData)^.FPrefix)^, ADest^, len);
+ inc(ADest, len)
+ end;
+ len := Length(PHeader(FData)^.FSeparator);
+ ps := PString(FData + HD_SIZE);
+ c := PHeader(FData)^.FCount;
+ if (c > 1) and (len > 0) then begin
+ txt := PChar(PHeader(FData)^.FSeparator);
+ for i := c - 2 downto 0 do begin
+ move(pchar(ps^)^, ADest^, Length(String(ps^)));
+ inc(ADest, Length(ps^));
+ inc(ps);
+ move(txt^, ADest^, len);
+ inc(ADest, len)
+ end;
+ move(pchar(ps^)^, ADest^, Length(String(ps^)));
+ inc(ADest, Length(ps^));
+ end
+ else begin
+ for i := c - 1 downto 0 do begin
+ move(pchar(ps^)^, ADest^, Length(String(ps^)));
+ inc(ADest, Length(ps^));
+ inc(ps);
+ end;
+ end;
+ len := Length(PHeader(FData)^.FPostfix);
+ if len > 0 then begin
+ move(PChar(PHeader(FData)^.FPostfix)^, ADest^, len);
+ inc(ADest, len)
+ end;
+ end;
+ sbfPartList: begin
+ len := Length(PHeader(FData)^.FPrefix);
+ if len > 0 then begin
+ move(PChar(PHeader(FData)^.FPrefix)^, ADest^, len);
+ inc(ADest, len)
+ end;
+ len := Length(PHeader(FData)^.FSeparator);
+ pp := PStringBuilderPart(FData + HD_SIZE);
+ c := PHeader(FData)^.FCount;
+ if (c > 1) and (len > 0) then begin
+ txt := PChar(PHeader(FData)^.FSeparator);
+ for i := c - 2 downto 0 do begin
+ pp^.WriteTo(ADest);
+ inc(pp);
+ move(txt^, ADest^, len);
+ inc(ADest, len)
+ end;
+ pp^.WriteTo(ADest);
+ end
+ else begin
+ for i := c- 1 downto 0 do begin
+ pp^.WriteTo(ADest);
+ inc(pp);
+ end;
+ end;
+ len := Length(PHeader(FData)^.FPostfix);
+ if len > 0 then begin
+ move(PChar(PHeader(FData)^.FPostfix)^, ADest^, len);
+ inc(ADest, len)
+ end;
+ end;
+ end;
+end;
+
+procedure TStringBuilderPart.Init;
+begin
+ FData := Nil;
+end;
+
+procedure TStringBuilderPart.FreeAll;
+begin
+ if FData = nil then
+ exit;
+
+ if FType = sbfString then
+ Finalize(String(FData))
+ else
+ DoFreeAll;
+ FData := nil;
+end;
+
+function TStringBuilderPart.GetFullString: String;
+var
+ p: PChar;
+begin
+ if FData = nil then
+ exit('');
+ if FType = sbfString then
+ exit(string(FData));
+
+ SetLength(Result, PHeader(FData)^.FTotalLen);
+ p := pchar(Result);
+ WriteTo(p);
+ assert(p = Pchar(Result)+Length(Result), 'TStringBuilderPart.GetFullString: p = Pchar(Result)+Length(Result)');
+end;
+
+procedure TStringBuilderPart.ChangeStringCount(ANewCount: Integer; ATrim: Boolean);
+var
+ i, t: Integer;
+ ps: PString;
+begin
+ t := PHeader(FData)^.FTotalLen;
+ ps := @PString(FData + HD_SIZE)[ANewCount];
+ for i := ANewCount to PHeader(FData)^.FCount -1 do begin
+ t := t - Length(ps^);
+ ps^ := '';
+ inc(ps);
+ end;
+ if ATrim or (ANewCount > PHeader(FData)^.FCount) then
+ FData := ReAllocMem(FData, HD_SIZE + ANewCount * SizeOf(string));
+ t := t + Length(PHeader(FData)^.FSeparator) * (ANewCount - PHeader(FData)^.FCount);
+ PHeader(FData)^.FTotalLen := t;
+ PHeader(FData)^.FCount := ANewCount;
+end;
+
+procedure TStringBuilderPart.ChangePartCount(ANewCount: Integer; ATrim: Boolean);
+var
+ i, t: Integer;
+ pp: PStringBuilderPart;
+begin
+ t := PHeader(FData)^.FTotalLen;
+ pp := @PStringBuilderPart(FData + HD_SIZE)[ANewCount];
+ for i := ANewCount to PHeader(FData)^.FCount -1 do begin
+ t := t - pp^.TotalLen;
+ pp^.FreeAll;
+ inc(pp);
+ end;
+ if ATrim or (ANewCount > PHeader(FData)^.FCount) then
+ FData := ReAllocMem(FData, HD_SIZE + ANewCount * SizeOf(TStringBuilderPart));
+ t := t + Length(PHeader(FData)^.FSeparator) * (ANewCount - PHeader(FData)^.FCount);
+ PHeader(FData)^.FTotalLen := t;
+ PHeader(FData)^.FCount := ANewCount;
+end;
+
+procedure TStringBuilderPart.PrependToPart(AnIndex: Integer; const AValue: String);
+var
+ p: PStringBuilderPart;
+begin
+ p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
+ case p^.FType of
+ sbfString: String(p^.FData) := AValue + String(p^.FData);
+ sbfStringList,
+ sbfPartList: begin
+ PHeader(p^.FData)^.FPrefix := AValue + PHeader(p^.FData)^.FPrefix;
+ PHeader(p^.FData)^.FTotalLen := PHeader(p^.FData)^.FTotalLen + Length(AValue);
+ end;
+ end;
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
+end;
+
+procedure TStringBuilderPart.AppendToPart(AnIndex: Integer; const AValue: String);
+var
+ p: PStringBuilderPart;
+begin
+ p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
+ case p^.FType of
+ sbfString: String(p^.FData) := String(p^.FData) + AValue;
+ sbfStringList,
+ sbfPartList: begin
+ PHeader(p^.FData)^.FPostfix := PHeader(p^.FData)^.FPostfix + AValue;
+ PHeader(p^.FData)^.FTotalLen := PHeader(p^.FData)^.FTotalLen + Length(AValue);
+ end;
+ end;
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
+end;
+
+function TStringBuilderPart.RawAsStringPtr: PString;
+begin
+ FType := sbfString;
+ FData := nil;
+Result := PString(@FData )
+end;
+
+procedure TStringBuilderPart.RawChangeStringCount(ANewCount: Integer);
+begin
+ if ANewCount > PHeader(FData)^.FCount then
+ FData := ReAllocMem(FData, HD_SIZE + ANewCount * SizeOf(string));
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(PHeader(FData)^.FSeparator) * (ANewCount - PHeader(FData)^.FCount);
+ PHeader(FData)^.FCount := ANewCount;
+end;
+
+procedure TStringBuilderPart.RawChangePartCount(ANewCount: Integer);
+begin
+ if ANewCount > PHeader(FData)^.FCount then
+ FData := ReAllocMem(FData, HD_SIZE + ANewCount * SizeOf(TStringBuilderPart));
+ PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(PHeader(FData)^.FSeparator) * (ANewCount - PHeader(FData)^.FCount);
+ PHeader(FData)^.FCount := ANewCount;
+end;
+
end.