-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
package body GNAT.Command_Line is
+ -- General note: this entire body could use much more commenting. There
+ -- are large sections of uncommented code throughout, and many formal
+ -- parameters of local subprograms are not documented at all ???
+
package CL renames Ada.Command_Line;
type Switch_Parameter_Type is
Extra : Character := ASCII.NUL);
pragma Inline (Set_Parameter);
-- Set the parameter that will be returned by Parameter below
+ --
+ -- Extra is a character that needs to be added when reporting Full_Switch.
+ -- (it will in general be the switch character, for instance '-').
+ -- Otherwise, Full_Switch will report 'f' instead of '-f'. In particular,
+ -- it needs to be set when reporting an invalid switch or handling '*'.
+ --
-- Parameters need to be defined ???
function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean;
Index_In_Switches : out Integer;
Switch_Length : out Integer;
Param : out Switch_Parameter_Type);
- -- Return the Longest switch from Switches that at least partially
- -- partially Arg. Index_In_Switches is set to 0 if none matches.
- -- What are other parameters??? in particular Param is not always set???
+ -- Return the Longest switch from Switches that at least partially matches
+ -- Arg. Index_In_Switches is set to 0 if none matches. What are other
+ -- parameters??? in particular Param is not always set???
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Argument_List, Argument_List_Access);
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
- Section : String := "");
+ Section : String := "";
+ Argument : String := "ARG");
-- 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.
if Index_Switches = 0 then
- -- Depending on the value of Concatenate, the full switch is
- -- a single character or the rest of the argument.
+ -- Find the current switch that we did not recognize. This is in
+ -- fact difficult because Getopt does not know explicitly about
+ -- short and long switches. Ideally, we would want the following
+ -- behavior:
+
+ -- * for short switches, with Concatenate:
+ -- if -a is not recognized, and the command line has -daf
+ -- we should report the invalid switch as "-a".
+
+ -- * for short switches, wihtout Concatenate:
+ -- we should report the invalid switch as "-daf".
+
+ -- * for long switches:
+ -- if the commadn line is "--long" we should report --long
+ -- as unrecongized.
+
+ -- Unfortunately, the fact that long switches start with a
+ -- duplicate switch character is just a convention (so we could
+ -- have a long switch "-long" for instance). We'll still rely on
+ -- this convention here to try and get as helpful an error message
+ -- as possible.
- End_Index :=
- (if Concatenate then Parser.Current_Index else Arg'Last);
+ -- Long switch case (starting with double switch character)
+
+ if Arg (Arg'First + 1) = Parser.Switch_Character then
+ End_Index := Arg'Last;
+
+ -- Short switch case
+
+ else
+ End_Index :=
+ (if Concatenate then Parser.Current_Index else Arg'Last);
+ end if;
if Switches (Switches'First) = '*' then
- -- Always prepend the switch character, so that users know that
- -- this comes from a switch on the command line. This is
- -- especially important when Concatenate is False, since
+ -- Always prepend the switch character, so that users know
+ -- that this comes from a switch on the command line. This
+ -- is especially important when Concatenate is False, since
-- otherwise the current argument first character is lost.
if Parser.Section (Parser.Current_Argument) = 0 then
end if;
end if;
- Set_Parameter
- (Parser.The_Switch,
- Arg_Num => Parser.Current_Argument,
- First => Parser.Current_Index,
- Last => End_Index);
+ if Parser.Current_Index = Arg'First then
+ Set_Parameter
+ (Parser.The_Switch,
+ Arg_Num => Parser.Current_Argument,
+ First => Parser.Current_Index,
+ Last => End_Index);
+ else
+ Set_Parameter
+ (Parser.The_Switch,
+ Arg_Num => Parser.Current_Argument,
+ First => Parser.Current_Index,
+ Last => End_Index,
+ Extra => Parser.Switch_Character);
+ end if;
+
Parser.Current_Index := End_Index + 1;
raise Invalid_Switch;
raise Invalid_Parameter;
end if;
- -- If the switch is of the form <switch> xxx
+ -- Case of switch of the form <switch> xxx
elsif Parser.Current_Argument < Parser.Arg_Count
and then Parser.Section (Parser.Current_Argument + 1) /= 0
(Parser.The_Switch,
Arg_Num => Parser.Current_Argument,
First => Parser.Current_Index,
- Last => Arg'Last);
+ Last => Arg'Last,
+ Extra => Parser.Switch_Character);
Parser.Current_Index := Arg'Last + 1;
raise Invalid_Switch;
end if;
procedure Unchecked_Free is new
Ada.Unchecked_Deallocation (Opt_Parser_Data, Opt_Parser);
begin
- if Parser /= null
- and then Parser /= Command_Line_Parser
- then
+ if Parser /= null and then Parser /= Command_Line_Parser then
Free (Parser.Arguments);
Unchecked_Free (Parser);
end if;
Section : String := "")
is
Def : Alias_Definition;
+
begin
if Config = null then
Config := new Command_Line_Configuration_Record;
-- Add --
---------
- procedure Add (Def : in out Alias_Definitions_List;
- Alias : Alias_Definition)
+ procedure Add
+ (Def : in out Alias_Definitions_List;
+ Alias : Alias_Definition)
is
procedure Unchecked_Free is new
Ada.Unchecked_Deallocation
---------------------------
procedure Initialize_Switch_Def
- (Def : out Switch_Definition;
+ (Def : out Switch_Definition;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
- Section : String := "")
+ Section : String := "";
+ Argument : String := "ARG")
is
P1, P2 : Switch_Parameter_Type := Parameter_None;
Last1, Last2 : Integer;
Def.Section := new String'(Section);
end if;
+ if Argument /= "ARG" then
+ Def.Argument := new String'(Argument);
+ end if;
+
if Help /= "" then
Def.Help := new String'(Help);
end if;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
- Section : String := "")
+ Section : String := "";
+ Argument : String := "ARG")
is
Def : Switch_Definition;
begin
if Switch /= "" or else Long_Switch /= "" then
- Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
+ Initialize_Switch_Def
+ (Def, Switch, Long_Switch, Help, Section, Argument);
Add (Config, Def);
end if;
end Define_Switch;
Help : String := "";
Section : String := "";
Initial : Integer := 0;
- Default : Integer := 1)
+ Default : Integer := 1;
+ Argument : String := "ARG")
is
Def : Switch_Definition (Switch_Integer);
begin
if Switch /= "" or else Long_Switch /= "" then
- Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
+ Initialize_Switch_Def
+ (Def, Switch, Long_Switch, Help, Section, Argument);
Def.Integer_Output := Output.all'Unchecked_Access;
Def.Integer_Default := Default;
Def.Integer_Initial := Initial;
Switch : String := "";
Long_Switch : String := "";
Help : String := "";
- Section : String := "")
+ Section : String := "";
+ Argument : String := "ARG")
is
Def : Switch_Definition (Switch_String);
begin
if Switch /= "" or else Long_Switch /= "" then
- Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
+ Initialize_Switch_Def
+ (Def, Switch, Long_Switch, Help, Section, Argument);
Def.String_Output := Output.all'Unchecked_Access;
Add (Config, Def);
end if;
Foreach (Config, Section => Section);
- -- Adding relevant aliases
+ -- Add relevant aliases
if Config.Aliases /= null then
for A in Config.Aliases'Range loop
function Real_Full_Switch
(S : Character;
Parser : Opt_Parser) return String;
- -- Ensure that the returned switch value contains the
- -- Switch_Char prefix if needed.
+ -- Ensure that the returned switch value contains the Switch_Char prefix
+ -- if needed.
----------------------
-- Real_Full_Switch --
((Cmd.Params (C) = null and then Param = "")
or else
(Cmd.Params (C) /= null
- and then
- -- Ignore the separator stored in Parameter
+ -- Ignore the separator stored in Parameter
+ and then
Cmd.Params (C) (Cmd.Params (C)'First + 1
- .. Cmd.Params (C)'Last) =
- Param))
+ .. Cmd.Params (C)'Last) = Param))
then
Remove (Cmd.Expanded, C);
Remove (Cmd.Params, C);
-- Start of processing for Group_Switches
begin
- if Cmd.Config = null
- or else Cmd.Config.Prefixes = null
- then
+ if Cmd.Config = null or else Cmd.Config.Prefixes = null then
return;
end if;
First : Natural;
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.
+ -- Checks whether the command line contains [Switch]. Sets the global
+ -- variable [Found] appropriately. This is called for each simple switch
+ -- that make up an alias, to know whether the alias should be applied.
procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer);
-- Remove the simple switch [Switch] from the command line, since it is
-- Start of processing for Alias_Switches
begin
- if Cmd.Config = null
- or else Cmd.Config.Aliases = null
- then
+ if Cmd.Config = null or else Cmd.Config.Aliases = null then
return;
end if;
procedure Display_Help (Config : Command_Line_Configuration) is
function Switch_Name
- (Def : Switch_Definition;
+ (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 Switch_Name
- (Def : Switch_Definition;
+ (Def : Switch_Definition;
Section : String) return String
is
use Ada.Strings.Unbounded;
Decompose_Switch (Def.Long_Switch.all, P2, Last2);
Append (Result, ", "
& Def.Long_Switch (Def.Long_Switch'First .. Last2));
- Append (Result, Param_Name (P2, "ARG"));
+
+ if Def.Argument = null then
+ Append (Result, Param_Name (P2, "ARG"));
+ else
+ Append (Result, Param_Name (P2, Def.Argument.all));
+ end if;
else
- Append (Result, Param_Name (P1, "ARG"));
+ if Def.Argument = null then
+ Append (Result, Param_Name (P1, "ARG"));
+ else
+ Append (Result, Param_Name (P1, Def.Argument.all));
+ end if;
end if;
- else -- Long_Switch necessarily not null
+ -- Def.Switch is null (Long_Switch must be non-null)
+
+ else
Decompose_Switch (Def.Long_Switch.all, P2, Last2);
Append (Result,
Def.Long_Switch (Def.Long_Switch'First .. Last2));
- Append (Result, Param_Name (P2, "ARG"));
+
+ if Def.Argument = null then
+ Append (Result, Param_Name (P2, "ARG"));
+ else
+ Append (Result, Param_Name (P2, Def.Argument.all));
+ end if;
end if;
end if;
Config.Switches (S).Integer_Initial;
when Switch_String =>
- Config.Switches (S).String_Output.all := new String'("");
+ if Config.Switches (S).String_Output.all = null then
+ Config.Switches (S).String_Output.all := new String'("");
+ end if;
end case;
end loop;
Put_Line (Standard_Error,
Base_Name (Ada.Command_Line.Command_Name)
& ": unrecognized option '"
- & Parser.Switch_Character & Full_Switch (Parser)
+ & Full_Switch (Parser)
& "'");
Put_Line (Standard_Error,
"Try `"