Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/LEFTJUST.ZIP/LEFTJUST.PAS

Pascal/Delphi Source File | 1988-08-31 | 7.5 KB | 284 lines

PROGRAM LeftJust;

{$B-,D+,R-,S-,V-}

USES DOS, CRT;

CONST
  Bell = #7;

TYPE
  line    = STRING[255];

VAR
  LineRead    : line;
  InFile      : TEXT;
  OutFile     : TEXT;
  InFileName  : line;
  OutFileName : line;
  Version     : line;
  Buf1        : Array[1..16384] of Char;
  Buf2        : Array[1..16384] of Char;

{
   ┌────────────────────────────────────────────────────┐
   │ PROCEDURE Error_Message                            │
   └────────────────────────────────────────────────────┘
}

PROCEDURE Error_Message (message : string);

BEGIN
  WRITELN (Bell,message);                      { ding bell & write message }
  HALT;
END;

{
   ┌────────────────────────────────────────────────────┐
   │ PROCEDURE Usage                                    │
   └────────────────────────────────────────────────────┘
}

PROCEDURE Usage;

CONST
  NL = #13#10;

BEGIN
  WRITELN (Bell,
'The purpose of this program is to left justify ASCII text files.  That is:',NL,
'remove a border consisting of blanks (ASCII character 32) from ASCII text',NL,
'files.  The program also removes form feeds (ASCII 12) as they make it more',NL,
'difficult to identify the width of the border.  An option is to remove ONLY',NL,
'(1) the excess left border spaces (automargin adjust), or (2) remove left',NL,
'border spaces up to a set number.',NL,
'',NL,
'USAGE:     LEFTJUST [in_filename] [out_filename] {/m{#}}',NL,
'',NL,
'The /m option allows you to automatically remove an "excess border" of',NL,
'left-side spaces in the ASCII file.  For example, if ALL lines have at',NL,
'least 5 left spaces, then EVERY line will have those (and only those) 5',NL,
'spaces removed.  If a number is specified after the /M option (e.g.,',NL,
'"/m4"), then every line will have UP TO 4 spaces removed.',NL);

  Halt;
END;

{
   ┌────────────────────────────────────────────────────┐
   │ PROCEDURE Read_Params                              │
   └────────────────────────────────────────────────────┘
}

PROCEDURE Read_Params (VAR param_option : integer; VAR InFileNameV : line;
                       VAR OutFileNameV : line);

VAR
  param : string;
  code  : integer;

BEGIN
  IF (ParamCount IN [2,3]) THEN
    BEGIN
      InFileNameV  := ParamStr(1);
      OutFileNameV := ParamStr(2);
      IF ParamStr(3) = '' THEN
        BEGIN
          param_option := 0;
          EXIT;
        END;
                                             { implied ELSE routine        }
      param := ParamStr(3);                  { select automargin adjust w/ }
      IF POS ('/',param) = 1 THEN            { /m or /M; by entering #,    }
        BEGIN                                { left margin reduced by #    }
          IF ((Param[2] = 'm') OR (Param[2] = 'M')) THEN
            BEGIN
              IF LENGTH (param) = 2 THEN
                BEGIN
                  param_option := -1;        { if input param. is ONLY /m, }
                  EXIT;                      { set var. to -1              }
                END
              ELSE
                BEGIN                        { if # entered, set var to #  }
                  DELETE (param,1,2);
                  VAL (param, param_option, code);
                  IF code <> 0 THEN
                    Error_Message ('Error -- Input margin number invalid');
                  IF param_option = 0 THEN param_option := -1;
                END;
            END
          ELSE
            Error_Message ('Error -- Illegal parameter');
        END
      ELSE
        Error_Message ('Error -- Illegal parameter');
    END
  ELSE
    Usage;
END;

{
   ┌────────────────────────────────────────────────────┐
   │ PROCEDURE OPEN_INFILE                              │
   └────────────────────────────────────────────────────┘
}

PROCEDURE Open_InFile (InFileNameV : line; VAR InFileV : TEXT);

VAR
  FileAttr : word;

BEGIN
{$I-}
  ASSIGN (InFileV,InFileNameV);
  IF IOresult <> 0 THEN Error_Message ('Error -- cannot assign filename');

  GetFAttr (InFileV, FileAttr);
  IF (FileAttr AND Directory) <> 0 THEN
    Error_Message ('Error -- input file does not exist in current directory');

  RESET (InFileV);
  IF IOresult <> 0 THEN Error_Message ('Error -- cannot open input file');

  SETTEXTBUF (InFileV, Buf1);
{$I+}

END;

{
   ┌────────────────────────────────────────────────────┐
   │ PROCEDURE OPEN_OUTFILE                             │
   └────────────────────────────────────────────────────┘
}

PROCEDURE Open_OutFile (OutFileNameV : line; VAR OutFileV : TEXT);

BEGIN
{$I-}
  ASSIGN (OutFileV,OutFileNameV);
  IF IOresult <> 0 THEN Error_Message ('Error -- cannot assign filename');

  REWRITE (OutFileV);
  IF IOresult <> 0 THEN Error_Message ('Error -- cannot open output file');

  SETTEXTBUF (OutFileV, Buf2);
{$I+}
END;

{
   ┌────────────────────────────────────────────────────┐
   │ PROCEDURE CLOSE_FILES                              │
   └────────────────────────────────────────────────────┘
}

PROCEDURE Close_Files (VAR InFileV : TEXT; VAR OutFileV : TEXT);

BEGIN
  CLOSE (InFileV);
  CLOSE (OutFileV);
  WRITELN (Bell);                               { ding bell }
END;

{
   ┌────────────────────────────────────────────────────┐
   │ PROCEDURE Cnt_Excess_Margin                        │
   └────────────────────────────────────────────────────┘
}

PROCEDURE Cnt_Excess_Margin (VAR Margin : integer);

VAR
  Count   : integer;

BEGIN
  Count   := 1;
  Margin  := 256;

  WRITELN;
  WRITELN ('Automatically checking left margin size ...');

  WHILE NOT EOF(InFile) DO
    BEGIN
      READLN (InFile,LineRead);

      DELETE (LineRead,POS(#12,LineRead),1);        { delete FF's           }

      WHILE LineRead[Count] = ' ' DO INC (Count);   { count leading spaces  }
      IF (Count < Margin) AND (LENGTH(LineRead) > 0) THEN Margin := Count;

      Count := 1;
    END;

  CLOSE (InFile);
  RESET (InFile);
END;

{
   ┌────────────────────────────────────────────────────┐
   │ PROCEDURE PROCESS_INFILE                           │
   └────────────────────────────────────────────────────┘
}

PROCEDURE Process_InFile (margin : integer; VAR InFileV  : TEXT;
                                            VAR OutFileV : TEXT);

VAR
  Count    : integer;
  DelLimit : integer;

BEGIN
  DelLimit := 256;

  IF margin = -1 THEN Cnt_Excess_margin (DelLimit);
  IF margin >  0 THEN DelLimit := margin;

  WHILE NOT EOF(InFileV) DO
    BEGIN
      Count    := 1;

      READLN (InFileV,LineRead);

      WHILE POS (#12,LineRead) <> 0 DO
        DELETE (LineRead,POS(#12,LineRead),1);    { delete FF's           }

      WHILE (LineRead[Count] = ' ') AND (Count <= DelLimit) DO
        INC (Count);

      DELETE (LineRead,1,Count - 1);              { delete counted spaces }

      WRITELN (OutFileV, LineRead);

    END; { while#1 }

  FLUSH (OutFileV);                               { ensure all lines written }
END;

{
   ┌────────────────────────────────────────────────────┐
   │ MAIN PROGRAM                                       │
   └────────────────────────────────────────────────────┘
}

VAR
  Option  : integer;

BEGIN

  Version := 'Version 1.2, 8-26-88 -- Public Domain by John Land';

  CLRSCR;

  Read_Params (Option, InFileName, OutFileName);

  Open_InFile (InFileName, InFile);

  Open_OutFile (OutFileName, OutFile);

  WRITELN ('PROCESSING ',InFileName, ' INTO ', OutFileName);

  Process_InFile (Option, InFile, OutFile);

  Close_Files (InFile, OutFile);

END.