home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GETDEC.ZIP / GETDECS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-03-10  |  2.6 KB  |  122 lines
  1. {
  2.   GETDECS.PAS - PUBLIC DOMAIN - JIM MURPHY - 74030,2643
  3.  
  4.   Program to read a .PAS file, and find all procedure, function,
  5.   and overlay declarations, and write the declaration header to
  6.   another file so it can be included in the initialization section
  7.   of a unit.  The format for using the program from the command
  8.   line is:
  9.  
  10.     getdecs <infilename> <outfilename> <return>
  11.  
  12.   Two parameters are required. Use CON or PRN as <outfilename> to
  13.   send output to the SCREEN or PRINTER instead.
  14.  
  15.   The program will only find procedures and functions that begin
  16.   in the first column of the input source file.  This is done so
  17.   procedures/functions inside of, and local to a procedure or
  18.   function will not be output.  Local procedures would normally be
  19.   indented a few spaces from the left margin according to standard
  20.   (more or less) indenting practices.
  21. }
  22.  
  23.  
  24. PROGRAM GETDECS;
  25.  
  26. var
  27.   infvar:text;
  28.   outfvar:text;
  29.  
  30.  
  31. procedure getparams;
  32.  
  33. begin
  34.   if paramcount<>2 then
  35.   begin
  36.     writeln('Incorrect parameter count.');
  37.     writeln('Correct syntax is: getdecs <infilename> <outfilename>');
  38.     writeln('Use CON or PRN as <outfilename> to send output to the');
  39.     writeln('screen or printer respectively.');
  40.     halt;
  41.   end else
  42.   begin
  43.     if paramstr(1)=paramstr(2) then
  44.     begin
  45.       writeln('Duplicate filenames not allowed');
  46.       halt;
  47.     end;
  48.   end;
  49. end;  { end getparams }
  50.  
  51.  
  52. procedure prepfiles;
  53.  
  54. begin
  55.   assign(infvar,paramstr(1));
  56.   assign(outfvar,paramstr(2));
  57.   {$I-}
  58.   reset(infvar);
  59.   {$I+}
  60.   if ioresult<>0 then
  61.   begin
  62.     writeln('Unable to find input file.');
  63.     halt;
  64.   end;
  65.   {$I-}
  66.   rewrite(outfvar);
  67.   {$I+}
  68.   if ioresult<>0 then
  69.   begin
  70.     writeln('Unable to open output file.');
  71.     close(infvar);
  72.     halt;
  73.   end;
  74. end;  { end prepfiles }
  75.  
  76.  
  77. procedure finddecs;
  78.  
  79. const
  80.   pro='PROCEDURE';
  81.   fun='FUNCTION';
  82.  ovr1='{OVERLAY}';
  83.  ovr2='OVERLAY';
  84.  
  85. var
  86.   instr:string;
  87.   teststr:string;
  88.  
  89.  
  90.   procedure toupper;
  91.  
  92.   var i:integer;
  93.  
  94.   begin
  95.     for i:=1 to length(teststr) do
  96.       teststr[i]:=upcase(teststr[i]);
  97.   end;  { end toupper }
  98.  
  99.  
  100. begin
  101.   while not eof(infvar) do
  102.   begin
  103.     readln(infvar,instr);
  104.     teststr:=instr;
  105.     toupper;
  106.     if pos(pro,teststr)=1 then writeln(outfvar,instr);
  107.     if pos(fun,teststr)=1 then writeln(outfvar,instr);
  108.     if pos(ovr1,teststr)=1 then
  109.       writeln(outfvar,copy(instr,11,length(instr)-10));
  110.     if pos(ovr2,teststr)=1 then
  111.       writeln(outfvar,copy(instr,9,length(instr)-8));
  112.   end;
  113.   close(infvar);
  114.   close(outfvar);
  115. end;  { end finddecs }
  116.  
  117.  
  118. BEGIN
  119.   getparams;
  120.   prepfiles;
  121.   finddecs;
  122. END.