Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/misc/cli.src

Text File | 1988-05-03 | 29.3 KB | 1,056 lines

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--chpt1.txt
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;
package CHAPTER_1 is
--  From Kernighan and Plauger's "Software Tools in Pascal" Addison-Wesley

  use TEXT_IO;


  TAB                   : constant CHARACTER := ASCII.HT;
  LF                    : constant CHARACTER := ASCII.LF;
  NEWLINE               : constant CHARACTER := ASCII.CR;
  ENDFILE               : constant CHARACTER := ASCII.FS;
  BLANK                 : constant CHARACTER := ' ';

  MAXLINE               : constant INTEGER := 250;
  TABSPACE              : constant INTEGER := 4;

  type TABTYPE is array(INTEGER range 1..MAXLINE) of BOOLEAN;
  TABSTOPS : TABTYPE;

  procedure GETC(C : out CHARACTER);
  procedure COPY;
  procedure CHARCOUNT;
  procedure LINECOUNT;
  procedure WORDCOUNT;
  function TABPOS(COL : INTEGER; TABSTOPS : TABTYPE) return BOOLEAN;
  procedure SETTABS(TABSTOPS : out TABTYPE);
  procedure DETAB;

end CHAPTER_1;


with TEXT_IO;
package body CHAPTER_1 is
--  Comments mostly point out differences from Pascal version

--  package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
  use TEXT_IO;
  use INTEGER_IO;

  procedure GETC(C : out CHARACTER) is
  --  Different from the SWT getc which is a function with side effect
  --  This can read a ASCII.FS from the keyboard for a file terminator
  --  Or use an END_ERROR off a file or tape
  begin
    GET(C);
    if C = ENDFILE  then
      raise END_ERROR;
    end if;
  end GETC;

  procedure COPY is
  --  1.1  copy input characters to output
  --  This has the major modification to the style of Software Tools
  --  That style may have been required by limitations of other languages
  --  Rather than the unusual getc function with side effects
  --  we will use a more conventional Ada construct
  --  End of file will be handled as in Ada rather than as a special character
  --  so type CHARACTER can be used
  --  When an explicit End of file character is needed ASCII.FS will be used

    C : CHARACTER;

  begin
    loop
      GETC(C);
      PUT(C);          --  May have to turn off local echo to make sense
    end loop;
  exception
  when END_ERROR  =>
    null;              --      When system EOF finish and exit
  when others  =>
    null;
  end COPY;


  procedure CHARCOUNT is
  --  1.2  count characters in standard input

    C : CHARACTER;
    NC : INTEGER := 0;                 --  Can initialize here in Ada

  begin
    loop
      GETC(C);
      NC := NC + 1;
    end loop;
    NEW_LINE;
    PUT("NUMBER OF CHARACTERS = ");
    PUT(NC);                          --  Ada PUT distinguishes type
    NEW_LINE;                         --  Ada has explicit procedure
  exception
  when END_ERROR  =>
    NEW_LINE;
    PUT("NUMBER OF CHARACTERS = ");
    PUT(NC);
    NEW_LINE;
  end CHARCOUNT;


  procedure LINECOUNT is
  --  1.3  count lines in standard input

    C : CHARACTER;
    NL : INTEGER := 0;

  begin
    loop
      GETC(C);
      if C = NEWLINE  then    --  Looks for explicit end of line
        NL := NL + 1;
      end if;
    end loop;
    NEW_LINE;
    PUT("NUMBER OF LINES = ");
    PUT(NL);
    NEW_LINE;
  exception
  when END_ERROR  =>
    NEW_LINE;
    PUT("NUMBER OF LINES = ");
    PUT(NL);                  --  An unterminated fragment is not counted
    NEW_LINE;
  end LINECOUNT;


  procedure WORDCOUNT is
  --  1.4  count lines in standard input

    C : CHARACTER;
    WC : INTEGER := 0;
    INWORD : BOOLEAN := FALSE;       -- BOOLEAN rather than integer

  begin
    loop
      GETC(C);
      if C = BLANK  or  C = NEWLINE  or  C = TAB or C = LF  then
        INWORD := FALSE;        --  We also worry about line feed
      else
        if INWORD = FALSE  then
          INWORD := TRUE;
          WC := WC + 1;
        end if;
      end if;
    end loop;
    NEW_LINE;
    PUT("NUMBER OF WORDS = ");
    PUT(WC);
    NEW_LINE;
  exception
  when END_ERROR  =>
    NEW_LINE;
    PUT("NUMBER OF WORDS = ");
    PUT(WC);
    NEW_LINE;
  end WORDCOUNT;

  procedure SETTABS(TABSTOPS : out TABTYPE) is
  --  1.5  set initial tab stops
  begin
    for I in 1..MAXLINE  loop
      if I mod TABSPACE = 1  then
        TABSTOPS(I) := TRUE;
      else
        TABSTOPS(I) := FALSE;
      end if;
    end loop;
  end SETTABS;

  function TABPOS(COL : INTEGER; TABSTOPS : TABTYPE) return BOOLEAN is
  --  1.5  return true if col is a tab stop
  begin
    if COL > MAXLINE  then
      return TRUE;
    else
      return TABSTOPS(COL);
    end if;
  end TABPOS;

  procedure DETAB is
  --  1.5  convert tabs to equivalent number of blanks
    C : CHARACTER;
    COL : INTEGER := 1;

  begin
    SETTABS(TABSTOPS);
    loop
      GETC(C);
      if C = TAB  then
        loop
          PUT(BLANK);
          COL := COL + 1;
          exit when TABPOS(COL, TABSTOPS) = TRUE;
        end loop;
      elsif C = NEWLINE  then
        PUT(NEWLINE);
        COL := 1;
      else
       PUT(C);
        if C /= LF  then
         COL := COL + 1;
        end if;
      end if;
    end loop;
    PUT(ENDFILE);      --  If that is how we got here
  exception
  when END_ERROR  =>
    null;              --  If we got out by sensing EOF
  end DETAB;

begin
  SET_INPUT(STANDARD_INPUT);
end CHAPTER_1;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--chpt2.txt
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with CHAPTER_1;         use CHAPTER_1;
package CHAPTER_2 is

  BACKSPACE : constant CHARACTER := ASCII.BS;
  WARNING   :   constant CHARACTER := ASCII.TILDE;
  ENDLINE   : constant CHARACTER := NEWLINE;
  ENDSTR    : constant CHARACTER := ASCII.GS;             --  CTL-]
  ESCAPE    : constant CHARACTER := '@';
  DASH      : constant CHARACTER := '-';
  NEGATE    : constant CHARACTER := '^';

  MAXSTR    : constant INTEGER := MAXLINE;
  MAXSET    : constant INTEGER := MAXSTR;
  MAXARG    : constant INTEGER := 12;

  ARGUMENTS : array(1..MAXARG) of STRING(1..MAXSTR);
  NUMBER_OF_ARGUMENTS : INTEGER := 0;

  GETARG_OK  : BOOLEAN := FALSE;
  ADDSTR_OK  : BOOLEAN := FALSE;
  MAKESET_OK : BOOLEAN := FALSE;

  ESCAPED_CHAR : CHARACTER;

  ERROR_ERROR    : exception;
  GETARG_ERROR   : exception;
  ADDSTR_ERROR   : exception;
  MAKESET_ERROR  : exception;
  TRANSLIT_ERROR : exception;

  procedure ERROR(ERROR_MESSAGE : STRING);
  procedure ENTAB;
  function MAX(X, Y : INTEGER) return INTEGER;
  procedure OVERSTRIKE;
  function MIN(X, Y : INTEGER) return INTEGER;
  procedure COMPRESS;
  function ISUPPER(C : CHARACTER) return BOOLEAN;
  procedure EXPAND;
  procedure CONVERT_ESCAPED(S : in STRING;
                            I : in out INTEGER;
                 ESCAPED_CHAR : out CHARACTER);
  procedure GETARG(N : in INTEGER;
              ARGSTR : out STRING;
              MAX_OF : in INTEGER);
  function LENGTH(S : STRING) return INTEGER;
  procedure ADDSTR(C : in CHARACTER;
              OUTSET : in out STRING;
                   J : in out INTEGER;
              MAX_OF : in INTEGER);
  procedure DODASH(DELIM : in CHARACTER;
                     SRC : in STRING;
                       I : in out INTEGER;
                    DEST : in out STRING;
                       J : in out INTEGER;
                  MAX_OF : in INTEGER);
  procedure TRANSLIT;

end CHAPTER_2;


with TEXT_IO;
with CHAPTER_1; use CHAPTER_1;
package body CHAPTER_2 is
--  package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
  use TEXT_IO;
  use INTEGER_IO;

  procedure ERROR(ERROR_MESSAGE : STRING) is
  begin
    PUT(ERROR_MESSAGE);
    raise ERROR_ERROR;
  end ERROR;

  procedure ENTAB is
  --  2.1  replace blanks by tabs and blanks
    type TABTYPE is array (INTEGER range 1..MAXLINE) of BOOLEAN;
    C : CHARACTER;
    COL, NEWCOL : INTEGER := 1;
  begin
    SETTABS(TABSTOPS);
    loop
      NEWCOL := COL;
      loop
        GETC(C);
        exit when C /= BLANK;
        NEWCOL := NEWCOL + 1;
        if TABPOS(NEWCOL, TABSTOPS)  then
          PUT(TAB);
          COL := NEWCOL;
        end if;
      end loop;
      while COL < NEWCOL  loop
        PUT(BLANK);
        COL := COL + 1;
      end loop;
      if C /= ENDFILE  then
        PUT(C);
        if C = NEWLINE  then
          COL := 1;
        else
          COL := COL + 1;
        end if;
      end if;
      exit when C = ENDFILE;
    end loop;
  exception
    when END_ERROR  =>
    null;              --      When system EOF finish and exit
  when others  =>
    null;
  end ENTAB;

  function MAX(X, Y : INTEGER) return INTEGER is
  --  2.2  compute maximum of two integers
  begin
    if X > Y  then
      return X;
    else
      return Y;
    end if;
  end MAX;

  procedure OVERSTRIKE is
  --  2.2  convert into multiple lines
    SKIP   : constant CHARACTER := BLANK;
    NOSKIP : constant CHARACTER := '+';

    C : CHARACTER;
    COL, NEWCOL : INTEGER := 1;
    I : INTEGER;

  begin
    loop
      NEWCOL := COL;
      loop                            --  eat backspace
        GETC(C);
        exit when C /= BACKSPACE;
        NEWCOL := MAX(NEWCOL - 1, 1);
      end loop;
      if NEWCOL < COL  then
        NEW_LINE;
        PUT(NOSKIP);                  --  start overstrike line
        for I in 1..NEWCOL-1  loop
          PUT(BLANK);
        end loop;
        COL := NEWCOL;
      elsif COL = 1  and  C /= ENDFILE  then
        PUT(SKIP);                    --  normal line
      end if;
      if C /= ENDFILE  then
        PUT(C);
        if C = NEWLINE  then
          COL := 1;
        else
          COL := COL + 1;
        end if;
      end if;
      exit when C = ENDFILE;
    end loop;
  exception
    when END_ERROR  =>
    null;              --      When system EOF finish and exit
  when others  =>
    null;
  end OVERSTRIKE;


  function MIN(X, Y : INTEGER) return INTEGER is
  --  2.3  compute minimum of two integers
  begin
    if X < Y  then
      return X;
    else
      return Y;
    end if;
  end MIN;

  procedure PUTREP(N : in INTEGER; C : in CHARACTER) is
  --  2.3  put out representation of run of n 'C's
    MAXREP : constant INTEGER := 26;         --  assumimg 'A'..'Z'
    THRESH : constant INTEGER := 4;
    M : INTEGER;
  begin
    M := N;
    while M >= THRESH  or  (C = WARNING and M > 0)  loop
      PUT(WARNING);
      PUT(CHARACTER'VAL(MIN(N, MAXREP) - 1 + CHARACTER'POS('A')));
      PUT(C);
      M := M - MAXREP;
    end loop;
    for I in REVERSE 1..M  loop
      PUT(C);
    end loop;
  end PUTREP;

  procedure COMPRESS is
  --  2.3  compress standard input
    C, LASTC : CHARACTER;
    N : INTEGER := 1;
  begin
    GETC(LASTC);
    while LASTC /= ENDFILE  loop
      GETC(C);
      if C = ENDFILE  then
        if N > 1  or LASTC = WARNING  then
          PUTREP(N, LASTC);
          N := 1;
        else
          PUT(LASTC);
        end if;
      elsif C = LASTC  then
        N := N + 1;
      elsif N > 1  or LASTC = WARNING  then
        PUTREP(N, LASTC);
        N := 1;
      else
        PUT(LASTC);
      end if;
      LASTC := C;
    end loop;
  exception
    when END_ERROR  =>
      null;              --      When system EOF finish and exit
      if N > 1  or LASTC = WARNING  then
        PUTREP(N, LASTC);
        N := 1;
      else
        PUT(LASTC);
      end if;
    when others  =>
      null;
  end COMPRESS;

  function ISUPPER(C : CHARACTER) return BOOLEAN is
  --  2.4  true if C is upper case letter
  begin
    return C in 'A'..'Z';
  end ISUPPER;

  procedure EXPAND is
  --  2.4  uncompress standard input
    C : CHARACTER;
    N : INTEGER;
  begin
    loop
      GETC(C);
      exit when C = ENDFILE;
      if C /= WARNING  then
        PUT(C);
      else
        GET(C);
        if ISUPPER(C)  then
          N := CHARACTER'POS(C) - CHARACTER'POS('A') + 1;
          GET(C);
          if C /= ENDFILE  then
            for I in reverse 1..N  loop
              PUT(C);
            end loop;
          else
            PUT(WARNING);
            PUT(CHARACTER'VAL(N - 1 + CHARACTER'POS('A')));
          end if;
        else
          PUT(WARNING);
          if C /= ENDFILE  then
            PUT(C);
          end if;
        end if;
      end if;
    end loop;
  exception
    when END_ERROR  =>
    null;              --      When system EOF finish and exit
    PUT(ENDFILE);                --  I think it needs this one
  when others  =>
    null;
  end EXPAND;

  procedure GETARG(N : in INTEGER;
              ARGSTR : out STRING;
              MAX_OF : in INTEGER) is
  begin
    if N > NUMBER_OF_ARGUMENTS  then
      --GETARG_OK := FALSE;      --########################################
      ARGSTR(1) := ENDSTR;
    else
      --GETARG_OK := TRUE;
      ARGSTR := ARGUMENTS(N);
    end if;
    return;
  end GETARG;

  function LENGTH(S : STRING) return INTEGER is
  --  2.5  compute length of string
  --  A bit different from the Pascal in initialization and return lines
    N : INTEGER := 0;
  begin
    for I in 1..MAXSTR  loop
      exit when S(I) = ENDSTR;
      N := N + 1;
    end loop;
    return N;
  end LENGTH;

  procedure ECHO is
  --  2.5  echo command line arguments to output
    I : INTEGER := 1;
    ARGSTR : STRING(1..MAXSTR);
  begin
    loop
      GETARG(I, ARGSTR, MAXSTR);
      if I > 1  then
        PUT(BLANK);
      end if;
      for J in 1..LENGTH(ARGSTR)  loop
        PUT(ARGSTR(J));
      end loop;
      I := I + 1;
    end loop;
  exception
    when GETARG_ERROR  =>
      if  I > 1  then
        NEW_LINE;
      end if;
  end ECHO;

    procedure CONVERT_ESCAPED(S : in STRING;
                            I : in out INTEGER;
                 ESCAPED_CHAR : out CHARACTER) is
--  2.6  map S(I) into escaped character, increment I
  --  this procedure is substituted for the equivalent SOFTWARE TOOLS function
  --  since Ada will not abide side effect of an in out parameter in function
  --  further it prepares for a wide range of escaped characters
    --ESCAPED : array(CHARACTER range 'A'..'z') of CHARACTER :=
         --('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
      --NEWLINE, 'O', 'P', 'Q', 'R', 'S', TAB, 'U', 'V', 'W', 'X', 'Y', 'Z',
          --'[', '\', ']', '^', '_', '|',
          --'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
      --NEWLINE, 'o', 'p', 'q', 'r', 's', TAB, 'u', 'v', 'w', 'x', 'y', 'z');
  --  Put in to simulate the character array that is not yet implemented
  function ESCAPED(C : in CHARACTER) return CHARACTER is
    Q : CHARACTER;
  begin
    Q := C;
    if (C = 'N') or (C = 'n')  then
      return NEWLINE;
    elsif (C = 'T') or (C = 't')  then
      return TAB;
    else
      return Q;
    end if;
  end ESCAPED;

  begin
    if S(I) /= ESCAPE  then
     ESCAPED_CHAR := S(I);
    elsif S(I+1) = ENDSTR  then              --  ESCAPE not special at end
     ESCAPED_CHAR := ESCAPE;
    else
      I := I + 1;
     ESCAPED_CHAR := ESCAPED(S(I));
    end if;
  end CONVERT_ESCAPED;

  function ISALPHANUM(C : CHARACTER) return BOOLEAN is
  --  2.6 if C is letter or digit
  begin
    return (C in 'A'..'Z') or (C in 'a'..'z') or (C in '0'..'9');
  end ISALPHANUM;

  procedure ADDSTR(C : in CHARACTER;
              OUTSET : in out STRING;
                   J : in out INTEGER;
              MAX_OF : in INTEGER) is
  --  2.6  put C in OUTSET(J) if it fits, increment J
  --  substituted a procedure for the SOFTWARE TOOLS function
  begin
    if J > MAX_OF  then
      --ADDSTR_OK := FALSE;  --####################################
      return;
    else
      OUTSET(J) := C;
      J := J + 1;
      --ADDSTR_OK := TRUE;   --#####################################
    end if;
  end ADDSTR;

  procedure DODASH(DELIM : in CHARACTER;
                     SRC : in STRING;
                       I : in out INTEGER;
                    DEST : in out STRING;
                       J : in out INTEGER;
                  MAX_OF : in INTEGER) is
  --  2.6  expand set at SRC(I) into DEST(J), stop at DELIM
    K : CHARACTER;
  begin
    while (SRC(I) /= DELIM) and (SRC(I) /= ENDSTR)  loop
      if SRC(I) = ESCAPE  then
        CONVERT_ESCAPED(SRC, I, ESCAPED_CHAR);
        ADDSTR(ESCAPED_CHAR, DEST, J, MAXSET);
      elsif SRC(I) /= DASH  then
        ADDSTR(SRC(I), DEST, J, MAXSET);
      elsif J <= 1  or  SRC(I+1) = ENDSTR  then
        ADDSTR(DASH, DEST, J, MAXSET);       --  literal -
      elsif ISALPHANUM(SRC(I-1)) and ISALPHANUM(SRC(I+1)) and
                     SRC(I-1) <= SRC(I+1)  then
        for K in CHARACTER'VAL(CHARACTER'POS(SRC(I-1)) + 1)..SRC(I+1)  loop
          ADDSTR(K, DEST, J, MAXSET);
        end loop;
        I := I + 1;
      else
        ADDSTR(DASH, DEST, J, MAXSET);
      end if;
      I := I + 1;
    end loop;
  end DODASH;

  procedure MAKESET(INSET : in STRING;
                        K : in out INTEGER;
                   OUTSET : in out STRING;
                   MAX_OF : in INTEGER) is
  --  2.6  make set from INSET(K) in OUTSET
  --  procedure rather than function
    J : INTEGER := 1;
  begin
    DODASH(ENDSTR, INSET, K, OUTSET, J, MAXSET);
    ADDSTR(ENDSTR, OUTSET, J, MAXSET);
  exception
    when ADDSTR_ERROR  =>
      raise MAKESET_ERROR;
  end MAKESET;

  function INDEX(S : STRING; C : CHARACTER) return INTEGER is
  --  2.6  find position of  character C in string S
    I : INTEGER := 1;
  begin
    while S(I) /= C  and  S(I) /= ENDSTR  loop
      I := I + 1;
    end loop;
    if S(I) = ENDSTR  then
      return 0;
    else
      return I;
    end if;
  end INDEX;

  function XINDEX(INSET : STRING; C : CHARACTER;
                  ALLBUT : BOOLEAN; LASTTO : INTEGER) return INTEGER is
  --  2.6  conditionally invert value from index
  begin
    if C = ENDFILE  then
      return 0;
    elsif not ALLBUT  then
      return INDEX(INSET, C);
    elsif INDEX(INSET, C) > 0  then
      return 0;
    else
      return LASTTO + 1;
    end if;
  end XINDEX;

  procedure TRANSLIT is
  --  2.6  map characters
    ARGSTR, FROMSET, TOSET : STRING(1..MAXSTR);
    C : CHARACTER;
    I, K, LASTTO : INTEGER;
    ALLBUT, SQUASH : BOOLEAN;
  begin

    GETARG_FROMSET:
      begin
        GETARG(1, ARGSTR, MAXSTR);
      exception
        when GETARG_ERROR  =>
          ERROR("usage: translit from to");
          raise TRANSLIT_ERROR;
      end GETARG_FROMSET;

    ALLBUT := (ARGSTR(1) = NEGATE);
    if ALLBUT  then
      I := 2;
    else
      I := 1;
    end if;

    MAKE_FROMSET:
      begin
        MAKESET(ARGSTR, I, FROMSET, MAXSTR);
      exception
        when MAKESET_ERROR  =>
          ERROR("translit: from set too large");
          raise TRANSLIT_ERROR;
    end MAKE_FROMSET;

    GETARG_TOSET:
      begin
        GETARG(2, ARGSTR, MAXSTR);
          K := 1;                          --  Dummy to MAKESET 1

          MAKE_TOSET:
            begin
              MAKESET(ARGSTR, K, TOSET, MAXSTR);
            exception
              when MAKESET_ERROR  =>
                ERROR("translit: to set too large");
                raise TRANSLIT_ERROR;
            end MAKE_TOSET;

          if  LENGTH(FROMSET) < LENGTH(TOSET)  then
            ERROR("translit: from shorter than to");
            raise TRANSLIT_ERROR;
          end if;
      exception
        when GETARG_ERROR  =>
        TOSET(1) := ENDSTR;
      end GETARG_TOSET;


    LASTTO := LENGTH(TOSET);
    SQUASH := (LENGTH(FROMSET) > LASTTO) or ALLBUT;
    loop
      GETC(C);
      I := XINDEX(FROMSET, C, ALLBUT, LASTTO);
      if SQUASH and (I >= LASTTO) and (LASTTO > 0)  then
        PUT(TOSET(LASTTO));
        loop
          GETC(C);
          I := XINDEX(FROMSET, C, ALLBUT, LASTTO);
          exit when I < LASTTO;
        end loop;
      end if;
      if C /= ENDFILE  then
        if (I > 0) and (LASTTO > 0)  then                     --  translate
          PUT(TOSET(I));
        elsif I = 0  then                                     --  copy
          PUT(C);
        end if;
      end if;
      exit when C = ENDFILE;
    end loop;
  exception
  when TRANSLIT_ERROR  =>
    PUT("TRANSLIT ERROR");
    return;
  when END_ERROR  =>
    return;
  end TRANSLIT;

begin
  null;
end CHAPTER_2;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--cli2.txt
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO; use TEXT_IO;
with CHAPTER_1; use CHAPTER_1;
with CHAPTER_2; use CHAPTER_2;
procedure CLI_2 is

  type COMMAND_TYPE is (COPY, CHARCOUNT, LINECOUNT, WORDCOUNT, DETAB,
                        ENTAB, OVERSTRIKE, COMPRESS, EXPAND, TRANSLIT,
                        QUIT, QUERY, UNKNOWN, REFUSED, ABORTING);
  COMMAND : COMMAND_TYPE;
  COMMAND_LINE : STRING(1..MAXLINE);
  UNKNOWN_COUNT : INTEGER := 0;
  TRYING_AGAIN : BOOLEAN := FALSE;

  function CONVERT_TO_UPPER_CASE(C : CHARACTER) return CHARACTER is
  --UPPER_CASE : array(CHARACTER range 'a'..'z') of CHARACTER
            --:= ('A','B','C','D','E','F','G','H','I','J','K','L','M',
                --'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
    function UPPER_CASE(C : CHARACTER) return CHARACTER is
    begin
      if C in 'a'..'z'  then
        return CHARACTER'VAL(CHARACTER'POS(C) - 32);
      else
        return C;
      end if;
    end UPPER_CASE;
begin
  if C in 'a'..'z'  then
    return UPPER_CASE(C);
  else
    return C;
  end if;
end CONVERT_TO_UPPER_CASE;

function CONVERT_TO_UPPER_CASE(S : STRING) return STRING is
  T : STRING(S'FIRST..S'LAST);
begin
  for I in S'RANGE  loop
    T(I) := CONVERT_TO_UPPER_CASE(S(I));
  end loop;
  return T;
end CONVERT_TO_UPPER_CASE;



  procedure PUT_OUT(LINE : in STRING) is
  --  Always have the PUT before the GET if possible so you can use it
  --  in diagnostics in developing the GET if necessary
  begin
    for I in 1..MAXLINE  loop
      if LINE(I) = ENDLINE  then
        NEW_LINE;
        exit;
      else
        PUT(LINE(I));
      end if;
    end loop;
  end PUT_OUT;


procedure GET_COMMAND_LINE(COMMAND_LINE : out STRING) is
    C : CHARACTER := ' ';
    LINE_LENGTH : INTEGER := MAXLINE;
  begin
    GET_LINE(COMMAND_LINE, LINE_LENGTH);
    COMMAND_LINE(LINE_LENGTH + 1) := ENDLINE;
  exception
    when others  =>
      null;
  end GET_COMMAND_LINE;

  function IS_ARGUMENT_SEPARATOR(C : CHARACTER) return BOOLEAN is
  begin
    return  C = BLANK
        or  C = TAB
        or  C = LF
        or  C = '('
        or  C = ','
        or  C = '/';
  end IS_ARGUMENT_SEPARATOR;

  function IS_ARGUMENT_TERMINATOR(C : CHARACTER) return BOOLEAN is
  begin
    return  C = ENDSTR
        or  C = NEWLINE
        or  C = ')'
        or  C = ';';
  end IS_ARGUMENT_TERMINATOR;

  procedure GET_ARGUMENTS(S : in STRING; I : in INTEGER) is
    N : INTEGER := 0;
    J : INTEGER := 1;
    K : INTEGER := 1;
    QUOTE : BOOLEAN := FALSE;
  begin
    J := I;
    while ( not IS_ARGUMENT_SEPARATOR(S(J)) )
      and ( not IS_ARGUMENT_TERMINATOR(S(J)) )  loop
      J := J + 1;                            --  eat rest of the command
    end loop;
    while not IS_ARGUMENT_TERMINATOR(S(J))  loop
      N := N + 1;
      while S(J) = BLANK  or  S(J) = TAB  loop
        J := J + 1;                          --  eat blanks
      end loop;
      K := 1;
      while ( ( not IS_ARGUMENT_SEPARATOR(S(J)) )
          and ( not IS_ARGUMENT_TERMINATOR(S(J)) ) )
          or QUOTE  loop
        if not QUOTE and S(J) = '"'  then
          QUOTE := TRUE;
        elsif QUOTE and S(J) = '"'  then
          QUOTE := FALSE;
        else
          ARGUMENTS(N)(K) := S(J);
          K := K + 1;
        end if;
        J := J + 1;
      end loop;
      ARGUMENTS(N)(K) := ENDSTR;
    end loop;
    NUMBER_OF_ARGUMENTS := N;
    return;
  end GET_ARGUMENTS;

  procedure PUT_ARGUMENTS is
  begin
    for N in 1..NUMBER_OF_ARGUMENTS  loop
      for K in 1..MAXSTR  loop
        exit when ARGUMENTS(N)(K) = ENDSTR;
        PUT(ARGUMENTS(N)(K));
      end loop;
      exit when N = NUMBER_OF_ARGUMENTS;  --  So you dont finish on a comma
      PUT(""", """);                      --  Only string arguments so far
    end loop;
    return;
  end PUT_ARGUMENTS;

  procedure PARSE_2(COMMAND_LINE : in STRING;
                         COMMAND : out COMMAND_TYPE) is
    CONFIRMATION : STRING(1..MAXLINE);
    CONFIRMATION_LENGTH : NATURAL := 0;
    I : INTEGER;

    procedure LIST_COMMANDS is
    begin
      PUT("COMMANDS ARE -- COPY, CHARCOUNT, LINECOUNT, WORDCOUNT, DETAB,");
      NEW_LINE;
      PUT("                ENTAB, OVERSTRIKE, COMPRESS, EXPAND, TRANSLIT,");
      NEW_LINE;
      PUT("                QUIT"); NEW_LINE;
    end LIST_COMMANDS;

  begin
    NEW_LINE;
    I := 0;
    loop
      I := I + 1;
      if I = MAXLINE  then
        COMMAND := UNKNOWN;
        UNKNOWN_COUNT := UNKNOWN_COUNT + 1;
        return;
      end if;
      if COMMAND_LINE(I) /= BLANK  then      --  Eat blanks
        if CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+2)) = "COP"  then
          COMMAND := COPY;
          PUT("COPY;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+1)) = "CH"  then
          COMMAND := CHARCOUNT;
          PUT("CHARCOUNT;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+1)) = "LI"  then
          COMMAND := LINECOUNT;
          PUT("LINECOUNT;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+1)) = "WO"  then
          COMMAND := WORDCOUNT;
          PUT("WORDCOUNT;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+1)) = "DE"  then
          COMMAND := DETAB;
          PUT("DETAB;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+1)) = "DE"  then
          COMMAND := DETAB;
          PUT("DETAB;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+1)) = "EN"  then
          COMMAND := ENTAB;
          PUT("ENTAB;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+1)) = "OV"  then
          COMMAND := OVERSTRIKE;
          PUT("OVERSTRIKE;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+2)) = "COM"  then
          COMMAND := COMPRESS;
          PUT("COMPRESS;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+2)) = "EXP"  then
          COMMAND := EXPAND;
          PUT("EXPAND;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+1)) = "TR"  then
          COMMAND := TRANSLIT;
          GET_ARGUMENTS(COMMAND_LINE, I+2);
          PUT("TRANSLIT(""");                 --  Only string arguments so far
          PUT_ARGUMENTS;
          PUT(""");  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I  )) = "Q"  then
          COMMAND := QUIT;
          PUT("QUIT;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I+2)) = "EXI"  then
          COMMAND := QUIT;
          PUT("QUIT;  [Confirm with CR] -->");
        elsif CONVERT_TO_UPPER_CASE(COMMAND_LINE(I..I  )) = "?"  then
          COMMAND := QUERY;
          LIST_COMMANDS;
          return;
        else
          COMMAND := UNKNOWN;
          PUT("COMMAND NOT RECOGNIZED ");
          NEW_LINE;
          UNKNOWN_COUNT := UNKNOWN_COUNT + 1;
          if UNKNOWN_COUNT < 3  then
            PUT("TRY AGAIN "); NEW_LINE;
            return;
          end if;
        end if;
        exit;
      end if;
    end loop;

    if UNKNOWN_COUNT >= 3  then
      if TRYING_AGAIN = FALSE  then
        PUT("YOU ARE NOT MAKING IT"); NEW_LINE;
        LIST_COMMANDS;
        COMMAND := UNKNOWN;
        UNKNOWN_COUNT := 0;
        TRYING_AGAIN := TRUE;
        return;
      else
        PUT("THREE FAILURES IN A ROW  -- AGAIN --  ABORTING CLI_1 ");
        COMMAND := ABORTING;
        return;
      end if;
    end if;

    GET_LINE(CONFIRMATION, CONFIRMATION_LENGTH);
    if CONFIRMATION_LENGTH /= 0  then        --  Just a CR gives no LENGTH
      COMMAND := REFUSED;
      UNKNOWN_COUNT := UNKNOWN_COUNT + 1;
      PUT("?"); NEW_LINE;
    else
      PUT("CONFIRMED!"); NEW_LINE;
      UNKNOWN_COUNT := 0;
      TRYING_AGAIN := FALSE;
    end if;
    return;

  end PARSE_2;


begin
  loop
    NEW_LINE;
    PUT("CLI_2 -->");
    GET_COMMAND_LINE(COMMAND_LINE);
    PARSE_2(COMMAND_LINE, COMMAND);
    case COMMAND is
    when COPY         =>  CHAPTER_1.COPY;
    when CHARCOUNT    =>  CHAPTER_1.CHARCOUNT;
    when LINECOUNT    =>  CHAPTER_1.LINECOUNT;
    when WORDCOUNT    =>  CHAPTER_1.WORDCOUNT;
    when DETAB        =>  CHAPTER_1.DETAB;
    when ENTAB        =>  CHAPTER_2.ENTAB;
    when OVERSTRIKE   =>  CHAPTER_2.OVERSTRIKE;
    when COMPRESS     =>  CHAPTER_2.COMPRESS;
    when EXPAND       =>  CHAPTER_2.EXPAND;
    when TRANSLIT     =>  CHAPTER_2.TRANSLIT;
    when QUIT         =>  exit;
    when QUERY        =>  null;
    when UNKNOWN      =>  null;
    when REFUSED      =>  null;
    when ABORTING     =>  exit;
    end case;
  end loop;
  PUT("QUIT CLI_2");
  NEW_LINE;

end CLI_2;