paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 01:28:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

Debugger: utf8 content for event-log (warnings/OutputDebugString). Issue #24353

Browse Source 
git-svn-id: trunk@41240 -
This commit is contained in:
martin 2013-05-17 18:45:04 +00:00
parent 031b757eb3
commit 6cb4b3e1fd
2 changed files with 54 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
debugger/debugutils.pp
View File

@ -69,6 +69,7 @@ function GetLine(var ABuffer: String): String;
function ConvertToCString(const AText: String): String;
function ConvertPathDelims(const AFileName: String): String;
function DeleteEscapeChars(const AValue: String; const AEscapeChar: Char = '\'): String;
function MakePrintable(const AString: String): String; // Make a pascal like string
function UnEscapeBackslashed(const AValue: String; AFlags: TGdbUnEscapeFlags = [uefOctal]; ATabWidth: Integer = 0): String;
function UnQuote(const AValue: String): String;
function Quote(const AValue: String; AForce: Boolean=False): String;
@ -198,6 +199,58 @@ begin
Result[i] := PathDelim;
end;
function MakePrintable(const AString: String): String; // Todo: Check invalid utf8
// Astring should not have quotes
var
n, l, u: Integer;
InString: Boolean;
procedure ToggleInString;
begin
InString := not InString;
Result := Result + '''';
end;
begin
Result := '';
InString := False;
n := 1;
l := Length(AString);
while n <= l do
//for n := 1 to Length(AString) do
begin
case AString[n] of
' '..#127: begin
if not InString then
ToggleInString;
Result := Result + AString[n];
//if AString[n] = '''' then Result := Result + '''';
end;
#192..#255: begin // Maybe utf8
u := UTF8CharacterLength(@AString[n]);
if (u > 0) and (n+u-1 <= l) then begin
if not InString then
ToggleInString;
Result := Result + copy(AString, n, u);
n := n + u - 1;
end
else begin
if InString then
ToggleInString;
Result := Result + Format('#%d', [Ord(AString[n])]);
end;
end;
else
if InString then
ToggleInString;
Result := Result + Format('#%d', [Ord(AString[n])]);
end;
inc(n);
end;
if InString
then Result := Result + '''';
end;
function UnEscapeBackslashed(const AValue: String; AFlags: TGdbUnEscapeFlags = [uefOctal]; ATabWidth: Integer = 0): String;
var
c, cnt, len: Integer;

54
debugger/gdbmidebugger.pp
View File

@ -2080,7 +2080,7 @@ var
begin
InLogWarning := True;
Delete(Warning, 1, Length(LogWarning));
Warning := Trim(Warning);
Warning := MakePrintable(UnEscapeBackslashed(Trim(Warning), [uefOctal, uefTab, uefNewLine]));
DoDbgEvent(ecOutput, etOutputDebugString, Warning);
end;
if InLogWarning then
@ -11809,58 +11809,6 @@ function TGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
var
TypeInfoFlags: TGDBTypeCreationFlags;
function MakePrintable(const AString: String): String; // Todo: Check invalid utf8
// Astring should not have quotes
var
n, l, u: Integer;
InString: Boolean;
procedure ToggleInString;
begin
InString := not InString;
Result := Result + '''';
end;
begin
Result := '';
InString := False;
n := 1;
l := Length(AString);
while n <= l do
//for n := 1 to Length(AString) do
begin
case AString[n] of
' '..#127: begin
if not InString then
ToggleInString;
Result := Result + AString[n];
//if AString[n] = '''' then Result := Result + '''';
end;
#192..#255: begin // Maybe utf8
u := UTF8CharacterLength(@AString[n]);
if (u > 0) and (n+u-1 <= l) then begin
if not InString then
ToggleInString;
Result := Result + copy(AString, n, u);
n := n + u - 1;
end
else begin
if InString then
ToggleInString;
Result := Result + Format('#%d', [Ord(AString[n])]);
end;
end;
else
if InString then
ToggleInString;
Result := Result + Format('#%d', [Ord(AString[n])]);
end;
inc(n);
end;
if InString
then Result := Result + '''';
end;
function FormatResult(const AInput: String; IsArray: Boolean = False): String;
const
INDENTSTRING = ' ';