home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / STRNFST2.ZIP / COMSTRIP.PAS next >
Encoding:
Pascal/Delphi Source File  |  1987-01-25  |  2.7 KB  |  110 lines
  1. program comstrip;
  2. {$V-,U+}
  3. (*
  4. This program is designed to strip comments from Inline code
  5. produced by Dave Baldwin's Inline.com program.  It also puts the
  6. Inline code itself into lines of somewhere around 78 characters
  7. long.  It assumes that the word Inline begins in col.1 and that
  8. the ending ); also begins in col.1.  Only lines between those
  9. two signals are affected.  Everything else is passed from input
  10. to output without change.   Because of the way Inline.com works,
  11. there should be no multiline comments in the inline code it
  12. produces.  This program assumes there are none.
  13. To run,
  14.    C>comstrip infile outfile
  15.  
  16. NOTE: This file specifies three include files.  These files are
  17. not included here.  The routines, however, can be found in
  18. Strnfst2.pas, and you can replace the three include files
  19. specified here with that file.
  20.  
  21. *)
  22.  
  23. type longstring = string[255];
  24.  
  25. var
  26.    filename:  string[36];
  27.    infile, outfile: text[$2000];
  28.    tline: longstring;
  29.  
  30. const
  31.    InLineStart: string[7] = 'Inline(';
  32.    InLineEnd:   string[2] = ');';
  33.  
  34. {$I stripr.inc}
  35. {$I stripl.inc}
  36. {$I equals.inc}
  37.  
  38. procedure get_files;
  39.  
  40.  begin
  41.   assign(infile, ParamStr(1));
  42.   reset(infile);
  43.   assign(outfile, ParamStr(2));
  44.   rewrite(outfile);
  45.  end;
  46.  
  47. procedure close_files;
  48.  
  49.  begin
  50.   close(infile);
  51.   close(outfile);
  52.  end;
  53.  
  54. procedure closeup(var tline:longstring);
  55.  
  56.  var
  57.   outline:longstring;
  58.   i,j : integer;
  59.  
  60.  const
  61.   blank = ' ';
  62.   CommentStart = '{';
  63.   CommentEnd   = '}';
  64.  
  65.    (*-----------------------------*)
  66.    procedure cleanit;
  67.    begin
  68.     stripl(tline,blank);
  69.     i := pos(CommentStart,Tline);
  70.     if i <> 0 then tline := copy (tline,1,i-1); {strips the comments}
  71.     stripr(tline, blank);
  72.     if (length(tline) > 0) and (pos('$',tline)>0) then
  73.      begin
  74.        outline := outline + tline;
  75.        if length(outline) > 78 then
  76.         begin
  77.          j := 78;
  78.          while (outline[j] <> '/') and (j >0) do j := pred(j);
  79.          if j = 0 then
  80.           begin
  81.            writeln ('Error in input file');
  82.            halt;
  83.           end;
  84.          writeln(outfile, blank, blank,copy(outline,1,j));
  85.          delete(outline,1,j);
  86.        end;
  87.     end;
  88.    readln(infile,tline);
  89.    end; {the while}
  90.  
  91.  
  92.  begin {closeup}
  93.   writeln(outfile,tline);
  94.   outline:='';
  95.   readln (infile,tline);
  96.   while not equal_structures (tline[1],InLineEnd[1],2) do cleanit;
  97.   if length(outline)>0 then tline := blank + blank + outline + tline;
  98.  end; {closeup}
  99.  
  100. begin
  101.  get_files;
  102.  while not eof(infile) do
  103.   begin
  104.    readln(infile, tline);
  105.    if equal_structures (tline[1],InLineStart[1],7) then closeup(tline);
  106.    writeln(outfile,tline);
  107.   end;
  108. close_files;
  109. end.
  110.