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-2010, 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 package CL
renames Ada
.Command_Line
;
44 type Switch_Parameter_Type
is
46 Parameter_With_Optional_Space
, -- ':' in getopt
47 Parameter_With_Space_Or_Equal
, -- '=' in getopt
48 Parameter_No_Space
, -- '!' in getopt
49 Parameter_Optional
); -- '?' in getopt
51 procedure Set_Parameter
52 (Variable
: out Parameter_Type
;
56 Extra
: Character := ASCII
.NUL
);
57 pragma Inline
(Set_Parameter
);
58 -- Set the parameter that will be returned by Parameter below
59 -- Parameters need to be defined ???
61 function Goto_Next_Argument_In_Section
(Parser
: Opt_Parser
) return Boolean;
62 -- Go to the next argument on the command line. If we are at the end of
63 -- the current section, we want to make sure there is no other identical
64 -- section on the command line (there might be multiple instances of
65 -- -largs). Returns True iff there is another argument.
67 function Get_File_Names_Case_Sensitive
return Integer;
68 pragma Import
(C
, Get_File_Names_Case_Sensitive
,
69 "__gnat_get_file_names_case_sensitive");
71 File_Names_Case_Sensitive
: constant Boolean :=
72 Get_File_Names_Case_Sensitive
/= 0;
74 procedure Canonical_Case_File_Name
(S
: in out String);
75 -- Given a file name, converts it to canonical case form. For systems where
76 -- file names are case sensitive, this procedure has no effect. If file
77 -- names are not case sensitive (i.e. for example if you have the file
78 -- "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
79 -- converts the given string to canonical all lower case form, so that two
80 -- file names compare equal if they refer to the same file.
82 procedure Internal_Initialize_Option_Scan
84 Switch_Char
: Character;
85 Stop_At_First_Non_Switch
: Boolean;
86 Section_Delimiters
: String);
87 -- Initialize Parser, which must have been allocated already
89 function Argument
(Parser
: Opt_Parser
; Index
: Integer) return String;
90 -- Return the index-th command line argument
92 procedure Find_Longest_Matching_Switch
95 Index_In_Switches
: out Integer;
96 Switch_Length
: out Integer;
97 Param
: out Switch_Parameter_Type
);
98 -- Return the Longest switch from Switches that at least partially
99 -- partially Arg. Index_In_Switches is set to 0 if none matches.
100 -- What are other parameters??? in particular Param is not always set???
102 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
103 (Argument_List
, Argument_List_Access
);
105 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
106 (Command_Line_Configuration_Record
, Command_Line_Configuration
);
108 procedure Remove
(Line
: in out Argument_List_Access
; Index
: Integer);
109 -- Remove a specific element from Line
112 (Line
: in out Argument_List_Access
;
114 Before
: Boolean := False);
115 -- Add a new element to Line. If Before is True, the item is inserted at
116 -- the beginning, else it is appended.
119 (Config
: in out Command_Line_Configuration
;
120 Switch
: Switch_Definition
);
122 (Def
: in out Alias_Definitions_List
;
123 Alias
: Alias_Definition
);
124 -- Add a new element to Def.
126 procedure Initialize_Switch_Def
127 (Def
: out Switch_Definition
;
128 Switch
: String := "";
129 Long_Switch
: String := "";
131 Section
: String := "");
132 -- Initialize [Def] with the contents of the other parameters.
133 -- This also checks consistency of the switch parameters, and will raise
134 -- Invalid_Switch if they do not match.
136 procedure Decompose_Switch
138 Parameter_Type
: out Switch_Parameter_Type
;
139 Switch_Last
: out Integer);
140 -- Given a switch definition ("name:" for instance), extracts the type of
141 -- parameter that is expected, and the name of the switch
143 function Can_Have_Parameter
(S
: String) return Boolean;
144 -- True if S can have a parameter
146 function Require_Parameter
(S
: String) return Boolean;
147 -- True if S requires a parameter
149 function Actual_Switch
(S
: String) return String;
150 -- Remove any possible trailing '!', ':', '?' and '='
153 with procedure Callback
154 (Simple_Switch
: String;
157 Index
: Integer); -- Index in Config.Switches, or -1
158 procedure For_Each_Simple_Switch
159 (Config
: Command_Line_Configuration
;
162 Parameter
: String := "";
163 Unalias
: Boolean := True);
164 -- Breaks Switch into as simple switches as possible (expanding aliases and
165 -- ungrouping common prefixes when possible), and call Callback for each of
168 procedure Sort_Sections
169 (Line
: GNAT
.OS_Lib
.Argument_List_Access
;
170 Sections
: GNAT
.OS_Lib
.Argument_List_Access
;
171 Params
: GNAT
.OS_Lib
.Argument_List_Access
);
172 -- Reorder the command line switches so that the switches belonging to a
173 -- section are grouped together.
175 procedure Group_Switches
177 Result
: Argument_List_Access
;
178 Sections
: Argument_List_Access
;
179 Params
: Argument_List_Access
);
180 -- Group switches with common prefixes whenever possible. Once they have
181 -- been grouped, we also check items for possible aliasing.
183 procedure Alias_Switches
185 Result
: Argument_List_Access
;
186 Params
: Argument_List_Access
);
187 -- When possible, replace one or more switches by an alias, i.e. a shorter
193 Substring
: String) return Boolean;
194 -- Return True if the characters starting at Index in Type_Str are
195 -- equivalent to Substring.
198 with function Callback
(S
: String; Index
: Integer) return Boolean;
199 procedure Foreach_Switch
200 (Config
: Command_Line_Configuration
;
202 -- Iterate over all switches defined in Config, for a specific section.
203 -- Index is set to the index in Config.Switches
209 function Argument
(Parser
: Opt_Parser
; Index
: Integer) return String is
211 if Parser
.Arguments
/= null then
212 return Parser
.Arguments
(Index
+ Parser
.Arguments
'First - 1).all;
214 return CL
.Argument
(Index
);
218 ------------------------------
219 -- Canonical_Case_File_Name --
220 ------------------------------
222 procedure Canonical_Case_File_Name
(S
: in out String) is
224 if not File_Names_Case_Sensitive
then
225 for J
in S
'Range loop
226 if S
(J
) in 'A' .. 'Z' then
227 S
(J
) := Character'Val
228 (Character'Pos (S
(J
)) +
229 Character'Pos ('a') -
230 Character'Pos ('A'));
234 end Canonical_Case_File_Name
;
240 function Expansion
(Iterator
: Expansion_Iterator
) return String is
241 type Pointer
is access all Expansion_Iterator
;
243 It
: constant Pointer
:= Iterator
'Unrestricted_Access;
244 S
: String (1 .. 1024);
247 Current
: Depth
:= It
.Current_Depth
;
251 -- It is assumed that a directory is opened at the current level.
252 -- Otherwise GNAT.Directory_Operations.Directory_Error will be raised
253 -- at the first call to Read.
256 Read
(It
.Levels
(Current
).Dir
, S
, Last
);
258 -- If we have exhausted the directory, close it and go back one level
261 Close
(It
.Levels
(Current
).Dir
);
263 -- If we are at level 1, we are finished; return an empty string
266 return String'(1 .. 0 => ' ');
268 -- Otherwise continue with the directory at the previous level
271 Current := Current - 1;
272 It.Current_Depth := Current;
275 -- If this is a directory, that is neither "." or "..", attempt to
276 -- go to the next level.
279 (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
280 and then S (1 .. Last) /= "."
281 and then S (1 .. Last) /= ".."
283 -- We can go to the next level only if we have not reached the
286 if Current < It.Maximum_Depth then
287 NL := It.Levels (Current).Name_Last;
289 -- And if relative path of this new directory is not too long
291 if NL + Last + 1 < Max_Path_Length then
292 Current := Current + 1;
293 It.Current_Depth := Current;
294 It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last);
296 It.Dir_Name (NL) := Directory_Separator;
297 It.Levels (Current).Name_Last := NL;
298 Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
300 -- Open the new directory, and read from it
302 GNAT.Directory_Operations.Open
303 (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
308 -- Check the relative path against the pattern
310 -- Note that we try to match also against directory names, since
311 -- clients of this function may expect to retrieve directories.
315 It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
319 Canonical_Case_File_Name (Name);
321 -- If it matches return the relative path
323 if GNAT.Regexp.Match (Name, Iterator.Regexp) then
330 ---------------------
331 -- Current_Section --
332 ---------------------
334 function Current_Section
335 (Parser : Opt_Parser := Command_Line_Parser) return String
338 if Parser.Current_Section = 1 then
342 for Index in reverse 1 .. Integer'Min (Parser.Current_Argument - 1,
345 if Parser.Section (Index) = 0 then
346 return Argument (Parser, Index);
358 (Parser : Opt_Parser := Command_Line_Parser) return String
361 if Parser.The_Switch.Extra = ASCII.NUL then
362 return Argument (Parser, Parser.The_Switch.Arg_Num)
363 (Parser.The_Switch.First .. Parser.The_Switch.Last);
365 return Parser.The_Switch.Extra
366 & Argument (Parser, Parser.The_Switch.Arg_Num)
367 (Parser.The_Switch.First .. Parser.The_Switch.Last);
375 function Get_Argument
376 (Do_Expansion : Boolean := False;
377 Parser : Opt_Parser := Command_Line_Parser) return String
380 if Parser.In_Expansion then
382 S : constant String := Expansion (Parser.Expansion_It);
384 if S'Length /= 0 then
387 Parser.In_Expansion := False;
392 if Parser.Current_Argument > Parser.Arg_Count then
394 -- If this is the first time this function is called
396 if Parser.Current_Index = 1 then
397 Parser.Current_Argument := 1;
398 while Parser.Current_Argument <= Parser.Arg_Count
399 and then Parser.Section (Parser.Current_Argument) /=
400 Parser.Current_Section
402 Parser.Current_Argument := Parser.Current_Argument + 1;
405 return String'(1 .. 0 => ' ');
408 elsif Parser
.Section
(Parser
.Current_Argument
) = 0 then
409 while Parser
.Current_Argument
<= Parser
.Arg_Count
410 and then Parser
.Section
(Parser
.Current_Argument
) /=
411 Parser
.Current_Section
413 Parser
.Current_Argument
:= Parser
.Current_Argument
+ 1;
417 Parser
.Current_Index
:= Integer'Last;
419 while Parser
.Current_Argument
<= Parser
.Arg_Count
420 and then Parser
.Is_Switch
(Parser
.Current_Argument
)
422 Parser
.Current_Argument
:= Parser
.Current_Argument
+ 1;
425 if Parser
.Current_Argument
> Parser
.Arg_Count
then
426 return String'(1 .. 0 => ' ');
427 elsif Parser.Section (Parser.Current_Argument) = 0 then
428 return Get_Argument (Do_Expansion);
431 Parser.Current_Argument := Parser.Current_Argument + 1;
433 -- Could it be a file name with wild cards to expand?
437 Arg : constant String :=
438 Argument (Parser, Parser.Current_Argument - 1);
443 while Index <= Arg'Last loop
445 or else Arg (Index) = '?
'
446 or else Arg (Index) = '['
448 Parser.In_Expansion := True;
449 Start_Expansion (Parser.Expansion_It, Arg);
450 return Get_Argument (Do_Expansion);
458 return Argument (Parser, Parser.Current_Argument - 1);
461 ----------------------
462 -- Decompose_Switch --
463 ----------------------
465 procedure Decompose_Switch
467 Parameter_Type : out Switch_Parameter_Type;
468 Switch_Last : out Integer)
472 Parameter_Type := Parameter_None;
473 Switch_Last := Switch'Last;
477 case Switch (Switch'Last) is
479 Parameter_Type := Parameter_With_Optional_Space;
480 Switch_Last := Switch'Last - 1;
482 Parameter_Type := Parameter_With_Space_Or_Equal;
483 Switch_Last := Switch'Last - 1;
485 Parameter_Type := Parameter_No_Space;
486 Switch_Last := Switch'Last - 1;
488 Parameter_Type := Parameter_Optional;
489 Switch_Last := Switch'Last - 1;
491 Parameter_Type := Parameter_None;
492 Switch_Last := Switch'Last;
494 end Decompose_Switch;
496 ----------------------------------
497 -- Find_Longest_Matching_Switch --
498 ----------------------------------
500 procedure Find_Longest_Matching_Switch
503 Index_In_Switches : out Integer;
504 Switch_Length : out Integer;
505 Param : out Switch_Parameter_Type)
508 Length : Natural := 1;
510 P : Switch_Parameter_Type;
513 Index_In_Switches := 0;
516 -- Remove all leading spaces first to make sure that Index points
517 -- at the start of the first switch.
519 Index := Switches'First;
520 while Index <= Switches'Last and then Switches (Index) = ' ' loop
524 while Index <= Switches'Last loop
526 -- Search the length of the parameter at this position in Switches
529 while Length <= Switches'Last
530 and then Switches (Length) /= ' '
532 Length := Length + 1;
535 -- Length now marks the separator after the current switch
536 -- Last will mark the last character of the name of the switch
538 if Length = Index + 1 then
542 Decompose_Switch (Switches (Index .. Length - 1), P, Last);
545 -- If it is the one we searched, it may be a candidate
547 if Arg'First + Last - Index <= Arg'Last
548 and then Switches (Index .. Last) =
549 Arg (Arg'First .. Arg'First + Last - Index)
550 and then Last - Index + 1 > Switch_Length
553 Index_In_Switches := Index;
554 Switch_Length := Last - Index + 1;
557 -- Look for the next switch in Switches
559 while Index <= Switches'Last
560 and then Switches (Index) /= ' '
567 end Find_Longest_Matching_Switch;
575 Concatenate : Boolean := True;
576 Parser : Opt_Parser := Command_Line_Parser) return Character
579 pragma Unreferenced (Dummy);
584 -- If we have finished parsing the current command line item (there
585 -- might be multiple switches in a single item), then go to the next
588 if Parser.Current_Argument > Parser.Arg_Count
589 or else (Parser.Current_Index >
590 Argument (Parser, Parser.Current_Argument)'Last
591 and then not Goto_Next_Argument_In_Section (Parser))
596 -- By default, the switch will not have a parameter
598 Parser.The_Parameter :=
599 (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
600 Parser.The_Separator := ASCII.NUL;
603 Arg : constant String :=
604 Argument (Parser, Parser.Current_Argument);
605 Index_Switches : Natural := 0;
606 Max_Length : Natural := 0;
608 Param : Switch_Parameter_Type;
610 -- If we are on a new item, test if this might be a switch
612 if Parser.Current_Index = Arg'First then
613 if Arg (Arg'First) /= Parser.Switch_Character then
615 -- If it isn't a switch, return it immediately. We also know it
616 -- isn't the parameter to a previous switch, since that has
617 -- already been handled
619 if Switches (Switches'First) = '*' then
622 Arg_Num => Parser.Current_Argument,
625 Parser.Is_Switch (Parser.Current_Argument) := True;
626 Dummy := Goto_Next_Argument_In_Section (Parser);
630 if Parser.Stop_At_First then
631 Parser.Current_Argument := Positive'Last;
634 elsif not Goto_Next_Argument_In_Section (Parser) then
638 -- Recurse to get the next switch on the command line
644 -- We are on the first character of a new command line argument,
645 -- which starts with Switch_Character. Further analysis is needed.
647 Parser.Current_Index := Parser.Current_Index + 1;
648 Parser.Is_Switch (Parser.Current_Argument) := True;
651 Find_Longest_Matching_Switch
652 (Switches => Switches,
653 Arg => Arg (Parser.Current_Index .. Arg'Last),
654 Index_In_Switches => Index_Switches,
655 Switch_Length => Max_Length,
658 -- If switch is not accepted, it is either invalid or is returned
659 -- in the context of '*'.
661 if Index_Switches = 0 then
663 -- Depending on the value of Concatenate, the full switch is
664 -- a single character or the rest of the argument.
667 (if Concatenate then Parser.Current_Index else Arg'Last);
669 if Switches (Switches'First) = '*' then
671 -- Always prepend the switch character, so that users know that
672 -- this comes from a switch on the command line. This is
673 -- especially important when Concatenate is False, since
674 -- otherwise the current argument first character is lost.
678 Arg_Num => Parser.Current_Argument,
679 First => Parser.Current_Index,
681 Extra => Parser.Switch_Character);
682 Parser.Is_Switch (Parser.Current_Argument) := True;
683 Dummy := Goto_Next_Argument_In_Section (Parser);
689 Arg_Num => Parser.Current_Argument,
690 First => Parser.Current_Index,
692 Parser.Current_Index := End_Index + 1;
694 raise Invalid_Switch;
697 End_Index := Parser.Current_Index + Max_Length - 1;
700 Arg_Num => Parser.Current_Argument,
701 First => Parser.Current_Index,
705 when Parameter_With_Optional_Space =>
706 if End_Index < Arg'Last then
708 (Parser.The_Parameter,
709 Arg_Num => Parser.Current_Argument,
710 First => End_Index + 1,
712 Dummy := Goto_Next_Argument_In_Section (Parser);
714 elsif Parser.Current_Argument < Parser.Arg_Count
715 and then Parser.Section (Parser.Current_Argument + 1) /= 0
717 Parser.Current_Argument := Parser.Current_Argument + 1;
718 Parser.The_Separator := ' ';
720 (Parser.The_Parameter,
721 Arg_Num => Parser.Current_Argument,
722 First => Argument (Parser, Parser.Current_Argument)'First,
723 Last => Argument (Parser, Parser.Current_Argument)'Last);
724 Parser.Is_Switch (Parser.Current_Argument) := True;
725 Dummy := Goto_Next_Argument_In_Section (Parser);
728 Parser.Current_Index := End_Index + 1;
729 raise Invalid_Parameter;
732 when Parameter_With_Space_Or_Equal =>
734 -- If the switch is of the form <switch>=xxx
736 if End_Index < Arg'Last then
737 if Arg (End_Index + 1) = '='
738 and then End_Index + 1 < Arg'Last
740 Parser.The_Separator := '=';
742 (Parser.The_Parameter,
743 Arg_Num => Parser.Current_Argument,
744 First => End_Index + 2,
746 Dummy := Goto_Next_Argument_In_Section (Parser);
748 Parser.Current_Index := End_Index + 1;
749 raise Invalid_Parameter;
752 -- If the switch is of the form <switch> xxx
754 elsif Parser.Current_Argument < Parser.Arg_Count
755 and then Parser.Section (Parser.Current_Argument + 1) /= 0
757 Parser.Current_Argument := Parser.Current_Argument + 1;
758 Parser.The_Separator := ' ';
760 (Parser.The_Parameter,
761 Arg_Num => Parser.Current_Argument,
762 First => Argument (Parser, Parser.Current_Argument)'First,
763 Last => Argument (Parser, Parser.Current_Argument)'Last);
764 Parser.Is_Switch (Parser.Current_Argument) := True;
765 Dummy := Goto_Next_Argument_In_Section (Parser);
768 Parser.Current_Index := End_Index + 1;
769 raise Invalid_Parameter;
772 when Parameter_No_Space =>
773 if End_Index < Arg'Last then
775 (Parser.The_Parameter,
776 Arg_Num => Parser.Current_Argument,
777 First => End_Index + 1,
779 Dummy := Goto_Next_Argument_In_Section (Parser);
782 Parser.Current_Index := End_Index + 1;
783 raise Invalid_Parameter;
786 when Parameter_Optional =>
787 if End_Index < Arg'Last then
789 (Parser.The_Parameter,
790 Arg_Num => Parser.Current_Argument,
791 First => End_Index + 1,
795 Dummy := Goto_Next_Argument_In_Section (Parser);
797 when Parameter_None =>
798 if Concatenate or else End_Index = Arg'Last then
799 Parser.Current_Index := End_Index + 1;
802 -- If Concatenate is False and the full argument is not
803 -- recognized as a switch, this is an invalid switch.
805 if Switches (Switches'First) = '*' then
808 Arg_Num => Parser.Current_Argument,
811 Parser.Is_Switch (Parser.Current_Argument) := True;
812 Dummy := Goto_Next_Argument_In_Section (Parser);
818 Arg_Num => Parser.Current_Argument,
819 First => Parser.Current_Index,
821 Parser.Current_Index := Arg'Last + 1;
822 raise Invalid_Switch;
826 return Switches (Index_Switches);
830 -----------------------------------
831 -- Goto_Next_Argument_In_Section --
832 -----------------------------------
834 function Goto_Next_Argument_In_Section
835 (Parser : Opt_Parser) return Boolean
838 Parser.Current_Argument := Parser.Current_Argument + 1;
840 if Parser.Current_Argument > Parser.Arg_Count
841 or else Parser.Section (Parser.Current_Argument) = 0
844 Parser.Current_Argument := Parser.Current_Argument + 1;
846 if Parser.Current_Argument > Parser.Arg_Count then
847 Parser.Current_Index := 1;
851 exit when Parser.Section (Parser.Current_Argument) =
852 Parser.Current_Section;
856 Parser.Current_Index :=
857 Argument (Parser, Parser.Current_Argument)'First;
860 end Goto_Next_Argument_In_Section;
866 procedure Goto_Section
867 (Name : String := "";
868 Parser : Opt_Parser := Command_Line_Parser)
873 Parser.In_Expansion := False;
876 Parser.Current_Argument := 1;
877 Parser.Current_Index := 1;
878 Parser.Current_Section := 1;
883 while Index <= Parser.Arg_Count loop
884 if Parser.Section (Index) = 0
885 and then Argument (Parser, Index) = Parser.Switch_Character & Name
887 Parser.Current_Argument := Index + 1;
888 Parser.Current_Index := 1;
890 if Parser.Current_Argument <= Parser.Arg_Count then
891 Parser.Current_Section :=
892 Parser.Section (Parser.Current_Argument);
900 Parser.Current_Argument := Positive'Last;
901 Parser.Current_Index := 2; -- so that Get_Argument returns nothing
904 ----------------------------
905 -- Initialize_Option_Scan --
906 ----------------------------
908 procedure Initialize_Option_Scan
909 (Switch_Char : Character := '-';
910 Stop_At_First_Non_Switch : Boolean := False;
911 Section_Delimiters : String := "")
914 Internal_Initialize_Option_Scan
915 (Parser => Command_Line_Parser,
916 Switch_Char => Switch_Char,
917 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
918 Section_Delimiters => Section_Delimiters);
919 end Initialize_Option_Scan;
921 ----------------------------
922 -- Initialize_Option_Scan --
923 ----------------------------
925 procedure Initialize_Option_Scan
926 (Parser : out Opt_Parser;
927 Command_Line : GNAT.OS_Lib.Argument_List_Access;
928 Switch_Char : Character := '-';
929 Stop_At_First_Non_Switch : Boolean := False;
930 Section_Delimiters : String := "")
935 if Command_Line = null then
936 Parser := new Opt_Parser_Data (CL.Argument_Count);
937 Internal_Initialize_Option_Scan
939 Switch_Char => Switch_Char,
940 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
941 Section_Delimiters => Section_Delimiters);
943 Parser := new Opt_Parser_Data (Command_Line'Length);
944 Parser.Arguments := Command_Line;
945 Internal_Initialize_Option_Scan
947 Switch_Char => Switch_Char,
948 Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
949 Section_Delimiters => Section_Delimiters);
951 end Initialize_Option_Scan;
953 -------------------------------------
954 -- Internal_Initialize_Option_Scan --
955 -------------------------------------
957 procedure Internal_Initialize_Option_Scan
958 (Parser : Opt_Parser;
959 Switch_Char : Character;
960 Stop_At_First_Non_Switch : Boolean;
961 Section_Delimiters : String)
963 Section_Num : Section_Number;
964 Section_Index : Integer;
966 Delimiter_Found : Boolean;
969 pragma Warnings (Off, Discard);
972 Parser.Current_Argument := 0;
973 Parser.Current_Index := 0;
974 Parser.In_Expansion := False;
975 Parser.Switch_Character := Switch_Char;
976 Parser.Stop_At_First := Stop_At_First_Non_Switch;
977 Parser.Section := (others => 1);
979 -- If we are using sections, we have to preprocess the command line
980 -- to delimit them. A section can be repeated, so we just give each
981 -- item on the command line a section number
984 Section_Index := Section_Delimiters'First;
985 while Section_Index <= Section_Delimiters'Last loop
986 Last := Section_Index;
987 while Last <= Section_Delimiters'Last
988 and then Section_Delimiters (Last) /= ' '
993 Delimiter_Found := False;
994 Section_Num := Section_Num + 1;
996 for Index in 1 .. Parser.Arg_Count loop
997 if Argument (Parser, Index)(1) = Parser.Switch_Character
999 Argument (Parser, Index) = Parser.Switch_Character &
1001 (Section_Index .. Last - 1)
1003 Parser.Section (Index) := 0;
1004 Delimiter_Found := True;
1006 elsif Parser.Section (Index) = 0 then
1007 Delimiter_Found := False;
1009 elsif Delimiter_Found then
1010 Parser.Section (Index) := Section_Num;
1014 Section_Index := Last + 1;
1015 while Section_Index <= Section_Delimiters'Last
1016 and then Section_Delimiters (Section_Index) = ' '
1018 Section_Index := Section_Index + 1;
1022 Discard := Goto_Next_Argument_In_Section (Parser);
1023 end Internal_Initialize_Option_Scan;
1030 (Parser : Opt_Parser := Command_Line_Parser) return String
1033 if Parser.The_Parameter.First > Parser.The_Parameter.Last then
1034 return String'(1 .. 0 => ' ');
1036 return Argument
(Parser
, Parser
.The_Parameter
.Arg_Num
)
1037 (Parser
.The_Parameter
.First
.. Parser
.The_Parameter
.Last
);
1046 (Parser
: Opt_Parser
:= Command_Line_Parser
) return Character
1049 return Parser
.The_Separator
;
1056 procedure Set_Parameter
1057 (Variable
: out Parameter_Type
;
1061 Extra
: Character := ASCII
.NUL
)
1064 Variable
.Arg_Num
:= Arg_Num
;
1065 Variable
.First
:= First
;
1066 Variable
.Last
:= Last
;
1067 Variable
.Extra
:= Extra
;
1070 ---------------------
1071 -- Start_Expansion --
1072 ---------------------
1074 procedure Start_Expansion
1075 (Iterator
: out Expansion_Iterator
;
1077 Directory
: String := "";
1078 Basic_Regexp
: Boolean := True)
1080 Directory_Separator
: Character;
1081 pragma Import
(C
, Directory_Separator
, "__gnat_dir_separator");
1083 First
: Positive := Pattern
'First;
1084 Pat
: String := Pattern
;
1087 Canonical_Case_File_Name
(Pat
);
1088 Iterator
.Current_Depth
:= 1;
1090 -- If Directory is unspecified, use the current directory ("./" or ".\")
1092 if Directory
= "" then
1093 Iterator
.Dir_Name
(1 .. 2) := "." & Directory_Separator
;
1094 Iterator
.Start
:= 3;
1097 Iterator
.Dir_Name
(1 .. Directory
'Length) := Directory
;
1098 Iterator
.Start
:= Directory
'Length + 1;
1099 Canonical_Case_File_Name
(Iterator
.Dir_Name
(1 .. Directory
'Length));
1101 -- Make sure that the last character is a directory separator
1103 if Directory
(Directory
'Last) /= Directory_Separator
then
1104 Iterator
.Dir_Name
(Iterator
.Start
) := Directory_Separator
;
1105 Iterator
.Start
:= Iterator
.Start
+ 1;
1109 Iterator
.Levels
(1).Name_Last
:= Iterator
.Start
- 1;
1111 -- Open the initial Directory, at depth 1
1113 GNAT
.Directory_Operations
.Open
1114 (Iterator
.Levels
(1).Dir
, Iterator
.Dir_Name
(1 .. Iterator
.Start
- 1));
1116 -- If in the current directory and the pattern starts with "./" or ".\",
1117 -- drop the "./" or ".\" from the pattern.
1119 if Directory
= "" and then Pat
'Length > 2
1120 and then Pat
(Pat
'First) = '.'
1121 and then Pat
(Pat
'First + 1) = Directory_Separator
1123 First
:= Pat
'First + 2;
1127 GNAT
.Regexp
.Compile
(Pat
(First
.. Pat
'Last), Basic_Regexp
, True);
1129 Iterator
.Maximum_Depth
:= 1;
1131 -- Maximum_Depth is equal to 1 plus the number of directory separators
1134 for Index
in First
.. Pat
'Last loop
1135 if Pat
(Index
) = Directory_Separator
then
1136 Iterator
.Maximum_Depth
:= Iterator
.Maximum_Depth
+ 1;
1137 exit when Iterator
.Maximum_Depth
= Max_Depth
;
1140 end Start_Expansion
;
1146 procedure Free
(Parser
: in out Opt_Parser
) is
1147 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
1148 (Opt_Parser_Data
, Opt_Parser
);
1151 and then Parser
/= Command_Line_Parser
1153 Free
(Parser
.Arguments
);
1154 Unchecked_Free
(Parser
);
1162 procedure Define_Alias
1163 (Config
: in out Command_Line_Configuration
;
1166 Section
: String := "")
1168 Def
: Alias_Definition
;
1170 if Config
= null then
1171 Config
:= new Command_Line_Configuration_Record
;
1174 Def
.Alias
:= new String'(Switch);
1175 Def.Expansion := new String'(Expanded
);
1176 Def
.Section
:= new String'(Section);
1177 Add (Config.Aliases, Def);
1184 procedure Define_Prefix
1185 (Config : in out Command_Line_Configuration;
1189 if Config = null then
1190 Config := new Command_Line_Configuration_Record;
1193 Add (Config.Prefixes, new String'(Prefix
));
1200 procedure Add
(Config
: in out Command_Line_Configuration
;
1201 Switch
: Switch_Definition
)
1203 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
1204 (Switch_Definitions
, Switch_Definitions_List
);
1205 Tmp
: Switch_Definitions_List
;
1208 if Config
= null then
1209 Config
:= new Command_Line_Configuration_Record
;
1212 Tmp
:= Config
.Switches
;
1215 Config
.Switches
:= new Switch_Definitions
(1 .. 1);
1217 Config
.Switches
:= new Switch_Definitions
(1 .. Tmp
'Length + 1);
1218 Config
.Switches
(1 .. Tmp
'Length) := Tmp
.all;
1219 Unchecked_Free
(Tmp
);
1222 Config
.Switches
(Config
.Switches
'Last) := Switch
;
1229 procedure Add
(Def
: in out Alias_Definitions_List
;
1230 Alias
: Alias_Definition
)
1232 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
1233 (Alias_Definitions
, Alias_Definitions_List
);
1234 Tmp
: Alias_Definitions_List
:= Def
;
1238 Def
:= new Alias_Definitions
(1 .. 1);
1240 Def
:= new Alias_Definitions
(1 .. Tmp
'Length + 1);
1241 Def
(1 .. Tmp
'Length) := Tmp
.all;
1242 Unchecked_Free
(Tmp
);
1245 Def
(Def
'Last) := Alias
;
1248 ---------------------------
1249 -- Initialize_Switch_Def --
1250 ---------------------------
1252 procedure Initialize_Switch_Def
1253 (Def
: out Switch_Definition
;
1254 Switch
: String := "";
1255 Long_Switch
: String := "";
1256 Help
: String := "";
1257 Section
: String := "")
1259 P1
, P2
: Switch_Parameter_Type
:= Parameter_None
;
1260 Last1
, Last2
: Integer;
1263 if Switch
/= "" then
1264 Def
.Switch
:= new String'(Switch);
1265 Decompose_Switch (Switch, P1, Last1);
1268 if Long_Switch /= "" then
1269 Def.Long_Switch := new String'(Long_Switch
);
1270 Decompose_Switch
(Long_Switch
, P2
, Last2
);
1273 if Switch
/= "" and then Long_Switch
/= "" then
1274 if (P1
= Parameter_None
and then P2
/= P1
)
1275 or else (P2
= Parameter_None
and then P1
/= P2
)
1276 or else (P1
= Parameter_Optional
and then P2
/= P1
)
1277 or else (P2
= Parameter_Optional
and then P2
/= P1
)
1279 raise Invalid_Switch
1280 with "Inconsistent parameter types for "
1281 & Switch
& " and " & Long_Switch
;
1285 if Section
/= "" then
1286 Def
.Section
:= new String'(Section);
1290 Def.Help := new String'(Help
);
1292 end Initialize_Switch_Def
;
1298 procedure Define_Switch
1299 (Config
: in out Command_Line_Configuration
;
1300 Switch
: String := "";
1301 Long_Switch
: String := "";
1302 Help
: String := "";
1303 Section
: String := "")
1305 Def
: Switch_Definition
;
1307 if Switch
/= "" or else Long_Switch
/= "" then
1308 Initialize_Switch_Def
(Def
, Switch
, Long_Switch
, Help
, Section
);
1317 procedure Define_Switch
1318 (Config
: in out Command_Line_Configuration
;
1319 Output
: access Boolean;
1320 Switch
: String := "";
1321 Long_Switch
: String := "";
1322 Help
: String := "";
1323 Section
: String := "";
1324 Value
: Boolean := True)
1326 Def
: Switch_Definition
(Switch_Boolean
);
1328 if Switch
/= "" or else Long_Switch
/= "" then
1329 Initialize_Switch_Def
(Def
, Switch
, Long_Switch
, Help
, Section
);
1330 Def
.Boolean_Output
:= Output
.all'Unchecked_Access;
1331 Def
.Boolean_Value
:= Value
;
1340 procedure Define_Switch
1341 (Config
: in out Command_Line_Configuration
;
1342 Output
: access Integer;
1343 Switch
: String := "";
1344 Long_Switch
: String := "";
1345 Help
: String := "";
1346 Section
: String := "";
1347 Initial
: Integer := 0;
1348 Default
: Integer := 1)
1350 Def
: Switch_Definition
(Switch_Integer
);
1352 if Switch
/= "" or else Long_Switch
/= "" then
1353 Initialize_Switch_Def
(Def
, Switch
, Long_Switch
, Help
, Section
);
1354 Def
.Integer_Output
:= Output
.all'Unchecked_Access;
1355 Def
.Integer_Default
:= Default
;
1356 Def
.Integer_Initial
:= Initial
;
1365 procedure Define_Switch
1366 (Config
: in out Command_Line_Configuration
;
1367 Output
: access GNAT
.Strings
.String_Access
;
1368 Switch
: String := "";
1369 Long_Switch
: String := "";
1370 Help
: String := "";
1371 Section
: String := "")
1373 Def
: Switch_Definition
(Switch_String
);
1375 if Switch
/= "" or else Long_Switch
/= "" then
1376 Initialize_Switch_Def
(Def
, Switch
, Long_Switch
, Help
, Section
);
1377 Def
.String_Output
:= Output
.all'Unchecked_Access;
1382 --------------------
1383 -- Define_Section --
1384 --------------------
1386 procedure Define_Section
1387 (Config
: in out Command_Line_Configuration
;
1391 if Config
= null then
1392 Config
:= new Command_Line_Configuration_Record
;
1395 Add
(Config
.Sections
, new String'(Section));
1398 --------------------
1399 -- Foreach_Switch --
1400 --------------------
1402 procedure Foreach_Switch
1403 (Config : Command_Line_Configuration;
1407 if Config /= null and then Config.Switches /= null then
1408 for J in Config.Switches'Range loop
1409 if (Section = "" and then Config.Switches (J).Section = null)
1411 (Config.Switches (J).Section /= null
1412 and then Config.Switches (J).Section.all = Section)
1414 exit when Config.Switches (J).Switch /= null
1415 and then not Callback (Config.Switches (J).Switch.all, J);
1417 exit when Config.Switches (J).Long_Switch /= null
1419 not Callback (Config.Switches (J).Long_Switch.all, J);
1429 function Get_Switches
1430 (Config : Command_Line_Configuration;
1431 Switch_Char : Character := '-';
1432 Section : String := "") return String
1434 Ret : Ada.Strings.Unbounded.Unbounded_String;
1435 use Ada.Strings.Unbounded;
1437 function Add_Switch (S : String; Index : Integer) return Boolean;
1438 -- Add a switch to Ret
1444 function Add_Switch (S : String; Index : Integer) return Boolean is
1445 pragma Unreferenced (Index);
1448 Ret := "*" & Ret; -- Always first
1449 elsif S (S'First) = Switch_Char then
1450 Append (Ret, " " & S (S'First + 1 .. S'Last));
1452 Append (Ret, " " & S);
1458 pragma Unreferenced (Tmp);
1460 procedure Foreach is new Foreach_Switch (Add_Switch);
1462 -- Start of processing for Get_Switches
1465 if Config = null then
1469 Foreach (Config, Section => Section);
1471 -- Adding relevant aliases
1473 if Config.Aliases /= null then
1474 for A in Config.Aliases'Range loop
1475 if Config.Aliases (A).Section.all = Section then
1476 Tmp := Add_Switch (Config.Aliases (A).Alias.all, -1);
1481 return To_String (Ret);
1484 ------------------------
1485 -- Section_Delimiters --
1486 ------------------------
1488 function Section_Delimiters
1489 (Config : Command_Line_Configuration) return String
1491 use Ada.Strings.Unbounded;
1492 Result : Unbounded_String;
1495 if Config /= null and then Config.Sections /= null then
1496 for S in Config.Sections'Range loop
1497 Append (Result, " " & Config.Sections (S).all);
1501 return To_String (Result);
1502 end Section_Delimiters;
1504 -----------------------
1505 -- Set_Configuration --
1506 -----------------------
1508 procedure Set_Configuration
1509 (Cmd : in out Command_Line;
1510 Config : Command_Line_Configuration)
1513 Cmd.Config := Config;
1514 end Set_Configuration;
1516 -----------------------
1517 -- Get_Configuration --
1518 -----------------------
1520 function Get_Configuration
1521 (Cmd : Command_Line) return Command_Line_Configuration
1525 end Get_Configuration;
1527 ----------------------
1528 -- Set_Command_Line --
1529 ----------------------
1531 procedure Set_Command_Line
1532 (Cmd : in out Command_Line;
1534 Getopt_Description : String := "";
1535 Switch_Char : Character := '-')
1537 Tmp : Argument_List_Access;
1538 Parser : Opt_Parser;
1540 Section : String_Access := null;
1542 function Real_Full_Switch
1544 Parser : Opt_Parser) return String;
1545 -- Ensure that the returned switch value contains the
1546 -- Switch_Char prefix if needed.
1548 ----------------------
1549 -- Real_Full_Switch --
1550 ----------------------
1552 function Real_Full_Switch
1554 Parser : Opt_Parser) return String
1558 return Full_Switch (Parser);
1560 return Switch_Char & Full_Switch (Parser);
1562 end Real_Full_Switch;
1564 -- Start of processing for Set_Command_Line
1567 Free (Cmd.Expanded);
1570 if Switches /= "" then
1571 Tmp := Argument_String_To_List (Switches);
1572 Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1576 S := Getopt (Switches => "* " & Getopt_Description,
1577 Concatenate => False,
1579 exit when S = ASCII.NUL;
1582 Sw : constant String :=
1583 Real_Full_Switch (S, Parser);
1584 Is_Section : Boolean := False;
1587 if Cmd.Config /= null
1588 and then Cmd.Config.Sections /= null
1591 for S in Cmd.Config.Sections'Range loop
1592 if Sw = Cmd.Config.Sections (S).all then
1593 Section := Cmd.Config.Sections (S);
1596 exit Section_Search;
1598 end loop Section_Search;
1601 if not Is_Section then
1602 if Section = null then
1603 Add_Switch (Cmd, Sw, Parameter (Parser));
1606 (Cmd, Sw, Parameter (Parser),
1607 Section => Section.all);
1613 when Invalid_Parameter =>
1615 -- Add it with no parameter, if that's the way the user
1618 -- Specify the separator in all cases, as the switch might
1619 -- need to be unaliased, and the alias might contain
1620 -- switches with parameters.
1622 if Section = null then
1624 (Cmd, Switch_Char & Full_Switch (Parser));
1627 (Cmd, Switch_Char & Full_Switch (Parser),
1628 Section => Section.all);
1635 end Set_Command_Line;
1644 Substring : String) return Boolean
1647 return Index + Substring'Length - 1 <= Type_Str'Last
1648 and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1651 ------------------------
1652 -- Can_Have_Parameter --
1653 ------------------------
1655 function Can_Have_Parameter (S : String) return Boolean is
1657 if S'Length <= 1 then
1662 when '!' | ':' | '?
' | '=' =>
1667 end Can_Have_Parameter;
1669 -----------------------
1670 -- Require_Parameter --
1671 -----------------------
1673 function Require_Parameter (S : String) return Boolean is
1675 if S'Length <= 1 then
1680 when '!' | ':' | '=' =>
1685 end Require_Parameter;
1691 function Actual_Switch (S : String) return String is
1693 if S'Length <= 1 then
1698 when '!' | ':' | '?
' | '=' =>
1699 return S (S'First .. S'Last - 1);
1705 ----------------------------
1706 -- For_Each_Simple_Switch --
1707 ----------------------------
1709 procedure For_Each_Simple_Switch
1710 (Config : Command_Line_Configuration;
1713 Parameter : String := "";
1714 Unalias : Boolean := True)
1716 function Group_Analysis
1718 Group : String) return Boolean;
1719 -- Perform the analysis of a group of switches
1721 Found_In_Config : Boolean := False;
1722 function Is_In_Config
1723 (Config_Switch : String; Index : Integer) return Boolean;
1724 -- If Switch is the same as Config_Switch, run the callback and sets
1725 -- Found_In_Config to True
1727 function Starts_With
1728 (Config_Switch : String; Index : Integer) return Boolean;
1729 -- if Switch starts with Config_Switch, sets Found_In_Config to True.
1730 -- The return value is for the Foreach_Switch iterator
1732 --------------------
1733 -- Group_Analysis --
1734 --------------------
1736 function Group_Analysis
1738 Group : String) return Boolean
1743 function Analyze_Simple_Switch
1744 (Switch : String; Index : Integer) return Boolean;
1746 ---------------------------
1747 -- Analyze_Simple_Switch --
1748 ---------------------------
1750 function Analyze_Simple_Switch
1751 (Switch : String; Index : Integer) return Boolean
1753 pragma Unreferenced (Index);
1755 Full : constant String := Prefix & Group (Idx .. Group'Last);
1756 Sw : constant String := Actual_Switch (Switch);
1761 if Sw'Length >= Prefix'Length
1763 -- Verify that sw starts with Prefix
1765 and then Looking_At (Sw, Sw'First, Prefix)
1767 -- Verify that the group starts with sw
1769 and then Looking_At (Full, Full'First, Sw)
1771 Last := Idx + Sw'Length - Prefix'Length - 1;
1774 if Can_Have_Parameter (Switch) then
1776 -- Include potential parameter to the recursive call.
1777 -- Only numbers are allowed.
1779 while Last < Group'Last
1780 and then Group (Last + 1) in '0' .. '9'
1786 if not Require_Parameter (Switch)
1787 or else Last >= Param
1789 if Idx = Group'First
1790 and then Last = Group'Last
1791 and then Last < Param
1793 -- The group only concerns a single switch. Do not
1794 -- perform recursive call.
1796 -- Note that we still perform a recursive call if
1797 -- a parameter is detected in the switch, as this
1798 -- is a way to correctly identify such a parameter
1806 -- Recursive call, using the detected parameter if any
1808 if Last >= Param then
1809 For_Each_Simple_Switch
1812 Prefix & Group (Idx .. Param - 1),
1813 Group (Param .. Last));
1815 For_Each_Simple_Switch
1816 (Config, Section, Prefix & Group (Idx .. Last), "");
1824 end Analyze_Simple_Switch;
1826 procedure Foreach is new Foreach_Switch (Analyze_Simple_Switch);
1828 -- Start of processing for Group_Analysis
1832 while Idx <= Group'Last loop
1835 Foreach (Config, Section);
1838 For_Each_Simple_Switch
1839 (Config, Section, Prefix & Group (Idx), "");
1851 function Is_In_Config
1852 (Config_Switch : String; Index : Integer) return Boolean
1855 P : Switch_Parameter_Type;
1858 Decompose_Switch (Config_Switch, P, Last);
1860 if Config_Switch (Config_Switch'First .. Last) = Switch then
1862 when Parameter_None =>
1863 if Parameter = "" then
1864 Callback (Switch, "", "", Index => Index);
1865 Found_In_Config := True;
1869 when Parameter_With_Optional_Space =>
1870 if Parameter /= "" then
1871 Callback (Switch, " ", Parameter, Index => Index);
1872 Found_In_Config := True;
1876 when Parameter_With_Space_Or_Equal =>
1877 if Parameter /= "" then
1878 Callback (Switch, "=", Parameter, Index => Index);
1879 Found_In_Config := True;
1883 when Parameter_No_Space =>
1884 if Parameter /= "" then
1885 Callback (Switch, "", Parameter, Index);
1886 Found_In_Config := True;
1890 when Parameter_Optional =>
1891 Callback (Switch, "", Parameter, Index);
1892 Found_In_Config := True;
1904 function Starts_With
1905 (Config_Switch : String; Index : Integer) return Boolean
1909 P : Switch_Parameter_Type;
1912 -- This function is called when we believe the parameter was
1913 -- specified as part of the switch, instead of separately. Thus we
1914 -- look in the config to find all possible switches.
1916 Decompose_Switch (Config_Switch, P, Last);
1919 (Switch, Switch'First, Config_Switch (Config_Switch'First .. Last))
1921 -- Set first char of Param, and last char of Switch
1923 Param := Switch'First + Last;
1924 Last := Switch'First + Last - Config_Switch'First;
1928 -- None is already handled in Is_In_Config
1930 when Parameter_None =>
1933 when Parameter_With_Space_Or_Equal =>
1934 if Param <= Switch'Last
1936 (Switch (Param) = ' ' or else Switch (Param) = '=')
1938 Callback (Switch (Switch'First .. Last),
1939 "=", Switch (Param + 1 .. Switch'Last), Index);
1940 Found_In_Config := True;
1944 when Parameter_With_Optional_Space =>
1945 if Param <= Switch'Last and then Switch (Param) = ' ' then
1949 Callback (Switch (Switch'First .. Last),
1950 " ", Switch (Param .. Switch'Last), Index);
1951 Found_In_Config := True;
1954 when Parameter_No_Space | Parameter_Optional =>
1955 Callback (Switch (Switch'First .. Last),
1956 "", Switch (Param .. Switch'Last), Index);
1957 Found_In_Config := True;
1964 procedure Foreach_In_Config is new Foreach_Switch (Is_In_Config);
1965 procedure Foreach_Starts_With is new Foreach_Switch (Starts_With);
1967 -- Start of processing for For_Each_Simple_Switch
1970 -- First determine if the switch corresponds to one belonging to the
1971 -- configuration. If so, run callback and exit.
1973 Foreach_In_Config (Config, Section);
1975 if Found_In_Config then
1979 -- If adding a switch that can in fact be expanded through aliases,
1980 -- add separately each of its expansions.
1982 -- This takes care of expansions like "-T" -> "-gnatwrs", where the
1983 -- alias and its expansion do not have the same prefix. Given the order
1984 -- in which we do things here, the expansion of the alias will itself
1985 -- be checked for a common prefix and split into simple switches.
1988 and then Config /= null
1989 and then Config.Aliases /= null
1991 for A in Config.Aliases'Range loop
1992 if Config.Aliases (A).Section.all = Section
1993 and then Config.Aliases (A).Alias.all = Switch
1994 and then Parameter = ""
1996 For_Each_Simple_Switch
1997 (Config, Section, Config.Aliases (A).Expansion.all, "");
2003 -- If adding a switch grouping several switches, add each of the simple
2004 -- switches instead.
2006 if Config /= null and then Config.Prefixes /= null then
2007 for P in Config.Prefixes'Range loop
2008 if Switch'Length > Config.Prefixes (P)'Length + 1
2010 (Switch, Switch'First, Config.Prefixes (P).all)
2012 -- Alias expansion will be done recursively
2014 if Config.Switches = null then
2015 for S in Switch'First + Config.Prefixes (P)'Length
2018 For_Each_Simple_Switch
2020 Config.Prefixes (P).all & Switch (S), "");
2025 elsif Group_Analysis
2026 (Config.Prefixes (P).all,
2028 (Switch'First + Config.Prefixes (P)'Length .. Switch'Last))
2030 -- Recursive calls already done on each switch of the group:
2031 -- Return without executing Callback.
2038 -- Test if added switch is a known switch with parameter attached
2039 -- instead of being specified separately
2042 and then Config /= null
2043 and then Config.Switches /= null
2045 Found_In_Config := False;
2046 Foreach_Starts_With (Config, Section);
2047 if Found_In_Config then
2052 -- The switch is invalid in the config, but we still want to report it.
2053 -- The config could, for instance, include "*" to specify it accepts
2056 Callback (Switch, " ", Parameter, Index => -1);
2057 end For_Each_Simple_Switch;
2063 procedure Add_Switch
2064 (Cmd : in out Command_Line;
2066 Parameter : String := "";
2067 Separator : Character := ' ';
2068 Section : String := "";
2069 Add_Before : Boolean := False)
2072 pragma Unreferenced (Success);
2074 Add_Switch (Cmd, Switch, Parameter, Separator,
2075 Section, Add_Before, Success);
2082 procedure Add_Switch
2083 (Cmd : in out Command_Line;
2085 Parameter : String := "";
2086 Separator : Character := ' ';
2087 Section : String := "";
2088 Add_Before : Boolean := False;
2089 Success : out Boolean)
2091 pragma Unreferenced (Separator); -- ??? Should be removed eventually
2093 procedure Add_Simple_Switch
2098 -- Add a new switch that has had all its aliases expanded, and switches
2099 -- ungrouped. We know there are no more aliases in Switches.
2101 -----------------------
2102 -- Add_Simple_Switch --
2103 -----------------------
2105 procedure Add_Simple_Switch
2111 pragma Unreferenced (Index);
2115 if Separator = "" then
2118 Sep := Separator (Separator'First);
2121 if Cmd.Expanded = null then
2122 Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
2126 new Argument_List'(1 .. 1 => new String'(Sep & Param));
2128 Cmd.Params := new Argument_List'(1 .. 1 => null);
2131 if Section
= "" then
2132 Cmd
.Sections
:= new Argument_List
'(1 .. 1 => null);
2135 new Argument_List'(1 .. 1 => new String'(Section));
2139 -- Do we already have this switch?
2141 for C in Cmd.Expanded'Range loop
2142 if Cmd.Expanded (C).all = Simple
2144 ((Cmd.Params (C) = null and then Param = "")
2146 (Cmd.Params (C) /= null
2147 and then Cmd.Params (C).all = Sep & Param))
2149 ((Cmd.Sections (C) = null and then Section = "")
2151 (Cmd.Sections (C) /= null
2152 and then Cmd.Sections (C).all = Section))
2158 -- Inserting at least one switch
2161 Add (Cmd.Expanded, new String'(Simple
), Add_Before
);
2166 new String'(Sep & Param),
2175 if Section = "" then
2183 new String'(Section
),
2187 end Add_Simple_Switch
;
2189 procedure Add_Simple_Switches
is
2190 new For_Each_Simple_Switch
(Add_Simple_Switch
);
2194 Section_Valid
: Boolean := False;
2196 -- Start of processing for Add_Switch
2199 if Section
/= "" and then Cmd
.Config
/= null then
2200 for S
in Cmd
.Config
.Sections
'Range loop
2201 if Section
= Cmd
.Config
.Sections
(S
).all then
2202 Section_Valid
:= True;
2207 if not Section_Valid
then
2208 raise Invalid_Section
;
2213 Add_Simple_Switches
(Cmd
.Config
, Section
, Switch
, Parameter
);
2214 Free
(Cmd
.Coalesce
);
2221 procedure Remove
(Line
: in out Argument_List_Access
; Index
: Integer) is
2222 Tmp
: Argument_List_Access
:= Line
;
2225 Line
:= new Argument_List
(Tmp
'First .. Tmp
'Last - 1);
2227 if Index
/= Tmp
'First then
2228 Line
(Tmp
'First .. Index
- 1) := Tmp
(Tmp
'First .. Index
- 1);
2233 if Index
/= Tmp
'Last then
2234 Line
(Index
.. Tmp
'Last - 1) := Tmp
(Index
+ 1 .. Tmp
'Last);
2237 Unchecked_Free
(Tmp
);
2245 (Line
: in out Argument_List_Access
;
2246 Str
: String_Access
;
2247 Before
: Boolean := False)
2249 Tmp
: Argument_List_Access
:= Line
;
2253 Line
:= new Argument_List
(Tmp
'First .. Tmp
'Last + 1);
2256 Line
(Tmp
'First) := Str
;
2257 Line
(Tmp
'First + 1 .. Tmp
'Last + 1) := Tmp
.all;
2259 Line
(Tmp
'Range) := Tmp
.all;
2260 Line
(Tmp
'Last + 1) := Str
;
2263 Unchecked_Free
(Tmp
);
2266 Line
:= new Argument_List
'(1 .. 1 => Str);
2274 procedure Remove_Switch
2275 (Cmd : in out Command_Line;
2277 Remove_All : Boolean := False;
2278 Has_Parameter : Boolean := False;
2279 Section : String := "")
2282 pragma Unreferenced (Success);
2284 Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
2291 procedure Remove_Switch
2292 (Cmd : in out Command_Line;
2294 Remove_All : Boolean := False;
2295 Has_Parameter : Boolean := False;
2296 Section : String := "";
2297 Success : out Boolean)
2299 procedure Remove_Simple_Switch
2300 (Simple, Separator, Param : String; Index : Integer);
2301 -- Removes a simple switch, with no aliasing or grouping
2303 --------------------------
2304 -- Remove_Simple_Switch --
2305 --------------------------
2307 procedure Remove_Simple_Switch
2308 (Simple, Separator, Param : String; Index : Integer)
2311 pragma Unreferenced (Param, Separator, Index);
2314 if Cmd.Expanded /= null then
2315 C := Cmd.Expanded'First;
2316 while C <= Cmd.Expanded'Last loop
2317 if Cmd.Expanded (C).all = Simple
2320 or else (Cmd.Sections (C) = null
2321 and then Section = "")
2322 or else (Cmd.Sections (C) /= null
2323 and then Section = Cmd.Sections (C).all))
2324 and then (not Has_Parameter or else Cmd.Params (C) /= null)
2326 Remove (Cmd.Expanded, C);
2327 Remove (Cmd.Params, C);
2328 Remove (Cmd.Sections, C);
2331 if not Remove_All then
2340 end Remove_Simple_Switch;
2342 procedure Remove_Simple_Switches is
2343 new For_Each_Simple_Switch (Remove_Simple_Switch);
2345 -- Start of processing for Remove_Switch
2349 Remove_Simple_Switches
2350 (Cmd.Config, Section, Switch, "", Unalias => not Has_Parameter);
2351 Free (Cmd.Coalesce);
2358 procedure Remove_Switch
2359 (Cmd : in out Command_Line;
2362 Section : String := "")
2364 procedure Remove_Simple_Switch
2365 (Simple, Separator, Param : String; Index : Integer);
2366 -- Removes a simple switch, with no aliasing or grouping
2368 --------------------------
2369 -- Remove_Simple_Switch --
2370 --------------------------
2372 procedure Remove_Simple_Switch
2373 (Simple, Separator, Param : String; Index : Integer)
2375 pragma Unreferenced (Separator, Index);
2379 if Cmd.Expanded /= null then
2380 C := Cmd.Expanded'First;
2381 while C <= Cmd.Expanded'Last loop
2382 if Cmd.Expanded (C).all = Simple
2384 ((Cmd.Sections (C) = null
2385 and then Section = "")
2387 (Cmd.Sections (C) /= null
2388 and then Section = Cmd.Sections (C).all))
2390 ((Cmd.Params (C) = null and then Param = "")
2392 (Cmd.Params (C) /= null
2395 -- Ignore the separator stored in Parameter
2397 Cmd.Params (C) (Cmd.Params (C)'First + 1
2398 .. Cmd.Params (C)'Last) =
2401 Remove (Cmd.Expanded, C);
2402 Remove (Cmd.Params, C);
2403 Remove (Cmd.Sections, C);
2405 -- The switch is necessarily unique by construction of
2415 end Remove_Simple_Switch;
2417 procedure Remove_Simple_Switches is
2418 new For_Each_Simple_Switch (Remove_Simple_Switch);
2420 -- Start of processing for Remove_Switch
2423 Remove_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2424 Free (Cmd.Coalesce);
2427 --------------------
2428 -- Group_Switches --
2429 --------------------
2431 procedure Group_Switches
2432 (Cmd : Command_Line;
2433 Result : Argument_List_Access;
2434 Sections : Argument_List_Access;
2435 Params : Argument_List_Access)
2437 function Compatible_Parameter (Param : String_Access) return Boolean;
2438 -- True when the parameter can be part of a group
2440 --------------------------
2441 -- Compatible_Parameter --
2442 --------------------------
2444 function Compatible_Parameter (Param : String_Access) return Boolean is
2448 if Param = null then
2451 -- We need parameters without separators
2453 elsif Param (Param'First) /= ASCII.NUL then
2456 -- Parameters must be all digits
2459 for J in Param'First + 1 .. Param'Last loop
2460 if Param (J) not in '0' .. '9' then
2467 end Compatible_Parameter;
2469 -- Local declarations
2471 Group : Ada.Strings.Unbounded.Unbounded_String;
2473 use type Ada.Strings.Unbounded.Unbounded_String;
2475 -- Start of processing for Group_Switches
2478 if Cmd.Config = null
2479 or else Cmd.Config.Prefixes = null
2484 for P in Cmd.Config.Prefixes'Range loop
2485 Group := Ada.Strings.Unbounded.Null_Unbounded_String;
2488 for C in Result'Range loop
2489 if Result (C) /= null
2490 and then Compatible_Parameter (Params (C))
2492 (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
2494 -- If we are still in the same section, group the switches
2498 (Sections (C) = null
2499 and then Sections (First) = null)
2501 (Sections (C) /= null
2502 and then Sections (First) /= null
2503 and then Sections (C).all = Sections (First).all)
2508 (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2511 if Params (C) /= null then
2514 Params (C) (Params (C)'First + 1 .. Params (C)'Last);
2524 -- We changed section: we put the grouped switches to the first
2525 -- place, on continue with the new section.
2530 (Cmd
.Config
.Prefixes
(P
).all &
2531 Ada
.Strings
.Unbounded
.To_String
(Group
));
2533 Ada
.Strings
.Unbounded
.To_Unbounded_String
2535 (Result
(C
)'First + Cmd
.Config
.Prefixes
(P
)'Length ..
2545 (Cmd.Config.Prefixes (P).all &
2546 Ada.Strings.Unbounded.To_String (Group));
2551 --------------------
2552 -- Alias_Switches --
2553 --------------------
2555 procedure Alias_Switches
2556 (Cmd : Command_Line;
2557 Result : Argument_List_Access;
2558 Params : Argument_List_Access)
2563 procedure Check_Cb (Switch, Separator, Param : String; Index : Integer);
2564 -- Checks whether the command line contains [Switch].
2565 -- Sets the global variable [Found] appropriately.
2566 -- This will be called for each simple switch that make up an alias, to
2567 -- know whether the alias should be applied.
2569 procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer);
2570 -- Remove the simple switch [Switch] from the command line, since it is
2571 -- part of a simpler alias
2578 (Switch, Separator, Param : String; Index : Integer)
2580 pragma Unreferenced (Separator, Index);
2584 for E in Result'Range loop
2585 if Result (E) /= null
2588 or else Params (E) (Params (E)'First + 1
2589 .. Params (E)'Last) = Param)
2590 and then Result (E).all = Switch
2604 procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer)
2606 pragma Unreferenced (Separator, Index);
2609 for E in Result'Range loop
2610 if Result (E) /= null
2613 or else Params (E) (Params (E)'First + 1
2614 .. Params (E)'Last) = Param)
2615 and then Result (E).all = Switch
2628 procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
2629 procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
2631 -- Start of processing for Alias_Switches
2634 if Cmd.Config = null
2635 or else Cmd.Config.Aliases = null
2640 for A in Cmd.Config.Aliases'Range loop
2642 -- Compute the various simple switches that make up the alias. We
2643 -- split the expansion into as many simple switches as possible, and
2644 -- then check whether the expanded command line has all of them.
2647 Check_All (Cmd.Config,
2648 Switch => Cmd.Config.Aliases (A).Expansion.all,
2649 Section => Cmd.Config.Aliases (A).Section.all);
2652 First := Integer'Last;
2653 Remove_All (Cmd.Config,
2654 Switch => Cmd.Config.Aliases (A).Expansion.all,
2655 Section => Cmd.Config.Aliases (A).Section.all);
2656 Result (First) := new String'(Cmd
.Config
.Aliases
(A
).Alias
.all);
2665 procedure Sort_Sections
2666 (Line
: GNAT
.OS_Lib
.Argument_List_Access
;
2667 Sections
: GNAT
.OS_Lib
.Argument_List_Access
;
2668 Params
: GNAT
.OS_Lib
.Argument_List_Access
)
2670 Sections_List
: Argument_List_Access
:=
2671 new Argument_List
'(1 .. 1 => null);
2673 Old_Line : constant Argument_List := Line.all;
2674 Old_Sections : constant Argument_List := Sections.all;
2675 Old_Params : constant Argument_List := Params.all;
2683 -- First construct a list of all sections
2685 for E in Line'Range loop
2686 if Sections (E) /= null then
2688 for S in Sections_List'Range loop
2689 if (Sections_List (S) = null and then Sections (E) = null)
2691 (Sections_List (S) /= null
2692 and then Sections (E) /= null
2693 and then Sections_List (S).all = Sections (E).all)
2701 Add (Sections_List, Sections (E));
2706 Index := Line'First;
2708 for S in Sections_List'Range loop
2709 for E in Old_Line'Range loop
2710 if (Sections_List (S) = null and then Old_Sections (E) = null)
2712 (Sections_List (S) /= null
2713 and then Old_Sections (E) /= null
2714 and then Sections_List (S).all = Old_Sections (E).all)
2716 Line (Index) := Old_Line (E);
2717 Sections (Index) := Old_Sections (E);
2718 Params (Index) := Old_Params (E);
2724 Unchecked_Free (Sections_List);
2732 (Cmd : in out Command_Line;
2733 Iter : in out Command_Line_Iterator;
2734 Expanded : Boolean := False)
2737 if Cmd.Expanded = null then
2742 -- Reorder the expanded line so that sections are grouped
2744 Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
2746 -- Coalesce the switches as much as possible
2749 and then Cmd.Coalesce = null
2751 Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range);
2752 for E in Cmd.Expanded'Range loop
2753 Cmd.Coalesce (E) := new String'(Cmd
.Expanded
(E
).all);
2756 Free
(Cmd
.Coalesce_Sections
);
2757 Cmd
.Coalesce_Sections
:= new Argument_List
(Cmd
.Sections
'Range);
2758 for E
in Cmd
.Sections
'Range loop
2759 Cmd
.Coalesce_Sections
(E
) :=
2760 (if Cmd
.Sections
(E
) = null then null
2761 else new String'(Cmd.Sections (E).all));
2764 Free (Cmd.Coalesce_Params);
2765 Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range);
2766 for E in Cmd.Params'Range loop
2767 Cmd.Coalesce_Params (E) :=
2768 (if Cmd.Params (E) = null then null
2769 else new String'(Cmd
.Params
(E
).all));
2772 -- Not a clone, since we will not modify the parameters anyway
2774 Alias_Switches
(Cmd
, Cmd
.Coalesce
, Cmd
.Coalesce_Params
);
2776 (Cmd
, Cmd
.Coalesce
, Cmd
.Coalesce_Sections
, Cmd
.Coalesce_Params
);
2780 Iter
.List
:= Cmd
.Expanded
;
2781 Iter
.Params
:= Cmd
.Params
;
2782 Iter
.Sections
:= Cmd
.Sections
;
2784 Iter
.List
:= Cmd
.Coalesce
;
2785 Iter
.Params
:= Cmd
.Coalesce_Params
;
2786 Iter
.Sections
:= Cmd
.Coalesce_Sections
;
2789 if Iter
.List
= null then
2790 Iter
.Current
:= Integer'Last;
2792 Iter
.Current
:= Iter
.List
'First;
2794 while Iter
.Current
<= Iter
.List
'Last
2795 and then Iter
.List
(Iter
.Current
) = null
2797 Iter
.Current
:= Iter
.Current
+ 1;
2802 --------------------
2803 -- Current_Switch --
2804 --------------------
2806 function Current_Switch
(Iter
: Command_Line_Iterator
) return String is
2808 return Iter
.List
(Iter
.Current
).all;
2811 --------------------
2812 -- Is_New_Section --
2813 --------------------
2815 function Is_New_Section
(Iter
: Command_Line_Iterator
) return Boolean is
2816 Section
: constant String := Current_Section
(Iter
);
2818 if Iter
.Sections
= null then
2820 elsif Iter
.Current
= Iter
.Sections
'First
2821 or else Iter
.Sections
(Iter
.Current
- 1) = null
2823 return Section
/= "";
2826 return Section
/= Iter
.Sections
(Iter
.Current
- 1).all;
2829 ---------------------
2830 -- Current_Section --
2831 ---------------------
2833 function Current_Section
(Iter
: Command_Line_Iterator
) return String is
2835 if Iter
.Sections
= null
2836 or else Iter
.Current
> Iter
.Sections
'Last
2837 or else Iter
.Sections
(Iter
.Current
) = null
2842 return Iter
.Sections
(Iter
.Current
).all;
2843 end Current_Section
;
2845 -----------------------
2846 -- Current_Separator --
2847 -----------------------
2849 function Current_Separator
(Iter
: Command_Line_Iterator
) return String is
2851 if Iter
.Params
= null
2852 or else Iter
.Current
> Iter
.Params
'Last
2853 or else Iter
.Params
(Iter
.Current
) = null
2859 Sep
: constant Character :=
2860 Iter
.Params
(Iter
.Current
) (Iter
.Params
(Iter
.Current
)'First);
2862 if Sep
= ASCII
.NUL
then
2869 end Current_Separator
;
2871 -----------------------
2872 -- Current_Parameter --
2873 -----------------------
2875 function Current_Parameter
(Iter
: Command_Line_Iterator
) return String is
2877 if Iter
.Params
= null
2878 or else Iter
.Current
> Iter
.Params
'Last
2879 or else Iter
.Params
(Iter
.Current
) = null
2885 P
: constant String := Iter
.Params
(Iter
.Current
).all;
2890 return P
(P
'First + 1 .. P
'Last);
2893 end Current_Parameter
;
2899 function Has_More
(Iter
: Command_Line_Iterator
) return Boolean is
2901 return Iter
.List
/= null and then Iter
.Current
<= Iter
.List
'Last;
2908 procedure Next
(Iter
: in out Command_Line_Iterator
) is
2910 Iter
.Current
:= Iter
.Current
+ 1;
2911 while Iter
.Current
<= Iter
.List
'Last
2912 and then Iter
.List
(Iter
.Current
) = null
2914 Iter
.Current
:= Iter
.Current
+ 1;
2922 procedure Free
(Config
: in out Command_Line_Configuration
) is
2923 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
2924 (Switch_Definitions
, Switch_Definitions_List
);
2925 procedure Unchecked_Free
is new Ada
.Unchecked_Deallocation
2926 (Alias_Definitions
, Alias_Definitions_List
);
2928 if Config
/= null then
2929 Free
(Config
.Prefixes
);
2930 Free
(Config
.Sections
);
2931 Free
(Config
.Usage
);
2934 if Config
.Aliases
/= null then
2935 for A
in Config
.Aliases
'Range loop
2936 Free
(Config
.Aliases
(A
).Alias
);
2937 Free
(Config
.Aliases
(A
).Expansion
);
2938 Free
(Config
.Aliases
(A
).Section
);
2940 Unchecked_Free
(Config
.Aliases
);
2943 if Config
.Switches
/= null then
2944 for S
in Config
.Switches
'Range loop
2945 Free
(Config
.Switches
(S
).Switch
);
2946 Free
(Config
.Switches
(S
).Long_Switch
);
2947 Free
(Config
.Switches
(S
).Help
);
2948 Free
(Config
.Switches
(S
).Section
);
2951 Unchecked_Free
(Config
.Switches
);
2954 Unchecked_Free
(Config
);
2962 procedure Free
(Cmd
: in out Command_Line
) is
2964 Free
(Cmd
.Expanded
);
2965 Free
(Cmd
.Coalesce
);
2966 Free
(Cmd
.Coalesce_Sections
);
2967 Free
(Cmd
.Coalesce_Params
);
2969 Free
(Cmd
.Sections
);
2977 (Config
: in out Command_Line_Configuration
;
2978 Usage
: String := "[switches] [arguments]";
2979 Help
: String := "")
2982 if Config
= null then
2983 Config
:= new Command_Line_Configuration_Record
;
2986 Free
(Config
.Usage
);
2987 Config
.Usage
:= new String'(Usage);
2988 Config.Help := new String'(Help
);
2995 procedure Display_Help
(Config
: Command_Line_Configuration
) is
2996 function Switch_Name
2997 (Def
: Switch_Definition
;
2998 Section
: String) return String;
2999 -- Return the "-short, --long=ARG" string for Def.
3000 -- Returns "" if the switch is not in the section.
3003 (P
: Switch_Parameter_Type
;
3004 Name
: String := "ARG") return String;
3005 -- Return the display for a switch parameter
3007 procedure Display_Section_Help
(Section
: String);
3008 -- Display the help for a specific section ("" is the default section)
3010 --------------------------
3011 -- Display_Section_Help --
3012 --------------------------
3014 procedure Display_Section_Help
(Section
: String) is
3015 Max_Len
: Natural := 0;
3017 -- ??? Special display for "*"
3021 if Section
/= "" then
3022 Put_Line
("Switches after " & Section
);
3025 -- Compute size of the switches column
3027 for S
in Config
.Switches
'Range loop
3028 Max_Len
:= Natural'Max
3029 (Max_Len
, Switch_Name
(Config
.Switches
(S
), Section
)'Length);
3032 if Config
.Aliases
/= null then
3033 for A
in Config
.Aliases
'Range loop
3034 if Config
.Aliases
(A
).Section
.all = Section
then
3035 Max_Len
:= Natural'Max
3036 (Max_Len
, Config
.Aliases
(A
).Alias
'Length);
3041 -- Display the switches
3043 for S
in Config
.Switches
'Range loop
3045 N
: constant String :=
3046 Switch_Name
(Config
.Switches
(S
), Section
);
3051 Put
((1 .. Max_Len
- N
'Length + 1 => ' '));
3053 if Config
.Switches
(S
).Help
/= null then
3054 Put
(Config
.Switches
(S
).Help
.all);
3062 -- Display the aliases
3064 if Config
.Aliases
/= null then
3065 for A
in Config
.Aliases
'Range loop
3066 if Config
.Aliases
(A
).Section
.all = Section
then
3068 Put
(Config
.Aliases
(A
).Alias
.all);
3069 Put
((1 .. Max_Len
- Config
.Aliases
(A
).Alias
'Length + 1
3071 Put
("Equivalent to " & Config
.Aliases
(A
).Expansion
.all);
3076 end Display_Section_Help
;
3083 (P
: Switch_Parameter_Type
;
3084 Name
: String := "ARG") return String
3088 when Parameter_None
=>
3091 when Parameter_With_Optional_Space
=>
3092 return " " & To_Upper
(Name
);
3094 when Parameter_With_Space_Or_Equal
=>
3095 return "=" & To_Upper
(Name
);
3097 when Parameter_No_Space
=>
3098 return To_Upper
(Name
);
3100 when Parameter_Optional
=>
3101 return '[' & To_Upper
(Name
) & ']';
3109 function Switch_Name
3110 (Def
: Switch_Definition
;
3111 Section
: String) return String
3113 use Ada
.Strings
.Unbounded
;
3114 Result
: Unbounded_String
;
3115 P1
, P2
: Switch_Parameter_Type
;
3116 Last1
, Last2
: Integer := 0;
3119 if (Section
= "" and then Def
.Section
= null)
3120 or else (Def
.Section
/= null and then Def
.Section
.all = Section
)
3122 if Def
.Switch
/= null
3123 and then Def
.Switch
.all = "*"
3125 return "[any switch]";
3128 if Def
.Switch
/= null then
3129 Decompose_Switch
(Def
.Switch
.all, P1
, Last1
);
3130 Append
(Result
, Def
.Switch
(Def
.Switch
'First .. Last1
));
3132 if Def
.Long_Switch
/= null then
3133 Decompose_Switch
(Def
.Long_Switch
.all, P2
, Last2
);
3134 Append
(Result
, ", "
3135 & Def
.Long_Switch
(Def
.Long_Switch
'First .. Last2
));
3136 Append
(Result
, Param_Name
(P2
, "ARG"));
3139 Append
(Result
, Param_Name
(P1
, "ARG"));
3142 else -- Long_Switch necessarily not null
3143 Decompose_Switch
(Def
.Long_Switch
.all, P2
, Last2
);
3145 Def
.Long_Switch
(Def
.Long_Switch
'First .. Last2
));
3146 Append
(Result
, Param_Name
(P2
, "ARG"));
3150 return To_String
(Result
);
3153 -- Start of processing for Display_Help
3156 if Config
= null then
3160 if Config
.Usage
/= null then
3163 (Ada
.Command_Line
.Command_Name
) & " " & Config
.Usage
.all);
3165 Put_Line
("Usage: " & Base_Name
(Ada
.Command_Line
.Command_Name
)
3166 & " [switches] [arguments]");
3169 if Config
.Help
/= null and then Config
.Help
.all /= "" then
3170 Put_Line
(Config
.Help
.all);
3173 Display_Section_Help
("");
3175 if Config
.Sections
/= null and then Config
.Switches
/= null then
3176 for S
in Config
.Sections
'Range loop
3177 Display_Section_Help
(Config
.Sections
(S
).all);
3187 (Config
: Command_Line_Configuration
;
3188 Callback
: Switch_Handler
:= null;
3189 Parser
: Opt_Parser
:= Command_Line_Parser
)
3191 Getopt_Switches
: String_Access
;
3192 C
: Character := ASCII
.NUL
;
3194 Empty_Name
: aliased constant String := "";
3195 Current_Section
: Integer := -1;
3196 Section_Name
: not null access constant String := Empty_Name
'Access;
3198 procedure Simple_Callback
3199 (Simple_Switch
: String;
3203 -- Needs comments ???
3205 procedure Do_Callback
(Switch
, Parameter
: String; Index
: Integer);
3211 procedure Do_Callback
(Switch
, Parameter
: String; Index
: Integer) is
3213 -- Do automatic handling when possible
3216 case Config
.Switches
(Index
).Typ
is
3217 when Switch_Untyped
=>
3218 null; -- no automatic handling
3220 when Switch_Boolean
=>
3221 Config
.Switches
(Index
).Boolean_Output
.all :=
3222 Config
.Switches
(Index
).Boolean_Value
;
3225 when Switch_Integer
=>
3227 if Parameter
= "" then
3228 Config
.Switches
(Index
).Integer_Output
.all :=
3229 Config
.Switches
(Index
).Integer_Default
;
3231 Config
.Switches
(Index
).Integer_Output
.all :=
3232 Integer'Value (Parameter
);
3235 when Constraint_Error
=>
3236 raise Invalid_Parameter
3237 with "Expected integer parameter for '"
3241 when Switch_String
=>
3242 Free
(Config
.Switches
(Index
).String_Output
.all);
3243 Config
.Switches
(Index
).String_Output
.all :=
3244 new String'(Parameter);
3248 -- Otherwise calls the user callback if one was defined
3250 if Callback /= null then
3251 Callback (Switch => Switch,
3252 Parameter => Parameter,
3253 Section => Section_Name.all);
3257 procedure For_Each_Simple
3258 is new For_Each_Simple_Switch (Simple_Callback);
3260 ---------------------
3261 -- Simple_Callback --
3262 ---------------------
3264 procedure Simple_Callback
3265 (Simple_Switch : String;
3270 pragma Unreferenced (Separator);
3272 Do_Callback (Switch => Simple_Switch,
3273 Parameter => Parameter,
3275 end Simple_Callback;
3277 -- Start of processing for Getopt
3280 -- Initialize sections
3282 if Config.Sections = null then
3283 Config.Sections := new Argument_List'(1 .. 0 => null);
3286 Internal_Initialize_Option_Scan
3288 Switch_Char
=> Parser
.Switch_Character
,
3289 Stop_At_First_Non_Switch
=> Parser
.Stop_At_First
,
3290 Section_Delimiters
=> Section_Delimiters
(Config
));
3292 Getopt_Switches
:= new String'
3293 (Get_Switches (Config, Parser.Switch_Character, Section_Name.all)
3296 -- Initialize output values for automatically handled switches
3298 for S in Config.Switches'Range loop
3299 case Config.Switches (S).Typ is
3300 when Switch_Untyped =>
3301 null; -- Nothing to do
3303 when Switch_Boolean =>
3304 Config.Switches (S).Boolean_Output.all :=
3305 not Config.Switches (S).Boolean_Value;
3307 when Switch_Integer =>
3308 Config.Switches (S).Integer_Output.all :=
3309 Config.Switches (S).Integer_Initial;
3311 when Switch_String =>
3312 Config.Switches (S).String_Output.all := new String'("");
3316 -- For all sections, and all switches within those sections
3319 C
:= Getopt
(Switches
=> Getopt_Switches
.all,
3320 Concatenate
=> True,
3324 -- Full_Switch already includes the leading '-'
3326 Do_Callback
(Switch
=> Full_Switch
(Parser
),
3327 Parameter
=> Parameter
(Parser
),
3330 elsif C
/= ASCII
.NUL
then
3331 if Full_Switch
(Parser
) = "h"
3332 or else Full_Switch
(Parser
) = "-help"
3334 Display_Help
(Config
);
3335 raise Exit_From_Command_Line
;
3338 -- Do switch expansion if needed
3341 Section
=> Section_Name
.all,
3342 Switch
=> Parser
.Switch_Character
& Full_Switch
(Parser
),
3343 Parameter
=> Parameter
(Parser
));
3346 if Current_Section
= -1 then
3347 Current_Section
:= Config
.Sections
'First;
3349 Current_Section
:= Current_Section
+ 1;
3352 exit when Current_Section
> Config
.Sections
'Last;
3354 Section_Name
:= Config
.Sections
(Current_Section
);
3355 Goto_Section
(Section_Name
.all, Parser
);
3357 Free
(Getopt_Switches
);
3358 Getopt_Switches
:= new String'
3360 (Config, Parser.Switch_Character, Section_Name.all));
3364 Free (Getopt_Switches);
3367 when Invalid_Switch =>
3368 Free (Getopt_Switches);
3370 -- Message inspired by "ls" on Unix
3372 Put_Line (Standard_Error,
3373 Base_Name (Ada.Command_Line.Command_Name)
3374 & ": unrecognized option '"
3375 & Parser.Switch_Character & Full_Switch (Parser)
3377 Put_Line (Standard_Error,
3379 & Base_Name (Ada.Command_Line.Command_Name)
3380 & " --help` for more information.");
3385 Free (Getopt_Switches);
3394 (Line : in out Command_Line;
3395 Args : out GNAT.OS_Lib.Argument_List_Access;
3396 Expanded : Boolean := False;
3397 Switch_Char : Character := '-')
3399 Iter : Command_Line_Iterator;
3400 Count : Natural := 0;
3403 Start (Line, Iter, Expanded => Expanded);
3404 while Has_More (Iter) loop
3405 if Is_New_Section (Iter) then
3413 Args := new Argument_List (1 .. Count);
3414 Count := Args'First;
3416 Start (Line, Iter, Expanded => Expanded);
3417 while Has_More (Iter) loop
3418 if Is_New_Section (Iter) then
3419 Args (Count) := new String'
3420 (Switch_Char
& Current_Section
(Iter
));
3424 Args
(Count
) := new String'(Current_Switch (Iter)
3425 & Current_Separator (Iter)
3426 & Current_Parameter (Iter));
3432 end GNAT.Command_Line;