|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 13880 (0x3638)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
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;