home *** CD-ROM | disk | FTP | other *** search
/ Phoenix CD 2.0 / Phoenix_CD.cdr / 15a / murutil.zip / DETAB.PAS < prev    next >
Pascal/Delphi Source File  |  1986-12-16  |  4KB  |  154 lines
  1. PROGRAM DETAB;
  2.  
  3. {  This Turbo Pascal program copies its input file to its output file
  4.    while deleting form-feed codes and  converting  tab  codes  to  an
  5.    equivalent series of spaces,  assuming standard tab settings every
  6.    eight characters.  All form-feeds and trailing blanks are deleted.
  7.  
  8.    Program by Harry M. Murphy,  2 March 1986.
  9.    Updated 4 June 1986 and 16 December 1986.  }
  10.  
  11.   CONST
  12.         LENSPEC = 65;
  13.         LINELEN = 132;
  14.  
  15.   TYPE
  16.        FILESPEC = STRING[LENSPEC];
  17.        TEXTLINE = STRING[LINELEN];
  18.  
  19.   VAR
  20.       CR:      CHAR;
  21.       FF:      CHAR;
  22.       INP:     TEXT[2048];
  23.       INPNAME: FILESPEC;
  24.       K:       0..LINELEN;
  25.       KT:      0..LINELEN;
  26.       L:       0..LINELEN;
  27.       LL:      0..LINELEN;
  28.       LINE:    TEXTLINE;
  29.       NFF:     INTEGER;
  30.       NLINE:   INTEGER;
  31.       NTAB:    INTEGER;
  32.       OUT:     TEXT[2048];
  33.       OUTNAME: FILESPEC;
  34.       TAB:     CHAR;
  35.  
  36.  
  37. PROCEDURE GETINPFIL(VAR INPNAME: FILESPEC);
  38.  
  39. {  This file gets an input file, either as the first parameter
  40.    on the command line or by requesting it from the user.
  41.  
  42.    Procedure by Harry M. Murphy,  22 February 1986.  }
  43.  
  44.   VAR
  45.       L: INTEGER;
  46.  
  47.   BEGIN
  48.     IF PARAMCOUNT = 0
  49.       THEN
  50.         BEGIN
  51.           WRITE('Input  file: ');
  52.           READLN(INPNAME)
  53.         END
  54.       ELSE
  55.         INPNAME := PARAMSTR(1);
  56.     FOR L:=1 TO LENGTH(INPNAME) DO INPNAME[L] := UPCASE(INPNAME[L]);
  57.     ASSIGN(INP,INPNAME);
  58.     {$I-} RESET(INP); {$I+}
  59.     IF IORESULT <> 0
  60.       THEN
  61.         BEGIN
  62.           CLOSE(INP);
  63.           WRITELN('ERROR!  Can''t find file ',INPNAME,'!');
  64.           HALT
  65.         END;
  66.   END {Procedure GETINPFIL};
  67.  
  68.  
  69. PROCEDURE GETOUTFIL(VAR OUTNAME: FILESPEC);
  70.  
  71. {  This file gets an output file, either as the second parameter
  72.    on the command line or by requesting it from the user.
  73.  
  74.    Procedure by Harry M. Murphy,  22 February 1986.  }
  75.  
  76.  VAR
  77.      L: INTEGER;
  78.  
  79.   BEGIN
  80.     IF PARAMCOUNT < 2
  81.       THEN
  82.         BEGIN
  83.           WRITE('Output file: ');
  84.           READLN(OUTNAME)
  85.         END
  86.       ELSE
  87.         OUTNAME := PARAMSTR(2);
  88.     FOR L:=1 TO LENGTH(OUTNAME) DO OUTNAME[L] := UPCASE(OUTNAME[L]);
  89.     ASSIGN(OUT,OUTNAME);
  90.     {$I-} REWRITE(OUT); {$I-}
  91.     IF IORESULT <> 0
  92.       THEN
  93.         BEGIN
  94.           CLOSE(OUT);
  95.           WRITELN('ERROR!  Can''t open ',OUTNAME,'!');
  96.           HALT
  97.         END
  98.   END {Procedure GETOUTFIL};
  99.  
  100.  
  101.   BEGIN {Program DETAB}
  102.     CR := CHR(13);
  103.     FF := CHR(12);
  104.     TAB := CHR(9);
  105.     GETINPFIL(INPNAME);
  106.     GETOUTFIL(OUTNAME);
  107.     LOWVIDEO;
  108.     WRITELN('De-tabbing file ',INPNAME,' ==> file ',OUTNAME);
  109.     NFF := 0;
  110.     NLINE := 0;
  111.     NTAB := 0;
  112.     WHILE NOT EOF(INP) DO
  113.       BEGIN
  114.         READLN(INP,LINE);
  115.         LL := LENGTH(LINE);
  116.         LINE[0] := CHR(0);
  117.         WHILE LINE[LL] = ' ' LL := LL-1;
  118.         LINE[0] := CHR(LL);
  119.         IF LL > 0
  120.           THEN
  121.             BEGIN
  122.               K := 1;
  123.               FOR L:=1 TO LL DO
  124.                 IF LINE[L] = TAB
  125.                   THEN
  126.                     BEGIN
  127.                       KT := ((K+7) DIV 8)*8+1;
  128.                       REPEAT
  129.                         WRITE(OUT,' ');
  130.                         K := K+1
  131.                       UNTIL K=KT;
  132.                       NTAB := NTAB+1
  133.                     END
  134.                   ELSE
  135.                     IF LINE[L] = FF
  136.                       THEN
  137.                         NFF := NFF+1
  138.                       ELSE
  139.                         BEGIN
  140.                           WRITE(OUT,LINE[L]);
  141.                           K := K+1
  142.                         END
  143.             END;
  144.         WRITELN(OUT);
  145.         NLINE := NLINE+1;
  146.         IF (NLINE MOD 100)=0 THEN WRITE(NLINE:5,' lines done.',CR)
  147.       END;
  148.     CLOSE(INP);
  149.     CLOSE(OUT);
  150.     WRITELN(NLINE:5,' lines de-tabbed.');
  151.     WRITELN(NTAB:5,' tab codes removed.');
  152.     WRITELN(NFF:5,' form-feed codes deleted.')
  153. END.
  154.