Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPUHEAD.ZIP/TPUHEAD.PAS

Pascal/Delphi Source File | 1988-06-04 | 8.5 KB | 273 lines

{ =============================================================================

                               TPUHEAD

  A program to copy the HEADER (everything from the top through the
  IMPLEMENTATION) of a TP4 Unit into a separate file for reference
  purposes.

  TPUHead accepts standard wildcards (*,?) when specifying the files
  to process as well as drive & path.

                  e.g.,  TPUHEAD d:\tpufiles\*.pas

  Each file meeting the user criteria is evaluated.  It is determined
  to be a valid TP4 unit if the keywords UNIT, INTERFACE, & IMPLEMENTATION
  are found, in order, and within the first 10 charcters on a line.  This
  was necessary since I often put in comments which would otherwise cause
  TPUHEAD to think the file was a unit when in fact it was not.

  Further, only files which have not been processed, or those which need
  to have updates are processed.  The trigger is date matching between the
  TPUHEAD output file  ".TOP" & the source.  When a .TOP file is created,
  it is date stamped exactly as the source.  Thus, if a source file is
  later updated (getting a new update date), TPUHEAD can identify it as
  needing updating.  Otherwise, it is skipped.

  By the way, the .TOP file is given the same filename as the source.  The
  file extent becomes ".TOP".

  As files are processed, the output filename is shown on the screen.  You
  may find this strange  ( e.g.,  "type SOURCE.TOP >> %1").  Actually, it
  is done to minimize steps necessary to later concat all output files
  into a single file.  Why?  I use WordPerfect.  Once I have the single
  file created, I go into WP, search for "== END" and start a new page.
  Then I build a Table of Contents & an Index (using my own concordance
  generator ... look for it soon).  When finished, I have a notebook with
  all unit interface sections.  No more looking for files & trying to read
  them online, or digging for the full print out to find what functions &
  procedures are there and how to call them.

  If you notice in the example given in the preceding paragraph, it shows
  the output including the redirection symbol ">>".  For this to make sense,
  the first output should also be redirected to a batch file;

                   e.g., TPUHEAD *.pas > headers.bat

  Then each of the "type .... >> %1" lines of output are directed into the
  specified batch file.  When the batch file is run;

                   e.g., headers Headers.All

  The individual ".TOP" files are concatenated into HEADERS.ALL which can
  then be used in your word processor.  (Of course, all the separate .TOP
  files are still there.  Be sure to keep them if you want TPUHEAD to be
  able to determine which files do/do not need updating.

  These techniques were possible by using TP4's FINDFIRST/FINDNEXT procs
  along with the redefinition of the "standard" output.

============================================================================= }

{$R-,S-,I-,D-,T-,F-,V-,B-,N-,L- }
{$M 16384,0,655360 }

program TPUHEAD;

uses DOS,CRT,qwik;

var
  OneLine,
  CmdLine,
  PathName,
  FileSource,
  FileOut     : string;
  FvarS,
  FvarO       : text;
  DosErr      : byte;
  InBuffer    : array[1..512] of char;
  SourceTime,
  OutputTime  : longint;
  FileRec     : SearchRec;

(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)

function UpperCase(St : string):string;
var
  i : integer;
begin
  if length(St) > 1 then
  begin
    for i := 1 to length(St) do St[i] := upcase(St[i]);
  end;
  UpperCase := St;
end; { function }

(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)

function GetCmdLine:boolean;
begin
  if paramcount > 0 then
  begin
    CmdLine := uppercase(paramstr(1));
    GetCmdLine := true;
  end    { if paramcount > 0 }
  else GetCmdLine := false;
end; { proc }

(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)

procedure SetFileNames;
var i : byte;
begin
  i := pos('.',FileSource);
  if i < 1 then
  begin
    FileOut := FileSource + '.TOP';
  end
  else FileOut := copy(FileSource,1,i) + 'TOP';
end; { proc }

(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)

procedure ProcessSource;
var
  i,
  Counter : byte;
  Skip    : boolean;
begin
  { set up source & get its date/time }
  Assign(FvarS,FileSource);
  Reset (FvarS);
  SetTextBuf(FvarS,InBuffer);
  SourceTime := FileRec.Time;

  { verify source is a unit by looking for UNIT, INTERFACE, &   }
  { IMPLEMENTATION.  Keywords are expected to appear w/in the   }
  { first 10 characters of a line & must appear in order.       }
  OneLine := '';
  Counter := 0;
  while (Counter < 3) and (not EoF(FvarS)) do
  begin
    readln(FvarS,OneLine);
    case Counter of
      0 : begin
            i := pos('UNIT',uppercase(OneLine));
            if (i > 0) AND (i < 10)                { found UNIT }
            then Counter := 1;
          end;
      1 : begin
            i := pos('INTERFACE',uppercase(OneLine));
            if (i > 0) and (i < 10)
            then Counter := 2;
          end;
      2 : begin
            i := pos('IMPLEMENTATION',uppercase(OneLine));
            if (i > 0) and (i < 10)
            then Counter := 3;
          end;
    end; { case }
  end; { while do }
  Close(FvarS);

  if Counter < 3 then
  begin
    { not a unit }
    Exit;
  end;

  Assign(FvarO,FileOut);
  {$I-}
  Reset(FvarO);
  Close(FvarO);
  {$I+}
  if (IOresult = 0) then
  begin
    { If output date/time >= source date/time, then no need to    }
    { recreate (output date/time is set = to source when created. }
    GetFTime(FvarO,OutputTime);
    if OutputTime >= SourceTime then Skip := true;
  end
  else Skip := false;

  if not Skip then
  begin
    writeln(Output,'type ',FileOut,' >> %1');
    OneLine := '';
    Reset(FvarS);                 { reset source for processing }
    Assign(FvarO,FileOut);
    ReWrite(FvarO);                    { set output for writing }

    writeln(FvarO,'{=====  START of ',FileSource,'  =====}');
    while (not Eof(FvarS))
    and   (pos('IMPLEMENTATION',UpperCase(OneLine)) < 1) do
    begin
      writeln(FvarO,OneLine);
      readln(FvarS,OneLine);
    end; { while .. do }
    writeln(FvarO,'{=====   END  of ',FileSource,'  =====}');

    Close(FvarS);
    Close(FvarO);
    Reset(FvarO);                     { adjust output date/time }
    SetFTime(FvarO,SourceTime);       { to equal source         }
    Close(FvarO);
  end; {if not skip}
end; { proc }

(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)

begin
  clrscr;
  CmdLine := '';

  { allow redirection of screen output to user file via DOS }
  { redirection; e.g.,  TPUINTFC *.pas > tpu.log            }
  assign(Output,'');
  rewrite(Output);

  { Read command line for file to process  }
  { Output file will be filename.INT       }
  if not GetCmdLine then
  begin
    writeln('       TPUHEAD - the TPU documentation creator');
    writeln;
    writeln('syntax:');
    writeln('         TPUHEAD d:\path\filename.ext [> output.bat]');
    writeln;
    writeln('Each source file will be processed into a ".TOP" file.');
    writeln('Only TP4 UNIT files will be processed. Only files which');
    writeln('need processing will be included.  No need for you to');
    writeln('try to weed out programs from units or ones previously');
    writeln('done from those needing to be done.');
    writeln;
    writeln('Screen output may be redirected to a batch file for later');
    writeln('use in concatenating all headers into a single file for');
    writeln('yet more processing.');
    writeln;
    writeln('Released for NON-PROFIT use only!');
    writeln('(c) 1988 by Robert W. Reed  [phone]');
    writeln;
    halt(1);
  end;

  { Get first file to process              }
  PathName := CmdLine;
  {$I-}
  FindFirst(PathName,$20,FileRec);
  {$I+}
  DosErr := DOSError;
  if DosErr > 0 then
  begin
    writeln(Output,'Source directory or file not found!');
    halt;
  end;

  { Process each file until no more left }
  while DosErr = 0 do
  begin
    FileSource := FileRec.Name;
    SetFileNames;
    if  (length(FileSource) > 0) then ProcessSource;

    {$I-}
    FindNext(FileRec);
    {$I+}
    DosErr := DOSError;
  end; { while doserr do }
  Close(Output);
end.