-- --
------------------------------------------------------------------------------
-with Ada.Unchecked_Deallocation;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings.Unbounded;
-
-with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
package body GNAT.Command_Line is
-- Add a new element to Line. If Before is True, the item is inserted at
-- the beginning, else it is appended.
+ procedure Add (Config : in out Command_Line_Configuration;
+ Switch : Switch_Definition);
+ procedure Add (Def : in out Alias_Definitions_List;
+ Alias : Alias_Definition);
+ -- Add a new element to Def.
+
+ procedure Initialize_Switch_Def
+ (Def : out Switch_Definition;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "");
+ -- Initialize [Def] with the contents of the other parameters.
+ -- This also checks consistency of the switch parameters, and will raise
+ -- Invalid_Switch if they do not match.
+
+ procedure Decompose_Switch
+ (Switch : String;
+ Parameter_Type : out Switch_Parameter_Type;
+ Switch_Last : out Integer);
+ -- Given a switch definition ("name:" for instance), extracts the type of
+ -- parameter that is expected, and the name of the switch
+
function Can_Have_Parameter (S : String) return Boolean;
-- True if S can have a parameter
-- Remove any possible trailing '!', ':', '?' and '='
generic
- with procedure Callback (Simple_Switch : String; Parameter : String);
+ with procedure Callback
+ (Simple_Switch : String;
+ Separator : String;
+ Parameter : String;
+ Index : Integer); -- Index in Config.Switches, or -1
procedure For_Each_Simple_Switch
- (Cmd : Command_Line;
+ (Config : Command_Line_Configuration;
+ Section : String;
Switch : String;
Parameter : String := "";
Unalias : Boolean := True);
-- Return True if the characters starting at Index in Type_Str are
-- equivalent to Substring.
+ procedure Foreach_Switch
+ (Config : Command_Line_Configuration;
+ Callback : access function (S : String; Index : Integer) return Boolean;
+ Section : String);
+ -- Iterate over all switches defined in Config, for a specific section.
+ -- Index is set to the index in Config.Switches
+
--------------
-- Argument --
--------------
---------------
function Expansion (Iterator : Expansion_Iterator) return String is
- use GNAT.Directory_Operations;
type Pointer is access all Expansion_Iterator;
It : constant Pointer := Iterator'Unrestricted_Access;
end loop;
end Expansion;
+ ---------------------
+ -- Current_Section --
+ ---------------------
+
+ function Current_Section
+ (Parser : Opt_Parser := Command_Line_Parser) return String is
+ begin
+ if Parser.Current_Section = 1 then
+ return "";
+ end if;
+
+ for Index in reverse 1 .. Integer'Min (Parser.Current_Argument - 1,
+ Parser.Section'Last)
+ loop
+ if Parser.Section (Index) = 0 then
+ return Argument (Parser, Index);
+ end if;
+ end loop;
+
+ return "";
+ end Current_Section;
+
-----------------
-- Full_Switch --
-----------------
return Argument (Parser, Parser.Current_Argument - 1);
end Get_Argument;
+ ----------------------
+ -- Decompose_Switch --
+ ----------------------
+
+ procedure Decompose_Switch
+ (Switch : String;
+ Parameter_Type : out Switch_Parameter_Type;
+ Switch_Last : out Integer)
+ is
+ begin
+ case Switch (Switch'Last) is
+ when ':' =>
+ Parameter_Type := Parameter_With_Optional_Space;
+ Switch_Last := Switch'Last - 1;
+ when '=' =>
+ Parameter_Type := Parameter_With_Space_Or_Equal;
+ Switch_Last := Switch'Last - 1;
+ when '!' =>
+ Parameter_Type := Parameter_No_Space;
+ Switch_Last := Switch'Last - 1;
+ when '?' =>
+ Parameter_Type := Parameter_Optional;
+ Switch_Last := Switch'Last - 1;
+ when others =>
+ Parameter_Type := Parameter_None;
+ Switch_Last := Switch'Last;
+ end case;
+ end Decompose_Switch;
+
----------------------------------
-- Find_Longest_Matching_Switch --
----------------------------------
is
Index : Natural;
Length : Natural := 1;
+ Last : Natural;
P : Switch_Parameter_Type;
begin
Length := Length + 1;
end loop;
+ -- Length now marks the separator after the current switch
+ -- Last will mark the last character of the name of the switch
+
if Length = Index + 1 then
P := Parameter_None;
+ Last := Index;
else
- case Switches (Length - 1) is
- when ':' =>
- P := Parameter_With_Optional_Space;
- Length := Length - 1;
- when '=' =>
- P := Parameter_With_Space_Or_Equal;
- Length := Length - 1;
- when '!' =>
- P := Parameter_No_Space;
- Length := Length - 1;
- when '?' =>
- P := Parameter_Optional;
- Length := Length - 1;
- when others =>
- P := Parameter_None;
- end case;
+ Decompose_Switch (Switches (Index .. Length - 1), P, Last);
end if;
-- If it is the one we searched, it may be a candidate
- if Arg'First + Length - 1 - Index <= Arg'Last
- and then Switches (Index .. Length - 1) =
- Arg (Arg'First .. Arg'First + Length - 1 - Index)
- and then Length - Index > Switch_Length
+ if Arg'First + Last - Index <= Arg'Last
+ and then Switches (Index .. Last) =
+ Arg (Arg'First .. Arg'First + Last - Index)
+ and then Last - Index + 1 > Switch_Length
then
Param := P;
Index_In_Switches := Index;
- Switch_Length := Length - Index;
+ Switch_Length := Last - Index + 1;
end if;
-- Look for the next switch in Switches
(Parser.The_Switch,
Arg_Num => Parser.Current_Argument,
First => Parser.Current_Index,
- Last => End_Index);
+ Last => Arg'Last);
Parser.Current_Index := End_Index + 1;
+
raise Invalid_Switch;
end if;
procedure Define_Alias
(Config : in out Command_Line_Configuration;
Switch : String;
- Expanded : String)
+ Expanded : String;
+ Section : String := "")
is
+ Def : Alias_Definition;
begin
if Config = null then
Config := new Command_Line_Configuration_Record;
end if;
- Add (Config.Aliases, new String'(Switch));
- Add (Config.Expansions, new String'(Expanded));
+ Def.Alias := new String'(Switch);
+ Def.Expansion := new String'(Expanded);
+ Def.Section := new String'(Section);
+ Add (Config.Aliases, Def);
end Define_Alias;
-------------------
Add (Config.Prefixes, new String'(Prefix));
end Define_Prefix;
+ ---------
+ -- Add --
+ ---------
+
+ procedure Add (Config : in out Command_Line_Configuration;
+ Switch : Switch_Definition)
+ is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Switch_Definitions, Switch_Definitions_List);
+ Tmp : Switch_Definitions_List;
+ begin
+ if Config = null then
+ Config := new Command_Line_Configuration_Record;
+ end if;
+
+ Tmp := Config.Switches;
+
+ if Tmp = null then
+ Config.Switches := new Switch_Definitions (1 .. 1);
+ else
+ Config.Switches := new Switch_Definitions (1 .. Tmp'Length + 1);
+ Config.Switches (1 .. Tmp'Length) := Tmp.all;
+ Unchecked_Free (Tmp);
+ end if;
+
+ Config.Switches (Config.Switches'Last) := Switch;
+ end Add;
+
+ ---------
+ -- Add --
+ ---------
+
+ procedure Add (Def : in out Alias_Definitions_List;
+ Alias : Alias_Definition)
+ is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Alias_Definitions, Alias_Definitions_List);
+ Tmp : Alias_Definitions_List := Def;
+ begin
+ if Tmp = null then
+ Def := new Alias_Definitions (1 .. 1);
+ else
+ Def := new Alias_Definitions (1 .. Tmp'Length + 1);
+ Def (1 .. Tmp'Length) := Tmp.all;
+ Unchecked_Free (Tmp);
+ end if;
+
+ Def (Def'Last) := Alias;
+ end Add;
+
+ ---------------------------
+ -- Initialize_Switch_Def --
+ ---------------------------
+
+ procedure Initialize_Switch_Def
+ (Def : out Switch_Definition;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "")
+ is
+ P1, P2 : Switch_Parameter_Type := Parameter_None;
+ Last1, Last2 : Integer;
+ begin
+ if Switch /= "" then
+ Def.Switch := new String'(Switch);
+ Decompose_Switch (Switch, P1, Last1);
+ end if;
+
+ if Long_Switch /= "" then
+ Def.Long_Switch := new String'(Long_Switch);
+ Decompose_Switch (Long_Switch, P2, Last2);
+ end if;
+
+ if Switch /= "" and then Long_Switch /= "" then
+ if (P1 = Parameter_None and then P2 /= P1)
+ or else (P2 = Parameter_None and then P1 /= P2)
+ or else (P1 = Parameter_Optional and then P2 /= P1)
+ or else (P2 = Parameter_Optional and then P2 /= P1)
+ then
+ raise Invalid_Switch
+ with "Inconsistent parameter types for "
+ & Switch & " and " & Long_Switch;
+ end if;
+ end if;
+
+ if Section /= "" then
+ Def.Section := new String'(Section);
+ end if;
+
+ if Help /= "" then
+ Def.Help := new String'(Help);
+ end if;
+ end Initialize_Switch_Def;
+
-------------------
-- Define_Switch --
-------------------
procedure Define_Switch
- (Config : in out Command_Line_Configuration;
- Switch : String)
+ (Config : in out Command_Line_Configuration;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "")
is
+ Def : Switch_Definition;
begin
- if Config = null then
- Config := new Command_Line_Configuration_Record;
+ if Switch /= "" or else Long_Switch /= "" then
+ Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
+ Add (Config, Def);
end if;
+ end Define_Switch;
- Add (Config.Switches, new String'(Switch));
+ -------------------
+ -- Define_Switch --
+ -------------------
+
+ procedure Define_Switch
+ (Config : in out Command_Line_Configuration;
+ Output : access Boolean;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "";
+ Value : Boolean := True)
+ is
+ Def : Switch_Definition (Switch_Boolean);
+ begin
+ if Switch /= "" or else Long_Switch /= "" then
+ Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
+ Def.Boolean_Output := Output.all'Unchecked_Access;
+ Def.Boolean_Value := Value;
+ Add (Config, Def);
+ end if;
+ end Define_Switch;
+
+ -------------------
+ -- Define_Switch --
+ -------------------
+
+ procedure Define_Switch
+ (Config : in out Command_Line_Configuration;
+ Output : access Integer;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "";
+ Initial : Integer := 0;
+ Default : Integer := 1)
+ is
+ Def : Switch_Definition (Switch_Integer);
+ begin
+ if Switch /= "" or else Long_Switch /= "" then
+ Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
+ Def.Integer_Output := Output.all'Unchecked_Access;
+ Def.Integer_Default := Default;
+ Def.Integer_Initial := Initial;
+ Add (Config, Def);
+ end if;
+ end Define_Switch;
+
+ -------------------
+ -- Define_Switch --
+ -------------------
+
+ procedure Define_Switch
+ (Config : in out Command_Line_Configuration;
+ Output : access GNAT.Strings.String_Access;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "")
+ is
+ Def : Switch_Definition (Switch_String);
+ begin
+ if Switch /= "" or else Long_Switch /= "" then
+ Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
+ Def.String_Output := Output.all'Unchecked_Access;
+ Add (Config, Def);
+ end if;
end Define_Switch;
--------------------
Add (Config.Sections, new String'(Section));
end Define_Section;
+ --------------------
+ -- Foreach_Switch --
+ --------------------
+
+ procedure Foreach_Switch
+ (Config : Command_Line_Configuration;
+ Callback : access function (S : String; Index : Integer) return Boolean;
+ Section : String)
+ is
+ begin
+ if Config /= null and then Config.Switches /= null then
+ for J in Config.Switches'Range loop
+ if (Section = "" and then Config.Switches (J).Section = null)
+ or else
+ (Config.Switches (J).Section /= null
+ and then Config.Switches (J).Section.all = Section)
+ then
+ exit when Config.Switches (J).Switch /= null
+ and then not Callback (Config.Switches (J).Switch.all, J);
+
+ exit when Config.Switches (J).Long_Switch /= null
+ and then
+ not Callback (Config.Switches (J).Long_Switch.all, J);
+ end if;
+ end loop;
+ end if;
+ end Foreach_Switch;
+
------------------
-- Get_Switches --
------------------
function Get_Switches
(Config : Command_Line_Configuration;
- Switch_Char : Character)
- return String
+ Section : String := "";
+ Switch_Char : Character := '-') return String
is
Ret : Ada.Strings.Unbounded.Unbounded_String;
- use type Ada.Strings.Unbounded.Unbounded_String;
+ use Ada.Strings.Unbounded;
- begin
- if Config = null or else Config.Switches = null then
- return "";
- end if;
+ function Add_Switch (S : String; Index : Integer) return Boolean;
+ -- Add a switch to Ret
- for J in Config.Switches'Range loop
- if Config.Switches (J) (Config.Switches (J)'First) = Switch_Char then
- Ret :=
- Ret & " " &
- Config.Switches (J)
- (Config.Switches (J)'First + 1 .. Config.Switches (J)'Last);
+ function Add_Switch (S : String; Index : Integer) return Boolean is
+ pragma Unreferenced (Index);
+ begin
+ if S = "*" then
+ Ret := "*" & Ret; -- Always first
+ elsif S (S'First) = Switch_Char then
+ Append (Ret, " " & S (S'First + 1 .. S'Last));
else
- Ret := Ret & " " & Config.Switches (J).all;
+ Append (Ret, " " & S);
end if;
- end loop;
+ return True;
+ end Add_Switch;
+
+ Tmp : Boolean;
+ pragma Unreferenced (Tmp);
+ begin
+ Foreach_Switch (Config, Add_Switch'Access, Section => Section);
- return Ada.Strings.Unbounded.To_String (Ret);
+ -- Adding relevant aliases
+ if Config.Aliases /= null then
+ for A in Config.Aliases'Range loop
+ if Config.Aliases (A).Section.all = Section then
+ Tmp := Add_Switch (Config.Aliases (A).Alias.all, -1);
+ end if;
+ end loop;
+ end if;
+
+ return To_String (Ret);
end Get_Switches;
+ ------------------------
+ -- Section_Delimiters --
+ ------------------------
+
+ function Section_Delimiters
+ (Config : Command_Line_Configuration) return String
+ is
+ use Ada.Strings.Unbounded;
+ Result : Unbounded_String;
+ begin
+ if Config /= null and then Config.Sections /= null then
+ for S in Config.Sections'Range loop
+ Append (Result, " " & Config.Sections (S).all);
+ end loop;
+ end if;
+
+ return To_String (Result);
+ end Section_Delimiters;
+
-----------------------
-- Set_Configuration --
-----------------------
-- Add_Switch if -gnaty3 is actually provided.
if Separator (Parser) = ASCII.NUL then
- Add_Switch
- (Cmd, Sw & Parameter (Parser), "", ASCII.NUL);
+ Add_Switch (Cmd, Sw & Parameter (Parser), "");
else
- Add_Switch
- (Cmd, Sw, Parameter (Parser), Separator (Parser));
+ Add_Switch (Cmd, Sw, Parameter (Parser));
end if;
else
if Separator (Parser) = ASCII.NUL then
Add_Switch
- (Cmd, Sw & Parameter (Parser), "",
- Separator (Parser),
- Section.all);
+ (Cmd, Sw & Parameter (Parser), "", Section.all);
else
Add_Switch
- (Cmd, Sw,
- Parameter (Parser),
- Separator (Parser),
- Section.all);
+ (Cmd, Sw, Parameter (Parser), Section.all);
end if;
end if;
end if;
if Section = null then
Add_Switch
- (Cmd, Switch_Char & Full_Switch (Parser),
- Separator => Separator (Parser));
+ (Cmd, Switch_Char & Full_Switch (Parser));
else
Add_Switch
(Cmd, Switch_Char & Full_Switch (Parser),
- Separator => Separator (Parser),
Section => Section.all);
end if;
end;
----------------------------
procedure For_Each_Simple_Switch
- (Cmd : Command_Line;
+ (Config : Command_Line_Configuration;
+ Section : String;
Switch : String;
Parameter : String := "";
Unalias : Boolean := True)
Group : String) return Boolean;
-- Perform the analysis of a group of switches
+ Found_In_Config : Boolean := False;
+ function Is_In_Config
+ (Config_Switch : String; Index : Integer) return Boolean;
+ -- If Switch is the same as Config_Switch, run the callback and sets
+ -- Found_In_Config to True
+
+ function Starts_With
+ (Config_Switch : String; Index : Integer) return Boolean;
+ -- if Switch starts with Config_Switch, sets Found_In_Config to True.
+ -- The return value is for the Foreach_Switch iterator
+
--------------------
-- Group_Analysis --
--------------------
Idx : Natural;
Found : Boolean;
- begin
- Idx := Group'First;
- while Idx <= Group'Last loop
- Found := False;
+ function Analyze_Simple_Switch
+ (Switch : String; Index : Integer) return Boolean;
- for S in Cmd.Config.Switches'Range loop
- declare
- Sw : constant String :=
- Actual_Switch
- (Cmd.Config.Switches (S).all);
- Full : constant String :=
- Prefix & Group (Idx .. Group'Last);
- Last : Natural;
- Param : Natural;
+ function Analyze_Simple_Switch
+ (Switch : String; Index : Integer) return Boolean
+ is
+ pragma Unreferenced (Index);
- begin
- if Sw'Length >= Prefix'Length
+ Full : constant String := Prefix & Group (Idx .. Group'Last);
+ Sw : constant String := Actual_Switch (Switch);
+ Last : Natural;
+ Param : Natural;
- -- Verify that sw starts with Prefix
+ begin
+ if Sw'Length >= Prefix'Length
- and then Looking_At (Sw, Sw'First, Prefix)
+ -- Verify that sw starts with Prefix
- -- Verify that the group starts with sw
+ and then Looking_At (Sw, Sw'First, Prefix)
- and then Looking_At (Full, Full'First, Sw)
- then
- Last := Idx + Sw'Length - Prefix'Length - 1;
- Param := Last + 1;
+ -- Verify that the group starts with sw
- if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
+ and then Looking_At (Full, Full'First, Sw)
+ then
+ Last := Idx + Sw'Length - Prefix'Length - 1;
+ Param := Last + 1;
- -- Include potential parameter to the recursive call.
- -- Only numbers are allowed.
+ if Can_Have_Parameter (Switch) then
- while Last < Group'Last
- and then Group (Last + 1) in '0' .. '9'
- loop
- Last := Last + 1;
- end loop;
- end if;
+ -- Include potential parameter to the recursive call.
+ -- Only numbers are allowed.
- if not Require_Parameter (Cmd.Config.Switches (S).all)
- or else Last >= Param
- then
- if Idx = Group'First
- and then Last = Group'Last
- and then Last < Param
- then
- -- The group only concerns a single switch. Do not
- -- perform recursive call.
-
- -- Note that we still perform a recursive call if
- -- a parameter is detected in the switch, as this
- -- is a way to correctly identify such a parameter
- -- in aliases.
-
- return False;
- end if;
+ while Last < Group'Last
+ and then Group (Last + 1) in '0' .. '9'
+ loop
+ Last := Last + 1;
+ end loop;
+ end if;
- Found := True;
+ if not Require_Parameter (Switch)
+ or else Last >= Param
+ then
+ if Idx = Group'First
+ and then Last = Group'Last
+ and then Last < Param
+ then
+ -- The group only concerns a single switch. Do not
+ -- perform recursive call.
- -- Recursive call, using the detected parameter if any
+ -- Note that we still perform a recursive call if
+ -- a parameter is detected in the switch, as this
+ -- is a way to correctly identify such a parameter
+ -- in aliases.
- if Last >= Param then
- For_Each_Simple_Switch
- (Cmd,
- Prefix & Group (Idx .. Param - 1),
- Group (Param .. Last));
- else
- For_Each_Simple_Switch
- (Cmd, Prefix & Group (Idx .. Last), "");
- end if;
+ return False;
+ end if;
- Idx := Last + 1;
- exit;
- end if;
+ Found := True;
+
+ -- Recursive call, using the detected parameter if any
+
+ if Last >= Param then
+ For_Each_Simple_Switch
+ (Config,
+ Section,
+ Prefix & Group (Idx .. Param - 1),
+ Group (Param .. Last));
+ else
+ For_Each_Simple_Switch
+ (Config, Section, Prefix & Group (Idx .. Last), "");
end if;
- end;
- end loop;
+
+ Idx := Last + 1;
+ return False;
+ end if;
+ end if;
+ return True;
+ end Analyze_Simple_Switch;
+
+ begin
+ Idx := Group'First;
+ while Idx <= Group'Last loop
+ Found := False;
+
+ Foreach_Switch (Config, Analyze_Simple_Switch'Access, Section);
if not Found then
- For_Each_Simple_Switch (Cmd, Prefix & Group (Idx), "");
+ For_Each_Simple_Switch
+ (Config, Section, Prefix & Group (Idx), "");
Idx := Idx + 1;
end if;
end loop;
return True;
end Group_Analysis;
+ ------------------
+ -- Is_In_Config --
+ ------------------
+
+ function Is_In_Config
+ (Config_Switch : String; Index : Integer) return Boolean
+ is
+ Last : Natural;
+ P : Switch_Parameter_Type;
+ begin
+ Decompose_Switch (Config_Switch, P, Last);
+
+ if Config_Switch (Config_Switch'First .. Last) = Switch then
+ case P is
+ when Parameter_None =>
+ if Parameter = "" then
+ Callback (Switch, "", "", Index => Index);
+ Found_In_Config := True;
+ return False;
+ end if;
+
+ when Parameter_With_Optional_Space
+ | Parameter_With_Space_Or_Equal =>
+ if Parameter /= "" then
+ Callback (Switch, " ", Parameter, Index => Index);
+ Found_In_Config := True;
+ return False;
+ end if;
+
+ when Parameter_No_Space =>
+ if Parameter /= "" then
+ Callback (Switch, "", Parameter, Index);
+ Found_In_Config := True;
+ return False;
+ end if;
+
+ when Parameter_Optional =>
+ Callback (Switch, "", Parameter, Index);
+ Found_In_Config := True;
+ return False;
+ end case;
+ end if;
+ return True;
+ end Is_In_Config;
+
+ -----------------
+ -- Starts_With --
+ -----------------
+
+ function Starts_With
+ (Config_Switch : String; Index : Integer) return Boolean
+ is
+ Last : Natural;
+ Param : Natural;
+ P : Switch_Parameter_Type;
+ begin
+ -- This function is called when we believe the parameter was
+ -- specified as part of the switch, instead of separately. Thus we
+ -- look in the config to find all possible switches.
+
+ Decompose_Switch (Config_Switch, P, Last);
+ if Looking_At
+ (Switch, Switch'First, Config_Switch (Config_Switch'First .. Last))
+ then
+ Param := Switch'First + Last; -- First char of parameter
+ Last := Switch'First + Last - Config_Switch'First;
+ -- last char of Switch
+
+ case P is
+ when Parameter_None =>
+ null; -- Already handled in Is_In_Config
+ when Parameter_With_Space_Or_Equal =>
+ if Switch (Param) = ' '
+ or else Switch (Param) = '='
+ then
+ Callback (Switch (Switch'First .. Last),
+ "=", Switch (Param + 1 .. Switch'Last), Index);
+ Found_In_Config := True;
+ return False;
+ end if;
+
+ when Parameter_With_Optional_Space =>
+ if Switch (Param) = ' ' then
+ Param := Param + 1;
+ end if;
+
+ Callback (Switch (Switch'First .. Last),
+ " ", Switch (Param .. Switch'Last), Index);
+ Found_In_Config := True;
+ return False;
+
+ when Parameter_No_Space | Parameter_Optional =>
+ Callback (Switch (Switch'First .. Last),
+ "", Switch (Param .. Switch'Last), Index);
+ Found_In_Config := True;
+ return False;
+ end case;
+ end if;
+ return True;
+ end Starts_With;
+
begin
-- First determine if the switch corresponds to one belonging to the
-- configuration. If so, run callback and exit.
- if Cmd.Config /= null and then Cmd.Config.Switches /= null then
- for S in Cmd.Config.Switches'Range loop
- declare
- Config_Switch : String renames Cmd.Config.Switches (S).all;
- begin
- if Actual_Switch (Config_Switch) = Switch
- and then
- ((Can_Have_Parameter (Config_Switch)
- and then Parameter /= "")
- or else
- (not Require_Parameter (Config_Switch)
- and then Parameter = ""))
- then
- Callback (Switch, Parameter);
- return;
- end if;
- end;
- end loop;
+ Foreach_Switch (Config, Is_In_Config'Access, Section);
+ if Found_In_Config then
+ return;
end if;
-- If adding a switch that can in fact be expanded through aliases,
-- be checked for a common prefix and split into simple switches.
if Unalias
- and then Cmd.Config /= null
- and then Cmd.Config.Aliases /= null
+ and then Config /= null
+ and then Config.Aliases /= null
then
- for A in Cmd.Config.Aliases'Range loop
- if Cmd.Config.Aliases (A).all = Switch and then Parameter = "" then
+ for A in Config.Aliases'Range loop
+ if Config.Aliases (A).Section.all = Section
+ and then Config.Aliases (A).Alias.all = Switch
+ and then Parameter = ""
+ then
For_Each_Simple_Switch
- (Cmd, Cmd.Config.Expansions (A).all, "");
+ (Config, Section, Config.Aliases (A).Expansion.all, "");
return;
end if;
end loop;
-- If adding a switch grouping several switches, add each of the simple
-- switches instead.
- if Cmd.Config /= null and then Cmd.Config.Prefixes /= null then
- for P in Cmd.Config.Prefixes'Range loop
- if Switch'Length > Cmd.Config.Prefixes (P)'Length + 1
+ if Config /= null and then Config.Prefixes /= null then
+ for P in Config.Prefixes'Range loop
+ if Switch'Length > Config.Prefixes (P)'Length + 1
and then Looking_At
- (Switch, Switch'First, Cmd.Config.Prefixes (P).all)
+ (Switch, Switch'First, Config.Prefixes (P).all)
then
-- Alias expansion will be done recursively
- if Cmd.Config.Switches = null then
- for S in Switch'First + Cmd.Config.Prefixes (P)'Length
+ if Config.Switches = null then
+ for S in Switch'First + Config.Prefixes (P)'Length
.. Switch'Last
loop
For_Each_Simple_Switch
- (Cmd, Cmd.Config.Prefixes (P).all & Switch (S), "");
+ (Config, Section,
+ Config.Prefixes (P).all & Switch (S), "");
end loop;
return;
elsif Group_Analysis
- (Cmd.Config.Prefixes (P).all,
+ (Config.Prefixes (P).all,
Switch
- (Switch'First + Cmd.Config.Prefixes (P)'Length
- .. Switch'Last))
+ (Switch'First + Config.Prefixes (P)'Length .. Switch'Last))
then
-- Recursive calls already done on each switch of the group:
-- Return without executing Callback.
-
return;
end if;
end if;
end if;
-- Test if added switch is a known switch with parameter attached
+ -- instead of being specified separately
if Parameter = ""
- and then Cmd.Config /= null
- and then Cmd.Config.Switches /= null
+ and then Config /= null
+ and then Config.Switches /= null
then
- for S in Cmd.Config.Switches'Range loop
- declare
- Sw : constant String :=
- Actual_Switch (Cmd.Config.Switches (S).all);
- Last : Natural;
- Param : Natural;
-
- begin
- -- Verify that switch starts with Sw
- -- What if the "verification" fails???
-
- if Switch'Length >= Sw'Length
- and then Looking_At (Switch, Switch'First, Sw)
- then
- Param := Switch'First + Sw'Length - 1;
- Last := Param;
-
- if Can_Have_Parameter (Cmd.Config.Switches (S).all) then
- while Last < Switch'Last
- and then Switch (Last + 1) in '0' .. '9'
- loop
- Last := Last + 1;
- end loop;
- end if;
-
- -- If full Switch is a known switch with attached parameter
- -- then we use this parameter in the callback.
-
- if Last = Switch'Last then
- Callback
- (Switch (Switch'First .. Param),
- Switch (Param + 1 .. Last));
- return;
-
- end if;
- end if;
- end;
- end loop;
+ Found_In_Config := False;
+ Foreach_Switch (Config, Starts_With'Access, Section);
+ if Found_In_Config then
+ return;
+ end if;
end if;
- Callback (Switch, Parameter);
+ -- The switch is invalid in the config, but we still want to report it.
+ -- The config could, for instance, include "*" to specify it accepts
+ -- all switches.
+
+ Callback (Switch, " ", Parameter, Index => -1);
end For_Each_Simple_Switch;
----------------
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
- Separator : Character := ' ';
Section : String := "";
Add_Before : Boolean := False)
is
pragma Unreferenced (Success);
begin
Add_Switch
- (Cmd, Switch, Parameter, Separator, Section, Add_Before, Success);
+ (Cmd, Switch, Parameter, Section, Add_Before, Success);
end Add_Switch;
----------------
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
- Separator : Character := ' ';
Section : String := "";
Add_Before : Boolean := False;
Success : out Boolean)
is
- procedure Add_Simple_Switch (Simple : String; Param : String);
+ procedure Add_Simple_Switch
+ (Simple, Separator, Param : String; Index : Integer);
-- Add a new switch that has had all its aliases expanded, and switches
-- ungrouped. We know there are no more aliases in Switches.
-- Add_Simple_Switch --
-----------------------
- procedure Add_Simple_Switch (Simple : String; Param : String) is
+ procedure Add_Simple_Switch
+ (Simple, Separator, Param : String; Index : Integer)
+ is
+ pragma Unreferenced (Index);
begin
if Cmd.Expanded = null then
Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
end Add_Simple_Switch;
procedure Add_Simple_Switches is
- new For_Each_Simple_Switch (Add_Simple_Switch);
+ new For_Each_Simple_Switch (Add_Simple_Switch);
-- Start of processing for Add_Switch
end if;
Success := False;
- Add_Simple_Switches (Cmd, Switch, Parameter);
+ Add_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
Free (Cmd.Coalesce);
end Add_Switch;
Section : String := "";
Success : out Boolean)
is
- procedure Remove_Simple_Switch (Simple : String; Param : String);
+ procedure Remove_Simple_Switch
+ (Simple, Separator, Param : String; Index : Integer);
-- Removes a simple switch, with no aliasing or grouping
--------------------------
-- Remove_Simple_Switch --
--------------------------
- procedure Remove_Simple_Switch (Simple : String; Param : String) is
+ procedure Remove_Simple_Switch
+ (Simple, Separator, Param : String; Index : Integer)
+ is
C : Integer;
- pragma Unreferenced (Param);
+ pragma Unreferenced (Param, Separator, Index);
begin
if Cmd.Expanded /= null then
begin
Success := False;
- Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter);
+ Remove_Simple_Switches
+ (Cmd.Config, Section, Switch, "", Unalias => not Has_Parameter);
Free (Cmd.Coalesce);
end Remove_Switch;
Parameter : String;
Section : String := "")
is
- procedure Remove_Simple_Switch (Simple : String; Param : String);
+ procedure Remove_Simple_Switch
+ (Simple, Separator, Param : String; Index : Integer);
-- Removes a simple switch, with no aliasing or grouping
--------------------------
-- Remove_Simple_Switch --
--------------------------
- procedure Remove_Simple_Switch (Simple : String; Param : String) is
+ procedure Remove_Simple_Switch
+ (Simple, Separator, Param : String; Index : Integer)
+ is
+ pragma Unreferenced (Separator, Index);
C : Integer;
begin
end Remove_Simple_Switch;
procedure Remove_Simple_Switches is
- new For_Each_Simple_Switch (Remove_Simple_Switch);
+ new For_Each_Simple_Switch (Remove_Simple_Switch);
-- Start of processing for Remove_Switch
begin
- Remove_Simple_Switches (Cmd, Switch, Parameter);
+ Remove_Simple_Switches (Cmd.Config, Switch, Parameter);
Free (Cmd.Coalesce);
end Remove_Switch;
Found : Boolean;
First : Natural;
- procedure Check_Cb (Switch : String; Param : String);
- -- Comment required ???
+ procedure Check_Cb (Switch, Separator, Param : String; Index : Integer);
+ -- Checks whether the command line contains [Switch].
+ -- Sets the global variable [Found] appropriately.
+ -- This will be called for each simple switch that make up an alias, to
+ -- know whether the alias should be applied.
- procedure Remove_Cb (Switch : String; Param : String);
- -- Comment required ???
+ procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer);
+ -- Remove the simple switch [Switch] from the command line, since it is
+ -- part of a simpler alias
--------------
-- Check_Cb --
--------------
- procedure Check_Cb (Switch : String; Param : String) is
+ procedure Check_Cb
+ (Switch, Separator, Param : String; Index : Integer)
+ is
+ pragma Unreferenced (Separator, Index);
begin
if Found then
for E in Result'Range loop
-- Remove_Cb --
---------------
- procedure Remove_Cb (Switch : String; Param : String) is
+ procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer)
+ is
+ pragma Unreferenced (Separator, Index);
begin
for E in Result'Range loop
if Result (E) /= null
-- then check whether the expanded command line has all of them.
Found := True;
- Check_All (Cmd, Cmd.Config.Expansions (A).all);
+ Check_All (Cmd.Config,
+ Switch => Cmd.Config.Aliases (A).Expansion.all,
+ Section => Cmd.Config.Aliases (A).Section.all);
if Found then
First := Integer'Last;
- Remove_All (Cmd, Cmd.Config.Expansions (A).all);
- Result (First) := new String'(Cmd.Config.Aliases (A).all);
+ Remove_All (Cmd.Config,
+ Switch => Cmd.Config.Aliases (A).Expansion.all,
+ Section => Cmd.Config.Aliases (A).Section.all);
+ Result (First) := new String'(Cmd.Config.Aliases (A).Alias.all);
end if;
end loop;
end Alias_Switches;
end if;
end loop;
end loop;
+
+ Unchecked_Free (Sections_List);
end Sort_Sections;
-----------
Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
end loop;
+ Free (Cmd.Coalesce_Sections);
Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
for E in Cmd.Sections'Range loop
Cmd.Coalesce_Sections (E) :=
else new String'(Cmd.Sections (E).all));
end loop;
+ Free (Cmd.Coalesce_Params);
Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
for E in Cmd.Params'Range loop
Cmd.Coalesce_Params (E) :=
----------
procedure Free (Config : in out Command_Line_Configuration) is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Switch_Definitions, Switch_Definitions_List);
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Alias_Definitions, Alias_Definitions_List);
begin
if Config /= null then
- Free (Config.Aliases);
- Free (Config.Expansions);
Free (Config.Prefixes);
Free (Config.Sections);
- Free (Config.Switches);
+ Free (Config.Usage);
+ Free (Config.Help);
+
+ if Config.Aliases /= null then
+ for A in Config.Aliases'Range loop
+ Free (Config.Aliases (A).Alias);
+ Free (Config.Aliases (A).Expansion);
+ Free (Config.Aliases (A).Section);
+ end loop;
+ Unchecked_Free (Config.Aliases);
+ end if;
+
+ if Config.Switches /= null then
+ for S in Config.Switches'Range loop
+ Free (Config.Switches (S).Switch);
+ Free (Config.Switches (S).Long_Switch);
+ Free (Config.Switches (S).Help);
+ Free (Config.Switches (S).Section);
+ end loop;
+
+ Unchecked_Free (Config.Switches);
+ end if;
+
Unchecked_Free (Config);
end if;
end Free;
begin
Free (Cmd.Expanded);
Free (Cmd.Coalesce);
+ Free (Cmd.Coalesce_Sections);
+ Free (Cmd.Coalesce_Params);
Free (Cmd.Params);
+ Free (Cmd.Sections);
end Free;
+ ---------------
+ -- Set_Usage --
+ ---------------
+
+ procedure Set_Usage
+ (Config : in out Command_Line_Configuration;
+ Usage : String := "[switches] [arguments]";
+ Help : String := "")
+ is
+ begin
+ if Config = null then
+ Config := new Command_Line_Configuration_Record;
+ end if;
+
+ Free (Config.Usage);
+ Config.Usage := new String'(Usage);
+ Config.Help := new String'(Help);
+ end Set_Usage;
+
+ ------------------
+ -- Display_Help --
+ ------------------
+
+ procedure Display_Help (Config : Command_Line_Configuration) is
+ function Switch_Name
+ (Def : Switch_Definition; Section : String) return String;
+ -- Return the "-short, --long=ARG" string for Def.
+ -- Returns "" if the switch is not in the section
+
+ function Param_Name
+ (P : Switch_Parameter_Type; Name : String := "ARG") return String;
+ -- Return the display for a switch parameter
+
+ procedure Display_Section_Help (Section : String);
+ -- Display the help for a specific section ("" is the default section)
+
+ function Param_Name
+ (P : Switch_Parameter_Type; Name : String := "ARG") return String is
+ begin
+ case P is
+ when Parameter_None =>
+ return "";
+
+ when Parameter_With_Optional_Space =>
+ return " " & To_Upper (Name);
+
+ when Parameter_With_Space_Or_Equal =>
+ return "=" & To_Upper (Name);
+
+ when Parameter_No_Space =>
+ return To_Upper (Name);
+
+ when Parameter_Optional =>
+ return '[' & To_Upper (Name) & ']';
+ end case;
+ end Param_Name;
+
+ function Switch_Name
+ (Def : Switch_Definition; Section : String) return String
+ is
+ use Ada.Strings.Unbounded;
+ Result : Unbounded_String;
+ P1, P2 : Switch_Parameter_Type;
+ Last1, Last2 : Integer := 0;
+ begin
+ if (Section = "" and then Def.Section = null)
+ or else (Def.Section /= null and then Def.Section.all = Section)
+ then
+ if Def.Switch /= null
+ and then Def.Switch.all = "*"
+ then
+ return "[any switch]";
+ end if;
+
+ if Def.Switch /= null then
+ Decompose_Switch (Def.Switch.all, P1, Last1);
+ Append (Result, Def.Switch (Def.Switch'First .. Last1));
+
+ if Def.Long_Switch /= null then
+ Decompose_Switch (Def.Long_Switch.all, P2, Last2);
+ Append (Result, ", "
+ & Def.Long_Switch (Def.Long_Switch'First .. Last2));
+ Append (Result, Param_Name (P2, "ARG"));
+
+ else
+ Append (Result, Param_Name (P1, "ARG"));
+ end if;
+
+ else -- Long_Switch necessarily not null
+ Decompose_Switch (Def.Long_Switch.all, P2, Last2);
+ Append (Result,
+ Def.Long_Switch (Def.Long_Switch'First .. Last2));
+ Append (Result, Param_Name (P2, "ARG"));
+ end if;
+ end if;
+
+ return To_String (Result);
+ end Switch_Name;
+
+ procedure Display_Section_Help (Section : String) is
+ Max_Len : Natural := 0;
+ begin
+ -- ??? Special display for "*"
+
+ New_Line;
+
+ if Section /= "" then
+ Put_Line ("Switches after " & Section);
+ end if;
+
+ -- Compute size of the switches column
+
+ for S in Config.Switches'Range loop
+ Max_Len := Natural'Max
+ (Max_Len, Switch_Name (Config.Switches (S), Section)'Length);
+ end loop;
+
+ if Config.Aliases /= null then
+ for A in Config.Aliases'Range loop
+ if Config.Aliases (A).Section.all = Section then
+ Max_Len := Natural'Max
+ (Max_Len, Config.Aliases (A).Alias'Length);
+ end if;
+ end loop;
+ end if;
+
+ -- Display the switches
+
+ for S in Config.Switches'Range loop
+ declare
+ N : constant String :=
+ Switch_Name (Config.Switches (S), Section);
+ begin
+ if N /= "" then
+ Put (" ");
+ Put (N);
+ Put ((1 .. Max_Len - N'Length + 1 => ' '));
+
+ if Config.Switches (S).Help /= null then
+ Put (Config.Switches (S).Help.all);
+ end if;
+
+ New_Line;
+ end if;
+ end;
+ end loop;
+
+ -- Display the aliases
+
+ if Config.Aliases /= null then
+ for A in Config.Aliases'Range loop
+ if Config.Aliases (A).Section.all = Section then
+ Put (" ");
+ Put (Config.Aliases (A).Alias.all);
+ Put ((1 .. Max_Len - Config.Aliases (A).Alias'Length + 1
+ => ' '));
+ Put ("Equivalent to " & Config.Aliases (A).Expansion.all);
+ New_Line;
+ end if;
+ end loop;
+ end if;
+ end Display_Section_Help;
+
+ begin
+ if Config = null then
+ return;
+ end if;
+
+ if Config.Usage /= null then
+ Put_Line ("Usage: "
+ & Base_Name
+ (Ada.Command_Line.Command_Name) & " " & Config.Usage.all);
+ else
+ Put_Line ("Usage: " & Base_Name (Ada.Command_Line.Command_Name)
+ & " [switches] [arguments]");
+ end if;
+
+ if Config.Help /= null and then Config.Help.all /= "" then
+ Put_Line (Config.Help.all);
+ end if;
+
+ Display_Section_Help ("");
+ if Config.Sections /= null and then Config.Switches /= null then
+ for S in Config.Sections'Range loop
+ Display_Section_Help (Config.Sections (S).all);
+ end loop;
+ end if;
+ end Display_Help;
+
+ ------------
+ -- Getopt --
+ ------------
+
+ procedure Getopt
+ (Config : Command_Line_Configuration;
+ Callback : Switch_Handler := null;
+ Parser : Opt_Parser := Command_Line_Parser)
+ is
+ Getopt_Switches : String_Access;
+ C : Character := ASCII.NUL;
+
+ Empty_Name : aliased constant String := "";
+ Current_Section : Integer := -1;
+ Section_Name : not null access constant String := Empty_Name'Access;
+
+ procedure Simple_Callback
+ (Simple_Switch, Separator, Parameter : String; Index : Integer);
+ procedure Do_Callback (Switch, Parameter : String; Index : Integer);
+
+ procedure Do_Callback (Switch, Parameter : String; Index : Integer) is
+ begin
+ -- Do automatic handling when possible
+
+ if Index /= -1 then
+ case Config.Switches (Index).Typ is
+ when Switch_Untyped =>
+ null; -- no automatic handling
+
+ when Switch_Boolean =>
+ Config.Switches (Index).Boolean_Output.all :=
+ Config.Switches (Index).Boolean_Value;
+ return;
+
+ when Switch_Integer =>
+ begin
+ if Parameter = "" then
+ Config.Switches (Index).Integer_Output.all :=
+ Config.Switches (Index).Integer_Default;
+ else
+ Config.Switches (Index).Integer_Output.all :=
+ Integer'Value (Parameter);
+ end if;
+ exception
+ when Constraint_Error =>
+ raise Invalid_Parameter
+ with "Expected integer parameter for '"
+ & Switch & "'";
+ end;
+
+ when Switch_String =>
+ Free (Config.Switches (Index).String_Output.all);
+ Config.Switches (Index).String_Output.all :=
+ new String'(Parameter);
+ end case;
+ end if;
+
+ -- Otherwise calls the user callback if one was defined
+
+ if Callback /= null then
+ Callback (Switch => Switch,
+ Parameter => Parameter,
+ Section => Section_Name.all);
+ end if;
+ end Do_Callback;
+
+ procedure Simple_Callback
+ (Simple_Switch, Separator, Parameter : String; Index : Integer)
+ is
+ pragma Unreferenced (Separator);
+ begin
+ Do_Callback (Switch => Simple_Switch,
+ Parameter => Parameter,
+ Index => Index);
+ end Simple_Callback;
+
+ procedure For_Each_Simple
+ is new For_Each_Simple_Switch (Simple_Callback);
+
+ begin
+ -- Initialize sections
+
+ if Config.Sections = null then
+ Config.Sections := new Argument_List'(1 .. 0 => null);
+ end if;
+
+ Internal_Initialize_Option_Scan
+ (Parser => Parser,
+ Switch_Char => Parser.Switch_Character,
+ Stop_At_First_Non_Switch => Parser.Stop_At_First,
+ Section_Delimiters => Section_Delimiters (Config));
+
+ Getopt_Switches := new String'
+ (Get_Switches (Config, Section_Name.all, Parser.Switch_Character)
+ & " h -help");
+
+ -- Initialize output values for automatically handled switches
+
+ for S in Config.Switches'Range loop
+ case Config.Switches (S).Typ is
+ when Switch_Untyped =>
+ null; -- Nothing to do
+
+ when Switch_Boolean =>
+ Config.Switches (S).Boolean_Output.all :=
+ not Config.Switches (S).Boolean_Value;
+
+ when Switch_Integer =>
+ Config.Switches (S).Integer_Output.all :=
+ Config.Switches (S).Integer_Initial;
+
+ when Switch_String =>
+ Config.Switches (S).String_Output.all := new String'("");
+ end case;
+ end loop;
+
+ -- For all sections, and all switches within those sections
+
+ loop
+ C := Getopt (Switches => Getopt_Switches.all,
+ Concatenate => True,
+ Parser => Parser);
+
+ if C = '*' then
+ -- Full_Switch already includes the leading '-'
+
+ Do_Callback (Switch => Full_Switch (Parser),
+ Parameter => Parameter (Parser),
+ Index => -1);
+
+ elsif C /= ASCII.NUL then
+ if Full_Switch (Parser) = "h"
+ or else Full_Switch (Parser) = "-help"
+ then
+ Display_Help (Config);
+ raise Exit_From_Command_Line;
+ end if;
+
+ -- Do switch expansion if needed
+ For_Each_Simple
+ (Config,
+ Section => Section_Name.all,
+ Switch => Parser.Switch_Character & Full_Switch (Parser),
+ Parameter => Parameter (Parser));
+
+ else
+ if Current_Section = -1 then
+ Current_Section := Config.Sections'First;
+ else
+ Current_Section := Current_Section + 1;
+ end if;
+
+ exit when Current_Section > Config.Sections'Last;
+
+ Section_Name := Config.Sections (Current_Section);
+ Goto_Section (Section_Name.all, Parser);
+
+ Free (Getopt_Switches);
+ Getopt_Switches := new String'
+ (Get_Switches
+ (Config, Section_Name.all, Parser.Switch_Character));
+ end if;
+ end loop;
+
+ Free (Getopt_Switches);
+
+ exception
+ when Invalid_Switch =>
+ Free (Getopt_Switches);
+
+ -- Message inspired by "ls" on Unix
+ Put_Line (Standard_Error,
+ Base_Name (Ada.Command_Line.Command_Name)
+ & ": unrecognized option '"
+ & Parser.Switch_Character & Full_Switch (Parser)
+ & "'");
+ Put_Line (Standard_Error,
+ "Try `"
+ & Base_Name (Ada.Command_Line.Command_Name)
+ & " --help` for more information.");
+
+ raise;
+
+ when others =>
+ Free (Getopt_Switches);
+ raise;
+ end Getopt;
+
+ -----------
+ -- Build --
+ -----------
+
+ procedure Build
+ (Line : in out Command_Line;
+ Args : out GNAT.OS_Lib.Argument_List_Access;
+ Expanded : Boolean := False;
+ Switch_Char : Character := '-')
+ is
+ Iter : Command_Line_Iterator;
+ Count : Natural := 0;
+ begin
+ Start (Line, Iter, Expanded => Expanded);
+ while Has_More (Iter) loop
+ if Is_New_Section (Iter) then
+ Count := Count + 1;
+ end if;
+
+ Count := Count + 1;
+ Next (Iter);
+ end loop;
+
+ Args := new Argument_List (1 .. Count);
+ Count := Args'First;
+
+ Start (Line, Iter, Expanded => Expanded);
+ while Has_More (Iter) loop
+ if Is_New_Section (Iter) then
+ Args (Count) := new String'
+ (Switch_Char & Current_Section (Iter));
+ Count := Count + 1;
+ end if;
+
+ Args (Count) := new String'(Current_Switch (Iter)
+ & Current_Separator (Iter)
+ & Current_Parameter (Iter));
+ Count := Count + 1;
+ Next (Iter);
+ end loop;
+ end Build;
+
end GNAT.Command_Line;
-- As shown in the example below, one should first retrieve the switches
-- (special command line arguments starting with '-' by default) and their
-- parameters, and then the rest of the command line arguments.
-
--- This package is flexible enough to accommodate various needs: optional
--- switch parameters, various characters to separate a switch and its
--- parameter, whether to stop the parsing at the first non-switch argument
--- encountered, etc.
-
+--
+-- While it may appear easy to parse the command line arguments with
+-- Ada.Command_Line, there are in fact lots of special cases to handle in some
+-- applications. Those are fully managed by GNAT.Command_Line. Among these are
+-- switches with optional parameters, grouping switches (for instance "-ab"
+-- might mean the same as "-a -b"), various characters to separate a switch
+-- and its parameter (or none: "-a 1" and "-a1" are generally the same, which
+-- can introduce confusion with grouped switches),...
+--
-- begin
-- loop
-- case Getopt ("a b: ad") is -- Accepts '-a', '-ad', or '-b argument'
-- Put_Line ("Got ad");
-- end if;
--- when 'b' =>
--- Put_Line ("Got b + " & Parameter);
+-- when 'b' => Put_Line ("Got b + " & Parameter);
-- when others =>
-- raise Program_Error; -- cannot occur!
-- end;
----------------------------------------------
--- Creating and manipulating the command line
+-- High level command line configuration
----------------------------------------------
--- This package provides mechanisms to create and modify command lines by
--- adding or removing arguments from them. The resulting command line is kept
--- as short as possible by coalescing arguments whenever possible.
-
--- Complex command lines can thus be constructed, for example from a GUI
--- (although this package does not by itself depend upon any specific GUI
--- toolkit). For instance, if you are configuring the command line to use when
--- spawning a tool with the following characteristics:
+-- As shown above, the code is still relatively low-level. For instance, there
+-- is no way to indicate which switches are related (thus if "-l" and "--long"
+-- should have the same effect, your code will need to test for both cases).
+-- Likewise, it is difficult to handle more advanced constructs, like:
-- * Specifying -gnatwa is the same as specifying -gnatwu -gnatwv, but
-- shorter and more readable
-- Of course, this can be combined with the above and -gnatwacd is the
-- same as -gnatwc -gnatwd -gnatwu -gnatwv
--- * The switch -T is the same as -gnatwAB
+-- * The switch -T is the same as -gnatwAB (same as -gnatwA -gnatwB)
--- * A switch -foo takes one mandatory parameter
+-- With the above form of Getopt, you would receive "-gnatwa", "-T" or
+-- "-gnatwcd" in the examples above, and thus you require additional manual
+-- parsing of the switch.
--- These properties can be configured through this package with the following
--- calls:
+-- Instead, this package provides the type Command_Line_Configuration, which
+-- stores all the knowledge above. For instance:
-- Config : Command_Line_Configuration;
+-- Define_Alias (Config, "-gnatwa", "-gnatwu -gnatwv");
-- Define_Prefix (Config, "-gnatw");
--- Define_Alias (Config, "-gnatwa", "-gnatwuv");
-- Define_Alias (Config, "-T", "-gnatwAB");
--- Using this configuration, one can then construct a command line for the
--- tool with:
+-- You then need to specify all possible switches in your application by
+-- calling Define_Switch, for instance:
+
+-- Define_Switch (Config, "-gnatwu", Help => "warn on unused entities");
+-- Define_Switch (Config, "-gnatwv", Help => "warn on unassigned var");
+-- ...
+
+-- Specifying the help message is optional, but makes it easy to then call
+-- the function
+-- Display_Help (Config);
+-- that will display a properly formatted help message for your application,
+-- listing all possible switches. That way you have a single place in which
+-- to maintain the list of switches and their meaning, rather than maintaing
+-- both the string to pass to Getopt and a subprogram to display the help.
+-- Both will properly stay synchronized.
+
+-- Once you have this Config, you just have to call
+-- Getopt (Config, Callback'Access);
+-- to parse the command line. The Callback will be called for each switch
+-- found on the command line (in the case of our example, that is "-gnatwu"
+-- and then "-gnatwv", not "-gnatwa" itself). This simplifies command line
+-- parsing a lot.
+
+-- In fact, this can be further automated for the most command case where the
+-- parameter passed to a switch is stored in a variable in the application.
+-- When a switch is defined, you only have to indicate where to store the
+-- value, and let Getopt do the rest. For instance:
+
+-- Optimization : aliased Integer;
+-- Verbose : aliased Boolean;
+--
+-- Define_Switch (Config, Verbose'Access,
+-- "-v", Long_Switch => "--verbose",
+-- Help => "Output extra verbose information");
+-- Define_Switch (Config, Optimization'Access,
+-- "-O?", Help => "Optimization level");
+--
+-- Getopt (Config); -- No callback
+
+-- Since all switches are handled automatically, we don't even need to pass
+-- a callback to Getopt. Once getopt has been called, the two variables
+-- Optimization and Verbose have been properly initialized, either to the
+-- default value or to the value found on the command line.
+
+----------------------------------------------
+-- Creating and manipulating the command line
+----------------------------------------------
+
+-- This package provides mechanisms to create and modify command lines by
+-- adding or removing arguments from them. The resulting command line is kept
+-- as short as possible by coalescing arguments whenever possible.
+
+-- Complex command lines can thus be constructed, for example from a GUI
+-- (although this package does not by itself depend upon any specific GUI
+-- toolkit).
+
+-- Using the configuration defined earlier, one can then construct a command
+-- line for the tool with:
-- Cmd : Command_Line;
--- Set_Configuration (Cmd, Config);
+-- Set_Configuration (Cmd, Config); -- Config created earlier
-- Add_Switch (Cmd, "-bar");
-- Add_Switch (Cmd, "-gnatwu");
-- Add_Switch (Cmd, "-gnatwv"); -- will be grouped with the above
-- This ensures that "arg1" will always be treated as the argument to -foo,
-- and will not be grouped with other parts of the command line.
----------------------------------------------------
--- Parsing the command line with grouped arguments
----------------------------------------------------
-
--- The command line construction facility can also be used in conjunction with
--- Getopt to interpret a command line. For example when implementing the tool
--- described above, you would do a first loop with Getopt to pass the switches
--- and their arguments, and create a temporary representation of the command
--- line as a Command_Line object. Finally, you can query each individual
--- switch from that object. For instance:
-
--- declare
--- Cmd : Command_Line;
--- Iter : Command_Line_Iterator;
-
--- begin
--- while Getopt ("foo: gnatw! T bar") /= ASCII.NUL loop
--- Add_Switch (Cmd, Full_Switch, Parameter);
--- end loop;
-
--- Start (Cmd, Iter, Expanded => True);
--- while Has_More (Iter) loop
--- if Current_Switch (Iter) = "-gnatwu" then
--- ...
--- elsif Current_Switch (Iter) = "-gnatwv" then
--- ...
--- end if;
--- Next (Iter);
--- end loop;
-
--- The above means that your tool does not have to handle on its own whether
--- the user passed -gnatwa (in which case -gnatwu was indeed selected), or
--- just -gnatwu, or a combination of -gnatw switches as in -gnatwuv.
-
with Ada.Command_Line;
with GNAT.Directory_Operations;
with GNAT.OS_Lib;
with GNAT.Regexp;
+with GNAT.Strings;
package GNAT.Command_Line is
-- first character). Does not include the Switch_Char ('-' by default),
-- unless the "*" option of Getopt is used (see below).
+ function Current_Section
+ (Parser : Opt_Parser := Command_Line_Parser) return String;
+ -- Return the name of the current section.
+ -- The list of valid sections is defined through Initialize_Option_Scan
+
function Getopt
(Switches : String;
Concatenate : Boolean := True;
type Command_Line_Configuration is private;
+ procedure Define_Section
+ (Config : in out Command_Line_Configuration;
+ Section : String);
+ -- Indicates a new switch section. All switches belonging to the same
+ -- section are ordered together, preceded by the section. They are placed
+ -- at the end of the command line (as in "gnatmake somefile.adb -cargs -g")
+ -- The section name should not include the leading '-'.
+ -- So for instance in the case of gnatmake we would use:
+ -- Define_Section (Config, "cargs");
+ -- Define_Section (Config, "bargs");
+
procedure Define_Alias
(Config : in out Command_Line_Configuration;
Switch : String;
- Expanded : String);
+ Expanded : String;
+ Section : String := "");
-- Indicates that whenever Switch appears on the command line, it should
-- be expanded as Expanded. For instance, for the GNAT compiler switches,
-- we would define "-gnatwa" as an alias for "-gnatwcfijkmopruvz", ie some
-- default warnings to be activated.
+ -- This expansion is only done within the specified section, which must
+ -- have been defined first through a call to [Define_Section].
procedure Define_Prefix
(Config : in out Command_Line_Configuration;
-- alphabetically.
procedure Define_Switch
- (Config : in out Command_Line_Configuration;
- Switch : String);
+ (Config : in out Command_Line_Configuration;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "");
-- Indicates a new switch. The format of this switch follows the getopt
-- format (trailing ':', '?', etc for defining a switch with parameters).
- -- The switches defined in the Command_Line_Configuration object are used
+ --
+ -- Switch should also start with the leading '-' (or any other characters).
+ -- They should all start with the same character, though. If this
+ -- character is not '-', you will need to call Initialize_Option_Scan to
+ -- set the proper character for the parser.
+ --
+ -- The switches defined in the command_line_configuration object are used
-- when ungrouping switches with more that one character after the prefix.
+ --
+ -- Switch and Long_Switch (when specified) are aliases and can be used
+ -- interchangeably. There is no check that they both take an argument or
+ -- both take no argument.
+ -- Switch can be set to "*" to indicate that any switch is supported (in
+ -- which case Getopt will return '*', see its documentation).
+ --
+ -- Help is used by the Display_Help procedure to describe the supported
+ -- switches.
+ --
+ -- In_Section indicates in which section the switch is valid (you need to
+ -- first define the section through a call to Define_Section).
- procedure Define_Section
- (Config : in out Command_Line_Configuration;
- Section : String);
- -- Indicates a new switch section. All switches belonging to the same
- -- section are ordered together, preceded by the section. They are placed
- -- at the end of the command line (as in "gnatmake somefile.adb -cargs -g")
+ procedure Define_Switch
+ (Config : in out Command_Line_Configuration;
+ Output : access Boolean;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "";
+ Value : Boolean := True);
+ -- See Define_Switch for a description of the parameters.
+ -- When the switch is found on the command line, Getopt will set
+ -- Output.all to Value.
+ -- Output is always initially set to "not Value", so that if the switch is
+ -- not found on the command line, Output still has a valid value.
+ -- The switch must not take any parameter.
+ -- Output must exist at least as long as Config, otherwise erroneous memory
+ -- access may happen.
+
+ procedure Define_Switch
+ (Config : in out Command_Line_Configuration;
+ Output : access Integer;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "";
+ Initial : Integer := 0;
+ Default : Integer := 1);
+ -- See Define_Switch for a description of the parameters.
+ -- When the switch is found on the command line, Getopt will set
+ -- Output.all to the value of the switch's parameter. If the parameter is
+ -- not an integer, Invalid_Parameter is raised.
+ -- Output is always initialized to Initial. If the switch has an optional
+ -- argument which isn't specified by the user, then Output will be set to
+ -- Default.
+
+ procedure Define_Switch
+ (Config : in out Command_Line_Configuration;
+ Output : access GNAT.Strings.String_Access;
+ Switch : String := "";
+ Long_Switch : String := "";
+ Help : String := "";
+ Section : String := "");
+ -- Set Output to the value of the switch's parameter when the switch is
+ -- found on the command line.
+ -- Output is always initialized to the empty string.
+
+ procedure Set_Usage
+ (Config : in out Command_Line_Configuration;
+ Usage : String := "[switches] [arguments]";
+ Help : String := "");
+ -- Defines the general format of the call to the application, and a short
+ -- help text. These are both displayed by Display_Help
+
+ procedure Display_Help (Config : Command_Line_Configuration);
+ -- Display the help for the tool (ie its usage, and its supported switches)
function Get_Switches
(Config : Command_Line_Configuration;
- Switch_Char : Character) return String;
- -- Get the switches list as expected by Getopt. This list is built using
- -- all switches defined previously via Define_Switch above.
+ Section : String := "";
+ Switch_Char : Character := '-') return String;
+ -- Get the switches list as expected by Getopt, for a specific section of
+ -- the command line. This list is built using all switches defined
+ -- previously via Define_Switch above.
+
+ function Section_Delimiters
+ (Config : Command_Line_Configuration) return String;
+ -- Return a string suitable for use in Initialize_Option_Scan
procedure Free (Config : in out Command_Line_Configuration);
-- Free the memory used by Config
+ type Switch_Handler is access procedure
+ (Switch : String;
+ Parameter : String;
+ Section : String);
+ -- Called when a switch is found on the command line.
+ -- [Switch] includes any leading '-' that was specified in Define_Switch.
+ -- This is slightly different from the functional version of Getopt above,
+ -- for which Full_Switch omits the first leading '-'.
+
+ Exit_From_Command_Line : exception;
+ -- Emitted when the program should exit.
+ -- This is called when Getopt below has seen -h, --help or an invalid
+ -- switch.
+
+ procedure Getopt
+ (Config : Command_Line_Configuration;
+ Callback : Switch_Handler := null;
+ Parser : Opt_Parser := Command_Line_Parser);
+ -- Similar to the standard Getopt function.
+ -- For each switch found on the command line, this calls Callback.
+ --
+ -- The list of valid switches are the ones from the configuration. The
+ -- switches that were declared through Define_Switch with an Output
+ -- parameter are never returned (and result in a modification of the Output
+ -- variable). This function will in fact never call [Callback] if all
+ -- switches were handled automatically and there is nothing left to do.
+ --
+ -- This procedure automatically adds -h and --help to the valid switches,
+ -- to display the help message and raises Exit_From_Command_Line.
+ -- If an invalid switch is specified on the command line, this procedure
+ -- will display an error message and raises Invalid_Switch again.
+ --
+ -- This function automatically expands switches:
+ -- * If Define_Prefix was called (for instance "-gnaty") and the user
+ -- specifies "-gnatycb" on the command line, then Getopt returns
+ -- "-gnatyc" and "-gnatyb" separately.
+ -- * If Define_Alias was called (for instance "-gnatya = -gnatycb") then
+ -- the latter is returned (in this case it also expands -gnaty as per
+ -- the above.
+ -- The goal is to make handling as easy as possible by leaving as much
+ -- work as possible to this package.
+ --
+ -- As opposed to the standard Getopt, this one will analyze all sections
+ -- as defined by Define_Section, and automatically jump from one section to
+ -- the next.
+
------------------------------
-- Generating command lines --
------------------------------
-- subprograms will properly take care of grouping switches when possible,
-- so as to keep the command line as short as possible. They also provide a
-- way to remove a switch from an existing command line.
+ -- For instance:
+ -- declare
+ -- Config : Command_Line_Configuration;
+ -- Line : Command_Line;
+ -- Args : Argument_List_Access;
+ -- begin
+ -- Define_Switch (Config, "-gnatyc");
+ -- Define_Switch (Config, ...); -- for all valid switches
+ -- Define_Prefix (Config, "-gnaty");
+ --
+ -- Set_Configuration (Line, Config);
+ -- Add_Switch (Line, "-O2");
+ -- Add_Switch (Line, "-gnatyc");
+ -- Add_Switch (Line, "-gnatyd");
+ --
+ -- Build (Line, Args);
+ -- -- Args is now ["-O2", "-gnatycd"]
+ -- end;
type Command_Line is private;
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
- Separator : Character := ' ';
Section : String := "";
Add_Before : Boolean := False);
-- Add a new switch to the command line, and combine/group it with existing
-- A Switch with a parameter will never be grouped with another switch to
-- avoid ambiguities as to what the parameter applies to.
--
- -- Separator is the character that goes between the switches and its
- -- parameter on the command line. If it is set to ASCII.NUL, then no
- -- separator is applied, and they are concatenated.
- --
-- If the switch is part of a section, then it should be specified so that
-- the switch is correctly placed in the command line, and the section
-- added if not already present. For example, to add the -g switch into the
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
- Separator : Character := ' ';
Section : String := "";
Add_Before : Boolean := False;
Success : out Boolean);
procedure Next (Iter : in out Command_Line_Iterator);
-- Move to the next switch
+ procedure Build
+ (Line : in out Command_Line;
+ Args : out GNAT.OS_Lib.Argument_List_Access;
+ Expanded : Boolean := False;
+ Switch_Char : Character := '-');
+ -- This is a wrapper using the Command_Line_Iterator.
+ -- It provides a simple way to get all switches (grouped as much as
+ -- possible), and possibly create an Opt_Parser.
+ -- [Args] must be freed by the caller.
+ -- [Expanded] has the same meaning as in [Start].
+
private
Max_Depth : constant := 100;
Command_Line_Parser : constant Opt_Parser :=
Command_Line_Parser_Data'Access;
+ type Switch_Type is (Switch_Untyped,
+ Switch_Boolean,
+ Switch_Integer,
+ Switch_String);
+
+ type Switch_Definition (Typ : Switch_Type := Switch_Untyped) is record
+ Switch : GNAT.OS_Lib.String_Access;
+ Long_Switch : GNAT.OS_Lib.String_Access;
+ Section : GNAT.OS_Lib.String_Access;
+ Help : GNAT.OS_Lib.String_Access;
+
+ case Typ is
+ when Switch_Untyped =>
+ null;
+ when Switch_Boolean =>
+ Boolean_Output : access Boolean;
+ Boolean_Value : Boolean; -- will set Output to that value
+ when Switch_Integer =>
+ Integer_Output : access Integer;
+ Integer_Initial : Integer;
+ Integer_Default : Integer;
+ when Switch_String =>
+ String_Output : access GNAT.Strings.String_Access;
+ end case;
+ end record;
+ type Switch_Definitions is array (Natural range <>) of Switch_Definition;
+ type Switch_Definitions_List is access all Switch_Definitions;
+ -- [Switch] includes the leading '-'
+
+ type Alias_Definition is record
+ Alias : GNAT.OS_Lib.String_Access;
+ Expansion : GNAT.OS_Lib.String_Access;
+ Section : GNAT.OS_Lib.String_Access;
+ end record;
+ type Alias_Definitions is array (Natural range <>) of Alias_Definition;
+ type Alias_Definitions_List is access all Alias_Definitions;
+
type Command_Line_Configuration_Record is record
- Prefixes : GNAT.OS_Lib.Argument_List_Access;
+ Prefixes : GNAT.OS_Lib.Argument_List_Access;
-- The list of prefixes
- Sections : GNAT.OS_Lib.Argument_List_Access;
+ Sections : GNAT.OS_Lib.Argument_List_Access;
-- The list of sections
- Aliases : GNAT.OS_Lib.Argument_List_Access;
- Expansions : GNAT.OS_Lib.Argument_List_Access;
- -- The aliases (Both arrays have the same bounds)
-
- Switches : GNAT.OS_Lib.Argument_List_Access;
+ Aliases : Alias_Definitions_List;
+ Usage : GNAT.OS_Lib.String_Access;
+ Help : GNAT.OS_Lib.String_Access;
+ Switches : Switch_Definitions_List;
-- List of expected switches (Used when expanding switch groups)
end record;
type Command_Line_Configuration is access Command_Line_Configuration_Record;
OSDN Git Service
