paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 00:39:35 +01:00
Code Issues Packages Projects Releases Wiki Activity
abbc3fa755
fpc/utils/ptopu.pp

1238 lines
36 KiB
ObjectPascal
Raw Blame History

Unit PtoPu;
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Michael Van Canneyt, member of
the Free Pascal development team
Pascal Pretty-Printer object implementation
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{
This unit is based heavily on the code by
Author: Peter Grogono
This program is based on a Pascal pretty-printer written by Ledgard,
Hueras, and Singer. See SIGPLAN Notices, Vol. 12, No. 7, July 1977,
pages 101-105, and PP.DOC/HLP.
This version of PP developed under Pascal/Z V4.0 or later.
Very minor modifications for Turbo Pascal made by Willett Kempton
March 1984 and Oct 84. Runs under 8-bit Turbo or 16-bit Turbo.
Toad Hall tweak, rewrite for TP 5, 28 Nov 89
The following was changed :
- Object oriented
- Uses streams
- Run-time customizable.
}
Interface
Uses objects;
Const
MAXSYMBOLSIZE = 80;
MAXSTACKSIZE = 100;
MAXKEYLENGTH = 15; { The longest keyword is PROCEDURE }
MAXLINESIZE = 90; { Maximum length of output line }
TYPE
Token = String[MAXSYMBOLSIZE];
String0 = STRING[1]; {Pascal/z had 0}
FileName = STRING;
{ Keysymbols }
{ If you add keysyms, adjust the definition of lastkey }
keysymbol = { keywords }
(endsym,beginsym,ifsym,thensym,elsesym,procsym,varsym,ofsym,
whilesym,dosym,casesym,withsym,forsym,repeatsym,untilsym,
funcsym,labelsym,constsym,typesym,recordsym,stringsym,progsym,
{ TP and Delphi keywords}
asmsym, trysym, finallysym,exceptsym,raisesym,classsym,objectsym,
constructorsym,destructorsym,inheritedsym,propertysym,
privatesym,publicsym,protectedsym,publishedsym,
initializationsym,finalizationsym,
inlinesym,librarysym,interfacesym,implementationsym,
readsym,writesym,unitsym,
{ Not used for formatting }
andsym,arrsym,divsym,downsym,filesym,gotosym,insym,modsym,
notsym,nilsym,orsym,setsym,tosym,
casevarsym,
{ other symbols }
becomes,delphicomment,opencomment,closecomment,semicolon,colon,equals,
openparen,closeparen,period,endoffile,othersym);
{ Formatting options }
{ If you add options, adjust the definition of lastopt }
options = (crsupp,crbefore,blinbefore,
dindonkey,dindent,spbef,
spaft,gobsym,inbytab,crafter,upper,lower,capital);
optionset = SET OF options;
keysymset = SET OF keysymbol;
tableentry = RECORD
selected : optionset;
dindsym : keysymset;
terminators : keysymset
END;
{ Character identification }
charname = (letter,digit,space,quote,endofline,
filemark,otherchar);
charinfo = RECORD
name : charname;
Value : CHAR
END;
symbol = RECORD
name : keysymbol;
Value : Token;
IsKeyWord : BOOLEAN;
length, spacesbefore, crsbefore : INTEGER;
END;
symbolinfo = ^ symbol;
stackentry = RECORD
indentsymbol : keysymbol;
prevmargin : INTEGER
END;
symbolstack = ARRAY [1..MAXSTACKSIZE] OF stackentry;
Const FirstOpt = crsupp;
LastOpt = capital; { Adjust this if you add options }
FirstKey = endsym;
LastKey = othersym; { Adjust this if you add options }
LastFormatsym = tosym;
Type
tableptr = ^tableentry;
optiontable = ARRAY [keysymbol] OF tableptr;
OEntriesTable = Array [keysymbol] OF String[15];
ONamesTable = Array [Options] of String[15];
KeywordTable = ARRAY [endsym..lastFormatsym] OF String[MAXKEYLENGTH];
SpecialChar = ARRAY [1..2] OF CHAR;
dblcharset = SET OF endsym..othersym;
DblCharTable = ARRAY [becomes..opencomment] OF SpecialChar;
SglCharTable = ARRAY [opencomment..period] OF CHAR;
TPrettyPrinter=Object(TObject)
Private
RecordSeen,
CRPending : BOOLEAN;
currchar,nextchar : charinfo;
currsym,nextsym : symbolinfo;
inlines,outlines : INTEGER;
stack : symbolstack;
top,startpos,currlinepos,currmargin : Integer;
option : OptionTable;
Procedure Verbose (Const Msg : String);
Procedure GetChar;
Procedure StoreNextChar(VAR lngth: INTEGER;
VAR Value: Token);
Procedure SkipBlanks(VAR spacesbefore, crsbefore: INTEGER);
Procedure GetComment(sym: symbolinfo);
Procedure GetDelphiComment(sym: symbolinfo);
Procedure GetNumber(sym: symbolinfo);
Procedure GetCharLiteral(sym: symbolinfo);
Function char_Type: keysymbol;
Procedure GetSpecialChar(sym: symbolinfo);
Procedure GetNextSymbol(sym: symbolinfo);
Procedure GetIdentifier(sym: symbolinfo);
Procedure GetSymbol;
Procedure PopStack(VAR indentsymbol: keysymbol;
VAR prevmargin: INTEGER);
Procedure PushStack(indentsymbol: keysymbol;
prevmargin: INTEGER );
Procedure WriteCRs(numberofcrs: INTEGER);
Procedure InsertCR;
Procedure InsertBlankLine;
Procedure LShiftOn(dindsym: keysymset);
Procedure LShift;
Procedure InsertSpace(VAR symbol: symbolinfo);
Procedure MoveLinePos(newlinepos: INTEGER);
Procedure PrintSymbol;
Procedure PPSymbol;
Procedure Gobble(terminators: keysymset);
Procedure RShift(currmsym: keysymbol);
Function ReadConfigFile: Boolean;
Public
LineSize : longint;
Indent : Integer; { How many characters to indent ? }
InS,
OutS,
DiagS,cfgS : PStream;
Constructor Create;
Function PrettyPrint : Boolean;
end;
Procedure GenerateCfgFile(S: PStream);
Implementation
CONST
version = '28 November 1989'; {was '11 October 1984'; ..ancient stuff!}
NUL = 0; { ASCII null character }
TAB = 9; { ASCII tab character }
FF = 12; { ASCII formfeed character }
CR = 13; { ASCII carriage return }
ESC = 27; { ASCII escape character }
Blank = ' ';
MAXBYTE = 255;{ Largest value of 1 byte variable }
Type
hashentry = RECORD
Keyword : String[MAXKEYLENGTH];
symtype : keysymbol
END;
VAR
sets : tableptr;
dblch : dblcharset;
hashtable : ARRAY [Byte] OF hashentry;
CONST
Keyword : KeywordTable =
('END', 'BEGIN', 'IF', 'THEN',
'ELSE', 'PROCEDURE', 'VAR', 'OF',
'WHILE', 'DO', 'CASE', 'WITH',
'FOR', 'REPEAT', 'UNTIL', 'FUNCTION',
'LABEL', 'CONST', 'TYPE', 'RECORD',
'STRING', 'PROGRAM',
'ASM','TRY','FINALLY','EXCEPT','RAISE','CLASS','OBJECT',
'CONSTRUCTOR','DESCTRUCTOR','INHERITED','PROPERTY',
'PRIVATE','PUBLIC','PROTECTED','PUBLISHED',
'INITIALIZATION','FINALIZATION',
'INLINE','LIBRARY','INTERFACE','IMPLEMENTATION',
'READ','WRITE','UNIT',
{keywords not used for formatting }
'AND', 'ARRAY', 'DIV', 'DOWNTO',
'FILE', 'GOTO', 'IN', 'MOD',
'NOT', 'NIL', 'OR', 'SET','TO'
);
EntryNames : OEntriesTable =
('end','begin','if','then','else','proc','var',
'of','while','do','case','with','for','repeat','until',
'func','label','const','type','record','string',
'prog',
'asm','try','finally','except','raise','class','object',
'constructor','destructor','inherited','property',
'private','public','protected','published',
'initialization','finalization',
'inline','library','interface','implementation',
'read','write','unit',
'and','arr','div','down','file','goto',
'in','mod','not','nil','or','set','to',
'casevar',
'becomes','delphicomment','opencomment','closecomment','semicolon',
'colon','equals',
'openparen','closeparen','period','endoffile','other');
OptionNames : ONamesTable =
('crsupp','crbefore','blinbefore',
'dindonkey','dindent','spbef','spaft',
'gobsym','inbytab','crafter','upper',
'lower','capital');
DblChar : DblCharTable =
( ':=', '//','(*' );
SglChar : SglCharTable =
('{', '}', ';', ':', '=', '(', ')', '.' );
{ ---------------------------------------------------------------------
General functions, not part of the object.
---------------------------------------------------------------------}
function upperStr(const s : string) : string;
var
i : longint;
begin
for i:=1 to length(s) do
if s[i] in ['a'..'z'] then
upperStr[i]:=char(byte(s[i])-32)
else
upperStr[i]:=s[i];
upperStr[0]:=s[0];
end;
function LowerStr(const s : string) : string;
var
i : longint;
begin
for i:=1 to length(s) do
if s[i] in ['A'..'Z'] then
LowerStr[i]:=char(byte(s[i])+32)
else
LowerStr[i]:=s[i];
LowerStr[0]:=s[0];
end;
Function IntToStr(I : LongInt) : String;
var
s : string;
begin
str(I,s);
IntToStr := s;
end;
Function StrToInt(Const S : String) : Integer;
Var Code : integer;
Res : Integer;
begin
Val(S, Res, Code);
StrToInt := Res;
If Code<>0 then StrToInt:=0;
end;
Procedure Strip (Var S : String);
Const WhiteSpace = [#32,#9,#10,#13];
Var I,J : Longint;
begin
If length(s)=0 then exit;
I:=1;
While (S[I] in whitespace) and (I<Length(S)) do inc(i);
J:=length(S);
While (S[J] in whitespace) and (J>1) do dec(j);
If I<=J then
S:=Copy(S,i,j-i+1)
else
S:='';
end;
{ ---------------------------------------------------------------------
Hash table related functions
---------------------------------------------------------------------}
Function hash(Symbol: String): Byte;
{ Hashing function for identifiers. The formula gives a unique value
in the range 0..255 for each Pascal/Z keyword. Note that range and
overflow checking must be turned off for this function even if they
are enabled for the rest of the program. }
BEGIN
{$R-}
hash := (ORD(Symbol[1]) * 5 + ORD(Symbol[length(Symbol)])) * 5 + length(Symbol);
{$R+}
END; { of hash }
Procedure CreateHash;
Var psn : Byte;
sym : keysymbol;
begin
FOR psn := 0 TO MAXBYTE DO BEGIN
hashtable[psn].Keyword := ' ';
hashtable[psn].symtype := othersym
END;
FOR sym := endsym TO lastformatsym DO BEGIN
psn := hash(Keyword[sym]);
hashtable[psn].Keyword := Keyword[sym];
hashtable[psn].symtype := sym
END; { for }
end;
Procedure ClassID(Value: Token;
lngth: INTEGER;
VAR idtype: keysymbol;
VAR IsKeyWord: BOOLEAN);
{ Classify an identifier. We are only interested
in it if it is a keyword, so we use the hash table. }
VAR
Keyvalue: String[MAXKEYLENGTH];
tabent: INTEGER;
BEGIN
IF lngth > MAXKEYLENGTH THEN BEGIN
idtype := othersym;
IsKeyWord := FALSE
END
ELSE BEGIN
KeyValue:= UpperStr(Value);
tabent := hash(Keyvalue);
IF Keyvalue = hashtable[tabent].Keyword THEN BEGIN
idtype := hashtable[tabent].symtype;
IsKeyWord := TRUE;
END
ELSE BEGIN
idtype := othersym;
IsKeyWord := FALSE;
END
END
END; { of ClassID }
{ ---------------------------------------------------------------------
Functions to create options and set defaults.
---------------------------------------------------------------------}
Procedure CreateOptions (Var Option : OptionTable);
Var Sym : KeySymbol;
begin
FOR sym := endsym TO othersym DO BEGIN
NEW(option[sym]);
option[sym]^.selected := [];
option[sym]^.dindsym := [];
option[sym]^.terminators := []
END;
end;
Procedure SetTerminators(Var Option : OptionTable);
begin
option[casesym]^.terminators := [ofsym];
option[casevarsym]^.terminators := [ofsym];
option[forsym]^.terminators := [dosym];
option[whilesym]^.terminators := [dosym];
option[withsym]^.terminators := [dosym];
option[ifsym]^.terminators := [thensym];
option[untilsym]^.terminators := [endsym, untilsym, elsesym, semicolon];
option[becomes]^.terminators := [endsym, untilsym, elsesym, semicolon];
option[openparen]^.terminators := [closeparen];
end;
Procedure SetDefaultIndents (Var Option : OptionTable);
begin
option[recordsym]^.dindsym := [endsym];
option[funcsym]^.dindsym := [labelsym, constsym, typesym, varsym];
option[procsym]^.dindsym := [labelsym, constsym, typesym, varsym];
option[constsym]^.dindsym := [labelsym, constsym, typesym, varsym];
option[typesym]^.dindsym := [labelsym, constsym, typesym, varsym];
option[varsym]^.dindsym := [labelsym, constsym, typesym, varsym];
option[beginsym]^.dindsym := [labelsym, constsym, typesym, varsym];
option[publicsym]^.dindsym := [protectedsym,privatesym,publicsym,publishedsym];
option[privatesym]^.dindsym := [protectedsym,privatesym,publicsym,publishedsym];
option[protectedsym]^.dindsym := [protectedsym,privatesym,publicsym,publishedsym];
option[publishedsym]^.dindsym := [protectedsym,privatesym,publicsym,publishedsym];
option[finallysym]^.dindsym := [trysym];
option[exceptsym]^.dindsym := [trysym];
option[elsesym]^.dindsym := [ifsym, thensym, elsesym];
option[untilsym]^.dindsym := [ifsym, thensym, elsesym, forsym, whilesym,
withsym, colon, equals];
option[endsym]^.dindsym := [ifsym, thensym, elsesym, forsym, whilesym,
withsym, casevarsym, colon, equals, recordsym,
classsym,objectsym];
option[semicolon]^.dindsym := [ifsym, thensym, elsesym, forsym,
whilesym, withsym, colon, equals];
end;
Procedure SetDefaults (Var Option : OptionTable);
{ Sets default values for the formatting rules. }
begin
option[progsym]^.selected := [capital,blinbefore, spaft];
option[unitsym]^.selected := [capital,blinbefore, spaft];
option[librarysym]^.selected := [capital,blinbefore, spaft];
option[funcsym]^.selected := [capital,blinbefore, dindonkey, spaft];
option[procsym]^.selected := [capital,blinbefore, dindonkey, spaft];
option[labelsym]^.selected := [capital,blinbefore, spaft, inbytab];
option[constsym]^.selected := [capital,blinbefore, dindonkey, spaft, inbytab];
option[typesym]^.selected := [capital,blinbefore, dindonkey, spaft, inbytab];
option[varsym]^.selected := [capital,blinbefore, dindonkey, spaft, inbytab];
option[beginsym]^.selected := [capital,dindonkey, crbefore, crafter, inbytab];
option[repeatsym]^.selected := [capital,inbytab, crafter];
option[recordsym]^.selected := [capital,inbytab, crafter];
option[objectsym]^.selected := [capital,inbytab, crafter];
option[classsym]^.selected := [capital,inbytab, crafter];
option[publicsym]^.selected := [capital,crbefore, dindonkey, spaft, inbytab];
option[publishedsym]^.selected := [capital,crbefore, dindonkey, spaft, inbytab];
option[protectedsym]^.selected := [capital,crbefore, dindonkey, spaft, inbytab];
option[privatesym]^.selected := [capital,crbefore, dindonkey, spaft, inbytab];
option[trysym]^.Selected := [capital,crbefore,crafter,inbytab];
option[finallysym]^.selected := [capital,crbefore,dindonkey,crafter,inbytab];
option[exceptsym]^.selected := [capital,crbefore,dindonkey,crafter,inbytab];
option[casesym]^.selected := [capital,spaft, inbytab, gobsym, crafter];
option[casevarsym]^.selected := [capital,spaft, inbytab, gobsym, crafter];
option[ofsym]^.selected := [capital,crsupp, spbef];
option[forsym]^.selected := [capital,spaft, inbytab, gobsym, crafter];
option[whilesym]^.selected := [capital,spaft, inbytab, gobsym, crafter];
option[withsym]^.selected := [capital,spaft, inbytab, gobsym, crafter];
option[dosym]^.selected := [capital,crsupp, spbef];
option[ifsym]^.selected := [capital,spaft, inbytab, gobsym];
option[thensym]^.selected := [capital];
option[elsesym]^.selected := [capital,crbefore, dindonkey, inbytab];
option[endsym]^.selected := [capital,crbefore, crafter,dindonkey,dindent];
option[untilsym]^.selected := [capital,crbefore, dindonkey, dindent, spaft,
gobsym, crafter];
option[becomes]^.selected := [capital,spbef, spaft, gobsym];
option[Delphicomment]^.Selected := [crafter];
option[opencomment]^.selected := [capital,crsupp];
option[closecomment]^.selected := [capital,crsupp];
option[semicolon]^.selected := [capital,crsupp, dindonkey, crafter];
option[colon]^.selected := [capital,inbytab];
option[equals]^.selected := [capital,spbef, spaft, inbytab];
option[openparen]^.selected := [capital,gobsym];
option[period]^.selected := [capital,crsupp];
end;
{ ---------------------------------------------------------------------
Stream handling routines
---------------------------------------------------------------------}
Function ReadChar (S : PStream) : Char;
Var C : Char;
begin
repeat
if S^.GetPos = S^.GetSize then
C:=#0
else
S^.Read(C,1);
Until C<>#13;
ReadChar:=C;
end;
Function EoSLn (S : PStream) : Char;
Const WhiteSpace = [' ', #9, #13 ];
Var C : Char;
begin
Repeat
if S^.GetPos = S^.GetSize then
C:=#0
else
S^.Read(C,1);
Until (Not (C in WhiteSpace)) or ((C=#10));
EoSln:=C;
end;
Function ReadString (S: PStream): String;
Var Buffer : String;
I : Byte;
begin
Buffer:='';
I:=0;
Repeat
S^.Read(Buffer[I+1],1);
Inc(I);
until (I=255) or (Buffer[I]=#10) Or (S^.Status=StReadError);
If S^.Status=stReadError then Dec(I);
If Buffer[i]=#10 Then Dec(I);
If Buffer[I]=#13 then Dec(I);
Buffer[0] := chr(I);
ReadString:=Buffer;
end;
Procedure WriteString (S : PStream; ST : String);
begin
S^.Write(St[1],length(St));
end;
Procedure WriteCR (S: PStream);
Const
Newline = System.LineEnding;
begin
WriteString(S,Newline);
end;
Procedure WriteLnString (S : PStream; ST : String);
begin
WriteString(S,ST);
WriteCR(S);
end;
{ ---------------------------------------------------------------------
TPrettyPrinter object
---------------------------------------------------------------------}
Procedure TPrettyPrinter.Verbose (Const Msg : String);
begin
If Assigned (DiagS) then
WriteLnString (DiagS,Msg);
end;
Procedure TPrettyPrinter.GetChar;
{ Read the next character and classify it }
VAR Ch: CHAR;
BEGIN
currchar := nextchar;
WITH nextchar DO
begin
Ch:=ReadCHar(Ins);
If Ch=#0 then
BEGIN
name := filemark;
Value := Blank
END
ELSE If (Ch=#10) THEN
BEGIN
name := endofline;
Value := Blank;
Inc(inlines);
END
ELSE
BEGIN
Value := Ch;
IF Ch IN ['a'..'z', 'A'..'Z', '_'] THEN name := letter
ELSE IF Ch IN ['0'..'9'] THEN name := digit
ELSE IF Ch = '''' THEN name := quote
ELSE IF Ch in [#13,' ',#9] THEN name := space
ELSE name := otherchar
END
end;
END; { of GetChar }
Procedure TPrettyPrinter.StoreNextChar(VAR lngth: INTEGER;
VAR Value: Token);
{ Store a character in the current symbol }
BEGIN
GetChar;
IF lngth < maxsymbolsize THEN BEGIN
Inc(lngth);
Value[lngth] := currchar.Value;
Value[0] := chr(Lngth);
END;
END; { of StoreNextChar }
Procedure TPrettyPrinter.SkipBlanks(VAR spacesbefore, crsbefore: INTEGER);
{ Count the spaces between symbols }
BEGIN
spacesbefore := 0;
crsbefore := 0;
WHILE nextchar.name IN [space, endofline] DO BEGIN
GetChar;
CASE currchar.name OF
space: Inc(spacesbefore);
endofline: BEGIN
Inc(crsbefore);
spacesbefore := 0;
END;
END; {case}
END;
END; { of SkipBlanks }
Procedure TPrettyPrinter.GetComment(sym: symbolinfo);
{ Process comments using either brace or parenthesis notation }
BEGIN
sym^.name := opencomment;
WHILE NOT (((currchar.Value = '*') AND (nextchar.Value = ')'))
OR (currchar.Value = '}') OR (nextchar.name = endofline)
OR (nextchar.name = filemark)) DO
StoreNextChar(sym^.length, sym^.Value);
IF (currchar.Value = '*') AND (nextchar.Value = ')') THEN BEGIN
StoreNextChar(sym^.LENGTH, sym^.Value);
sym^.name := closecomment;
END;
IF currchar.Value = '}' THEN sym^.name := closecomment;
END; { of GetCommment }
Procedure TPrettyPrinter.GetDelphiComment(sym: symbolinfo);
{ Process comments using either brace or parenthesis notation }
BEGIN
sym^.name := Delphicomment;
WHILE NOT ((nextchar.name = endofline) OR (nextchar.name = filemark)) DO
StoreNextChar(sym^.length, sym^.Value);
END; { of GetDelphiCommment }
Procedure TPrettyPrinter.GetIdentifier(sym: symbolinfo);
{ Read an identifier and classify it }
BEGIN
WHILE nextchar.name IN [letter, digit] DO
StoreNextChar(sym^.length, sym^.Value);
ClassID(sym^.Value, sym^.length, sym^.name, sym^.IsKeyWord);
IF sym^.name IN [recordsym, casesym, endsym] THEN
CASE sym^.name OF
recordsym : RecordSeen := TRUE;
casesym : IF RecordSeen THEN sym^.name := casevarsym;
endsym : RecordSeen := FALSE;
END; {case}
END; { of GetIdentifier }
{ Read a number and store it as a string }
Procedure TPrettyPrinter.GetNumber(sym: symbolinfo);
BEGIN
WHILE nextchar.name = digit DO StoreNextChar(sym^.length, sym^.Value);
sym^.name := othersym;
END; { of GetNumber }
PROCEDURE TPrettyPrinter.GetCharLiteral(sym: symbolinfo);
{ Read a quoted string }
BEGIN
WHILE nextchar.name = quote DO BEGIN
StoreNextChar(sym^.length, sym^.Value);
WHILE NOT (nextchar.name IN [quote, endofline, filemark]) DO
StoreNextChar(sym^.length, sym^.Value);
IF nextchar.name = quote THEN StoreNextChar(sym^.length, sym^.Value);
END;
sym^.name := othersym;
END; { of GetCharLiteral }
FUNCTION TPrettyPrinter.char_Type: keysymbol;
{ Classify a character pair }
VAR
NextTwoChars: SpecialChar;
Hit: BOOLEAN;
thischar: keysymbol;
BEGIN
NextTwoChars[1] := currchar.Value;
NextTwoChars[2] := nextchar.Value;
thischar := becomes;
Hit := FALSE;
WHILE NOT (Hit OR (thischar = closecomment)) DO BEGIN
IF NextTwoChars = DblChar[thischar] THEN Hit := TRUE
ELSE Inc(thischar);
END;
IF NOT Hit THEN BEGIN
thischar := opencomment;
WHILE NOT (Hit OR (PRED(thischar) = period)) DO BEGIN
IF currchar.Value = SglChar[thischar] THEN Hit := TRUE
ELSE Inc(thischar);
END;
END;
IF Hit THEN char_Type := thischar
ELSE char_Type := othersym;
END; { of char_Type }
Procedure TPrettyPrinter.GetSpecialChar(sym: symbolinfo);
{ Read special characters }
BEGIN
StoreNextChar(sym^.length, sym^.Value);
sym^.name := char_Type;
IF sym^.name IN dblch THEN StoreNextChar(sym^.length, sym^.Value)
END; { of GetSpecialChar }
Procedure TPrettyPrinter.GetNextSymbol(sym: symbolinfo);
{ Read a symbol using the appropriate procedure }
BEGIN
CASE nextchar.name OF
letter: GetIdentifier(sym);
digit: GetNumber(sym);
quote: GetCharLiteral(sym);
otherchar: BEGIN
GetSpecialChar(sym);
IF sym^.name = opencomment THEN GetComment(sym)
else IF sym^.name= DelphiComment then GetDelphiComment(Sym)
END;
filemark: sym^.name := endoffile;
ELSE {:} {Turbo}
WRITELN('Unknown character type: ', ORD(nextchar.name));
END; {case}
END; { of GetNextSymbol }
Procedure TprettyPrinter.GetSymbol;
{ Store the next symbol in NEXTSYM }
VAR
dummy: symbolinfo;
BEGIN
dummy := currsym;
currsym := nextsym;
nextsym := dummy;
SkipBlanks(nextsym^.spacesbefore, nextsym^.crsbefore);
nextsym^.length := 0;
nextsym^.IsKeyWord := FALSE;
IF currsym^.name = opencomment THEN GetComment(nextsym)
ELSE GetNextSymbol(nextsym);
END; {of GetSymbol}
Procedure TprettyPrinter.PopStack(VAR indentsymbol: keysymbol;
VAR prevmargin: INTEGER);
{ Manage stack of indentation symbols and margins }
BEGIN
IF top > 0 THEN BEGIN
indentsymbol := stack[top].indentsymbol;
prevmargin := stack[top].prevmargin;
Dec(top);
END
ELSE BEGIN
indentsymbol := othersym;
prevmargin := 0;
END;
END; { of PopStack }
Procedure TPrettyPrinter.PushStack(indentsymbol: keysymbol;
prevmargin: INTEGER );
BEGIN
Inc(top);
stack[top].indentsymbol := indentsymbol;
stack[top].prevmargin := prevmargin;
END; { of PushStack }
Procedure TPrettyPrinter.WriteCRs(numberofcrs: INTEGER);
VAR
i: INTEGER;
BEGIN
IF numberofcrs > 0 THEN BEGIN
FOR i := 1 TO numberofcrs DO
WriteCr(OutS);
Inc(outlines,numberofcrs);
currlinepos := 0;
END;
END; { of WriteCRs }
Procedure TPrettyPrinter.InsertCR;
BEGIN
IF currsym^.crsbefore = 0 THEN BEGIN
WriteCRs(1);
currsym^.spacesbefore := 0;
END;
END; { of InsertCR }
Procedure TPrettyPrinter.InsertBlankLine;
BEGIN
IF currsym^.crsbefore = 0 THEN BEGIN
IF currlinepos = 0 THEN WriteCRs(1)
ELSE WriteCRs(2);
currsym^.spacesbefore := 0;
END
ELSE IF currsym^.crsbefore = 1 THEN
IF currlinepos > 0 THEN WriteCRs(1);
END; { of InsertBlankLine }
Procedure TPrettyPrinter.LShiftOn(dindsym: keysymset);
{ Move margin left according to stack configuration and current symbol }
VAR
indentsymbol: keysymbol;
prevmargin: INTEGER;
BEGIN
IF top > 0 THEN BEGIN
REPEAT
PopStack(indentsymbol, prevmargin);
IF indentsymbol IN dindsym THEN currmargin := prevmargin;
UNTIL NOT (indentsymbol IN dindsym) OR (top = 0);
IF NOT (indentsymbol IN dindsym) THEN
PushStack(indentsymbol, prevmargin);
END;
END; { of LShiftOn }
Procedure TprettyPrinter.LShift;
{ Move margin left according to stack top }
VAR
indentsymbol: keysymbol;
prevmargin: INTEGER;
BEGIN
IF top > 0 THEN BEGIN
PopStack(indentsymbol, prevmargin);
currmargin := prevmargin;
(* maybe PopStack(indentsymbol,currmargin); *)
END;
END; { of LShift }
Procedure TPrettyPrinter.InsertSpace(VAR symbol: symbolinfo);
{ Insert space if room on line }
BEGIN
IF currlinepos < LineSize THEN BEGIN
WriteString(OutS, Blank);
Inc(currlinepos);
IF (symbol^.crsbefore = 0) AND (symbol^.spacesbefore > 0)
THEN Dec(symbol^.spacesbefore);
END;
END; { of InsertSpace }
Procedure TPrettyPrinter.MoveLinePos(newlinepos: INTEGER);
{ Insert spaces until correct line position reached }
VAR i: INTEGER;
BEGIN
FOR i := SUCC(currlinepos) TO newlinepos DO
WriteString(OutS, Blank);
currlinepos := newlinepos;
END; { of MoveLinePos }
Procedure TPrettyPrinter.PrintSymbol;
BEGIN
IF (currsym^.IsKeyWord) then
begin
If upper in sets^.selected Then
WriteString (OutS,UpperStr(currsym^.value))
else if lower in sets^.selected then
WriteString (OutS,LowerStr(currsym^.value))
else if capital in sets^.selected then
begin
WriteString(OutS,UpCase(CurrSym^.Value[1]));
WriteString(OutS,LowerStr(Copy(CurrSym^.Value,2,255)));
end
else
WriteString(OutS,Currsym^.Value);
end
ELSE
WriteString(OutS, currsym^.Value);
startpos := currlinepos;
Inc(currlinepos,currsym^.length);
END; { of PrintSymbol }
Procedure TPrettyPrinter.PPSymbol;
{ Find position for symbol and then print it }
VAR newlinepos: INTEGER;
BEGIN
WriteCRs(currsym^.crsbefore);
IF (currlinepos + currsym^.spacesbefore > currmargin)
OR (currsym^.name IN [opencomment, closecomment])
THEN newlinepos := currlinepos + currsym^.spacesbefore
ELSE newlinepos := currmargin;
IF newlinepos + currsym^.length > LINESIZE THEN BEGIN
WriteCRs(1);
IF currmargin + currsym^.length <= LINESIZE
THEN newlinepos := currmargin
ELSE IF currsym^.length < LINESIZE
THEN newlinepos := LINESIZE - currsym^.length
ELSE newlinepos := 0;
END;
MoveLinePos(newlinepos);
PrintSymbol;
END; { of PPSymbol }
Procedure TPrettyPrinter.Gobble(terminators: keysymset);
{ Print symbols which follow a formatting symbol but which do not
affect layout }
BEGIN
IF top < MAXSTACKSIZE THEN PushStack(currsym^.name, currmargin);
currmargin := currlinepos;
WHILE NOT ((nextsym^.name IN terminators)
OR (nextsym^.name = endoffile)) DO BEGIN
GetSymbol;
PPSymbol;
END;
LShift;
END; { of Gobble }
Procedure TprettyPrinter.RShift(currmsym: keysymbol);
{ Move right, stacking margin positions }
BEGIN
IF top < MAXSTACKSIZE THEN PushStack(currmsym, currmargin);
IF startpos > currmargin THEN currmargin := startpos;
Inc(currmargin,INDENT);
END; { of RShift }
Function TPrettyPrinter.ReadConfigFile : Boolean;
Var I,J : Longint;
Procedure SetOption(TheKey : KeySymbol;Var OptionList : String);
Var TheOpt : Options;
Found : Boolean;
K : longint;
opt : string;
begin
Repeat
K:=pos(',',optionlist);
If k>0 then
begin
opt:=Copy(OptionList,1,k-1);
strip(opt);
Delete(OptionList,1,k);
end
else
opt:=OptionList;
If Length(Opt)>0 then
begin
Found:=False;
for TheOpt :=firstopt to lastopt do
begin
found:=opt=OptionNames[Theopt];
If found then break;
end;
If not found then
Verbose ('Unknown option on line '+inttostr(i)+': '+Opt)
else
Option[TheKey]^.Selected:=Option[TheKey]^.Selected+[TheOpt];
end;
until k=0;
end;
Procedure SetIndent(TheKey : KeySymbol; Var OptionList : String);
Var
TheIndent : Keysymbol;
Found : Boolean;
K : longint;
opt : string;
begin
Repeat
K:=pos(',',optionlist);
If k>0 then
begin
opt:=Copy(OptionList,1,k-1);
strip(opt);
Delete(OptionList,1,k);
end
else
opt:=OptionList;
If Length(Opt)>0 then
begin
Found:=False;
for TheIndent :=firstKey to lastKey do
begin
found:=opt=EntryNames[Theindent];
If found then break;
end;
If not found then
begin
Verbose ('Unknown indent keysym on line '+inttostr(i)+': '+Opt);
exit;
end;
Option[TheKey]^.dindsym:=Option[TheKey]^.dindsym+[Theindent];
end;
until k=0;
end;
Var TheKey : KeySymbol;
Found,DoIndent : Boolean;
Line, Name : String;
begin
ReadConfigFile:=false;
I:=0;
while not (CfgS^.Status=stReadError) do
begin
inc(i);
Line:='';
Line:=ReadString(cfgS);
{ Strip comment }
If pos('#',Line)<>0 then
Line:=Copy(Line,1,Pos('#',Line)-1);
If length(Line)<>0 then
begin
J:=Pos('=',Line);
If J>0 then
begin
Line:=LowerStr(Line);
Name:=Copy(Line,1,j-1);
Delete(Line,1,J);
{ indents or options ? }
If (Name[1]='[') and
(Name[Length(Name)]=']') then
begin
Name:=Copy(Name,2,Length(Name)-2);
Doindent:=True;
end
else
DoIndent:=False;
Strip(Name);
found:=false;
for thekey:=firstkey to lastkey do
begin
found:=Name=EntryNames[thekey];
If Found then break;
end;
If not found then
Verbose ('Unknown keyword on line '+inttostr(i)+': '+Name)
else
If DoIndent then
SetIndent(TheKey,Line)
else
SetOption(TheKey,Line)
end
else
verbose ('Error in config file on line '+IntToStr(i));
end;
end;
Verbose ('Processed configfile: read '+IntToStr(I)+' lines');
ReadConfigFile:=true;
end;
Procedure GenerateCfgFile(S : PStream);
Var TheKey,TheIndent : KeySymbol;
TheOpt : Options;
Written : Boolean;
Option : OptionTable;
begin
CreateOptions(option);
SetDefaults(option);
SetDefaultIndents(option);
For TheKey:=Firstkey to lastkey do
begin
{ Write options }
WriteString (S,EntryNames[TheKey]+'=');
Written:=False;
for TheOpt:=FirstOpt to LastOpt do
If TheOpt in Option[TheKey]^.Selected then
begin
if written then
WriteString (S,',')
else
Written:=True;
writeString (S,OptionNames[TheOpt]);
end;
WriteCr (S);
{ Write de-indent keysyms, if any }
If Option[TheKey]^.dindsym<>[] then
begin
WriteString (S,'['+EntryNames[TheKey]+']=');
Written:=False;
For TheIndent:=FirstKey to lastkey do
If TheIndent in Option[TheKey]^.dindsym then
begin
if written then
WriteString (S,',')
else
Written:=True;
WriteString (S,EntryNames[Theindent]);
end;
WriteCr (S);
end;
end;
end;
Function TPrettyPrinter.PrettyPrint : Boolean;
Begin
PrettyPrint:=False;
If Not Assigned(Ins) or Not Assigned(OutS) then
exit;
If Not Assigned(CfgS) then
begin
SetDefaults(Option);
SetDefaultIndents(Option);
end
else
ReadConfigFile;
{ Initialize variables }
top := 0;
currlinepos := 0;
currmargin := 0;
inlines := 0;
outlines := 0;
CrPending := FALSE;
RecordSeen := FALSE;
GetChar;
NEW(currsym);
NEW(nextsym);
GetSymbol;
WHILE nextsym^.name <> endoffile DO BEGIN
GetSymbol;
sets := option[currsym^.name];
IF (CrPending AND NOT (crsupp IN sets^.selected))
OR (crbefore IN sets^.selected) THEN BEGIN
InsertCR;
CrPending := FALSE
END;
IF blinbefore IN sets^.selected THEN BEGIN
InsertBlankLine;
CrPending := FALSE
END;
IF dindonkey IN sets^.selected THEN LShiftOn(sets^.dindsym);
IF dindent IN sets^.selected THEN LShift;
IF spbef IN sets^.selected THEN InsertSpace(currsym);
PPSymbol;
IF spaft IN sets^.selected THEN InsertSpace(nextsym);
IF inbytab IN sets^.selected THEN RShift(currsym^.name);
IF gobsym IN sets^.selected THEN Gobble(sets^.terminators);
IF crafter IN sets^.selected THEN CrPending := TRUE
END;
IF CrPending THEN WriteCRs(1);
Verbose(IntToStr(inlines)+' lines read, '+IntToStr(outlines)+' lines written.');
PrettyPrint:=True;
end;
Constructor TPrettyPrinter.Create;
Begin
LineSize:=MaxLineSize;
CreateOptions (Option);
SetTerminators(Option);
DiagS:=Nil;
InS:=Nil;
OutS:=Nil;
CfgS:=Nil;
End;
{ ---------------------------------------------------------------------
Unit initialization
---------------------------------------------------------------------}
Begin
CreateHash;
dblch := [becomes, opencomment];
end.
{
$Log$
Revision 1.6 2003-03-27 14:23:00 michael
+ Fixed use of linesize property, reported by Wolfgang Waffenschmidt
Revision 1.5 2002/09/07 15:40:31 peter
* old logs removed and tabs fixed
Revision 1.4 2002/07/14 13:39:45 carl
* use special symbols for portability's sake
Revision 1.3 2002/06/01 18:39:14 marco
* Renamefest
Revision 1.2 2002/02/27 16:35:31 carl
* bugfix of stream errors - would always give error!
}
Reference in New Issue View Git Blame Copy Permalink