with Text_Io;
use Text_Io;
with String_Pkg;
with String_Scanner;
----------------------------------------------------------------

package body Command_Line_Interface is
    --| Provides primitives for getting at the command line arguments.

    --| Overview

    package Sp renames String_Pkg;
    package Ss renames String_Scanner;

    type Name_Value is
    --| Name/Value pair
        record
            Name : Sp.String_Type;  --| Name of value
            Value : Sp.String_Type;  --| Value associated with name
            Was_Retrieved : Boolean :=
               False;  --| Flag indicating whether name-value
        end record;
    --  association has been retrieved by tool

    type Token_Type is (Ada_Id, Word, Bound_To, None);

    package Token_Type_Io is new Enumeration_Io (Token_Type);
    use Token_Type_Io;

    Argument_String : String (1 .. 132);
    Blanks : String (1 .. 132) := (others => ' ');
    N_Arg_Count : Argument_Count;  --| Count of named args
    P_Arg_Count : Argument_Count;  --| Count of positional args
    Rejected : Boolean := False;

    Named_Args : array (Argument_Index) of Name_Value;

    Positional_Args : array (Argument_Index) of Sp.String_Type;

    ----------------------------------------------------------------

    -- Local functions:

    procedure Get_Token (Scan_String : in out Ss.Scanner;
                         Argument : in out Sp.String_Type;
                         Kind : in out Token_Type) is

        Last_Arg : Sp.String_Type;
        Last_Kind : Token_Type;
        Found : Boolean;
        Delimeter : Sp.String_Type;
        Delim_String : Ss.Scanner;
        More_Commas : Boolean := False;
        Tail : Sp.String_Type;

    begin

        if Rejected then
            Argument := Last_Arg;
            Kind := Last_Kind;
            Rejected := False;
        else
            if Ss.Is_Sequence (" ,", Scan_String) then
                Ss.Scan_Sequence (" ,", Scan_String, Found, Delimeter);
                Delim_String := Ss.Make_Scanner (Delimeter);
                loop
                    Ss.Skip_Space (Delim_String);
                    exit when not Ss.More (Delim_String);
                    Ss.Forward (Delim_String);
                    if More_Commas then
                        raise Missing_Positional_Arg;
                    end if;
                    More_Commas := True;
                end loop;
            end if;
            if Ss.Is_Ada_Id (Scan_String) then
                Ss.Scan_Ada_Id (Scan_String, Found, Argument);
                if Ss.Is_Literal ("=>", Scan_String) or
                   Ss.Is_Literal ("""", Scan_String) or
                   Ss.Is_Sequence (" ,", Scan_String) or
                   not Ss.More (Scan_String) then
                    Kind := Ada_Id;
                else
                    if Ss.Is_Not_Sequence (" ,", Scan_String) then
                        Ss.Scan_Not_Sequence (" ,", Scan_String, Found, Tail);
                        Argument := Sp."&" (Argument, Tail);
                        Kind := Word;
                    else
                        Ss.Scan_Word (Scan_String, Found, Tail);
                        Argument := Sp."&" (Argument, Tail);
                        Kind := Word;
                    end if;
                end if;
            elsif Ss.Is_Literal ("=>", Scan_String) then
                Ss.Scan_Literal ("=>", Scan_String, Found);
                Argument := Sp.Create ("=>");
                Kind := Bound_To;
            elsif Ss.Is_Quoted (Scan_String) then
                Ss.Scan_Quoted (Scan_String, Found, Argument);
                Kind := Word;
            elsif Ss.Is_Enclosed ('(', ')', Scan_String) then
                Ss.Scan_Enclosed ('(', ')', Scan_String, Found, Argument);
                Kind := Word;
            elsif Ss.Is_Not_Sequence (" ,", Scan_String) then
                Ss.Scan_Not_Sequence (" ,", Scan_String, Found, Argument);
                Kind := Word;
            elsif Ss.Is_Word (Scan_String) then
                Ss.Scan_Word (Scan_String, Found, Argument);
                Kind := Word;
            else
                Argument := Sp.Create ("");
                Kind := None;
            end if;
            Last_Kind := Kind;
            Last_Arg := Argument;
        end if;
    end Get_Token;

    -----------------------------------------------------------------------

    procedure Save_Named (Name : in Sp.String_Type;
                          Value : in Sp.String_Type) is

    begin
        N_Arg_Count := N_Arg_Count + 1;
        Named_Args (N_Arg_Count).Name := Name;
        Named_Args (N_Arg_Count).Value := Value;
    end Save_Named;

    procedure Save_Positional (Value : in Sp.String_Type) is

    begin
        if N_Arg_Count > 0 then
            raise Invalid_Parameter_Order;
        end if;
        P_Arg_Count := P_Arg_Count + 1;
        Positional_Args (P_Arg_Count) := Value;
    end Save_Positional;

    procedure Reject_Token is

    begin
        Rejected := True;
    end Reject_Token;

    ----------------------------------------------------------------

    procedure Initialize (Arg_String : in String) is

    begin

        declare

            type State_Type is (Have_Nothing, Have_Ada_Id, Have_Bound_To);

            Index : Integer;  --| Index of characters in argument string
            Scan_String : Ss.Scanner;  --| Scanned argument string
            Argument :
               Sp.String_Type;  --| Argument scanned from argument string
            Kind : Token_Type;  --| Kind of argument- WORD, =>, Ada_ID
            Old_Arg : Sp.String_Type;  --| Previously scanned argument
            Found : Boolean;

            State : State_Type := Have_Nothing;
            --| State of argument in decision tree

        begin

            Index := Arg_String'First;
            N_Arg_Count := 0;
            P_Arg_Count := 0;

            -- Remove trailing blanks and final semicolon
            for I in reverse Arg_String'Range loop
                if Arg_String (I) /= ' ' then
                    if Arg_String (I) = ';' then
                        Index := I - 1;
                    else
                        Index := I;
                    end if;
                    exit;
                end if;
            end loop;

            -- Convert argument string to scanner and remove enclosing parantheses
            Scan_String := Ss.Make_Scanner
                              (Sp.Create (Arg_String
                                             (Arg_String'First .. Index)));
            if Ss.Is_Enclosed ('(', ')', Scan_String) then
                Ss.Mark (Scan_String);
                Ss.Scan_Enclosed ('(', ')', Scan_String, Found, Argument);
                Ss.Skip_Space (Scan_String);
                if not Ss.More (Scan_String) then
                    Ss.Destroy_Scanner (Scan_String);
                    Scan_String := Ss.Make_Scanner (Argument);
                else
                    Ss.Restore (Scan_String);
                end if;
            end if;

            -- Parse argument string and save arguments
            loop
                Get_Token (Scan_String, Argument, Kind);
                case State is
                    when Have_Nothing =>
                        case Kind is
                            when Ada_Id =>
                                Old_Arg := Argument;
                                State := Have_Ada_Id;
                            when Word =>
                                Save_Positional (Argument);
                                State := Have_Nothing;
                            when Bound_To =>
                                State := Have_Nothing;
                                raise Invalid_Named_Association;
                            when None =>
                                null;
                        end case;
                    when Have_Ada_Id =>
                        case Kind is
                            when Ada_Id =>
                                Save_Positional (Old_Arg);
                                Old_Arg := Argument;
                                State := Have_Ada_Id;
                            when Word =>
                                Save_Positional (Old_Arg);
                                Save_Positional (Argument);
                                State := Have_Nothing;
                            when Bound_To =>
                                State := Have_Bound_To;
                            when None =>
                                Save_Positional (Old_Arg);
                        end case;
                    when Have_Bound_To =>
                        case Kind is
                            when Ada_Id | Word =>
                                Save_Named (Old_Arg, Argument);
                                State := Have_Nothing;
                            when Bound_To =>
                                State := Have_Bound_To;
                                raise Invalid_Named_Association;
                            when None =>
                                raise Invalid_Named_Association;

                        end case;
                end case;
                exit when Kind = None;
            end loop;
        end;
        Argument_String (1 .. Arg_String'Length) := Arg_String;
        Argument_String (Arg_String'Length + 1 .. 132) :=
           Blanks (Arg_String'Length + 1 .. 132);
    end Initialize;

    --------------------------------------------------------------------------

    function Named_Arg_Count --| Return number of named arguments
                return Argument_Count is

    begin
        return N_Arg_Count;
    end Named_Arg_Count;

    ----------------------------------------------------------------

    function Positional_Arg_Count --| Return number of positional arguments
                return Argument_Count is

    begin
        return P_Arg_Count;
    end Positional_Arg_Count;

    ----------------------------------------------------------------

    function Positional_Arg_Value ( --| Return an argument value
                                   N : in Argument_Index
                                   --| Position of desired argument
                                   ) return String is
        --| Raises: no_arg

        --| Effects: Return the Nth argument.  If there is no argument at
        --| position N, no_arg is raised.

        --| N/A: modifies, errors

    begin
        if N > P_Arg_Count then
            raise No_Arg;
        else
            return Sp.Value (Positional_Args (N));
        end if;
    end Positional_Arg_Value;

    ----------------------------------------------------------------

    function Positional_Arg_Value ( --| Return an argument value
                                   N : in Argument_Index
                                   --| Position of desired argument
                                   ) return Sp.String_Type is
        --| Raises: no_arg

        --| Effects: Return the Nth argument.  If there is no argument at
        --| position N, no_arg is raised.

        --| N/A: modifies, errors

    begin
        if N > P_Arg_Count then
            raise No_Arg;
        else
            return Positional_Args (N);
        end if;
    end Positional_Arg_Value;

    ----------------------------------------------------------------

    procedure Named_Arg_Value ( --| Return a named argument value
                               Name : in String;
                               Found : out Boolean;
                               Arg_Value : out String) is

        --| Effects: Return the value associated with Name on the command
        --| line.
        Found_Flag : Boolean := False;

    begin
        for I in 1 .. N_Arg_Count loop
            if Sp.Equal (Sp.Upper (Named_Args (I).Name),
                         Sp.Upper (Sp.Create (Name))) then
                Named_Args (I).Was_Retrieved := True;
                Arg_Value := Sp.Value (Named_Args (I).Value);
                Found_Flag := True;
                exit;
            end if;
        end loop;
        if Found_Flag = False then
            Arg_Value := "   ";
        end if;
        Found := Found_Flag;
    end Named_Arg_Value;
    ----------------------------------------------------------------

    procedure Named_Arg_Value ( --| Return a named argument value
                               Name : in String;
                               Found : out Boolean;
                               Arg_Value : out Sp.String_Type) is

        --| Effects: Return the value associated with Name on the command
        --| line.  If there was none, return Default.


    begin
        Found := False;
        for I in 1 .. N_Arg_Count loop
            if Sp.Equal (Sp.Upper (Named_Args (I).Name),
                         Sp.Upper (Sp.Create (Name))) then
                Named_Args (I).Was_Retrieved := True;
                Arg_Value := Named_Args (I).Value;
                Found := True;
                exit;
            end if;
        end loop;
    end Named_Arg_Value;

    ----------------------------------------------------------------

    function Arguments --| Return the entire argument string
                return String is

        --| Effects: Return the entire command line, except for the name
        --| of the command itself.

    begin
        return Argument_String;
    end Arguments;
    ----------------------------------------------------------------

    procedure Finalize is
        --| Raises: unreferenced_named_arg

    begin
        for I in 1 .. Named_Arg_Count loop
            if Named_Args (I).Was_Retrieved = False then
                raise Unreferenced_Named_Arg;
            end if;
        end loop;
    end Finalize;

    -------------------------------------------------------------------

end Command_Line_Interface;