ptopu.pp 41 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381
  1. {$mode objfpc}
  2. {$h+}
  3. Unit PtoPu;
  4. {
  5. This file is part of the Free Pascal run time library.
  6. Copyright (c) 1999-2000 by Michael Van Canneyt, member of
  7. the Free Pascal development team
  8. Pascal Pretty-Printer object implementation
  9. See the file COPYING.FPC, included in this distribution,
  10. for details about the copyright.
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14. **********************************************************************}
  15. {
  16. This unit is based heavily on the code by
  17. Author: Peter Grogono
  18. This program is based on a Pascal pretty-printer written by Ledgard,
  19. Hueras, and Singer. See SIGPLAN Notices, Vol. 12, No. 7, July 1977,
  20. pages 101-105, and PP.DOC/HLP.
  21. This version of PP developed under Pascal/Z V4.0 or later.
  22. Very minor modifications for Turbo Pascal made by Willett Kempton
  23. March 1984 and Oct 84. Runs under 8-bit Turbo or 16-bit Turbo.
  24. Toad Hall tweak, rewrite for TP 5, 28 Nov 89
  25. The following was changed :
  26. - Object oriented
  27. - Uses streams
  28. - Run-time customizable.
  29. }
  30. { $define debug}
  31. Interface
  32. uses Classes,Sysutils;
  33. Const
  34. MAXSYMBOLSIZE = 65500;
  35. MAXSHOWSIZE = 40;
  36. MAXSTACKSIZE = 100;
  37. MAXKEYLENGTH = 15; { The longest keywords are IMPLEMENTATION INITIALIZATION }
  38. DEFLINESIZE = 100;
  39. DEFINDENT = 2;
  40. TYPE
  41. Token = AnsiString;
  42. FileName = STRING;
  43. TTokenScope = (tsInterface,tsImplementation);
  44. { Keysymbols }
  45. { If you add keysyms, adjust the definition of lastkey }
  46. keysymbol = { keywords }
  47. (endsym,beginsym,ifsym,thensym,elsesym,procsym,varsym,ofsym,
  48. whilesym,dosym,casesym,withsym,forsym,repeatsym,untilsym,
  49. funcsym,labelsym,constsym,typesym,recordsym,stringsym,progsym,
  50. { TP and Delphi keywords}
  51. asmsym, trysym, finallysym,exceptsym,raisesym,classsym,objectsym,
  52. constructorsym,destructorsym,inheritedsym,propertysym,
  53. privatesym,publicsym,protectedsym,publishedsym,
  54. initializationsym,finalizationsym,
  55. inlinesym,librarysym,interfacesym,implementationsym,
  56. readsym,writesym,unitsym,
  57. { Not used for formatting }
  58. andsym,arrsym,divsym,downsym,filesym,gotosym,insym,modsym,
  59. notsym,nilsym,orsym,setsym,tosym,virtualsym,usessym,
  60. casevarsym,ofobjectsym,
  61. { other symbols }
  62. becomes,delphicomment,dopencomment,dclosecomment,opencomment,closecomment,semicolon,colon,equals,
  63. openparen,closeparen,period,endoffile,othersym);
  64. { Formatting options }
  65. { If you add options, adjust the definition of lastopt }
  66. options = (crsupp,crbefore,blinbefore,
  67. dindonkey,dindent,spbef,
  68. spaft,gobsym,inbytab,inbyindent,crafter,upper,lower,capital);
  69. optionset = SET OF options;
  70. keysymset = SET OF keysymbol;
  71. tableentry = RECORD
  72. selected : optionset;
  73. dindsym : keysymset;
  74. terminators : keysymset
  75. END;
  76. { Character identification }
  77. charname = (letter,digit,space,quote,endofline,
  78. filemark,otherchar);
  79. charinfo = RECORD
  80. name : charname;
  81. Value : CHAR
  82. END;
  83. symbol = RECORD
  84. name : keysymbol;
  85. Value : Token;
  86. IsKeyWord : BOOLEAN;
  87. length, spacesbefore, crsbefore : INTEGER;
  88. END;
  89. symbolinfo = ^ symbol;
  90. stackentry = RECORD
  91. indentsymbol : keysymbol;
  92. prevmargin : INTEGER;
  93. END;
  94. symbolstack = ARRAY [1..MAXSTACKSIZE] OF stackentry;
  95. Const FirstOpt = crsupp;
  96. LastOpt = capital; { Adjust this if you add options }
  97. FirstKey = endsym;
  98. LastKey = othersym; { Adjust this if you add options }
  99. LastFormatsym = usessym;
  100. Type
  101. tableptr = ^tableentry;
  102. optiontable = ARRAY [Ttokenscope,keysymbol] OF tableptr;
  103. OEntriesTable = Array [keysymbol] OF String[15];
  104. ONamesTable = Array [Options] of String[15];
  105. KeywordTable = ARRAY [endsym..lastFormatsym] OF String[MAXKEYLENGTH];
  106. SpecialChar = ARRAY [1..2] OF CHAR;
  107. dblcharset = SET OF endsym..othersym;
  108. DblCharTable = ARRAY [becomes..dclosecomment] OF SpecialChar;
  109. SglCharTable = ARRAY [opencomment..period] OF CHAR;
  110. TVerboseEvent = Procedure (Sender : TObject; Const Msg : String) of Object;
  111. { TPrettyPrinter }
  112. TPrettyPrinter=Class(TObject)
  113. Private
  114. FTokenScope: TTokenScope;
  115. {$ifdef debug}
  116. GobbleLevel : Integer;
  117. {$endif debug}
  118. PreviousSymbol : keysymbol;
  119. RecordLevel : Integer;
  120. ClassSeen,ObjectSeen : Boolean;
  121. LastStruct : KeySymbol;
  122. CRPending : BOOLEAN;
  123. currchar,nextchar : charinfo;
  124. currsym,nextsym : symbolinfo;
  125. inlines,outlines : INTEGER;
  126. stack : symbolstack;
  127. top,startpos,currlinepos,currmargin : Integer;
  128. option : OptionTable;
  129. FOnVerbose : TVerboseEvent;
  130. FirstWordStackPos,
  131. FirstWordPos,
  132. FLineSize,
  133. FIndent : Integer;
  134. ins,outs,cfgs : TStream;
  135. Procedure Verbose (Const Msg : String);
  136. Procedure GetChar;
  137. Procedure StoreNextChar(VAR lngth: INTEGER;
  138. VAR Value: Token);
  139. Procedure SkipBlanks(VAR spacesbefore, crsbefore: INTEGER);
  140. Procedure GetComment(sym: symbolinfo);
  141. Procedure GetDoubleComment(sym: symbolinfo);
  142. Procedure GetDelphiComment(sym: symbolinfo);
  143. Procedure GetNumber(sym: symbolinfo);
  144. Procedure GetCharLiteral(sym: symbolinfo);
  145. Function char_Type: keysymbol;
  146. Procedure GetSpecialChar(sym: symbolinfo);
  147. Procedure GetNextSymbol(sym: symbolinfo);
  148. Procedure GetIdentifier(sym: symbolinfo);
  149. Procedure GetSymbol;
  150. Procedure PopStack(VAR indentsymbol: keysymbol;
  151. VAR prevmargin: INTEGER);
  152. Procedure PushStack(indentsymbol: keysymbol;
  153. prevmargin: INTEGER );
  154. Procedure WriteCRs(numberofcrs: INTEGER);
  155. Procedure InsertCR;
  156. Procedure InsertBlankLine;
  157. Procedure LShiftOn(dindsym: keysymset);
  158. Procedure LShift;
  159. Procedure InsertSpace(VAR symbol: symbolinfo);
  160. Procedure MoveLinePos(newlinepos: INTEGER);
  161. Procedure PrintSymbol;
  162. Procedure PPSymbol;
  163. Procedure Gobble(terminators: keysymset);
  164. Procedure RShift(currmsym: keysymbol);
  165. Procedure RShiftIndent(currmsym: keysymbol);
  166. Function ReadConfigFile: Boolean;
  167. Public
  168. Constructor Create;
  169. Function PrettyPrint : Boolean;
  170. Property OnVerbose : TVerboseEvent Read FOnVerbose Write FOnVerbose;
  171. Property LineSize : Integer Read FLineSize Write FLineSize;
  172. Property Indent : Integer Read FIndent Write FIndent; { How many characters to indent ? }
  173. Property Source : TStream Read Ins Write Ins;
  174. Property Dest : TStream Read OutS Write Outs;
  175. Property Config : Tstream Read cfgS Write cfgs;
  176. Property CurrentScope : TTokenScope Read FTokenScope Write FTokenScope;
  177. end;
  178. Procedure GenerateCfgFile(S: TStream);
  179. Implementation
  180. CONST
  181. version = '20 February 2005'; {was '11 October 1984','28 November 1989'; ..ancient stuff!}
  182. NUL = 0; { ASCII null character }
  183. TAB = 9; { ASCII tab character }
  184. FF = 12; { ASCII formfeed character }
  185. CR = 13; { ASCII carriage return }
  186. ESC = 27; { ASCII escape character }
  187. Blank = ' ';
  188. MAXBYTE = 255;{ Largest value of 1 byte variable }
  189. VAR
  190. sets : tableptr;
  191. dblch : dblcharset;
  192. CONST
  193. Keyword : KeywordTable =
  194. ('END', 'BEGIN', 'IF', 'THEN',
  195. 'ELSE', 'PROCEDURE', 'VAR', 'OF',
  196. 'WHILE', 'DO', 'CASE', 'WITH',
  197. 'FOR', 'REPEAT', 'UNTIL', 'FUNCTION',
  198. 'LABEL', 'CONST', 'TYPE', 'RECORD',
  199. 'STRING', 'PROGRAM',
  200. 'ASM','TRY','FINALLY','EXCEPT','RAISE','CLASS','OBJECT',
  201. 'CONSTRUCTOR','DESCTRUCTOR','INHERITED','PROPERTY',
  202. 'PRIVATE','PUBLIC','PROTECTED','PUBLISHED',
  203. 'INITIALIZATION','FINALIZATION',
  204. 'INLINE','LIBRARY','INTERFACE','IMPLEMENTATION',
  205. 'READ','WRITE','UNIT',
  206. {keywords not used for formatting }
  207. 'AND', 'ARRAY', 'DIV', 'DOWNTO',
  208. 'FILE', 'GOTO', 'IN', 'MOD',
  209. 'NOT', 'NIL', 'OR', 'SET','TO','VIRTUAL','USES'
  210. );
  211. EntryNames : OEntriesTable =
  212. ('end','begin','if','then','else','proc','var',
  213. 'of','while','do','case','with','for','repeat','until',
  214. 'func','label','const','type','record','string',
  215. 'prog',
  216. 'asm','try','finally','except','raise','class','object',
  217. 'constructor','destructor','inherited','property',
  218. 'private','public','protected','published',
  219. 'initialization','finalization',
  220. 'inline','library','interface','implementation',
  221. 'read','write','unit',
  222. 'and','arr','div','down','file','goto',
  223. 'in','mod','not','nil','or','set','to','virtual','uses',
  224. 'casevar','ofobject',
  225. 'becomes','delphicomment','dopencomment','dclosecomment',
  226. 'opencomment','closecomment','semicolon',
  227. 'colon','equals',
  228. 'openparen','closeparen','period','endoffile','other');
  229. OptionNames : ONamesTable =
  230. ('crsupp','crbefore','blinbefore',
  231. 'dindonkey','dindent','spbef','spaft',
  232. 'gobsym','inbytab','inbyindent','crafter','upper',
  233. 'lower','capital');
  234. DblChar : DblCharTable =
  235. ( ':=', '//','(*','*)' );
  236. SglChar : SglCharTable =
  237. ('{', '}', ';', ':', '=', '(', ')', '.' );
  238. { ---------------------------------------------------------------------
  239. General functions, not part of the object.
  240. ---------------------------------------------------------------------}
  241. function upperStr(const s : string) : string;
  242. var
  243. i : longint;
  244. begin
  245. setLength(upperStr,length(s));
  246. for i:=1 to length(s) do
  247. if s[i] in ['a'..'z'] then
  248. upperStr[i]:=char(byte(s[i])-32)
  249. else
  250. upperStr[i]:=s[i];
  251. end;
  252. function LowerStr(const s : string) : string;
  253. var
  254. i : longint;
  255. begin
  256. setLength(LowerStr,length(s));
  257. for i:=1 to length(s) do
  258. if s[i] in ['A'..'Z'] then
  259. LowerStr[i]:=char(byte(s[i])+32)
  260. else
  261. LowerStr[i]:=s[i];
  262. end;
  263. Function IntToStr(I : LongInt) : String;
  264. var
  265. s : string;
  266. begin
  267. str(I,s);
  268. IntToStr := s;
  269. end;
  270. Function StrToInt(Const S : String) : Integer;
  271. Var Code : integer;
  272. Res : Integer;
  273. begin
  274. Val(S, Res, Code);
  275. StrToInt := Res;
  276. If Code<>0 then StrToInt:=0;
  277. end;
  278. Procedure Strip (Var S : String);
  279. Const WhiteSpace = [#32,#9,#10,#13];
  280. Var I,J : Longint;
  281. begin
  282. If length(s)=0 then exit;
  283. I:=1;
  284. While (S[I] in whitespace) and (I<Length(S)) do inc(i);
  285. J:=length(S);
  286. While (S[J] in whitespace) and (J>1) do dec(j);
  287. If I<=J then
  288. S:=Copy(S,i,j-i+1)
  289. else
  290. S:='';
  291. end;
  292. Procedure ClassID(Value: Token;
  293. lngth: INTEGER;
  294. VAR idtype: keysymbol;
  295. VAR IsKeyWord: BOOLEAN);
  296. { Classify an identifier. We are only interested
  297. in it if it is a keyword, so we use the hash table. }
  298. VAR
  299. Keyvalue: String[MAXKEYLENGTH];
  300. tabent: INTEGER;
  301. found : Integer;
  302. Sym : keysymbol;
  303. BEGIN
  304. IF lngth > MAXKEYLENGTH THEN BEGIN
  305. idtype := othersym;
  306. IsKeyWord := FALSE
  307. END
  308. ELSE
  309. BEGIN
  310. IsKeyWord := FALSE;
  311. KeyValue:= UpperStr(Value);
  312. sym:=endsym;
  313. While (Not IsKeyword) and (sym<=lastformatsym) DO
  314. begin
  315. iskeyword:=(KeyValue=Keyword[sym]);
  316. if not iskeyword then
  317. Sym:=Succ(sym);
  318. end;
  319. if IsKeyWord then
  320. idtype:=sym
  321. ELSE
  322. idtype := othersym;
  323. END
  324. END; { of ClassID }
  325. { ---------------------------------------------------------------------
  326. Functions to create options and set defaults.
  327. ---------------------------------------------------------------------}
  328. Procedure CreateOptions (Var Option : OptionTable);
  329. Var Sym : KeySymbol;
  330. T : TTokenScope;
  331. begin
  332. FOR sym := endsym TO othersym DO
  333. For T:=Low(TTokenScope) to High(TTokenScope) do
  334. begin
  335. NEW(option[T,sym]);
  336. option[T,sym]^.selected := [];
  337. option[T,sym]^.dindsym := [];
  338. option[T,sym]^.terminators := []
  339. END;
  340. end;
  341. Procedure SetTerminators(Var Option : OptionTable);
  342. Var
  343. T : TTokenScope;
  344. begin
  345. For T:=Low(TTokenScope) to High(TTokenScope) do
  346. begin
  347. option[t,casesym]^.terminators := [ofsym];
  348. option[t,casevarsym]^.terminators := [ofsym];
  349. option[t,forsym]^.terminators := [dosym];
  350. option[t,whilesym]^.terminators := [dosym];
  351. option[t,withsym]^.terminators := [dosym];
  352. option[t,ifsym]^.terminators := [thensym];
  353. option[t,untilsym]^.terminators := [endsym, untilsym, elsesym, semicolon];
  354. option[t,becomes]^.terminators := [endsym, untilsym, elsesym, semicolon];
  355. option[t,openparen]^.terminators := [closeparen];
  356. option[t,usessym]^.terminators := [semicolon];
  357. end;
  358. end;
  359. Procedure SetDefaultIndents (Var Option : OptionTable);
  360. Var
  361. T : TTokenScope;
  362. begin
  363. For T:=Low(TTokenScope) to High(TTokenScope) do
  364. begin
  365. option[t,recordsym]^.dindsym := [endsym];
  366. option[t,funcsym]^.dindsym := [labelsym, constsym, typesym, varsym];
  367. option[t,procsym]^.dindsym := [labelsym, constsym, typesym, varsym];
  368. option[t,constsym]^.dindsym := [labelsym, constsym, typesym, varsym];
  369. option[t,typesym]^.dindsym := [labelsym, constsym, typesym, varsym];
  370. option[t,varsym]^.dindsym := [labelsym, constsym, typesym, varsym];
  371. option[t,beginsym]^.dindsym := [labelsym, constsym, typesym, varsym];
  372. option[t,publicsym]^.dindsym := [endsym,protectedsym,privatesym,publicsym,publishedsym];
  373. option[t,privatesym]^.dindsym := [endsym,protectedsym,privatesym,publicsym,publishedsym];
  374. option[t,protectedsym]^.dindsym := [endsym,protectedsym,privatesym,publicsym,publishedsym];
  375. option[t,publishedsym]^.dindsym := [endsym,protectedsym,privatesym,publicsym,publishedsym];
  376. option[t,finallysym]^.dindsym := [trysym];
  377. option[t,exceptsym]^.dindsym := [trysym];
  378. option[t,elsesym]^.dindsym := [ifsym, thensym, elsesym];
  379. option[t,untilsym]^.dindsym := [ifsym, thensym, elsesym, forsym, whilesym,
  380. withsym, colon, equals];
  381. option[t,endsym]^.dindsym := [ifsym, thensym, elsesym, forsym, whilesym,
  382. withsym, casevarsym, colon, equals, recordsym,
  383. trysym,classsym,objectsym];
  384. option[t,semicolon]^.dindsym := [ifsym, thensym, elsesym, forsym,
  385. whilesym, withsym, colon, equals];
  386. end;
  387. end;
  388. Procedure SetDefaults (Var Option : OptionTable);
  389. { Sets default values for the formatting rules. }
  390. Var
  391. T : TTokenScope;
  392. begin
  393. For T:=Low(TTokenScope) to High(TTokenScope) do
  394. begin
  395. option[t,progsym]^.selected := [capital,blinbefore, spaft];
  396. option[t,unitsym]^.selected := [capital,blinbefore, spaft];
  397. option[t,librarysym]^.selected := [capital,blinbefore, spaft];
  398. option[t,funcsym]^.selected := [capital,blinbefore, dindonkey, spaft];
  399. option[t,procsym]^.selected := [capital,blinbefore, dindonkey, spaft];
  400. option[t,labelsym]^.selected := [capital,blinbefore, spaft, inbytab];
  401. option[t,constsym]^.selected := [capital,blinbefore, dindonkey, spaft, inbytab];
  402. option[t,typesym]^.selected := [capital,blinbefore, dindonkey, spaft, inbytab];
  403. option[t,varsym]^.selected := [capital,blinbefore, dindonkey, spaft, inbytab];
  404. option[t,beginsym]^.selected := [capital,dindonkey, crbefore, crafter, inbytab];
  405. option[t,repeatsym]^.selected := [capital,inbytab, crafter];
  406. option[t,recordsym]^.selected := [capital,inbyIndent, crafter];
  407. option[t,objectsym]^.selected := [capital,inbyIndent];
  408. option[t,classsym]^.selected := [capital,inbyIndent];
  409. option[t,publicsym]^.selected := [capital,crbefore, dindonkey, spaft];
  410. option[t,publishedsym]^.selected := [capital,crbefore, dindonkey, spaft];
  411. option[t,protectedsym]^.selected := [capital,crbefore, dindonkey, spaft];
  412. option[t,privatesym]^.selected := [capital,crbefore, dindonkey, spaft];
  413. option[t,trysym]^.Selected := [capital,crbefore,crafter,inbytab];
  414. option[t,finallysym]^.selected := [capital,crbefore,dindent,crafter,inbytab];
  415. option[t,exceptsym]^.selected := [capital,crbefore,dindent,crafter,inbytab];
  416. option[t,casesym]^.selected := [capital,spaft, inbytab, gobsym, crafter];
  417. option[t,casevarsym]^.selected := [capital,spaft, inbytab, gobsym, crafter];
  418. option[t,ofsym]^.selected := [capital,crsupp, spbef, spaft];
  419. option[t,forsym]^.selected := [capital,spaft, inbytab, gobsym, crafter];
  420. option[t,whilesym]^.selected := [capital,spaft, inbytab, gobsym, crafter];
  421. option[t,withsym]^.selected := [capital,spaft, inbytab, gobsym, crafter];
  422. option[t,dosym]^.selected := [capital,crsupp, spbef];
  423. option[t,ifsym]^.selected := [capital,spaft, inbytab, gobsym];
  424. option[t,implementationsym]^.selected := [capital,blinbefore,crafter];
  425. option[t,interfacesym]^.selected := [capital,blinbefore,crafter];
  426. option[t,usessym]^.selected := [capital,blinbefore,spaft];
  427. option[t,thensym]^.selected := [capital];
  428. option[t,elsesym]^.selected := [capital,crbefore, dindonkey, inbytab];
  429. option[t,endsym]^.selected := [capital,crbefore, crafter,dindonkey,dindent];
  430. option[t,untilsym]^.selected := [capital,crbefore, dindonkey, dindent, spaft,
  431. gobsym, crafter];
  432. option[t,becomes]^.selected := [capital,spbef, spaft, gobsym];
  433. option[t,Delphicomment]^.Selected := [crafter];
  434. option[t,opencomment]^.selected := [capital,crsupp];
  435. option[t,closecomment]^.selected := [capital,crsupp];
  436. option[t,semicolon]^.selected := [capital,crsupp, dindonkey, crafter];
  437. option[t,colon]^.selected := [capital,inbytab];
  438. option[t,equals]^.selected := [capital,spbef, spaft, inbytab];
  439. option[t,openparen]^.selected := [capital,gobsym];
  440. option[t,period]^.selected := [capital,crsupp];
  441. end;
  442. option[tsInterface,funcsym]^.selected := [capital, dindonkey, spaft];
  443. option[tsInterface,procsym]^.selected := [capital, dindonkey, spaft];
  444. end;
  445. { ---------------------------------------------------------------------
  446. Stream handling routines
  447. ---------------------------------------------------------------------}
  448. Function ReadChar (S : TStream) : Char;
  449. Var C : Char;
  450. begin
  451. repeat
  452. if S.Position=S.Size then
  453. C:=#0
  454. else
  455. S.Read(C,1);
  456. Until (C<>#13);
  457. ReadChar:=C;
  458. end;
  459. Function EoSLn (S : TStream) : Char;
  460. Const WhiteSpace = [' ', #9, #13 ];
  461. Var C : Char;
  462. begin
  463. Repeat
  464. if S.Position = S.Size then
  465. C:=#0
  466. else
  467. S.Read(C,1);
  468. Until (Not (C in WhiteSpace)) or ((C=#10));
  469. EoSln:=C;
  470. end;
  471. Function ReadString (S: TStream): String;
  472. Var
  473. I : Byte;
  474. Count : Integer;
  475. begin
  476. Result:='';
  477. I:=0;
  478. Repeat
  479. If ((I+1)>Length(Result)) then
  480. SetLength(Result,Length(Result)+255);
  481. Count:=S.Read(Result[I+1],1);
  482. If Count>0 then
  483. Inc(I);
  484. until (Result[I]=#10) or (Count=0);
  485. If Result[i]=#10 Then Dec(I);
  486. If Result[I]=#13 then Dec(I);
  487. SetLength(Result,I);
  488. end;
  489. Procedure WriteString (S : TStream; ST : String);
  490. begin
  491. S.Write(St[1],length(St));
  492. end;
  493. Procedure WriteAnsiString (S : TStream; ST : AnsiString);
  494. begin
  495. S.Write(St[1],length(St));
  496. end;
  497. Procedure WriteCR (S: TStream);
  498. Const
  499. Newline = System.LineEnding;
  500. begin
  501. WriteString(S,Newline);
  502. end;
  503. Procedure WriteLnString (S : TStream; ST : String);
  504. begin
  505. WriteString(S,ST);
  506. WriteCR(S);
  507. end;
  508. { ---------------------------------------------------------------------
  509. TPrettyPrinter object
  510. ---------------------------------------------------------------------}
  511. Procedure TPrettyPrinter.Verbose (Const Msg : String);
  512. begin
  513. If Assigned (FOnVerbose) then
  514. FOnVerbose(Self,Msg);
  515. end;
  516. Procedure TPrettyPrinter.GetChar;
  517. { Read the next character and classify it }
  518. VAR Ch: CHAR;
  519. BEGIN
  520. currchar := nextchar;
  521. WITH nextchar DO
  522. begin
  523. Ch:=ReadCHar(Ins);
  524. If Ch=#0 then
  525. BEGIN
  526. name := filemark;
  527. Value := Blank
  528. END
  529. ELSE If (Ch=#10) THEN
  530. BEGIN
  531. name := endofline;
  532. Value := Ch;
  533. Inc(inlines);
  534. END
  535. ELSE
  536. BEGIN
  537. Value := Ch;
  538. IF Ch IN ['a'..'z', 'A'..'Z', '_'] THEN name := letter
  539. ELSE IF Ch IN ['0'..'9'] THEN name := digit
  540. ELSE IF Ch = '''' THEN name := quote
  541. ELSE IF Ch in [#13,' ',#9] THEN name := space
  542. ELSE name := otherchar
  543. END
  544. end;
  545. END; { of GetChar }
  546. Procedure TPrettyPrinter.StoreNextChar(VAR lngth: INTEGER;
  547. VAR Value: Token);
  548. { Store a character in the current symbol }
  549. BEGIN
  550. GetChar;
  551. IF lngth < MAXSYMBOLSIZE THEN BEGIN {XXX - should there be a limit at all?}
  552. Inc(lngth);
  553. setlength(Value,lngth);
  554. Value[lngth] := currchar.Value;
  555. END;
  556. END; { of StoreNextChar }
  557. Procedure TPrettyPrinter.SkipBlanks(VAR spacesbefore, crsbefore: INTEGER);
  558. { Count the spaces between symbols }
  559. BEGIN
  560. spacesbefore := 0;
  561. crsbefore := 0;
  562. WHILE nextchar.name IN [space, endofline] DO BEGIN
  563. GetChar;
  564. CASE currchar.name OF
  565. space: Inc(spacesbefore);
  566. endofline: BEGIN
  567. Inc(crsbefore);
  568. spacesbefore := 0;
  569. END;
  570. END; {case}
  571. END;
  572. END; { of SkipBlanks }
  573. Procedure TPrettyPrinter.GetComment(sym: symbolinfo);
  574. { Process comments using brace notation }
  575. BEGIN
  576. sym^.name := opencomment;
  577. WHILE NOT ((currchar.Value = '}')
  578. OR (nextchar.name = filemark)) DO
  579. StoreNextChar(sym^.length, sym^.Value);
  580. IF currchar.Value = '}' THEN sym^.name := closecomment;
  581. END; { of GetCommment }
  582. Procedure TPrettyPrinter.GetDoubleComment(sym: symbolinfo);
  583. { Process comments using parenthesis notation }
  584. BEGIN
  585. sym^.name := dopencomment;
  586. WHILE NOT (((currchar.Value = '*') AND (nextchar.Value = ')'))
  587. OR (nextchar.name = filemark)) DO
  588. StoreNextChar(sym^.length, sym^.Value);
  589. IF (currchar.Value = '*') AND (nextchar.Value = ')') THEN BEGIN
  590. StoreNextChar(sym^.length, sym^.Value);
  591. sym^.name := dclosecomment;
  592. END;
  593. END; { of GetDoubleCommment }
  594. Procedure TPrettyPrinter.GetDelphiComment(sym: symbolinfo);
  595. { Process comments using either brace or parenthesis notation }
  596. BEGIN
  597. sym^.name := Delphicomment;
  598. WHILE NOT ((nextchar.name = endofline) OR (nextchar.name = filemark)) DO
  599. StoreNextChar(sym^.length, sym^.Value);
  600. END; { of GetDelphiCommment }
  601. Procedure TPrettyPrinter.GetIdentifier(sym: symbolinfo);
  602. { Read an identifier and classify it }
  603. BEGIN
  604. WHILE nextchar.name IN [letter, digit] DO
  605. StoreNextChar(sym^.length, sym^.Value);
  606. ClassID(sym^.Value, sym^.length, sym^.name, sym^.IsKeyWord);
  607. IF sym^.name IN [recordsym, objectsym,classsym, casesym, endsym] THEN
  608. begin
  609. if sym^.name=implementationsym then
  610. FTokenScope:=tsImplementation;
  611. if sym^.name in [recordsym,objectsym,classsym] then
  612. LastStruct:=sym^.name;
  613. CASE sym^.name OF
  614. RecordSym : Inc(RecordLevel);
  615. ClassSym : ClassSeen:=True;
  616. objectsym : begin
  617. if (PreviousSymbol=Ofsym) then
  618. sym^.name:=ofobjectsym
  619. else
  620. ObjectSeen:=True;
  621. end;
  622. casesym : IF (RecordLevel>0) and (LastStruct=recordsym) THEN sym^.name := casevarsym;
  623. endsym : If (LastStruct=recordsym) then
  624. Dec(Recordlevel);
  625. else
  626. begin
  627. ClassSeen:=False;
  628. ObjectSeen:=False;
  629. end
  630. END; {case}
  631. end;
  632. If (PreviousSymbol=ClassSym) and (sym^.Name=ofsym) then
  633. ClassSeen:=False;
  634. PreviousSymbol:=sym^.Name;
  635. END; { of GetIdentifier }
  636. { Read a number and store it as a string }
  637. Procedure TPrettyPrinter.GetNumber(sym: symbolinfo);
  638. BEGIN
  639. WHILE nextchar.name = digit DO StoreNextChar(sym^.length, sym^.Value);
  640. sym^.name := othersym;
  641. END; { of GetNumber }
  642. PROCEDURE TPrettyPrinter.GetCharLiteral(sym: symbolinfo);
  643. { Read a quoted string }
  644. BEGIN
  645. WHILE nextchar.name = quote DO BEGIN
  646. StoreNextChar(sym^.length, sym^.Value);
  647. WHILE NOT (nextchar.name IN [quote, endofline, filemark]) DO
  648. StoreNextChar(sym^.length, sym^.Value);
  649. IF nextchar.name = quote THEN StoreNextChar(sym^.length, sym^.Value);
  650. END;
  651. sym^.name := othersym;
  652. END; { of GetCharLiteral }
  653. FUNCTION TPrettyPrinter.char_Type: keysymbol;
  654. { Classify a character pair }
  655. VAR
  656. NextTwoChars: SpecialChar;
  657. Hit: BOOLEAN;
  658. thischar: keysymbol;
  659. BEGIN
  660. NextTwoChars[1] := currchar.Value;
  661. NextTwoChars[2] := nextchar.Value;
  662. thischar := becomes;
  663. Hit := FALSE;
  664. WHILE NOT (Hit OR (thischar = opencomment)) DO BEGIN
  665. IF NextTwoChars = DblChar[thischar] THEN Hit := TRUE
  666. ELSE Inc(thischar);
  667. END;
  668. IF NOT Hit THEN BEGIN
  669. thischar := opencomment;
  670. WHILE NOT (Hit OR (PRED(thischar) = period)) DO BEGIN
  671. IF currchar.Value = SglChar[thischar] THEN Hit := TRUE
  672. ELSE Inc(thischar);
  673. END;
  674. END;
  675. IF Hit THEN char_Type := thischar
  676. ELSE char_Type := othersym;
  677. END; { of char_Type }
  678. Procedure TPrettyPrinter.GetSpecialChar(sym: symbolinfo);
  679. { Read special characters }
  680. BEGIN
  681. StoreNextChar(sym^.length, sym^.Value);
  682. sym^.name := char_Type;
  683. IF sym^.name IN dblch THEN StoreNextChar(sym^.length, sym^.Value)
  684. END; { of GetSpecialChar }
  685. Procedure TPrettyPrinter.GetNextSymbol(sym: symbolinfo);
  686. { Read a symbol using the appropriate procedure }
  687. BEGIN
  688. CASE nextchar.name OF
  689. letter: GetIdentifier(sym);
  690. digit: GetNumber(sym);
  691. quote: GetCharLiteral(sym);
  692. otherchar: BEGIN
  693. GetSpecialChar(sym);
  694. IF sym^.name = opencomment THEN GetComment(sym)
  695. else IF sym^.name = dopencomment THEN GetDoubleComment(sym)
  696. else IF sym^.name= DelphiComment then GetDelphiComment(Sym)
  697. END;
  698. filemark: sym^.name := endoffile;
  699. ELSE {:} {Turbo}
  700. WRITELN('Unknown character type: ', ORD(nextchar.name));
  701. END; {case}
  702. END; { of GetNextSymbol }
  703. Procedure TprettyPrinter.GetSymbol;
  704. { Store the next symbol in NEXTSYM }
  705. VAR
  706. dummy: symbolinfo;
  707. BEGIN
  708. dummy := currsym;
  709. currsym := nextsym;
  710. nextsym := dummy;
  711. SkipBlanks(nextsym^.spacesbefore, nextsym^.crsbefore);
  712. nextsym^.length := 0;
  713. nextsym^.IsKeyWord := FALSE;
  714. IF currsym^.name = opencomment THEN GetComment(nextsym)
  715. ELSE IF currsym^.name = dopencomment THEN GetDoubleComment(nextsym)
  716. ELSE GetNextSymbol(nextsym);
  717. END; {of GetSymbol}
  718. Procedure TprettyPrinter.PopStack(VAR indentsymbol: keysymbol;
  719. VAR prevmargin: INTEGER);
  720. { Manage stack of indentation symbols and margins }
  721. BEGIN
  722. IF top > 0 THEN BEGIN
  723. indentsymbol := stack[top].indentsymbol;
  724. prevmargin := stack[top].prevmargin;
  725. Dec(top);
  726. END
  727. ELSE BEGIN
  728. indentsymbol := othersym;
  729. prevmargin := 0;
  730. END;
  731. END; { of PopStack }
  732. Procedure TPrettyPrinter.PushStack(indentsymbol: keysymbol;
  733. prevmargin: INTEGER );
  734. BEGIN
  735. Inc(top);
  736. stack[top].indentsymbol := indentsymbol;
  737. stack[top].prevmargin := prevmargin;
  738. END; { of PushStack }
  739. Procedure TPrettyPrinter.WriteCRs(numberofcrs: INTEGER);
  740. VAR
  741. i: INTEGER;
  742. BEGIN
  743. IF numberofcrs > 0 THEN BEGIN
  744. FOR i := 1 TO numberofcrs DO
  745. WriteCr(OutS);
  746. Inc(outlines,numberofcrs);
  747. Currlinepos := 0;
  748. FirstWordStackPos:=-1;
  749. END;
  750. END; { of WriteCRs }
  751. Procedure TPrettyPrinter.InsertCR;
  752. BEGIN
  753. IF currsym^.crsbefore = 0 THEN BEGIN
  754. WriteCRs(1);
  755. currsym^.spacesbefore := 0;
  756. END;
  757. END; { of InsertCR }
  758. Procedure TPrettyPrinter.InsertBlankLine;
  759. BEGIN
  760. IF currsym^.crsbefore = 0 THEN
  761. BEGIN
  762. IF currlinepos = 0 THEN
  763. WriteCRs(1)
  764. ELSE
  765. WriteCRs(2);
  766. currsym^.spacesbefore := 0;
  767. END
  768. ELSE
  769. IF currsym^.crsbefore = 1 THEN
  770. IF currlinepos > 0 THEN
  771. begin
  772. WriteCRs(1);
  773. currsym^.spacesbefore := 0;
  774. end;
  775. END; { of InsertBlankLine }
  776. Procedure TPrettyPrinter.LShiftOn(dindsym: keysymset);
  777. { Move margin left according to stack configuration and current symbol }
  778. VAR
  779. indentsymbol: keysymbol;
  780. prevmargin: INTEGER;
  781. BEGIN
  782. {$ifdef debug}
  783. Write('LShiftOn ',EntryNames[currsym^.name],' : ',FirstWordPos,'/',CurrMargin);
  784. {$endif debug}
  785. IF top > 0 THEN BEGIN
  786. REPEAT
  787. PopStack(indentsymbol, prevmargin);
  788. IF indentsymbol IN dindsym THEN currmargin := prevmargin;
  789. UNTIL NOT (indentsymbol IN dindsym) OR (top = 0);
  790. IF NOT (indentsymbol IN dindsym) THEN
  791. PushStack(indentsymbol, prevmargin);
  792. END;
  793. {$ifdef debug}
  794. Writeln('-> ',CurrMargin);
  795. {$endif debug}
  796. END; { of LShiftOn }
  797. Procedure TprettyPrinter.LShift;
  798. { Move margin left according to stack top }
  799. VAR
  800. indentsymbol: keysymbol;
  801. prevmargin: INTEGER;
  802. BEGIN
  803. {$ifdef debug}
  804. Write('LShift ',EntryNames[currsym^.name],' : ',FirstWordPos,'/',CurrMargin);
  805. {$endif debug}
  806. IF top > 0 THEN BEGIN
  807. PopStack(indentsymbol, prevmargin);
  808. currmargin := prevmargin;
  809. (* maybe PopStack(indentsymbol,currmargin); *)
  810. END;
  811. {$ifdef debug}
  812. Writeln('-> ',CurrMargin);
  813. {$endif debug}
  814. END; { of LShift }
  815. Procedure TprettyPrinter.RShift(currmsym: keysymbol);
  816. { Move right, stacking margin positions }
  817. BEGIN
  818. {$ifdef debug}
  819. Write('RShift ',EntryNames[currmsym],' : ',FirstWordPos,'/',Currmargin);
  820. {$endif debug}
  821. IF top < MAXSTACKSIZE THEN PushStack(currmsym, currmargin);
  822. IF startpos > currmargin THEN currmargin := startpos;
  823. Inc(currmargin,INDENT);
  824. {$ifdef debug}
  825. Writeln(' -> ',Currmargin)
  826. {$endif debug}
  827. END; { of RShift }
  828. Procedure TprettyPrinter.RShiftIndent(currmsym: keysymbol);
  829. { Move right, stacking margin positions }
  830. BEGIN
  831. {$ifdef debug}
  832. Write('RShiftIndent ',EntryNames[currmsym],' : ',FirstWordPos,'/',Currmargin);
  833. {$endif debug}
  834. If (FirstWordStackPos>=0) then
  835. Top:=FirstWordStackPos
  836. else
  837. Top:=0;
  838. {$ifdef debug}
  839. If (Top>0) then
  840. Write(' Stackpos ',Top,' Item: ',EntryNames[Stack[Top].IndentSymbol],' Pos: ',Stack[Top].Prevmargin)
  841. else
  842. Write(' no item on stack');
  843. {$endif debug}
  844. IF top < MAXSTACKSIZE THEN PushStack(othersym, FirstWordPos);
  845. // IF top < MAXSTACKSIZE THEN PushStack(currmsym, currmargin);
  846. CurrMargin:=FirstWordPos+Indent;
  847. {$ifdef debug}
  848. Writeln(' -> ',Currmargin)
  849. {$endif debug}
  850. END; { of RShift }
  851. Procedure TPrettyPrinter.InsertSpace(VAR symbol: symbolinfo);
  852. { Insert space if room on line }
  853. BEGIN
  854. IF currlinepos < LineSize THEN BEGIN
  855. WriteString(OutS, Blank);
  856. Inc(currlinepos);
  857. IF (symbol^.crsbefore = 0) AND (symbol^.spacesbefore > 0)
  858. THEN Dec(symbol^.spacesbefore);
  859. END;
  860. END; { of InsertSpace }
  861. Procedure TPrettyPrinter.MoveLinePos(newlinepos: INTEGER);
  862. { Insert spaces until correct line position reached }
  863. VAR i: INTEGER;
  864. BEGIN
  865. FOR i := SUCC(currlinepos) TO newlinepos DO
  866. WriteString(OutS, Blank);
  867. currlinepos := newlinepos;
  868. END; { of MoveLinePos }
  869. Procedure TPrettyPrinter.PrintSymbol;
  870. BEGIN
  871. IF (currsym^.IsKeyWord) then
  872. begin
  873. If upper in sets^.selected Then
  874. WriteString (OutS,UpperStr(currsym^.value))
  875. else if lower in sets^.selected then
  876. WriteString (OutS,LowerStr(currsym^.value))
  877. else if capital in sets^.selected then
  878. begin
  879. WriteString(OutS,UpCase(CurrSym^.Value[1]));
  880. WriteString(OutS,LowerStr(Copy(CurrSym^.Value,2,MAXSYMBOLSIZE)));{XXX - ?should it be length?}
  881. end
  882. else
  883. WriteString(OutS,Currsym^.Value);
  884. end
  885. ELSE
  886. WriteAnsiString(OutS, currsym^.Value);
  887. startpos := currlinepos;
  888. Inc(currlinepos,currsym^.length);
  889. if (FirstWordStackPos=-1) then
  890. begin
  891. FirstWordPos:=startpos;
  892. FirstWordStackPos:=Top;
  893. {$ifdef debug}
  894. write('First word : ',currlinepos,': ',currsym^.value);
  895. If (FirstWordStackPos>0) then
  896. writeln(' [Stack: ',FirstWordStackPos,' Item: "',EntryNames[Stack[FirstWordStackPos].IndentSymbol],'" Pos: ',Stack[FirstWordStackPos].Prevmargin,']')
  897. else
  898. Writeln(' No stack')
  899. {$endif debug}
  900. end;
  901. END; { of PrintSymbol }
  902. Procedure TPrettyPrinter.PPSymbol;
  903. { Find position for symbol and then print it }
  904. VAR newlinepos: INTEGER;
  905. BEGIN
  906. WriteCRs(currsym^.crsbefore);
  907. IF ((currLinePos<>0) and (currlinepos + currsym^.spacesbefore > currmargin)) OR
  908. (currsym^.name IN [opencomment, closecomment,dopencomment, dclosecomment])
  909. THEN
  910. newlinepos := currlinepos + currsym^.spacesbefore
  911. ELSE
  912. newlinepos := currmargin;
  913. IF newlinepos + currsym^.length > LINESIZE THEN
  914. BEGIN {XXX - this needs to be cleaned for case of long symbol values}
  915. WriteCRs(1);
  916. IF currmargin + currsym^.length <= LINESIZE THEN
  917. newlinepos := currmargin
  918. ELSE IF currsym^.length < LINESIZE THEN
  919. newlinepos := LINESIZE - currsym^.length
  920. ELSE
  921. newlinepos := 0;
  922. END;
  923. MoveLinePos(newlinepos);
  924. PrintSymbol;
  925. END; { of PPSymbol }
  926. Procedure TPrettyPrinter.Gobble(terminators: keysymset);
  927. { Print symbols which follow a formatting symbol but which do not
  928. affect layout }
  929. BEGIN
  930. {$ifdef debug}
  931. Inc(GobbleLevel);
  932. Writeln('Gobble start ',GobbleLevel,' : ',EntryNames[currsym^.name]);
  933. {$endif debug}
  934. IF top < MAXSTACKSIZE THEN PushStack(currsym^.name, currmargin);
  935. currmargin := currlinepos;
  936. WHILE NOT ((nextsym^.name IN terminators)
  937. OR (nextsym^.name = endoffile)) DO BEGIN
  938. GetSymbol;
  939. PPSymbol;
  940. END;
  941. LShift;
  942. {$ifdef debug}
  943. Writeln('Gobble end ',gobblelevel,' : ',EntryNames[nextsym^.name],' ',nextsym^.name in terminators );
  944. Dec(GobbleLevel);
  945. {$endif debug}
  946. END; { of Gobble }
  947. Function TPrettyPrinter.ReadConfigFile : Boolean;
  948. Var
  949. I,J : Longint;
  950. Procedure SetOption(TheKey : KeySymbol;Var OptionList : String);
  951. Var TheOpt : Options;
  952. Found : Boolean;
  953. K : longint;
  954. opt : string;
  955. TS : TTokenScope;
  956. begin
  957. Repeat
  958. K:=pos(',',optionlist);
  959. If k>0 then
  960. begin
  961. opt:=Copy(OptionList,1,k-1);
  962. strip(opt);
  963. Delete(OptionList,1,k);
  964. end
  965. else
  966. opt:=OptionList;
  967. If Length(Opt)>0 then
  968. begin
  969. Found:=False;
  970. for TheOpt :=firstopt to lastopt do
  971. begin
  972. found:=opt=OptionNames[Theopt];
  973. If found then break;
  974. end;
  975. If not found then
  976. Verbose ('Unknown option on line '+inttostr(i)+': '+Opt)
  977. else
  978. For TS:=Low(TTokenScope) to High(TTokenScope) do
  979. Option[TS,TheKey]^.Selected:=Option[TS,TheKey]^.Selected+[TheOpt];
  980. end;
  981. until k=0;
  982. end;
  983. Procedure SetIndent(TheKey : KeySymbol; Var OptionList : String);
  984. Var
  985. TheIndent : Keysymbol;
  986. Found : Boolean;
  987. K : longint;
  988. opt : string;
  989. TS : TTokenScope;
  990. begin
  991. Repeat
  992. K:=pos(',',optionlist);
  993. If k>0 then
  994. begin
  995. opt:=Copy(OptionList,1,k-1);
  996. strip(opt);
  997. Delete(OptionList,1,k);
  998. end
  999. else
  1000. opt:=OptionList;
  1001. If Length(Opt)>0 then
  1002. begin
  1003. Found:=False;
  1004. for TheIndent :=firstKey to lastKey do
  1005. begin
  1006. found:=opt=EntryNames[Theindent];
  1007. If found then break;
  1008. end;
  1009. If not found then
  1010. begin
  1011. Verbose ('Unknown indent keysym on line '+inttostr(i)+': '+Opt);
  1012. exit;
  1013. end;
  1014. For TS:=Low(TTokenScope) to High(TTokenScope) do
  1015. Option[TS,TheKey]^.dindsym:=Option[TS,TheKey]^.dindsym+[Theindent];
  1016. end;
  1017. until k=0;
  1018. end;
  1019. Var TheKey : KeySymbol;
  1020. Found,DoIndent : Boolean;
  1021. Line, Name : String;
  1022. L : TStringList;
  1023. begin
  1024. ReadConfigFile:=false;
  1025. L:=TStringList.Create;
  1026. Try
  1027. L.LoadFromStream(CfgS);
  1028. For I:=1 to L.Count do
  1029. begin
  1030. Line:=L[i-1];
  1031. { Strip comment }
  1032. If pos('#',Line)<>0 then
  1033. Line:=Copy(Line,1,Pos('#',Line)-1);
  1034. If length(Line)<>0 then
  1035. begin
  1036. J:=Pos('=',Line);
  1037. If J>0 then
  1038. begin
  1039. Line:=LowerStr(Line);
  1040. Name:=Copy(Line,1,j-1);
  1041. Delete(Line,1,J);
  1042. { indents or options ? }
  1043. If (Name[1]='[') and
  1044. (Name[Length(Name)]=']') then
  1045. begin
  1046. Name:=Copy(Name,2,Length(Name)-2);
  1047. Doindent:=True;
  1048. end
  1049. else
  1050. DoIndent:=False;
  1051. Strip(Name);
  1052. found:=false;
  1053. for thekey:=firstkey to lastkey do
  1054. begin
  1055. found:=Name=EntryNames[thekey];
  1056. If Found then break;
  1057. end;
  1058. If not found then
  1059. Verbose ('Unknown keyword on line '+inttostr(i)+': '+Name)
  1060. else
  1061. If DoIndent then
  1062. SetIndent(TheKey,Line)
  1063. else
  1064. SetOption(TheKey,Line)
  1065. end
  1066. else
  1067. verbose ('Error in config file on line '+IntToStr(i));
  1068. end;
  1069. end;
  1070. Finally
  1071. L.Free;
  1072. end;
  1073. Verbose ('Processed configfile: read '+IntToStr(I)+' lines');
  1074. ReadConfigFile:=true;
  1075. end;
  1076. Procedure GenerateCfgFile(S : TStream);
  1077. Var TheKey,TheIndent : KeySymbol;
  1078. TheOpt : Options;
  1079. Written : Boolean;
  1080. Option : OptionTable;
  1081. begin
  1082. CreateOptions(option);
  1083. SetDefaults(option);
  1084. SetDefaultIndents(option);
  1085. For TheKey:=Firstkey to lastkey do
  1086. begin
  1087. { Write options }
  1088. WriteString (S,EntryNames[TheKey]+'=');
  1089. Written:=False;
  1090. for TheOpt:=FirstOpt to LastOpt do
  1091. If TheOpt in Option[tsInterface,TheKey]^.Selected then
  1092. begin
  1093. if written then
  1094. WriteString (S,',')
  1095. else
  1096. Written:=True;
  1097. writeString (S,OptionNames[TheOpt]);
  1098. end;
  1099. WriteCr (S);
  1100. { Write de-indent keysyms, if any }
  1101. If Option[tsInterface,TheKey]^.dindsym<>[] then
  1102. begin
  1103. WriteString (S,'['+EntryNames[TheKey]+']=');
  1104. Written:=False;
  1105. For TheIndent:=FirstKey to lastkey do
  1106. If TheIndent in Option[tsInterface,TheKey]^.dindsym then
  1107. begin
  1108. if written then
  1109. WriteString (S,',')
  1110. else
  1111. Written:=True;
  1112. WriteString (S,EntryNames[Theindent]);
  1113. end;
  1114. WriteCr (S);
  1115. end;
  1116. end;
  1117. end;
  1118. Function trimMiddle ( a:ansistring; lnght: integer; size: integer):string;
  1119. var
  1120. half:Integer;
  1121. begin
  1122. if lnght > size
  1123. then
  1124. begin
  1125. half := (size - 3) div 2;
  1126. trimMiddle := copy(a,1,half) + '...' + copy(a,lnght-half+1,half);
  1127. end
  1128. else
  1129. trimMiddle := a;
  1130. end;
  1131. Function TPrettyPrinter.PrettyPrint : Boolean;
  1132. Begin
  1133. PrettyPrint:=False;
  1134. If Not Assigned(Ins) or Not Assigned(OutS) then
  1135. exit;
  1136. If Not Assigned(CfgS) then
  1137. begin
  1138. SetDefaults(Option);
  1139. SetDefaultIndents(Option);
  1140. end
  1141. else
  1142. ReadConfigFile;
  1143. { Initialize variables }
  1144. top := 0;
  1145. currlinepos := 0;
  1146. currmargin := 0;
  1147. inlines := 0;
  1148. outlines := 0;
  1149. CrPending := FALSE;
  1150. FirstWordStackPos:=-1;
  1151. RecordLevel := 0;
  1152. GetChar;
  1153. NEW(currsym);
  1154. NEW(nextsym);
  1155. GetSymbol;
  1156. WHILE nextsym^.name <> endoffile DO BEGIN
  1157. GetSymbol;
  1158. {$ifdef debug}
  1159. Writeln('line in-'+IntToStr(inlines)+' out-'+IntToStr(outlines)+
  1160. ' symbol "'+EntryNames[currsym^.name]+'" = "'+
  1161. trimMiddle(currsym^.value,length(currsym^.value),MAXSHOWSIZE)+'"');
  1162. {$endif debug}
  1163. sets := option[FTokenScope,currsym^.name];
  1164. IF (CrPending AND NOT (crsupp IN sets^.selected))
  1165. OR (crbefore IN sets^.selected) THEN BEGIN
  1166. InsertCR;
  1167. CrPending := FALSE
  1168. END;
  1169. IF blinbefore IN sets^.selected THEN BEGIN
  1170. InsertBlankLine;
  1171. CrPending := FALSE
  1172. END;
  1173. IF dindonkey IN sets^.selected THEN
  1174. LShiftOn(sets^.dindsym);
  1175. IF dindent IN sets^.selected THEN
  1176. LShift;
  1177. IF spbef IN sets^.selected THEN InsertSpace(currsym);
  1178. PPSymbol;
  1179. IF spaft IN sets^.selected THEN InsertSpace(nextsym);
  1180. IF inbytab IN sets^.selected THEN
  1181. RShift(currsym^.name)
  1182. else IF inbyindent IN sets^.selected THEN
  1183. RShiftIndent(currsym^.name);
  1184. IF gobsym IN sets^.selected THEN Gobble(sets^.terminators);
  1185. IF crafter IN sets^.selected THEN CrPending := TRUE
  1186. END;
  1187. IF CrPending THEN WriteCRs(1);
  1188. Verbose(IntToStr(inlines)+' lines read, '+IntToStr(outlines)+' lines written.');
  1189. PrettyPrint:=True;
  1190. end;
  1191. Constructor TPrettyPrinter.Create;
  1192. Begin
  1193. Indent:=DefIndent;
  1194. LineSize:=DefLineSize;
  1195. CreateOptions (Option);
  1196. SetTerminators(Option);
  1197. InS:=Nil;
  1198. OutS:=Nil;
  1199. CfgS:=Nil;
  1200. End;
  1201. { ---------------------------------------------------------------------
  1202. Unit initialization
  1203. ---------------------------------------------------------------------}
  1204. Begin
  1205. dblch := [becomes, opencomment];
  1206. end.