ptop.pp 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204
  1. Program PtoP;
  2. {
  3. $Id$
  4. This file is part of the Free Pascal run time library.
  5. Copyright (c) 1999-2000 by Michael Van Canneyt, member of
  6. the Free Pascal development team
  7. Pascal pretty print program
  8. See the file COPYING.FPC, included in this distribution,
  9. for details about the copyright.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13. **********************************************************************}
  14. Uses PtoPu,Objects,getopts;
  15. Var
  16. Infilename,OutFileName,ConfigFile : String;
  17. BeVerbose : Boolean;
  18. TheIndent,TheBufSize,TheLineSize : Integer;
  19. Function StrToInt(Const S : String) : Integer;
  20. Var Code : integer;
  21. Int : integer;
  22. begin
  23. Val(S,int,Code);
  24. StrToInt := int;
  25. If Code<>0 then StrToInt:=0;
  26. end;
  27. Procedure Usage;
  28. begin
  29. Writeln ('ptop : Usage : ');
  30. Writeln ('ptop [-v] [-i indent] [-b bufsize ][-c optsfile][-l linesize] infile outfile');
  31. Writeln (' converts infile to outfile.');
  32. Writeln (' -c : read options from optsfile');
  33. Writeln (' -i : Set number of indent spaces.');
  34. Writeln (' -l : Set maximum output linesize.');
  35. Writeln (' -b : Use buffers of size bufsize');
  36. Writeln (' -v : be verbose');
  37. writeln ('ptop -g ofile');
  38. writeln (' generate default options file');
  39. Writeln ('ptop -h : This help');
  40. halt(0);
  41. end;
  42. Procedure Genopts;
  43. Var S : PBufStream;
  44. begin
  45. S:=New(PBufStream,Init(ConfigFile,stCreate,255));
  46. GeneratecfgFile(S);
  47. {$ifndef tp}
  48. S^.Close;
  49. {$endif}
  50. S^.Done;
  51. end;
  52. Procedure ProcessOpts;
  53. Var c : char;
  54. begin
  55. { Set defaults }
  56. Infilename:='';
  57. OutFileName:='';
  58. ConfigFile:='';
  59. TheIndent:=2;
  60. TheBufSize:=255;
  61. TheLineSize:=MaxLineSize;
  62. BeVerbose:=False;
  63. Repeat
  64. c:=getopt('i:c:g:b:hv');
  65. case c of
  66. 'i' : begin
  67. TheIndent:=StrToInt(OptArg);
  68. If TheIndent=0 then TheIndent:=2;
  69. end;
  70. 'b' : begin
  71. TheBufSize:=StrToInt(OptArg);
  72. If TheBufSize=0 then TheBufSize:=255;
  73. end;
  74. 'c' : ConfigFile:=OptArg;
  75. 'l' : begin
  76. TheLineSize:=StrToInt(OptArg);
  77. If TheLineSIze=0 Then TheLineSize:=MaxLineSize;
  78. end;
  79. 'g' : begin
  80. ConfigFIle:=OptArg;
  81. GenOpts;
  82. halt(0);
  83. end;
  84. 'h' : usage;
  85. 'v' : BeVerbose:=True;
  86. else
  87. end;
  88. until c=endofoptions;
  89. If optind<=paramcount then
  90. begin
  91. InFileName:=paramstr(OptInd);
  92. Inc(optind);
  93. If OptInd<=paramcount then
  94. OutFilename:=Paramstr(OptInd);
  95. end;
  96. end; { Of ProcessOpts }
  97. Var DiagS : PMemoryStream;
  98. InS,OutS,cfgS : PBufSTream;
  99. PPrinter : TPrettyPrinter;
  100. P : Pchar;
  101. i : longint;
  102. Procedure StreamErrorProcedure(Var S: TStream);{$ifndef fpc}FAR;{$endif}
  103. Begin
  104. If S.Status = StError then
  105. WriteLn('ERROR: General Access failure. Halting');
  106. If S.Status = StInitError then
  107. WriteLn('ERROR: Cannot Init Stream. Halting. ');
  108. If S.Status = StReadError then
  109. WriteLn('ERROR: Read beyond end of Stream. Halting');
  110. If S.Status = StWriteError then
  111. WriteLn('ERROR: Cannot expand Stream. Halting');
  112. If S.Status = StGetError then
  113. WriteLn('ERROR: Get of Unregistered type. Halting');
  114. If S.Status = StPutError then
  115. WriteLn('ERROR: Put of Unregistered type. Halting');
  116. end;
  117. begin
  118. StreamError:={$ifndef tp}@{$endif}StreamErrorProcedure;
  119. ProcessOpts;
  120. If (Length(InfileName)=0) or (Length(OutFileName)=0) Then
  121. Usage;
  122. Ins:=New(PBufStream,Init(InFileName,StopenRead,TheBufSize));
  123. OutS:=New(PBufStream,Init(OutFileName,StCreate,TheBufSize));
  124. If BeVerbose then
  125. diagS:=New(PMemoryStream,Init(1000,255))
  126. else
  127. DiagS:=Nil;
  128. If ConfigFile<>'' then
  129. CfgS:=New(PBufStream,Init(ConfigFile,StOpenRead,TheBufSize))
  130. else
  131. CfgS:=Nil;
  132. PPrinter.Create;
  133. PPrinter.Indent:=TheIndent;
  134. PPrinter.LineSize:=TheLineSize;
  135. PPrinter.Ins:=Ins;
  136. PPrinter.outS:=OutS;
  137. PPrinter.cfgS:=CfgS;
  138. PPrinter.DiagS:=DiagS;
  139. PPrinter.PrettyPrint;
  140. If Assigned(DiagS) then
  141. begin
  142. I:=DiagS^.GetSize;
  143. DiagS^.Seek(0);
  144. getmem (P,I+1);
  145. DiagS^.Read(P[0],I);
  146. P[I]:=#0;
  147. {$ifndef tp}
  148. Writeln (stderr,P);
  149. Flush(stderr);
  150. {$else}
  151. Writeln (P);
  152. {$endif}
  153. DiagS^.Done;
  154. end;
  155. If Assigned(CfgS) then
  156. CfgS^.Done;
  157. Ins^.Done;
  158. OutS^.Done;
  159. end.
  160. {
  161. $Log$
  162. Revision 1.1 2000-07-13 10:16:22 michael
  163. + Initial import
  164. Revision 1.7 2000/07/04 19:05:55 peter
  165. * be optimistic: version 1.00 for some utils
  166. Revision 1.6 2000/02/09 16:44:15 peter
  167. * log truncated
  168. Revision 1.5 2000/02/07 13:41:51 peter
  169. * fix wrong $ifdef tp
  170. Revision 1.4 2000/02/06 19:58:24 carl
  171. + Error detection of streams
  172. Revision 1.3 2000/01/07 16:46:04 daniel
  173. * copyright 2000
  174. }