{ TurboPascal layout tool }

program CLEAN_TP ; uses Dos ; {$B-,R+}

{ J R Stockton ð program to indent TurboPascal according to logical structure.
  Was PRETTY.PAS.  For TP5 / TP5.5 / TP6 / TP7 / BP7 / BP8 ? ;
  Compile with TPn or higher to make CLEAN-TP process TPn code.
  Can be installed in BP7 as a Tool; command line = $save cur /* $EDNAME
  Honours the TP comment convention which considers { and (* to be different
  and to need only the first corresponding closing symbol to terminate.
  Parameters are taken in turn.  Options are each preceded by / :
  /<digit> => indent-unit, default = 2 spaces;
  /<t or T> => indenting uses HT chars; HT = ^I = #9;
  /# => use StdOut, show indent numbers;
  /! => use StdOut, show indent bars;
  /* => do one file only (for BP7 Tools) ;
  other parameters are I/O wildcard files; if no files, StdIn & StdOut used.
  DO NOT use CLEAN-TP < Q > Q which destroys most of Q; use CLEAN-TP Q }

{ This program is used at your own risk if obtained from JRS; RSVP.
  If distributed by MGK/CSU, MGK/CSU must read this, hold sources, &c. }

{ Adjusts indents only; needs a little user cooperation : reserved words
  "program unit library begin record object case end repeat until of
  procedure function const var type" should in general be lower case,
  but main block is best with capitals in its "BEGIN; ... END.".
  "END." or "end." must be at the beginning of a line which ends CRLF.
  Where a reserved word does not have its own usual "end", hide it by
  capitalisation, except in the case of "record case ... end;",
  or note that now "(*+*)" increases and "(*-*)" decreases the indentation.
  If SB was defined at compile time, all letters are taken as lower case.
  If "program", "library", or "unit" does not appear at the start,
  the file is assumed to be an Include file.  Library untested.
  Units should have an initialisation part, which can be empty.
  Check results by using "FC /w OldFile NewFile" (NB Not all DOS have FC)}

{$IFDEF VER50} {TP5.0}                             {$ENDIF}
{$IFDEF VER55} {TP5.5} {$DEFINE OBJ} {$DEFINE UPZ} {$ENDIF}
{$IFDEF VER60} {TP6.0} {$DEFINE OBJ} {$DEFINE ASM} {$ENDIF}
{$IFDEF VER70} {TP7.0} {$DEFINE OBJ} {$DEFINE ASM} {$ENDIF}
{$IFDEF VER80} {TP8.0/Delphi} Re-write?! ; {$ENDIF}

const Sp = char(32) ; HT = char(9) ; FF = char(12) ; Aint = 0 ;

var
S, P : string ;
Indent : shortint ;
EndCom : string [2] ;
UnknownSort, ObjDec : boolean ;


function OKwd(b : byte) : boolean ;
const nIDset = [#0..#255] - ['A'..'Z', 'a'..'z', '_', '0'..'9'] ;
begin OKwd := (b=0) or (b>Length(S)) or (S[b] in nIDset) end {OKwd} ;

function IsResWd(d, L : byte) : boolean ;
begin IsResWd := OKwd(d-1) and OKwd(d+L) end {IsResWd} ;

procedure Try(rw : string ;
  x : shortint) ;
var d : byte ;
begin
  repeat d := Pos(rw, S) ;
    if d>Aint then begin S[d] := '!' ;
      if IsResWd(d, Length(rw)) then Inc(Indent, x) ;
      end {d>Aint} ;
    until d=Aint ;
  end {Try} ;

procedure TryObj(x : shortint) ;
var d : byte ;
begin ObjDec := false ;
  repeat d := Pos('object', S) ;
    if d>Aint then begin S[d] := '!' ; ObjDec := true ;
      if IsResWd(d, Length('object')) then Inc(Indent, x) ;
      end {d>Aint} ;
    until d=Aint ;
  end {Try} ;

function Test(rw : string) : boolean ;
var d : byte ;
begin Test := false ;
  d := Pos(rw, S) ;
  if (d>Aint) and IsResWd(d, Length(rw)) then begin
    UnknownSort := false ; Test := true end ;
  end {Test} ;


function X(T : string) : boolean ;
begin
  X := (T=Copy(S, Length(S)-Length(T)+1, Length(T)))
    and OKwd(Length(S)-Length(T)) ;
  end {X} ;

var
ConF : text ;


const
Tabs : boolean = false ;     (*+*)
  Plop : boolean = false ;   (*-*)
Hash : boolean = false ;
One  : byte = 2 { default indent size } ;


procedure Job ;
var i, j, k, m, n : byte ; si, parens : shortint ;
Continuing, SeemsIncludeFile : boolean ;
CStr, TabStr : string [9] ; S3 : string [3] ;
const Cn : array [boolean] of char = ('C', 'n') ; S9 = '         ' ;
begin
  SeemsIncludeFile := true ; UnknownSort := true ; ObjDec := false ;
  Continuing := false ; EndCom := '' ; Indent := 0 ; parens := 0 ;
  if Tabs then TabStr := ^I else begin
    TabStr := S9 ; TabStr[0] := char(One) end ;
  CStr := TabStr ;
  if Plop then if Tabs then TabStr := '!'^I else TabStr[1] := '!' ;

  repeat

    if EoF then begin
      if not SeemsIncludeFile then
        Writeln('{Seems a Program/Unit/Library.  No "<NL>END." or "end." found!}') ;
      EXIT end {EoF} ;

    Readln(S) ;
    while S[Length(S)] in [Sp, HT] do Delete(S, Length(S), 1) ;
    if Length(S)>126 then begin
      Writeln(ConF, 'INPUT LINE TOO LONG : ',
        Copy(S, 1, 52), ' ...'^M^J, Copy(S, 53, 126), ' <<<'^M^J,
        Copy(S, 127, 255)) ; HALT end ;
    k := 1 ; while S[k] in [Sp, HT] do Inc(k) ; Delete(S, 1, k-1) ;

    P := '' ;
    if Hash then begin
      Str(Indent:2, P) ; P := Cn[EndCom=''] + P + Sp end ;

    if (S>'') or Plop then begin
      for si := 1+Ord(ObjDec) to Indent do P := P + TabStr ;
      if (EndCom>'') or Continuing then P := P + CStr ;
      P := P + S end {or} ;

    if Length(P)<=126 then m := 1 else begin m := Length(P) - 126 + 1 ;
      Writeln('{Next line under-indented}') end ;
    Writeln(Copy(P, m, 255)) ; (*** Ensures Length(P)<=126 ***)

    if EndCom>'' then begin
      k := Pos(EndCom, S) ;
      if k=Aint then S := '' else begin
        Delete(S, 1, k-1+Length(EndCom)) ; EndCom := '' end {<>Aint} ;
      end {>''} ;

    if EndCom='' then repeat {'} (*{*) {*)} {tests}
      i := Pos('''', S) ; { m will be first opener,  ' { (*  }       m := i ;
      j := Pos('{', S) ;  if (j>Aint) and ( (m=Aint) or (j<m) ) then m := j ;
      k := Pos('(*', S) ; if (k>Aint) and ( (m=Aint) or (k<m) ) then m := k ;
      if m>Aint then begin
        if i=m then begin
          S[i] := '"' ; n := Pos('''', S) ;
          if n=Aint then Writeln(^G'(*** Quote error in above line! ***)') ;
          Delete(S, m, n-m+1) end {i=m}
        else begin
          if j=m then EndCom := '}' else {k=m} begin
            S3 := Copy(S, k+2, 3) ;
            if S3='+*)' then Inc(Indent) ;
            if S3='-*)' then Dec(Indent) ;
            EndCom := '*)' end ;
          n := Pos(EndCom, S) {Close} ;
          if n=Aint then Delete(S, m, 255) else begin
            Delete(S, m, n-m+Length(EndCom)) ; EndCom := '' end {n<>Aint} ;
          end {i<>m} ;
        end {m>Aint} ;
      until m=Aint ;

    while S[Length(S)] in [Sp, HT, FF] do Delete(S, Length(S), 1) ;

    if S>'' then begin
      {$IFDEF SB}
      for k := 1 to Length(S) do
        if S[k] in ['A'..'Z'] then S[k] := char(byte(S[k]) or $20) ;
      {$ENDIF}

      for k := 1 to Length(S) do
        if S[k]='(' then Inc(parens) else if S[k]=')' then Dec(parens) ;

      if UnknownSort then begin
        if Test('program') or Test('unit') or Test('library') then
          SeemsIncludeFile := false else
          if Test('const') or Test('var') or Test('type') or
          Test('procedure') or Test('function') then ;
        end {US} ;

      Try('record case', 0) ;
      Try('begin', 1) ; Try('record', 1) ; Try('case', 1) ; Try('repeat', 1) ;
      (*** Try('unit', 1) ; ***)
      {$IFDEF OBJ} TryObj(1) {$ENDIF} ;
      {$IFDEF ASM} Try('asm', 1) {$ENDIF} ;

      Try('end', -1) ; Try('until', -1) ;

      if (Pos('END.', S)=1 ) or (Pos('!nd.', S)>Aint) then begin
        while not EoF do begin Readln(S) ; Writeln(S) end {not EoF} ;
        if SeemsIncludeFile then
          Writeln('{Seems an Include file.  "<NL>END." or "end." found!}') ;
        EXIT end {or} ;

      if S>'' then Continuing :=
        ( (S[Length(S)]<>';') or (parens<>0) ) and not
        ( X('of') or X(':') or X('!egin') or X('!nd')
        or X('!epeat') or X('!ecord')
        or (S='var') or (S='const') or (S='type') or (S='label')
        or (S='interface') or (S='implementation')
        or (S='private') or (S='public') ) ;

      end {S>''} ;

    until false ;
  end {Job} ;


var BufIn, BufOut : array [0..16383] of char ;
const Tried : boolean = false ;


procedure DoOne(InFiNa : string ; RN : boolean) ;
var Bad, OvrFlo, Um : boolean ; LI : longint ; OuFiNa : string ;
begin Bad := false ; OvrFlo := false ; Write(ConF, InFiNa, ' ') ;
  Assign(Input, InFiNa) ; SetTextBuf(Input, BufIn) ; Reset(Input) ;
  if RN then
    begin OuFiNa := InFiNa ; OuFiNa[Length(OuFiNa)] := 'ä' ;
    end else OuFiNa := '' ;
  Assign(Output, OuFiNa) ; SetTextBuf(Output, BufOut) ; Rewrite(Output) ;
  Job ;
  Um := Indent<>0 ;
  if Um then begin Bad := true ;
    Writeln(^G'Indent count error = ', Indent) end ;
  Um := EndCom>'' ;
  if Um then begin Bad := true ;
    Writeln(^G'In comment - wants ', EndCom) end ;
  OvrFlo := DiskFree(0)=0 ;
  if OvrFlo then begin Bad := true ;
    Writeln(^G'Out-Pipe full?') ; Writeln(ConF, ^G'Out-Pipe full?') end ;
  {$IFDEF UPZ} Write(^Z {only before V5.5 or V6.0} ) ; {$ENDIF}
  GetFTime(Output, LI) ; Write(ConF, LI:12, ' ') ; {???}
  Close(Output) ; Close(Input) ;
  if RN and not OvrFlo then begin Erase(Input) ; Rename(Output, InFiNa) end ;
  if Bad then Write(ConF, '(discrepant?)'^G) ;
  Writeln(ConF, 'done') ;
  end {DoOne} ;

const Star : boolean = false ;


procedure Process(ST : string ; OK : boolean) ;
var SR : SearchRec ; DS : DirStr ; NS : NameStr ; ES : ExtStr ;
begin OK := (ST<>'') and OK ; Tried := true ;
  FSplit(ST, DS, NS, ES) ;
  (*** if NS='' then NS := '*' ; if ES='' then ES := '.PAS' ; ***)
  FindFirst(DS+NS+ES, Archive, SR) ;
  if not Star then
    while DosError=0 do begin DoOne(DS+SR.Name, OK) ;
    { if Star then BREAK ? }
    FindNext(SR) end
  else if DosError=0 then DoOne(DS+SR.Name, OK) ;
  end {Process} ;


var JP : word ; BV : boolean ;
Sent,
  Send
  : byte ;


BEGIN ;
Assign(ConF, 'CON') ; Rewrite(ConF) ;
Writeln('CLEAN-TP compiled by/for Pascal Version '+
  {$IFDEF VER50} 'TP5.0' {$ENDIF}
  {$IFDEF VER55} 'TP5.5' {$ENDIF}
  {$IFDEF VER60} 'TP6.0' {$ENDIF}
  {$IFDEF VER70} 'BP/TP7.0' {$ENDIF}
  {$IFDEF VER80} 'BP/TP8.0' {$ENDIF}
  + ' with'
  {$IFDEF UPZ} +' Ctrl-Z' {$ENDIF}
  {$IFDEF OBJ} +' OBJ' {$ENDIF}
  {$IFDEF ASM} +' ASM' {$ENDIF}
  ) ;

{$IFDEF ASM}
asm nop
    end { asm..end causes unavoidable T5 indent error } ;
{$ENDIF} ;

for JP := 1 to ParamCount do begin
  S := ParamStr(JP) ; BV := (Length(S)<3) or (S[3]<>'-') ;
  if S[1]<>'/' then Process(S, not (Plop or Hash))
    else if Length(S)>1 then
    case UpCase(S[2]) of
    'T'      : Tabs := BV ;
    '0'..'9' : begin Tabs := false ; One := Ord(S[2])-Ord('0') end ;
    '!'      : Plop := BV ;
    '#'      : Hash := BV ;
    '*'      : Star := BV ;
    else begin Writeln('ParaErr : ', S) ; Halt(1) end ;
    end ;
  end {JP} ;
if not Tried then DoOne('', false) ;
Writeln(Conf, 'Clean-TP end.') ; Close(ConF) ;
END.

CLEAN-TP.PAS : the rest is just copied.
For documentation see comment herein.
Dr J R Stockton, www.merlyn.demon.co.uk.