home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / NUTUG11.ZIP / REFORM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-11-22  |  7.6 KB  |  273 lines
  1. Program Reform;
  2. Uses    Dos,
  3.         Crt;
  4.  
  5.             {NORTHWESTERN UNIVERSITY TURBO USERS GROUP UTILITIES}
  6.  
  7.                           (** NUtility FORMAT **)
  8.  
  9.                          {(C) J. E. Hilliard 1986}
  10.  
  11. PROCEDURE Reformat;
  12.  
  13.          (*Originally this routine was written solely for the purpose
  14.          of deleting the tutorial comments (ie. those enclosed within
  15.          {/  /}) from the NUTILITY files. But it later became appar-
  16.          ent that by adding the necessary sub-procedures more general
  17.          formatting operations could be performed. For example, the
  18.          Procedure 'ListDeclarations' was used to generate the list of
  19.          procedures and functions for NUTDOC.
  20.  
  21.          The procedure loads the files listed in 'FileNames' and, after
  22.          formatting, writes them as files with the extension 'FOR'.
  23.  
  24.          The subprocedures included are: Counting {/ and /}, Del-
  25.          ting tutorial comments, Deleting blank lines and Listing
  26.          Procedure and Function headings.                            *)
  27.  
  28.  
  29. CONST
  30.  
  31.   NofF = 6;                             {Number of files.                    }
  32.  
  33.   FileNames : array [1..NofF] of string[8] =
  34.  
  35.                ('VIDEO',                {Modify list if necessary.           }
  36.                 'MISC',
  37.                 'DATETIME',
  38.                 'REALFAST',
  39.                 'DATIM',
  40.                 'BASECON');
  41.  
  42. VAR
  43.  
  44.   InFile, OutFile : Text;
  45.   J,  K    : integer;
  46.  
  47.  
  48. Procedure ListDeclarations (FN : integer);
  49.  
  50.          {Searches for lines begining with 'P' or 'F', deletes the
  51.          first word, contracts or expands line to 50 characters, adds
  52.          the file name and then writes the line.                    }
  53.  
  54. Var
  55.  
  56.   NL      : integer;
  57.   Line    : string[250];
  58.   ExpName : string[12];
  59.  
  60. begin
  61.  
  62.   ExpName := FileNames[FN];
  63.   while Length (ExpName) < 8 do
  64.     ExpName := ExpName + ' ';
  65.   ExpName := ExpName + '.PAS';
  66.   NL := 0;
  67.   GoToXY (5, WhereY + 1);
  68.   write ('Running ', ExpName);
  69.   GoToXY (26, WhereY);
  70.   write (NL:4, ' Labels written.');
  71.   while not EOF (InFile) do
  72.     begin
  73.       readln (InFile, Line);
  74.       if Line[1] in ['P', 'F'] then
  75.         begin
  76.           Line :=
  77.             Copy (Line, Pos (' ', Line) + 1, 80);  {Delete first word.      }
  78.           while Pos ('  ', Line) <> 0 do    {Delete multiple spaces.        }
  79.             Delete (Line, Pos ('  ', Line), 1);
  80.           Delete (Line, 50, 40);            {Truncate line.                 }
  81.           while Length (Line) < 50 do       {Fill out line.                 }
  82.             Line := Line + ' ';
  83.           Line := Line + '['+ ExpName + ']';{Add file name.                 }
  84.           writeln (Outfile, Line);
  85.           NL := succ (NL);
  86.           GoToXY (26, WhereY);
  87.           write (NL:4);                     {Up date display.               }
  88.         end; {if}
  89.     end; {while not EOF}
  90.  
  91. End; {ListDeclarations (FN : integer)}
  92.  
  93.  
  94. Procedure DeleteBlankLines (FN : integer);
  95.  
  96.          {As you will have noticed, I have a fondness for blank lines
  97.          in the belief that they improve clarity. However, you may
  98.          prefer tighter formatting (certainly it speeds up compilation).
  99.          This sub-procedure deletes all blank lines in file number FN
  100.          except for those occurring before a line begining with a 'P'
  101.          or an 'F'.                                                  }
  102.  
  103.          {This Procedure is dedicated to Scott Lindsey.              }
  104.  
  105. Var
  106.  
  107.   BL     : integer;
  108.   Line  : string[250];
  109.  
  110. begin
  111.  
  112.   BL := 0;
  113.   GoToXY (5, WhereY + 1);
  114.   write ('Running ', FileNames[FN] + '.PAS');
  115.   GoToXY (26, WhereY);
  116.   write (BL:4, ' Blank lines deleted');
  117.   while not EOF (InFile) do
  118.     begin
  119.       readln (InFile, Line);
  120.       if Length (Line) <> 0
  121.         then
  122.           writeln (OutFile, Line)
  123.         else                           {Line is blank.                      }
  124.           begin
  125.             repeat
  126.               readln (InFile, Line);   {Get next non-blank line.            }
  127.               BL := succ (BL);
  128.             until (Length (Line) <> 0) or (EOF (InFile) );
  129.             BL := pred (BL);
  130.             if Line[1] in ['P', 'F']
  131.               then                     {Retain blank line.                  }
  132.                 writeln (OutFile, '')
  133.               else
  134.                 BL := succ (BL);       {Blank line was deleted.             }
  135.              writeln (OutFile, Line);
  136.              GoToXY (26, WhereY);
  137.              write (BL:4);
  138.           end; {else}
  139.  
  140.     end; {while not EOF}
  141.  
  142. end; {DeleteBlankLines (FN : integer)}
  143.  
  144.  
  145. Procedure MatchBraces (FN : integer);
  146.  
  147.          (*This procedure scans all line in file number FN and reports
  148.          the number of {/ and /} braces. It is advisable to check that
  149.          the numbers match before using DeleteTutorialLines.        *)
  150.  
  151. Var
  152.  
  153.   LH, RH : integer;
  154.   Line   : string[250];
  155.  
  156. begin
  157.  
  158.   LH := 0; RH := 0;
  159.   GoToXY (5, WhereY + 1);
  160.   write ('Running ', FileNames[FN] + '.PAS');
  161.   GoToXY (26, WhereY);
  162.   write (LH:4, ' Left braces.');
  163.   GoToXY (45, WhereY);
  164.   write (RH:4, ' Right braces.');
  165.   while not EOF (InFile) do
  166.     begin
  167.       readln (InFile, Line);
  168.       if Pos ('{/', Line) <> 0 then
  169.         begin
  170.           LH := succ (LH);
  171.           GoToXY (26, WhereY);
  172.           write (LH:4);
  173.         end;
  174.       if Pos ('/}', Line) <> 0 then
  175.         begin
  176.           RH := succ (RH);
  177.           GoToXY (45, WhereY);
  178.           write (RH:4);
  179.         end;
  180.     end; {while not EOF}
  181.  
  182. end; {MatchBraces (FN : integer)}
  183.  
  184.  
  185. Procedure DeleteTutorialLines (FN : Integer);
  186.  
  187. Var
  188.  
  189.   L : integer;
  190.   Line : string[250];
  191.  
  192. begin
  193.  
  194.   L := 0;
  195.   GoToXY (5, WhereY + 1);
  196.   write ('Running ', FileNames[FN] + '.PAS');
  197.   GoToXY (26, WhereY);
  198.   write (L:3, ' Lines deleted.');
  199.   while not EOF (InFile) do
  200.     begin
  201.       readln (InFile, Line);
  202.       if Pos ('{/', Line) = 0
  203.         then
  204.           writeln (OutFile, Line)
  205.         else
  206.           begin
  207.             while Pos ('/}', Line) = 0 do
  208.               begin
  209.                 readln (InFile, Line);
  210.                 L := succ (L);
  211.               end;
  212.             L := succ (L);
  213.             GoToXY (26, WhereY);
  214.             write (L:3);
  215.           end; {else}
  216.     end; {while not EOF}
  217.  
  218. end; {DeleteTutorialLines (FN)}
  219.  
  220. Begin                                  {Main routine.                       }
  221.  
  222.   ClrScr;
  223.   GoToXY (29, 3);
  224.   write ('NUTILITY FILES REFORMAT');
  225.   GoToXY (29, 4);
  226.   write ('-----------------------');
  227.   GoToXY (5, 6);
  228.   for J := 1 to NofF do
  229.     begin
  230.       Assign (InFile,  FileNames[J] + '.PAS');
  231.       Assign (OutFile, FileNames[J] + '.FOR');
  232.       {$I-} Reset (InFile); {$I+}
  233.       if IOResult = 0
  234.         then
  235.           begin
  236.             {$I-} ReWrite (OutFile); {$I+}
  237.             if IOResult = 0
  238.               then
  239.                 begin
  240.  
  241.        (*****  UNCOMMENT PROCEDURE REQUIRED OR ADD YOUR OWN *****)
  242.  
  243.                   {ListDeclarations (J);}
  244.                   {DeleteBlankLines (J);}
  245.                   {DeleteTutorialLines (J);}
  246.                   {MatchBraces (J);}
  247.  
  248.                   Close (InFile);
  249.                   Close (OutFile);
  250.                 end
  251.               else
  252.                 begin
  253.                   GoToXY (5, WhereY + 1);
  254.                   write ('*** Unable to open ', FileNames[J] + '.DEL ***');
  255.                   Close (InFile)
  256.                 end;
  257.           end {if IOResult = 0}
  258.         else
  259.           begin
  260.             GoToXY (5, WhereY + 1);
  261.             write ('*** Unable to Find ', FileNames[J] + '.PAS ***');
  262.           end;
  263.     end; {for J}
  264.  
  265. End; {Reformat}
  266.  
  267. BEGIN
  268.  
  269.   Reformat
  270.  
  271. END.
  272.  
  273.