home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TURBO.ZIP / PRETTY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-09-16  |  9.0 KB  |  286 lines
  1.  
  2. program plist(input, output);
  3. (* Pretty print with date/time stamp for Turbo Pascal programs.
  4.   Written by: Rick Schaeffer
  5.               E. 13611 26th Av.
  6.               Spokane, Wa.  99216
  7.  
  8.   modifications (7/8/84  by Len Whitten, CIS: [73545,1006])
  9.      1) added error handling if file not found
  10.      2) added default extension of .PAS to main & include files
  11.      3) added "WhenCreated" procedure to extract file
  12.         creation date & time from TURBO FIB
  13.      4) added demarcation of where include file ends
  14.      5) added upper char. conversion to include file
  15.      6) increased left margin to 5 spaces (80 char. line just fits @ 10cpi)
  16.      7) added listing control: {.L-} turns it off, {.L+} turns it back on,
  17.         must be in column 1
  18.      
  19.   further modifications (7/12/84 by Rick Schaeffer)
  20.      1) cleaned up the command line parsing routines and put them in
  21.         separate procedures.  Now permits any number of command line
  22.         arguments, each argument separated with at least one space.
  23.      2) added support for an optional second command line parameter
  24.         which specifies whether include files will be listed or not.
  25.         The command is invoked by placing "/i" on the command line
  26.         at least one space after the file name to be listed.  For
  27.         instance, to list MYPROG.PAS as well as any "included" files,
  28.         the command line would be: PLIST MYPROG /I
  29. *)
  30.  
  31. type
  32.    fnmtype = string[14];
  33.    instring = string[132];
  34.    dtstr = string[8];
  35.    two_letters = string[2];
  36.    regpack = record
  37.       ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  38.    end;
  39.  
  40. const monthmask = $000F;
  41.       daymask = $001F;
  42.       minutemask = $003F;
  43.       secondmask = $001F;
  44.  
  45. var
  46.    expand_includes     : boolean;
  47.    holdarg             : instring;
  48.    mainflnm            : fnmtype;
  49.    linecnt, pageno,
  50.    offset,i,j          : integer;
  51.    done                : boolean;
  52.    sysdate, systime,
  53.    filedate, filetime  : dtstr;
  54.    month,day,year,
  55.    hour,minute,second  : two_letters;
  56.    allregs             : regpack;
  57.  
  58. procedure fill_blanks (var line: dtstr);
  59.  
  60. begin
  61.   for i:= 1 to 8 do if line[i] = ' ' then line[i]:= '0';
  62. end;  {fill_blanks}
  63.  
  64. procedure getdate(var date : dtstr);
  65.  
  66. begin
  67.    allregs.ax := $2A * 256;
  68.    MsDos(allregs);
  69.    str((allregs.dx div 256):2,month);
  70.    str((allregs.dx mod 256):2,day);
  71.    str((allregs.cx - 1900):2,year);
  72.    date := month + '/' + day + '/' + year;
  73.    fill_blanks (date);
  74. end;  {getdate}
  75.  
  76. procedure gettime(var time : dtstr);
  77.  
  78. begin
  79.    allregs.ax := $2C * 256;
  80.    MsDos(allregs);
  81.    str((allregs.cx div 256):2,hour);
  82.    str((allregs.cx mod 256):2,minute);
  83.    str((allregs.dx div 256):2,second);
  84.    time := hour + ':' + minute + ':' + second;
  85.    fill_blanks (time);
  86. end;  {gettime}
  87.  
  88. procedure WhenCreated (var date, time: dtstr; var infile: text);
  89.  
  90. var fulltime,fulldate: integer;
  91.  
  92. begin
  93.  
  94. {fulldate gets the area of the FIB which corresponds to bytes 20-21
  95.  of the FCB. Format is: bits 0 - 4: day of month
  96.                              5 - 8: month of year
  97.                              9 -15: year - 1980                     }
  98.  
  99.     fulldate:= memw [seg(infile):ofs(infile)+31];
  100.     str(((fulldate shr 9) + 80):2,year);
  101.     str(((fulldate shr 5) and monthmask):2,month);
  102.     str((fulldate and daymask):2,day);
  103.     date:= month + '/' + day + '/' + year;
  104.     fill_blanks(date);
  105.  
  106. {fulltime gets the area of the FIB which corresponds to bytes 22-23
  107.  of the FCB. Format is: bits 0 - 4: seconds/2
  108.                              5 -10: minutes
  109.                              11-15: hours                          }
  110.  
  111.     fulltime:= memw [seg(infile):ofs(infile)+33];
  112.     str((fulltime shr 11):2,hour);
  113.     str(((fulltime shr 5) and minutemask):2,minute);
  114.     str(((fulltime and secondmask) * 2):2,second);
  115.     time:= hour + ':' + minute + ':' + second;
  116.     fill_blanks (time);
  117. end;  {WhenCreated}
  118.  
  119. function chkinc(var iptline : instring; var incflname : fnmtype) : boolean;
  120. var
  121.    done : boolean;
  122. begin
  123.    i := 4; j := 1; incflname := '';
  124.    if copy(iptline, 1, 3) = '{$I' then begin
  125.       i := 4; j := 1; incflname := '';
  126.       while (iptline[i] = ' ') and (i <= length(iptline)) do i := i + 1;
  127.       done := false;
  128.       while not done do begin
  129.          if i <= length(iptline) then begin
  130.             if not (iptline[i] in [' ','}','+','-']) then begin
  131.                incflname[j] := iptline[i];
  132.                i := i + 1; j := j + 1;
  133.             end else done := true;
  134.          end else done := true;
  135.          if j > 14 then done := true;
  136.       end;
  137.       incflname[0] := chr(j - 1);
  138.    end;
  139.    if incflname <> '' then chkinc := true else chkinc := false;
  140. end;  {chkinc}
  141.  
  142. procedure print_heading(filename : fnmtype);
  143.  
  144. var offset_inc: integer;
  145.  
  146. begin
  147.    if linecnt <> 66 then write(lst,^L);
  148.    pageno := pageno + 1;
  149.    write(lst,'     TURBO Pascal Program Lister');
  150.    writeln(lst,' ':8,'Printed: ',sysdate,'  ',systime,'   Page ',pageno:4);
  151.    if filename <> mainflnm then begin
  152.       offset_inc:= 14 - length (filename);
  153.       write(lst,'     Include File: ',filename,' ':offset_inc,
  154.          'Created: ',filedate,'  ',filetime);
  155.    end
  156.    else write(lst,'     Main File: ',mainflnm,' ':offset,
  157.          'Created: ',filedate,'  ',filetime);
  158.    writeln(lst);
  159.    writeln(lst); writeln(lst);
  160.    linecnt := 1;
  161. end;  {print_heading}
  162.  
  163. procedure printline(iptline : instring; filename : fnmtype);
  164. begin
  165.    if linecnt < 56 then begin
  166.       writeln(lst,'     ',iptline);
  167.       linecnt := linecnt + 1;
  168.    end else begin
  169.       print_heading(filename);
  170.       writeln(lst,'     ',iptline);
  171.    end;
  172. end;  {printline}
  173.  
  174. procedure listit(filename : fnmtype);
  175.  
  176. var
  177.    infile    : text;
  178.    iptline   : instring;
  179.    incflname : fnmtype;
  180.    print     : boolean;
  181.  
  182. begin
  183.    print:= true;
  184.    assign(infile, filename);
  185.    {$I-} reset(infile) {$I+} ;
  186.    if IOresult <> 0 then begin
  187.       writeln ('File ',filename,' not found.');
  188.       halt;
  189.    end;
  190.    WhenCreated (filedate,filetime,infile);
  191.    while not eof(infile) do begin
  192.       readln(infile, iptline);
  193.       if copy(iptline, 1, 4) = '{.L-' then print:= false;
  194.       if print then begin
  195.          if (chkinc(iptline, incflname) and (expand_includes)) then begin
  196.             for i := 1 to length(incflname) do
  197.               incflname[i] := upcase(incflname[i]);
  198.             if pos('.',incflname) = 0 then incflname := incflname + '.PAS';
  199.             printline('*************************************',filename);
  200.             printline('    Including "'+incflname+'"', filename);
  201.             printline('*************************************',filename);
  202.             listit(incflname);
  203.             printline('*************************************',filename);
  204.             printline('    End of    "'+incflname+'"', filename);
  205.             printline('*************************************',filename);
  206.          end  {include file check}
  207.          else begin
  208.             if copy(iptline, 1, 4) = '{.PA' then print_heading(filename)
  209.             else printline(iptline, filename);
  210.          end  {line printing}
  211.       end  {listing control}
  212.       else if copy(iptline, 1, 4) = '{.L+' then print:= true;
  213.    end;  {file reading}
  214.    close(infile);
  215. end;  {listit}
  216.  
  217. function parse_cmd(argno : integer) : instring;
  218. var
  219.    i,j : integer;
  220.    wkstr : instring;
  221.    done : boolean;
  222.    cmdline : ^instring;
  223. begin
  224.    cmdline := ptr(CSEG,$0080);
  225.    wkstr := '';
  226.    done := false; i := 1; j := 0;
  227.    if length(cmdline^) < i then done := true;
  228.    repeat
  229.       while ((cmdline^[i] = ' ') and (not done)) do begin
  230.          i := i + 1;
  231.          if i > length(cmdline^) then done := true;
  232.       end;
  233.       if not done then j := j + 1;
  234.       while ((cmdline^[i] <> ' ') and (not done)) do begin
  235.          wkstr := wkstr + cmdline^[i];
  236.          i := i + 1;
  237.          if i > length(cmdline^) then done := true;
  238.       end;
  239.       if (j <> argno) then wkstr := '';
  240.    until (done or (j = argno));
  241.    for i := 1 to length(wkstr) do
  242.       wkstr[i] := upcase(wkstr[i]); {all arguments forced to upper case}
  243.    parse_cmd := wkstr;
  244. end;
  245.  
  246. begin {main program}
  247.    getdate(sysdate);
  248.    gettime(systime);
  249.    linecnt := 66; pageno := 0;
  250.    writeln;
  251.    writeln('TURBO Pascal Formatted Listing');
  252.    holdarg := parse_cmd(1); {get command line argument # 1}
  253.    if length(holdarg) <= 14 then mainflnm := holdarg;
  254.    holdarg := parse_cmd(2); {get optional command line argument # 2}
  255.    if holdarg = '/I' then expand_includes := true
  256.       else expand_includes := false;
  257.    if mainflnm = '' then begin
  258.       write('Enter file name: ');
  259.       readln(mainflnm);
  260.    end;
  261.    if pos('.',mainflnm) = 0 then mainflnm := mainflnm + '.PAS';
  262.    offset:= 24 - length (mainflnm);
  263.    listit(mainflnm);
  264.    write(lst,^L);
  265. end.
  266. G>vlZE2qp
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274. S+
  275.  
  276. Press ENTER to continue: G>vlZE2qp
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284. S+
  285.  
  286. Press ENTER to continue: