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-2019, 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 : not null 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 wildcards 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;
491 Parameter_Type := Parameter_With_Space_Or_Equal;
492 Switch_Last := Switch'Last - 1;
495 Parameter_Type := Parameter_No_Space;
496 Switch_Last := Switch'Last - 1;
499 Parameter_Type := Parameter_Optional;
500 Switch_Last := Switch'Last - 1;
503 Parameter_Type := Parameter_None;
504 Switch_Last := Switch'Last;
506 end Decompose_Switch;
508 ----------------------------------
509 -- Find_Longest_Matching_Switch --
510 ----------------------------------
512 procedure Find_Longest_Matching_Switch
515 Index_In_Switches : out Integer;
516 Switch_Length : out Integer;
517 Param : out Switch_Parameter_Type)
520 Length : Natural := 1;
522 P : Switch_Parameter_Type;
525 Index_In_Switches := 0;
528 -- Remove all leading spaces first to make sure that Index points
529 -- at the start of the first switch.
531 Index := Switches'First;
532 while Index <= Switches'Last and then Switches (Index) = ' ' loop
536 while Index <= Switches'Last loop
538 -- Search the length of the parameter at this position in Switches
541 while Length <= Switches'Last
542 and then Switches (Length) /= ' '
544 Length := Length + 1;
547 -- Length now marks the separator after the current switch. Last will
548 -- mark the last character of the name of the switch.
550 if Length = Index + 1 then
554 Decompose_Switch (Switches (Index .. Length - 1), P, Last);
557 -- If it is the one we searched, it may be a candidate
559 if Arg'First + Last - Index <= Arg'Last
560 and then Switches (Index .. Last) =
561 Arg (Arg'First .. Arg'First + Last - Index)
562 and then Last - Index + 1 > Switch_Length
564 (P /= Parameter_With_Space_Or_Equal
565 or else Arg'Last = Arg'First + Last - Index
566 or else Arg (Arg'First + Last - Index + 1) = '=')
569 Index_In_Switches := Index;
570 Switch_Length := Last - Index + 1;
573 -- Look for the next switch in Switches
575 while Index <= Switches'Last
576 and then Switches (Index) /= ' '
583 end Find_Longest_Matching_Switch;
591 Concatenate : Boolean := True;
592 Parser : Opt_Parser := Command_Line_Parser) return Character
599 -- If we have finished parsing the current command line item (there
600 -- might be multiple switches in a single item), then go to the next
603 if Parser.Current_Argument > Parser.Arg_Count
604 or else (Parser.Current_Index >
605 Argument (Parser, Parser.Current_Argument)'Last
606 and then not Goto_Next_Argument_In_Section (Parser))
611 -- By default, the switch will not have a parameter
613 Parser.The_Parameter :=
614 (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
615 Parser.The_Separator := ASCII.NUL;
618 Arg : constant String :=
619 Argument (Parser, Parser.Current_Argument);
620 Index_Switches : Natural := 0;
621 Max_Length : Natural := 0;
623 Param : Switch_Parameter_Type;
625 -- If we are on a new item, test if this might be a switch
627 if Parser.Current_Index = Arg'First then
628 if Arg = "" or else Arg (Arg'First) /= Parser.Switch_Character then
630 -- If it isn't a switch, return it immediately. We also know it
631 -- isn't the parameter to a previous switch, since that has
632 -- already been handled.
634 if Switches (Switches'First) = '*' then
637 Arg_Num => Parser.Current_Argument,
640 Parser.Is_Switch (Parser.Current_Argument) := True;
641 Dummy := Goto_Next_Argument_In_Section (Parser);
645 if Parser.Stop_At_First then
646 Parser.Current_Argument := Positive'Last;
649 elsif not Goto_Next_Argument_In_Section (Parser) then
653 -- Recurse to get the next switch on the command line
659 -- We are on the first character of a new command line argument,
660 -- which starts with Switch_Character. Further analysis is needed.
662 Parser.Current_Index := Parser.Current_Index + 1;
663 Parser.Is_Switch (Parser.Current_Argument) := True;
666 Find_Longest_Matching_Switch
667 (Switches => Switches,
668 Arg => Arg (Parser.Current_Index .. Arg'Last),
669 Index_In_Switches => Index_Switches,
670 Switch_Length => Max_Length,
673 -- If switch is not accepted, it is either invalid or is returned
674 -- in the context of '*'.
676 if Index_Switches = 0 then
678 -- Find the current switch that we did not recognize. This is in
679 -- fact difficult because Getopt does not know explicitly about
680 -- short and long switches. Ideally, we would want the following
683 -- * for short switches, with Concatenate:
684 -- if -a is not recognized, and the command line has -daf
685 -- we should report the invalid switch as "-a".
687 -- * for short switches, wihtout Concatenate:
688 -- we should report the invalid switch as "-daf".
690 -- * for long switches:
691 -- if the commadn line is "--long" we should report --long
694 -- Unfortunately, the fact that long switches start with a
695 -- duplicate switch character is just a convention (so we could
696 -- have a long switch "-long" for instance). We'll still rely on
697 -- this convention here to try and get as helpful an error message
700 -- Long switch case (starting with double switch character)
702 if Arg (Arg'First + 1) = Parser.Switch_Character then
703 End_Index := Arg'Last;
709 (if Concatenate then Parser.Current_Index else Arg'Last);
712 if Switches /= "" and then Switches (Switches'First) = '*' then
714 -- Always prepend the switch character, so that users know
715 -- that this comes from a switch on the command line. This
716 -- is especially important when Concatenate is False, since
717 -- otherwise the current argument first character is lost.
719 if Parser.Section (Parser.Current_Argument) = 0 then
721 -- A section transition should not be returned to the user
723 Dummy := Goto_Next_Argument_In_Section (Parser);
729 Arg_Num => Parser.Current_Argument,
730 First => Parser.Current_Index,
732 Extra => Parser.Switch_Character);
733 Parser.Is_Switch (Parser.Current_Argument) := True;
734 Dummy := Goto_Next_Argument_In_Section (Parser);
739 if Parser.Current_Index = Arg'First then
742 Arg_Num => Parser.Current_Argument,
743 First => Parser.Current_Index,
748 Arg_Num => Parser.Current_Argument,
749 First => Parser.Current_Index,
751 Extra => Parser.Switch_Character);
754 Parser.Current_Index := End_Index + 1;
756 raise Invalid_Switch with
757 "Unrecognized option '" & Full_Switch (Parser) & ''';
760 End_Index := Parser.Current_Index + Max_Length - 1;
763 Arg_Num => Parser.Current_Argument,
764 First => Parser.Current_Index,
768 when Parameter_With_Optional_Space =>
769 if End_Index < Arg'Last then
771 (Parser.The_Parameter,
772 Arg_Num => Parser.Current_Argument,
773 First => End_Index + 1,
775 Dummy := Goto_Next_Argument_In_Section (Parser);
777 elsif Parser.Current_Argument < Parser.Arg_Count
778 and then Parser.Section (Parser.Current_Argument + 1) /= 0
780 Parser.Current_Argument := Parser.Current_Argument + 1;
781 Parser.The_Separator := ' ';
783 (Parser.The_Parameter,
784 Arg_Num => Parser.Current_Argument,
785 First => Argument (Parser, Parser.Current_Argument)'First,
786 Last => Argument (Parser, Parser.Current_Argument)'Last);
787 Parser.Is_Switch (Parser.Current_Argument) := True;
788 Dummy := Goto_Next_Argument_In_Section (Parser);
791 Parser.Current_Index := End_Index + 1;
792 raise Invalid_Parameter;
795 when Parameter_With_Space_Or_Equal =>
797 -- If the switch is of the form <switch>=xxx
799 if End_Index < Arg'Last then
800 if Arg (End_Index + 1) = '='
801 and then End_Index + 1 < Arg'Last
803 Parser.The_Separator := '=';
805 (Parser.The_Parameter,
806 Arg_Num => Parser.Current_Argument,
807 First => End_Index + 2,
809 Dummy := Goto_Next_Argument_In_Section (Parser);
812 Parser.Current_Index := End_Index + 1;
813 raise Invalid_Parameter;
816 -- Case of switch of the form <switch> xxx
818 elsif Parser.Current_Argument < Parser.Arg_Count
819 and then Parser.Section (Parser.Current_Argument + 1) /= 0
821 Parser.Current_Argument := Parser.Current_Argument + 1;
822 Parser.The_Separator := ' ';
824 (Parser.The_Parameter,
825 Arg_Num => Parser.Current_Argument,
826 First => Argument (Parser, Parser.Current_Argument)'First,
827 Last => Argument (Parser, Parser.Current_Argument)'Last);
828 Parser.Is_Switch (Parser.Current_Argument) := True;
829 Dummy := Goto_Next_Argument_In_Section (Parser);
832 Parser.Current_Index := End_Index + 1;
833 raise Invalid_Parameter;
836 when Parameter_No_Space =>
837 if End_Index < Arg'Last then
839 (Parser.The_Parameter,
840 Arg_Num => Parser.Current_Argument,
841 First => End_Index + 1,
843 Dummy := Goto_Next_Argument_In_Section (Parser);
846 Parser.Current_Index := End_Index + 1;
847 raise Invalid_Parameter;
850 when Parameter_Optional =>
851 if End_Index < Arg'Last then
853 (Parser.The_Parameter,
854 Arg_Num => Parser.Current_Argument,
855 First => End_Index + 1,
859 Dummy := Goto_Next_Argument_In_Section (Parser);
861 when Parameter_None =>
862 if Concatenate or else End_Index = Arg'Last then
863 Parser.Current_Index := End_Index + 1;
866 -- If Concatenate is False and the full argument is not
867 -- recognized as a switch, this is an invalid switch.
869 if Switches (Switches'First) = '*' then
872 Arg_Num => Parser.Current_Argument,
875 Parser.Is_Switch (Parser.Current_Argument) := True;
876 Dummy := Goto_Next_Argument_In_Section (Parser);
882 Arg_Num => Parser.Current_Argument,
883 First => Parser.Current_Index,
885 Extra => Parser.Switch_Character);
886 Parser.Current_Index := Arg'Last + 1;
887 raise Invalid_Switch with
888 "Unrecognized option '" & Full_Switch (Parser) & ''';
892 return Switches (Index_Switches);
896 -----------------------------------
897 -- Goto_Next_Argument_In_Section --
898 -----------------------------------
900 function Goto_Next_Argument_In_Section
901 (Parser : Opt_Parser) return Boolean
904 Parser.Current_Argument := Parser.Current_Argument + 1;
906 if Parser.Current_Argument > Parser.Arg_Count
907 or else Parser.Section (Parser.Current_Argument) = 0
910 Parser.Current_Argument := Parser.Current_Argument + 1;
912 if Parser.Current_Argument > Parser.Arg_Count then
913 Parser.Current_Index := 1;
917 exit when Parser.Section (Parser.Current_Argument) =
918 Parser.Current_Section;
922 Parser.Current_Index :=
923 Argument (Parser, Parser.Current_Argument)'First;
926 end Goto_Next_Argument_In_Section;
932 procedure Goto_Section
933 (Name : String := "";
934 Parser : Opt_Parser := Command_Line_Parser)
939 Parser.In_Expansion := False;
942 Parser.Current_Argument := 1;
943 Parser.Current_Index := 1;
944 Parser.Current_Section := 1;
949 while Index <= Parser.Arg_Count loop
950 if Parser.Section (Index) = 0
951 and then Argument (Parser, Index) = Parser.Switch_Character & Name
953 Parser.Current_Argument := Index + 1;
954 Parser.Current_Index := 1;
956 if Parser.Current_Argument <= Parser.Arg_Count then
957 Parser.Current_Section :=
958 Parser.Section (Parser.Current_Argument);
961 -- Exit from loop if we have the start of another section
963 if Index = Parser.Section'Last
964 or else Parser.Section (Index + 1) /= 0
973 Parser.Current_Argument := Positive'Last;
974 Parser.Current_Index := 2; -- so that Get_Argument returns nothing
977 ----------------------------
978 -- Initialize_Option_Scan --
979 ----------------------------
981 procedure Initialize_Option_Scan
982 (Switch_Char : Character := '-';
983 Stop_At_First_Non_Switch : Boolean := False;
984 Section_Delimiters : String := "")
987 Internal_Initialize_Option_Scan
988 (Parser => Command_Line_Parser,
989 Switch_Char => Switch_Char,
990 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
991 Section_Delimiters => Section_Delimiters);
992 end Initialize_Option_Scan;
994 ----------------------------
995 -- Initialize_Option_Scan --
996 ----------------------------
998 procedure Initialize_Option_Scan
999 (Parser : out Opt_Parser;
1000 Command_Line : GNAT.OS_Lib.Argument_List_Access;
1001 Switch_Char : Character := '-';
1002 Stop_At_First_Non_Switch : Boolean := False;
1003 Section_Delimiters : String := "")
1008 if Command_Line = null then
1009 Parser := new Opt_Parser_Data (CL.Argument_Count);
1010 Internal_Initialize_Option_Scan
1012 Switch_Char => Switch_Char,
1013 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
1014 Section_Delimiters => Section_Delimiters);
1016 Parser := new Opt_Parser_Data (Command_Line'Length);
1017 Parser.Arguments := Command_Line;
1018 Internal_Initialize_Option_Scan
1020 Switch_Char => Switch_Char,
1021 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
1022 Section_Delimiters => Section_Delimiters);
1024 end Initialize_Option_Scan;
1026 -------------------------------------
1027 -- Internal_Initialize_Option_Scan --
1028 -------------------------------------
1030 procedure Internal_Initialize_Option_Scan
1031 (Parser : Opt_Parser;
1032 Switch_Char : Character;
1033 Stop_At_First_Non_Switch : Boolean;
1034 Section_Delimiters : String)
1036 Section_Num : Section_Number;
1037 Section_Index : Integer;
1039 Delimiter_Found : Boolean;
1042 pragma Warnings (Off, Discard);
1045 Parser.Current_Argument := 0;
1046 Parser.Current_Index := 0;
1047 Parser.In_Expansion := False;
1048 Parser.Switch_Character := Switch_Char;
1049 Parser.Stop_At_First := Stop_At_First_Non_Switch;
1050 Parser.Section := (others => 1);
1052 -- If we are using sections, we have to preprocess the command line to
1053 -- delimit them. A section can be repeated, so we just give each item
1054 -- on the command line a section number
1057 Section_Index := Section_Delimiters'First;
1058 while Section_Index <= Section_Delimiters'Last loop
1059 Last := Section_Index;
1060 while Last <= Section_Delimiters'Last
1061 and then Section_Delimiters (Last) /= ' '
1066 Delimiter_Found := False;
1067 Section_Num := Section_Num + 1;
1069 for Index in 1 .. Parser.Arg_Count loop
1070 pragma Assert (Argument (Parser, Index)'First = 1);
1071 if Argument (Parser, Index) /= ""
1072 and then Argument (Parser, Index)(1) = Parser.Switch_Character
1074 Argument (Parser, Index) = Parser.Switch_Character &
1076 (Section_Index .. Last - 1)
1078 Parser.Section (Index) := 0;
1079 Delimiter_Found := True;
1081 elsif Parser.Section (Index) = 0 then
1083 -- A previous section delimiter
1085 Delimiter_Found := False;
1087 elsif Delimiter_Found then
1088 Parser.Section (Index) := Section_Num;
1092 Section_Index := Last + 1;
1093 while Section_Index <= Section_Delimiters'Last
1094 and then Section_Delimiters (Section_Index) = ' '
1096 Section_Index := Section_Index + 1;
1100 Discard := Goto_Next_Argument_In_Section (Parser);
1101 end Internal_Initialize_Option_Scan;
1108 (Parser : Opt_Parser := Command_Line_Parser) return String
1111 if Parser.The_Parameter.First > Parser.The_Parameter.Last then
1112 return String'(1 .. 0 => ' ');
1114 return Argument (Parser, Parser.The_Parameter.Arg_Num)
1115 (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
1124 (Parser : Opt_Parser := Command_Line_Parser) return Character
1127 return Parser.The_Separator;
1134 procedure Set_Parameter
1135 (Variable : out Parameter_Type;
1139 Extra : Character := ASCII.NUL)
1142 Variable.Arg_Num := Arg_Num;
1143 Variable.First := First;
1144 Variable.Last := Last;
1145 Variable.Extra := Extra;
1148 ---------------------
1149 -- Start_Expansion --
1150 ---------------------
1152 procedure Start_Expansion
1153 (Iterator : out Expansion_Iterator;
1155 Directory : String := "";
1156 Basic_Regexp : Boolean := True)
1158 Directory_Separator : Character;
1159 pragma Import (C, Directory_Separator, "__gnat_dir_separator");
1161 First : Positive := Pattern'First;
1162 Pat : String := Pattern;
1165 Canonical_Case_File_Name (Pat);
1166 Iterator.Current_Depth := 1;
1168 -- If Directory is unspecified, use the current directory ("./" or ".\")
1170 if Directory = "" then
1171 Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
1172 Iterator.Start := 3;
1175 Iterator.Dir_Name (1 .. Directory'Length) := Directory;
1176 Iterator.Start := Directory'Length + 1;
1177 Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length));
1179 -- Make sure that the last character is a directory separator
1181 if Directory (Directory'Last) /= Directory_Separator then
1182 Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
1183 Iterator.Start := Iterator.Start + 1;
1187 Iterator.Levels (1).Name_Last := Iterator.Start - 1;
1189 -- Open the initial Directory, at depth 1
1191 GNAT.Directory_Operations.Open
1192 (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
1194 -- If in the current directory and the pattern starts with "./" or ".\",
1195 -- drop the "./" or ".\" from the pattern.
1197 if Directory = "" and then Pat'Length > 2
1198 and then Pat (Pat'First) = '.'
1199 and then Pat (Pat'First + 1) = Directory_Separator
1201 First := Pat'First + 2;
1205 GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
1207 Iterator.Maximum_Depth := 1;
1209 -- Maximum_Depth is equal to 1 plus the number of directory separators
1212 for Index in First .. Pat'Last loop
1213 if Pat (Index) = Directory_Separator then
1214 Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1;
1215 exit when Iterator.Maximum_Depth = Max_Depth;
1218 end Start_Expansion;
1224 procedure Free (Parser : in out Opt_Parser) is
1225 procedure Unchecked_Free is new
1226 Ada.Unchecked_Deallocation (Opt_Parser_Data, Opt_Parser);
1228 if Parser /= null and then Parser /= Command_Line_Parser then
1229 Free (Parser.Arguments);
1230 Unchecked_Free (Parser);
1238 procedure Define_Alias
1239 (Config : in out Command_Line_Configuration;
1242 Section : String := "")
1244 Def : Alias_Definition;
1247 if Config = null then
1248 Config := new Command_Line_Configuration_Record;
1251 Def.Alias := new String'(Switch);
1252 Def.Expansion := new String'(Expanded);
1253 Def.Section := new String'(Section);
1254 Add (Config.Aliases, Def);
1261 procedure Define_Prefix
1262 (Config : in out Command_Line_Configuration;
1266 if Config = null then
1267 Config := new Command_Line_Configuration_Record;
1270 Add (Config.Prefixes, new String'(Prefix));
1278 (Config : in out Command_Line_Configuration;
1279 Switch : Switch_Definition)
1281 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1282 (Switch_Definitions, Switch_Definitions_List);
1284 Tmp : Switch_Definitions_List;
1287 if Config = null then
1288 Config := new Command_Line_Configuration_Record;
1291 Tmp := Config.Switches;
1294 Config.Switches := new Switch_Definitions (1 .. 1);
1296 Config.Switches := new Switch_Definitions (1 .. Tmp'Length + 1);
1297 Config.Switches (1 .. Tmp'Length) := Tmp.all;
1298 Unchecked_Free (Tmp);
1301 if Switch.Switch /= null and then Switch.Switch.all = "*" then
1302 Config.Star_Switch := True;
1305 Config.Switches (Config.Switches'Last) := Switch;
1313 (Def : in out Alias_Definitions_List;
1314 Alias : Alias_Definition)
1316 procedure Unchecked_Free is new
1317 Ada.Unchecked_Deallocation
1318 (Alias_Definitions, Alias_Definitions_List);
1320 Tmp : Alias_Definitions_List := Def;
1324 Def := new Alias_Definitions (1 .. 1);
1326 Def := new Alias_Definitions (1 .. Tmp'Length + 1);
1327 Def (1 .. Tmp'Length) := Tmp.all;
1328 Unchecked_Free (Tmp);
1331 Def (Def'Last) := Alias;
1334 ---------------------------
1335 -- Initialize_Switch_Def --
1336 ---------------------------
1338 procedure Initialize_Switch_Def
1339 (Def : out Switch_Definition;
1340 Switch : String := "";
1341 Long_Switch : String := "";
1342 Help : String := "";
1343 Section : String := "";
1344 Argument : String := "ARG")
1346 P1, P2 : Switch_Parameter_Type := Parameter_None;
1347 Last1, Last2 : Integer;
1350 if Switch /= "" then
1351 Def.Switch := new String'(Switch);
1352 Decompose_Switch (Switch, P1, Last1);
1355 if Long_Switch /= "" then
1356 Def.Long_Switch := new String'(Long_Switch);
1357 Decompose_Switch (Long_Switch, P2, Last2);
1360 if Switch /= "" and then Long_Switch /= "" then
1361 if (P1 = Parameter_None and then P2 /= P1)
1362 or else (P2 = Parameter_None and then P1 /= P2)
1363 or else (P1 = Parameter_Optional and then P2 /= P1)
1364 or else (P2 = Parameter_Optional and then P2 /= P1)
1366 raise Invalid_Switch
1367 with "Inconsistent parameter types for "
1368 & Switch & " and " & Long_Switch;
1372 if Section /= "" then
1373 Def.Section := new String'(Section);
1376 if Argument /= "ARG" then
1377 Def.Argument := new String'(Argument);
1381 Def.Help := new String'(Help);
1383 end Initialize_Switch_Def;
1389 procedure Define_Switch
1390 (Config : in out Command_Line_Configuration;
1391 Switch : String := "";
1392 Long_Switch : String := "";
1393 Help : String := "";
1394 Section : String := "";
1395 Argument : String := "ARG")
1397 Def : Switch_Definition;
1399 if Switch /= "" or else Long_Switch /= "" then
1400 Initialize_Switch_Def
1401 (Def, Switch, Long_Switch, Help, Section, Argument);
1410 procedure Define_Switch
1411 (Config : in out Command_Line_Configuration;
1412 Output : access Boolean;
1413 Switch : String := "";
1414 Long_Switch : String := "";
1415 Help : String := "";
1416 Section : String := "";
1417 Value : Boolean := True)
1419 Def : Switch_Definition (Switch_Boolean);
1421 if Switch /= "" or else Long_Switch /= "" then
1422 Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
1423 Def.Boolean_Output := Output.all'Unchecked_Access;
1424 Def.Boolean_Value := Value;
1433 procedure Define_Switch
1434 (Config : in out Command_Line_Configuration;
1435 Output : access Integer;
1436 Switch : String := "";
1437 Long_Switch : String := "";
1438 Help : String := "";
1439 Section : String := "";
1440 Initial : Integer := 0;
1441 Default : Integer := 1;
1442 Argument : String := "ARG")
1444 Def : Switch_Definition (Switch_Integer);
1446 if Switch /= "" or else Long_Switch /= "" then
1447 Initialize_Switch_Def
1448 (Def, Switch, Long_Switch, Help, Section, Argument);
1449 Def.Integer_Output := Output.all'Unchecked_Access;
1450 Def.Integer_Default := Default;
1451 Def.Integer_Initial := Initial;
1460 procedure Define_Switch
1461 (Config : in out Command_Line_Configuration;
1462 Output : access GNAT.Strings.String_Access;
1463 Switch : String := "";
1464 Long_Switch : String := "";
1465 Help : String := "";
1466 Section : String := "";
1467 Argument : String := "ARG")
1469 Def : Switch_Definition (Switch_String);
1471 if Switch /= "" or else Long_Switch /= "" then
1472 Initialize_Switch_Def
1473 (Def, Switch, Long_Switch, Help, Section, Argument);
1474 Def.String_Output := Output.all'Unchecked_Access;
1483 procedure Define_Switch
1484 (Config : in out Command_Line_Configuration;
1485 Callback : not null Value_Callback;
1486 Switch : String := "";
1487 Long_Switch : String := "";
1488 Help : String := "";
1489 Section : String := "";
1490 Argument : String := "ARG")
1492 Def : Switch_Definition (Switch_Callback);
1494 if Switch /= "" or else Long_Switch /= "" then
1495 Initialize_Switch_Def
1496 (Def, Switch, Long_Switch, Help, Section, Argument);
1497 Def.Callback := Callback;
1502 --------------------
1503 -- Define_Section --
1504 --------------------
1506 procedure Define_Section
1507 (Config : in out Command_Line_Configuration;
1511 if Config = null then
1512 Config := new Command_Line_Configuration_Record;
1515 Add (Config.Sections, new String'(Section));
1518 --------------------
1519 -- Foreach_Switch --
1520 --------------------
1522 procedure Foreach_Switch
1523 (Config : Command_Line_Configuration;
1527 if Config /= null and then Config.Switches /= null then
1528 for J in Config.Switches'Range loop
1529 if (Section = "" and then Config.Switches (J).Section = null)
1531 (Config.Switches (J).Section /= null
1532 and then Config.Switches (J).Section.all = Section)
1534 exit when Config.Switches (J).Switch /= null
1535 and then not Callback (Config.Switches (J).Switch.all, J);
1537 exit when Config.Switches (J).Long_Switch /= null
1539 not Callback (Config.Switches (J).Long_Switch.all, J);
1549 function Get_Switches
1550 (Config : Command_Line_Configuration;
1551 Switch_Char : Character := '-';
1552 Section : String := "") return String
1554 Ret : Ada.Strings.Unbounded.Unbounded_String;
1555 use Ada.Strings.Unbounded;
1557 function Add_Switch (S : String; Index : Integer) return Boolean;
1558 -- Add a switch to Ret
1564 function Add_Switch (S : String; Index : Integer) return Boolean is
1565 pragma Unreferenced (Index);
1568 Ret := "*" & Ret; -- Always first
1569 elsif S (S'First) = Switch_Char then
1570 Append (Ret, " " & S (S'First + 1 .. S'Last));
1572 Append (Ret, " " & S);
1579 pragma Unreferenced (Tmp);
1581 procedure Foreach is new Foreach_Switch (Add_Switch);
1583 -- Start of processing for Get_Switches
1586 if Config = null then
1590 Foreach (Config, Section => Section);
1592 -- Add relevant aliases
1594 if Config.Aliases /= null then
1595 for A in Config.Aliases'Range loop
1596 if Config.Aliases (A).Section.all = Section then
1597 Tmp := Add_Switch (Config.Aliases (A).Alias.all, -1);
1602 return To_String (Ret);
1605 ------------------------
1606 -- Section_Delimiters --
1607 ------------------------
1609 function Section_Delimiters
1610 (Config : Command_Line_Configuration) return String
1612 use Ada.Strings.Unbounded;
1613 Result : Unbounded_String;
1616 if Config /= null and then Config.Sections /= null then
1617 for S in Config.Sections'Range loop
1618 Append (Result, " " & Config.Sections (S).all);
1622 return To_String (Result);
1623 end Section_Delimiters;
1625 -----------------------
1626 -- Set_Configuration --
1627 -----------------------
1629 procedure Set_Configuration
1630 (Cmd : in out Command_Line;
1631 Config : Command_Line_Configuration)
1634 Cmd.Config := Config;
1635 end Set_Configuration;
1637 -----------------------
1638 -- Get_Configuration --
1639 -----------------------
1641 function Get_Configuration
1642 (Cmd : Command_Line) return Command_Line_Configuration
1646 end Get_Configuration;
1648 ----------------------
1649 -- Set_Command_Line --
1650 ----------------------
1652 procedure Set_Command_Line
1653 (Cmd : in out Command_Line;
1655 Getopt_Description : String := "";
1656 Switch_Char : Character := '-')
1658 Tmp : Argument_List_Access;
1659 Parser : Opt_Parser;
1661 Section : String_Access := null;
1663 function Real_Full_Switch
1665 Parser : Opt_Parser) return String;
1666 -- Ensure that the returned switch value contains the Switch_Char prefix
1669 ----------------------
1670 -- Real_Full_Switch --
1671 ----------------------
1673 function Real_Full_Switch
1675 Parser : Opt_Parser) return String
1679 return Full_Switch (Parser);
1681 return Switch_Char & Full_Switch (Parser);
1683 end Real_Full_Switch;
1685 -- Start of processing for Set_Command_Line
1688 Free (Cmd.Expanded);
1691 if Switches /= "" then
1692 Tmp := Argument_String_To_List (Switches);
1693 Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1697 if Cmd.Config /= null then
1699 -- Do not use Getopt_Description in this case. Otherwise,
1700 -- if we have defined a prefix -gnaty, and two switches
1701 -- -gnatya and -gnatyL!, we would have a different behavior
1702 -- depending on the order of switches:
1704 -- -gnatyL1a => -gnatyL with argument "1a"
1705 -- -gnatyaL1 => -gnatya and -gnatyL with argument "1"
1707 -- This is because the call to Getopt below knows nothing
1708 -- about prefixes, and in the first case finds a valid
1709 -- switch with arguments, so returns it without analyzing
1710 -- the argument. In the second case, the switch matches "*",
1711 -- and is then decomposed below.
1713 -- Note: When a Command_Line object is associated with a
1714 -- Command_Line_Config (which is mostly the case for tools
1715 -- that let users choose the command line before spawning
1716 -- other tools, for instance IDEs), the configuration of
1717 -- the switches must be taken from the Command_Line_Config.
1719 S := Getopt (Switches => "* " & Get_Switches (Cmd.Config),
1720 Concatenate => False,
1724 S := Getopt (Switches => "* " & Getopt_Description,
1725 Concatenate => False,
1729 exit when S = ASCII.NUL;
1732 Sw : constant String := Real_Full_Switch (S, Parser);
1733 Is_Section : Boolean := False;
1736 if Cmd.Config /= null
1737 and then Cmd.Config.Sections /= null
1740 for S in Cmd.Config.Sections'Range loop
1741 if Sw = Cmd.Config.Sections (S).all then
1742 Section := Cmd.Config.Sections (S);
1745 exit Section_Search;
1747 end loop Section_Search;
1750 if not Is_Section then
1751 if Section = null then
1752 Add_Switch (Cmd, Sw, Parameter (Parser));
1755 (Cmd, Sw, Parameter (Parser),
1756 Section => Section.all);
1762 when Invalid_Parameter =>
1764 -- Add it with no parameter, if that's the way the user
1767 -- Specify the separator in all cases, as the switch might
1768 -- need to be unaliased, and the alias might contain
1769 -- switches with parameters.
1771 if Section = null then
1773 (Cmd, Switch_Char & Full_Switch (Parser));
1776 (Cmd, Switch_Char & Full_Switch (Parser),
1777 Section => Section.all);
1784 end Set_Command_Line;
1793 Substring : String) return Boolean
1796 return Index + Substring'Length - 1 <= Type_Str'Last
1797 and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1800 ------------------------
1801 -- Can_Have_Parameter --
1802 ------------------------
1804 function Can_Have_Parameter (S : String) return Boolean is
1806 if S'Length <= 1 then
1811 when '!' | ':' | '?' | '=' =>
1816 end Can_Have_Parameter;
1818 -----------------------
1819 -- Require_Parameter --
1820 -----------------------
1822 function Require_Parameter (S : String) return Boolean is
1824 if S'Length <= 1 then
1829 when '!' | ':' | '=' =>
1834 end Require_Parameter;
1840 function Actual_Switch (S : String) return String is
1842 if S'Length <= 1 then
1847 when '!' | ':' | '?' | '=' =>
1848 return S (S'First .. S'Last - 1);
1854 ----------------------------
1855 -- For_Each_Simple_Switch --
1856 ----------------------------
1858 procedure For_Each_Simple_Switch
1859 (Config : Command_Line_Configuration;
1862 Parameter : String := "";
1863 Unalias : Boolean := True)
1865 function Group_Analysis
1867 Group : String) return Boolean;
1868 -- Perform the analysis of a group of switches
1870 Found_In_Config : Boolean := False;
1871 function Is_In_Config
1872 (Config_Switch : String; Index : Integer) return Boolean;
1873 -- If Switch is the same as Config_Switch, run the callback and sets
1874 -- Found_In_Config to True.
1876 function Starts_With
1877 (Config_Switch : String; Index : Integer) return Boolean;
1878 -- if Switch starts with Config_Switch, sets Found_In_Config to True.
1879 -- The return value is for the Foreach_Switch iterator.
1881 --------------------
1882 -- Group_Analysis --
1883 --------------------
1885 function Group_Analysis
1887 Group : String) return Boolean
1892 function Analyze_Simple_Switch
1893 (Switch : String; Index : Integer) return Boolean;
1894 -- "Switches" is one of the switch definitions passed to the
1895 -- configuration, not one of the switches found on the command line.
1897 ---------------------------
1898 -- Analyze_Simple_Switch --
1899 ---------------------------
1901 function Analyze_Simple_Switch
1902 (Switch : String; Index : Integer) return Boolean
1904 pragma Unreferenced (Index);
1906 Full : constant String := Prefix & Group (Idx .. Group'Last);
1908 Sw : constant String := Actual_Switch (Switch);
1909 -- Switches definition minus argument definition
1915 -- Verify that sw starts with Prefix
1917 if Looking_At (Sw, Sw'First, Prefix)
1919 -- Verify that the group starts with sw
1921 and then Looking_At (Full, Full'First, Sw)
1923 Last := Idx + Sw'Length - Prefix'Length - 1;
1926 if Can_Have_Parameter (Switch) then
1928 -- Include potential parameter to the recursive call. Only
1929 -- numbers are allowed.
1931 while Last < Group'Last
1932 and then Group (Last + 1) in '0' .. '9'
1938 if not Require_Parameter (Switch) or else Last >= Param then
1939 if Idx = Group'First
1940 and then Last = Group'Last
1941 and then Last < Param
1943 -- The group only concerns a single switch. Do not
1944 -- perform recursive call.
1946 -- Note that we still perform a recursive call if
1947 -- a parameter is detected in the switch, as this
1948 -- is a way to correctly identify such a parameter
1956 -- Recursive call, using the detected parameter if any
1958 if Last >= Param then
1959 For_Each_Simple_Switch
1962 Prefix & Group (Idx .. Param - 1),
1963 Group (Param .. Last));
1966 For_Each_Simple_Switch
1967 (Config, Section, Prefix & Group (Idx .. Last), "");
1976 end Analyze_Simple_Switch;
1978 procedure Foreach is new Foreach_Switch (Analyze_Simple_Switch);
1980 -- Start of processing for Group_Analysis
1984 while Idx <= Group'Last loop
1986 Foreach (Config, Section);
1989 For_Each_Simple_Switch
1990 (Config, Section, Prefix & Group (Idx), "");
2002 function Is_In_Config
2003 (Config_Switch : String; Index : Integer) return Boolean
2006 P : Switch_Parameter_Type;
2009 Decompose_Switch (Config_Switch, P, Last);
2011 if Config_Switch (Config_Switch'First .. Last) = Switch then
2013 when Parameter_None =>
2014 if Parameter = "" then
2015 Callback (Switch, "", "", Index => Index);
2016 Found_In_Config := True;
2020 when Parameter_With_Optional_Space =>
2021 Callback (Switch, " ", Parameter, Index => Index);
2022 Found_In_Config := True;
2025 when Parameter_With_Space_Or_Equal =>
2026 Callback (Switch, "=", Parameter, Index => Index);
2027 Found_In_Config := True;
2030 when Parameter_No_Space
2031 | Parameter_Optional
2033 Callback (Switch, "", Parameter, Index);
2034 Found_In_Config := True;
2046 function Starts_With
2047 (Config_Switch : String; Index : Integer) return Boolean
2051 P : Switch_Parameter_Type;
2054 -- This function is called when we believe the parameter was
2055 -- specified as part of the switch, instead of separately. Thus we
2056 -- look in the config to find all possible switches.
2058 Decompose_Switch (Config_Switch, P, Last);
2061 (Switch, Switch'First,
2062 Config_Switch (Config_Switch'First .. Last))
2064 -- Set first char of Param, and last char of Switch
2066 Param := Switch'First + Last;
2067 Last := Switch'First + Last - Config_Switch'First;
2071 -- None is already handled in Is_In_Config
2073 when Parameter_None =>
2076 when Parameter_With_Space_Or_Equal =>
2077 if Param <= Switch'Last
2079 (Switch (Param) = ' ' or else Switch (Param) = '=')
2081 Callback (Switch (Switch'First .. Last),
2082 "=", Switch (Param + 1 .. Switch'Last), Index);
2083 Found_In_Config := True;
2087 when Parameter_With_Optional_Space =>
2088 if Param <= Switch'Last and then Switch (Param) = ' ' then
2092 Callback (Switch (Switch'First .. Last),
2093 " ", Switch (Param .. Switch'Last), Index);
2094 Found_In_Config := True;
2097 when Parameter_No_Space
2098 | Parameter_Optional
2100 Callback (Switch (Switch'First .. Last),
2101 "", Switch (Param .. Switch'Last), Index);
2102 Found_In_Config := True;
2109 procedure Foreach_In_Config is new Foreach_Switch (Is_In_Config);
2110 procedure Foreach_Starts_With is new Foreach_Switch (Starts_With);
2112 -- Start of processing for For_Each_Simple_Switch
2115 -- First determine if the switch corresponds to one belonging to the
2116 -- configuration. If so, run callback and exit.
2118 -- ??? Is this necessary. On simple tests, we seem to have the same
2119 -- results with or without this call.
2121 Foreach_In_Config (Config, Section);
2123 if Found_In_Config then
2127 -- If adding a switch that can in fact be expanded through aliases,
2128 -- add separately each of its expansions.
2130 -- This takes care of expansions like "-T" -> "-gnatwrs", where the
2131 -- alias and its expansion do not have the same prefix. Given the order
2132 -- in which we do things here, the expansion of the alias will itself
2133 -- be checked for a common prefix and split into simple switches.
2136 and then Config /= null
2137 and then Config.Aliases /= null
2139 for A in Config.Aliases'Range loop
2140 if Config.Aliases (A).Section.all = Section
2141 and then Config.Aliases (A).Alias.all = Switch
2142 and then Parameter = ""
2144 For_Each_Simple_Switch
2145 (Config, Section, Config.Aliases (A).Expansion.all, "");
2151 -- If adding a switch grouping several switches, add each of the simple
2152 -- switches instead.
2154 if Config /= null and then Config.Prefixes /= null then
2155 for P in Config.Prefixes'Range loop
2156 if Switch'Length > Config.Prefixes (P)'Length + 1
2158 Looking_At (Switch, Switch'First, Config.Prefixes (P).all)
2160 -- Alias expansion will be done recursively
2162 if Config.Switches = null then
2163 for S in Switch'First + Config.Prefixes (P)'Length
2166 For_Each_Simple_Switch
2168 Config.Prefixes (P).all & Switch (S), "");
2173 elsif Group_Analysis
2174 (Config.Prefixes (P).all,
2176 (Switch'First + Config.Prefixes (P)'Length .. Switch'Last))
2178 -- Recursive calls already done on each switch of the group:
2179 -- Return without executing Callback.
2187 -- Test if added switch is a known switch with parameter attached
2188 -- instead of being specified separately
2191 and then Config /= null
2192 and then Config.Switches /= null
2194 Found_In_Config := False;
2195 Foreach_Starts_With (Config, Section);
2197 if Found_In_Config then
2202 -- The switch is invalid in the config, but we still want to report it.
2203 -- The config could, for instance, include "*" to specify it accepts
2206 Callback (Switch, " ", Parameter, Index => -1);
2207 end For_Each_Simple_Switch;
2213 procedure Add_Switch
2214 (Cmd : in out Command_Line;
2216 Parameter : String := "";
2217 Separator : Character := ASCII.NUL;
2218 Section : String := "";
2219 Add_Before : Boolean := False)
2222 pragma Unreferenced (Success);
2224 Add_Switch (Cmd, Switch, Parameter, Separator,
2225 Section, Add_Before, Success);
2232 procedure Add_Switch
2233 (Cmd : in out Command_Line;
2235 Parameter : String := "";
2236 Separator : Character := ASCII.NUL;
2237 Section : String := "";
2238 Add_Before : Boolean := False;
2239 Success : out Boolean)
2241 procedure Add_Simple_Switch
2246 -- Add a new switch that has had all its aliases expanded, and switches
2247 -- ungrouped. We know there are no more aliases in Switches.
2249 -----------------------
2250 -- Add_Simple_Switch --
2251 -----------------------
2253 procedure Add_Simple_Switch
2263 and then Cmd.Config /= null
2264 and then not Cmd.Config.Star_Switch
2266 raise Invalid_Switch
2267 with "Invalid switch " & Simple;
2270 if Separator /= ASCII.NUL then
2273 elsif Sepa = "" then
2276 Sep := Sepa (Sepa'First);
2279 if Cmd.Expanded = null then
2280 Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
2284 new Argument_List'(1 .. 1 => new String'(Sep & Param));
2286 Cmd.Params := new Argument_List'(1 .. 1 => null);
2289 if Section = "" then
2290 Cmd.Sections := new Argument_List'(1 .. 1 => null);
2293 new Argument_List'(1 .. 1 => new String'(Section));
2297 -- Do we already have this switch?
2299 for C in Cmd.Expanded'Range loop
2300 if Cmd.Expanded (C).all = Simple
2302 ((Cmd.Params (C) = null and then Param = "")
2304 (Cmd.Params (C) /= null
2305 and then Cmd.Params (C).all = Sep & Param))
2307 ((Cmd.Sections (C) = null and then Section = "")
2309 (Cmd.Sections (C) /= null
2310 and then Cmd.Sections (C).all = Section))
2316 -- Inserting at least one switch
2319 Add (Cmd.Expanded, new String'(Simple), Add_Before);
2324 new String'(Sep & Param),
2333 if Section = "" then
2341 new String'(Section),
2345 end Add_Simple_Switch;
2347 procedure Add_Simple_Switches is
2348 new For_Each_Simple_Switch (Add_Simple_Switch);
2352 Section_Valid : Boolean := False;
2354 -- Start of processing for Add_Switch
2357 if Section /= "" and then Cmd.Config /= null then
2358 for S in Cmd.Config.Sections'Range loop
2359 if Section = Cmd.Config.Sections (S).all then
2360 Section_Valid := True;
2365 if not Section_Valid then
2366 raise Invalid_Section;
2371 Add_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2372 Free (Cmd.Coalesce);
2379 procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
2380 Tmp : Argument_List_Access := Line;
2383 Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
2385 if Index /= Tmp'First then
2386 Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
2391 if Index /= Tmp'Last then
2392 Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
2395 Unchecked_Free (Tmp);
2403 (Line : in out Argument_List_Access;
2404 Str : String_Access;
2405 Before : Boolean := False)
2407 Tmp : Argument_List_Access := Line;
2411 Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
2414 Line (Tmp'First) := Str;
2415 Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
2417 Line (Tmp'Range) := Tmp.all;
2418 Line (Tmp'Last + 1) := Str;
2421 Unchecked_Free (Tmp);
2424 Line := new Argument_List'(1 .. 1 => Str);
2432 procedure Remove_Switch
2433 (Cmd : in out Command_Line;
2435 Remove_All : Boolean := False;
2436 Has_Parameter : Boolean := False;
2437 Section : String := "")
2440 pragma Unreferenced (Success);
2442 Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
2449 procedure Remove_Switch
2450 (Cmd : in out Command_Line;
2452 Remove_All : Boolean := False;
2453 Has_Parameter : Boolean := False;
2454 Section : String := "";
2455 Success : out Boolean)
2457 procedure Remove_Simple_Switch
2458 (Simple, Separator, Param : String; Index : Integer);
2459 -- Removes a simple switch, with no aliasing or grouping
2461 --------------------------
2462 -- Remove_Simple_Switch --
2463 --------------------------
2465 procedure Remove_Simple_Switch
2466 (Simple, Separator, Param : String; Index : Integer)
2469 pragma Unreferenced (Param, Separator, Index);
2472 if Cmd.Expanded /= null then
2473 C := Cmd.Expanded'First;
2474 while C <= Cmd.Expanded'Last loop
2475 if Cmd.Expanded (C).all = Simple
2478 or else (Cmd.Sections (C) = null
2479 and then Section = "")
2480 or else (Cmd.Sections (C) /= null
2481 and then Section = Cmd.Sections (C).all))
2482 and then (not Has_Parameter or else Cmd.Params (C) /= null)
2484 Remove (Cmd.Expanded, C);
2485 Remove (Cmd.Params, C);
2486 Remove (Cmd.Sections, C);
2489 if not Remove_All then
2498 end Remove_Simple_Switch;
2500 procedure Remove_Simple_Switches is
2501 new For_Each_Simple_Switch (Remove_Simple_Switch);
2503 -- Start of processing for Remove_Switch
2507 Remove_Simple_Switches
2508 (Cmd.Config, Section, Switch, "", Unalias => not Has_Parameter);
2509 Free (Cmd.Coalesce);
2516 procedure Remove_Switch
2517 (Cmd : in out Command_Line;
2520 Section : String := "")
2522 procedure Remove_Simple_Switch
2523 (Simple, Separator, Param : String; Index : Integer);
2524 -- Removes a simple switch, with no aliasing or grouping
2526 --------------------------
2527 -- Remove_Simple_Switch --
2528 --------------------------
2530 procedure Remove_Simple_Switch
2531 (Simple, Separator, Param : String; Index : Integer)
2533 pragma Unreferenced (Separator, Index);
2537 if Cmd.Expanded /= null then
2538 C := Cmd.Expanded'First;
2539 while C <= Cmd.Expanded'Last loop
2540 if Cmd.Expanded (C).all = Simple
2542 ((Cmd.Sections (C) = null
2543 and then Section = "")
2545 (Cmd.Sections (C) /= null
2546 and then Section = Cmd.Sections (C).all))
2548 ((Cmd.Params (C) = null and then Param = "")
2550 (Cmd.Params (C) /= null
2552 -- Ignore the separator stored in Parameter
2555 Cmd.Params (C) (Cmd.Params (C)'First + 1
2556 .. Cmd.Params (C)'Last) = Param))
2558 Remove (Cmd.Expanded, C);
2559 Remove (Cmd.Params, C);
2560 Remove (Cmd.Sections, C);
2562 -- The switch is necessarily unique by construction of
2572 end Remove_Simple_Switch;
2574 procedure Remove_Simple_Switches is
2575 new For_Each_Simple_Switch (Remove_Simple_Switch);
2577 -- Start of processing for Remove_Switch
2580 Remove_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2581 Free (Cmd.Coalesce);
2584 --------------------
2585 -- Group_Switches --
2586 --------------------
2588 procedure Group_Switches
2589 (Cmd : Command_Line;
2590 Result : Argument_List_Access;
2591 Sections : Argument_List_Access;
2592 Params : Argument_List_Access)
2594 function Compatible_Parameter (Param : String_Access) return Boolean;
2595 -- True when the parameter can be part of a group
2597 --------------------------
2598 -- Compatible_Parameter --
2599 --------------------------
2601 function Compatible_Parameter (Param : String_Access) return Boolean is
2605 if Param = null then
2608 -- We need parameters without separators
2610 elsif Param (Param'First) /= ASCII.NUL then
2613 -- Parameters must be all digits
2616 for J in Param'First + 1 .. Param'Last loop
2617 if Param (J) not in '0' .. '9' then
2624 end Compatible_Parameter;
2626 -- Local declarations
2628 Group : Ada.Strings.Unbounded.Unbounded_String;
2630 use type Ada.Strings.Unbounded.Unbounded_String;
2632 -- Start of processing for Group_Switches
2635 if Cmd.Config = null or else Cmd.Config.Prefixes = null then
2639 for P in Cmd.Config.Prefixes'Range loop
2640 Group := Ada.Strings.Unbounded.Null_Unbounded_String;
2643 for C in Result'Range loop
2644 if Result (C) /= null
2645 and then Compatible_Parameter (Params (C))
2649 Cmd.Config.Prefixes (P).all)
2651 -- If we are still in the same section, group the switches
2655 (Sections (C) = null
2656 and then Sections (First) = null)
2658 (Sections (C) /= null
2659 and then Sections (First) /= null
2660 and then Sections (C).all = Sections (First).all)
2665 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2668 if Params (C) /= null then
2671 Params (C) (Params (C)'First + 1 .. Params (C)'Last);
2681 -- We changed section: we put the grouped switches to the first
2682 -- place, on continue with the new section.
2687 (Cmd.Config.Prefixes (P).all &
2688 Ada.Strings.Unbounded.To_String (Group));
2690 Ada.Strings.Unbounded.To_Unbounded_String
2692 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2702 (Cmd.Config.Prefixes (P).all &
2703 Ada.Strings.Unbounded.To_String (Group));
2708 --------------------
2709 -- Alias_Switches --
2710 --------------------
2712 procedure Alias_Switches
2713 (Cmd : Command_Line;
2714 Result : Argument_List_Access;
2715 Params : Argument_List_Access)
2720 procedure Check_Cb (Switch, Separator, Param : String; Index : Integer);
2721 -- Checks whether the command line contains [Switch]. Sets the global
2722 -- variable [Found] appropriately. This is called for each simple switch
2723 -- that make up an alias, to know whether the alias should be applied.
2725 procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer);
2726 -- Remove the simple switch [Switch] from the command line, since it is
2727 -- part of a simpler alias
2734 (Switch, Separator, Param : String; Index : Integer)
2736 pragma Unreferenced (Separator, Index);
2740 for E in Result'Range loop
2741 if Result (E) /= null
2744 or else Params (E) (Params (E)'First + 1 ..
2745 Params (E)'Last) = Param)
2746 and then Result (E).all = Switch
2760 procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer)
2762 pragma Unreferenced (Separator, Index);
2765 for E in Result'Range loop
2766 if Result (E) /= null
2769 or else Params (E) (Params (E)'First + 1
2770 .. Params (E)'Last) = Param)
2771 and then Result (E).all = Switch
2784 procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
2785 procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
2787 -- Start of processing for Alias_Switches
2790 if Cmd.Config = null or else Cmd.Config.Aliases = null then
2794 for A in Cmd.Config.Aliases'Range loop
2796 -- Compute the various simple switches that make up the alias. We
2797 -- split the expansion into as many simple switches as possible, and
2798 -- then check whether the expanded command line has all of them.
2801 Check_All (Cmd.Config,
2802 Switch => Cmd.Config.Aliases (A).Expansion.all,
2803 Section => Cmd.Config.Aliases (A).Section.all);
2806 First := Integer'Last;
2807 Remove_All (Cmd.Config,
2808 Switch => Cmd.Config.Aliases (A).Expansion.all,
2809 Section => Cmd.Config.Aliases (A).Section.all);
2810 Result (First) := new String'(Cmd.Config.Aliases (A).Alias.all);
2819 procedure Sort_Sections
2820 (Line : not null GNAT.OS_Lib.Argument_List_Access;
2821 Sections : GNAT.OS_Lib.Argument_List_Access;
2822 Params : GNAT.OS_Lib.Argument_List_Access)
2824 Sections_List : Argument_List_Access :=
2825 new Argument_List'(1 .. 1 => null);
2827 Old_Line : constant Argument_List := Line.all;
2828 Old_Sections : constant Argument_List := Sections.all;
2829 Old_Params : constant Argument_List := Params.all;
2833 -- First construct a list of all sections
2835 for E in Line'Range loop
2836 if Sections (E) /= null then
2838 for S in Sections_List'Range loop
2839 if (Sections_List (S) = null and then Sections (E) = null)
2841 (Sections_List (S) /= null
2842 and then Sections (E) /= null
2843 and then Sections_List (S).all = Sections (E).all)
2851 Add (Sections_List, Sections (E));
2856 Index := Line'First;
2858 for S in Sections_List'Range loop
2859 for E in Old_Line'Range loop
2860 if (Sections_List (S) = null and then Old_Sections (E) = null)
2862 (Sections_List (S) /= null
2863 and then Old_Sections (E) /= null
2864 and then Sections_List (S).all = Old_Sections (E).all)
2866 Line (Index) := Old_Line (E);
2867 Sections (Index) := Old_Sections (E);
2868 Params (Index) := Old_Params (E);
2874 Unchecked_Free (Sections_List);
2882 (Cmd : in out Command_Line;
2883 Iter : in out Command_Line_Iterator;
2884 Expanded : Boolean := False)
2887 if Cmd.Expanded = null then
2892 -- Reorder the expanded line so that sections are grouped
2894 Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
2896 -- Coalesce the switches as much as possible
2899 and then Cmd.Coalesce = null
2901 Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
2902 for E in Cmd.Expanded'Range loop
2903 Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
2906 Free (Cmd.Coalesce_Sections);
2907 Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
2908 for E in Cmd.Sections'Range loop
2909 Cmd.Coalesce_Sections (E) :=
2910 (if Cmd.Sections (E) = null then null
2911 else new String'(Cmd.Sections (E).all));
2914 Free (Cmd.Coalesce_Params);
2915 Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
2916 for E in Cmd.Params'Range loop
2917 Cmd.Coalesce_Params (E) :=
2918 (if Cmd.Params (E) = null then null
2919 else new String'(Cmd.Params (E).all));
2922 -- Not a clone, since we will not modify the parameters anyway
2924 Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2926 (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2930 Iter.List := Cmd.Expanded;
2931 Iter.Params := Cmd.Params;
2932 Iter.Sections := Cmd.Sections;
2934 Iter.List := Cmd.Coalesce;
2935 Iter.Params := Cmd.Coalesce_Params;
2936 Iter.Sections := Cmd.Coalesce_Sections;
2939 if Iter.List = null then
2940 Iter.Current := Integer'Last;
2942 Iter.Current := Iter.List'First - 1;
2947 --------------------
2948 -- Current_Switch --
2949 --------------------
2951 function Current_Switch (Iter : Command_Line_Iterator) return String is
2953 return Iter.List (Iter.Current).all;
2956 --------------------
2957 -- Is_New_Section --
2958 --------------------
2960 function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is
2961 Section : constant String := Current_Section (Iter);
2964 if Iter.Sections = null then
2967 elsif Iter.Current = Iter.Sections'First
2968 or else Iter.Sections (Iter.Current - 1) = null
2970 return Section /= "";
2973 return Section /= Iter.Sections (Iter.Current - 1).all;
2977 ---------------------
2978 -- Current_Section --
2979 ---------------------
2981 function Current_Section (Iter : Command_Line_Iterator) return String is
2983 if Iter.Sections = null
2984 or else Iter.Current > Iter.Sections'Last
2985 or else Iter.Sections (Iter.Current) = null
2990 return Iter.Sections (Iter.Current).all;
2991 end Current_Section;
2993 -----------------------
2994 -- Current_Separator --
2995 -----------------------
2997 function Current_Separator (Iter : Command_Line_Iterator) return String is
2999 if Iter.Params = null
3000 or else Iter.Current > Iter.Params'Last
3001 or else Iter.Params (Iter.Current) = null
3007 Sep : constant Character :=
3008 Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
3010 if Sep = ASCII.NUL then
3017 end Current_Separator;
3019 -----------------------
3020 -- Current_Parameter --
3021 -----------------------
3023 function Current_Parameter (Iter : Command_Line_Iterator) return String is
3025 if Iter.Params = null
3026 or else Iter.Current > Iter.Params'Last
3027 or else Iter.Params (Iter.Current) = null
3032 -- Return result, skipping separator
3035 P : constant String := Iter.Params (Iter.Current).all;
3037 return P (P'First + 1 .. P'Last);
3040 end Current_Parameter;
3046 function Has_More (Iter : Command_Line_Iterator) return Boolean is
3048 return Iter.List /= null and then Iter.Current <= Iter.List'Last;
3055 procedure Next (Iter : in out Command_Line_Iterator) is
3057 Iter.Current := Iter.Current + 1;
3058 while Iter.Current <= Iter.List'Last
3059 and then Iter.List (Iter.Current) = null
3061 Iter.Current := Iter.Current + 1;
3069 procedure Free (Config : in out Command_Line_Configuration) is
3070 procedure Unchecked_Free is new
3071 Ada.Unchecked_Deallocation
3072 (Switch_Definitions, Switch_Definitions_List);
3074 procedure Unchecked_Free is new
3075 Ada.Unchecked_Deallocation
3076 (Alias_Definitions, Alias_Definitions_List);
3079 if Config /= null then
3080 Free (Config.Prefixes);
3081 Free (Config.Sections);
3082 Free (Config.Usage);
3084 Free (Config.Help_Msg);
3086 if Config.Aliases /= null then
3087 for A in Config.Aliases'Range loop
3088 Free (Config.Aliases (A).Alias);
3089 Free (Config.Aliases (A).Expansion);
3090 Free (Config.Aliases (A).Section);
3093 Unchecked_Free (Config.Aliases);
3096 if Config.Switches /= null then
3097 for S in Config.Switches'Range loop
3098 Free (Config.Switches (S).Switch);
3099 Free (Config.Switches (S).Long_Switch);
3100 Free (Config.Switches (S).Help);
3101 Free (Config.Switches (S).Section);
3102 Free (Config.Switches (S).Argument);
3105 Unchecked_Free (Config.Switches);
3108 Unchecked_Free (Config);
3116 procedure Free (Cmd : in out Command_Line) is
3118 Free (Cmd.Expanded);
3119 Free (Cmd.Coalesce);
3120 Free (Cmd.Coalesce_Sections);
3121 Free (Cmd.Coalesce_Params);
3123 Free (Cmd.Sections);
3131 (Config : in out Command_Line_Configuration;
3132 Usage : String := "[switches] [arguments]";
3133 Help : String := "";
3134 Help_Msg : String := "")
3137 if Config = null then
3138 Config := new Command_Line_Configuration_Record;
3141 Free (Config.Usage);
3143 Free (Config.Help_Msg);
3145 Config.Usage := new String'(Usage);
3146 Config.Help := new String'(Help);
3147 Config.Help_Msg := new String'(Help_Msg);
3154 procedure Display_Help (Config : Command_Line_Configuration) is
3155 function Switch_Name
3156 (Def : Switch_Definition;
3157 Section : String) return String;
3158 -- Return the "-short, --long=ARG" string for Def.
3159 -- Returns "" if the switch is not in the section.
3162 (P : Switch_Parameter_Type;
3163 Name : String := "ARG") return String;
3164 -- Return the display for a switch parameter
3166 procedure Display_Section_Help (Section : String);
3167 -- Display the help for a specific section ("" is the default section)
3169 --------------------------
3170 -- Display_Section_Help --
3171 --------------------------
3173 procedure Display_Section_Help (Section : String) is
3174 Max_Len : Natural := 0;
3177 -- ??? Special display for "*"
3181 if Section /= "" then
3182 Put_Line ("Switches after " & Section);
3185 -- Compute size of the switches column
3187 for S in Config.Switches'Range loop
3188 Max_Len := Natural'Max
3189 (Max_Len, Switch_Name (Config.Switches (S), Section)'Length);
3192 if Config.Aliases /= null then
3193 for A in Config.Aliases'Range loop
3194 if Config.Aliases (A).Section.all = Section then
3195 Max_Len := Natural'Max
3196 (Max_Len, Config.Aliases (A).Alias'Length);
3201 -- Display the switches
3203 for S in Config.Switches'Range loop
3205 N : constant String :=
3206 Switch_Name (Config.Switches (S), Section);
3212 Put ((1 .. Max_Len - N'Length + 1 => ' '));
3214 if Config.Switches (S).Help /= null then
3215 Put (Config.Switches (S).Help.all);
3223 -- Display the aliases
3225 if Config.Aliases /= null then
3226 for A in Config.Aliases'Range loop
3227 if Config.Aliases (A).Section.all = Section then
3229 Put (Config.Aliases (A).Alias.all);
3230 Put ((1 .. Max_Len - Config.Aliases (A).Alias'Length + 1
3232 Put ("Equivalent to " & Config.Aliases (A).Expansion.all);
3237 end Display_Section_Help;
3244 (P : Switch_Parameter_Type;
3245 Name : String := "ARG") return String
3249 when Parameter_None =>
3252 when Parameter_With_Optional_Space =>
3253 return " " & To_Upper (Name);
3255 when Parameter_With_Space_Or_Equal =>
3256 return "=" & To_Upper (Name);
3258 when Parameter_No_Space =>
3259 return To_Upper (Name);
3261 when Parameter_Optional =>
3262 return '[' & To_Upper (Name) & ']';
3270 function Switch_Name
3271 (Def : Switch_Definition;
3272 Section : String) return String
3274 use Ada.Strings.Unbounded;
3275 Result : Unbounded_String;
3276 P1, P2 : Switch_Parameter_Type;
3277 Last1, Last2 : Integer := 0;
3280 if (Section = "" and then Def.Section = null)
3281 or else (Def.Section /= null and then Def.Section.all = Section)
3283 if Def.Switch /= null and then Def.Switch.all = "*" then
3284 return "[any switch]";
3287 if Def.Switch /= null then
3288 Decompose_Switch (Def.Switch.all, P1, Last1);
3289 Append (Result, Def.Switch (Def.Switch'First .. Last1));
3291 if Def.Long_Switch /= null then
3292 Decompose_Switch (Def.Long_Switch.all, P2, Last2);
3293 Append (Result, ", "
3294 & Def.Long_Switch (Def.Long_Switch'First .. Last2));
3296 if Def.Argument = null then
3297 Append (Result, Param_Name (P2, "ARG"));
3299 Append (Result, Param_Name (P2, Def.Argument.all));
3303 if Def.Argument = null then
3304 Append (Result, Param_Name (P1, "ARG"));
3306 Append (Result, Param_Name (P1, Def.Argument.all));
3310 -- Def.Switch is null (Long_Switch must be non-null)
3313 Decompose_Switch (Def.Long_Switch.all, P2, Last2);
3315 Def.Long_Switch (Def.Long_Switch'First .. Last2));
3317 if Def.Argument = null then
3318 Append (Result, Param_Name (P2, "ARG"));
3320 Append (Result, Param_Name (P2, Def.Argument.all));
3325 return To_String (Result);
3328 -- Start of processing for Display_Help
3331 if Config = null then
3335 if Config.Help /= null and then Config.Help.all /= "" then
3336 Put_Line (Config.Help.all);
3339 if Config.Usage /= null then
3342 (Ada.Command_Line.Command_Name) & " " & Config.Usage.all);
3344 Put_Line ("Usage: " & Base_Name (Ada.Command_Line.Command_Name)
3345 & " [switches] [arguments]");
3348 if Config.Help_Msg /= null and then Config.Help_Msg.all /= "" then
3349 Put_Line (Config.Help_Msg.all);
3352 Display_Section_Help ("");
3354 if Config.Sections /= null and then Config.Switches /= null then
3355 for S in Config.Sections'Range loop
3356 Display_Section_Help (Config.Sections (S).all);
3367 (Config : Command_Line_Configuration;
3368 Callback : Switch_Handler := null;
3369 Parser : Opt_Parser := Command_Line_Parser;
3370 Concatenate : Boolean := True;
3371 Quiet : Boolean := False)
3373 Local_Config : Command_Line_Configuration := Config;
3374 Getopt_Switches : String_Access;
3375 C : Character := ASCII.NUL;
3377 Empty_Name : aliased constant String := "";
3378 Current_Section : Integer := -1;
3379 Section_Name : not null access constant String := Empty_Name'Access;
3381 procedure Simple_Callback
3382 (Simple_Switch : String;
3386 -- Needs comments ???
3388 procedure Do_Callback (Switch, Parameter : String; Index : Integer);
3394 procedure Do_Callback (Switch, Parameter : String; Index : Integer) is
3396 -- Do automatic handling when possible
3399 case Local_Config.Switches (Index).Typ is
3400 when Switch_Untyped =>
3401 null; -- no automatic handling
3403 when Switch_Boolean =>
3404 Local_Config.Switches (Index).Boolean_Output.all :=
3405 Local_Config.Switches (Index).Boolean_Value;
3408 when Switch_Integer =>
3410 if Parameter = "" then
3411 Local_Config.Switches (Index).Integer_Output.all :=
3412 Local_Config.Switches (Index).Integer_Default;
3414 Local_Config.Switches (Index).Integer_Output.all :=
3415 Integer'Value (Parameter);
3419 when Constraint_Error =>
3420 raise Invalid_Parameter
3421 with "Expected integer parameter for '"
3427 when Switch_String =>
3428 Free (Local_Config.Switches (Index).String_Output.all);
3429 Local_Config.Switches (Index).String_Output.all :=
3430 new String'(Parameter);
3433 when Switch_Callback =>
3434 Local_Config.Switches (Index).Callback (Switch, Parameter);
3439 -- Otherwise calls the user callback if one was defined
3441 if Callback /= null then
3442 Callback (Switch => Switch,
3443 Parameter => Parameter,
3444 Section => Section_Name.all);
3448 procedure For_Each_Simple
3449 is new For_Each_Simple_Switch (Simple_Callback);
3451 ---------------------
3452 -- Simple_Callback --
3453 ---------------------
3455 procedure Simple_Callback
3456 (Simple_Switch : String;
3461 pragma Unreferenced (Separator);
3463 Do_Callback (Switch => Simple_Switch,
3464 Parameter => Parameter,
3466 end Simple_Callback;
3468 -- Start of processing for Getopt
3471 -- We work with a local copy of Config, because Config can be null, for
3472 -- example if Define_Switch was never called. We could modify Config
3473 -- itself, but then we would have to make it into an 'in out' parameter,
3474 -- which would be incompatible.
3476 if Local_Config = null then
3477 Local_Config := new Command_Line_Configuration_Record;
3480 if Local_Config.Switches = null then
3481 Local_Config.Switches := new Switch_Definitions (1 .. 0);
3484 -- Initialize sections
3486 if Local_Config.Sections = null then
3487 Local_Config.Sections := new Argument_List'(1 .. 0 => null);
3490 Internal_Initialize_Option_Scan
3492 Switch_Char => Parser.Switch_Character,
3493 Stop_At_First_Non_Switch => Parser.Stop_At_First,
3494 Section_Delimiters => Section_Delimiters (Local_Config));
3496 Getopt_Switches := new String'
3497 (Get_Switches (Local_Config, Parser.Switch_Character, Section_Name.all)
3500 -- Initialize output values for automatically handled switches
3502 for S in Local_Config.Switches'Range loop
3503 case Local_Config.Switches (S).Typ is
3504 when Switch_Untyped | Switch_Callback =>
3505 null; -- Nothing to do
3507 when Switch_Boolean =>
3508 Local_Config.Switches (S).Boolean_Output.all :=
3509 not Local_Config.Switches (S).Boolean_Value;
3511 when Switch_Integer =>
3512 Local_Config.Switches (S).Integer_Output.all :=
3513 Local_Config.Switches (S).Integer_Initial;
3515 when Switch_String =>
3516 if Local_Config.Switches (S).String_Output.all = null then
3517 Local_Config.Switches (S).String_Output.all :=
3523 -- For all sections, and all switches within those sections
3526 C := Getopt (Switches => Getopt_Switches.all,
3527 Concatenate => Concatenate,
3531 -- Full_Switch already includes the leading '-'
3533 Do_Callback (Switch => Full_Switch (Parser),
3534 Parameter => Parameter (Parser),
3537 elsif C /= ASCII.NUL then
3538 if Full_Switch (Parser) = "h"
3540 Full_Switch (Parser) = "-help"
3542 Display_Help (Local_Config);
3543 raise Exit_From_Command_Line;
3546 -- Do switch expansion if needed
3550 Section => Section_Name.all,
3551 Switch => Parser.Switch_Character & Full_Switch (Parser),
3552 Parameter => Parameter (Parser));
3555 if Current_Section = -1 then
3556 Current_Section := Local_Config.Sections'First;
3558 Current_Section := Current_Section + 1;
3561 exit when Current_Section > Local_Config.Sections'Last;
3563 Section_Name := Local_Config.Sections (Current_Section);
3564 Goto_Section (Section_Name.all, Parser);
3566 Free (Getopt_Switches);
3567 Getopt_Switches := new String'
3569 (Local_Config, Parser.Switch_Character, Section_Name.all));
3573 Free (Getopt_Switches);
3576 when Invalid_Switch =>
3577 Free (Getopt_Switches);
3579 -- Message inspired by "ls" on Unix
3582 Put_Line (Standard_Error,
3583 Base_Name (Ada.Command_Line.Command_Name)
3584 & ": unrecognized option '"
3585 & Full_Switch (Parser)
3593 Free (Getopt_Switches);
3602 (Line : in out Command_Line;
3603 Args : out GNAT.OS_Lib.Argument_List_Access;
3604 Expanded : Boolean := False;
3605 Switch_Char : Character := '-')
3607 Iter : Command_Line_Iterator;
3608 Count : Natural := 0;
3611 Start (Line, Iter, Expanded => Expanded);
3612 while Has_More (Iter) loop
3613 if Is_New_Section (Iter) then
3621 Args := new Argument_List (1 .. Count);
3622 Count := Args'First;
3624 Start (Line, Iter, Expanded => Expanded);
3625 while Has_More (Iter) loop
3626 if Is_New_Section (Iter) then
3627 Args (Count) := new String'(Switch_Char & Current_Section (Iter));
3631 Args (Count) := new String'(Current_Switch (Iter)
3632 & Current_Separator (Iter)
3633 & Current_Parameter (Iter));
3643 -- Note: Any change to the message displayed should also be done in
3644 -- gnatbind.adb that does not use this interface.
3646 procedure Try_Help is
3650 "try """ & Base_Name (Ada.Command_Line.Command_Name, Suffix => ".exe")
3651 & " --help"" for more information.");
3654 end GNAT.Command_Line;