home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / DETAB.ZIP / DETAB.PAS
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  2.2 KB  |  93 lines
  1. {---------------------------------------------------------------------------
  2.   DETAB - remove tabs from a text file an replace them with appropiate number
  3.   of blanks.
  4.  ---------------------------------------------------------------------------}
  5. program DETAB;
  6. const
  7.    MAXLINE = 255;
  8.    TABSTOP = 4;
  9.    TABCHAR = #09;
  10.    NOTIFY  = 10;
  11.    BLANK = ' ';
  12. type
  13.    int = integer;
  14.    MaxString = string[MAXLINE];
  15. var
  16.    tabs : array[1..MAXLINE] of boolean;
  17.    I, col, k, kk : int;
  18.    S, Sout  : MaxString;
  19.    File1, File2 : text;
  20.  
  21. procedure Abend(msg : MaxString);
  22. begin
  23.    writeln(msg);
  24.    halt;
  25. end;
  26.  
  27. procedure OpenFiles;
  28. begin
  29.    if ParamCount < 2 then
  30.       Abend('format is: DETAB file1 file2');
  31.    assign(File1,ParamStr(1));
  32.    {$I-} reset(File1); {$I+}
  33.    if IOresult <> 0 then
  34.       Abend('error opening input file ' + ParamStr(1));
  35.    assign(File2,ParamStr(2));
  36.    {$I-} rewrite(File2); {$I+}
  37.    if IOresult <> 0 then begin
  38.       close(File1);
  39.       Abend('error opening output file ' + ParamStr(2));
  40.    end;
  41. end;
  42.  
  43. function ReadString(var S : MaxString): boolean;
  44. begin
  45.    if not EOF(File1) then begin
  46.       ReadString := true;
  47.       ReadLn(File1,S);
  48.    end else
  49.       ReadString := false;
  50. end;
  51.  
  52. procedure WriteString(var S : MaxString);
  53. begin
  54.    WriteLn(File2,S);
  55. end;
  56.  
  57. procedure CloseFiles;
  58. begin
  59.    close(File1);
  60.    close(File2);
  61. end;
  62.  
  63.  
  64. begin (* main program *)
  65.    OpenFiles;
  66.    for I:=1 to MAXLINE do                (* initialize tabstops array *)
  67.       tabs[I] := (I mod TABSTOP) = 1;
  68.    K := 0;
  69.    KK := 0;
  70.    while ReadString(S) do begin
  71.       col := 1;
  72.       for I:=1 to length(S) do begin
  73.          if S[I] <> TABCHAR then begin
  74.             Sout[col] := S[I];
  75.             col := succ(col);
  76.          end else
  77.             repeat
  78.                Sout[col] := BLANK;
  79.                col := succ(col);
  80.             until tabs[col] or (col > MAXLINE);
  81.       end; (* FOR *)
  82.       Sout[0] := chr(col-1);
  83.       WriteString(Sout);
  84.       K := succ(K);
  85.       KK := succ(KK);
  86.       if K > NOTIFY then begin
  87.          gotoxy(1,25); clreol; write(KK);
  88.          K := 0;
  89.       end;
  90.    end; (* WHILE *)
  91.    CloseFiles;
  92. end.
  93.