1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . C O M M A N D _ L I N E --
9 -- Copyright (C) 1999-2014, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada.Characters.Handling; use Ada.Characters.Handling;
33 with Ada.Strings.Unbounded;
34 with Ada.Text_IO; use Ada.Text_IO;
35 with Ada.Unchecked_Deallocation;
37 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
38 with GNAT.OS_Lib; use GNAT.OS_Lib;
40 package body GNAT.Command_Line is
42 -- General note: this entire body could use much more commenting. There
43 -- are large sections of uncommented code throughout, and many formal
44 -- parameters of local subprograms are not documented at all ???
46 package CL renames Ada.Command_Line;
48 type Switch_Parameter_Type is
50 Parameter_With_Optional_Space, -- ':' in getopt
51 Parameter_With_Space_Or_Equal, -- '=' in getopt
52 Parameter_No_Space, -- '!' in getopt
53 Parameter_Optional); -- '?' in getopt
55 procedure Set_Parameter
56 (Variable : out Parameter_Type;
60 Extra : Character := ASCII.NUL);
61 pragma Inline (Set_Parameter);
62 -- Set the parameter that will be returned by Parameter below
64 -- Extra is a character that needs to be added when reporting Full_Switch.
65 -- (it will in general be the switch character, for instance '-').
66 -- Otherwise, Full_Switch will report 'f' instead of '-f'. In particular,
67 -- it needs to be set when reporting an invalid switch or handling '*'.
69 -- Parameters need to be defined ???
71 function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean;
72 -- Go to the next argument on the command line. If we are at the end of
73 -- the current section, we want to make sure there is no other identical
74 -- section on the command line (there might be multiple instances of
75 -- -largs). Returns True iff there is another argument.
77 function Get_File_Names_Case_Sensitive return Integer;
78 pragma Import (C, Get_File_Names_Case_Sensitive,
79 "__gnat_get_file_names_case_sensitive");
81 File_Names_Case_Sensitive : constant Boolean :=
82 Get_File_Names_Case_Sensitive /= 0;
84 procedure Canonical_Case_File_Name (S : in out String);
85 -- Given a file name, converts it to canonical case form. For systems where
86 -- file names are case sensitive, this procedure has no effect. If file
87 -- names are not case sensitive (i.e. for example if you have the file
88 -- "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
89 -- converts the given string to canonical all lower case form, so that two
90 -- file names compare equal if they refer to the same file.
92 procedure Internal_Initialize_Option_Scan
94 Switch_Char : Character;
95 Stop_At_First_Non_Switch : Boolean;
96 Section_Delimiters : String);
97 -- Initialize Parser, which must have been allocated already
99 function Argument (Parser : Opt_Parser; Index : Integer) return String;
100 -- Return the index-th command line argument
102 procedure Find_Longest_Matching_Switch
105 Index_In_Switches : out Integer;
106 Switch_Length : out Integer;
107 Param : out Switch_Parameter_Type);
108 -- Return the Longest switch from Switches that at least partially matches
109 -- Arg. Index_In_Switches is set to 0 if none matches. What are other
110 -- parameters??? in particular Param is not always set???
112 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
113 (Argument_List, Argument_List_Access);
115 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
116 (Command_Line_Configuration_Record, Command_Line_Configuration);
118 procedure Remove (Line : in out Argument_List_Access; Index : Integer);
119 -- Remove a specific element from Line
122 (Line : in out Argument_List_Access;
124 Before : Boolean := False);
125 -- Add a new element to Line. If Before is True, the item is inserted at
126 -- the beginning, else it is appended.
129 (Config : in out Command_Line_Configuration;
130 Switch : Switch_Definition);
132 (Def : in out Alias_Definitions_List;
133 Alias : Alias_Definition);
134 -- Add a new element to Def
136 procedure Initialize_Switch_Def
137 (Def : out Switch_Definition;
138 Switch : String := "";
139 Long_Switch : String := "";
141 Section : String := "";
142 Argument : String := "ARG");
143 -- Initialize [Def] with the contents of the other parameters.
144 -- This also checks consistency of the switch parameters, and will raise
145 -- Invalid_Switch if they do not match.
147 procedure Decompose_Switch
149 Parameter_Type : out Switch_Parameter_Type;
150 Switch_Last : out Integer);
151 -- Given a switch definition ("name:" for instance), extracts the type of
152 -- parameter that is expected, and the name of the switch
154 function Can_Have_Parameter (S : String) return Boolean;
155 -- True if S can have a parameter
157 function Require_Parameter (S : String) return Boolean;
158 -- True if S requires a parameter
160 function Actual_Switch (S : String) return String;
161 -- Remove any possible trailing '!', ':', '?' and '='
164 with procedure Callback
165 (Simple_Switch : String;
168 Index : Integer); -- Index in Config.Switches, or -1
169 procedure For_Each_Simple_Switch
170 (Config : Command_Line_Configuration;
173 Parameter : String := "";
174 Unalias : Boolean := True);
175 -- Breaks Switch into as simple switches as possible (expanding aliases and
176 -- ungrouping common prefixes when possible), and call Callback for each of
179 procedure Sort_Sections
180 (Line : GNAT.OS_Lib.Argument_List_Access;
181 Sections : GNAT.OS_Lib.Argument_List_Access;
182 Params : GNAT.OS_Lib.Argument_List_Access);
183 -- Reorder the command line switches so that the switches belonging to a
184 -- section are grouped together.
186 procedure Group_Switches
188 Result : Argument_List_Access;
189 Sections : Argument_List_Access;
190 Params : Argument_List_Access);
191 -- Group switches with common prefixes whenever possible. Once they have
192 -- been grouped, we also check items for possible aliasing.
194 procedure Alias_Switches
196 Result : Argument_List_Access;
197 Params : Argument_List_Access);
198 -- When possible, replace one or more switches by an alias, i.e. a shorter
204 Substring : String) return Boolean;
205 -- Return True if the characters starting at Index in Type_Str are
206 -- equivalent to Substring.
209 with function Callback (S : String; Index : Integer) return Boolean;
210 procedure Foreach_Switch
211 (Config : Command_Line_Configuration;
213 -- Iterate over all switches defined in Config, for a specific section.
214 -- Index is set to the index in Config.Switches. Stop iterating when
215 -- Callback returns False.
221 function Argument (Parser : Opt_Parser; Index : Integer) return String is
223 if Parser.Arguments /= null then
224 return Parser.Arguments (Index + Parser.Arguments'First - 1).all;
226 return CL.Argument (Index);
230 ------------------------------
231 -- Canonical_Case_File_Name --
232 ------------------------------
234 procedure Canonical_Case_File_Name (S : in out String) is
236 if not File_Names_Case_Sensitive then
237 for J in S'Range loop
238 if S (J) in 'A' .. 'Z' then
239 S (J) := Character'Val
240 (Character'Pos (S (J)) +
241 (Character'Pos ('a') - Character'Pos ('A')));
245 end Canonical_Case_File_Name;
251 function Expansion (Iterator : Expansion_Iterator) return String is
252 type Pointer is access all Expansion_Iterator;
254 It : constant Pointer := Iterator'Unrestricted_Access;
255 S : String (1 .. 1024);
258 Current : Depth := It.Current_Depth;
262 -- It is assumed that a directory is opened at the current level.
263 -- Otherwise GNAT.Directory_Operations.Directory_Error will be raised
264 -- at the first call to Read.
267 Read (It.Levels (Current).Dir, S, Last);
269 -- If we have exhausted the directory, close it and go back one level
272 Close (It.Levels (Current).Dir);
274 -- If we are at level 1, we are finished; return an empty string
277 return String'(1 .. 0 => ' ');
279 -- Otherwise continue with the directory at the previous level
282 Current := Current - 1;
283 It.Current_Depth := Current;
286 -- If this is a directory, that is neither "." or "..", attempt to
287 -- go to the next level.
290 (It.Dir_Name (1 .. It.Levels (Current).Name_Last) &
292 and then S (1 .. Last) /= "."
293 and then S (1 .. Last) /= ".."
295 -- We can go to the next level only if we have not reached the
298 if Current < It.Maximum_Depth then
299 NL := It.Levels (Current).Name_Last;
301 -- And if relative path of this new directory is not too long
303 if NL + Last + 1 < Max_Path_Length then
304 Current := Current + 1;
305 It.Current_Depth := Current;
306 It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
308 It.Dir_Name (NL) := Directory_Separator;
309 It.Levels (Current).Name_Last := NL;
310 Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
312 -- Open the new directory, and read from it
314 GNAT.Directory_Operations.Open
315 (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
320 -- Check the relative path against the pattern
322 -- Note that we try to match also against directory names, since
323 -- clients of this function may expect to retrieve directories.
327 It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
331 Canonical_Case_File_Name (Name);
333 -- If it matches return the relative path
335 if GNAT.Regexp.Match (Name, Iterator.Regexp) then
342 ---------------------
343 -- Current_Section --
344 ---------------------
346 function Current_Section
347 (Parser : Opt_Parser := Command_Line_Parser) return String
350 if Parser.Current_Section = 1 then
354 for Index in reverse 1 .. Integer'Min (Parser.Current_Argument - 1,
357 if Parser.Section (Index) = 0 then
358 return Argument (Parser, Index);
370 (Parser : Opt_Parser := Command_Line_Parser) return String
373 if Parser.The_Switch.Extra = ASCII.NUL then
374 return Argument (Parser, Parser.The_Switch.Arg_Num)
375 (Parser.The_Switch.First .. Parser.The_Switch.Last);
377 return Parser.The_Switch.Extra
378 & Argument (Parser, Parser.The_Switch.Arg_Num)
379 (Parser.The_Switch.First .. Parser.The_Switch.Last);
387 function Get_Argument
388 (Do_Expansion : Boolean := False;
389 Parser : Opt_Parser := Command_Line_Parser) return String
392 if Parser.In_Expansion then
394 S : constant String := Expansion (Parser.Expansion_It);
396 if S'Length /= 0 then
399 Parser.In_Expansion := False;
404 if Parser.Current_Argument > Parser.Arg_Count then
406 -- If this is the first time this function is called
408 if Parser.Current_Index = 1 then
409 Parser.Current_Argument := 1;
410 while Parser.Current_Argument <= Parser.Arg_Count
411 and then Parser.Section (Parser.Current_Argument) /=
412 Parser.Current_Section
414 Parser.Current_Argument := Parser.Current_Argument + 1;
418 return String'(1 .. 0 => ' ');
421 elsif Parser.Section (Parser.Current_Argument) = 0 then
422 while Parser.Current_Argument <= Parser.Arg_Count
423 and then Parser.Section (Parser.Current_Argument) /=
424 Parser.Current_Section
426 Parser.Current_Argument := Parser.Current_Argument + 1;
430 Parser.Current_Index := Integer'Last;
432 while Parser.Current_Argument <= Parser.Arg_Count
433 and then Parser.Is_Switch (Parser.Current_Argument)
435 Parser.Current_Argument := Parser.Current_Argument + 1;
438 if Parser.Current_Argument > Parser.Arg_Count then
439 return String'(1 .. 0 => ' ');
440 elsif Parser.Section (Parser.Current_Argument) = 0 then
441 return Get_Argument (Do_Expansion);
444 Parser.Current_Argument := Parser.Current_Argument + 1;
446 -- Could it be a file name with wild cards to expand?
450 Arg : constant String :=
451 Argument (Parser, Parser.Current_Argument - 1);
453 for Index in Arg'Range loop
455 or else Arg (Index) = '?'
456 or else Arg (Index) = '['
458 Parser.In_Expansion := True;
459 Start_Expansion (Parser.Expansion_It, Arg);
460 return Get_Argument (Do_Expansion, Parser);
466 return Argument (Parser, Parser.Current_Argument - 1);
469 ----------------------
470 -- Decompose_Switch --
471 ----------------------
473 procedure Decompose_Switch
475 Parameter_Type : out Switch_Parameter_Type;
476 Switch_Last : out Integer)
480 Parameter_Type := Parameter_None;
481 Switch_Last := Switch'Last;
485 case Switch (Switch'Last) is
487 Parameter_Type := Parameter_With_Optional_Space;
488 Switch_Last := Switch'Last - 1;
490 Parameter_Type := Parameter_With_Space_Or_Equal;
491 Switch_Last := Switch'Last - 1;
493 Parameter_Type := Parameter_No_Space;
494 Switch_Last := Switch'Last - 1;
496 Parameter_Type := Parameter_Optional;
497 Switch_Last := Switch'Last - 1;
499 Parameter_Type := Parameter_None;
500 Switch_Last := Switch'Last;
502 end Decompose_Switch;
504 ----------------------------------
505 -- Find_Longest_Matching_Switch --
506 ----------------------------------
508 procedure Find_Longest_Matching_Switch
511 Index_In_Switches : out Integer;
512 Switch_Length : out Integer;
513 Param : out Switch_Parameter_Type)
516 Length : Natural := 1;
518 P : Switch_Parameter_Type;
521 Index_In_Switches := 0;
524 -- Remove all leading spaces first to make sure that Index points
525 -- at the start of the first switch.
527 Index := Switches'First;
528 while Index <= Switches'Last and then Switches (Index) = ' ' loop
532 while Index <= Switches'Last loop
534 -- Search the length of the parameter at this position in Switches
537 while Length <= Switches'Last
538 and then Switches (Length) /= ' '
540 Length := Length + 1;
543 -- Length now marks the separator after the current switch. Last will
544 -- mark the last character of the name of the switch.
546 if Length = Index + 1 then
550 Decompose_Switch (Switches (Index .. Length - 1), P, Last);
553 -- If it is the one we searched, it may be a candidate
555 if Arg'First + Last - Index <= Arg'Last
556 and then Switches (Index .. Last) =
557 Arg (Arg'First .. Arg'First + Last - Index)
558 and then Last - Index + 1 > Switch_Length
561 Index_In_Switches := Index;
562 Switch_Length := Last - Index + 1;
565 -- Look for the next switch in Switches
567 while Index <= Switches'Last
568 and then Switches (Index) /= ' '
575 end Find_Longest_Matching_Switch;
583 Concatenate : Boolean := True;
584 Parser : Opt_Parser := Command_Line_Parser) return Character
587 pragma Unreferenced (Dummy);
592 -- If we have finished parsing the current command line item (there
593 -- might be multiple switches in a single item), then go to the next
596 if Parser.Current_Argument > Parser.Arg_Count
597 or else (Parser.Current_Index >
598 Argument (Parser, Parser.Current_Argument)'Last
599 and then not Goto_Next_Argument_In_Section (Parser))
604 -- By default, the switch will not have a parameter
606 Parser.The_Parameter :=
607 (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
608 Parser.The_Separator := ASCII.NUL;
611 Arg : constant String :=
612 Argument (Parser, Parser.Current_Argument);
613 Index_Switches : Natural := 0;
614 Max_Length : Natural := 0;
616 Param : Switch_Parameter_Type;
618 -- If we are on a new item, test if this might be a switch
620 if Parser.Current_Index = Arg'First then
621 if Arg (Arg'First) /= Parser.Switch_Character then
623 -- If it isn't a switch, return it immediately. We also know it
624 -- isn't the parameter to a previous switch, since that has
625 -- already been handled.
627 if Switches (Switches'First) = '*' then
630 Arg_Num => Parser.Current_Argument,
633 Parser.Is_Switch (Parser.Current_Argument) := True;
634 Dummy := Goto_Next_Argument_In_Section (Parser);
638 if Parser.Stop_At_First then
639 Parser.Current_Argument := Positive'Last;
642 elsif not Goto_Next_Argument_In_Section (Parser) then
646 -- Recurse to get the next switch on the command line
652 -- We are on the first character of a new command line argument,
653 -- which starts with Switch_Character. Further analysis is needed.
655 Parser.Current_Index := Parser.Current_Index + 1;
656 Parser.Is_Switch (Parser.Current_Argument) := True;
659 Find_Longest_Matching_Switch
660 (Switches => Switches,
661 Arg => Arg (Parser.Current_Index .. Arg'Last),
662 Index_In_Switches => Index_Switches,
663 Switch_Length => Max_Length,
666 -- If switch is not accepted, it is either invalid or is returned
667 -- in the context of '*'.
669 if Index_Switches = 0 then
671 -- Find the current switch that we did not recognize. This is in
672 -- fact difficult because Getopt does not know explicitly about
673 -- short and long switches. Ideally, we would want the following
676 -- * for short switches, with Concatenate:
677 -- if -a is not recognized, and the command line has -daf
678 -- we should report the invalid switch as "-a".
680 -- * for short switches, wihtout Concatenate:
681 -- we should report the invalid switch as "-daf".
683 -- * for long switches:
684 -- if the commadn line is "--long" we should report --long
687 -- Unfortunately, the fact that long switches start with a
688 -- duplicate switch character is just a convention (so we could
689 -- have a long switch "-long" for instance). We'll still rely on
690 -- this convention here to try and get as helpful an error message
693 -- Long switch case (starting with double switch character)
695 if Arg (Arg'First + 1) = Parser.Switch_Character then
696 End_Index := Arg'Last;
702 (if Concatenate then Parser.Current_Index else Arg'Last);
705 if Switches (Switches'First) = '*' then
707 -- Always prepend the switch character, so that users know
708 -- that this comes from a switch on the command line. This
709 -- is especially important when Concatenate is False, since
710 -- otherwise the current argument first character is lost.
712 if Parser.Section (Parser.Current_Argument) = 0 then
714 -- A section transition should not be returned to the user
716 Dummy := Goto_Next_Argument_In_Section (Parser);
722 Arg_Num => Parser.Current_Argument,
723 First => Parser.Current_Index,
725 Extra => Parser.Switch_Character);
726 Parser.Is_Switch (Parser.Current_Argument) := True;
727 Dummy := Goto_Next_Argument_In_Section (Parser);
732 if Parser.Current_Index = Arg'First then
735 Arg_Num => Parser.Current_Argument,
736 First => Parser.Current_Index,
741 Arg_Num => Parser.Current_Argument,
742 First => Parser.Current_Index,
744 Extra => Parser.Switch_Character);
747 Parser.Current_Index := End_Index + 1;
749 raise Invalid_Switch;
752 End_Index := Parser.Current_Index + Max_Length - 1;
755 Arg_Num => Parser.Current_Argument,
756 First => Parser.Current_Index,
760 when Parameter_With_Optional_Space =>
761 if End_Index < Arg'Last then
763 (Parser.The_Parameter,
764 Arg_Num => Parser.Current_Argument,
765 First => End_Index + 1,
767 Dummy := Goto_Next_Argument_In_Section (Parser);
769 elsif Parser.Current_Argument < Parser.Arg_Count
770 and then Parser.Section (Parser.Current_Argument + 1) /= 0
772 Parser.Current_Argument := Parser.Current_Argument + 1;
773 Parser.The_Separator := ' ';
775 (Parser.The_Parameter,
776 Arg_Num => Parser.Current_Argument,
777 First => Argument (Parser, Parser.Current_Argument)'First,
778 Last => Argument (Parser, Parser.Current_Argument)'Last);
779 Parser.Is_Switch (Parser.Current_Argument) := True;
780 Dummy := Goto_Next_Argument_In_Section (Parser);
783 Parser.Current_Index := End_Index + 1;
784 raise Invalid_Parameter;
787 when Parameter_With_Space_Or_Equal =>
789 -- If the switch is of the form <switch>=xxx
791 if End_Index < Arg'Last then
792 if Arg (End_Index + 1) = '='
793 and then End_Index + 1 < Arg'Last
795 Parser.The_Separator := '=';
797 (Parser.The_Parameter,
798 Arg_Num => Parser.Current_Argument,
799 First => End_Index + 2,
801 Dummy := Goto_Next_Argument_In_Section (Parser);
804 Parser.Current_Index := End_Index + 1;
805 raise Invalid_Parameter;
808 -- Case of switch of the form <switch> xxx
810 elsif Parser.Current_Argument < Parser.Arg_Count
811 and then Parser.Section (Parser.Current_Argument + 1) /= 0
813 Parser.Current_Argument := Parser.Current_Argument + 1;
814 Parser.The_Separator := ' ';
816 (Parser.The_Parameter,
817 Arg_Num => Parser.Current_Argument,
818 First => Argument (Parser, Parser.Current_Argument)'First,
819 Last => Argument (Parser, Parser.Current_Argument)'Last);
820 Parser.Is_Switch (Parser.Current_Argument) := True;
821 Dummy := Goto_Next_Argument_In_Section (Parser);
824 Parser.Current_Index := End_Index + 1;
825 raise Invalid_Parameter;
828 when Parameter_No_Space =>
829 if End_Index < Arg'Last then
831 (Parser.The_Parameter,
832 Arg_Num => Parser.Current_Argument,
833 First => End_Index + 1,
835 Dummy := Goto_Next_Argument_In_Section (Parser);
838 Parser.Current_Index := End_Index + 1;
839 raise Invalid_Parameter;
842 when Parameter_Optional =>
843 if End_Index < Arg'Last then
845 (Parser.The_Parameter,
846 Arg_Num => Parser.Current_Argument,
847 First => End_Index + 1,
851 Dummy := Goto_Next_Argument_In_Section (Parser);
853 when Parameter_None =>
854 if Concatenate or else End_Index = Arg'Last then
855 Parser.Current_Index := End_Index + 1;
858 -- If Concatenate is False and the full argument is not
859 -- recognized as a switch, this is an invalid switch.
861 if Switches (Switches'First) = '*' then
864 Arg_Num => Parser.Current_Argument,
867 Parser.Is_Switch (Parser.Current_Argument) := True;
868 Dummy := Goto_Next_Argument_In_Section (Parser);
874 Arg_Num => Parser.Current_Argument,
875 First => Parser.Current_Index,
877 Extra => Parser.Switch_Character);
878 Parser.Current_Index := Arg'Last + 1;
879 raise Invalid_Switch;
883 return Switches (Index_Switches);
887 -----------------------------------
888 -- Goto_Next_Argument_In_Section --
889 -----------------------------------
891 function Goto_Next_Argument_In_Section
892 (Parser : Opt_Parser) return Boolean
895 Parser.Current_Argument := Parser.Current_Argument + 1;
897 if Parser.Current_Argument > Parser.Arg_Count
898 or else Parser.Section (Parser.Current_Argument) = 0
901 Parser.Current_Argument := Parser.Current_Argument + 1;
903 if Parser.Current_Argument > Parser.Arg_Count then
904 Parser.Current_Index := 1;
908 exit when Parser.Section (Parser.Current_Argument) =
909 Parser.Current_Section;
913 Parser.Current_Index :=
914 Argument (Parser, Parser.Current_Argument)'First;
917 end Goto_Next_Argument_In_Section;
923 procedure Goto_Section
924 (Name : String := "";
925 Parser : Opt_Parser := Command_Line_Parser)
930 Parser.In_Expansion := False;
933 Parser.Current_Argument := 1;
934 Parser.Current_Index := 1;
935 Parser.Current_Section := 1;
940 while Index <= Parser.Arg_Count loop
941 if Parser.Section (Index) = 0
942 and then Argument (Parser, Index) = Parser.Switch_Character & Name
944 Parser.Current_Argument := Index + 1;
945 Parser.Current_Index := 1;
947 if Parser.Current_Argument <= Parser.Arg_Count then
948 Parser.Current_Section :=
949 Parser.Section (Parser.Current_Argument);
952 -- Exit from loop if we have the start of another section
954 if Index = Parser.Section'Last
955 or else Parser.Section (Index + 1) /= 0
964 Parser.Current_Argument := Positive'Last;
965 Parser.Current_Index := 2; -- so that Get_Argument returns nothing
968 ----------------------------
969 -- Initialize_Option_Scan --
970 ----------------------------
972 procedure Initialize_Option_Scan
973 (Switch_Char : Character := '-';
974 Stop_At_First_Non_Switch : Boolean := False;
975 Section_Delimiters : String := "")
978 Internal_Initialize_Option_Scan
979 (Parser => Command_Line_Parser,
980 Switch_Char => Switch_Char,
981 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
982 Section_Delimiters => Section_Delimiters);
983 end Initialize_Option_Scan;
985 ----------------------------
986 -- Initialize_Option_Scan --
987 ----------------------------
989 procedure Initialize_Option_Scan
990 (Parser : out Opt_Parser;
991 Command_Line : GNAT.OS_Lib.Argument_List_Access;
992 Switch_Char : Character := '-';
993 Stop_At_First_Non_Switch : Boolean := False;
994 Section_Delimiters : String := "")
999 if Command_Line = null then
1000 Parser := new Opt_Parser_Data (CL.Argument_Count);
1001 Internal_Initialize_Option_Scan
1003 Switch_Char => Switch_Char,
1004 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
1005 Section_Delimiters => Section_Delimiters);
1007 Parser := new Opt_Parser_Data (Command_Line'Length);
1008 Parser.Arguments := Command_Line;
1009 Internal_Initialize_Option_Scan
1011 Switch_Char => Switch_Char,
1012 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
1013 Section_Delimiters => Section_Delimiters);
1015 end Initialize_Option_Scan;
1017 -------------------------------------
1018 -- Internal_Initialize_Option_Scan --
1019 -------------------------------------
1021 procedure Internal_Initialize_Option_Scan
1022 (Parser : Opt_Parser;
1023 Switch_Char : Character;
1024 Stop_At_First_Non_Switch : Boolean;
1025 Section_Delimiters : String)
1027 Section_Num : Section_Number;
1028 Section_Index : Integer;
1030 Delimiter_Found : Boolean;
1033 pragma Warnings (Off, Discard);
1036 Parser.Current_Argument := 0;
1037 Parser.Current_Index := 0;
1038 Parser.In_Expansion := False;
1039 Parser.Switch_Character := Switch_Char;
1040 Parser.Stop_At_First := Stop_At_First_Non_Switch;
1041 Parser.Section := (others => 1);
1043 -- If we are using sections, we have to preprocess the command line to
1044 -- delimit them. A section can be repeated, so we just give each item
1045 -- on the command line a section number
1048 Section_Index := Section_Delimiters'First;
1049 while Section_Index <= Section_Delimiters'Last loop
1050 Last := Section_Index;
1051 while Last <= Section_Delimiters'Last
1052 and then Section_Delimiters (Last) /= ' '
1057 Delimiter_Found := False;
1058 Section_Num := Section_Num + 1;
1060 for Index in 1 .. Parser.Arg_Count loop
1061 if Argument (Parser, Index)(1) = Parser.Switch_Character
1063 Argument (Parser, Index) = Parser.Switch_Character &
1065 (Section_Index .. Last - 1)
1067 Parser.Section (Index) := 0;
1068 Delimiter_Found := True;
1070 elsif Parser.Section (Index) = 0 then
1072 -- A previous section delimiter
1074 Delimiter_Found := False;
1076 elsif Delimiter_Found then
1077 Parser.Section (Index) := Section_Num;
1081 Section_Index := Last + 1;
1082 while Section_Index <= Section_Delimiters'Last
1083 and then Section_Delimiters (Section_Index) = ' '
1085 Section_Index := Section_Index + 1;
1089 Discard := Goto_Next_Argument_In_Section (Parser);
1090 end Internal_Initialize_Option_Scan;
1097 (Parser : Opt_Parser := Command_Line_Parser) return String
1100 if Parser.The_Parameter.First > Parser.The_Parameter.Last then
1101 return String'(1 .. 0 => ' ');
1103 return Argument (Parser, Parser.The_Parameter.Arg_Num)
1104 (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
1113 (Parser : Opt_Parser := Command_Line_Parser) return Character
1116 return Parser.The_Separator;
1123 procedure Set_Parameter
1124 (Variable : out Parameter_Type;
1128 Extra : Character := ASCII.NUL)
1131 Variable.Arg_Num := Arg_Num;
1132 Variable.First := First;
1133 Variable.Last := Last;
1134 Variable.Extra := Extra;
1137 ---------------------
1138 -- Start_Expansion --
1139 ---------------------
1141 procedure Start_Expansion
1142 (Iterator : out Expansion_Iterator;
1144 Directory : String := "";
1145 Basic_Regexp : Boolean := True)
1147 Directory_Separator : Character;
1148 pragma Import (C, Directory_Separator, "__gnat_dir_separator");
1150 First : Positive := Pattern'First;
1151 Pat : String := Pattern;
1154 Canonical_Case_File_Name (Pat);
1155 Iterator.Current_Depth := 1;
1157 -- If Directory is unspecified, use the current directory ("./" or ".\")
1159 if Directory = "" then
1160 Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
1161 Iterator.Start := 3;
1164 Iterator.Dir_Name (1 .. Directory'Length) := Directory;
1165 Iterator.Start := Directory'Length + 1;
1166 Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
1168 -- Make sure that the last character is a directory separator
1170 if Directory (Directory'Last) /= Directory_Separator then
1171 Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
1172 Iterator.Start := Iterator.Start + 1;
1176 Iterator.Levels (1).Name_Last := Iterator.Start - 1;
1178 -- Open the initial Directory, at depth 1
1180 GNAT.Directory_Operations.Open
1181 (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
1183 -- If in the current directory and the pattern starts with "./" or ".\",
1184 -- drop the "./" or ".\" from the pattern.
1186 if Directory = "" and then Pat'Length > 2
1187 and then Pat (Pat'First) = '.'
1188 and then Pat (Pat'First + 1) = Directory_Separator
1190 First := Pat'First + 2;
1194 GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
1196 Iterator.Maximum_Depth := 1;
1198 -- Maximum_Depth is equal to 1 plus the number of directory separators
1201 for Index in First .. Pat'Last loop
1202 if Pat (Index) = Directory_Separator then
1203 Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
1204 exit when Iterator.Maximum_Depth = Max_Depth;
1207 end Start_Expansion;
1213 procedure Free (Parser : in out Opt_Parser) is
1214 procedure Unchecked_Free is new
1215 Ada.Unchecked_Deallocation (Opt_Parser_Data, Opt_Parser);
1217 if Parser /= null and then Parser /= Command_Line_Parser then
1218 Free (Parser.Arguments);
1219 Unchecked_Free (Parser);
1227 procedure Define_Alias
1228 (Config : in out Command_Line_Configuration;
1231 Section : String := "")
1233 Def : Alias_Definition;
1236 if Config = null then
1237 Config := new Command_Line_Configuration_Record;
1240 Def.Alias := new String'(Switch);
1241 Def.Expansion := new String'(Expanded);
1242 Def.Section := new String'(Section);
1243 Add (Config.Aliases, Def);
1250 procedure Define_Prefix
1251 (Config : in out Command_Line_Configuration;
1255 if Config = null then
1256 Config := new Command_Line_Configuration_Record;
1259 Add (Config.Prefixes, new String'(Prefix));
1267 (Config : in out Command_Line_Configuration;
1268 Switch : Switch_Definition)
1270 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1271 (Switch_Definitions, Switch_Definitions_List);
1273 Tmp : Switch_Definitions_List;
1276 if Config = null then
1277 Config := new Command_Line_Configuration_Record;
1280 Tmp := Config.Switches;
1283 Config.Switches := new Switch_Definitions (1 .. 1);
1285 Config.Switches := new Switch_Definitions (1 .. Tmp'Length + 1);
1286 Config.Switches (1 .. Tmp'Length) := Tmp.all;
1287 Unchecked_Free (Tmp);
1290 if Switch.Switch /= null and then Switch.Switch.all = "*" then
1291 Config.Star_Switch := True;
1294 Config.Switches (Config.Switches'Last) := Switch;
1302 (Def : in out Alias_Definitions_List;
1303 Alias : Alias_Definition)
1305 procedure Unchecked_Free is new
1306 Ada.Unchecked_Deallocation
1307 (Alias_Definitions, Alias_Definitions_List);
1309 Tmp : Alias_Definitions_List := Def;
1313 Def := new Alias_Definitions (1 .. 1);
1315 Def := new Alias_Definitions (1 .. Tmp'Length + 1);
1316 Def (1 .. Tmp'Length) := Tmp.all;
1317 Unchecked_Free (Tmp);
1320 Def (Def'Last) := Alias;
1323 ---------------------------
1324 -- Initialize_Switch_Def --
1325 ---------------------------
1327 procedure Initialize_Switch_Def
1328 (Def : out Switch_Definition;
1329 Switch : String := "";
1330 Long_Switch : String := "";
1331 Help : String := "";
1332 Section : String := "";
1333 Argument : String := "ARG")
1335 P1, P2 : Switch_Parameter_Type := Parameter_None;
1336 Last1, Last2 : Integer;
1339 if Switch /= "" then
1340 Def.Switch := new String'(Switch);
1341 Decompose_Switch (Switch, P1, Last1);
1344 if Long_Switch /= "" then
1345 Def.Long_Switch := new String'(Long_Switch);
1346 Decompose_Switch (Long_Switch, P2, Last2);
1349 if Switch /= "" and then Long_Switch /= "" then
1350 if (P1 = Parameter_None and then P2 /= P1)
1351 or else (P2 = Parameter_None and then P1 /= P2)
1352 or else (P1 = Parameter_Optional and then P2 /= P1)
1353 or else (P2 = Parameter_Optional and then P2 /= P1)
1355 raise Invalid_Switch
1356 with "Inconsistent parameter types for "
1357 & Switch & " and " & Long_Switch;
1361 if Section /= "" then
1362 Def.Section := new String'(Section);
1365 if Argument /= "ARG" then
1366 Def.Argument := new String'(Argument);
1370 Def.Help := new String'(Help);
1372 end Initialize_Switch_Def;
1378 procedure Define_Switch
1379 (Config : in out Command_Line_Configuration;
1380 Switch : String := "";
1381 Long_Switch : String := "";
1382 Help : String := "";
1383 Section : String := "";
1384 Argument : String := "ARG")
1386 Def : Switch_Definition;
1388 if Switch /= "" or else Long_Switch /= "" then
1389 Initialize_Switch_Def
1390 (Def, Switch, Long_Switch, Help, Section, Argument);
1399 procedure Define_Switch
1400 (Config : in out Command_Line_Configuration;
1401 Output : access Boolean;
1402 Switch : String := "";
1403 Long_Switch : String := "";
1404 Help : String := "";
1405 Section : String := "";
1406 Value : Boolean := True)
1408 Def : Switch_Definition (Switch_Boolean);
1410 if Switch /= "" or else Long_Switch /= "" then
1411 Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
1412 Def.Boolean_Output := Output.all'Unchecked_Access;
1413 Def.Boolean_Value := Value;
1422 procedure Define_Switch
1423 (Config : in out Command_Line_Configuration;
1424 Output : access Integer;
1425 Switch : String := "";
1426 Long_Switch : String := "";
1427 Help : String := "";
1428 Section : String := "";
1429 Initial : Integer := 0;
1430 Default : Integer := 1;
1431 Argument : String := "ARG")
1433 Def : Switch_Definition (Switch_Integer);
1435 if Switch /= "" or else Long_Switch /= "" then
1436 Initialize_Switch_Def
1437 (Def, Switch, Long_Switch, Help, Section, Argument);
1438 Def.Integer_Output := Output.all'Unchecked_Access;
1439 Def.Integer_Default := Default;
1440 Def.Integer_Initial := Initial;
1449 procedure Define_Switch
1450 (Config : in out Command_Line_Configuration;
1451 Output : access GNAT.Strings.String_Access;
1452 Switch : String := "";
1453 Long_Switch : String := "";
1454 Help : String := "";
1455 Section : String := "";
1456 Argument : String := "ARG")
1458 Def : Switch_Definition (Switch_String);
1460 if Switch /= "" or else Long_Switch /= "" then
1461 Initialize_Switch_Def
1462 (Def, Switch, Long_Switch, Help, Section, Argument);
1463 Def.String_Output := Output.all'Unchecked_Access;
1468 --------------------
1469 -- Define_Section --
1470 --------------------
1472 procedure Define_Section
1473 (Config : in out Command_Line_Configuration;
1477 if Config = null then
1478 Config := new Command_Line_Configuration_Record;
1481 Add (Config.Sections, new String'(Section));
1484 --------------------
1485 -- Foreach_Switch --
1486 --------------------
1488 procedure Foreach_Switch
1489 (Config : Command_Line_Configuration;
1493 if Config /= null and then Config.Switches /= null then
1494 for J in Config.Switches'Range loop
1495 if (Section = "" and then Config.Switches (J).Section = null)
1497 (Config.Switches (J).Section /= null
1498 and then Config.Switches (J).Section.all = Section)
1500 exit when Config.Switches (J).Switch /= null
1501 and then not Callback (Config.Switches (J).Switch.all, J);
1503 exit when Config.Switches (J).Long_Switch /= null
1505 not Callback (Config.Switches (J).Long_Switch.all, J);
1515 function Get_Switches
1516 (Config : Command_Line_Configuration;
1517 Switch_Char : Character := '-';
1518 Section : String := "") return String
1520 Ret : Ada.Strings.Unbounded.Unbounded_String;
1521 use Ada.Strings.Unbounded;
1523 function Add_Switch (S : String; Index : Integer) return Boolean;
1524 -- Add a switch to Ret
1530 function Add_Switch (S : String; Index : Integer) return Boolean is
1531 pragma Unreferenced (Index);
1534 Ret := "*" & Ret; -- Always first
1535 elsif S (S'First) = Switch_Char then
1536 Append (Ret, " " & S (S'First + 1 .. S'Last));
1538 Append (Ret, " " & S);
1545 pragma Unreferenced (Tmp);
1547 procedure Foreach is new Foreach_Switch (Add_Switch);
1549 -- Start of processing for Get_Switches
1552 if Config = null then
1556 Foreach (Config, Section => Section);
1558 -- Add relevant aliases
1560 if Config.Aliases /= null then
1561 for A in Config.Aliases'Range loop
1562 if Config.Aliases (A).Section.all = Section then
1563 Tmp := Add_Switch (Config.Aliases (A).Alias.all, -1);
1568 return To_String (Ret);
1571 ------------------------
1572 -- Section_Delimiters --
1573 ------------------------
1575 function Section_Delimiters
1576 (Config : Command_Line_Configuration) return String
1578 use Ada.Strings.Unbounded;
1579 Result : Unbounded_String;
1582 if Config /= null and then Config.Sections /= null then
1583 for S in Config.Sections'Range loop
1584 Append (Result, " " & Config.Sections (S).all);
1588 return To_String (Result);
1589 end Section_Delimiters;
1591 -----------------------
1592 -- Set_Configuration --
1593 -----------------------
1595 procedure Set_Configuration
1596 (Cmd : in out Command_Line;
1597 Config : Command_Line_Configuration)
1600 Cmd.Config := Config;
1601 end Set_Configuration;
1603 -----------------------
1604 -- Get_Configuration --
1605 -----------------------
1607 function Get_Configuration
1608 (Cmd : Command_Line) return Command_Line_Configuration
1612 end Get_Configuration;
1614 ----------------------
1615 -- Set_Command_Line --
1616 ----------------------
1618 procedure Set_Command_Line
1619 (Cmd : in out Command_Line;
1621 Getopt_Description : String := "";
1622 Switch_Char : Character := '-')
1624 Tmp : Argument_List_Access;
1625 Parser : Opt_Parser;
1627 Section : String_Access := null;
1629 function Real_Full_Switch
1631 Parser : Opt_Parser) return String;
1632 -- Ensure that the returned switch value contains the Switch_Char prefix
1635 ----------------------
1636 -- Real_Full_Switch --
1637 ----------------------
1639 function Real_Full_Switch
1641 Parser : Opt_Parser) return String
1645 return Full_Switch (Parser);
1647 return Switch_Char & Full_Switch (Parser);
1649 end Real_Full_Switch;
1651 -- Start of processing for Set_Command_Line
1654 Free (Cmd.Expanded);
1657 if Switches /= "" then
1658 Tmp := Argument_String_To_List (Switches);
1659 Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1663 if Cmd.Config /= null then
1665 -- Do not use Getopt_Description in this case. Otherwise,
1666 -- if we have defined a prefix -gnaty, and two switches
1667 -- -gnatya and -gnatyL!, we would have a different behavior
1668 -- depending on the order of switches:
1670 -- -gnatyL1a => -gnatyL with argument "1a"
1671 -- -gnatyaL1 => -gnatya and -gnatyL with argument "1"
1673 -- This is because the call to Getopt below knows nothing
1674 -- about prefixes, and in the first case finds a valid
1675 -- switch with arguments, so returns it without analyzing
1676 -- the argument. In the second case, the switch matches "*",
1677 -- and is then decomposed below.
1679 -- Note: When a Command_Line object is associated with a
1680 -- Command_Line_Config (which is mostly the case for tools
1681 -- that let users choose the command line before spawning
1682 -- other tools, for instance IDEs), the configuration of
1683 -- the switches must be taken from the Command_Line_Config.
1685 S := Getopt (Switches => "* " & Get_Switches (Cmd.Config),
1686 Concatenate => False,
1690 S := Getopt (Switches => "* " & Getopt_Description,
1691 Concatenate => False,
1695 exit when S = ASCII.NUL;
1698 Sw : constant String := Real_Full_Switch (S, Parser);
1699 Is_Section : Boolean := False;
1702 if Cmd.Config /= null
1703 and then Cmd.Config.Sections /= null
1706 for S in Cmd.Config.Sections'Range loop
1707 if Sw = Cmd.Config.Sections (S).all then
1708 Section := Cmd.Config.Sections (S);
1711 exit Section_Search;
1713 end loop Section_Search;
1716 if not Is_Section then
1717 if Section = null then
1718 Add_Switch (Cmd, Sw, Parameter (Parser));
1721 (Cmd, Sw, Parameter (Parser),
1722 Section => Section.all);
1728 when Invalid_Parameter =>
1730 -- Add it with no parameter, if that's the way the user
1733 -- Specify the separator in all cases, as the switch might
1734 -- need to be unaliased, and the alias might contain
1735 -- switches with parameters.
1737 if Section = null then
1739 (Cmd, Switch_Char & Full_Switch (Parser));
1742 (Cmd, Switch_Char & Full_Switch (Parser),
1743 Section => Section.all);
1750 end Set_Command_Line;
1759 Substring : String) return Boolean
1762 return Index + Substring'Length - 1 <= Type_Str'Last
1763 and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1766 ------------------------
1767 -- Can_Have_Parameter --
1768 ------------------------
1770 function Can_Have_Parameter (S : String) return Boolean is
1772 if S'Length <= 1 then
1777 when '!' | ':' | '?' | '=' =>
1782 end Can_Have_Parameter;
1784 -----------------------
1785 -- Require_Parameter --
1786 -----------------------
1788 function Require_Parameter (S : String) return Boolean is
1790 if S'Length <= 1 then
1795 when '!' | ':' | '=' =>
1800 end Require_Parameter;
1806 function Actual_Switch (S : String) return String is
1808 if S'Length <= 1 then
1813 when '!' | ':' | '?' | '=' =>
1814 return S (S'First .. S'Last - 1);
1820 ----------------------------
1821 -- For_Each_Simple_Switch --
1822 ----------------------------
1824 procedure For_Each_Simple_Switch
1825 (Config : Command_Line_Configuration;
1828 Parameter : String := "";
1829 Unalias : Boolean := True)
1831 function Group_Analysis
1833 Group : String) return Boolean;
1834 -- Perform the analysis of a group of switches
1836 Found_In_Config : Boolean := False;
1837 function Is_In_Config
1838 (Config_Switch : String; Index : Integer) return Boolean;
1839 -- If Switch is the same as Config_Switch, run the callback and sets
1840 -- Found_In_Config to True.
1842 function Starts_With
1843 (Config_Switch : String; Index : Integer) return Boolean;
1844 -- if Switch starts with Config_Switch, sets Found_In_Config to True.
1845 -- The return value is for the Foreach_Switch iterator.
1847 --------------------
1848 -- Group_Analysis --
1849 --------------------
1851 function Group_Analysis
1853 Group : String) return Boolean
1858 function Analyze_Simple_Switch
1859 (Switch : String; Index : Integer) return Boolean;
1860 -- "Switches" is one of the switch definitions passed to the
1861 -- configuration, not one of the switches found on the command line.
1863 ---------------------------
1864 -- Analyze_Simple_Switch --
1865 ---------------------------
1867 function Analyze_Simple_Switch
1868 (Switch : String; Index : Integer) return Boolean
1870 pragma Unreferenced (Index);
1872 Full : constant String := Prefix & Group (Idx .. Group'Last);
1874 Sw : constant String := Actual_Switch (Switch);
1875 -- Switches definition minus argument definition
1881 -- Verify that sw starts with Prefix
1883 if Looking_At (Sw, Sw'First, Prefix)
1885 -- Verify that the group starts with sw
1887 and then Looking_At (Full, Full'First, Sw)
1889 Last := Idx + Sw'Length - Prefix'Length - 1;
1892 if Can_Have_Parameter (Switch) then
1894 -- Include potential parameter to the recursive call. Only
1895 -- numbers are allowed.
1897 while Last < Group'Last
1898 and then Group (Last + 1) in '0' .. '9'
1904 if not Require_Parameter (Switch) or else Last >= Param then
1905 if Idx = Group'First
1906 and then Last = Group'Last
1907 and then Last < Param
1909 -- The group only concerns a single switch. Do not
1910 -- perform recursive call.
1912 -- Note that we still perform a recursive call if
1913 -- a parameter is detected in the switch, as this
1914 -- is a way to correctly identify such a parameter
1922 -- Recursive call, using the detected parameter if any
1924 if Last >= Param then
1925 For_Each_Simple_Switch
1928 Prefix & Group (Idx .. Param - 1),
1929 Group (Param .. Last));
1932 For_Each_Simple_Switch
1933 (Config, Section, Prefix & Group (Idx .. Last), "");
1942 end Analyze_Simple_Switch;
1944 procedure Foreach is new Foreach_Switch (Analyze_Simple_Switch);
1946 -- Start of processing for Group_Analysis
1950 while Idx <= Group'Last loop
1952 Foreach (Config, Section);
1955 For_Each_Simple_Switch
1956 (Config, Section, Prefix & Group (Idx), "");
1968 function Is_In_Config
1969 (Config_Switch : String; Index : Integer) return Boolean
1972 P : Switch_Parameter_Type;
1975 Decompose_Switch (Config_Switch, P, Last);
1977 if Config_Switch (Config_Switch'First .. Last) = Switch then
1979 when Parameter_None =>
1980 if Parameter = "" then
1981 Callback (Switch, "", "", Index => Index);
1982 Found_In_Config := True;
1986 when Parameter_With_Optional_Space =>
1987 Callback (Switch, " ", Parameter, Index => Index);
1988 Found_In_Config := True;
1991 when Parameter_With_Space_Or_Equal =>
1992 Callback (Switch, "=", Parameter, Index => Index);
1993 Found_In_Config := True;
1996 when Parameter_No_Space =>
1997 Callback (Switch, "", Parameter, Index);
1998 Found_In_Config := True;
2001 when Parameter_Optional =>
2002 Callback (Switch, "", Parameter, Index);
2003 Found_In_Config := True;
2015 function Starts_With
2016 (Config_Switch : String; Index : Integer) return Boolean
2020 P : Switch_Parameter_Type;
2023 -- This function is called when we believe the parameter was
2024 -- specified as part of the switch, instead of separately. Thus we
2025 -- look in the config to find all possible switches.
2027 Decompose_Switch (Config_Switch, P, Last);
2030 (Switch, Switch'First,
2031 Config_Switch (Config_Switch'First .. Last))
2033 -- Set first char of Param, and last char of Switch
2035 Param := Switch'First + Last;
2036 Last := Switch'First + Last - Config_Switch'First;
2040 -- None is already handled in Is_In_Config
2042 when Parameter_None =>
2045 when Parameter_With_Space_Or_Equal =>
2046 if Param <= Switch'Last
2048 (Switch (Param) = ' ' or else Switch (Param) = '=')
2050 Callback (Switch (Switch'First .. Last),
2051 "=", Switch (Param + 1 .. Switch'Last), Index);
2052 Found_In_Config := True;
2056 when Parameter_With_Optional_Space =>
2057 if Param <= Switch'Last and then Switch (Param) = ' ' then
2061 Callback (Switch (Switch'First .. Last),
2062 " ", Switch (Param .. Switch'Last), Index);
2063 Found_In_Config := True;
2066 when Parameter_No_Space | Parameter_Optional =>
2067 Callback (Switch (Switch'First .. Last),
2068 "", Switch (Param .. Switch'Last), Index);
2069 Found_In_Config := True;
2076 procedure Foreach_In_Config is new Foreach_Switch (Is_In_Config);
2077 procedure Foreach_Starts_With is new Foreach_Switch (Starts_With);
2079 -- Start of processing for For_Each_Simple_Switch
2082 -- First determine if the switch corresponds to one belonging to the
2083 -- configuration. If so, run callback and exit.
2085 -- ??? Is this necessary. On simple tests, we seem to have the same
2086 -- results with or without this call.
2088 Foreach_In_Config (Config, Section);
2090 if Found_In_Config then
2094 -- If adding a switch that can in fact be expanded through aliases,
2095 -- add separately each of its expansions.
2097 -- This takes care of expansions like "-T" -> "-gnatwrs", where the
2098 -- alias and its expansion do not have the same prefix. Given the order
2099 -- in which we do things here, the expansion of the alias will itself
2100 -- be checked for a common prefix and split into simple switches.
2103 and then Config /= null
2104 and then Config.Aliases /= null
2106 for A in Config.Aliases'Range loop
2107 if Config.Aliases (A).Section.all = Section
2108 and then Config.Aliases (A).Alias.all = Switch
2109 and then Parameter = ""
2111 For_Each_Simple_Switch
2112 (Config, Section, Config.Aliases (A).Expansion.all, "");
2118 -- If adding a switch grouping several switches, add each of the simple
2119 -- switches instead.
2121 if Config /= null and then Config.Prefixes /= null then
2122 for P in Config.Prefixes'Range loop
2123 if Switch'Length > Config.Prefixes (P)'Length + 1
2125 Looking_At (Switch, Switch'First, Config.Prefixes (P).all)
2127 -- Alias expansion will be done recursively
2129 if Config.Switches = null then
2130 for S in Switch'First + Config.Prefixes (P)'Length
2133 For_Each_Simple_Switch
2135 Config.Prefixes (P).all & Switch (S), "");
2140 elsif Group_Analysis
2141 (Config.Prefixes (P).all,
2143 (Switch'First + Config.Prefixes (P)'Length .. Switch'Last))
2145 -- Recursive calls already done on each switch of the group:
2146 -- Return without executing Callback.
2154 -- Test if added switch is a known switch with parameter attached
2155 -- instead of being specified separately
2158 and then Config /= null
2159 and then Config.Switches /= null
2161 Found_In_Config := False;
2162 Foreach_Starts_With (Config, Section);
2164 if Found_In_Config then
2169 -- The switch is invalid in the config, but we still want to report it.
2170 -- The config could, for instance, include "*" to specify it accepts
2173 Callback (Switch, " ", Parameter, Index => -1);
2174 end For_Each_Simple_Switch;
2180 procedure Add_Switch
2181 (Cmd : in out Command_Line;
2183 Parameter : String := "";
2184 Separator : Character := ASCII.NUL;
2185 Section : String := "";
2186 Add_Before : Boolean := False)
2189 pragma Unreferenced (Success);
2191 Add_Switch (Cmd, Switch, Parameter, Separator,
2192 Section, Add_Before, Success);
2199 procedure Add_Switch
2200 (Cmd : in out Command_Line;
2202 Parameter : String := "";
2203 Separator : Character := ASCII.NUL;
2204 Section : String := "";
2205 Add_Before : Boolean := False;
2206 Success : out Boolean)
2208 procedure Add_Simple_Switch
2213 -- Add a new switch that has had all its aliases expanded, and switches
2214 -- ungrouped. We know there are no more aliases in Switches.
2216 -----------------------
2217 -- Add_Simple_Switch --
2218 -----------------------
2220 procedure Add_Simple_Switch
2230 and then Cmd.Config /= null
2231 and then not Cmd.Config.Star_Switch
2233 raise Invalid_Switch
2234 with "Invalid switch " & Simple;
2237 if Separator /= ASCII.NUL then
2240 elsif Sepa = "" then
2243 Sep := Sepa (Sepa'First);
2246 if Cmd.Expanded = null then
2247 Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
2251 new Argument_List'(1 .. 1 => new String'(Sep & Param));
2253 Cmd.Params := new Argument_List'(1 .. 1 => null);
2256 if Section = "" then
2257 Cmd.Sections := new Argument_List'(1 .. 1 => null);
2260 new Argument_List'(1 .. 1 => new String'(Section));
2264 -- Do we already have this switch?
2266 for C in Cmd.Expanded'Range loop
2267 if Cmd.Expanded (C).all = Simple
2269 ((Cmd.Params (C) = null and then Param = "")
2271 (Cmd.Params (C) /= null
2272 and then Cmd.Params (C).all = Sep & Param))
2274 ((Cmd.Sections (C) = null and then Section = "")
2276 (Cmd.Sections (C) /= null
2277 and then Cmd.Sections (C).all = Section))
2283 -- Inserting at least one switch
2286 Add (Cmd.Expanded, new String'(Simple), Add_Before);
2291 new String'(Sep & Param),
2300 if Section = "" then
2308 new String'(Section),
2312 end Add_Simple_Switch;
2314 procedure Add_Simple_Switches is
2315 new For_Each_Simple_Switch (Add_Simple_Switch);
2319 Section_Valid : Boolean := False;
2321 -- Start of processing for Add_Switch
2324 if Section /= "" and then Cmd.Config /= null then
2325 for S in Cmd.Config.Sections'Range loop
2326 if Section = Cmd.Config.Sections (S).all then
2327 Section_Valid := True;
2332 if not Section_Valid then
2333 raise Invalid_Section;
2338 Add_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2339 Free (Cmd.Coalesce);
2346 procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
2347 Tmp : Argument_List_Access := Line;
2350 Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
2352 if Index /= Tmp'First then
2353 Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
2358 if Index /= Tmp'Last then
2359 Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
2362 Unchecked_Free (Tmp);
2370 (Line : in out Argument_List_Access;
2371 Str : String_Access;
2372 Before : Boolean := False)
2374 Tmp : Argument_List_Access := Line;
2378 Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
2381 Line (Tmp'First) := Str;
2382 Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
2384 Line (Tmp'Range) := Tmp.all;
2385 Line (Tmp'Last + 1) := Str;
2388 Unchecked_Free (Tmp);
2391 Line := new Argument_List'(1 .. 1 => Str);
2399 procedure Remove_Switch
2400 (Cmd : in out Command_Line;
2402 Remove_All : Boolean := False;
2403 Has_Parameter : Boolean := False;
2404 Section : String := "")
2407 pragma Unreferenced (Success);
2409 Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
2416 procedure Remove_Switch
2417 (Cmd : in out Command_Line;
2419 Remove_All : Boolean := False;
2420 Has_Parameter : Boolean := False;
2421 Section : String := "";
2422 Success : out Boolean)
2424 procedure Remove_Simple_Switch
2425 (Simple, Separator, Param : String; Index : Integer);
2426 -- Removes a simple switch, with no aliasing or grouping
2428 --------------------------
2429 -- Remove_Simple_Switch --
2430 --------------------------
2432 procedure Remove_Simple_Switch
2433 (Simple, Separator, Param : String; Index : Integer)
2436 pragma Unreferenced (Param, Separator, Index);
2439 if Cmd.Expanded /= null then
2440 C := Cmd.Expanded'First;
2441 while C <= Cmd.Expanded'Last loop
2442 if Cmd.Expanded (C).all = Simple
2445 or else (Cmd.Sections (C) = null
2446 and then Section = "")
2447 or else (Cmd.Sections (C) /= null
2448 and then Section = Cmd.Sections (C).all))
2449 and then (not Has_Parameter or else Cmd.Params (C) /= null)
2451 Remove (Cmd.Expanded, C);
2452 Remove (Cmd.Params, C);
2453 Remove (Cmd.Sections, C);
2456 if not Remove_All then
2465 end Remove_Simple_Switch;
2467 procedure Remove_Simple_Switches is
2468 new For_Each_Simple_Switch (Remove_Simple_Switch);
2470 -- Start of processing for Remove_Switch
2474 Remove_Simple_Switches
2475 (Cmd.Config, Section, Switch, "", Unalias => not Has_Parameter);
2476 Free (Cmd.Coalesce);
2483 procedure Remove_Switch
2484 (Cmd : in out Command_Line;
2487 Section : String := "")
2489 procedure Remove_Simple_Switch
2490 (Simple, Separator, Param : String; Index : Integer);
2491 -- Removes a simple switch, with no aliasing or grouping
2493 --------------------------
2494 -- Remove_Simple_Switch --
2495 --------------------------
2497 procedure Remove_Simple_Switch
2498 (Simple, Separator, Param : String; Index : Integer)
2500 pragma Unreferenced (Separator, Index);
2504 if Cmd.Expanded /= null then
2505 C := Cmd.Expanded'First;
2506 while C <= Cmd.Expanded'Last loop
2507 if Cmd.Expanded (C).all = Simple
2509 ((Cmd.Sections (C) = null
2510 and then Section = "")
2512 (Cmd.Sections (C) /= null
2513 and then Section = Cmd.Sections (C).all))
2515 ((Cmd.Params (C) = null and then Param = "")
2517 (Cmd.Params (C) /= null
2519 -- Ignore the separator stored in Parameter
2522 Cmd.Params (C) (Cmd.Params (C)'First + 1
2523 .. Cmd.Params (C)'Last) = Param))
2525 Remove (Cmd.Expanded, C);
2526 Remove (Cmd.Params, C);
2527 Remove (Cmd.Sections, C);
2529 -- The switch is necessarily unique by construction of
2539 end Remove_Simple_Switch;
2541 procedure Remove_Simple_Switches is
2542 new For_Each_Simple_Switch (Remove_Simple_Switch);
2544 -- Start of processing for Remove_Switch
2547 Remove_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2548 Free (Cmd.Coalesce);
2551 --------------------
2552 -- Group_Switches --
2553 --------------------
2555 procedure Group_Switches
2556 (Cmd : Command_Line;
2557 Result : Argument_List_Access;
2558 Sections : Argument_List_Access;
2559 Params : Argument_List_Access)
2561 function Compatible_Parameter (Param : String_Access) return Boolean;
2562 -- True when the parameter can be part of a group
2564 --------------------------
2565 -- Compatible_Parameter --
2566 --------------------------
2568 function Compatible_Parameter (Param : String_Access) return Boolean is
2572 if Param = null then
2575 -- We need parameters without separators
2577 elsif Param (Param'First) /= ASCII.NUL then
2580 -- Parameters must be all digits
2583 for J in Param'First + 1 .. Param'Last loop
2584 if Param (J) not in '0' .. '9' then
2591 end Compatible_Parameter;
2593 -- Local declarations
2595 Group : Ada.Strings.Unbounded.Unbounded_String;
2597 use type Ada.Strings.Unbounded.Unbounded_String;
2599 -- Start of processing for Group_Switches
2602 if Cmd.Config = null or else Cmd.Config.Prefixes = null then
2606 for P in Cmd.Config.Prefixes'Range loop
2607 Group := Ada.Strings.Unbounded.Null_Unbounded_String;
2610 for C in Result'Range loop
2611 if Result (C) /= null
2612 and then Compatible_Parameter (Params (C))
2616 Cmd.Config.Prefixes (P).all)
2618 -- If we are still in the same section, group the switches
2622 (Sections (C) = null
2623 and then Sections (First) = null)
2625 (Sections (C) /= null
2626 and then Sections (First) /= null
2627 and then Sections (C).all = Sections (First).all)
2632 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2635 if Params (C) /= null then
2638 Params (C) (Params (C)'First + 1 .. Params (C)'Last);
2648 -- We changed section: we put the grouped switches to the first
2649 -- place, on continue with the new section.
2654 (Cmd.Config.Prefixes (P).all &
2655 Ada.Strings.Unbounded.To_String (Group));
2657 Ada.Strings.Unbounded.To_Unbounded_String
2659 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2669 (Cmd.Config.Prefixes (P).all &
2670 Ada.Strings.Unbounded.To_String (Group));
2675 --------------------
2676 -- Alias_Switches --
2677 --------------------
2679 procedure Alias_Switches
2680 (Cmd : Command_Line;
2681 Result : Argument_List_Access;
2682 Params : Argument_List_Access)
2687 procedure Check_Cb (Switch, Separator, Param : String; Index : Integer);
2688 -- Checks whether the command line contains [Switch]. Sets the global
2689 -- variable [Found] appropriately. This is called for each simple switch
2690 -- that make up an alias, to know whether the alias should be applied.
2692 procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer);
2693 -- Remove the simple switch [Switch] from the command line, since it is
2694 -- part of a simpler alias
2701 (Switch, Separator, Param : String; Index : Integer)
2703 pragma Unreferenced (Separator, Index);
2707 for E in Result'Range loop
2708 if Result (E) /= null
2711 or else Params (E) (Params (E)'First + 1 ..
2712 Params (E)'Last) = Param)
2713 and then Result (E).all = Switch
2727 procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer)
2729 pragma Unreferenced (Separator, Index);
2732 for E in Result'Range loop
2733 if Result (E) /= null
2736 or else Params (E) (Params (E)'First + 1
2737 .. Params (E)'Last) = Param)
2738 and then Result (E).all = Switch
2751 procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
2752 procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
2754 -- Start of processing for Alias_Switches
2757 if Cmd.Config = null or else Cmd.Config.Aliases = null then
2761 for A in Cmd.Config.Aliases'Range loop
2763 -- Compute the various simple switches that make up the alias. We
2764 -- split the expansion into as many simple switches as possible, and
2765 -- then check whether the expanded command line has all of them.
2768 Check_All (Cmd.Config,
2769 Switch => Cmd.Config.Aliases (A).Expansion.all,
2770 Section => Cmd.Config.Aliases (A).Section.all);
2773 First := Integer'Last;
2774 Remove_All (Cmd.Config,
2775 Switch => Cmd.Config.Aliases (A).Expansion.all,
2776 Section => Cmd.Config.Aliases (A).Section.all);
2777 Result (First) := new String'(Cmd.Config.Aliases (A).Alias.all);
2786 procedure Sort_Sections
2787 (Line : GNAT.OS_Lib.Argument_List_Access;
2788 Sections : GNAT.OS_Lib.Argument_List_Access;
2789 Params : GNAT.OS_Lib.Argument_List_Access)
2791 Sections_List : Argument_List_Access :=
2792 new Argument_List'(1 .. 1 => null);
2794 Old_Line : constant Argument_List := Line.all;
2795 Old_Sections : constant Argument_List := Sections.all;
2796 Old_Params : constant Argument_List := Params.all;
2804 -- First construct a list of all sections
2806 for E in Line'Range loop
2807 if Sections (E) /= null then
2809 for S in Sections_List'Range loop
2810 if (Sections_List (S) = null and then Sections (E) = null)
2812 (Sections_List (S) /= null
2813 and then Sections (E) /= null
2814 and then Sections_List (S).all = Sections (E).all)
2822 Add (Sections_List, Sections (E));
2827 Index := Line'First;
2829 for S in Sections_List'Range loop
2830 for E in Old_Line'Range loop
2831 if (Sections_List (S) = null and then Old_Sections (E) = null)
2833 (Sections_List (S) /= null
2834 and then Old_Sections (E) /= null
2835 and then Sections_List (S).all = Old_Sections (E).all)
2837 Line (Index) := Old_Line (E);
2838 Sections (Index) := Old_Sections (E);
2839 Params (Index) := Old_Params (E);
2845 Unchecked_Free (Sections_List);
2853 (Cmd : in out Command_Line;
2854 Iter : in out Command_Line_Iterator;
2855 Expanded : Boolean := False)
2858 if Cmd.Expanded = null then
2863 -- Reorder the expanded line so that sections are grouped
2865 Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
2867 -- Coalesce the switches as much as possible
2870 and then Cmd.Coalesce = null
2872 Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
2873 for E in Cmd.Expanded'Range loop
2874 Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
2877 Free (Cmd.Coalesce_Sections);
2878 Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
2879 for E in Cmd.Sections'Range loop
2880 Cmd.Coalesce_Sections (E) :=
2881 (if Cmd.Sections (E) = null then null
2882 else new String'(Cmd.Sections (E).all));
2885 Free (Cmd.Coalesce_Params);
2886 Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
2887 for E in Cmd.Params'Range loop
2888 Cmd.Coalesce_Params (E) :=
2889 (if Cmd.Params (E) = null then null
2890 else new String'(Cmd.Params (E).all));
2893 -- Not a clone, since we will not modify the parameters anyway
2895 Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2897 (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2901 Iter.List := Cmd.Expanded;
2902 Iter.Params := Cmd.Params;
2903 Iter.Sections := Cmd.Sections;
2905 Iter.List := Cmd.Coalesce;
2906 Iter.Params := Cmd.Coalesce_Params;
2907 Iter.Sections := Cmd.Coalesce_Sections;
2910 if Iter.List = null then
2911 Iter.Current := Integer'Last;
2913 Iter.Current := Iter.List'First - 1;
2918 --------------------
2919 -- Current_Switch --
2920 --------------------
2922 function Current_Switch (Iter : Command_Line_Iterator) return String is
2924 return Iter.List (Iter.Current).all;
2927 --------------------
2928 -- Is_New_Section --
2929 --------------------
2931 function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is
2932 Section : constant String := Current_Section (Iter);
2935 if Iter.Sections = null then
2938 elsif Iter.Current = Iter.Sections'First
2939 or else Iter.Sections (Iter.Current - 1) = null
2941 return Section /= "";
2944 return Section /= Iter.Sections (Iter.Current - 1).all;
2948 ---------------------
2949 -- Current_Section --
2950 ---------------------
2952 function Current_Section (Iter : Command_Line_Iterator) return String is
2954 if Iter.Sections = null
2955 or else Iter.Current > Iter.Sections'Last
2956 or else Iter.Sections (Iter.Current) = null
2961 return Iter.Sections (Iter.Current).all;
2962 end Current_Section;
2964 -----------------------
2965 -- Current_Separator --
2966 -----------------------
2968 function Current_Separator (Iter : Command_Line_Iterator) return String is
2970 if Iter.Params = null
2971 or else Iter.Current > Iter.Params'Last
2972 or else Iter.Params (Iter.Current) = null
2978 Sep : constant Character :=
2979 Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
2981 if Sep = ASCII.NUL then
2988 end Current_Separator;
2990 -----------------------
2991 -- Current_Parameter --
2992 -----------------------
2994 function Current_Parameter (Iter : Command_Line_Iterator) return String is
2996 if Iter.Params = null
2997 or else Iter.Current > Iter.Params'Last
2998 or else Iter.Params (Iter.Current) = null
3003 -- Return result, skipping separator
3006 P : constant String := Iter.Params (Iter.Current).all;
3008 return P (P'First + 1 .. P'Last);
3011 end Current_Parameter;
3017 function Has_More (Iter : Command_Line_Iterator) return Boolean is
3019 return Iter.List /= null and then Iter.Current <= Iter.List'Last;
3026 procedure Next (Iter : in out Command_Line_Iterator) is
3028 Iter.Current := Iter.Current + 1;
3029 while Iter.Current <= Iter.List'Last
3030 and then Iter.List (Iter.Current) = null
3032 Iter.Current := Iter.Current + 1;
3040 procedure Free (Config : in out Command_Line_Configuration) is
3041 procedure Unchecked_Free is new
3042 Ada.Unchecked_Deallocation
3043 (Switch_Definitions, Switch_Definitions_List);
3045 procedure Unchecked_Free is new
3046 Ada.Unchecked_Deallocation
3047 (Alias_Definitions, Alias_Definitions_List);
3050 if Config /= null then
3051 Free (Config.Prefixes);
3052 Free (Config.Sections);
3053 Free (Config.Usage);
3055 Free (Config.Help_Msg);
3057 if Config.Aliases /= null then
3058 for A in Config.Aliases'Range loop
3059 Free (Config.Aliases (A).Alias);
3060 Free (Config.Aliases (A).Expansion);
3061 Free (Config.Aliases (A).Section);
3064 Unchecked_Free (Config.Aliases);
3067 if Config.Switches /= null then
3068 for S in Config.Switches'Range loop
3069 Free (Config.Switches (S).Switch);
3070 Free (Config.Switches (S).Long_Switch);
3071 Free (Config.Switches (S).Help);
3072 Free (Config.Switches (S).Section);
3075 Unchecked_Free (Config.Switches);
3078 Unchecked_Free (Config);
3086 procedure Free (Cmd : in out Command_Line) is
3088 Free (Cmd.Expanded);
3089 Free (Cmd.Coalesce);
3090 Free (Cmd.Coalesce_Sections);
3091 Free (Cmd.Coalesce_Params);
3093 Free (Cmd.Sections);
3101 (Config : in out Command_Line_Configuration;
3102 Usage : String := "[switches] [arguments]";
3103 Help : String := "";
3104 Help_Msg : String := "")
3107 if Config = null then
3108 Config := new Command_Line_Configuration_Record;
3111 Free (Config.Usage);
3113 Free (Config.Help_Msg);
3115 Config.Usage := new String'(Usage);
3116 Config.Help := new String'(Help);
3117 Config.Help_Msg := new String'(Help_Msg);
3124 procedure Display_Help (Config : Command_Line_Configuration) is
3125 function Switch_Name
3126 (Def : Switch_Definition;
3127 Section : String) return String;
3128 -- Return the "-short, --long=ARG" string for Def.
3129 -- Returns "" if the switch is not in the section.
3132 (P : Switch_Parameter_Type;
3133 Name : String := "ARG") return String;
3134 -- Return the display for a switch parameter
3136 procedure Display_Section_Help (Section : String);
3137 -- Display the help for a specific section ("" is the default section)
3139 --------------------------
3140 -- Display_Section_Help --
3141 --------------------------
3143 procedure Display_Section_Help (Section : String) is
3144 Max_Len : Natural := 0;
3147 -- ??? Special display for "*"
3151 if Section /= "" then
3152 Put_Line ("Switches after " & Section);
3155 -- Compute size of the switches column
3157 for S in Config.Switches'Range loop
3158 Max_Len := Natural'Max
3159 (Max_Len, Switch_Name (Config.Switches (S), Section)'Length);
3162 if Config.Aliases /= null then
3163 for A in Config.Aliases'Range loop
3164 if Config.Aliases (A).Section.all = Section then
3165 Max_Len := Natural'Max
3166 (Max_Len, Config.Aliases (A).Alias'Length);
3171 -- Display the switches
3173 for S in Config.Switches'Range loop
3175 N : constant String :=
3176 Switch_Name (Config.Switches (S), Section);
3182 Put ((1 .. Max_Len - N'Length + 1 => ' '));
3184 if Config.Switches (S).Help /= null then
3185 Put (Config.Switches (S).Help.all);
3193 -- Display the aliases
3195 if Config.Aliases /= null then
3196 for A in Config.Aliases'Range loop
3197 if Config.Aliases (A).Section.all = Section then
3199 Put (Config.Aliases (A).Alias.all);
3200 Put ((1 .. Max_Len - Config.Aliases (A).Alias'Length + 1
3202 Put ("Equivalent to " & Config.Aliases (A).Expansion.all);
3207 end Display_Section_Help;
3214 (P : Switch_Parameter_Type;
3215 Name : String := "ARG") return String
3219 when Parameter_None =>
3222 when Parameter_With_Optional_Space =>
3223 return " " & To_Upper (Name);
3225 when Parameter_With_Space_Or_Equal =>
3226 return "=" & To_Upper (Name);
3228 when Parameter_No_Space =>
3229 return To_Upper (Name);
3231 when Parameter_Optional =>
3232 return '[' & To_Upper (Name) & ']';
3240 function Switch_Name
3241 (Def : Switch_Definition;
3242 Section : String) return String
3244 use Ada.Strings.Unbounded;
3245 Result : Unbounded_String;
3246 P1, P2 : Switch_Parameter_Type;
3247 Last1, Last2 : Integer := 0;
3250 if (Section = "" and then Def.Section = null)
3251 or else (Def.Section /= null and then Def.Section.all = Section)
3253 if Def.Switch /= null and then Def.Switch.all = "*" then
3254 return "[any switch]";
3257 if Def.Switch /= null then
3258 Decompose_Switch (Def.Switch.all, P1, Last1);
3259 Append (Result, Def.Switch (Def.Switch'First .. Last1));
3261 if Def.Long_Switch /= null then
3262 Decompose_Switch (Def.Long_Switch.all, P2, Last2);
3263 Append (Result, ", "
3264 & Def.Long_Switch (Def.Long_Switch'First .. Last2));
3266 if Def.Argument = null then
3267 Append (Result, Param_Name (P2, "ARG"));
3269 Append (Result, Param_Name (P2, Def.Argument.all));
3273 if Def.Argument = null then
3274 Append (Result, Param_Name (P1, "ARG"));
3276 Append (Result, Param_Name (P1, Def.Argument.all));
3280 -- Def.Switch is null (Long_Switch must be non-null)
3283 Decompose_Switch (Def.Long_Switch.all, P2, Last2);
3285 Def.Long_Switch (Def.Long_Switch'First .. Last2));
3287 if Def.Argument = null then
3288 Append (Result, Param_Name (P2, "ARG"));
3290 Append (Result, Param_Name (P2, Def.Argument.all));
3295 return To_String (Result);
3298 -- Start of processing for Display_Help
3301 if Config = null then
3305 if Config.Help /= null and then Config.Help.all /= "" then
3306 Put_Line (Config.Help.all);
3309 if Config.Usage /= null then
3312 (Ada.Command_Line.Command_Name) & " " & Config.Usage.all);
3314 Put_Line ("Usage: " & Base_Name (Ada.Command_Line.Command_Name)
3315 & " [switches] [arguments]");
3318 if Config.Help_Msg /= null and then Config.Help_Msg.all /= "" then
3319 Put_Line (Config.Help_Msg.all);
3322 Display_Section_Help ("");
3324 if Config.Sections /= null and then Config.Switches /= null then
3325 for S in Config.Sections'Range loop
3326 Display_Section_Help (Config.Sections (S).all);
3337 (Config : Command_Line_Configuration;
3338 Callback : Switch_Handler := null;
3339 Parser : Opt_Parser := Command_Line_Parser;
3340 Concatenate : Boolean := True)
3342 Getopt_Switches : String_Access;
3343 C : Character := ASCII.NUL;
3345 Empty_Name : aliased constant String := "";
3346 Current_Section : Integer := -1;
3347 Section_Name : not null access constant String := Empty_Name'Access;
3349 procedure Simple_Callback
3350 (Simple_Switch : String;
3354 -- Needs comments ???
3356 procedure Do_Callback (Switch, Parameter : String; Index : Integer);
3362 procedure Do_Callback (Switch, Parameter : String; Index : Integer) is
3364 -- Do automatic handling when possible
3367 case Config.Switches (Index).Typ is
3368 when Switch_Untyped =>
3369 null; -- no automatic handling
3371 when Switch_Boolean =>
3372 Config.Switches (Index).Boolean_Output.all :=
3373 Config.Switches (Index).Boolean_Value;
3376 when Switch_Integer =>
3378 if Parameter = "" then
3379 Config.Switches (Index).Integer_Output.all :=
3380 Config.Switches (Index).Integer_Default;
3382 Config.Switches (Index).Integer_Output.all :=
3383 Integer'Value (Parameter);
3387 when Constraint_Error =>
3388 raise Invalid_Parameter
3389 with "Expected integer parameter for '"
3395 when Switch_String =>
3396 Free (Config.Switches (Index).String_Output.all);
3397 Config.Switches (Index).String_Output.all :=
3398 new String'(Parameter);
3404 -- Otherwise calls the user callback if one was defined
3406 if Callback /= null then
3407 Callback (Switch => Switch,
3408 Parameter => Parameter,
3409 Section => Section_Name.all);
3413 procedure For_Each_Simple
3414 is new For_Each_Simple_Switch (Simple_Callback);
3416 ---------------------
3417 -- Simple_Callback --
3418 ---------------------
3420 procedure Simple_Callback
3421 (Simple_Switch : String;
3426 pragma Unreferenced (Separator);
3428 Do_Callback (Switch => Simple_Switch,
3429 Parameter => Parameter,
3431 end Simple_Callback;
3433 -- Start of processing for Getopt
3436 -- Initialize sections
3438 if Config.Sections = null then
3439 Config.Sections := new Argument_List'(1 .. 0 => null);
3442 Internal_Initialize_Option_Scan
3444 Switch_Char => Parser.Switch_Character,
3445 Stop_At_First_Non_Switch => Parser.Stop_At_First,
3446 Section_Delimiters => Section_Delimiters (Config));
3448 Getopt_Switches := new String'
3449 (Get_Switches (Config, Parser.Switch_Character, Section_Name.all)
3452 -- Initialize output values for automatically handled switches
3454 for S in Config.Switches'Range loop
3455 case Config.Switches (S).Typ is
3456 when Switch_Untyped =>
3457 null; -- Nothing to do
3459 when Switch_Boolean =>
3460 Config.Switches (S).Boolean_Output.all :=
3461 not Config.Switches (S).Boolean_Value;
3463 when Switch_Integer =>
3464 Config.Switches (S).Integer_Output.all :=
3465 Config.Switches (S).Integer_Initial;
3467 when Switch_String =>
3468 if Config.Switches (S).String_Output.all = null then
3469 Config.Switches (S).String_Output.all := new String'("");
3474 -- For all sections, and all switches within those sections
3477 C := Getopt (Switches => Getopt_Switches.all,
3478 Concatenate => Concatenate,
3482 -- Full_Switch already includes the leading '-'
3484 Do_Callback (Switch => Full_Switch (Parser),
3485 Parameter => Parameter (Parser),
3488 elsif C /= ASCII.NUL then
3489 if Full_Switch (Parser) = "h"
3491 Full_Switch (Parser) = "-help"
3493 Display_Help (Config);
3494 raise Exit_From_Command_Line;
3497 -- Do switch expansion if needed
3501 Section => Section_Name.all,
3502 Switch => Parser.Switch_Character & Full_Switch (Parser),
3503 Parameter => Parameter (Parser));
3506 if Current_Section = -1 then
3507 Current_Section := Config.Sections'First;
3509 Current_Section := Current_Section + 1;
3512 exit when Current_Section > Config.Sections'Last;
3514 Section_Name := Config.Sections (Current_Section);
3515 Goto_Section (Section_Name.all, Parser);
3517 Free (Getopt_Switches);
3518 Getopt_Switches := new String'
3520 (Config, Parser.Switch_Character, Section_Name.all));
3524 Free (Getopt_Switches);
3527 when Invalid_Switch =>
3528 Free (Getopt_Switches);
3530 -- Message inspired by "ls" on Unix
3532 Put_Line (Standard_Error,
3533 Base_Name (Ada.Command_Line.Command_Name)
3534 & ": unrecognized option '"
3535 & Full_Switch (Parser)
3537 Put_Line (Standard_Error,
3539 & Base_Name (Ada.Command_Line.Command_Name)
3540 & " --help` for more information.");
3545 Free (Getopt_Switches);
3554 (Line : in out Command_Line;
3555 Args : out GNAT.OS_Lib.Argument_List_Access;
3556 Expanded : Boolean := False;
3557 Switch_Char : Character := '-')
3559 Iter : Command_Line_Iterator;
3560 Count : Natural := 0;
3563 Start (Line, Iter, Expanded => Expanded);
3564 while Has_More (Iter) loop
3565 if Is_New_Section (Iter) then
3573 Args := new Argument_List (1 .. Count);
3574 Count := Args'First;
3576 Start (Line, Iter, Expanded => Expanded);
3577 while Has_More (Iter) loop
3578 if Is_New_Section (Iter) then
3579 Args (Count) := new String'(Switch_Char & Current_Section (Iter));
3583 Args (Count) := new String'(Current_Switch (Iter)
3584 & Current_Separator (Iter)
3585 & Current_Parameter (Iter));
3591 end GNAT.Command_Line;