paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 10:46:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-js: adapted jswriter for pas2js

Browse Source 
git-svn-id: trunk@39898 -
This commit is contained in:
Mattias Gaertner 2018-10-07 12:58:35 +00:00
parent e644e6332b
commit ddf409d7ad
2 changed files with 58 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
packages/fcl-js/src/jsbase.pp
View File

@ -25,6 +25,9 @@ uses
{$endif} {$endif}
Classes, SysUtils; Classes, SysUtils;
const
MinSafeIntDouble = -$10000000000000; // -4503599627370496
MaxSafeIntDouble = $fffffffffffff; // 4503599627370495
Type Type
TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion); TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);

107
packages/fcl-js/src/jswriter.pp
View File

@ -517,26 +517,26 @@ function TJSWriter.EscapeString(const S: TJSString; Quote: TJSEscapeQuote
Var Var
I,J,L : Integer; I,J,L : Integer;
P : TJSPChar;
R: TJSString; R: TJSString;
c: Char;
begin begin
I:=1; I:=1;
J:=1; J:=1;
R:=''; R:='';
L:=Length(S); L:=Length(S);
P:=TJSPChar(S);
While I<=L do While I<=L do
begin begin
if (P^ in [#0..#31,'"','''','/','\']) then c:=S[I];
if (c in [#0..#31,'"','''','/','\']) then
begin begin
R:=R+Copy(S,J,I-J); R:=R+Copy(S,J,I-J);
Case P^ of Case c of
'\' : R:=R+'\\'; '\' : R:=R+'\\';
'/' : R:=R+'\/'; '/' : R:=R+'\/';
'"' : if Quote=jseqSingle then R:=R+'"' else R:=R+'\"'; '"' : if Quote=jseqSingle then R:=R+'"' else R:=R+'\"';
'''': if Quote=jseqDouble then R:=R+'''' else R:=R+'\'''; '''': if Quote=jseqDouble then R:=R+'''' else R:=R+'\''';
#0..#7,#11,#14..#31: R:=R+'\x'+TJSString(hexStr(ord(P^),2)); #0..#7,#11,#14..#31: R:=R+'\x'+TJSString(hexStr(ord(c),2));
#8 : R:=R+'\b'; #8 : R:=R+'\b';
#9 : R:=R+'\t'; #9 : R:=R+'\t';
#10 : R:=R+'\n'; #10 : R:=R+'\n';
@ -546,7 +546,6 @@ begin
J:=I+1; J:=I+1;
end; end;
Inc(I); Inc(I);
Inc(P);
end; end;
R:=R+Copy(S,J,I-1); R:=R+Copy(S,J,I-1);
Result:=R; Result:=R;
@ -556,32 +555,36 @@ procedure TJSWriter.WriteValue(V: TJSValue);
const const
TabWidth = 4; TabWidth = 4;
function GetLineIndent(var p: PWideChar): integer; function GetLineIndent(const S: TJSString; var p: integer): integer;
var var
h: PWideChar; h, l: integer;
begin begin
h:=p; h:=p;
l:=length(S);
Result:=0; Result:=0;
repeat while h<=l do
case h^ of begin
#0: break; case S[h] of
#9: Result:=Result+(TabWidth-Result mod TabWidth); #9: Result:=Result+(TabWidth-Result mod TabWidth);
' ': inc(Result); ' ': inc(Result);
else break; else break;
end; end;
inc(h); inc(h);
until false; end;
p:=h; p:=h;
end; end;
function SkipToNextLineStart(p: PWideChar): PWideChar; function SkipToNextLineStart(const S: TJSString; p: integer): integer;
var
l: Integer;
begin begin
repeat l:=length(S);
case p^ of while p<=l do
#0: break; begin
case S[p] of
#10,#13: #10,#13:
begin begin
if (p[1] in [#10,#13]) and (p^<>p[1]) then if (p<l) and (S[p+1] in [#10,#13]) and (S[p]<>S[p+1]) then
inc(p,2) inc(p,2)
else else
inc(p); inc(p);
@ -589,14 +592,14 @@ const
end end
else inc(p); else inc(p);
end; end;
until false; end;
Result:=p; Result:=p;
end; end;
Var Var
S , S2: String; S , S2: String;
JS: TJSString; JS: TJSString;
p, StartP: PWideChar; p, StartP: Integer;
MinIndent, CurLineIndent, j, Exp, Code: Integer; MinIndent, CurLineIndent, j, Exp, Code: Integer;
i: SizeInt; i: SizeInt;
D: TJSNumber; D: TJSNumber;
@ -606,8 +609,8 @@ begin
JS:=V.CustomValue; JS:=V.CustomValue;
if JS='' then exit; if JS='' then exit;
p:=SkipToNextLineStart(PWideChar(JS)); p:=SkipToNextLineStart(JS,1);
if p^=#0 then if p>length(JS) then
begin begin
// simple value // simple value
Write(JS); Write(JS);
@ -619,21 +622,21 @@ begin
// find minimum indent // find minimum indent
MinIndent:=-1; MinIndent:=-1;
repeat repeat
CurLineIndent:=GetLineIndent(p); CurLineIndent:=GetLineIndent(JS,p);
if (MinIndent<0) or (MinIndent>CurLineIndent) then if (MinIndent<0) or (MinIndent>CurLineIndent) then
MinIndent:=CurLineIndent; MinIndent:=CurLineIndent;
p:=SkipToNextLineStart(p); p:=SkipToNextLineStart(JS,p);
until p^=#0; until p>length(JS);
// write value lines indented // write value lines indented
p:=PWideChar(JS); p:=1;
GetLineIndent(p); // the first line is already indented, skip GetLineIndent(JS,p); // the first line is already indented, skip
repeat repeat
StartP:=p; StartP:=p;
p:=SkipToNextLineStart(StartP); p:=SkipToNextLineStart(JS,StartP);
Write(copy(JS,StartP-PWideChar(JS)+1,p-StartP)); Write(copy(JS,StartP,p-StartP));
if p^=#0 then break; if p>length(JS) then break;
CurLineIndent:=GetLineIndent(p); CurLineIndent:=GetLineIndent(JS,p);
Write(StringOfChar(FIndentChar,FCurIndent+CurLineIndent-MinIndent)); Write(StringOfChar(FIndentChar,FCurIndent+CurLineIndent-MinIndent));
until false; until false;
@ -655,8 +658,8 @@ begin
end; end;
jstNumber : jstNumber :
if (Frac(V.AsNumber)=0) if (Frac(V.AsNumber)=0)
and (V.AsNumber>double(low(int64))) and (V.AsNumber>=double(MinSafeIntDouble))
and (V.AsNumber<double(high(int64))) then and (V.AsNumber<=double(MaxSafeIntDouble)) then
begin begin
Str(Round(V.AsNumber),S); Str(Round(V.AsNumber),S);
end end
@ -796,7 +799,7 @@ constructor TJSWriter.Create(AWriter: TTextWriter);
begin begin
FWriter:=AWriter; FWriter:=AWriter;
FIndentChar:=' '; FIndentChar:=' ';
FOptions:=[woUseUTF8]; FOptions:=[{$ifdef fpc}woUseUTF8{$endif}];
end; end;
{$ifdef fpc} {$ifdef fpc}
@ -918,13 +921,15 @@ end;
procedure TJSWriter.WriteArrayLiteral(El: TJSArrayLiteral); procedure TJSWriter.WriteArrayLiteral(El: TJSArrayLiteral);
type
BracketString = string{$ifdef fpc}[2]{$endif};
Var Var
Chars : Array[Boolean] of string[2] = ('[]','()'); Chars : Array[Boolean] of BracketString = ('[]','()');
Var Var
i,C : Integer; i,C : Integer;
isArgs,WC , MultiLine: Boolean; isArgs,WC , MultiLine: Boolean;
BC : String[2]; BC : BracketString;
begin begin
isArgs:=El is TJSArguments; isArgs:=El is TJSArguments;
@ -1201,7 +1206,7 @@ end;
procedure TJSWriter.WriteBinary(El: TJSBinary); procedure TJSWriter.WriteBinary(El: TJSBinary);
Var Var
S : AnsiString; S : String;
AllowCompact, WithBrackets: Boolean; AllowCompact, WithBrackets: Boolean;
begin begin
{$IFDEF VerboseJSWriter} {$IFDEF VerboseJSWriter}
@ -1278,7 +1283,7 @@ end;
procedure TJSWriter.WriteAssignStatement(El: TJSAssignStatement); procedure TJSWriter.WriteAssignStatement(El: TJSAssignStatement);
Var Var
S : AnsiString; S : String;
begin begin
WriteJS(El.LHS); WriteJS(El.LHS);
Writer.CurElement:=El; Writer.CurElement:=El;
@ -1827,6 +1832,7 @@ begin
FCurColumn:=1; FCurColumn:=1;
end; end;
{$ifdef fpc}
function TTextWriter.Write(const S: UnicodeString): Integer; function TTextWriter.Write(const S: UnicodeString): Integer;
var var
p: PWideChar; p: PWideChar;
@ -1859,38 +1865,35 @@ begin
inc(p); inc(p);
until false; until false;
end; end;
{$endif}
function TTextWriter.Write(const S: TJSWriterString): Integer; function TTextWriter.Write(const S: TJSWriterString): Integer;
var var
p: PChar;
c: Char; c: Char;
l, p: Integer;
begin begin
if S='' then exit; if S='' then exit;
Writing; Writing;
Result:=DoWrite(S); Result:=DoWrite(S);
p:=PChar(S); l:=length(S);
repeat p:=1;
c:=p^; while p<=l do
begin
c:=S[p];
case c of case c of
#0:
if p-PChar(S)=length(S) then
break
else
inc(FCurColumn);
#10,#13: #10,#13:
begin begin
FCurColumn:=1; FCurColumn:=1;
inc(FCurLine); inc(FCurLine);
inc(p); inc(p);
if (p^ in [#10,#13]) and (c<>p^) then inc(p); if (p<=l) and (S[p] in [#10,#13]) and (c<>S[p]) then inc(p);
continue;
end; end;
else else
// ignore UTF-8 multibyte chars, CurColumn is char index, not codepoint // Note about UTF-8 multibyte chars: CurColumn is char index, not codepoint
inc(FCurColumn); inc(FCurColumn);
end;
inc(p); inc(p);
until false; end;
end;
end; end;
function TTextWriter.WriteLn(const S: TJSWriterString): Integer; function TTextWriter.WriteLn(const S: TJSWriterString): Integer;
@ -1933,7 +1936,7 @@ begin
{$ifdef pas2js} {$ifdef pas2js}
case jsTypeOf(V) of case jsTypeOf(V) of
'boolean': 'boolean':
S:=if V then S:='true' else S:='false'; if V then S:='true' else S:='false';
'number': 'number':
if isInteger(V) then if isInteger(V) then
S:=str(NativeInt(V)) S:=str(NativeInt(V))