--::::::::::
--cli.cmm
--::::::::::

 
     
                     Comments on Porting
             Command Language Interpreter (CLI)
                        by WIS JPMO
                         to DEC Ada
    
                                                             Tool 34  
                                                             August 2, 1985
     
COMPILATION
-----------
  A VMS command file was created from the ordered list of compilation
  units provided in CLISRC.DIS.
     
  We were able to recompile the Command Language Interpreter with only
  minor changes in two files.  Errors occured because the generic 
  instantiation of package INTEGER_IO was needed, but had been 
  commented out of the code.  This comment notation was removed.  
  Additionally, the parameter "C" in the procedure GETC had to be 
  changed to mode "in out" from mode "out", so that a necessary assignment 
  could be made to "C".
     


EXECUTION
---------
  We were able to link CLI_2 without any problems.  Although no
  Users Manual was provided, the code stated that the Command
  Language Interpreter (CLI) implements the tools found in
  chapters one and two of "Software Tools in Pascal" by Brian
  W. Kernighan and P. J. Plauger.  The following commands were
  able to be executed by the Command Language Interpreter:
     
  copy            detab            expand
  charcount       entab            translit
  linecount       overstrike       quit
  wordcount       compress
     
  Most of the commands read subsequent text from the terminal
  modifying it in one way or another.  The commands we tried
  worked and would exit as expected, but when the CLI tried to 
  read the next command the end-of-file condition would not be 
  cleared and the CLI would abort with an unhandled exception 
  "END_ERROR".
     


COMMENT
-------
  The CLI is not a generalized command language interpreter.  Rather
  it provides a framework upon which to build a more general CLI.
--::::::::::
--cli.dis
--::::::::::
[whitaker.tools.cli]chpt1.txt
[whitaker.tools.cli]chpt2.txt
[whitaker.tools.cli]cli2.txt
--::::::::::
--cli.pro
--::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : Command Language Interpreter (CLI)
-- Version      : 1.0
-- Author       : WIS JPMO
--              : Washington, D.C.  20330
--              : Contact: Lt. Colonel Falgiano
--              : ESD/SCW
--              : Hanscom AFB, MA  01731
-- DDN Address  :
-- Copyright    : (c) 1985
-- Date created : 1985
-- Release date : 1985
-- Last update  : 1985
-- Machine/System Compiled/Run on:
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     : 
----------------:
--
-- Abstract     : The Command Language Interpreter (CLI)
----------------: implements the tools found in chapters
----------------: one and two of "Software Tools in 
----------------: Pascal" by Brian W. Kernighan and P.J.
----------------: Plauger.  The commands available for 
----------------: execution are: copy, charcount, linecount,
----------------: wordcount, detab, entab, overstrike,
----------------: compress, expand, translit and quit.
----------------: Most of the commands read subsequent 
----------------: text from the terminal modifying it in
----------------: one way or another.
----------------:
----------------: This tool was developed as a precursor for 
----------------: the WMCCS Information System (WIS).  An
----------------: executable version of the tool has been 
----------------: demonstrated.  This source code has sub-
----------------: sequently been recompiled but has not under-
----------------: gone extensive testing.
----------------:
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION AUTHOR                  HISTORY 
-- 1985         1.0     WIS JPMO                Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
-- 
-- This software is copyright by the author.
-- 
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
----------------- Disclaimer ----------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
--
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to 
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this 
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                          -*
----------------- END-PROLOGUE -------------------------------
--::::::::::
--cli.src
--::::::::::
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--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;