program CATLINES ;

uses Dos ;

const This = 'john^merlyn demon co uk >= 2003-06-03' ;

{ Concatenate text files in columns; uses only short file names, 8.3 format.

  A Pass consists of reading one line in turn from each file.

  Output: each pass is (for each file: Gutter, file line padded to ColWid),
  then newline; except that Binder replaces Gutter for the first file.

  Parameters are handled in order; in general, each applies to
  subsequently-named files :
   /Bnumber : Binder : spaces before the first column
   /Cnumber : ColWid : magnitude is columns width, sign gives padding type
   /Gnumber : Gutter : spaces between columns
   /Lnumber : LinFds : new Lines after each Pass
   /Mnumber : MaxCol : column width truncated to this; use 0 or 255 for none
   /Nnumber : NewLns : Newlines before each file
   /Pnumber : Passes : Stop after output pass "number"; 0 => 2^32
   /Snumber : StopIt : True if odd, default false; stop at end of this file
   /Tchar   : TagCut : mark lines which have been truncated;  /T = off
   /@name   : Script : short name of script file; use just /@ to pipe
   Otherwise a parameter is the short name of a file to supply a column.

  Initially, /B0 /C35 /G2 /L0 /M255 /N0 /S0 /T are set.

  There is no program limit on the number of files handled at once;
  but it is limited by what DOS allows (15, which can be increased;
  see UK PCW Dec 2002 p176 mid, Tim Nott, for Windows).

  Text input can be from file or device, but not from Standard Input.

  Input lines, but not output lines, are limited to 255 characters.
  Script files have one parameter per line.

  By default, shorter input files are considered as extended with blank
  lines; if StopIt is set for a file, program terminates with this file.

  If ColWid<0, padding is on the left (for numbers); else right, for text.

  Overlength input lines are not truncated, other than as given by M.

  EL refers to the ErrorLevel given, which is a parameter to DIE().

  Consider the possibilities of names CON & NUL, and numbers = 0.

  Consider   HUNT *.txt /o | CATLINES /M48 /C50 /@ > WidePrinter.txt
  and        dir  *.txt /b | CATLINES /M48 /C50 /@ > WidePrinter.txt

  ErrorLevels :
    1 : Help
    2 : Bad parameter type
    3 : Bad parameter value
    4 : Cannot open script
    5 : cannot open text file

  Note 2003-06-03 : some parameters renamed,

  Compiled with Borland Pascal 7 }



procedure DIE(const St : string ; const Errlev : byte) ;
begin Writeln(' CATLINES: ', St, '  EL=', ErrLev, '.') ;
  HALT(Errlev) end {DIE} ;


procedure HELP ;
begin
  DIE(' -  ' + This + ^M^J' Parameters:  /@Script FileName'^M^J +
    '  /Binder /ColWid /Gutter /LinFds /MaxCol /NewLns /Passes /StopIt /TagCut '^M^J +
    '  - in any order and multiplicity.'^M^J +
    '  Use only Short File Names.  See source for details.', 1) ;
  end {HELP} ;


function IntStr(const PN : integer) : string ;
var S : string [9] ;
begin Str(PN, S) ; IntStr := S end {IntStr} ;


function GetNumber(const St : string ; const PN : integer) : integer ;
var XX, N : integer ;
begin
  Val(St, XX, N) ;
  if N<>0 then DIE(' Bad parameter ' + IntStr(PN) + ' value', 3) ;
  GetNumber := XX end {GetNumber} ;


type
PList = ^List ;
List = record Txt : text ; Nxt : PList ;
  Wid, Gut, NLs, Max : integer ; Sum : boolean ; Tag : char end ;

var Root, Tail : PList ;

const
Binder : integer = 0 { Initial padding for left margin } ;
LinFds : integer = 1 { Initial line feeds between passes } ;
Passes : longint = 0 { Initial max-passes setting } ;


procedure ProcessParam(Para : string ; const PN : integer) ; forward ;


procedure DoScript(const Name : string) ;
var Scr : text ; LN : integer ; Line : string ;
begin LN := 0 ;
  Assign(Scr, Name) ; {$I-} Reset(Scr) {$I+} ;
  if IOResult<>0 then DIE('Cannot open script ' + Name, 4) ;
  while not EoF(Scr) do begin Dec(LN) ;
    Readln(Scr, Line) ;
    ProcessParam(Line, LN) ;
    end ;
  Close(Scr) ;
  end {DoScript} ;


procedure ProcessParam(Para : string ; const PN : integer) ;
const
ColWid : integer = 35 { Initial padding for Columns } ;
Gutter : integer = 2 { Initial spaces between Columns } ;
MaxCol : byte = 255 { Initial column truncation ineffective } ;
NewLns : integer = 0 { Initial newlines between files } ;
StopIt : boolean = false { This file end terminates output } ;
TagCut : char = #0 { Initial do not mark truncation } ;
No : byte = 0 { File count } ;
var Temp : PList ; Ch : char ;
begin

  if Para='' then EXIT ;

  case Para[1]='/' of

    true : begin Ch := UpCase(Para[2]) ;
      Delete(Para, 1, 2) ;
      case Ch of
        'B' : Binder := GetNumber(Para, PN) ;
        'C' : ColWid := GetNumber(Para, PN) ;
        'G' : Gutter := GetNumber(Para, PN) ;
        'L' : LinFds := GetNumber(Para, PN) ;
        'M' : begin MaxCol := GetNumber(Para, PN) ;
          if MaxCol=0 then MaxCol := 255 end ;
        'N' : NewLns := GetNumber(Para, PN) ;
        'P' : Passes := GetNumber(Para, PN) ;
        'S' : StopIt := Odd(GetNumber(Para, PN)) ;
        'T' : if Para='' then TagCut := #0 else TagCut := Para[1] ;
        '@' : DoScript(Para) ;
        else DIE(' Bad parameter ' + IntStr(PN) + ' letter ' + Ch, 2) ;
        end {Ch} ;
      end {true} ;

    false : begin Inc(No) ; Temp := New(PList) ;
      if Root=NIL then Root := Temp else Tail^.Nxt := Temp ;
      Tail := Temp ;
      with Tail^ do begin Nxt := NIL ;
        Assign(Txt, Para) ; {$I-} Reset(Txt) {$I+} ;
          if IOResult<>0 then
            DIE('Cannot open file #'+IntStr(No)+', '''+Para+'''', 5) ;
        Wid := ColWid ; Gut := Gutter ; NLs := NewLns ; Max := MaxCol ;
        Sum := StopIt ; Tag := TagCut end ;
      end {false} ;

    end {case} ;

  end {ProcessParam} ;


procedure ProcessCommandLine ;
var PN : integer ;
begin
  Root := NIL ; Tail := NIL ;
  for PN := 1 to ParamCount do ProcessParam(ParamStr(PN), PN) ;
  end {ProcessCommandLine} ;


procedure ProcessFiles ;
var Temp : PList ; St : string ; J : integer ; Chop, Done : boolean ;
begin

  Root^.Gut := Binder ;

  repeat

    Temp := Root ; Done := true ;
    while Temp<>NIL do with Temp^ do begin
      if not EoF(Txt) then Done := false
        else if Sum then EXIT { this file at EoF } ;
      Temp := Nxt end ;
    if Done then EXIT { ALL files at EoF } ;

    Temp := Root ;
    while Temp<>NIL do with Temp^ do begin
      if EoF(Txt) then St := '' else Readln(Txt, St) ;
      Chop := Length(St)>Max ;
      if Chop then byte(St[0]) := Max ;
      for J:= 1 to NLs do Writeln ;
      Write('':Gut, St:-Wid, '':Wid-Length(St)) ;
      if Tag>#0 then if Chop then Write(Tag) else Write(#32) ;
      Temp := Nxt end ;

    for J := 1 to LinFds do Writeln ;
    Dec(Passes) until Passes=0 ;

  end {ProcessFiles} ;


procedure Closedown ;
var Temp : PList ;
begin
  while Root<>NIL do with Root^ do begin
    Close(Txt) ; Temp := Root ; Root := Nxt ; Dispose(Temp) end ;
  end {Closedown} ;



BEGIN ;
if (ParamCount=0) or (ParamStr(1)='/?') then HELP ;
FileMode := 0 ;
ProcessCommandLine ;
{$IFDEF DEBUG} Writeln('Commands processed') ; {$ENDIF}
ProcessFiles ;
{$IFDEF DEBUG} Writeln('Files processed') ; {$ENDIF}
Closedown ;
{$IFDEF DEBUG} Writeln('Finished') ; {$ENDIF}
END.