program plist(input, output);
(*Turbo Pascal programs lister with time and date stamp.
  Written by: Rick Schaeffer
              E. 13611 26th Av.
              Spokane, Wa.  99216

  modifications (7/8/84  by Len Whitten, CIS: [73545,1006])
    1) added error handling if file not found
    2) added default extension of .PAS to main & include files
    3) added "WhenCreated" procedure to extract file
       creation date & time from TURBO FIB
    4) added demarcation of where include file ends
    5) added upper char. conversion to include file
    6) increased left margin to 5 spaces (80 char. line just fits @ 10cpi)
    7) added listing control: {.L-} turns it off, {.L+} turns it back on,
       must be in column 1

  further modifications (7/12/84 by Rick Schaeffer)
    1) cleaned up the command line parsing routines and put them in
       separate procedures.  Now permits any number of command line
       arguments, each argument separated with at least one space.
    2) added support for an optional second command line parameter
       which specifies whether include files will be listed or not.
       The command is invoked by placing "/i" on the command line
       at least one space after the file name to be listed.  For
       instance, to list MYPROG.PAS as well as any "included" files,
       the command line would be: PLIST MYPROG /I

  modifications by Steve Fox 10/16/84
    1) generic time and date routine
    2) will now work on CP/M-80 too
*)
type
  fnmtype = string[14];
  instring = string[132];
  tad_array = array[0..2] of integer;
  StdStr = string[255];
const
  max_line = 59;
var
  print, expand_includes : boolean;
  holdarg                : instring;
  mainflnm               : fnmtype;
  linecnt, pageno        : integer;
  sysdate, systime,
  credate, cretime       : StdStr;
  t                      : tad_array;

{$I TADPC.INC }
{$I TADFORM.INC }

function parse_cmd(argno: integer): instring;
var
  i,j : integer;
  wkstr : instring;
  done : boolean;
  cmdline : ^instring;
begin
  cmdline := ptr(CSEG,$0080);  { CSEG required for PC version }
  wkstr := '';
  done := FALSE;
  i := 1;
  j := 0;
  if length(cmdline^) < i
    then done := TRUE;
  repeat
    while ((cmdline^[i] = ' ') and (not done)) do
      begin
        i := i + 1;
        if length(cmdline^) < i
          then done := TRUE;
      end;
    if not done
      then j := j + 1;
    while ((cmdline^[i] <> ' ') and (not done)) do
      begin
        wkstr := wkstr + cmdline^[i];
        i := i + 1;
        if length(cmdline^) < i
          then done := TRUE;
      end;
    if (j <> argno)
      then wkstr := '';
  until (done or (j = argno));
  for i := 1 to length(wkstr) do
    wkstr[i] := upcase(wkstr[i]); {all arguments forced to upper case}
  parse_cmd := wkstr;
end;

function chkinc(var iptline: instring; var incflname: fnmtype): boolean;
var
   done : boolean;
   i, j: integer;
begin { chkinc }
   i := 4;
   j := 1;
   incflname := '';
   if copy(iptline, 1, 3) = '{$I'
     then
       begin
         i := 4;
         j := 1;
         incflname := '';
         while (iptline[i] = ' ') and (i <= length(iptline))
           do i := i + 1;
         done := FALSE;
         while not done do
           begin
             if i <= length(iptline)
               then
                 begin
                   if not (iptline[i] in [' ','}','+','-'])
                     then
                       begin
                         incflname[j] := iptline[i];
                         i := i + 1;
                         j := j + 1;
                       end
                     else done := TRUE;
                 end
               else done := TRUE;
               if j > 14
                 then done := TRUE;
       end;
       incflname[0] := chr(j - 1);
   end;
   if incflname <> ''
     then chkinc := TRUE
     else chkinc := FALSE;
end;  {chkinc}

procedure print_heading(filename : fnmtype);
begin { print_heading }
  write(lst, ^L, '   TURBO Pascal Program Lister');
  writeln(lst, '      Printed: ', sysdate,'  ', systime, '   Page ', pageno:4);
  if filename = mainflnm
    then write(lst, '   Main File: ', filename, '   ')
    else write(lst, '   Include File: ', filename);
{ Next line for PC version only}
  writeln(lst, ' ':(19 - length(filename)),'Created: ',credate,'  ',cretime);

  writeln(lst);
  writeln(lst);
  linecnt := 5;
  pageno := pageno + 1
end;

procedure printline(iptline : instring; filename : fnmtype);
begin { printline }
  if linecnt > max_line
    then print_heading(filename);
  writeln(lst, '   ', iptline);
  linecnt := linecnt + 1
end;

procedure listit(filename : fnmtype);
var
  i: integer;
  infile    : text;
  iptline   : instring;
  incflname : fnmtype;
begin { listit }
  {($A-)} { This line not used for PC version }
  assign(infile, filename);
  {$I-} reset(infile) {$I+};
  if IOresult <> 0
    then writeln ('File ', filename, ' not found.')
    else
      begin
{ These 4 lines for PC version only}
        Get_Cre_Date(t, infile);
        credate := formdate(t);
        Get_Cre_Time(t, infile);
        cretime := formtime(t);

        while not eof(infile) do
          begin
            readln(infile, iptline);
            if copy(iptline, 1, 4) = '{.L-'
              then print := FALSE;
            if print
              then
                begin
                  if (chkinc(iptline, incflname) and (expand_includes))
                    then
                      begin
                        for i := 1 to length(incflname) do
                          incflname[i] := upcase(incflname[i]);
                        if pos('.', incflname) = 0
                          then incflname := incflname + '.PAS';
                        printline('*****************************',filename);
                        printline('    Including "'+incflname+'"',filename);
                        printline('*****************************',filename);
                        listit(incflname);
                        printline('*****************************',filename);
                        printline('    End of    "'+incflname+'"',filename);
                        printline('*****************************',filename)
                      end  {include file check}
                    else
                      begin
                        if copy(iptline, 1, 4) = '{.PA'
                          then print_heading(filename)
                          else printline(iptline, filename)
                      end  {line printing}
                end;  {listing control}
            if copy(iptline, 1, 4) = '{.L+'
              then print := TRUE
          end;  {file reading}
        close(infile)
      end
end;  {listit}

begin {main program}
  print := TRUE;
  Get_Sys_Date(t);
  sysdate := formdate(t);
  Get_Sys_Time(t);
  systime := formtime(t);
  writeln;
  writeln('TURBO Pascal Formatted Listing');
  holdarg := parse_cmd(1);             {get command line argument # 1}
  if length(holdarg) <= 14
    then mainflnm := holdarg;
  holdarg := parse_cmd(2);             {get optional command line argument # 2}
  if holdarg = '/I'
    then expand_includes := TRUE
    else expand_includes := FALSE;
  if mainflnm = ''
    then
      begin
        write('Enter file name: ');
        readln(mainflnm)
      end;
  if pos('.', mainflnm) = 0
    then mainflnm := mainflnm + '.PAS';
  pageno := 1;
  linecnt := max_line + 1;             {force heading on first page}
  listit(mainflnm)
end.