diff --git a/example/src/clic_ex-commands-config.ads b/example/src/clic_ex-commands-config.ads index 9b074f8..20bbacc 100644 --- a/example/src/clic_ex-commands-config.ads +++ b/example/src/clic_ex-commands-config.ads @@ -14,8 +14,9 @@ package CLIC_Ex.Commands.Config is is ("config"); overriding - function Switches_As_Args (This : Instance) return Boolean - is (False); + function Switch_Parsing (This : Instance) + return CLIC.Subcommand.Switch_Parsing_Kind + is (CLIC.Subcommand.Parse_All); overriding procedure Execute (Cmd : in out Instance; diff --git a/example/src/clic_ex-commands-double_dash.adb b/example/src/clic_ex-commands-double_dash.adb new file mode 100644 index 0000000..76c87e4 --- /dev/null +++ b/example/src/clic_ex-commands-double_dash.adb @@ -0,0 +1,36 @@ +package body CLIC_Ex.Commands.Double_Dash is + + Upper_Case : aliased Boolean := False; + + ------------- + -- Execute -- + ------------- + + overriding + procedure Execute (Cmd : in out Instance; Args : AAA.Strings.Vector) + is + begin + if Upper_Case then + Ada.Text_IO.Put_Line (AAA.Strings.To_Upper_Case (Args.Flatten)); + else + Ada.Text_IO.Put_Line (Args.Flatten); + end if; + + end Execute; + + -------------------- + -- Setup_Switches -- + -------------------- + + overriding + procedure Setup_Switches + (Cmd : in out Instance; + Config : in out CLIC.Subcommand.Switches_Configuration) + is + begin + CLIC.Subcommand.Define_Switch (Config, + Output => Upper_Case'Access, + Long_Switch => "--upper"); + end Setup_Switches; + +end CLIC_Ex.Commands.Double_Dash; diff --git a/example/src/clic_ex-commands-double_dash.ads b/example/src/clic_ex-commands-double_dash.ads new file mode 100644 index 0000000..b46af2b --- /dev/null +++ b/example/src/clic_ex-commands-double_dash.ads @@ -0,0 +1,47 @@ +with AAA.Strings; + +with CLIC.Subcommand; + +package CLIC_Ex.Commands.Double_Dash is + + type Instance + is new CLIC.Subcommand.Command + with private; + + overriding + function Name (Cmd : Instance) return CLIC.Subcommand.Identifier + is ("double_dash"); + + overriding + function Switch_Parsing (This : Instance) + return CLIC.Subcommand.Switch_Parsing_Kind + is (CLIC.Subcommand.Before_Double_Dash); + + overriding + procedure Execute (Cmd : in out Instance; + Args : AAA.Strings.Vector); + + overriding + function Long_Description (Cmd : Instance) return AAA.Strings.Vector + is (AAA.Strings.Empty_Vector); + + overriding + procedure Setup_Switches + (Cmd : in out Instance; + Config : in out CLIC.Subcommand.Switches_Configuration); + + overriding + function Short_Description (Cmd : Instance) return String + is ("Switch parsing before -- (double dash)"); + + overriding + function Usage_Custom_Parameters (Cmd : Instance) return String + is ("[--upper] [--] [args]"); + +private + + type Instance + is new CLIC.Subcommand.Command + with null record; + +end CLIC_Ex.Commands.Double_Dash; diff --git a/example/src/clic_ex-commands-subsub.ads b/example/src/clic_ex-commands-subsub.ads index 0c8df6d..fc87221 100644 --- a/example/src/clic_ex-commands-subsub.ads +++ b/example/src/clic_ex-commands-subsub.ads @@ -13,8 +13,9 @@ package CLIC_Ex.Commands.Subsub is is ("subsub"); overriding - function Switches_As_Args (This : Instance) return Boolean - is (True); + function Switch_Parsing (This : Instance) + return CLIC.Subcommand.Switch_Parsing_Kind + is (CLIC.Subcommand.Parse_All); overriding procedure Execute (Cmd : in out Instance; diff --git a/example/src/clic_ex-commands-switches_and_args.ads b/example/src/clic_ex-commands-switches_and_args.ads index 65e81fd..d14052f 100644 --- a/example/src/clic_ex-commands-switches_and_args.ads +++ b/example/src/clic_ex-commands-switches_and_args.ads @@ -13,8 +13,9 @@ package CLIC_Ex.Commands.Switches_And_Args is is ("switches_and_args"); overriding - function Switches_As_Args (This : Instance) return Boolean - is (True); + function Switch_Parsing (This : Instance) + return CLIC.Subcommand.Switch_Parsing_Kind + is (CLIC.Subcommand.All_As_Args); overriding procedure Execute (Cmd : in out Instance; diff --git a/example/src/clic_ex-commands-tty.ads b/example/src/clic_ex-commands-tty.ads index a5b3e8f..2c4e561 100644 --- a/example/src/clic_ex-commands-tty.ads +++ b/example/src/clic_ex-commands-tty.ads @@ -13,8 +13,9 @@ package CLIC_Ex.Commands.TTY is is ("tty"); overriding - function Switches_As_Args (This : Instance) return Boolean - is (False); + function Switch_Parsing (This : Instance) + return CLIC.Subcommand.Switch_Parsing_Kind + is (CLIC.Subcommand.Parse_All); overriding procedure Execute (Cmd : in out Instance; diff --git a/example/src/clic_ex-commands-user_input.ads b/example/src/clic_ex-commands-user_input.ads index 26df19b..daf6bb1 100644 --- a/example/src/clic_ex-commands-user_input.ads +++ b/example/src/clic_ex-commands-user_input.ads @@ -13,8 +13,9 @@ package CLIC_Ex.Commands.User_Input is is ("user_input"); overriding - function Switches_As_Args (This : Instance) return Boolean - is (False); + function Switch_Parsing (This : Instance) + return CLIC.Subcommand.Switch_Parsing_Kind + is (CLIC.Subcommand.Parse_All); overriding procedure Execute (Cmd : in out Instance; diff --git a/example/src/clic_ex-commands.adb b/example/src/clic_ex-commands.adb index bd68dcc..247d6a2 100644 --- a/example/src/clic_ex-commands.adb +++ b/example/src/clic_ex-commands.adb @@ -7,6 +7,7 @@ with CLIC.Config.Load; with CLIC_Ex.Commands.TTY; with CLIC_Ex.Commands.User_Input; with CLIC_Ex.Commands.Switches_And_Args; +with CLIC_Ex.Commands.Double_Dash; with CLIC_Ex.Commands.Topics.Example; with CLIC_Ex.Commands.Config; with CLIC_Ex.Commands.Subsub; @@ -83,6 +84,7 @@ begin Sub_Cmd.Register (new CLIC_Ex.Commands.TTY.Instance); Sub_Cmd.Register (new CLIC_Ex.Commands.User_Input.Instance); Sub_Cmd.Register (new CLIC_Ex.Commands.Switches_And_Args.Instance); + Sub_Cmd.Register (new CLIC_Ex.Commands.Double_Dash.Instance); Sub_Cmd.Register (new CLIC_Ex.Commands.Subsub.Instance); Sub_Cmd.Register (new CLIC_Ex.Commands.Topics.Example.Instance); diff --git a/src/clic-subcommand-instance.adb b/src/clic-subcommand-instance.adb index 6c7877b..6cdc5a0 100644 --- a/src/clic-subcommand-instance.adb +++ b/src/clic-subcommand-instance.adb @@ -81,6 +81,41 @@ package body CLIC.Subcommand.Instance is procedure Process_Aliases with Pre => not Global_Arguments.Is_Empty; + procedure Split_At_Double_Dash (Args : AAA.Strings.Vector; + Before, After : out AAA.Strings.Vector) + with Post => (if not Args.Contains ("--") then Before."=" (Args)) + and then + not Before.Contains ("--"); + -- Split a vector of command line arguments, everything before a potential + -- first "--" (double dash) is added to the Before output, the arguments + -- after the "--" are added to the After output. The first "--" is not + -- added to either the Before or After output. + -- + -- When there is no "--" argument, Before is equal to Args. + + + -------------------------- + -- Split_At_Double_Dash -- + -------------------------- + + procedure Split_At_Double_Dash (Args : AAA.Strings.Vector; + Before, After : out AAA.Strings.Vector) + is + Before_Double_Dash : Boolean := True; + begin + for Elt of Args loop + if Before_Double_Dash then + if Elt = "--" then + Before_Double_Dash := False; + else + Before.Append (Elt); + end if; + else + After.Append (Elt); + end if; + end loop; + end Split_At_Double_Dash; + ------------------------- -- Put_Line_For_Access -- ------------------------- @@ -632,22 +667,37 @@ package body CLIC.Subcommand.Instance is Parser : Opt_Parser; - Sub_Arguments : AAA.Strings.Vector; + To_Parse, Sub_Arguments : AAA.Strings.Vector; begin -- Add command specific switches to the config. We don't need the -- global switches because they have been parsed before. Cmd.Setup_Switches (Command_Config); - if Cmd.Switches_As_Args then + case Cmd.Switch_Parsing is + when Parse_All => + -- Parse all global arguments + To_Parse := Global_Arguments; + Sub_Arguments := AAA.Strings.Empty_Vector; - -- Skip sub-command switch parsing as requested by the command - Sub_Arguments := Global_Arguments; - else + when Before_Double_Dash => + -- Only parse the arguments before a potential "--" + Split_At_Double_Dash (Global_Arguments, + Before => To_Parse, + After => Sub_Arguments); + + when All_As_Args => + -- Skip all sub-command switch parsing + To_Parse := AAA.Strings.Empty_Vector; + Sub_Arguments := Global_Arguments; + + end case; + + if not To_Parse.Is_Empty then -- Make a new command line argument list from the remaining -- arguments and switches after global parsing. - Sub_Cmd_Line := To_Argument_List (Global_Arguments); + Sub_Cmd_Line := To_Argument_List (To_Parse); -- Initialize a new switch parser that will only see the new -- sub-command line (i.e. the remaining args and switches after @@ -662,15 +712,21 @@ package body CLIC.Subcommand.Instance is -- Make a vector of arguments for the sub-command (every element -- that was not a switch in the sub-command line). - loop - declare - Arg : constant String := - CLIC.Command_Line.Get_Argument (Parser => Parser); - begin - exit when Arg = ""; - Sub_Arguments.Append (Arg); - end; - end loop; + declare + Args_After_Parsing : AAA.Strings.Vector; + begin + loop + declare + Arg : constant String := + CLIC.Command_Line.Get_Argument (Parser => Parser); + begin + exit when Arg = ""; + Args_After_Parsing.Append (Arg); + end; + end loop; + + Sub_Arguments.Prepend (Args_After_Parsing); + end; -- We don't need this anymore GNAT.OS_Lib.Free (Sub_Cmd_Line); diff --git a/src/clic-subcommand-instance.ads b/src/clic-subcommand-instance.ads index 27cbaa8..23074a3 100644 --- a/src/clic-subcommand-instance.ads +++ b/src/clic-subcommand-instance.ads @@ -101,8 +101,8 @@ private is ("help"); overriding - function Switches_As_Args (This : Builtin_Help) return Boolean - is (False); + function Switch_Parsing (This : Builtin_Help) return Switch_Parsing_Kind + is (Parse_All); overriding procedure Execute (This : in out Builtin_Help; diff --git a/src/clic-subcommand.ads b/src/clic-subcommand.ads index f3fe13c..105db56 100644 --- a/src/clic-subcommand.ads +++ b/src/clic-subcommand.ads @@ -82,7 +82,22 @@ package CLIC.Subcommand is -- This name is used to identify the sub-command in usage and command line. -- E.g. "my_app " will exectute the command. - function Switches_As_Args (Cmd : Command) return Boolean + type Switch_Parsing_Kind is + (Parse_All, + -- All the sub-command arguments are parsed for switches + + Before_Double_Dash, + -- Only the arguments before a potential "--" are parsed for switches. + -- The remaining switches and arguments are passed to the Args parameter + -- of the Execute primitive. + + All_As_Args + -- Sub-command arguments parsing is disabled, both the sub-command + -- switches and arguments passed to the Args parameter of the Execute + -- primitive. + ); + + function Switch_Parsing (Cmd : Command) return Switch_Parsing_Kind is abstract; -- Return True to skip sub-command switches parsing and get both the -- sub-command switches and arguments passed to the Args parameter of