home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / USCX / TURBO-04.ZIP / PLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1985-03-09  |  8KB  |  240 lines
  1. program plist(input, output);
  2. (*Turbo Pascal programs lister with time and date stamp.
  3.   Written by: Rick Schaeffer
  4.               E. 13611 26th Av.
  5.               Spokane, Wa.  99216
  6.  
  7.   modifications (7/8/84  by Len Whitten, CIS: [73545,1006])
  8.     1) added error handling if file not found
  9.     2) added default extension of .PAS to main & include files
  10.     3) added "WhenCreated" procedure to extract file
  11.        creation date & time from TURBO FIB
  12.     4) added demarcation of where include file ends
  13.     5) added upper char. conversion to include file
  14.     6) increased left margin to 5 spaces (80 char. line just fits @ 10cpi)
  15.     7) added listing control: {.L-} turns it off, {.L+} turns it back on,
  16.        must be in column 1
  17.  
  18.   further modifications (7/12/84 by Rick Schaeffer)
  19.     1) cleaned up the command line parsing routines and put them in
  20.        separate procedures.  Now permits any number of command line
  21.        arguments, each argument separated with at least one space.
  22.     2) added support for an optional second command line parameter
  23.        which specifies whether include files will be listed or not.
  24.        The command is invoked by placing "/i" on the command line
  25.        at least one space after the file name to be listed.  For
  26.        instance, to list MYPROG.PAS as well as any "included" files,
  27.        the command line would be: PLIST MYPROG /I
  28.  
  29.   modifications by Steve Fox 10/16/84
  30.     1) generic time and date routine
  31.     2) will now work on CP/M-80 too
  32. *)
  33. type
  34.   fnmtype = string[14];
  35.   instring = string[132];
  36.   tad_array = array[0..2] of integer;
  37.   StdStr = string[255];
  38. const
  39.   max_line = 59;
  40. var
  41.   print, expand_includes : boolean;
  42.   holdarg                : instring;
  43.   mainflnm               : fnmtype;
  44.   linecnt, pageno        : integer;
  45.   sysdate, systime,
  46.   credate, cretime       : StdStr;
  47.   t                      : tad_array;
  48.  
  49. {$I TADPC.INC }
  50. {$I TADFORM.INC }
  51.  
  52. function parse_cmd(argno: integer): instring;
  53. var
  54.   i,j : integer;
  55.   wkstr : instring;
  56.   done : boolean;
  57.   cmdline : ^instring;
  58. begin
  59.   cmdline := ptr(CSEG,$0080);  { CSEG required for PC version }
  60.   wkstr := '';
  61.   done := FALSE;
  62.   i := 1;
  63.   j := 0;
  64.   if length(cmdline^) < i
  65.     then done := TRUE;
  66.   repeat
  67.     while ((cmdline^[i] = ' ') and (not done)) do
  68.       begin
  69.         i := i + 1;
  70.         if length(cmdline^) < i
  71.           then done := TRUE;
  72.       end;
  73.     if not done
  74.       then j := j + 1;
  75.     while ((cmdline^[i] <> ' ') and (not done)) do
  76.       begin
  77.         wkstr := wkstr + cmdline^[i];
  78.         i := i + 1;
  79.         if length(cmdline^) < i
  80.           then done := TRUE;
  81.       end;
  82.     if (j <> argno)
  83.       then wkstr := '';
  84.   until (done or (j = argno));
  85.   for i := 1 to length(wkstr) do
  86.     wkstr[i] := upcase(wkstr[i]); {all arguments forced to upper case}
  87.   parse_cmd := wkstr;
  88. end;
  89.  
  90. function chkinc(var iptline: instring; var incflname: fnmtype): boolean;
  91. var
  92.    done : boolean;
  93.    i, j: integer;
  94. begin { chkinc }
  95.    i := 4;
  96.    j := 1;
  97.    incflname := '';
  98.    if copy(iptline, 1, 3) = '{$I'
  99.      then
  100.        begin
  101.          i := 4;
  102.          j := 1;
  103.          incflname := '';
  104.          while (iptline[i] = ' ') and (i <= length(iptline))
  105.            do i := i + 1;
  106.          done := FALSE;
  107.          while not done do
  108.            begin
  109.              if i <= length(iptline)
  110.                then
  111.                  begin
  112.                    if not (iptline[i] in [' ','}','+','-'])
  113.                      then
  114.                        begin
  115.                          incflname[j] := iptline[i];
  116.                          i := i + 1;
  117.                          j := j + 1;
  118.                        end
  119.                      else done := TRUE;
  120.                  end
  121.                else done := TRUE;
  122.                if j > 14
  123.                  then done := TRUE;
  124.        end;
  125.        incflname[0] := chr(j - 1);
  126.    end;
  127.    if incflname <> ''
  128.      then chkinc := TRUE
  129.      else chkinc := FALSE;
  130. end;  {chkinc}
  131.  
  132. procedure print_heading(filename : fnmtype);
  133. begin { print_heading }
  134.   write(lst, ^L, '   TURBO Pascal Program Lister');
  135.   writeln(lst, '      Printed: ', sysdate,'  ', systime, '   Page ', pageno:4);
  136.   if filename = mainflnm
  137.     then write(lst, '   Main File: ', filename, '   ')
  138.     else write(lst, '   Include File: ', filename);
  139. { Next line for PC version only}
  140.   writeln(lst, ' ':(19 - length(filename)),'Created: ',credate,'  ',cretime);
  141.  
  142.   writeln(lst);
  143.   writeln(lst);
  144.   linecnt := 5;
  145.   pageno := pageno + 1
  146. end;
  147.  
  148. procedure printline(iptline : instring; filename : fnmtype);
  149. begin { printline }
  150.   if linecnt > max_line
  151.     then print_heading(filename);
  152.   writeln(lst, '   ', iptline);
  153.   linecnt := linecnt + 1
  154. end;
  155.  
  156. procedure listit(filename : fnmtype);
  157. var
  158.   i: integer;
  159.   infile    : text;
  160.   iptline   : instring;
  161.   incflname : fnmtype;
  162. begin { listit }
  163.   {($A-)} { This line not used for PC version }
  164.   assign(infile, filename);
  165.   {$I-} reset(infile) {$I+};
  166.   if IOresult <> 0
  167.     then writeln ('File ', filename, ' not found.')
  168.     else
  169.       begin
  170. { These 4 lines for PC version only}
  171.         Get_Cre_Date(t, infile);
  172.         credate := formdate(t);
  173.         Get_Cre_Time(t, infile);
  174.         cretime := formtime(t);
  175.  
  176.         while not eof(infile) do
  177.           begin
  178.             readln(infile, iptline);
  179.             if copy(iptline, 1, 4) = '{.L-'
  180.               then print := FALSE;
  181.             if print
  182.               then
  183.                 begin
  184.                   if (chkinc(iptline, incflname) and (expand_includes))
  185.                     then
  186.                       begin
  187.                         for i := 1 to length(incflname) do
  188.                           incflname[i] := upcase(incflname[i]);
  189.                         if pos('.', incflname) = 0
  190.                           then incflname := incflname + '.PAS';
  191.                         printline('*****************************',filename);
  192.                         printline('    Including "'+incflname+'"',filename);
  193.                         printline('*****************************',filename);
  194.                         listit(incflname);
  195.                         printline('*****************************',filename);
  196.                         printline('    End of    "'+incflname+'"',filename);
  197.                         printline('*****************************',filename)
  198.                       end  {include file check}
  199.                     else
  200.                       begin
  201.                         if copy(iptline, 1, 4) = '{.PA'
  202.                           then print_heading(filename)
  203.                           else printline(iptline, filename)
  204.                       end  {line printing}
  205.                 end;  {listing control}
  206.             if copy(iptline, 1, 4) = '{.L+'
  207.               then print := TRUE
  208.           end;  {file reading}
  209.         close(infile)
  210.       end
  211. end;  {listit}
  212.  
  213. begin {main program}
  214.   print := TRUE;
  215.   Get_Sys_Date(t);
  216.   sysdate := formdate(t);
  217.   Get_Sys_Time(t);
  218.   systime := formtime(t);
  219.   writeln;
  220.   writeln('TURBO Pascal Formatted Listing');
  221.   holdarg := parse_cmd(1);             {get command line argument # 1}
  222.   if length(holdarg) <= 14
  223.     then mainflnm := holdarg;
  224.   holdarg := parse_cmd(2);             {get optional command line argument # 2}
  225.   if holdarg = '/I'
  226.     then expand_includes := TRUE
  227.     else expand_includes := FALSE;
  228.   if mainflnm = ''
  229.     then
  230.       begin
  231.         write('Enter file name: ');
  232.         readln(mainflnm)
  233.       end;
  234.   if pos('.', mainflnm) = 0
  235.     then mainflnm := mainflnm + '.PAS';
  236.   pageno := 1;
  237.   linecnt := max_line + 1;             {force heading on first page}
  238.   listit(mainflnm)
  239. end.
  240.