1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
2 * Understanding is not required. Only obedience.
4 * This program is free software: you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 3 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 {$INCLUDE a_modes.inc}
18 {.$DEFINE XPARSER_DEBUG}
24 SysUtils
, Classes
{$IFDEF USE_MEMPOOL}, mempool
{$ENDIF};
27 // ////////////////////////////////////////////////////////////////////////// //
31 TParserException
= class(Exception
)
33 tokLine
, tokCol
: Integer;
36 constructor Create (pr
: TTextParser
; const amsg
: AnsiString);
37 constructor CreateFmt (pr
: TTextParser
; const afmt
: AnsiString; const args
: array of const);
40 TTextParser
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
47 //TTFloat = 3; // not yet
49 TTDelim
= 5; // one-char delimiters
54 TTGreatEqu
= 14; // >=
56 TTEqu
= 16; // == or <>
65 SignedNumbers
, // allow signed numbers; otherwise sign will be TTDelim
66 DollarIsId
, // allow dollar in identifiers; otherwise dollar will be TTDelim
67 DotIsId
, // allow dot in identifiers; otherwise dot will be TTDelim
68 DashIsId
, // '-' can be part of identifier (but identifier cannot start with '-')
69 HtmlColors
, // #rgb or #rrggbb colors
70 PascalComments
// allow `{}` pascal comments
72 TOptions
= set of TOption
;
76 TAnsiCharSet
= set of AnsiChar;
83 mCharBuf
: packed array [0..CharBufSize
-1] of AnsiChar;
84 mCharBufUsed
: Integer;
86 mEofHit
: Boolean; // no more chars to load into mCharBuf
90 mTokLine
, mTokCol
: Integer; // token start
92 mTokStr
: AnsiString; // string or identifier
93 mTokChar
: AnsiChar; // for delimiters
97 procedure fillCharBuf ();
98 function popFrontChar (): AnsiChar; inline; // never drains char buffer (except on "total EOF")
99 function peekCurChar (): AnsiChar; inline;
100 function peekNextChar (): AnsiChar; inline;
101 function peekChar (dest
: Integer): AnsiChar; inline;
104 function loadChar (): AnsiChar; virtual; abstract; // loads next char; #0 means 'eof'
107 function isIdStartChar (ch
: AnsiChar): Boolean; inline;
108 function isIdMidChar (ch
: AnsiChar): Boolean; inline;
111 constructor Create (aopts
: TOptions
=[TOption
.SignedNumbers
]);
112 destructor Destroy (); override;
114 procedure error (const amsg
: AnsiString); noreturn
;
115 procedure errorfmt (const afmt
: AnsiString; const args
: array of const); noreturn
;
117 function skipChar (): Boolean; // returns `false` on eof
119 function skipBlanks (): Boolean; // ...and comments; returns `false` on eof
121 function skipToken (): Boolean; // returns `false` on eof
122 {$IFDEF XPARSER_DEBUG}
123 function skipToken1 (): Boolean;
126 function isEOF (): Boolean; inline;
127 function isId (): Boolean; inline;
128 function isInt (): Boolean; inline;
129 function isStr (): Boolean; inline;
130 function isDelim (): Boolean; inline;
131 function isIdOrStr (): Boolean; inline;
133 function expectId (): AnsiString;
134 procedure expectId (const aid
: AnsiString; caseSens
: Boolean=true);
135 function eatId (const aid
: AnsiString; caseSens
: Boolean=true): Boolean;
136 function eatIdOrStr (const aid
: AnsiString; caseSens
: Boolean=true): Boolean;
137 function eatIdOrStrCI (const aid
: AnsiString): Boolean; inline;
139 function expectStr (allowEmpty
: Boolean=false): AnsiString;
140 function expectInt (): Integer;
142 function expectIdOrStr (allowEmpty
: Boolean=false): AnsiString;
144 procedure expectTT (ttype
: Integer);
145 function eatTT (ttype
: Integer): Boolean;
147 procedure expectDelim (const ch
: AnsiChar);
148 function expectDelims (const ch
: TAnsiCharSet
): AnsiChar;
149 function eatDelim (const ch
: AnsiChar): Boolean;
151 function isDelim (const ch
: AnsiChar): Boolean; inline;
154 property options
: TOptions read mOptions write mOptions
;
157 property col
: Integer read mCol
;
158 property line
: Integer read mLine
;
160 property curChar
: AnsiChar read peekCurChar
;
161 property nextChar
: AnsiChar read peekNextChar
;
164 property tokCol
: Integer read mTokCol
;
165 property tokLine
: Integer read mTokLine
;
167 property tokType
: Integer read mTokType
; // see TTXXX constants
168 property tokStr
: AnsiString read mTokStr
; // string or identifier
169 property tokChar
: AnsiChar read mTokChar
; // for delimiters
170 property tokInt
: Integer read mTokInt
;
174 // ////////////////////////////////////////////////////////////////////////// //
176 TFileTextParser
= class(TTextParser
)
178 const BufSize
= 16384;
182 mStreamOwned
: Boolean;
188 function loadChar (): AnsiChar; override; // loads next char; #0 means 'eof'
191 constructor Create (const fname
: AnsiString; aopts
: TOptions
=[TOption
.SignedNumbers
]);
192 constructor Create (st
: TStream
; astOwned
: Boolean=true; aopts
: TOptions
=[TOption
.SignedNumbers
]);
193 destructor Destroy (); override;
196 TStrTextParser
= class(TTextParser
)
202 function loadChar (): AnsiChar; override; // loads next char; #0 means 'eof'
205 constructor Create (const astr
: AnsiString; aopts
: TOptions
=[TOption
.SignedNumbers
]);
206 destructor Destroy (); override;
210 // ////////////////////////////////////////////////////////////////////////// //
217 procedure putBuf (constref buf
; len
: SizeUInt
); virtual; abstract;
220 constructor Create ();
222 procedure flush (); virtual;
224 procedure put (const s
: AnsiString); overload
;
225 procedure put (v
: Byte); overload
;
226 procedure put (v
: Integer); overload
;
227 procedure put (const fmt
: AnsiString; args
: array of const); overload
;
228 procedure putIndent ();
230 procedure unindent ();
233 property curIndent
: Integer read mIndent
;
237 // ////////////////////////////////////////////////////////////////////////// //
239 TFileTextWriter
= class(TTextWriter
)
241 const BufSize
= 16384;
245 mStreamOwned
: Boolean;
250 procedure putBuf (constref buf
; len
: SizeUInt
); override;
253 constructor Create (const fname
: AnsiString);
254 constructor Create (ast
: TStream
; astOwned
: Boolean=true); // will own the stream by default
255 destructor Destroy (); override;
257 procedure flush (); override;
260 TStrTextWriter
= class(TTextWriter
)
265 procedure putBuf (constref buf
; len
: SizeUInt
); override;
268 constructor Create ();
269 destructor Destroy (); override;
271 property str
: AnsiString read mStr
;
281 // ////////////////////////////////////////////////////////////////////////// //
282 constructor TParserException
.Create (pr
: TTextParser
; const amsg
: AnsiString);
284 if (pr
<> nil) then begin tokLine
:= pr
.tokLine
; tokCol
:= pr
.tokCol
; end;
285 inherited Create(amsg
);
288 constructor TParserException
.CreateFmt (pr
: TTextParser
; const afmt
: AnsiString; const args
: array of const);
290 if (pr
<> nil) then begin tokLine
:= pr
.tokLine
; tokCol
:= pr
.tokCol
; end;
291 inherited Create(formatstrf(afmt
, args
));
295 // ////////////////////////////////////////////////////////////////////////// //
296 constructor TTextParser
.Create (aopts
: TOptions
=[TOption
.SignedNumbers
]);
312 destructor TTextParser
.Destroy ();
318 procedure TTextParser
.error (const amsg
: AnsiString); noreturn
;
320 raise TParserException
.Create(self
, amsg
);
324 procedure TTextParser
.errorfmt (const afmt
: AnsiString; const args
: array of const); noreturn
;
326 raise TParserException
.CreateFmt(self
, afmt
, args
);
330 function TTextParser
.isIdStartChar (ch
: AnsiChar): Boolean; inline;
334 ((ch
>= 'A') and (ch
<= 'Z')) or
335 ((ch
>= 'a') and (ch
<= 'z')) or
337 ((ch
= '$') and (TOption
.DollarIsId
in mOptions
)) or
338 ((ch
= '.') and (TOption
.DotIsId
in mOptions
));
341 function TTextParser
.isIdMidChar (ch
: AnsiChar): Boolean; inline;
344 ((ch
>= '0') and (ch
<= '9')) or
345 ((ch
= '-') and (TOption
.DashIsId
in mOptions
)) or
350 procedure TTextParser
.fillCharBuf ();
354 if (mEofHit
) then begin mCharBuf
[mCharBufPos
] := #0; exit
; end;
355 while (not mEofHit
) and (mCharBufUsed
< CharBufSize
) do
358 mCharBuf
[(mCharBufPos
+mCharBufUsed
) mod CharBufSize
] := ch
;
359 if (ch
= #0) then begin mEofHit
:= true; break
; end;
365 // never drains char buffer (except on "total EOF")
366 function TTextParser
.popFrontChar (): AnsiChar; inline;
368 if (mEofHit
) and (mCharBufUsed
= 0) then begin result
:= #0; exit
; end;
369 assert(mCharBufUsed
> 0);
370 result
:= mCharBuf
[mCharBufPos
];
371 mCharBufPos
:= (mCharBufPos
+1) mod CharBufSize
;
373 if (not mEofHit
) and (mCharBufUsed
= 0) then fillCharBuf();
376 function TTextParser
.peekCurChar (): AnsiChar; inline;
378 if (mCharBufUsed
= 0) and (not mEofHit
) then fillCharBuf();
379 result
:= mCharBuf
[mCharBufPos
]; // it is safe, 'cause `fillCharBuf()` will put #0 on "total EOF"
382 function TTextParser
.peekNextChar (): AnsiChar; inline;
384 if (mCharBufUsed
< 2) and (not mEofHit
) then fillCharBuf();
385 if (mCharBufUsed
< 2) then result
:= #0 else result
:= mCharBuf
[(mCharBufPos
+1) mod CharBufSize
];
388 function TTextParser
.peekChar (dest
: Integer): AnsiChar; inline;
390 if (dest
< 0) or (dest
>= CharBufSize
) then error('internal text parser error');
391 if (mCharBufUsed
< dest
+1) then fillCharBuf();
392 if (mCharBufUsed
< dest
+1) then result
:= #0 else result
:= mCharBuf
[(mCharBufPos
+dest
) mod CharBufSize
];
396 function TTextParser
.skipChar (): Boolean;
400 ch
:= popFrontChar();
401 if (ch
= #0) then begin result
:= false; exit
; end;
414 if (mCharBufUsed
> 0) and (mCharBuf
[0] = #10) then
416 if (popFrontChar() = #0) then result
:= false;
425 function TTextParser
.skipBlanks (): Boolean;
429 while (curChar
<> #0) do
431 if (curChar
= '/') then
433 // single-line comment
434 if (nextChar
= '/') then
436 //writeln('spos=(', mLine, ',', mCol, ')');
437 while (curChar
<> #0) and (curChar
<> #10) and (curChar
<> #13) do skipChar();
438 skipChar(); // skip EOL
439 //writeln('{', curChar, '}');
440 //writeln('epos=(', mLine, ',', mCol, ')');
444 if (nextChar
= '*') then
446 // skip comment start
449 while (curChar
<> #0) do
451 if (curChar
= '*') and (nextChar
= '/') then
462 // nesting multline comment
463 if (nextChar
= '+') then
465 // skip comment start
469 while (curChar
<> #0) do
471 if (curChar
= '+') and (nextChar
= '/') then
477 if (level
= 0) then break
;
480 if (curChar
= '/') and (nextChar
= '+') then
482 // skip comment start
493 else if (curChar
= '(') and (nextChar
= '*') then
495 // pascal comment; skip comment start
498 while (curChar
<> #0) do
500 if (curChar
= '*') and (nextChar
= ')') then
511 else if (curChar
= '{') and (TOption
.PascalComments
in mOptions
) then
513 // pascal comment; skip comment start
515 while (curChar
<> #0) do
517 if (curChar
= '}') then
527 if (curChar
> ' ') then break
;
528 skipChar(); // skip blank
530 result
:= (curChar
<> #0);
534 {$IFDEF XPARSER_DEBUG}
535 function TTextParser
.skipToken (): Boolean;
537 writeln('getting token...');
538 result
:= skipToken1();
539 writeln(' got token: ', mTokType
, ' <', mTokStr
, '> : <', mTokChar
, '>');
542 function TTextParser
.skipToken1 (): Boolean;
544 function TTextParser
.skipToken (): Boolean;
546 procedure parseInt ();
548 neg
: Boolean = false;
552 if (TOption
.SignedNumbers
in mOptions
) then
554 if (curChar
= '+') or (curChar
= '-') then
556 neg
:= (curChar
= '-');
558 if (curChar
< '0') or (curChar
> '9') then
561 if (neg
) then mTokChar
:= '-' else mTokChar
:= '+';
566 if (curChar
= '0') then
582 if (base
< 0) then base
:= 10;
583 if (digitInBase(curChar
, base
) < 0) then error('invalid number');
585 mTokInt
:= 0; // just in case
586 while (curChar
<> #0) do
588 if (curChar
= '_') then
591 if (curChar
= #0) then break
;
593 n
:= digitInBase(curChar
, base
);
594 if (n
< 0) then break
;
596 if (n
< 0) or (n
< mTokInt
) then error('integer overflow');
600 // check for valid number end
601 if (curChar
<> #0) then
603 if (curChar
= '.') then error('floating numbers aren''t supported yet');
604 if (isIdMidChar(curChar
)) then error('invalid number');
606 if neg
then mTokInt
:= -mTokInt
;
609 procedure parseString ();
615 mTokStr
:= ''; // just in case
617 skipChar(); // skip starting quote
618 while (curChar
<> #0) do
621 if (qch
= '"') and (curChar
= '\') then
623 if (nextChar
= #0) then error('unterminated string escape');
625 // skip backslash and escape type
634 'x', 'X': // hex escape
636 n
:= digitInBase(curChar
, 16);
637 if (n
< 0) then error('invalid hexstr escape');
639 if (digitInBase(curChar
, 16) > 0) then
641 n
:= n
*16+digitInBase(curChar
, 16);
644 mTokStr
+= AnsiChar(n
);
650 // duplicate single quote (pascal style)
651 if (qch
= '''') and (curChar
= '''') and (nextChar
= '''') then
659 if (curChar
= qch
) then
661 skipChar(); // skip ending quote
669 procedure parseId ();
672 mTokStr
:= ''; // just in case
673 while (isIdMidChar(curChar
)) do
675 if (curChar
= '.') and (nextChar
= '.') then break
; // dotdot is a token by itself
689 if not skipBlanks() then
704 if (TOption
.SignedNumbers
in mOptions
) and ((curChar
= '+') or (curChar
= '-')) then begin parseInt(); exit
; end;
705 if (curChar
>= '0') and (curChar
<= '9') then begin parseInt(); exit
; end;
708 if (curChar
= '"') or (curChar
= '''') or (curChar
= '`') then begin parseString(); exit
; end;
711 if (curChar
= '#') and (TOption
.HtmlColors
in mOptions
) then
713 if (digitInBase(peekChar(1), 16) >= 0) and (digitInBase(peekChar(2), 16) >= 0) and (digitInBase(peekChar(3), 16) >= 0) then
715 if (digitInBase(peekChar(4), 16) >= 0) and (digitInBase(peekChar(5), 16) >= 0) and (digitInBase(peekChar(6), 16) >= 0) then xpos
:= 7 else xpos
:= 4;
716 if (not isIdMidChar(peekChar(xpos
))) then
732 if (isIdStartChar(curChar
)) then
734 if (curChar
= '.') and (nextChar
= '.') then
736 // nothing to do here, as dotdot is a token by itself
749 if (curChar
= '=') then
752 '<': begin mTokType
:= TTLessEqu
; mTokStr
:= '<='; skipChar(); exit
; end;
753 '>': begin mTokType
:= TTGreatEqu
; mTokStr
:= '>='; skipChar(); exit
; end;
754 '!': begin mTokType
:= TTNotEqu
; mTokStr
:= '!='; skipChar(); exit
; end;
755 '=': begin mTokType
:= TTEqu
; mTokStr
:= '=='; skipChar(); exit
; end;
756 ':': begin mTokType
:= TTAss
; mTokStr
:= ':='; skipChar(); exit
; end;
759 else if (mTokChar
= curChar
) then
762 '<': begin mTokType
:= TTShl
; mTokStr
:= '<<'; skipChar(); exit
; end;
763 '>': begin mTokType
:= TTShr
; mTokStr
:= '>>'; skipChar(); exit
; end;
764 '&': begin mTokType
:= TTLogAnd
; mTokStr
:= '&&'; skipChar(); exit
; end;
765 '|': begin mTokType
:= TTLogOr
; mTokStr
:= '||'; skipChar(); exit
; end;
771 '<': if (curChar
= '>') then begin mTokType
:= TTNotEqu
; mTokStr
:= '<>'; skipChar(); exit
; end;
772 '.': if (curChar
= '.') then begin mTokType
:= TTDotDot
; mTokStr
:= '..'; skipChar(); exit
; end;
778 function TTextParser
.isEOF (): Boolean; inline; begin result
:= (mTokType
= TTEOF
); end;
779 function TTextParser
.isId (): Boolean; inline; begin result
:= (mTokType
= TTId
); end;
780 function TTextParser
.isInt (): Boolean; inline; begin result
:= (mTokType
= TTInt
); end;
781 function TTextParser
.isStr (): Boolean; inline; begin result
:= (mTokType
= TTStr
); end;
782 function TTextParser
.isDelim (): Boolean; inline; begin result
:= (mTokType
= TTDelim
); end;
783 function TTextParser
.isIdOrStr (): Boolean; inline; begin result
:= (mTokType
= TTId
) or (mTokType
= TTStr
); end;
786 function TTextParser
.expectId (): AnsiString;
788 if (mTokType
<> TTId
) then error('identifier expected');
794 procedure TTextParser
.expectId (const aid
: AnsiString; caseSens
: Boolean=true);
798 if (mTokType
<> TTId
) or (mTokStr
<> aid
) then error('identifier '''+aid
+''' expected');
802 if (mTokType
<> TTId
) or (not strEquCI1251(mTokStr
, aid
)) then error('identifier '''+aid
+''' expected');
808 function TTextParser
.eatId (const aid
: AnsiString; caseSens
: Boolean=true): Boolean;
812 result
:= (mTokType
= TTId
) and (mTokStr
= aid
);
816 result
:= (mTokType
= TTId
) and strEquCI1251(mTokStr
, aid
);
818 if result
then skipToken();
822 function TTextParser
.eatIdOrStr (const aid
: AnsiString; caseSens
: Boolean=true): Boolean;
826 result
:= (mTokType
= TTId
) and (mTokStr
= aid
);
827 if not result
then result
:= (mTokType
= TTStr
) and (mTokStr
= aid
);
831 result
:= (mTokType
= TTId
) and strEquCI1251(mTokStr
, aid
);
832 if not result
then result
:= (mTokType
= TTStr
) and strEquCI1251(mTokStr
, aid
);
834 if result
then skipToken();
838 function TTextParser
.eatIdOrStrCI (const aid
: AnsiString): Boolean; inline;
840 result
:= eatIdOrStr(aid
, false);
844 function TTextParser
.expectStr (allowEmpty
: Boolean=false): AnsiString;
846 if (mTokType
<> TTStr
) then error('string expected');
847 if (not allowEmpty
) and (Length(mTokStr
) = 0) then error('non-empty string expected');
853 function TTextParser
.expectIdOrStr (allowEmpty
: Boolean=false): AnsiString;
857 if (not allowEmpty
) and (Length(mTokStr
) = 0) then error('non-empty string expected');
861 error('string or identifier expected');
868 function TTextParser
.expectInt (): Integer;
870 if (mTokType
<> TTInt
) then error('string expected');
876 procedure TTextParser
.expectTT (ttype
: Integer);
878 if (mTokType
<> ttype
) then error('unexpected token');
883 function TTextParser
.eatTT (ttype
: Integer): Boolean;
885 result
:= (mTokType
= ttype
);
886 if result
then skipToken();
890 procedure TTextParser
.expectDelim (const ch
: AnsiChar);
892 if (mTokType
<> TTDelim
) or (mTokChar
<> ch
) then errorfmt('delimiter ''%s'' expected', [ch
]);
897 function TTextParser
.expectDelims (const ch
: TAnsiCharSet
): AnsiChar;
899 if (mTokType
<> TTDelim
) then error('delimiter expected');
900 if not (mTokChar
in ch
) then error('delimiter expected');
906 function TTextParser
.eatDelim (const ch
: AnsiChar): Boolean;
908 result
:= (mTokType
= TTDelim
) and (mTokChar
= ch
);
909 if result
then skipToken();
913 function TTextParser
.isDelim (const ch
: AnsiChar): Boolean; inline;
915 result
:= (mTokType
= TTDelim
) and (mTokChar
= ch
);
919 // ////////////////////////////////////////////////////////////////////////// //
920 constructor TFileTextParser
.Create (const fname
: AnsiString; aopts
: TOptions
=[TOption
.SignedNumbers
]);
923 mFile
:= openDiskFileRO(fname
);
924 mStreamOwned
:= true;
925 GetMem(mBuffer
, BufSize
);
927 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
928 if (mBufLen
< 0) then error('TFileTextParser: read error');
929 inherited Create(aopts
);
933 constructor TFileTextParser
.Create (st
: TStream
; astOwned
: Boolean=true; aopts
: TOptions
=[TOption
.SignedNumbers
]);
935 if (st
= nil) then error('cannot create parser for nil stream');
937 mStreamOwned
:= astOwned
;
938 GetMem(mBuffer
, BufSize
);
940 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
941 if (mBufLen
< 0) then error('TFileTextParser: read error');
942 inherited Create(aopts
);
946 destructor TFileTextParser
.Destroy ();
948 if (mBuffer
<> nil) then FreeMem(mBuffer
);
952 if (mStreamOwned
) then FreeAndNil(mFile
) else mFile
:= nil;
957 function TFileTextParser
.loadChar (): AnsiChar;
959 if (mBufLen
= 0) then begin result
:= #0; exit
; end;
960 if (mBufPos
>= mBufLen
) then
962 mBufLen
:= mFile
.Read(mBuffer
^, BufSize
);
963 if (mBufLen
< 0) then error('TFileTextParser: read error');
964 if (mBufLen
= 0) then begin result
:= #0; exit
; end;
967 assert(mBufPos
< mBufLen
);
968 result
:= mBuffer
[mBufPos
];
970 if (result
= #0) then result
:= ' ';
974 // ////////////////////////////////////////////////////////////////////////// //
975 constructor TStrTextParser
.Create (const astr
: AnsiString; aopts
: TOptions
=[TOption
.SignedNumbers
]);
979 inherited Create(aopts
);
983 destructor TStrTextParser
.Destroy ();
990 function TStrTextParser
.loadChar (): AnsiChar;
993 if (mPos
> Length(mStr
)) then exit
;
994 result
:= mStr
[mPos
];
996 if (result
= #0) then result
:= ' ';
1000 // ////////////////////////////////////////////////////////////////////////// //
1001 constructor TTextWriter
.Create (); begin mIndent
:= 0; end;
1002 procedure TTextWriter
.flush (); begin end;
1003 procedure TTextWriter
.put (const s
: AnsiString); overload
; begin if (Length(s
) > 0) then putBuf((@(s
[1]))^, Length(s
)); end;
1004 procedure TTextWriter
.put (v
: Byte); overload
; begin put('%d', [v
]); end;
1005 procedure TTextWriter
.put (v
: Integer); overload
; begin put('%d', [v
]); end;
1006 procedure TTextWriter
.put (const fmt
: AnsiString; args
: array of const); overload
; begin put(formatstrf(fmt
, args
)); end;
1007 procedure TTextWriter
.putIndent (); var f
: Integer; begin for f
:= 1 to mIndent
do put(' '); end;
1008 procedure TTextWriter
.indent (); begin Inc(mIndent
, 2); end;
1009 procedure TTextWriter
.unindent (); begin Dec(mIndent
, 2); end;
1012 // ////////////////////////////////////////////////////////////////////////// //
1013 constructor TFileTextWriter
.Create (const fname
: AnsiString);
1015 mFile
:= createDiskFile(fname
);
1016 mStreamOwned
:= true;
1018 GetMem(mBuffer
, BufSize
);
1019 assert(mBuffer
<> nil);
1024 constructor TFileTextWriter
.Create (ast
: TStream
; astOwned
: Boolean=true);
1026 if (ast
= nil) then raise Exception
.Create('cannot write to nil stream');
1028 mStreamOwned
:= astOwned
;
1030 GetMem(mBuffer
, BufSize
);
1031 assert(mBuffer
<> nil);
1035 destructor TFileTextWriter
.Destroy ();
1038 if (mBuffer
<> nil) then FreeMem(mBuffer
);
1041 if (mStreamOwned
) then mFile
.Free();
1047 procedure TFileTextWriter
.flush ();
1049 if (mFile
<> nil) and (mBufUsed
> 0) then
1051 mFile
.WriteBuffer(mBuffer
^, mBufUsed
);
1057 procedure TFileTextWriter
.putBuf (constref buf
; len
: SizeUInt
);
1062 if (len
= 0) then exit
;
1066 left
:= BufSize
-mBufUsed
;
1070 left
:= BufSize
-mBufUsed
;
1073 if (left
> len
) then left
:= Integer(len
);
1074 Move(pc
^, (mBuffer
+mBufUsed
)^, left
);
1075 Inc(mBufUsed
, left
);
1082 // ////////////////////////////////////////////////////////////////////////// //
1083 constructor TStrTextWriter
.Create ();
1089 destructor TStrTextWriter
.Destroy ();
1096 procedure TStrTextWriter
.putBuf (constref buf
; len
: SizeUInt
);
1098 st
: AnsiString = '';
1102 SetLength(st
, Integer(len
));
1103 Move(buf
, PChar(st
)^, Integer(len
));