fpc/utils/ptop.pp

{$mode objfpc}
{$H+}
Program PtoP;
{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2002 by Michael Van Canneyt, member of
    the Free Pascal development team

    Pascal pretty print program

    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.

 **********************************************************************}


Uses SysUtils,Classes,PtoPu,CustApp, bufstream;

ResourceString
  Version   = 'Version 1.2';
  ATitle     = 'PToP';
  Copyright = 'Copyright (c) 1999-2005 by the Free Pascal Development Team';
  SErrNoInputOutput = 'No input and output file given';
  
Type
  TPToP = Class(TCustomApplication)
  Private
    Infilename,
    OutFileName,
    ConfigFile : String;
    BeVerbose : Boolean;
    TheIndent,
    TheBufSize,
    TheLineSize : Integer;
    Procedure Usage(ECode : Word);
    Procedure GenOpts;
    Procedure ProcessOpts;
    Procedure DoVerbose(Sender : TObject; Const Msg : String);
  Public
    Procedure DoRun; override;
  end;


Procedure TPToP.DoVerbose(Sender : TObject; Const Msg : String);

begin
  Writeln(StdErr,Msg);
end;

Procedure TPToP.Usage(ECode : Word);

begin
  Writeln ('ptop : Usage : ');
  Writeln ('ptop [-v] [-i indent] [-b bufsize ][-c optsfile][-l linesize] infile outfile');
  Writeln ('     converts infile to outfile.');
  Writeln ('     -c : read options from optsfile');
  Writeln ('     -i : Set number of indent spaces.');
  Writeln ('     -l : Set maximum output linesize.');
  Writeln ('     -b : Use buffers of size bufsize');
  Writeln ('     -v : be verbose');
  writeln ('ptop -g ofile');
  writeln ('     generate default options file');
  Writeln ('ptop -h : This help');
  halt(Ecode);
end;

Procedure TPToP.Genopts;

Var S : TFileStream;

begin
  S:=TFileStream.Create(ConfigFile,fmCreate);
  Try
    GeneratecfgFile(S);
  Finally
    S.Free;
  end;
end;

Procedure TPToP.ProcessOpts;

Var
  S : String;
begin
  { Set defaults }
  Infilename:='';
  OutFileName:='';
  ConfigFile:='';
  TheIndent:=2;
  TheBufSize:=255;
  TheLineSize:=DefLineSize;
  BeVerbose:=False;
  S:=CheckOptions('icglbhv','');
  If (S<>'') then
    begin
    Writeln(stderr,S);
    Usage(1);
    end;
  if HasOption('h') then
    usage(0);
  TheIndent:=StrToIntDef(GetOptionValue('i',''),2);
  TheBufSize:=StrToIntDef(GetOptionValue('b',''),255);
  TheLineSize:=StrToIntDef(GetOptionValue('l',''),DefLineSize);
  If HasOption('g') then
    begin
    ConfigFile:=GetOptionValue('g','');
    GenOpts;
    halt(0);
    end;
  ConfigFile:=GetOptionValue('c','');
  BeVerbose:=HasOption('v');
  If (ParamCount>1) then
    begin
    InFileName:=paramstr(ParamCount-1);
    OutFilename:=Paramstr(ParamCount);
    end;
end; { Of ProcessOpts }

Procedure TPToP.DoRun;

Var
  F,InS,OutS,cfgS : TSTream;
  PPrinter : TPrettyPrinter;

begin
  ProcessOpts;
  if BeVerbose then
    begin
    writeln(Title+' '+Version);
    writeln(Copyright);
    Writeln;
    end;
  If (Length(InfileName)=0) or (Length(OutFileName)=0) Then
    begin
    Writeln(stderr,SErrNoInputOutput);
    Usage(1);
    end;
  Ins:=TMemoryStream.Create;
  try
    F:=TFileStream.Create(InFileName,fmOpenRead);
    Try
      Ins.CopyFrom(F,0);
      Ins.Position:=0;
    Finally
      F.Free;
    end;
    OutS:=TwriteBufStream.Create(TFileStream.Create(OutFileName,fmCreate));
    Try
      If ConfigFile<>'' then
        CfgS:=TFileStream.Create(ConfigFile,fmOpenRead)
      else
        CfgS:=Nil;
      try
        PPrinter:=TPrettyPrinter.Create;
        Try
          PPrinter.Indent:=TheIndent;
          PPrinter.LineSize:=TheLineSize;
          PPrinter.Source:=Ins;
          PPrinter.Dest:=OutS;
          PPrinter.Config:=CfgS;
          If BeVerbose then
            PPrinter.OnVerbose:=@DoVerbose;
          PPrinter.PrettyPrint;
        Finally
          FreeAndNil(PPrinter);
        end;
      Finally
        FreeAndNil(CfgS);
      end;
    Finally
      FreeAndNil(OutS);
    end;
  Finally
    FreeAndNil(Ins);
  end;
  Terminate;
end;

begin
  With TPToP.Create(Nil) do
    Try
      Title:= ATitle;
      StopOnException:=True;
      Initialize;
      Run;
    Finally
      Free;
    end;
end.