Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/C/Applications/GW AdaEd 1.4.2/GWAdaDemos/NYUDemos/CLI.ADA

Text File | 1994-01-09 | 10.4 KB | 297 lines | [TEXT/GADA]

-- **************************************
-- *                                    *
-- * CLI (Command Line Interface)       * SPEC
-- *                                    *
-- **************************************
package CLI is

--| Purpose
--|   CLI is a package which implements a Command
--| Line Interface.  It mirrors the UNIX/C
--| command line interface, providing an argument
--| count and the arguments themselves.
--|
--| Initialization Exceptions (none)
--|
--| Notes
--|   Compiler limit on string length and dynamic memory.
--|   INITIALIZE must be called once, and only once, during
--| the execution of the main Ada proc.
--|
--| Modifications
--|  2/25/88  Richard Conn    Initial Version
--|  5/12/89  Richard Conn    Review and Upgrade
--|  4/11/90  Richard Conn    MIL-HDBK-1804 Annotations and
--|                           Meridian Ada Interface Added

  -- ...................................
  -- .                                 .
  -- . CLI.INITIALIZE                  . SPEC
  -- .                                 .
  -- ...................................
  procedure Initialize (Program_Name        : in STRING;
                        Command_Line_Prompt : in STRING);
  --| Purpose
  --|   Initialize this package.  This routine must be called
  --| before any other routines or objects are called or referenced.
  --|
  --| Exceptions (none)
  --|
  --| Notes
  --|   CALL THIS PROCEDURE ONLY ONE TIME

  -- ...................................
  -- .                                 .
  -- . CLI.ARGC (Argument Count)       . SPEC
  -- .                                 .
  -- ...................................
  function ArgC return NATURAL;
  --| Purpose
  --|   Return the number (1 to N) of command line arguments.
  --| ARGC is at least 1 because the name of the program or
  --| process is always ARGV(0).
  --|
  --| Exceptions (none)
  --| Notes (none)

  -- ...................................
  -- .                                 .
  -- . CLI.ARGV (Argument Value)       . SPEC
  -- .                                 .
  -- ...................................
  function ArgV (Index : in NATURAL) return STRING;
  --| Purpose
  --|   Return the INDEXth (0 <= INDEX < ARGC) command line
  --| argument.  Example: if ARGC = 1, ARGV(0) is the only
  --| valid argument string.  ARGV(0) is always the name of
  --| the program or process.
  --|
  --| Exceptions
  --|   INVALID_INDEX     raised if Index >= ARGC
  --|
  --| Notes (none)

  INVALID_INDEX    : exception;
  UNEXPECTED_ERROR : exception;  -- raised anytime

end CLI;
-- This implementation of Package Body CLI is general-purpose.
-- Using TEXT_IO, it prompts the user for input arguments and
-- accepts these arguments via a GET_LINE call.
with TEXT_IO;
package body CLI is

   LOCAL_ARGC : NATURAL := 0;

   package STRING_LIST is

      NUMBER_OF_STRINGS : NATURAL := 0;

      procedure ADD_TO_LIST (ITEM : in STRING);
      function GET_FROM_LIST (ITEM : in NATURAL) return STRING;

   end STRING_LIST;

   package body STRING_LIST is

      type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
      type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
      type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is
         record
            DS   : STRING (1 .. LENGTH);
            NEXT : DYNAMIC_STRING;
         end record;

      FIRST : DYNAMIC_STRING := null;
      LAST  : DYNAMIC_STRING := null;

      procedure ADD_TO_LIST (ITEM : in STRING) is

         --========================= PDL ===========================
         --|ABSTRACT:
         --|    ADD_TO_LIST adds the ITEM string to the linked list
         --|    of dynamic strings implemented by this package.
         --|DESIGN DESCRIPTION:
         --|    Create new DYNAMIC_STRING_OBJECT of the proper length
         --|    Set DS field of new object to the ITEM string
         --|    Set the NEXT field of the new object to NULL
         --|    If FIRST pointer is null
         --|      Set FIRST and LAST to point to the new object
         --|    Else
         --|      Set LAST.NEXT to point to the new object
         --|      Set LAST to point to the new object
         --|    End if
         --|    Increment NUMBER_OF_STRINGS
         --=========================================================

         TEMP : DYNAMIC_STRING;
      begin
         TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
         TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
         TEMP.NEXT                  := null;
         if FIRST = null then
            FIRST := TEMP;
            LAST  := TEMP;
         else
            LAST.NEXT := TEMP;
            LAST      := TEMP;
         end if;
         NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
      end ADD_TO_LIST;

      function GET_FROM_LIST (ITEM : in NATURAL) return STRING is

         --========================= PDL ===========================
         --|ABSTRACT:
         --|    GET_FROM_LIST returns the ITEM string from the linked list
         --|    of dynamic strings implemented by this package.
         --|DESIGN DESCRIPTION:
         --|    If ITEM > 0
         --|        Advance to desired item
         --|    End If
         --|    Return the DS field of the desired item
         --=========================================================

         ROVER : DYNAMIC_STRING := FIRST;
      begin
         if ITEM > 0 then
            for I in 1 .. ITEM loop
               ROVER := ROVER.NEXT;
            end loop;
         end if;
         return ROVER.DS;
      end GET_FROM_LIST;

   end STRING_LIST;

   procedure INITIALIZE (PROGRAM_NAME        : in STRING;
                         COMMAND_LINE_PROMPT : in STRING) is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    INITIALIZE prompts the user for the command line
      --|    arguments and loads the linked list with them.
      --|DESIGN DESCRIPTION:
      --|    Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|    Set the first list object to PROGRAM_NAME
      --|    Prompt the user with COMMAND_LINE_PROMPT and
      --|      get his response
      --|    Over number of characters in line, loop
      --|        Case CURRENT_STATE
      --|            When LOOKING_FOR_TOKEN
      --|                If character is not white-space
      --|                    Set CURRENT_STATE to IN_TOKEN
      --|                    If character is quote (")
      --|                        Set QUOTED to TRUE
      --|                        Set START to the character's index + 1
      --|                    Else
      --|                        Set QUOTED to FALSE
      --|                        Set START to the character's index
      --|                    End IF
      --|                End If
      --|            When IN_TOKEN
      --|                If QUOTED
      --|                    If character is quote (")
      --|                        Set STOP to the previous character's index
      --|                        Add slice from START to STOP to list
      --|                        Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|                    End If
      --|                ElsIF character is white-space
      --|                    Set STOP to the previous character's index
      --|                    Add slice from START to STOP to list
      --|                    Set CURRENT_STATE to LOOKING_FOR_TOKEN
      --|                End If
      --|        End Case
      --|    End Loop
      --|    If CURRENT_STATE is IN_TOKEN
      --|        Set STOP to the previous character's index
      --|        Add slice from START to STOP to list
      --|    End if
      --|    Set LOCAL_ARGC to NUMBER_OF_STRINGS
      --|    Output NEW_LINE (to reset column count in TEXT_IO)
      --=========================================================

      ARGCOUNT      : NATURAL := 1;
      INLINE        : STRING (1 .. 400);
      LAST          : NATURAL;
      START         : NATURAL;
      STOP          : NATURAL;
      QUOTED        : BOOLEAN;
      type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
      CURRENT_STATE : STATE   := LOOKING_FOR_TOKEN;
   begin
      STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
      TEXT_IO.PUT (COMMAND_LINE_PROMPT);
      TEXT_IO.GET_LINE (INLINE, LAST);
      for I in 1 .. LAST loop
         case CURRENT_STATE is
            when LOOKING_FOR_TOKEN  =>
               if INLINE (I) > ' ' then
                  CURRENT_STATE := IN_TOKEN;
                  if INLINE (I) = '"' then
                     QUOTED := TRUE;
                     START  := I;
                  else
                     QUOTED := FALSE;
                     START  := I;
                  end if;
               end if;
            when IN_TOKEN =>
               if QUOTED then
                  if INLINE (I) = '"' then
                     STOP          := I;
                     STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
                     CURRENT_STATE := LOOKING_FOR_TOKEN;
                  end if;
               elsif INLINE (I) <= ' ' then
                  STOP          := I - 1;
                  STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
                  CURRENT_STATE := LOOKING_FOR_TOKEN;
               end if;
         end case;
      end loop;
      if CURRENT_STATE = IN_TOKEN then
         STOP := LAST;
         STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
      end if;
      LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
      TEXT_IO.NEW_LINE;
   end INITIALIZE;

   function ARGC return NATURAL is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGC returns the argument count.
      --|DESIGN DESCRIPTION:
      --|    Return LOCAL_ARGC
      --=========================================================

   begin
      return LOCAL_ARGC;
   end ARGC;

   function ARGV (INDEX : in NATURAL) return STRING is

      --========================= PDL ===========================
      --|ABSTRACT:
      --|    ARGV returns the indicated argument string.
      --|DESIGN DESCRIPTION:
      --|    If INDEX is out of range, raise INVALID_INDEX
      --|    Return GET_FROM_LIST(INDEX)
      --=========================================================

   begin
      if INDEX >= LOCAL_ARGC then
         raise INVALID_INDEX;
      end if;
      return STRING_LIST.GET_FROM_LIST (INDEX);
   exception
      when INVALID_INDEX  =>
         raise ;
      when others    =>
         raise UNEXPECTED_ERROR;
   end ARGV;

end CLI;