]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- G N A T . C O M M A N D _ L I N E -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
748086b7 | 9 | -- Copyright (C) 1999-2009, Free Software Foundation, Inc. -- |
38cbfe40 RK |
10 | -- -- |
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- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
38cbfe40 RK |
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 -- | |
748086b7 JJ |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
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. -- | |
21 | -- -- | |
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/>. -- | |
38cbfe40 | 26 | -- -- |
fbf5a39b AC |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- |
28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
38cbfe40 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
da2ac8c2 | 32 | with Ada.Unchecked_Deallocation; |
c18b3a99 | 33 | with Ada.Strings.Unbounded; |
b59283f2 | 34 | |
c18b3a99 | 35 | with GNAT.OS_Lib; use GNAT.OS_Lib; |
38cbfe40 RK |
36 | |
37 | package body GNAT.Command_Line is | |
38 | ||
39 | package CL renames Ada.Command_Line; | |
40 | ||
da2ac8c2 EB |
41 | type Switch_Parameter_Type is |
42 | (Parameter_None, | |
43 | Parameter_With_Optional_Space, -- ':' in getopt | |
44 | Parameter_With_Space_Or_Equal, -- '=' in getopt | |
45 | Parameter_No_Space, -- '!' in getopt | |
e14c931f | 46 | Parameter_Optional); -- '?' in getopt |
38cbfe40 RK |
47 | |
48 | procedure Set_Parameter | |
49 | (Variable : out Parameter_Type; | |
50 | Arg_Num : Positive; | |
51 | First : Positive; | |
da2ac8c2 EB |
52 | Last : Positive; |
53 | Extra : Character := ASCII.NUL); | |
38cbfe40 RK |
54 | pragma Inline (Set_Parameter); |
55 | -- Set the parameter that will be returned by Parameter below | |
da2ac8c2 | 56 | -- Parameters need to be defined ??? |
38cbfe40 | 57 | |
da2ac8c2 EB |
58 | function Goto_Next_Argument_In_Section (Parser : Opt_Parser) return Boolean; |
59 | -- Go to the next argument on the command line. If we are at the end of | |
60 | -- the current section, we want to make sure there is no other identical | |
a2cb348e RD |
61 | -- section on the command line (there might be multiple instances of |
62 | -- -largs). Returns True iff there is another argument. | |
07fc65c4 GB |
63 | |
64 | function Get_File_Names_Case_Sensitive return Integer; | |
65 | pragma Import (C, Get_File_Names_Case_Sensitive, | |
66 | "__gnat_get_file_names_case_sensitive"); | |
a2cb348e | 67 | |
07fc65c4 GB |
68 | File_Names_Case_Sensitive : constant Boolean := |
69 | Get_File_Names_Case_Sensitive /= 0; | |
70 | ||
71 | procedure Canonical_Case_File_Name (S : in out String); | |
a2cb348e RD |
72 | -- Given a file name, converts it to canonical case form. For systems where |
73 | -- file names are case sensitive, this procedure has no effect. If file | |
74 | -- names are not case sensitive (i.e. for example if you have the file | |
75 | -- "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call | |
76 | -- converts the given string to canonical all lower case form, so that two | |
77 | -- file names compare equal if they refer to the same file. | |
07fc65c4 | 78 | |
da2ac8c2 EB |
79 | procedure Internal_Initialize_Option_Scan |
80 | (Parser : Opt_Parser; | |
81 | Switch_Char : Character; | |
82 | Stop_At_First_Non_Switch : Boolean; | |
83 | Section_Delimiters : String); | |
84 | -- Initialize Parser, which must have been allocated already | |
85 | ||
86 | function Argument (Parser : Opt_Parser; Index : Integer) return String; | |
87 | -- Return the index-th command line argument | |
88 | ||
89 | procedure Find_Longest_Matching_Switch | |
90 | (Switches : String; | |
91 | Arg : String; | |
92 | Index_In_Switches : out Integer; | |
93 | Switch_Length : out Integer; | |
94 | Param : out Switch_Parameter_Type); | |
95 | -- return the Longest switch from Switches that matches at least | |
96 | -- partially Arg. Index_In_Switches is set to 0 if none matches | |
97 | ||
98 | procedure Unchecked_Free is new Ada.Unchecked_Deallocation | |
99 | (Argument_List, Argument_List_Access); | |
100 | ||
101 | procedure Unchecked_Free is new Ada.Unchecked_Deallocation | |
102 | (Command_Line_Configuration_Record, Command_Line_Configuration); | |
103 | ||
da2ac8c2 EB |
104 | procedure Remove (Line : in out Argument_List_Access; Index : Integer); |
105 | -- Remove a specific element from Line | |
106 | ||
cf5028e3 RD |
107 | procedure Add |
108 | (Line : in out Argument_List_Access; | |
109 | Str : String_Access; | |
110 | Before : Boolean := False); | |
111 | -- Add a new element to Line. If Before is True, the item is inserted at | |
5b3a33c3 | 112 | -- the beginning, else it is appended. |
da2ac8c2 | 113 | |
f9325b03 | 114 | function Can_Have_Parameter (S : String) return Boolean; |
16b05213 | 115 | -- True if S can have a parameter. |
f9325b03 AC |
116 | |
117 | function Require_Parameter (S : String) return Boolean; | |
16b05213 | 118 | -- True if S requires a parameter. |
f9325b03 AC |
119 | |
120 | function Actual_Switch (S : String) return String; | |
121 | -- Remove any possible trailing '!', ':', '?' and '=' | |
122 | ||
6a1cb33a | 123 | generic |
f9325b03 | 124 | with procedure Callback (Simple_Switch : String; Parameter : String); |
da2ac8c2 | 125 | procedure For_Each_Simple_Switch |
f9325b03 AC |
126 | (Cmd : Command_Line; |
127 | Switch : String; | |
cf5028e3 | 128 | Parameter : String := ""; |
f9325b03 | 129 | Unalias : Boolean := True); |
da2ac8c2 EB |
130 | -- Breaks Switch into as simple switches as possible (expanding aliases and |
131 | -- ungrouping common prefixes when possible), and call Callback for each of | |
132 | -- these. | |
133 | ||
c1db334e JL |
134 | procedure Sort_Sections |
135 | (Line : GNAT.OS_Lib.Argument_List_Access; | |
136 | Sections : GNAT.OS_Lib.Argument_List_Access; | |
137 | Params : GNAT.OS_Lib.Argument_List_Access); | |
138 | -- Reorder the command line switches so that the switches belonging to a | |
139 | -- section are grouped together. | |
140 | ||
da2ac8c2 | 141 | procedure Group_Switches |
c1db334e JL |
142 | (Cmd : Command_Line; |
143 | Result : Argument_List_Access; | |
144 | Sections : Argument_List_Access; | |
145 | Params : Argument_List_Access); | |
cf5028e3 RD |
146 | -- Group switches with common prefixes whenever possible. Once they have |
147 | -- been grouped, we also check items for possible aliasing. | |
da2ac8c2 EB |
148 | |
149 | procedure Alias_Switches | |
150 | (Cmd : Command_Line; | |
151 | Result : Argument_List_Access; | |
152 | Params : Argument_List_Access); | |
cf5028e3 | 153 | -- When possible, replace one or more switches by an alias, i.e. a shorter |
da2ac8c2 EB |
154 | -- version. |
155 | ||
156 | function Looking_At | |
157 | (Type_Str : String; | |
158 | Index : Natural; | |
159 | Substring : String) return Boolean; | |
160 | -- Return True if the characters starting at Index in Type_Str are | |
161 | -- equivalent to Substring. | |
162 | ||
163 | -------------- | |
164 | -- Argument -- | |
165 | -------------- | |
166 | ||
167 | function Argument (Parser : Opt_Parser; Index : Integer) return String is | |
168 | begin | |
169 | if Parser.Arguments /= null then | |
170 | return Parser.Arguments (Index + Parser.Arguments'First - 1).all; | |
171 | else | |
172 | return CL.Argument (Index); | |
173 | end if; | |
174 | end Argument; | |
175 | ||
07fc65c4 GB |
176 | ------------------------------ |
177 | -- Canonical_Case_File_Name -- | |
178 | ------------------------------ | |
179 | ||
180 | procedure Canonical_Case_File_Name (S : in out String) is | |
181 | begin | |
182 | if not File_Names_Case_Sensitive then | |
183 | for J in S'Range loop | |
184 | if S (J) in 'A' .. 'Z' then | |
da2ac8c2 EB |
185 | S (J) := Character'Val |
186 | (Character'Pos (S (J)) + | |
07fc65c4 GB |
187 | Character'Pos ('a') - |
188 | Character'Pos ('A')); | |
189 | end if; | |
190 | end loop; | |
191 | end if; | |
192 | end Canonical_Case_File_Name; | |
38cbfe40 RK |
193 | |
194 | --------------- | |
195 | -- Expansion -- | |
196 | --------------- | |
197 | ||
198 | function Expansion (Iterator : Expansion_Iterator) return String is | |
199 | use GNAT.Directory_Operations; | |
200 | type Pointer is access all Expansion_Iterator; | |
201 | ||
fbe627af | 202 | It : constant Pointer := Iterator'Unrestricted_Access; |
38cbfe40 RK |
203 | S : String (1 .. 1024); |
204 | Last : Natural; | |
38cbfe40 | 205 | |
07fc65c4 GB |
206 | Current : Depth := It.Current_Depth; |
207 | NL : Positive; | |
208 | ||
38cbfe40 | 209 | begin |
a2cb348e RD |
210 | -- It is assumed that a directory is opened at the current level. |
211 | -- Otherwise GNAT.Directory_Operations.Directory_Error will be raised | |
07fc65c4 GB |
212 | -- at the first call to Read. |
213 | ||
38cbfe40 | 214 | loop |
07fc65c4 GB |
215 | Read (It.Levels (Current).Dir, S, Last); |
216 | ||
217 | -- If we have exhausted the directory, close it and go back one level | |
38cbfe40 RK |
218 | |
219 | if Last = 0 then | |
07fc65c4 GB |
220 | Close (It.Levels (Current).Dir); |
221 | ||
a2cb348e | 222 | -- If we are at level 1, we are finished; return an empty string |
07fc65c4 GB |
223 | |
224 | if Current = 1 then | |
225 | return String'(1 .. 0 => ' '); | |
226 | else | |
da2ac8c2 | 227 | -- Otherwise continue with the directory at the previous level |
07fc65c4 GB |
228 | |
229 | Current := Current - 1; | |
230 | It.Current_Depth := Current; | |
231 | end if; | |
232 | ||
233 | -- If this is a directory, that is neither "." or "..", attempt to | |
234 | -- go to the next level. | |
235 | ||
236 | elsif Is_Directory | |
237 | (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last)) | |
238 | and then S (1 .. Last) /= "." | |
239 | and then S (1 .. Last) /= ".." | |
240 | then | |
241 | -- We can go to the next level only if we have not reached the | |
242 | -- maximum depth, | |
243 | ||
244 | if Current < It.Maximum_Depth then | |
245 | NL := It.Levels (Current).Name_Last; | |
246 | ||
247 | -- And if relative path of this new directory is not too long | |
248 | ||
249 | if NL + Last + 1 < Max_Path_Length then | |
250 | Current := Current + 1; | |
251 | It.Current_Depth := Current; | |
252 | It.Dir_Name (NL + 1 .. NL + Last) := S (1 .. Last); | |
253 | NL := NL + Last + 1; | |
254 | It.Dir_Name (NL) := Directory_Separator; | |
255 | It.Levels (Current).Name_Last := NL; | |
256 | Canonical_Case_File_Name (It.Dir_Name (1 .. NL)); | |
257 | ||
258 | -- Open the new directory, and read from it | |
38cbfe40 | 259 | |
07fc65c4 GB |
260 | GNAT.Directory_Operations.Open |
261 | (It.Levels (Current).Dir, It.Dir_Name (1 .. NL)); | |
262 | end if; | |
263 | end if; | |
f16d05d9 | 264 | end if; |
07fc65c4 | 265 | |
a8ea8a9d AC |
266 | -- Check the relative path against the pattern |
267 | ||
f16d05d9 AC |
268 | -- Note that we try to match also against directory names, since |
269 | -- clients of this function may expect to retrieve directories. | |
07fc65c4 | 270 | |
f16d05d9 AC |
271 | declare |
272 | Name : String := | |
273 | It.Dir_Name (It.Start .. It.Levels (Current).Name_Last) | |
274 | & S (1 .. Last); | |
a8ea8a9d | 275 | |
f16d05d9 AC |
276 | begin |
277 | Canonical_Case_File_Name (Name); | |
07fc65c4 | 278 | |
f16d05d9 | 279 | -- If it matches return the relative path |
07fc65c4 | 280 | |
f16d05d9 AC |
281 | if GNAT.Regexp.Match (Name, Iterator.Regexp) then |
282 | return Name; | |
283 | end if; | |
284 | end; | |
38cbfe40 | 285 | end loop; |
38cbfe40 RK |
286 | end Expansion; |
287 | ||
288 | ----------------- | |
289 | -- Full_Switch -- | |
290 | ----------------- | |
291 | ||
da2ac8c2 EB |
292 | function Full_Switch |
293 | (Parser : Opt_Parser := Command_Line_Parser) return String | |
294 | is | |
38cbfe40 | 295 | begin |
da2ac8c2 EB |
296 | if Parser.The_Switch.Extra = ASCII.NUL then |
297 | return Argument (Parser, Parser.The_Switch.Arg_Num) | |
298 | (Parser.The_Switch.First .. Parser.The_Switch.Last); | |
299 | else | |
300 | return Parser.The_Switch.Extra | |
301 | & Argument (Parser, Parser.The_Switch.Arg_Num) | |
302 | (Parser.The_Switch.First .. Parser.The_Switch.Last); | |
303 | end if; | |
38cbfe40 RK |
304 | end Full_Switch; |
305 | ||
306 | ------------------ | |
307 | -- Get_Argument -- | |
308 | ------------------ | |
309 | ||
da2ac8c2 EB |
310 | function Get_Argument |
311 | (Do_Expansion : Boolean := False; | |
312 | Parser : Opt_Parser := Command_Line_Parser) return String | |
313 | is | |
38cbfe40 | 314 | begin |
da2ac8c2 | 315 | if Parser.In_Expansion then |
38cbfe40 | 316 | declare |
da2ac8c2 | 317 | S : constant String := Expansion (Parser.Expansion_It); |
38cbfe40 RK |
318 | begin |
319 | if S'Length /= 0 then | |
320 | return S; | |
321 | else | |
da2ac8c2 | 322 | Parser.In_Expansion := False; |
38cbfe40 | 323 | end if; |
38cbfe40 RK |
324 | end; |
325 | end if; | |
326 | ||
da2ac8c2 | 327 | if Parser.Current_Argument > Parser.Arg_Count then |
38cbfe40 RK |
328 | |
329 | -- If this is the first time this function is called | |
330 | ||
da2ac8c2 EB |
331 | if Parser.Current_Index = 1 then |
332 | Parser.Current_Argument := 1; | |
333 | while Parser.Current_Argument <= Parser.Arg_Count | |
334 | and then Parser.Section (Parser.Current_Argument) /= | |
335 | Parser.Current_Section | |
38cbfe40 | 336 | loop |
da2ac8c2 | 337 | Parser.Current_Argument := Parser.Current_Argument + 1; |
38cbfe40 RK |
338 | end loop; |
339 | else | |
340 | return String'(1 .. 0 => ' '); | |
341 | end if; | |
342 | ||
da2ac8c2 EB |
343 | elsif Parser.Section (Parser.Current_Argument) = 0 then |
344 | while Parser.Current_Argument <= Parser.Arg_Count | |
345 | and then Parser.Section (Parser.Current_Argument) /= | |
346 | Parser.Current_Section | |
38cbfe40 | 347 | loop |
da2ac8c2 | 348 | Parser.Current_Argument := Parser.Current_Argument + 1; |
38cbfe40 RK |
349 | end loop; |
350 | end if; | |
351 | ||
da2ac8c2 | 352 | Parser.Current_Index := Integer'Last; |
38cbfe40 | 353 | |
da2ac8c2 EB |
354 | while Parser.Current_Argument <= Parser.Arg_Count |
355 | and then Parser.Is_Switch (Parser.Current_Argument) | |
38cbfe40 | 356 | loop |
da2ac8c2 | 357 | Parser.Current_Argument := Parser.Current_Argument + 1; |
38cbfe40 RK |
358 | end loop; |
359 | ||
da2ac8c2 | 360 | if Parser.Current_Argument > Parser.Arg_Count then |
38cbfe40 | 361 | return String'(1 .. 0 => ' '); |
da2ac8c2 | 362 | elsif Parser.Section (Parser.Current_Argument) = 0 then |
38cbfe40 RK |
363 | return Get_Argument (Do_Expansion); |
364 | end if; | |
365 | ||
da2ac8c2 | 366 | Parser.Current_Argument := Parser.Current_Argument + 1; |
38cbfe40 | 367 | |
07fc65c4 | 368 | -- Could it be a file name with wild cards to expand? |
38cbfe40 RK |
369 | |
370 | if Do_Expansion then | |
371 | declare | |
da2ac8c2 EB |
372 | Arg : constant String := |
373 | Argument (Parser, Parser.Current_Argument - 1); | |
374 | Index : Positive; | |
38cbfe40 RK |
375 | |
376 | begin | |
da2ac8c2 | 377 | Index := Arg'First; |
38cbfe40 | 378 | while Index <= Arg'Last loop |
38cbfe40 RK |
379 | if Arg (Index) = '*' |
380 | or else Arg (Index) = '?' | |
381 | or else Arg (Index) = '[' | |
382 | then | |
da2ac8c2 EB |
383 | Parser.In_Expansion := True; |
384 | Start_Expansion (Parser.Expansion_It, Arg); | |
38cbfe40 RK |
385 | return Get_Argument (Do_Expansion); |
386 | end if; | |
387 | ||
388 | Index := Index + 1; | |
389 | end loop; | |
390 | end; | |
391 | end if; | |
392 | ||
da2ac8c2 | 393 | return Argument (Parser, Parser.Current_Argument - 1); |
38cbfe40 RK |
394 | end Get_Argument; |
395 | ||
da2ac8c2 EB |
396 | ---------------------------------- |
397 | -- Find_Longest_Matching_Switch -- | |
398 | ---------------------------------- | |
399 | ||
400 | procedure Find_Longest_Matching_Switch | |
401 | (Switches : String; | |
402 | Arg : String; | |
403 | Index_In_Switches : out Integer; | |
404 | Switch_Length : out Integer; | |
405 | Param : out Switch_Parameter_Type) | |
406 | is | |
407 | Index : Natural; | |
408 | Length : Natural := 1; | |
409 | P : Switch_Parameter_Type; | |
410 | ||
411 | begin | |
412 | Index_In_Switches := 0; | |
413 | Switch_Length := 0; | |
414 | ||
415 | -- Remove all leading spaces first to make sure that Index points | |
416 | -- at the start of the first switch. | |
417 | ||
418 | Index := Switches'First; | |
419 | while Index <= Switches'Last and then Switches (Index) = ' ' loop | |
420 | Index := Index + 1; | |
421 | end loop; | |
422 | ||
423 | while Index <= Switches'Last loop | |
424 | ||
425 | -- Search the length of the parameter at this position in Switches | |
426 | ||
427 | Length := Index; | |
428 | while Length <= Switches'Last | |
429 | and then Switches (Length) /= ' ' | |
430 | loop | |
431 | Length := Length + 1; | |
432 | end loop; | |
433 | ||
434 | if Length = Index + 1 then | |
435 | P := Parameter_None; | |
436 | else | |
437 | case Switches (Length - 1) is | |
438 | when ':' => | |
439 | P := Parameter_With_Optional_Space; | |
440 | Length := Length - 1; | |
441 | when '=' => | |
442 | P := Parameter_With_Space_Or_Equal; | |
443 | Length := Length - 1; | |
444 | when '!' => | |
445 | P := Parameter_No_Space; | |
446 | Length := Length - 1; | |
447 | when '?' => | |
448 | P := Parameter_Optional; | |
449 | Length := Length - 1; | |
450 | when others => | |
451 | P := Parameter_None; | |
452 | end case; | |
453 | end if; | |
454 | ||
455 | -- If it is the one we searched, it may be a candidate | |
456 | ||
457 | if Arg'First + Length - 1 - Index <= Arg'Last | |
458 | and then Switches (Index .. Length - 1) = | |
459 | Arg (Arg'First .. Arg'First + Length - 1 - Index) | |
460 | and then Length - Index > Switch_Length | |
461 | then | |
462 | Param := P; | |
463 | Index_In_Switches := Index; | |
464 | Switch_Length := Length - Index; | |
465 | end if; | |
466 | ||
467 | -- Look for the next switch in Switches | |
468 | ||
469 | while Index <= Switches'Last | |
470 | and then Switches (Index) /= ' ' | |
471 | loop | |
472 | Index := Index + 1; | |
473 | end loop; | |
474 | ||
475 | Index := Index + 1; | |
476 | end loop; | |
477 | end Find_Longest_Matching_Switch; | |
478 | ||
38cbfe40 RK |
479 | ------------ |
480 | -- Getopt -- | |
481 | ------------ | |
482 | ||
fbf5a39b AC |
483 | function Getopt |
484 | (Switches : String; | |
da2ac8c2 EB |
485 | Concatenate : Boolean := True; |
486 | Parser : Opt_Parser := Command_Line_Parser) return Character | |
fbf5a39b | 487 | is |
07fc65c4 | 488 | Dummy : Boolean; |
fbf5a39b | 489 | pragma Unreferenced (Dummy); |
38cbfe40 RK |
490 | |
491 | begin | |
da2ac8c2 EB |
492 | <<Restart>> |
493 | ||
07fc65c4 | 494 | -- If we have finished parsing the current command line item (there |
38cbfe40 RK |
495 | -- might be multiple switches in a single item), then go to the next |
496 | -- element | |
497 | ||
da2ac8c2 EB |
498 | if Parser.Current_Argument > Parser.Arg_Count |
499 | or else (Parser.Current_Index > | |
500 | Argument (Parser, Parser.Current_Argument)'Last | |
501 | and then not Goto_Next_Argument_In_Section (Parser)) | |
38cbfe40 RK |
502 | then |
503 | return ASCII.NUL; | |
504 | end if; | |
505 | ||
da2ac8c2 | 506 | -- By default, the switch will not have a parameter |
38cbfe40 | 507 | |
da2ac8c2 EB |
508 | Parser.The_Parameter := |
509 | (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL); | |
510 | Parser.The_Separator := ASCII.NUL; | |
38cbfe40 RK |
511 | |
512 | declare | |
da2ac8c2 EB |
513 | Arg : constant String := |
514 | Argument (Parser, Parser.Current_Argument); | |
38cbfe40 RK |
515 | Index_Switches : Natural := 0; |
516 | Max_Length : Natural := 0; | |
38cbfe40 | 517 | End_Index : Natural; |
da2ac8c2 | 518 | Param : Switch_Parameter_Type; |
38cbfe40 | 519 | begin |
da2ac8c2 EB |
520 | -- If we are on a new item, test if this might be a switch |
521 | ||
522 | if Parser.Current_Index = Arg'First then | |
523 | if Arg (Arg'First) /= Parser.Switch_Character then | |
524 | ||
525 | -- If it isn't a switch, return it immediately. We also know it | |
526 | -- isn't the parameter to a previous switch, since that has | |
527 | -- already been handled | |
528 | ||
529 | if Switches (Switches'First) = '*' then | |
530 | Set_Parameter | |
531 | (Parser.The_Switch, | |
532 | Arg_Num => Parser.Current_Argument, | |
533 | First => Arg'First, | |
534 | Last => Arg'Last); | |
535 | Parser.Is_Switch (Parser.Current_Argument) := True; | |
536 | Dummy := Goto_Next_Argument_In_Section (Parser); | |
537 | return '*'; | |
538 | end if; | |
ffdbd4c4 | 539 | |
da2ac8c2 EB |
540 | if Parser.Stop_At_First then |
541 | Parser.Current_Argument := Positive'Last; | |
542 | return ASCII.NUL; | |
38cbfe40 | 543 | |
da2ac8c2 EB |
544 | elsif not Goto_Next_Argument_In_Section (Parser) then |
545 | return ASCII.NUL; | |
38cbfe40 | 546 | |
da2ac8c2 EB |
547 | else |
548 | -- Recurse to get the next switch on the command line | |
38cbfe40 | 549 | |
da2ac8c2 EB |
550 | goto Restart; |
551 | end if; | |
38cbfe40 RK |
552 | end if; |
553 | ||
da2ac8c2 EB |
554 | -- We are on the first character of a new command line argument, |
555 | -- which starts with Switch_Character. Further analysis is needed. | |
38cbfe40 | 556 | |
da2ac8c2 EB |
557 | Parser.Current_Index := Parser.Current_Index + 1; |
558 | Parser.Is_Switch (Parser.Current_Argument) := True; | |
559 | end if; | |
38cbfe40 | 560 | |
da2ac8c2 EB |
561 | Find_Longest_Matching_Switch |
562 | (Switches => Switches, | |
563 | Arg => Arg (Parser.Current_Index .. Arg'Last), | |
564 | Index_In_Switches => Index_Switches, | |
565 | Switch_Length => Max_Length, | |
566 | Param => Param); | |
38cbfe40 | 567 | |
da2ac8c2 EB |
568 | -- If switch is not accepted, it is either invalid or is returned |
569 | -- in the context of '*'. | |
38cbfe40 RK |
570 | |
571 | if Index_Switches = 0 then | |
38cbfe40 | 572 | |
fbf5a39b | 573 | -- Depending on the value of Concatenate, the full switch is |
da2ac8c2 | 574 | -- a single character or the rest of the argument. |
fbf5a39b AC |
575 | |
576 | if Concatenate then | |
da2ac8c2 | 577 | End_Index := Parser.Current_Index; |
fbf5a39b AC |
578 | else |
579 | End_Index := Arg'Last; | |
580 | end if; | |
581 | ||
da2ac8c2 | 582 | if Switches (Switches'First) = '*' then |
38cbfe40 | 583 | |
da2ac8c2 EB |
584 | -- Always prepend the switch character, so that users know that |
585 | -- this comes from a switch on the command line. This is | |
586 | -- especially important when Concatenate is False, since | |
e14c931f | 587 | -- otherwise the current argument first character is lost. |
38cbfe40 | 588 | |
da2ac8c2 EB |
589 | Set_Parameter |
590 | (Parser.The_Switch, | |
591 | Arg_Num => Parser.Current_Argument, | |
592 | First => Parser.Current_Index, | |
593 | Last => Arg'Last, | |
594 | Extra => Parser.Switch_Character); | |
595 | Parser.Is_Switch (Parser.Current_Argument) := True; | |
596 | Dummy := Goto_Next_Argument_In_Section (Parser); | |
597 | return '*'; | |
598 | end if; | |
38cbfe40 | 599 | |
da2ac8c2 EB |
600 | Set_Parameter |
601 | (Parser.The_Switch, | |
602 | Arg_Num => Parser.Current_Argument, | |
603 | First => Parser.Current_Index, | |
604 | Last => End_Index); | |
605 | Parser.Current_Index := End_Index + 1; | |
606 | raise Invalid_Switch; | |
607 | end if; | |
38cbfe40 | 608 | |
da2ac8c2 EB |
609 | End_Index := Parser.Current_Index + Max_Length - 1; |
610 | Set_Parameter | |
611 | (Parser.The_Switch, | |
612 | Arg_Num => Parser.Current_Argument, | |
613 | First => Parser.Current_Index, | |
614 | Last => End_Index); | |
615 | ||
616 | case Param is | |
617 | when Parameter_With_Optional_Space => | |
618 | if End_Index < Arg'Last then | |
619 | Set_Parameter | |
620 | (Parser.The_Parameter, | |
621 | Arg_Num => Parser.Current_Argument, | |
622 | First => End_Index + 1, | |
623 | Last => Arg'Last); | |
624 | Dummy := Goto_Next_Argument_In_Section (Parser); | |
625 | ||
626 | elsif Parser.Current_Argument < Parser.Arg_Count | |
627 | and then Parser.Section (Parser.Current_Argument + 1) /= 0 | |
628 | then | |
629 | Parser.Current_Argument := Parser.Current_Argument + 1; | |
630 | Parser.The_Separator := ' '; | |
631 | Set_Parameter | |
632 | (Parser.The_Parameter, | |
633 | Arg_Num => Parser.Current_Argument, | |
634 | First => Argument (Parser, Parser.Current_Argument)'First, | |
635 | Last => Argument (Parser, Parser.Current_Argument)'Last); | |
636 | Parser.Is_Switch (Parser.Current_Argument) := True; | |
637 | Dummy := Goto_Next_Argument_In_Section (Parser); | |
638 | ||
639 | else | |
640 | Parser.Current_Index := End_Index + 1; | |
641 | raise Invalid_Parameter; | |
642 | end if; | |
38cbfe40 | 643 | |
da2ac8c2 | 644 | when Parameter_With_Space_Or_Equal => |
38cbfe40 | 645 | |
da2ac8c2 | 646 | -- If the switch is of the form <switch>=xxx |
38cbfe40 | 647 | |
da2ac8c2 | 648 | if End_Index < Arg'Last then |
38cbfe40 | 649 | |
da2ac8c2 EB |
650 | if Arg (End_Index + 1) = '=' |
651 | and then End_Index + 1 < Arg'Last | |
652 | then | |
653 | Parser.The_Separator := '='; | |
654 | Set_Parameter | |
655 | (Parser.The_Parameter, | |
656 | Arg_Num => Parser.Current_Argument, | |
657 | First => End_Index + 2, | |
658 | Last => Arg'Last); | |
659 | Dummy := Goto_Next_Argument_In_Section (Parser); | |
38cbfe40 | 660 | else |
da2ac8c2 | 661 | Parser.Current_Index := End_Index + 1; |
38cbfe40 RK |
662 | raise Invalid_Parameter; |
663 | end if; | |
664 | ||
da2ac8c2 | 665 | -- If the switch is of the form <switch> xxx |
07fc65c4 | 666 | |
da2ac8c2 EB |
667 | elsif Parser.Current_Argument < Parser.Arg_Count |
668 | and then Parser.Section (Parser.Current_Argument + 1) /= 0 | |
669 | then | |
670 | Parser.Current_Argument := Parser.Current_Argument + 1; | |
671 | Parser.The_Separator := ' '; | |
672 | Set_Parameter | |
673 | (Parser.The_Parameter, | |
674 | Arg_Num => Parser.Current_Argument, | |
675 | First => Argument (Parser, Parser.Current_Argument)'First, | |
676 | Last => Argument (Parser, Parser.Current_Argument)'Last); | |
677 | Parser.Is_Switch (Parser.Current_Argument) := True; | |
678 | Dummy := Goto_Next_Argument_In_Section (Parser); | |
679 | ||
680 | else | |
681 | Parser.Current_Index := End_Index + 1; | |
682 | raise Invalid_Parameter; | |
683 | end if; | |
07fc65c4 | 684 | |
da2ac8c2 | 685 | when Parameter_No_Space => |
07fc65c4 | 686 | |
da2ac8c2 EB |
687 | if End_Index < Arg'Last then |
688 | Set_Parameter | |
689 | (Parser.The_Parameter, | |
690 | Arg_Num => Parser.Current_Argument, | |
691 | First => End_Index + 1, | |
692 | Last => Arg'Last); | |
693 | Dummy := Goto_Next_Argument_In_Section (Parser); | |
07fc65c4 | 694 | |
da2ac8c2 EB |
695 | else |
696 | Parser.Current_Index := End_Index + 1; | |
697 | raise Invalid_Parameter; | |
698 | end if; | |
38cbfe40 | 699 | |
da2ac8c2 | 700 | when Parameter_Optional => |
38cbfe40 | 701 | |
da2ac8c2 EB |
702 | if End_Index < Arg'Last then |
703 | Set_Parameter | |
704 | (Parser.The_Parameter, | |
705 | Arg_Num => Parser.Current_Argument, | |
706 | First => End_Index + 1, | |
707 | Last => Arg'Last); | |
708 | end if; | |
38cbfe40 | 709 | |
da2ac8c2 | 710 | Dummy := Goto_Next_Argument_In_Section (Parser); |
38cbfe40 | 711 | |
da2ac8c2 | 712 | when Parameter_None => |
38cbfe40 | 713 | |
da2ac8c2 EB |
714 | if Concatenate or else End_Index = Arg'Last then |
715 | Parser.Current_Index := End_Index + 1; | |
38cbfe40 | 716 | |
da2ac8c2 EB |
717 | else |
718 | -- If Concatenate is False and the full argument is not | |
719 | -- recognized as a switch, this is an invalid switch. | |
38cbfe40 | 720 | |
da2ac8c2 EB |
721 | if Switches (Switches'First) = '*' then |
722 | Set_Parameter | |
723 | (Parser.The_Switch, | |
724 | Arg_Num => Parser.Current_Argument, | |
725 | First => Arg'First, | |
726 | Last => Arg'Last); | |
727 | Parser.Is_Switch (Parser.Current_Argument) := True; | |
728 | Dummy := Goto_Next_Argument_In_Section (Parser); | |
729 | return '*'; | |
fbf5a39b | 730 | end if; |
fbf5a39b | 731 | |
da2ac8c2 EB |
732 | Set_Parameter |
733 | (Parser.The_Switch, | |
734 | Arg_Num => Parser.Current_Argument, | |
735 | First => Parser.Current_Index, | |
736 | Last => Arg'Last); | |
737 | Parser.Current_Index := Arg'Last + 1; | |
738 | raise Invalid_Switch; | |
739 | end if; | |
740 | end case; | |
38cbfe40 RK |
741 | |
742 | return Switches (Index_Switches); | |
743 | end; | |
744 | end Getopt; | |
745 | ||
746 | ----------------------------------- | |
747 | -- Goto_Next_Argument_In_Section -- | |
748 | ----------------------------------- | |
749 | ||
da2ac8c2 EB |
750 | function Goto_Next_Argument_In_Section |
751 | (Parser : Opt_Parser) return Boolean | |
752 | is | |
38cbfe40 | 753 | begin |
da2ac8c2 | 754 | Parser.Current_Argument := Parser.Current_Argument + 1; |
38cbfe40 | 755 | |
da2ac8c2 EB |
756 | if Parser.Current_Argument > Parser.Arg_Count |
757 | or else Parser.Section (Parser.Current_Argument) = 0 | |
758 | then | |
38cbfe40 | 759 | loop |
da2ac8c2 EB |
760 | Parser.Current_Argument := Parser.Current_Argument + 1; |
761 | ||
762 | if Parser.Current_Argument > Parser.Arg_Count then | |
763 | Parser.Current_Index := 1; | |
38cbfe40 RK |
764 | return False; |
765 | end if; | |
07fc65c4 | 766 | |
da2ac8c2 EB |
767 | exit when Parser.Section (Parser.Current_Argument) = |
768 | Parser.Current_Section; | |
38cbfe40 RK |
769 | end loop; |
770 | end if; | |
da2ac8c2 EB |
771 | |
772 | Parser.Current_Index := | |
773 | Argument (Parser, Parser.Current_Argument)'First; | |
774 | ||
38cbfe40 RK |
775 | return True; |
776 | end Goto_Next_Argument_In_Section; | |
777 | ||
778 | ------------------ | |
779 | -- Goto_Section -- | |
780 | ------------------ | |
781 | ||
da2ac8c2 EB |
782 | procedure Goto_Section |
783 | (Name : String := ""; | |
784 | Parser : Opt_Parser := Command_Line_Parser) | |
785 | is | |
786 | Index : Integer; | |
38cbfe40 RK |
787 | |
788 | begin | |
da2ac8c2 | 789 | Parser.In_Expansion := False; |
38cbfe40 RK |
790 | |
791 | if Name = "" then | |
da2ac8c2 EB |
792 | Parser.Current_Argument := 1; |
793 | Parser.Current_Index := 1; | |
794 | Parser.Current_Section := 1; | |
38cbfe40 RK |
795 | return; |
796 | end if; | |
797 | ||
da2ac8c2 EB |
798 | Index := 1; |
799 | while Index <= Parser.Arg_Count loop | |
800 | if Parser.Section (Index) = 0 | |
801 | and then Argument (Parser, Index) = Parser.Switch_Character & Name | |
38cbfe40 | 802 | then |
da2ac8c2 EB |
803 | Parser.Current_Argument := Index + 1; |
804 | Parser.Current_Index := 1; | |
07fc65c4 | 805 | |
da2ac8c2 EB |
806 | if Parser.Current_Argument <= Parser.Arg_Count then |
807 | Parser.Current_Section := | |
808 | Parser.Section (Parser.Current_Argument); | |
38cbfe40 RK |
809 | end if; |
810 | return; | |
811 | end if; | |
812 | ||
813 | Index := Index + 1; | |
814 | end loop; | |
07fc65c4 | 815 | |
da2ac8c2 EB |
816 | Parser.Current_Argument := Positive'Last; |
817 | Parser.Current_Index := 2; -- so that Get_Argument returns nothing | |
38cbfe40 RK |
818 | end Goto_Section; |
819 | ||
820 | ---------------------------- | |
821 | -- Initialize_Option_Scan -- | |
822 | ---------------------------- | |
823 | ||
824 | procedure Initialize_Option_Scan | |
825 | (Switch_Char : Character := '-'; | |
da2ac8c2 EB |
826 | Stop_At_First_Non_Switch : Boolean := False; |
827 | Section_Delimiters : String := "") | |
828 | is | |
829 | begin | |
830 | Internal_Initialize_Option_Scan | |
831 | (Parser => Command_Line_Parser, | |
832 | Switch_Char => Switch_Char, | |
833 | Stop_At_First_Non_Switch => Stop_At_First_Non_Switch, | |
834 | Section_Delimiters => Section_Delimiters); | |
835 | end Initialize_Option_Scan; | |
836 | ||
837 | ---------------------------- | |
838 | -- Initialize_Option_Scan -- | |
839 | ---------------------------- | |
840 | ||
841 | procedure Initialize_Option_Scan | |
842 | (Parser : out Opt_Parser; | |
843 | Command_Line : GNAT.OS_Lib.Argument_List_Access; | |
844 | Switch_Char : Character := '-'; | |
38cbfe40 RK |
845 | Stop_At_First_Non_Switch : Boolean := False; |
846 | Section_Delimiters : String := "") | |
847 | is | |
da2ac8c2 EB |
848 | begin |
849 | Free (Parser); | |
850 | ||
851 | if Command_Line = null then | |
852 | Parser := new Opt_Parser_Data (CL.Argument_Count); | |
853 | Initialize_Option_Scan | |
854 | (Switch_Char => Switch_Char, | |
855 | Stop_At_First_Non_Switch => Stop_At_First_Non_Switch, | |
856 | Section_Delimiters => Section_Delimiters); | |
857 | else | |
858 | Parser := new Opt_Parser_Data (Command_Line'Length); | |
859 | Parser.Arguments := Command_Line; | |
860 | Internal_Initialize_Option_Scan | |
861 | (Parser => Parser, | |
862 | Switch_Char => Switch_Char, | |
863 | Stop_At_First_Non_Switch => Stop_At_First_Non_Switch, | |
864 | Section_Delimiters => Section_Delimiters); | |
865 | end if; | |
866 | end Initialize_Option_Scan; | |
867 | ||
868 | ------------------------------------- | |
869 | -- Internal_Initialize_Option_Scan -- | |
870 | ------------------------------------- | |
871 | ||
872 | procedure Internal_Initialize_Option_Scan | |
873 | (Parser : Opt_Parser; | |
874 | Switch_Char : Character; | |
875 | Stop_At_First_Non_Switch : Boolean; | |
876 | Section_Delimiters : String) | |
877 | is | |
878 | Section_Num : Section_Number; | |
879 | Section_Index : Integer; | |
38cbfe40 RK |
880 | Last : Integer; |
881 | Delimiter_Found : Boolean; | |
882 | ||
3f1ede06 RD |
883 | Discard : Boolean; |
884 | pragma Warnings (Off, Discard); | |
885 | ||
38cbfe40 | 886 | begin |
da2ac8c2 EB |
887 | Parser.Current_Argument := 0; |
888 | Parser.Current_Index := 0; | |
889 | Parser.In_Expansion := False; | |
890 | Parser.Switch_Character := Switch_Char; | |
891 | Parser.Stop_At_First := Stop_At_First_Non_Switch; | |
38cbfe40 RK |
892 | |
893 | -- If we are using sections, we have to preprocess the command line | |
894 | -- to delimit them. A section can be repeated, so we just give each | |
895 | -- item on the command line a section number | |
896 | ||
da2ac8c2 EB |
897 | Section_Num := 1; |
898 | Section_Index := Section_Delimiters'First; | |
38cbfe40 | 899 | while Section_Index <= Section_Delimiters'Last loop |
38cbfe40 RK |
900 | Last := Section_Index; |
901 | while Last <= Section_Delimiters'Last | |
902 | and then Section_Delimiters (Last) /= ' ' | |
903 | loop | |
904 | Last := Last + 1; | |
905 | end loop; | |
906 | ||
907 | Delimiter_Found := False; | |
908 | Section_Num := Section_Num + 1; | |
909 | ||
da2ac8c2 EB |
910 | for Index in 1 .. Parser.Arg_Count loop |
911 | if Argument (Parser, Index)(1) = Parser.Switch_Character | |
07fc65c4 | 912 | and then |
da2ac8c2 | 913 | Argument (Parser, Index) = Parser.Switch_Character & |
07fc65c4 GB |
914 | Section_Delimiters |
915 | (Section_Index .. Last - 1) | |
38cbfe40 | 916 | then |
da2ac8c2 | 917 | Parser.Section (Index) := 0; |
38cbfe40 RK |
918 | Delimiter_Found := True; |
919 | ||
da2ac8c2 | 920 | elsif Parser.Section (Index) = 0 then |
38cbfe40 RK |
921 | Delimiter_Found := False; |
922 | ||
923 | elsif Delimiter_Found then | |
da2ac8c2 | 924 | Parser.Section (Index) := Section_Num; |
38cbfe40 RK |
925 | end if; |
926 | end loop; | |
927 | ||
928 | Section_Index := Last + 1; | |
929 | while Section_Index <= Section_Delimiters'Last | |
930 | and then Section_Delimiters (Section_Index) = ' ' | |
931 | loop | |
932 | Section_Index := Section_Index + 1; | |
933 | end loop; | |
934 | end loop; | |
935 | ||
da2ac8c2 EB |
936 | Discard := Goto_Next_Argument_In_Section (Parser); |
937 | end Internal_Initialize_Option_Scan; | |
38cbfe40 RK |
938 | |
939 | --------------- | |
940 | -- Parameter -- | |
941 | --------------- | |
942 | ||
da2ac8c2 EB |
943 | function Parameter |
944 | (Parser : Opt_Parser := Command_Line_Parser) return String | |
945 | is | |
38cbfe40 | 946 | begin |
da2ac8c2 | 947 | if Parser.The_Parameter.First > Parser.The_Parameter.Last then |
38cbfe40 RK |
948 | return String'(1 .. 0 => ' '); |
949 | else | |
da2ac8c2 EB |
950 | return Argument (Parser, Parser.The_Parameter.Arg_Num) |
951 | (Parser.The_Parameter.First .. Parser.The_Parameter.Last); | |
38cbfe40 RK |
952 | end if; |
953 | end Parameter; | |
954 | ||
da2ac8c2 EB |
955 | --------------- |
956 | -- Separator -- | |
957 | --------------- | |
958 | ||
959 | function Separator | |
960 | (Parser : Opt_Parser := Command_Line_Parser) return Character | |
961 | is | |
962 | begin | |
963 | return Parser.The_Separator; | |
964 | end Separator; | |
965 | ||
38cbfe40 RK |
966 | ------------------- |
967 | -- Set_Parameter -- | |
968 | ------------------- | |
969 | ||
970 | procedure Set_Parameter | |
971 | (Variable : out Parameter_Type; | |
972 | Arg_Num : Positive; | |
973 | First : Positive; | |
da2ac8c2 EB |
974 | Last : Positive; |
975 | Extra : Character := ASCII.NUL) | |
07fc65c4 | 976 | is |
38cbfe40 RK |
977 | begin |
978 | Variable.Arg_Num := Arg_Num; | |
979 | Variable.First := First; | |
980 | Variable.Last := Last; | |
da2ac8c2 | 981 | Variable.Extra := Extra; |
38cbfe40 RK |
982 | end Set_Parameter; |
983 | ||
984 | --------------------- | |
985 | -- Start_Expansion -- | |
986 | --------------------- | |
987 | ||
988 | procedure Start_Expansion | |
989 | (Iterator : out Expansion_Iterator; | |
990 | Pattern : String; | |
991 | Directory : String := ""; | |
992 | Basic_Regexp : Boolean := True) | |
993 | is | |
994 | Directory_Separator : Character; | |
995 | pragma Import (C, Directory_Separator, "__gnat_dir_separator"); | |
07fc65c4 | 996 | |
fbe627af RD |
997 | First : Positive := Pattern'First; |
998 | Pat : String := Pattern; | |
38cbfe40 RK |
999 | |
1000 | begin | |
07fc65c4 GB |
1001 | Canonical_Case_File_Name (Pat); |
1002 | Iterator.Current_Depth := 1; | |
1003 | ||
1004 | -- If Directory is unspecified, use the current directory ("./" or ".\") | |
1005 | ||
38cbfe40 | 1006 | if Directory = "" then |
07fc65c4 GB |
1007 | Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator; |
1008 | Iterator.Start := 3; | |
1009 | ||
38cbfe40 | 1010 | else |
07fc65c4 GB |
1011 | Iterator.Dir_Name (1 .. Directory'Length) := Directory; |
1012 | Iterator.Start := Directory'Length + 1; | |
1013 | Canonical_Case_File_Name (Iterator.Dir_Name (1 .. Directory'Length)); | |
1014 | ||
1015 | -- Make sure that the last character is a directory separator | |
1016 | ||
1017 | if Directory (Directory'Last) /= Directory_Separator then | |
1018 | Iterator.Dir_Name (Iterator.Start) := Directory_Separator; | |
1019 | Iterator.Start := Iterator.Start + 1; | |
1020 | end if; | |
1021 | end if; | |
1022 | ||
1023 | Iterator.Levels (1).Name_Last := Iterator.Start - 1; | |
1024 | ||
1025 | -- Open the initial Directory, at depth 1 | |
1026 | ||
1027 | GNAT.Directory_Operations.Open | |
1028 | (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1)); | |
1029 | ||
bcea76b6 GB |
1030 | -- If in the current directory and the pattern starts with "./" or ".\", |
1031 | -- drop the "./" or ".\" from the pattern. | |
07fc65c4 GB |
1032 | |
1033 | if Directory = "" and then Pat'Length > 2 | |
bcea76b6 GB |
1034 | and then Pat (Pat'First) = '.' |
1035 | and then Pat (Pat'First + 1) = Directory_Separator | |
07fc65c4 GB |
1036 | then |
1037 | First := Pat'First + 2; | |
38cbfe40 RK |
1038 | end if; |
1039 | ||
07fc65c4 GB |
1040 | Iterator.Regexp := |
1041 | GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True); | |
1042 | ||
1043 | Iterator.Maximum_Depth := 1; | |
1044 | ||
1045 | -- Maximum_Depth is equal to 1 plus the number of directory separators | |
1046 | -- in the pattern. | |
1047 | ||
1048 | for Index in First .. Pat'Last loop | |
1049 | if Pat (Index) = Directory_Separator then | |
1050 | Iterator.Maximum_Depth := Iterator.Maximum_Depth + 1; | |
1051 | exit when Iterator.Maximum_Depth = Max_Depth; | |
1052 | end if; | |
1053 | end loop; | |
38cbfe40 RK |
1054 | end Start_Expansion; |
1055 | ||
da2ac8c2 EB |
1056 | ---------- |
1057 | -- Free -- | |
1058 | ---------- | |
1059 | ||
1060 | procedure Free (Parser : in out Opt_Parser) is | |
1061 | procedure Unchecked_Free is new Ada.Unchecked_Deallocation | |
1062 | (Opt_Parser_Data, Opt_Parser); | |
1063 | begin | |
1064 | if Parser /= null | |
1065 | and then Parser /= Command_Line_Parser | |
1066 | then | |
1067 | Free (Parser.Arguments); | |
1068 | Unchecked_Free (Parser); | |
1069 | end if; | |
1070 | end Free; | |
1071 | ||
da2ac8c2 EB |
1072 | ------------------ |
1073 | -- Define_Alias -- | |
1074 | ------------------ | |
1075 | ||
1076 | procedure Define_Alias | |
1077 | (Config : in out Command_Line_Configuration; | |
1078 | Switch : String; | |
1079 | Expanded : String) | |
1080 | is | |
1081 | begin | |
1082 | if Config = null then | |
1083 | Config := new Command_Line_Configuration_Record; | |
1084 | end if; | |
1085 | ||
cf5028e3 RD |
1086 | Add (Config.Aliases, new String'(Switch)); |
1087 | Add (Config.Expansions, new String'(Expanded)); | |
da2ac8c2 EB |
1088 | end Define_Alias; |
1089 | ||
1090 | ------------------- | |
1091 | -- Define_Prefix -- | |
1092 | ------------------- | |
1093 | ||
1094 | procedure Define_Prefix | |
1095 | (Config : in out Command_Line_Configuration; | |
1096 | Prefix : String) | |
1097 | is | |
1098 | begin | |
1099 | if Config = null then | |
1100 | Config := new Command_Line_Configuration_Record; | |
1101 | end if; | |
1102 | ||
cf5028e3 | 1103 | Add (Config.Prefixes, new String'(Prefix)); |
da2ac8c2 EB |
1104 | end Define_Prefix; |
1105 | ||
f9325b03 AC |
1106 | ------------------- |
1107 | -- Define_Switch -- | |
1108 | ------------------- | |
1109 | ||
1110 | procedure Define_Switch | |
1111 | (Config : in out Command_Line_Configuration; | |
1112 | Switch : String) | |
1113 | is | |
1114 | begin | |
1115 | if Config = null then | |
1116 | Config := new Command_Line_Configuration_Record; | |
1117 | end if; | |
1118 | ||
cf5028e3 | 1119 | Add (Config.Switches, new String'(Switch)); |
f9325b03 AC |
1120 | end Define_Switch; |
1121 | ||
c1db334e JL |
1122 | -------------------- |
1123 | -- Define_Section -- | |
1124 | -------------------- | |
1125 | ||
1126 | procedure Define_Section | |
1127 | (Config : in out Command_Line_Configuration; | |
1128 | Section : String) | |
1129 | is | |
1130 | begin | |
1131 | if Config = null then | |
1132 | Config := new Command_Line_Configuration_Record; | |
1133 | end if; | |
1134 | ||
cf5028e3 | 1135 | Add (Config.Sections, new String'(Section)); |
c1db334e JL |
1136 | end Define_Section; |
1137 | ||
f9325b03 AC |
1138 | ------------------ |
1139 | -- Get_Switches -- | |
1140 | ------------------ | |
1141 | ||
1142 | function Get_Switches | |
1143 | (Config : Command_Line_Configuration; | |
1144 | Switch_Char : Character) | |
1145 | return String | |
1146 | is | |
1147 | Ret : Ada.Strings.Unbounded.Unbounded_String; | |
1148 | use type Ada.Strings.Unbounded.Unbounded_String; | |
1bae4562 | 1149 | |
f9325b03 AC |
1150 | begin |
1151 | if Config = null or else Config.Switches = null then | |
1152 | return ""; | |
1153 | end if; | |
1154 | ||
1155 | for J in Config.Switches'Range loop | |
1156 | if Config.Switches (J) (Config.Switches (J)'First) = Switch_Char then | |
1bae4562 RD |
1157 | Ret := |
1158 | Ret & " " & | |
1159 | Config.Switches (J) | |
1160 | (Config.Switches (J)'First + 1 .. Config.Switches (J)'Last); | |
f9325b03 AC |
1161 | else |
1162 | Ret := Ret & " " & Config.Switches (J).all; | |
1163 | end if; | |
1164 | end loop; | |
1165 | ||
1166 | return Ada.Strings.Unbounded.To_String (Ret); | |
1167 | end Get_Switches; | |
1168 | ||
da2ac8c2 EB |
1169 | ----------------------- |
1170 | -- Set_Configuration -- | |
1171 | ----------------------- | |
1172 | ||
1173 | procedure Set_Configuration | |
77e51042 EB |
1174 | (Cmd : in out Command_Line; |
1175 | Config : Command_Line_Configuration) | |
da2ac8c2 EB |
1176 | is |
1177 | begin | |
1178 | Cmd.Config := Config; | |
1179 | end Set_Configuration; | |
1180 | ||
77e51042 EB |
1181 | ----------------------- |
1182 | -- Get_Configuration -- | |
1183 | ----------------------- | |
1184 | ||
1185 | function Get_Configuration | |
1186 | (Cmd : Command_Line) return Command_Line_Configuration is | |
1187 | begin | |
1188 | return Cmd.Config; | |
1189 | end Get_Configuration; | |
1190 | ||
da2ac8c2 EB |
1191 | ---------------------- |
1192 | -- Set_Command_Line -- | |
1193 | ---------------------- | |
1194 | ||
1195 | procedure Set_Command_Line | |
1196 | (Cmd : in out Command_Line; | |
1197 | Switches : String; | |
1198 | Getopt_Description : String := ""; | |
1199 | Switch_Char : Character := '-') | |
1200 | is | |
c1db334e JL |
1201 | Tmp : Argument_List_Access; |
1202 | Parser : Opt_Parser; | |
1203 | S : Character; | |
1204 | Section : String_Access := null; | |
1205 | ||
1206 | function Real_Full_Switch | |
1207 | (S : Character; | |
1208 | Parser : Opt_Parser) return String; | |
1209 | -- Ensure that the returned switch value contains the | |
1210 | -- Switch_Char prefix if needed. | |
1211 | ||
1212 | ---------------------- | |
1213 | -- Real_Full_Switch -- | |
1214 | ---------------------- | |
1215 | ||
1216 | function Real_Full_Switch | |
1217 | (S : Character; | |
1218 | Parser : Opt_Parser) return String | |
1219 | is | |
1220 | begin | |
1221 | if S = '*' then | |
1222 | return Full_Switch (Parser); | |
1223 | else | |
1224 | return Switch_Char & Full_Switch (Parser); | |
1225 | end if; | |
1226 | end Real_Full_Switch; | |
1227 | ||
1228 | -- Start of processing for Set_Command_Line | |
da2ac8c2 EB |
1229 | |
1230 | begin | |
1231 | Free (Cmd.Expanded); | |
1232 | Free (Cmd.Params); | |
1233 | ||
1234 | if Switches /= "" then | |
1235 | Tmp := Argument_String_To_List (Switches); | |
1236 | Initialize_Option_Scan (Parser, Tmp, Switch_Char); | |
1237 | ||
1238 | loop | |
1239 | begin | |
1240 | S := Getopt (Switches => "* " & Getopt_Description, | |
1241 | Concatenate => False, | |
1242 | Parser => Parser); | |
1243 | exit when S = ASCII.NUL; | |
1244 | ||
c1db334e JL |
1245 | declare |
1246 | Sw : constant String := | |
1247 | Real_Full_Switch (S, Parser); | |
1248 | Is_Section : Boolean := False; | |
1249 | ||
1250 | begin | |
1251 | if Cmd.Config /= null | |
1252 | and then Cmd.Config.Sections /= null | |
1253 | then | |
1254 | Section_Search : | |
1255 | for S in Cmd.Config.Sections'Range loop | |
1256 | if Sw = Cmd.Config.Sections (S).all then | |
1257 | Section := Cmd.Config.Sections (S); | |
1258 | Is_Section := True; | |
1259 | ||
1260 | exit Section_Search; | |
1261 | end if; | |
1262 | end loop Section_Search; | |
1263 | end if; | |
1264 | ||
1265 | if not Is_Section then | |
1266 | if Section = null then | |
1bae4562 | 1267 | |
5b3a33c3 | 1268 | -- Work around some weird cases: some switches may |
f9325b03 AC |
1269 | -- expect parameters, but have the same value as |
1270 | -- longer switches: -gnaty3 (-gnaty, parameter=3) and | |
1271 | -- -gnatya (-gnatya, no parameter). | |
1bae4562 | 1272 | |
f9325b03 AC |
1273 | -- So we are calling add_switch here with parameter |
1274 | -- attached. This will be anyway correctly handled by | |
5b3a33c3 | 1275 | -- Add_Switch if -gnaty3 is actually provided. |
1bae4562 | 1276 | |
f9325b03 AC |
1277 | if Separator (Parser) = ASCII.NUL then |
1278 | Add_Switch | |
1279 | (Cmd, Sw & Parameter (Parser), ""); | |
1280 | else | |
1281 | Add_Switch | |
1282 | (Cmd, Sw, Parameter (Parser), Separator (Parser)); | |
1283 | end if; | |
c1db334e | 1284 | else |
f9325b03 AC |
1285 | if Separator (Parser) = ASCII.NUL then |
1286 | Add_Switch | |
1287 | (Cmd, Sw & Parameter (Parser), "", | |
1288 | Separator (Parser), | |
1289 | Section.all); | |
1290 | else | |
1291 | Add_Switch | |
1292 | (Cmd, Sw, | |
1293 | Parameter (Parser), | |
1294 | Separator (Parser), | |
1295 | Section.all); | |
1296 | end if; | |
c1db334e JL |
1297 | end if; |
1298 | end if; | |
1299 | end; | |
da2ac8c2 EB |
1300 | |
1301 | exception | |
1302 | when Invalid_Parameter => | |
c1db334e | 1303 | |
da2ac8c2 | 1304 | -- Add it with no parameter, if that's the way the user |
c1db334e | 1305 | -- wants it. |
1bae4562 | 1306 | |
32b99014 JL |
1307 | -- Specify the separator in all cases, as the switch might |
1308 | -- need to be unaliased, and the alias might contain | |
1309 | -- switches with parameters. | |
c1db334e JL |
1310 | |
1311 | if Section = null then | |
1312 | Add_Switch | |
32b99014 JL |
1313 | (Cmd, Switch_Char & Full_Switch (Parser), |
1314 | Separator => Separator (Parser)); | |
c1db334e JL |
1315 | else |
1316 | Add_Switch | |
32b99014 JL |
1317 | (Cmd, Switch_Char & Full_Switch (Parser), |
1318 | Separator => Separator (Parser), | |
1319 | Section => Section.all); | |
c1db334e | 1320 | end if; |
da2ac8c2 EB |
1321 | end; |
1322 | end loop; | |
1323 | ||
1324 | Free (Parser); | |
1325 | end if; | |
1326 | end Set_Command_Line; | |
1327 | ||
1328 | ---------------- | |
1329 | -- Looking_At -- | |
1330 | ---------------- | |
1331 | ||
1332 | function Looking_At | |
1333 | (Type_Str : String; | |
1334 | Index : Natural; | |
1335 | Substring : String) return Boolean is | |
1336 | begin | |
1337 | return Index + Substring'Length - 1 <= Type_Str'Last | |
1338 | and then Type_Str (Index .. Index + Substring'Length - 1) = Substring; | |
1339 | end Looking_At; | |
1340 | ||
f9325b03 AC |
1341 | ------------------------ |
1342 | -- Can_Have_Parameter -- | |
1343 | ------------------------ | |
1344 | ||
1345 | function Can_Have_Parameter (S : String) return Boolean is | |
1346 | begin | |
1347 | if S'Length <= 1 then | |
1348 | return False; | |
1349 | end if; | |
1350 | ||
1351 | case S (S'Last) is | |
1352 | when '!' | ':' | '?' | '=' => | |
1353 | return True; | |
1354 | when others => | |
1355 | return False; | |
1356 | end case; | |
1357 | end Can_Have_Parameter; | |
1358 | ||
1359 | ----------------------- | |
1360 | -- Require_Parameter -- | |
1361 | ----------------------- | |
1362 | ||
1363 | function Require_Parameter (S : String) return Boolean is | |
1364 | begin | |
1365 | if S'Length <= 1 then | |
1366 | return False; | |
1367 | end if; | |
1368 | ||
1369 | case S (S'Last) is | |
1370 | when '!' | ':' | '=' => | |
1371 | return True; | |
1372 | when others => | |
1373 | return False; | |
1374 | end case; | |
1375 | end Require_Parameter; | |
1376 | ||
1377 | ------------------- | |
1378 | -- Actual_Switch -- | |
1379 | ------------------- | |
1380 | ||
1381 | function Actual_Switch (S : String) return String is | |
1382 | begin | |
1383 | if S'Length <= 1 then | |
1384 | return S; | |
1385 | end if; | |
1386 | ||
1387 | case S (S'Last) is | |
1388 | when '!' | ':' | '?' | '=' => | |
1389 | return S (S'First .. S'Last - 1); | |
1390 | when others => | |
1391 | return S; | |
1392 | end case; | |
1393 | end Actual_Switch; | |
1394 | ||
da2ac8c2 EB |
1395 | ---------------------------- |
1396 | -- For_Each_Simple_Switch -- | |
1397 | ---------------------------- | |
1398 | ||
1399 | procedure For_Each_Simple_Switch | |
f9325b03 AC |
1400 | (Cmd : Command_Line; |
1401 | Switch : String; | |
1402 | Parameter : String := ""; | |
1403 | Unalias : Boolean := True) | |
da2ac8c2 | 1404 | is |
f9325b03 AC |
1405 | function Group_Analysis |
1406 | (Prefix : String; | |
1407 | Group : String) return Boolean; | |
3dd9959c | 1408 | -- Perform the analysis of a group of switches |
f9325b03 AC |
1409 | |
1410 | -------------------- | |
1411 | -- Group_Analysis -- | |
1412 | -------------------- | |
1413 | ||
1414 | function Group_Analysis | |
1415 | (Prefix : String; | |
1416 | Group : String) return Boolean | |
1417 | is | |
1bae4562 | 1418 | Idx : Natural; |
f9325b03 | 1419 | Found : Boolean; |
1bae4562 | 1420 | |
f9325b03 | 1421 | begin |
1bae4562 | 1422 | Idx := Group'First; |
f9325b03 AC |
1423 | while Idx <= Group'Last loop |
1424 | Found := False; | |
1425 | ||
1426 | for S in Cmd.Config.Switches'Range loop | |
1427 | declare | |
1428 | Sw : constant String := | |
1429 | Actual_Switch | |
1430 | (Cmd.Config.Switches (S).all); | |
1431 | Full : constant String := | |
1432 | Prefix & Group (Idx .. Group'Last); | |
1433 | Last : Natural; | |
1434 | Param : Natural; | |
1435 | ||
1436 | begin | |
1437 | if Sw'Length >= Prefix'Length | |
1bae4562 RD |
1438 | |
1439 | -- Verify that sw starts with Prefix | |
1440 | ||
1441 | and then Looking_At (Sw, Sw'First, Prefix) | |
1442 | ||
1443 | -- Verify that the group starts with sw | |
1444 | ||
1445 | and then Looking_At (Full, Full'First, Sw) | |
f9325b03 AC |
1446 | then |
1447 | Last := Idx + Sw'Length - Prefix'Length - 1; | |
1448 | Param := Last + 1; | |
1449 | ||
1450 | if Can_Have_Parameter (Cmd.Config.Switches (S).all) then | |
1bae4562 | 1451 | |
f9325b03 AC |
1452 | -- Include potential parameter to the recursive call. |
1453 | -- Only numbers are allowed. | |
1bae4562 | 1454 | |
f9325b03 AC |
1455 | while Last < Group'Last |
1456 | and then Group (Last + 1) in '0' .. '9' | |
1457 | loop | |
1458 | Last := Last + 1; | |
1459 | end loop; | |
1460 | end if; | |
1461 | ||
1462 | if not Require_Parameter (Cmd.Config.Switches (S).all) | |
1463 | or else Last >= Param | |
1464 | then | |
32b99014 JL |
1465 | if Idx = Group'First |
1466 | and then Last = Group'Last | |
1467 | and then Last < Param | |
1468 | then | |
f9325b03 AC |
1469 | -- The group only concerns a single switch. Do not |
1470 | -- perform recursive call. | |
32b99014 JL |
1471 | |
1472 | -- Note that we still perform a recursive call if | |
1473 | -- a parameter is detected in the switch, as this | |
1474 | -- is a way to correctly identify such a parameter | |
1475 | -- in aliases. | |
1bae4562 | 1476 | |
f9325b03 AC |
1477 | return False; |
1478 | end if; | |
1479 | ||
1480 | Found := True; | |
1481 | ||
1482 | -- Recursive call, using the detected parameter if any | |
1bae4562 | 1483 | |
f9325b03 AC |
1484 | if Last >= Param then |
1485 | For_Each_Simple_Switch | |
1486 | (Cmd, | |
1487 | Prefix & Group (Idx .. Param - 1), | |
1488 | Group (Param .. Last)); | |
1489 | else | |
1490 | For_Each_Simple_Switch | |
1491 | (Cmd, Prefix & Group (Idx .. Last), ""); | |
1492 | end if; | |
1493 | ||
1494 | Idx := Last + 1; | |
1495 | exit; | |
1496 | end if; | |
1497 | end if; | |
1498 | end; | |
1499 | end loop; | |
1500 | ||
1501 | if not Found then | |
1502 | For_Each_Simple_Switch (Cmd, Prefix & Group (Idx), ""); | |
1503 | Idx := Idx + 1; | |
1504 | end if; | |
1505 | end loop; | |
1506 | ||
1507 | return True; | |
1508 | end Group_Analysis; | |
1509 | ||
da2ac8c2 EB |
1510 | begin |
1511 | -- Are we adding a switch that can in fact be expanded through aliases ? | |
1512 | -- If yes, we add separately each of its expansion. | |
1513 | ||
1514 | -- This takes care of expansions like "-T" -> "-gnatwrs", where the | |
1515 | -- alias and its expansion do not have the same prefix. Given the order | |
1516 | -- in which we do things here, the expansion of the alias will itself | |
1517 | -- be checked for a common prefix and further split into simple switches | |
1518 | ||
f9325b03 AC |
1519 | if Unalias |
1520 | and then Cmd.Config /= null | |
da2ac8c2 EB |
1521 | and then Cmd.Config.Aliases /= null |
1522 | then | |
1523 | for A in Cmd.Config.Aliases'Range loop | |
f9325b03 AC |
1524 | if Cmd.Config.Aliases (A).all = Switch |
1525 | and then Parameter = "" | |
1526 | then | |
da2ac8c2 | 1527 | For_Each_Simple_Switch |
f9325b03 | 1528 | (Cmd, Cmd.Config.Expansions (A).all, ""); |
da2ac8c2 EB |
1529 | return; |
1530 | end if; | |
1531 | end loop; | |
1532 | end if; | |
1533 | ||
1534 | -- Are we adding a switch grouping several switches ? If yes, add each | |
1535 | -- of the simple switches instead. | |
1536 | ||
1537 | if Cmd.Config /= null | |
1538 | and then Cmd.Config.Prefixes /= null | |
1539 | then | |
1540 | for P in Cmd.Config.Prefixes'Range loop | |
1541 | if Switch'Length > Cmd.Config.Prefixes (P)'Length + 1 | |
1542 | and then Looking_At | |
1543 | (Switch, Switch'First, Cmd.Config.Prefixes (P).all) | |
1544 | then | |
1545 | -- Alias expansion will be done recursively | |
f9325b03 AC |
1546 | if Cmd.Config.Switches = null then |
1547 | for S in Switch'First + Cmd.Config.Prefixes (P)'Length | |
1548 | .. Switch'Last | |
1549 | loop | |
1550 | For_Each_Simple_Switch | |
1551 | (Cmd, Cmd.Config.Prefixes (P).all & Switch (S), ""); | |
1552 | end loop; | |
da2ac8c2 | 1553 | |
f9325b03 AC |
1554 | return; |
1555 | ||
1556 | elsif Group_Analysis | |
1557 | (Cmd.Config.Prefixes (P).all, | |
1558 | Switch | |
1559 | (Switch'First + Cmd.Config.Prefixes (P)'Length | |
1560 | .. Switch'Last)) | |
1561 | then | |
1562 | -- Recursive calls already done on each switch of the | |
1563 | -- group. Let's return to not call Callback. | |
1564 | return; | |
1565 | end if; | |
da2ac8c2 EB |
1566 | end if; |
1567 | end loop; | |
1568 | end if; | |
1569 | ||
76871f97 RD |
1570 | -- Test if added switch is a known switch with parameter attached |
1571 | ||
7486d8e0 AC |
1572 | if Parameter = "" |
1573 | and then Cmd.Config /= null | |
1574 | and then Cmd.Config.Switches /= null | |
1575 | then | |
1576 | for S in Cmd.Config.Switches'Range loop | |
1577 | declare | |
1578 | Sw : constant String := | |
1579 | Actual_Switch (Cmd.Config.Switches (S).all); | |
1580 | Last : Natural; | |
1581 | Param : Natural; | |
1582 | ||
1583 | begin | |
76871f97 RD |
1584 | -- Verify that switch starts with Sw |
1585 | -- What if the "verification" fails??? | |
1586 | ||
7486d8e0 | 1587 | if Switch'Length >= Sw'Length |
7486d8e0 AC |
1588 | and then Looking_At (Switch, Switch'First, Sw) |
1589 | then | |
1590 | Param := Switch'First + Sw'Length - 1; | |
1591 | Last := Param; | |
1592 | ||
1593 | if Can_Have_Parameter (Cmd.Config.Switches (S).all) then | |
1594 | while Last < Switch'Last | |
1595 | and then Switch (Last + 1) in '0' .. '9' | |
1596 | loop | |
1597 | Last := Last + 1; | |
1598 | end loop; | |
1599 | end if; | |
1600 | ||
76871f97 RD |
1601 | -- If full Switch is a known switch with attached parameter |
1602 | -- then we use this parameter in the callback. | |
1603 | ||
7486d8e0 AC |
1604 | if Last = Switch'Last then |
1605 | Callback | |
1606 | (Switch (Switch'First .. Param), | |
1607 | Switch (Param + 1 .. Last)); | |
7486d8e0 AC |
1608 | return; |
1609 | ||
1610 | end if; | |
1611 | end if; | |
1612 | end; | |
1613 | end loop; | |
1614 | end if; | |
1615 | ||
f9325b03 | 1616 | Callback (Switch, Parameter); |
da2ac8c2 EB |
1617 | end For_Each_Simple_Switch; |
1618 | ||
1619 | ---------------- | |
1620 | -- Add_Switch -- | |
1621 | ---------------- | |
1622 | ||
1623 | procedure Add_Switch | |
cf5028e3 RD |
1624 | (Cmd : in out Command_Line; |
1625 | Switch : String; | |
1626 | Parameter : String := ""; | |
1627 | Separator : Character := ' '; | |
1628 | Section : String := ""; | |
1629 | Add_Before : Boolean := False) | |
da2ac8c2 | 1630 | is |
f9325b03 AC |
1631 | Success : Boolean; |
1632 | pragma Unreferenced (Success); | |
1633 | begin | |
cf5028e3 RD |
1634 | Add_Switch |
1635 | (Cmd, Switch, Parameter, Separator, Section, Add_Before, Success); | |
f9325b03 AC |
1636 | end Add_Switch; |
1637 | ||
1638 | ---------------- | |
1639 | -- Add_Switch -- | |
1640 | ---------------- | |
1641 | ||
1642 | procedure Add_Switch | |
cf5028e3 RD |
1643 | (Cmd : in out Command_Line; |
1644 | Switch : String; | |
1645 | Parameter : String := ""; | |
1646 | Separator : Character := ' '; | |
1647 | Section : String := ""; | |
1648 | Add_Before : Boolean := False; | |
1649 | Success : out Boolean) | |
f9325b03 AC |
1650 | is |
1651 | procedure Add_Simple_Switch (Simple : String; Param : String); | |
da2ac8c2 | 1652 | -- Add a new switch that has had all its aliases expanded, and switches |
76871f97 | 1653 | -- ungrouped. We know there are no more aliases in Switches. |
da2ac8c2 EB |
1654 | |
1655 | ----------------------- | |
1656 | -- Add_Simple_Switch -- | |
1657 | ----------------------- | |
1658 | ||
f9325b03 | 1659 | procedure Add_Simple_Switch (Simple : String; Param : String) is |
da2ac8c2 EB |
1660 | begin |
1661 | if Cmd.Expanded = null then | |
1662 | Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple)); | |
f9325b03 AC |
1663 | |
1664 | if Param /= "" then | |
da2ac8c2 | 1665 | Cmd.Params := new Argument_List' |
f9325b03 AC |
1666 | (1 .. 1 => new String'(Separator & Param)); |
1667 | ||
1668 | else | |
1669 | Cmd.Params := new Argument_List'(1 .. 1 => null); | |
da2ac8c2 | 1670 | end if; |
f9325b03 | 1671 | |
c1db334e JL |
1672 | if Section = "" then |
1673 | Cmd.Sections := new Argument_List'(1 .. 1 => null); | |
f9325b03 | 1674 | |
c1db334e JL |
1675 | else |
1676 | Cmd.Sections := new Argument_List' | |
1677 | (1 .. 1 => new String'(Section)); | |
1678 | end if; | |
f9325b03 | 1679 | |
da2ac8c2 | 1680 | else |
76871f97 | 1681 | -- Do we already have this switch? |
da2ac8c2 EB |
1682 | |
1683 | for C in Cmd.Expanded'Range loop | |
1684 | if Cmd.Expanded (C).all = Simple | |
1685 | and then | |
f9325b03 | 1686 | ((Cmd.Params (C) = null and then Param = "") |
cf5028e3 RD |
1687 | or else |
1688 | (Cmd.Params (C) /= null | |
1689 | and then Cmd.Params (C).all = Separator & Param)) | |
c1db334e JL |
1690 | and then |
1691 | ((Cmd.Sections (C) = null and then Section = "") | |
cf5028e3 RD |
1692 | or else |
1693 | (Cmd.Sections (C) /= null | |
1694 | and then Cmd.Sections (C).all = Section)) | |
da2ac8c2 EB |
1695 | then |
1696 | return; | |
1697 | end if; | |
1698 | end loop; | |
1699 | ||
f9325b03 | 1700 | -- Inserting at least one switch |
cf5028e3 | 1701 | |
f9325b03 | 1702 | Success := True; |
cf5028e3 | 1703 | Add (Cmd.Expanded, new String'(Simple), Add_Before); |
da2ac8c2 | 1704 | |
f9325b03 | 1705 | if Param /= "" then |
cf5028e3 RD |
1706 | Add |
1707 | (Cmd.Params, | |
1708 | new String'(Separator & Param), | |
1709 | Add_Before); | |
f9325b03 | 1710 | |
da2ac8c2 | 1711 | else |
cf5028e3 RD |
1712 | Add |
1713 | (Cmd.Params, | |
1714 | null, | |
1715 | Add_Before); | |
da2ac8c2 | 1716 | end if; |
c1db334e JL |
1717 | |
1718 | if Section = "" then | |
cf5028e3 RD |
1719 | Add |
1720 | (Cmd.Sections, | |
1721 | null, | |
1722 | Add_Before); | |
c1db334e | 1723 | else |
cf5028e3 RD |
1724 | Add |
1725 | (Cmd.Sections, | |
1726 | new String'(Section), | |
1727 | Add_Before); | |
c1db334e | 1728 | end if; |
da2ac8c2 EB |
1729 | end if; |
1730 | end Add_Simple_Switch; | |
1731 | ||
6a1cb33a BD |
1732 | procedure Add_Simple_Switches is |
1733 | new For_Each_Simple_Switch (Add_Simple_Switch); | |
1734 | ||
da2ac8c2 EB |
1735 | -- Start of processing for Add_Switch |
1736 | ||
1737 | begin | |
f9325b03 AC |
1738 | Success := False; |
1739 | Add_Simple_Switches (Cmd, Switch, Parameter); | |
da2ac8c2 EB |
1740 | Free (Cmd.Coalesce); |
1741 | end Add_Switch; | |
1742 | ||
1743 | ------------ | |
1744 | -- Remove -- | |
1745 | ------------ | |
1746 | ||
1747 | procedure Remove (Line : in out Argument_List_Access; Index : Integer) is | |
1748 | Tmp : Argument_List_Access := Line; | |
1749 | ||
1750 | begin | |
1751 | Line := new Argument_List (Tmp'First .. Tmp'Last - 1); | |
1752 | ||
1753 | if Index /= Tmp'First then | |
1754 | Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1); | |
1755 | end if; | |
1756 | ||
1757 | Free (Tmp (Index)); | |
1758 | ||
1759 | if Index /= Tmp'Last then | |
1760 | Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last); | |
1761 | end if; | |
1762 | ||
1763 | Unchecked_Free (Tmp); | |
1764 | end Remove; | |
1765 | ||
76871f97 RD |
1766 | --------- |
1767 | -- Add -- | |
1768 | --------- | |
da2ac8c2 | 1769 | |
cf5028e3 RD |
1770 | procedure Add |
1771 | (Line : in out Argument_List_Access; | |
1772 | Str : String_Access; | |
1773 | Before : Boolean := False) | |
da2ac8c2 EB |
1774 | is |
1775 | Tmp : Argument_List_Access := Line; | |
76871f97 | 1776 | |
da2ac8c2 EB |
1777 | begin |
1778 | if Tmp /= null then | |
1779 | Line := new Argument_List (Tmp'First .. Tmp'Last + 1); | |
cf5028e3 RD |
1780 | |
1781 | if Before then | |
5b3a33c3 | 1782 | Line (Tmp'First) := Str; |
cf5028e3 RD |
1783 | Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all; |
1784 | else | |
5b3a33c3 TQ |
1785 | Line (Tmp'Range) := Tmp.all; |
1786 | Line (Tmp'Last + 1) := Str; | |
cf5028e3 RD |
1787 | end if; |
1788 | ||
da2ac8c2 | 1789 | Unchecked_Free (Tmp); |
76871f97 | 1790 | |
cf5028e3 | 1791 | else |
5b3a33c3 | 1792 | Line := new Argument_List'(1 .. 1 => Str); |
cf5028e3 RD |
1793 | end if; |
1794 | end Add; | |
da2ac8c2 EB |
1795 | |
1796 | ------------------- | |
1797 | -- Remove_Switch -- | |
1798 | ------------------- | |
1799 | ||
1800 | procedure Remove_Switch | |
f9325b03 AC |
1801 | (Cmd : in out Command_Line; |
1802 | Switch : String; | |
1803 | Remove_All : Boolean := False; | |
1804 | Has_Parameter : Boolean := False; | |
1805 | Section : String := "") | |
1806 | is | |
1807 | Success : Boolean; | |
1808 | pragma Unreferenced (Success); | |
1809 | begin | |
1810 | Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success); | |
1811 | end Remove_Switch; | |
1812 | ||
1813 | ------------------- | |
1814 | -- Remove_Switch -- | |
1815 | ------------------- | |
1816 | ||
1817 | procedure Remove_Switch | |
1818 | (Cmd : in out Command_Line; | |
1819 | Switch : String; | |
1820 | Remove_All : Boolean := False; | |
1821 | Has_Parameter : Boolean := False; | |
1822 | Section : String := ""; | |
1823 | Success : out Boolean) | |
da2ac8c2 | 1824 | is |
f9325b03 | 1825 | procedure Remove_Simple_Switch (Simple : String; Param : String); |
da2ac8c2 EB |
1826 | -- Removes a simple switch, with no aliasing or grouping |
1827 | ||
1828 | -------------------------- | |
1829 | -- Remove_Simple_Switch -- | |
1830 | -------------------------- | |
1831 | ||
f9325b03 | 1832 | procedure Remove_Simple_Switch (Simple : String; Param : String) is |
da2ac8c2 | 1833 | C : Integer; |
f9325b03 | 1834 | pragma Unreferenced (Param); |
da2ac8c2 EB |
1835 | |
1836 | begin | |
1837 | if Cmd.Expanded /= null then | |
1838 | C := Cmd.Expanded'First; | |
1839 | while C <= Cmd.Expanded'Last loop | |
c1db334e JL |
1840 | if Cmd.Expanded (C).all = Simple |
1841 | and then | |
1842 | (Remove_All | |
cf5028e3 RD |
1843 | or else (Cmd.Sections (C) = null |
1844 | and then Section = "") | |
1845 | or else (Cmd.Sections (C) /= null | |
1846 | and then Section = Cmd.Sections (C).all)) | |
f9325b03 | 1847 | and then (not Has_Parameter or else Cmd.Params (C) /= null) |
c1db334e | 1848 | then |
da2ac8c2 EB |
1849 | Remove (Cmd.Expanded, C); |
1850 | Remove (Cmd.Params, C); | |
c1db334e | 1851 | Remove (Cmd.Sections, C); |
f9325b03 | 1852 | Success := True; |
da2ac8c2 EB |
1853 | |
1854 | if not Remove_All then | |
1855 | return; | |
1856 | end if; | |
1857 | ||
1858 | else | |
1859 | C := C + 1; | |
1860 | end if; | |
1861 | end loop; | |
1862 | end if; | |
1863 | end Remove_Simple_Switch; | |
1864 | ||
6a1cb33a | 1865 | procedure Remove_Simple_Switches is |
cf5028e3 | 1866 | new For_Each_Simple_Switch (Remove_Simple_Switch); |
6a1cb33a | 1867 | |
da2ac8c2 EB |
1868 | -- Start of processing for Remove_Switch |
1869 | ||
1870 | begin | |
f9325b03 AC |
1871 | Success := False; |
1872 | Remove_Simple_Switches (Cmd, Switch, "", Unalias => not Has_Parameter); | |
da2ac8c2 EB |
1873 | Free (Cmd.Coalesce); |
1874 | end Remove_Switch; | |
1875 | ||
1876 | ------------------- | |
1877 | -- Remove_Switch -- | |
1878 | ------------------- | |
1879 | ||
1880 | procedure Remove_Switch | |
1881 | (Cmd : in out Command_Line; | |
1882 | Switch : String; | |
c1db334e JL |
1883 | Parameter : String; |
1884 | Section : String := "") | |
da2ac8c2 | 1885 | is |
f9325b03 | 1886 | procedure Remove_Simple_Switch (Simple : String; Param : String); |
da2ac8c2 EB |
1887 | -- Removes a simple switch, with no aliasing or grouping |
1888 | ||
1889 | -------------------------- | |
1890 | -- Remove_Simple_Switch -- | |
1891 | -------------------------- | |
1892 | ||
f9325b03 | 1893 | procedure Remove_Simple_Switch (Simple : String; Param : String) is |
da2ac8c2 EB |
1894 | C : Integer; |
1895 | ||
1896 | begin | |
1897 | if Cmd.Expanded /= null then | |
1898 | C := Cmd.Expanded'First; | |
1899 | while C <= Cmd.Expanded'Last loop | |
1900 | if Cmd.Expanded (C).all = Simple | |
c1db334e JL |
1901 | and then |
1902 | ((Cmd.Sections (C) = null | |
cf5028e3 | 1903 | and then Section = "") |
c1db334e JL |
1904 | or else |
1905 | (Cmd.Sections (C) /= null | |
cf5028e3 | 1906 | and then Section = Cmd.Sections (C).all)) |
da2ac8c2 | 1907 | and then |
f9325b03 | 1908 | ((Cmd.Params (C) = null and then Param = "") |
da2ac8c2 EB |
1909 | or else |
1910 | (Cmd.Params (C) /= null | |
1911 | and then | |
1912 | ||
1913 | -- Ignore the separator stored in Parameter | |
1914 | ||
1915 | Cmd.Params (C) (Cmd.Params (C)'First + 1 | |
1916 | .. Cmd.Params (C)'Last) = | |
f9325b03 | 1917 | Param)) |
da2ac8c2 EB |
1918 | then |
1919 | Remove (Cmd.Expanded, C); | |
1920 | Remove (Cmd.Params, C); | |
c1db334e | 1921 | Remove (Cmd.Sections, C); |
da2ac8c2 EB |
1922 | |
1923 | -- The switch is necessarily unique by construction of | |
76871f97 | 1924 | -- Add_Switch. |
da2ac8c2 EB |
1925 | |
1926 | return; | |
1927 | ||
1928 | else | |
1929 | C := C + 1; | |
1930 | end if; | |
1931 | end loop; | |
1932 | end if; | |
1933 | end Remove_Simple_Switch; | |
1934 | ||
6a1cb33a BD |
1935 | procedure Remove_Simple_Switches is |
1936 | new For_Each_Simple_Switch (Remove_Simple_Switch); | |
1937 | ||
da2ac8c2 EB |
1938 | -- Start of processing for Remove_Switch |
1939 | ||
1940 | begin | |
f9325b03 | 1941 | Remove_Simple_Switches (Cmd, Switch, Parameter); |
da2ac8c2 EB |
1942 | Free (Cmd.Coalesce); |
1943 | end Remove_Switch; | |
1944 | ||
1945 | -------------------- | |
1946 | -- Group_Switches -- | |
1947 | -------------------- | |
1948 | ||
1949 | procedure Group_Switches | |
c1db334e JL |
1950 | (Cmd : Command_Line; |
1951 | Result : Argument_List_Access; | |
1952 | Sections : Argument_List_Access; | |
1953 | Params : Argument_List_Access) | |
da2ac8c2 | 1954 | is |
f9325b03 | 1955 | function Compatible_Parameter (Param : String_Access) return Boolean; |
76871f97 | 1956 | -- True when the parameter can be part of a group |
f9325b03 AC |
1957 | |
1958 | -------------------------- | |
1959 | -- Compatible_Parameter -- | |
1960 | -------------------------- | |
1961 | ||
1962 | function Compatible_Parameter (Param : String_Access) return Boolean is | |
1963 | begin | |
1bae4562 RD |
1964 | -- No parameter OK |
1965 | ||
f9325b03 | 1966 | if Param = null then |
f9325b03 AC |
1967 | return True; |
1968 | ||
1bae4562 RD |
1969 | -- We need parameters without separators |
1970 | ||
f9325b03 | 1971 | elsif Param (Param'First) /= ASCII.NUL then |
f9325b03 AC |
1972 | return False; |
1973 | ||
1bae4562 RD |
1974 | -- Parameters must be all digits |
1975 | ||
f9325b03 | 1976 | else |
f9325b03 AC |
1977 | for J in Param'First + 1 .. Param'Last loop |
1978 | if Param (J) not in '0' .. '9' then | |
1979 | return False; | |
1980 | end if; | |
1981 | end loop; | |
1982 | ||
1983 | return True; | |
1984 | end if; | |
f9325b03 AC |
1985 | end Compatible_Parameter; |
1986 | ||
1bae4562 RD |
1987 | -- Local declarations |
1988 | ||
1989 | Group : Ada.Strings.Unbounded.Unbounded_String; | |
1990 | First : Natural; | |
c18b3a99 | 1991 | use type Ada.Strings.Unbounded.Unbounded_String; |
da2ac8c2 | 1992 | |
1bae4562 RD |
1993 | -- Start of processing for Group_Switches |
1994 | ||
da2ac8c2 EB |
1995 | begin |
1996 | if Cmd.Config = null | |
1997 | or else Cmd.Config.Prefixes = null | |
1998 | then | |
1999 | return; | |
2000 | end if; | |
2001 | ||
2002 | for P in Cmd.Config.Prefixes'Range loop | |
c18b3a99 JL |
2003 | Group := Ada.Strings.Unbounded.Null_Unbounded_String; |
2004 | First := 0; | |
da2ac8c2 EB |
2005 | |
2006 | for C in Result'Range loop | |
2007 | if Result (C) /= null | |
f9325b03 | 2008 | and then Compatible_Parameter (Params (C)) |
da2ac8c2 EB |
2009 | and then Looking_At |
2010 | (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all) | |
2011 | then | |
c1db334e | 2012 | -- If we are still in the same section, group the switches |
1bae4562 | 2013 | |
c1db334e JL |
2014 | if First = 0 |
2015 | or else | |
2016 | (Sections (C) = null | |
1bae4562 | 2017 | and then Sections (First) = null) |
c1db334e JL |
2018 | or else |
2019 | (Sections (C) /= null | |
1bae4562 RD |
2020 | and then Sections (First) /= null |
2021 | and then Sections (C).all = Sections (First).all) | |
c1db334e JL |
2022 | then |
2023 | Group := | |
2024 | Group & | |
2025 | Result (C) | |
2026 | (Result (C)'First + Cmd.Config.Prefixes (P)'Length .. | |
1bae4562 | 2027 | Result (C)'Last); |
f9325b03 AC |
2028 | |
2029 | if Params (C) /= null then | |
1bae4562 RD |
2030 | Group := |
2031 | Group & | |
2032 | Params (C) (Params (C)'First + 1 .. Params (C)'Last); | |
f9325b03 AC |
2033 | Free (Params (C)); |
2034 | end if; | |
2035 | ||
c1db334e JL |
2036 | if First = 0 then |
2037 | First := C; | |
2038 | end if; | |
b59283f2 | 2039 | |
c1db334e | 2040 | Free (Result (C)); |
1bae4562 | 2041 | |
c1db334e JL |
2042 | else |
2043 | -- We changed section: we put the grouped switches to the | |
2044 | -- first place, on continue with the new section. | |
1bae4562 | 2045 | |
c1db334e JL |
2046 | Result (First) := |
2047 | new String' | |
2048 | (Cmd.Config.Prefixes (P).all & | |
2049 | Ada.Strings.Unbounded.To_String (Group)); | |
2050 | Group := | |
2051 | Ada.Strings.Unbounded.To_Unbounded_String | |
2052 | (Result (C) | |
2053 | (Result (C)'First + Cmd.Config.Prefixes (P)'Length .. | |
2054 | Result (C)'Last)); | |
c18b3a99 JL |
2055 | First := C; |
2056 | end if; | |
da2ac8c2 EB |
2057 | end if; |
2058 | end loop; | |
2059 | ||
c18b3a99 | 2060 | if First > 0 then |
b59283f2 RD |
2061 | Result (First) := |
2062 | new String' | |
2063 | (Cmd.Config.Prefixes (P).all & | |
2064 | Ada.Strings.Unbounded.To_String (Group)); | |
da2ac8c2 EB |
2065 | end if; |
2066 | end loop; | |
2067 | end Group_Switches; | |
2068 | ||
2069 | -------------------- | |
2070 | -- Alias_Switches -- | |
2071 | -------------------- | |
2072 | ||
2073 | procedure Alias_Switches | |
2074 | (Cmd : Command_Line; | |
2075 | Result : Argument_List_Access; | |
2076 | Params : Argument_List_Access) | |
2077 | is | |
2078 | Found : Boolean; | |
2079 | First : Natural; | |
2080 | ||
f9325b03 | 2081 | procedure Check_Cb (Switch : String; Param : String); |
da2ac8c2 EB |
2082 | -- Comment required ??? |
2083 | ||
f9325b03 | 2084 | procedure Remove_Cb (Switch : String; Param : String); |
da2ac8c2 EB |
2085 | -- Comment required ??? |
2086 | ||
2087 | -------------- | |
2088 | -- Check_Cb -- | |
2089 | -------------- | |
2090 | ||
f9325b03 | 2091 | procedure Check_Cb (Switch : String; Param : String) is |
da2ac8c2 EB |
2092 | begin |
2093 | if Found then | |
2094 | for E in Result'Range loop | |
2095 | if Result (E) /= null | |
f9325b03 AC |
2096 | and then |
2097 | (Params (E) = null | |
2098 | or else Params (E) (Params (E)'First + 1 | |
2099 | .. Params (E)'Last) = Param) | |
da2ac8c2 EB |
2100 | and then Result (E).all = Switch |
2101 | then | |
2102 | return; | |
2103 | end if; | |
2104 | end loop; | |
2105 | ||
2106 | Found := False; | |
2107 | end if; | |
2108 | end Check_Cb; | |
2109 | ||
2110 | --------------- | |
2111 | -- Remove_Cb -- | |
2112 | --------------- | |
2113 | ||
f9325b03 | 2114 | procedure Remove_Cb (Switch : String; Param : String) is |
da2ac8c2 EB |
2115 | begin |
2116 | for E in Result'Range loop | |
f9325b03 AC |
2117 | if Result (E) /= null |
2118 | and then | |
2119 | (Params (E) = null | |
2120 | or else Params (E) (Params (E)'First + 1 | |
2121 | .. Params (E)'Last) = Param) | |
2122 | and then Result (E).all = Switch | |
2123 | then | |
da2ac8c2 EB |
2124 | if First > E then |
2125 | First := E; | |
2126 | end if; | |
2127 | Free (Result (E)); | |
f9325b03 | 2128 | Free (Params (E)); |
da2ac8c2 EB |
2129 | return; |
2130 | end if; | |
2131 | end loop; | |
2132 | end Remove_Cb; | |
2133 | ||
6a1cb33a BD |
2134 | procedure Check_All is new For_Each_Simple_Switch (Check_Cb); |
2135 | procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb); | |
2136 | ||
da2ac8c2 EB |
2137 | -- Start of processing for Alias_Switches |
2138 | ||
2139 | begin | |
2140 | if Cmd.Config = null | |
2141 | or else Cmd.Config.Aliases = null | |
2142 | then | |
2143 | return; | |
2144 | end if; | |
2145 | ||
2146 | for A in Cmd.Config.Aliases'Range loop | |
2147 | ||
2148 | -- Compute the various simple switches that make up the alias. We | |
2149 | -- split the expansion into as many simple switches as possible, and | |
2150 | -- then check whether the expanded command line has all of them. | |
2151 | ||
2152 | Found := True; | |
6a1cb33a | 2153 | Check_All (Cmd, Cmd.Config.Expansions (A).all); |
da2ac8c2 EB |
2154 | |
2155 | if Found then | |
2156 | First := Integer'Last; | |
6a1cb33a | 2157 | Remove_All (Cmd, Cmd.Config.Expansions (A).all); |
da2ac8c2 EB |
2158 | Result (First) := new String'(Cmd.Config.Aliases (A).all); |
2159 | end if; | |
2160 | end loop; | |
2161 | end Alias_Switches; | |
2162 | ||
c1db334e JL |
2163 | ------------------- |
2164 | -- Sort_Sections -- | |
2165 | ------------------- | |
2166 | ||
2167 | procedure Sort_Sections | |
2168 | (Line : GNAT.OS_Lib.Argument_List_Access; | |
2169 | Sections : GNAT.OS_Lib.Argument_List_Access; | |
2170 | Params : GNAT.OS_Lib.Argument_List_Access) | |
2171 | is | |
2172 | Sections_List : Argument_List_Access := | |
2173 | new Argument_List'(1 .. 1 => null); | |
2174 | Found : Boolean; | |
2175 | Old_Line : constant Argument_List := Line.all; | |
2176 | Old_Sections : constant Argument_List := Sections.all; | |
2177 | Old_Params : constant Argument_List := Params.all; | |
2178 | Index : Natural; | |
2179 | ||
2180 | begin | |
2181 | if Line = null then | |
2182 | return; | |
2183 | end if; | |
2184 | ||
2185 | -- First construct a list of all sections | |
2186 | ||
2187 | for E in Line'Range loop | |
2188 | if Sections (E) /= null then | |
2189 | Found := False; | |
2190 | for S in Sections_List'Range loop | |
2191 | if (Sections_List (S) = null and then Sections (E) = null) | |
2192 | or else | |
2193 | (Sections_List (S) /= null | |
2194 | and then Sections (E) /= null | |
2195 | and then Sections_List (S).all = Sections (E).all) | |
2196 | then | |
2197 | Found := True; | |
2198 | exit; | |
2199 | end if; | |
2200 | end loop; | |
2201 | ||
2202 | if not Found then | |
cf5028e3 | 2203 | Add (Sections_List, Sections (E)); |
c1db334e JL |
2204 | end if; |
2205 | end if; | |
2206 | end loop; | |
2207 | ||
2208 | Index := Line'First; | |
2209 | ||
2210 | for S in Sections_List'Range loop | |
2211 | for E in Old_Line'Range loop | |
2212 | if (Sections_List (S) = null and then Old_Sections (E) = null) | |
2213 | or else | |
2214 | (Sections_List (S) /= null | |
2215 | and then Old_Sections (E) /= null | |
2216 | and then Sections_List (S).all = Old_Sections (E).all) | |
2217 | then | |
2218 | Line (Index) := Old_Line (E); | |
2219 | Sections (Index) := Old_Sections (E); | |
2220 | Params (Index) := Old_Params (E); | |
2221 | Index := Index + 1; | |
2222 | end if; | |
2223 | end loop; | |
2224 | end loop; | |
2225 | end Sort_Sections; | |
2226 | ||
da2ac8c2 EB |
2227 | ----------- |
2228 | -- Start -- | |
2229 | ----------- | |
2230 | ||
2231 | procedure Start | |
2232 | (Cmd : in out Command_Line; | |
2233 | Iter : in out Command_Line_Iterator; | |
2234 | Expanded : Boolean) | |
2235 | is | |
2236 | begin | |
1033834f RD |
2237 | if Cmd.Expanded = null then |
2238 | Iter.List := null; | |
2239 | return; | |
2240 | end if; | |
2241 | ||
c1db334e JL |
2242 | -- Reorder the expanded line so that sections are grouped |
2243 | ||
2244 | Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params); | |
2245 | ||
da2ac8c2 EB |
2246 | -- Coalesce the switches as much as possible |
2247 | ||
2248 | if not Expanded | |
2249 | and then Cmd.Coalesce = null | |
2250 | then | |
2251 | Cmd.Coalesce := new Argument_List (Cmd.Expanded'Range); | |
2252 | for E in Cmd.Expanded'Range loop | |
2253 | Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all); | |
2254 | end loop; | |
2255 | ||
c1db334e JL |
2256 | Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range); |
2257 | for E in Cmd.Sections'Range loop | |
2258 | if Cmd.Sections (E) = null then | |
2259 | Cmd.Coalesce_Sections (E) := null; | |
2260 | else | |
2261 | Cmd.Coalesce_Sections (E) := new String'(Cmd.Sections (E).all); | |
2262 | end if; | |
2263 | end loop; | |
2264 | ||
f9325b03 AC |
2265 | Cmd.Coalesce_Params := new Argument_List (Cmd.Params'Range); |
2266 | for E in Cmd.Params'Range loop | |
2267 | if Cmd.Params (E) = null then | |
2268 | Cmd.Coalesce_Params (E) := null; | |
2269 | else | |
2270 | Cmd.Coalesce_Params (E) := new String'(Cmd.Params (E).all); | |
2271 | end if; | |
2272 | end loop; | |
2273 | ||
da2ac8c2 EB |
2274 | -- Not a clone, since we will not modify the parameters anyway |
2275 | ||
f9325b03 AC |
2276 | Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params); |
2277 | Group_Switches | |
2278 | (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params); | |
da2ac8c2 EB |
2279 | end if; |
2280 | ||
2281 | if Expanded then | |
c1db334e JL |
2282 | Iter.List := Cmd.Expanded; |
2283 | Iter.Params := Cmd.Params; | |
2284 | Iter.Sections := Cmd.Sections; | |
da2ac8c2 | 2285 | else |
c1db334e JL |
2286 | Iter.List := Cmd.Coalesce; |
2287 | Iter.Params := Cmd.Coalesce_Params; | |
2288 | Iter.Sections := Cmd.Coalesce_Sections; | |
da2ac8c2 EB |
2289 | end if; |
2290 | ||
2291 | if Iter.List = null then | |
2292 | Iter.Current := Integer'Last; | |
2293 | else | |
2294 | Iter.Current := Iter.List'First; | |
f9325b03 | 2295 | |
da2ac8c2 EB |
2296 | while Iter.Current <= Iter.List'Last |
2297 | and then Iter.List (Iter.Current) = null | |
2298 | loop | |
2299 | Iter.Current := Iter.Current + 1; | |
2300 | end loop; | |
2301 | end if; | |
2302 | end Start; | |
2303 | ||
2304 | -------------------- | |
2305 | -- Current_Switch -- | |
2306 | -------------------- | |
2307 | ||
2308 | function Current_Switch (Iter : Command_Line_Iterator) return String is | |
2309 | begin | |
2310 | return Iter.List (Iter.Current).all; | |
2311 | end Current_Switch; | |
2312 | ||
c1db334e JL |
2313 | -------------------- |
2314 | -- Is_New_Section -- | |
2315 | -------------------- | |
2316 | ||
2317 | function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is | |
2318 | Section : constant String := Current_Section (Iter); | |
2319 | begin | |
2320 | if Iter.Sections = null then | |
2321 | return False; | |
2322 | elsif Iter.Current = Iter.Sections'First | |
2323 | or else Iter.Sections (Iter.Current - 1) = null | |
2324 | then | |
2325 | return Section /= ""; | |
2326 | end if; | |
2327 | ||
2328 | return Section /= Iter.Sections (Iter.Current - 1).all; | |
2329 | end Is_New_Section; | |
2330 | ||
2331 | --------------------- | |
2332 | -- Current_Section -- | |
2333 | --------------------- | |
2334 | ||
2335 | function Current_Section (Iter : Command_Line_Iterator) return String is | |
2336 | begin | |
2337 | if Iter.Sections = null | |
2338 | or else Iter.Current > Iter.Sections'Last | |
2339 | or else Iter.Sections (Iter.Current) = null | |
2340 | then | |
2341 | return ""; | |
2342 | end if; | |
2343 | ||
2344 | return Iter.Sections (Iter.Current).all; | |
2345 | end Current_Section; | |
2346 | ||
da2ac8c2 EB |
2347 | ----------------------- |
2348 | -- Current_Separator -- | |
2349 | ----------------------- | |
2350 | ||
2351 | function Current_Separator (Iter : Command_Line_Iterator) return String is | |
2352 | begin | |
2353 | if Iter.Params = null | |
2354 | or else Iter.Current > Iter.Params'Last | |
2355 | or else Iter.Params (Iter.Current) = null | |
2356 | then | |
2357 | return ""; | |
2358 | ||
2359 | else | |
2360 | declare | |
2361 | Sep : constant Character := | |
2362 | Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First); | |
2363 | begin | |
2364 | if Sep = ASCII.NUL then | |
2365 | return ""; | |
2366 | else | |
2367 | return "" & Sep; | |
2368 | end if; | |
2369 | end; | |
2370 | end if; | |
2371 | end Current_Separator; | |
2372 | ||
2373 | ----------------------- | |
2374 | -- Current_Parameter -- | |
2375 | ----------------------- | |
2376 | ||
2377 | function Current_Parameter (Iter : Command_Line_Iterator) return String is | |
2378 | begin | |
2379 | if Iter.Params = null | |
2380 | or else Iter.Current > Iter.Params'Last | |
2381 | or else Iter.Params (Iter.Current) = null | |
2382 | then | |
2383 | return ""; | |
2384 | ||
2385 | else | |
2386 | declare | |
2387 | P : constant String := Iter.Params (Iter.Current).all; | |
2388 | ||
2389 | begin | |
2390 | -- Skip separator | |
2391 | ||
2392 | return P (P'First + 1 .. P'Last); | |
2393 | end; | |
2394 | end if; | |
2395 | end Current_Parameter; | |
2396 | ||
2397 | -------------- | |
2398 | -- Has_More -- | |
2399 | -------------- | |
2400 | ||
2401 | function Has_More (Iter : Command_Line_Iterator) return Boolean is | |
2402 | begin | |
2403 | return Iter.List /= null and then Iter.Current <= Iter.List'Last; | |
2404 | end Has_More; | |
2405 | ||
2406 | ---------- | |
2407 | -- Next -- | |
2408 | ---------- | |
2409 | ||
2410 | procedure Next (Iter : in out Command_Line_Iterator) is | |
2411 | begin | |
2412 | Iter.Current := Iter.Current + 1; | |
2413 | while Iter.Current <= Iter.List'Last | |
2414 | and then Iter.List (Iter.Current) = null | |
2415 | loop | |
2416 | Iter.Current := Iter.Current + 1; | |
2417 | end loop; | |
2418 | end Next; | |
2419 | ||
2420 | ---------- | |
2421 | -- Free -- | |
2422 | ---------- | |
2423 | ||
2424 | procedure Free (Config : in out Command_Line_Configuration) is | |
2425 | begin | |
2426 | if Config /= null then | |
2427 | Free (Config.Aliases); | |
2428 | Free (Config.Expansions); | |
2429 | Free (Config.Prefixes); | |
2430 | Unchecked_Free (Config); | |
2431 | end if; | |
2432 | end Free; | |
2433 | ||
2434 | ---------- | |
2435 | -- Free -- | |
2436 | ---------- | |
2437 | ||
2438 | procedure Free (Cmd : in out Command_Line) is | |
2439 | begin | |
2440 | Free (Cmd.Expanded); | |
2441 | Free (Cmd.Coalesce); | |
2442 | Free (Cmd.Params); | |
2443 | end Free; | |
2444 | ||
38cbfe40 | 2445 | end GNAT.Command_Line; |