gcc/ada/g-comlin.adb

   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 --                                                                          --
   9 --          Copyright (C) 1999-2010, Free Software Foundation, Inc.         --
  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- --
  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.                                     --
  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/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  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;
  36
  37 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  38 with GNAT.OS_Lib;               use GNAT.OS_Lib;
  39
  40 package body GNAT.Command_Line is
  41
  42    package CL renames Ada.Command_Line;
  43
  44    type Switch_Parameter_Type is
  45      (Parameter_None,
  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
  50
  51    procedure Set_Parameter
  52      (Variable : out Parameter_Type;
  53       Arg_Num  : Positive;
  54       First    : Positive;
  55       Last     : Positive;
  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 ???
  60
  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.
  66
  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");
  70
  71    File_Names_Case_Sensitive : constant Boolean :=
  72                                  Get_File_Names_Case_Sensitive /= 0;
  73
  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.
  81
  82    procedure Internal_Initialize_Option_Scan
  83      (Parser                   : Opt_Parser;
  84       Switch_Char              : Character;
  85       Stop_At_First_Non_Switch : Boolean;
  86       Section_Delimiters       : String);
  87    --  Initialize Parser, which must have been allocated already
  88
  89    function Argument (Parser : Opt_Parser; Index : Integer) return String;
  90    --  Return the index-th command line argument
  91
  92    procedure Find_Longest_Matching_Switch
  93      (Switches          : String;
  94       Arg               : String;
  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???
 101
 102    procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 103      (Argument_List, Argument_List_Access);
 104
 105    procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 106      (Command_Line_Configuration_Record, Command_Line_Configuration);
 107
 108    procedure Remove (Line : in out Argument_List_Access; Index : Integer);
 109    --  Remove a specific element from Line
 110
 111    procedure Add
 112      (Line   : in out Argument_List_Access;
 113       Str    : String_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.
 117
 118    procedure Add
 119      (Config : in out Command_Line_Configuration;
 120       Switch : Switch_Definition);
 121    procedure Add
 122      (Def : in out Alias_Definitions_List;
 123       Alias  : Alias_Definition);
 124    --  Add a new element to Def.
 125
 126    procedure Initialize_Switch_Def
 127      (Def         : out Switch_Definition;
 128       Switch      : String := "";
 129       Long_Switch : String := "";
 130       Help        : 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.
 135
 136    procedure Decompose_Switch
 137      (Switch         : String;
 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
 142
 143    function Can_Have_Parameter (S : String) return Boolean;
 144    --  True if S can have a parameter
 145
 146    function Require_Parameter (S : String) return Boolean;
 147    --  True if S requires a parameter
 148
 149    function Actual_Switch (S : String) return String;
 150    --  Remove any possible trailing '!', ':', '?' and '='
 151
 152    generic
 153       with procedure Callback
 154         (Simple_Switch : String;
 155          Separator     : String;
 156          Parameter     : String;
 157          Index         : Integer);  --  Index in Config.Switches, or -1
 158    procedure For_Each_Simple_Switch
 159      (Config    : Command_Line_Configuration;
 160       Section   : String;
 161       Switch    : String;
 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
 166    --  these.
 167
 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.
 174
 175    procedure Group_Switches
 176      (Cmd      : Command_Line;
 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.
 182
 183    procedure Alias_Switches
 184      (Cmd    : Command_Line;
 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
 188    --  version.
 189
 190    function Looking_At
 191      (Type_Str  : String;
 192       Index     : Natural;
 193       Substring : String) return Boolean;
 194    --  Return True if the characters starting at Index in Type_Str are
 195    --  equivalent to Substring.
 196
 197    generic
 198       with function Callback (S : String; Index : Integer) return Boolean;
 199    procedure Foreach_Switch
 200      (Config   : Command_Line_Configuration;
 201       Section  : String);
 202    --  Iterate over all switches defined in Config, for a specific section.
 203    --  Index is set to the index in Config.Switches
 204
 205    --------------
 206    -- Argument --
 207    --------------
 208
 209    function Argument (Parser : Opt_Parser; Index : Integer) return String is
 210    begin
 211       if Parser.Arguments /= null then
 212          return Parser.Arguments (Index + Parser.Arguments'First - 1).all;
 213       else
 214          return CL.Argument (Index);
 215       end if;
 216    end Argument;
 217
 218    ------------------------------
 219    -- Canonical_Case_File_Name --
 220    ------------------------------
 221
 222    procedure Canonical_Case_File_Name (S : in out String) is
 223    begin
 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'));
 231             end if;
 232          end loop;
 233       end if;
 234    end Canonical_Case_File_Name;
 235
 236    ---------------
 237    -- Expansion --
 238    ---------------
 239
 240    function Expansion (Iterator : Expansion_Iterator) return String is
 241       type Pointer is access all Expansion_Iterator;
 242
 243       It   : constant Pointer := Iterator'Unrestricted_Access;
 244       S    : String (1 .. 1024);
 245       Last : Natural;
 246
 247       Current : Depth := It.Current_Depth;
 248       NL      : Positive;
 249
 250    begin
 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.
 254
 255       loop
 256          Read (It.Levels (Current).Dir, S, Last);
 257
 258          --  If we have exhausted the directory, close it and go back one level
 259
 260          if Last = 0 then
 261             Close (It.Levels (Current).Dir);
 262
 263             --  If we are at level 1, we are finished; return an empty string
 264
 265             if Current = 1 then
 266                return String'(1 .. 0 => ' ');
 267
 268             --  Otherwise continue with the directory at the previous level
 269
 270             else
 271                Current := Current - 1;
 272                It.Current_Depth := Current;
 273             end if;
 274
 275          --  If this is a directory, that is neither "." or "..", attempt to
 276          --  go to the next level.
 277
 278          elsif Is_Directory
 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) /= ".."
 282          then
 283             --  We can go to the next level only if we have not reached the
 284             --  maximum depth,
 285
 286             if Current < It.Maximum_Depth then
 287                NL := It.Levels (Current).Name_Last;
 288
 289                --  And if relative path of this new directory is not too long
 290
 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);
 295                   NL := NL + Last + 1;
 296                   It.Dir_Name (NL) := Directory_Separator;
 297                   It.Levels (Current).Name_Last := NL;
 298                   Canonical_Case_File_Name (It.Dir_Name (1 .. NL));
 299
 300                   --  Open the new directory, and read from it
 301
 302                   GNAT.Directory_Operations.Open
 303                     (It.Levels (Current).Dir, It.Dir_Name (1 .. NL));
 304                end if;
 305             end if;
 306          end if;
 307
 308          --  Check the relative path against the pattern
 309
 310          --  Note that we try to match also against directory names, since
 311          --  clients of this function may expect to retrieve directories.
 312
 313          declare
 314             Name : String :=
 315                      It.Dir_Name (It.Start .. It.Levels (Current).Name_Last)
 316                        & S (1 .. Last);
 317
 318          begin
 319             Canonical_Case_File_Name (Name);
 320
 321             --  If it matches return the relative path
 322
 323             if GNAT.Regexp.Match (Name, Iterator.Regexp) then
 324                return Name;
 325             end if;
 326          end;
 327       end loop;
 328    end Expansion;
 329
 330    ---------------------
 331    -- Current_Section --
 332    ---------------------
 333
 334    function Current_Section
 335      (Parser : Opt_Parser := Command_Line_Parser) return String
 336    is
 337    begin
 338       if Parser.Current_Section = 1 then
 339          return "";
 340       end if;
 341
 342       for Index in reverse 1 .. Integer'Min (Parser.Current_Argument - 1,
 343                                              Parser.Section'Last)
 344       loop
 345          if Parser.Section (Index) = 0 then
 346             return Argument (Parser, Index);
 347          end if;
 348       end loop;
 349
 350       return "";
 351    end Current_Section;
 352
 353    -----------------
 354    -- Full_Switch --
 355    -----------------
 356
 357    function Full_Switch
 358      (Parser : Opt_Parser := Command_Line_Parser) return String
 359    is
 360    begin
 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);
 364       else
 365          return Parser.The_Switch.Extra
 366            & Argument (Parser, Parser.The_Switch.Arg_Num)
 367            (Parser.The_Switch.First .. Parser.The_Switch.Last);
 368       end if;
 369    end Full_Switch;
 370
 371    ------------------
 372    -- Get_Argument --
 373    ------------------
 374
 375    function Get_Argument
 376      (Do_Expansion : Boolean    := False;
 377       Parser       : Opt_Parser := Command_Line_Parser) return String
 378    is
 379    begin
 380       if Parser.In_Expansion then
 381          declare
 382             S : constant String := Expansion (Parser.Expansion_It);
 383          begin
 384             if S'Length /= 0 then
 385                return S;
 386             else
 387                Parser.In_Expansion := False;
 388             end if;
 389          end;
 390       end if;
 391
 392       if Parser.Current_Argument > Parser.Arg_Count then
 393
 394          --  If this is the first time this function is called
 395
 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
 401             loop
 402                Parser.Current_Argument := Parser.Current_Argument + 1;
 403             end loop;
 404          else
 405             return String'(1 .. 0 => ' ');
 406          end if;
 407
 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
 412          loop
 413             Parser.Current_Argument := Parser.Current_Argument + 1;
 414          end loop;
 415       end if;
 416
 417       Parser.Current_Index := Integer'Last;
 418
 419       while Parser.Current_Argument <= Parser.Arg_Count
 420         and then Parser.Is_Switch (Parser.Current_Argument)
 421       loop
 422          Parser.Current_Argument := Parser.Current_Argument + 1;
 423       end loop;
 424
 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);
 429       end if;
 430
 431       Parser.Current_Argument := Parser.Current_Argument + 1;
 432
 433       --  Could it be a file name with wild cards to expand?
 434
 435       if Do_Expansion then
 436          declare
 437             Arg   : constant String :=
 438                       Argument (Parser, Parser.Current_Argument - 1);
 439             Index : Positive;
 440
 441          begin
 442             Index := Arg'First;
 443             while Index <= Arg'Last loop
 444                if Arg (Index) = '*'
 445                  or else Arg (Index) = '?'
 446                  or else Arg (Index) = '['
 447                then
 448                   Parser.In_Expansion := True;
 449                   Start_Expansion (Parser.Expansion_It, Arg);
 450                   return Get_Argument (Do_Expansion);
 451                end if;
 452
 453                Index := Index + 1;
 454             end loop;
 455          end;
 456       end if;
 457
 458       return Argument (Parser, Parser.Current_Argument - 1);
 459    end Get_Argument;
 460
 461    ----------------------
 462    -- Decompose_Switch --
 463    ----------------------
 464
 465    procedure Decompose_Switch
 466      (Switch         : String;
 467       Parameter_Type : out Switch_Parameter_Type;
 468       Switch_Last    : out Integer)
 469    is
 470    begin
 471       if Switch = "" then
 472          Parameter_Type := Parameter_None;
 473          Switch_Last := Switch'Last;
 474          return;
 475       end if;
 476
 477       case Switch (Switch'Last) is
 478          when ':'    =>
 479             Parameter_Type := Parameter_With_Optional_Space;
 480             Switch_Last    := Switch'Last - 1;
 481          when '='    =>
 482             Parameter_Type := Parameter_With_Space_Or_Equal;
 483             Switch_Last    := Switch'Last - 1;
 484          when '!'    =>
 485             Parameter_Type := Parameter_No_Space;
 486             Switch_Last    := Switch'Last - 1;
 487          when '?'    =>
 488             Parameter_Type := Parameter_Optional;
 489             Switch_Last    := Switch'Last - 1;
 490          when others =>
 491             Parameter_Type := Parameter_None;
 492             Switch_Last    := Switch'Last;
 493       end case;
 494    end Decompose_Switch;
 495
 496    ----------------------------------
 497    -- Find_Longest_Matching_Switch --
 498    ----------------------------------
 499
 500    procedure Find_Longest_Matching_Switch
 501      (Switches          : String;
 502       Arg               : String;
 503       Index_In_Switches : out Integer;
 504       Switch_Length     : out Integer;
 505       Param             : out Switch_Parameter_Type)
 506    is
 507       Index  : Natural;
 508       Length : Natural := 1;
 509       Last   : Natural;
 510       P      : Switch_Parameter_Type;
 511
 512    begin
 513       Index_In_Switches := 0;
 514       Switch_Length     := 0;
 515
 516       --  Remove all leading spaces first to make sure that Index points
 517       --  at the start of the first switch.
 518
 519       Index := Switches'First;
 520       while Index <= Switches'Last and then Switches (Index) = ' ' loop
 521          Index := Index + 1;
 522       end loop;
 523
 524       while Index <= Switches'Last loop
 525
 526          --  Search the length of the parameter at this position in Switches
 527
 528          Length := Index;
 529          while Length <= Switches'Last
 530            and then Switches (Length) /= ' '
 531          loop
 532             Length := Length + 1;
 533          end loop;
 534
 535          --  Length now marks the separator after the current switch
 536          --  Last will mark the last character of the name of the switch
 537
 538          if Length = Index + 1 then
 539             P := Parameter_None;
 540             Last := Index;
 541          else
 542             Decompose_Switch (Switches (Index .. Length - 1), P, Last);
 543          end if;
 544
 545          --  If it is the one we searched, it may be a candidate
 546
 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
 551          then
 552             Param             := P;
 553             Index_In_Switches := Index;
 554             Switch_Length     := Last - Index + 1;
 555          end if;
 556
 557          --  Look for the next switch in Switches
 558
 559          while Index <= Switches'Last
 560            and then Switches (Index) /= ' '
 561          loop
 562             Index := Index + 1;
 563          end loop;
 564
 565          Index := Index + 1;
 566       end loop;
 567    end Find_Longest_Matching_Switch;
 568
 569    ------------
 570    -- Getopt --
 571    ------------
 572
 573    function Getopt
 574      (Switches    : String;
 575       Concatenate : Boolean := True;
 576       Parser      : Opt_Parser := Command_Line_Parser) return Character
 577    is
 578       Dummy : Boolean;
 579       pragma Unreferenced (Dummy);
 580
 581    begin
 582       <<Restart>>
 583
 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
 586       --  element
 587
 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))
 592       then
 593          return ASCII.NUL;
 594       end if;
 595
 596       --  By default, the switch will not have a parameter
 597
 598       Parser.The_Parameter :=
 599         (Integer'Last, Integer'Last, Integer'Last - 1, ASCII.NUL);
 600       Parser.The_Separator := ASCII.NUL;
 601
 602       declare
 603          Arg            : constant String :=
 604                             Argument (Parser, Parser.Current_Argument);
 605          Index_Switches : Natural := 0;
 606          Max_Length     : Natural := 0;
 607          End_Index      : Natural;
 608          Param          : Switch_Parameter_Type;
 609       begin
 610          --  If we are on a new item, test if this might be a switch
 611
 612          if Parser.Current_Index = Arg'First then
 613             if Arg (Arg'First) /= Parser.Switch_Character then
 614
 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
 618
 619                if Switches (Switches'First) = '*' then
 620                   Set_Parameter
 621                     (Parser.The_Switch,
 622                      Arg_Num => Parser.Current_Argument,
 623                      First   => Arg'First,
 624                      Last    => Arg'Last);
 625                   Parser.Is_Switch (Parser.Current_Argument) := True;
 626                   Dummy := Goto_Next_Argument_In_Section (Parser);
 627                   return '*';
 628                end if;
 629
 630                if Parser.Stop_At_First then
 631                   Parser.Current_Argument := Positive'Last;
 632                   return ASCII.NUL;
 633
 634                elsif not Goto_Next_Argument_In_Section (Parser) then
 635                   return ASCII.NUL;
 636
 637                else
 638                   --  Recurse to get the next switch on the command line
 639
 640                   goto Restart;
 641                end if;
 642             end if;
 643
 644             --  We are on the first character of a new command line argument,
 645             --  which starts with Switch_Character. Further analysis is needed.
 646
 647             Parser.Current_Index := Parser.Current_Index + 1;
 648             Parser.Is_Switch (Parser.Current_Argument) := True;
 649          end if;
 650
 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,
 656             Param             => Param);
 657
 658          --  If switch is not accepted, it is either invalid or is returned
 659          --  in the context of '*'.
 660
 661          if Index_Switches = 0 then
 662
 663             --  Depending on the value of Concatenate, the full switch is
 664             --  a single character or the rest of the argument.
 665
 666             End_Index :=
 667               (if Concatenate then Parser.Current_Index else Arg'Last);
 668
 669             if Switches (Switches'First) = '*' then
 670
 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.
 675
 676                Set_Parameter
 677                  (Parser.The_Switch,
 678                   Arg_Num => Parser.Current_Argument,
 679                   First   => Parser.Current_Index,
 680                   Last    => Arg'Last,
 681                   Extra   => Parser.Switch_Character);
 682                Parser.Is_Switch (Parser.Current_Argument) := True;
 683                Dummy := Goto_Next_Argument_In_Section (Parser);
 684                return '*';
 685             end if;
 686
 687             Set_Parameter
 688               (Parser.The_Switch,
 689                Arg_Num => Parser.Current_Argument,
 690                First   => Parser.Current_Index,
 691                Last    => End_Index);
 692             Parser.Current_Index := End_Index + 1;
 693
 694             raise Invalid_Switch;
 695          end if;
 696
 697          End_Index := Parser.Current_Index + Max_Length - 1;
 698          Set_Parameter
 699            (Parser.The_Switch,
 700             Arg_Num => Parser.Current_Argument,
 701             First   => Parser.Current_Index,
 702             Last    => End_Index);
 703
 704          case Param is
 705             when Parameter_With_Optional_Space =>
 706                if End_Index < Arg'Last then
 707                   Set_Parameter
 708                     (Parser.The_Parameter,
 709                      Arg_Num => Parser.Current_Argument,
 710                      First   => End_Index + 1,
 711                      Last    => Arg'Last);
 712                   Dummy := Goto_Next_Argument_In_Section (Parser);
 713
 714                elsif Parser.Current_Argument < Parser.Arg_Count
 715                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 716                then
 717                   Parser.Current_Argument := Parser.Current_Argument + 1;
 718                   Parser.The_Separator := ' ';
 719                   Set_Parameter
 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);
 726
 727                else
 728                   Parser.Current_Index := End_Index + 1;
 729                   raise Invalid_Parameter;
 730                end if;
 731
 732             when Parameter_With_Space_Or_Equal =>
 733
 734                --  If the switch is of the form <switch>=xxx
 735
 736                if End_Index < Arg'Last then
 737                   if Arg (End_Index + 1) = '='
 738                     and then End_Index + 1 < Arg'Last
 739                   then
 740                      Parser.The_Separator := '=';
 741                      Set_Parameter
 742                        (Parser.The_Parameter,
 743                         Arg_Num => Parser.Current_Argument,
 744                         First   => End_Index + 2,
 745                         Last    => Arg'Last);
 746                      Dummy := Goto_Next_Argument_In_Section (Parser);
 747                   else
 748                      Parser.Current_Index := End_Index + 1;
 749                      raise Invalid_Parameter;
 750                   end if;
 751
 752                --  If the switch is of the form <switch> xxx
 753
 754                elsif Parser.Current_Argument < Parser.Arg_Count
 755                  and then Parser.Section (Parser.Current_Argument + 1) /= 0
 756                then
 757                   Parser.Current_Argument := Parser.Current_Argument + 1;
 758                   Parser.The_Separator := ' ';
 759                   Set_Parameter
 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);
 766
 767                else
 768                   Parser.Current_Index := End_Index + 1;
 769                   raise Invalid_Parameter;
 770                end if;
 771
 772             when Parameter_No_Space =>
 773                if End_Index < Arg'Last then
 774                   Set_Parameter
 775                     (Parser.The_Parameter,
 776                      Arg_Num => Parser.Current_Argument,
 777                      First   => End_Index + 1,
 778                      Last    => Arg'Last);
 779                   Dummy := Goto_Next_Argument_In_Section (Parser);
 780
 781                else
 782                   Parser.Current_Index := End_Index + 1;
 783                   raise Invalid_Parameter;
 784                end if;
 785
 786             when Parameter_Optional =>
 787                if End_Index < Arg'Last then
 788                   Set_Parameter
 789                     (Parser.The_Parameter,
 790                      Arg_Num => Parser.Current_Argument,
 791                      First   => End_Index + 1,
 792                      Last    => Arg'Last);
 793                end if;
 794
 795                Dummy := Goto_Next_Argument_In_Section (Parser);
 796
 797             when Parameter_None =>
 798                if Concatenate or else End_Index = Arg'Last then
 799                   Parser.Current_Index := End_Index + 1;
 800
 801                else
 802                   --  If Concatenate is False and the full argument is not
 803                   --  recognized as a switch, this is an invalid switch.
 804
 805                   if Switches (Switches'First) = '*' then
 806                      Set_Parameter
 807                        (Parser.The_Switch,
 808                         Arg_Num => Parser.Current_Argument,
 809                         First   => Arg'First,
 810                         Last    => Arg'Last);
 811                      Parser.Is_Switch (Parser.Current_Argument) := True;
 812                      Dummy := Goto_Next_Argument_In_Section (Parser);
 813                      return '*';
 814                   end if;
 815
 816                   Set_Parameter
 817                     (Parser.The_Switch,
 818                      Arg_Num => Parser.Current_Argument,
 819                      First   => Parser.Current_Index,
 820                      Last    => Arg'Last);
 821                   Parser.Current_Index := Arg'Last + 1;
 822                   raise Invalid_Switch;
 823                end if;
 824          end case;
 825
 826          return Switches (Index_Switches);
 827       end;
 828    end Getopt;
 829
 830    -----------------------------------
 831    -- Goto_Next_Argument_In_Section --
 832    -----------------------------------
 833
 834    function Goto_Next_Argument_In_Section
 835      (Parser : Opt_Parser) return Boolean
 836    is
 837    begin
 838       Parser.Current_Argument := Parser.Current_Argument + 1;
 839
 840       if Parser.Current_Argument > Parser.Arg_Count
 841         or else Parser.Section (Parser.Current_Argument) = 0
 842       then
 843          loop
 844             Parser.Current_Argument := Parser.Current_Argument + 1;
 845
 846             if Parser.Current_Argument > Parser.Arg_Count then
 847                Parser.Current_Index := 1;
 848                return False;
 849             end if;
 850
 851             exit when Parser.Section (Parser.Current_Argument) =
 852                                                   Parser.Current_Section;
 853          end loop;
 854       end if;
 855
 856       Parser.Current_Index :=
 857         Argument (Parser, Parser.Current_Argument)'First;
 858
 859       return True;
 860    end Goto_Next_Argument_In_Section;
 861
 862    ------------------
 863    -- Goto_Section --
 864    ------------------
 865
 866    procedure Goto_Section
 867      (Name   : String := "";
 868       Parser : Opt_Parser := Command_Line_Parser)
 869    is
 870       Index : Integer;
 871
 872    begin
 873       Parser.In_Expansion := False;
 874
 875       if Name = "" then
 876          Parser.Current_Argument := 1;
 877          Parser.Current_Index    := 1;
 878          Parser.Current_Section  := 1;
 879          return;
 880       end if;
 881
 882       Index := 1;
 883       while Index <= Parser.Arg_Count loop
 884          if Parser.Section (Index) = 0
 885            and then Argument (Parser, Index) = Parser.Switch_Character & Name
 886          then
 887             Parser.Current_Argument := Index + 1;
 888             Parser.Current_Index    := 1;
 889
 890             if Parser.Current_Argument <= Parser.Arg_Count then
 891                Parser.Current_Section :=
 892                  Parser.Section (Parser.Current_Argument);
 893             end if;
 894             return;
 895          end if;
 896
 897          Index := Index + 1;
 898       end loop;
 899
 900       Parser.Current_Argument := Positive'Last;
 901       Parser.Current_Index := 2;   --  so that Get_Argument returns nothing
 902    end Goto_Section;
 903
 904    ----------------------------
 905    -- Initialize_Option_Scan --
 906    ----------------------------
 907
 908    procedure Initialize_Option_Scan
 909      (Switch_Char              : Character := '-';
 910       Stop_At_First_Non_Switch : Boolean   := False;
 911       Section_Delimiters       : String    := "")
 912    is
 913    begin
 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;
 920
 921    ----------------------------
 922    -- Initialize_Option_Scan --
 923    ----------------------------
 924
 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 := "")
 931    is
 932    begin
 933       Free (Parser);
 934
 935       if Command_Line = null then
 936          Parser := new Opt_Parser_Data (CL.Argument_Count);
 937          Internal_Initialize_Option_Scan
 938            (Parser                   => Parser,
 939             Switch_Char              => Switch_Char,
 940             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 941             Section_Delimiters       => Section_Delimiters);
 942       else
 943          Parser := new Opt_Parser_Data (Command_Line'Length);
 944          Parser.Arguments := Command_Line;
 945          Internal_Initialize_Option_Scan
 946            (Parser                   => Parser,
 947             Switch_Char              => Switch_Char,
 948             Stop_At_First_Non_Switch => Stop_At_First_Non_Switch,
 949             Section_Delimiters       => Section_Delimiters);
 950       end if;
 951    end Initialize_Option_Scan;
 952
 953    -------------------------------------
 954    -- Internal_Initialize_Option_Scan --
 955    -------------------------------------
 956
 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)
 962    is
 963       Section_Num     : Section_Number;
 964       Section_Index   : Integer;
 965       Last            : Integer;
 966       Delimiter_Found : Boolean;
 967
 968       Discard : Boolean;
 969       pragma Warnings (Off, Discard);
 970
 971    begin
 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);
 978
 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
 982
 983       Section_Num   := 1;
 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) /= ' '
 989          loop
 990             Last := Last + 1;
 991          end loop;
 992
 993          Delimiter_Found := False;
 994          Section_Num := Section_Num + 1;
 995
 996          for Index in 1 .. Parser.Arg_Count loop
 997             if Argument (Parser, Index)(1) = Parser.Switch_Character
 998               and then
 999                 Argument (Parser, Index) = Parser.Switch_Character &
1000                                         Section_Delimiters
1001                                           (Section_Index .. Last - 1)
1002             then
1003                Parser.Section (Index) := 0;
1004                Delimiter_Found := True;
1005
1006             elsif Parser.Section (Index) = 0 then
1007                Delimiter_Found := False;
1008
1009             elsif Delimiter_Found then
1010                Parser.Section (Index) := Section_Num;
1011             end if;
1012          end loop;
1013
1014          Section_Index := Last + 1;
1015          while Section_Index <= Section_Delimiters'Last
1016            and then Section_Delimiters (Section_Index) = ' '
1017          loop
1018             Section_Index := Section_Index + 1;
1019          end loop;
1020       end loop;
1021
1022       Discard := Goto_Next_Argument_In_Section (Parser);
1023    end Internal_Initialize_Option_Scan;
1024
1025    ---------------
1026    -- Parameter --
1027    ---------------
1028
1029    function Parameter
1030      (Parser : Opt_Parser := Command_Line_Parser) return String
1031    is
1032    begin
1033       if Parser.The_Parameter.First > Parser.The_Parameter.Last then
1034          return String'(1 .. 0 => ' ');
1035       else
1036          return Argument (Parser, Parser.The_Parameter.Arg_Num)
1037            (Parser.The_Parameter.First .. Parser.The_Parameter.Last);
1038       end if;
1039    end Parameter;
1040
1041    ---------------
1042    -- Separator --
1043    ---------------
1044
1045    function Separator
1046      (Parser : Opt_Parser := Command_Line_Parser) return Character
1047    is
1048    begin
1049       return Parser.The_Separator;
1050    end Separator;
1051
1052    -------------------
1053    -- Set_Parameter --
1054    -------------------
1055
1056    procedure Set_Parameter
1057      (Variable : out Parameter_Type;
1058       Arg_Num  : Positive;
1059       First    : Positive;
1060       Last     : Positive;
1061       Extra    : Character := ASCII.NUL)
1062    is
1063    begin
1064       Variable.Arg_Num := Arg_Num;
1065       Variable.First   := First;
1066       Variable.Last    := Last;
1067       Variable.Extra   := Extra;
1068    end Set_Parameter;
1069
1070    ---------------------
1071    -- Start_Expansion --
1072    ---------------------
1073
1074    procedure Start_Expansion
1075      (Iterator     : out Expansion_Iterator;
1076       Pattern      : String;
1077       Directory    : String := "";
1078       Basic_Regexp : Boolean := True)
1079    is
1080       Directory_Separator : Character;
1081       pragma Import (C, Directory_Separator, "__gnat_dir_separator");
1082
1083       First : Positive := Pattern'First;
1084       Pat   : String := Pattern;
1085
1086    begin
1087       Canonical_Case_File_Name (Pat);
1088       Iterator.Current_Depth := 1;
1089
1090       --  If Directory is unspecified, use the current directory ("./" or ".\")
1091
1092       if Directory = "" then
1093          Iterator.Dir_Name (1 .. 2) := "." & Directory_Separator;
1094          Iterator.Start := 3;
1095
1096       else
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));
1100
1101          --  Make sure that the last character is a directory separator
1102
1103          if Directory (Directory'Last) /= Directory_Separator then
1104             Iterator.Dir_Name (Iterator.Start) := Directory_Separator;
1105             Iterator.Start := Iterator.Start + 1;
1106          end if;
1107       end if;
1108
1109       Iterator.Levels (1).Name_Last := Iterator.Start - 1;
1110
1111       --  Open the initial Directory, at depth 1
1112
1113       GNAT.Directory_Operations.Open
1114         (Iterator.Levels (1).Dir, Iterator.Dir_Name (1 .. Iterator.Start - 1));
1115
1116       --  If in the current directory and the pattern starts with "./" or ".\",
1117       --  drop the "./" or ".\" from the pattern.
1118
1119       if Directory = "" and then Pat'Length > 2
1120         and then Pat (Pat'First) = '.'
1121         and then Pat (Pat'First + 1) = Directory_Separator
1122       then
1123          First := Pat'First + 2;
1124       end if;
1125
1126       Iterator.Regexp :=
1127         GNAT.Regexp.Compile (Pat (First .. Pat'Last), Basic_Regexp, True);
1128
1129       Iterator.Maximum_Depth := 1;
1130
1131       --  Maximum_Depth is equal to 1 plus the number of directory separators
1132       --  in the pattern.
1133
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;
1138          end if;
1139       end loop;
1140    end Start_Expansion;
1141
1142    ----------
1143    -- Free --
1144    ----------
1145
1146    procedure Free (Parser : in out Opt_Parser) is
1147       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1148         (Opt_Parser_Data, Opt_Parser);
1149    begin
1150       if Parser /= null
1151         and then Parser /= Command_Line_Parser
1152       then
1153          Free (Parser.Arguments);
1154          Unchecked_Free (Parser);
1155       end if;
1156    end Free;
1157
1158    ------------------
1159    -- Define_Alias --
1160    ------------------
1161
1162    procedure Define_Alias
1163      (Config   : in out Command_Line_Configuration;
1164       Switch   : String;
1165       Expanded : String;
1166       Section  : String := "")
1167    is
1168       Def    : Alias_Definition;
1169    begin
1170       if Config = null then
1171          Config := new Command_Line_Configuration_Record;
1172       end if;
1173
1174       Def.Alias     := new String'(Switch);
1175       Def.Expansion := new String'(Expanded);
1176       Def.Section   := new String'(Section);
1177       Add (Config.Aliases, Def);
1178    end Define_Alias;
1179
1180    -------------------
1181    -- Define_Prefix --
1182    -------------------
1183
1184    procedure Define_Prefix
1185      (Config : in out Command_Line_Configuration;
1186       Prefix : String)
1187    is
1188    begin
1189       if Config = null then
1190          Config := new Command_Line_Configuration_Record;
1191       end if;
1192
1193       Add (Config.Prefixes, new String'(Prefix));
1194    end Define_Prefix;
1195
1196    ---------
1197    -- Add --
1198    ---------
1199
1200    procedure Add (Config : in out Command_Line_Configuration;
1201                   Switch : Switch_Definition)
1202    is
1203       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1204         (Switch_Definitions, Switch_Definitions_List);
1205       Tmp : Switch_Definitions_List;
1206
1207    begin
1208       if Config = null then
1209          Config := new Command_Line_Configuration_Record;
1210       end if;
1211
1212       Tmp := Config.Switches;
1213
1214       if Tmp = null then
1215          Config.Switches := new Switch_Definitions (1 .. 1);
1216       else
1217          Config.Switches := new Switch_Definitions (1 .. Tmp'Length + 1);
1218          Config.Switches (1 .. Tmp'Length) := Tmp.all;
1219          Unchecked_Free (Tmp);
1220       end if;
1221
1222       Config.Switches (Config.Switches'Last) := Switch;
1223    end Add;
1224
1225    ---------
1226    -- Add --
1227    ---------
1228
1229    procedure Add (Def : in out Alias_Definitions_List;
1230                   Alias : Alias_Definition)
1231    is
1232       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1233         (Alias_Definitions, Alias_Definitions_List);
1234       Tmp : Alias_Definitions_List := Def;
1235
1236    begin
1237       if Tmp = null then
1238          Def := new Alias_Definitions (1 .. 1);
1239       else
1240          Def := new Alias_Definitions (1 .. Tmp'Length + 1);
1241          Def (1 .. Tmp'Length) := Tmp.all;
1242          Unchecked_Free (Tmp);
1243       end if;
1244
1245       Def (Def'Last) := Alias;
1246    end Add;
1247
1248    ---------------------------
1249    -- Initialize_Switch_Def --
1250    ---------------------------
1251
1252    procedure Initialize_Switch_Def
1253      (Def : out Switch_Definition;
1254       Switch      : String := "";
1255       Long_Switch : String := "";
1256       Help        : String := "";
1257       Section     : String := "")
1258    is
1259       P1, P2       : Switch_Parameter_Type := Parameter_None;
1260       Last1, Last2 : Integer;
1261
1262    begin
1263       if Switch /= "" then
1264          Def.Switch := new String'(Switch);
1265          Decompose_Switch (Switch, P1, Last1);
1266       end if;
1267
1268       if Long_Switch /= "" then
1269          Def.Long_Switch := new String'(Long_Switch);
1270          Decompose_Switch (Long_Switch, P2, Last2);
1271       end if;
1272
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)
1278          then
1279             raise Invalid_Switch
1280               with "Inconsistent parameter types for "
1281                 & Switch & " and " & Long_Switch;
1282          end if;
1283       end if;
1284
1285       if Section /= "" then
1286          Def.Section := new String'(Section);
1287       end if;
1288
1289       if Help /= "" then
1290          Def.Help := new String'(Help);
1291       end if;
1292    end Initialize_Switch_Def;
1293
1294    -------------------
1295    -- Define_Switch --
1296    -------------------
1297
1298    procedure Define_Switch
1299      (Config      : in out Command_Line_Configuration;
1300       Switch      : String := "";
1301       Long_Switch : String := "";
1302       Help        : String := "";
1303       Section     : String := "")
1304    is
1305       Def : Switch_Definition;
1306    begin
1307       if Switch /= "" or else Long_Switch /= "" then
1308          Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
1309          Add (Config, Def);
1310       end if;
1311    end Define_Switch;
1312
1313    -------------------
1314    -- Define_Switch --
1315    -------------------
1316
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)
1325    is
1326       Def : Switch_Definition (Switch_Boolean);
1327    begin
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;
1332          Add (Config, Def);
1333       end if;
1334    end Define_Switch;
1335
1336    -------------------
1337    -- Define_Switch --
1338    -------------------
1339
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)
1349    is
1350       Def : Switch_Definition (Switch_Integer);
1351    begin
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;
1357          Add (Config, Def);
1358       end if;
1359    end Define_Switch;
1360
1361    -------------------
1362    -- Define_Switch --
1363    -------------------
1364
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 := "")
1372    is
1373       Def : Switch_Definition (Switch_String);
1374    begin
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;
1378          Add (Config, Def);
1379       end if;
1380    end Define_Switch;
1381
1382    --------------------
1383    -- Define_Section --
1384    --------------------
1385
1386    procedure Define_Section
1387      (Config : in out Command_Line_Configuration;
1388       Section : String)
1389    is
1390    begin
1391       if Config = null then
1392          Config := new Command_Line_Configuration_Record;
1393       end if;
1394
1395       Add (Config.Sections, new String'(Section));
1396    end Define_Section;
1397
1398    --------------------
1399    -- Foreach_Switch --
1400    --------------------
1401
1402    procedure Foreach_Switch
1403      (Config   : Command_Line_Configuration;
1404       Section  : String)
1405    is
1406    begin
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)
1410               or else
1411                 (Config.Switches (J).Section /= null
1412                  and then Config.Switches (J).Section.all = Section)
1413             then
1414                exit when Config.Switches (J).Switch /= null
1415                  and then not Callback (Config.Switches (J).Switch.all, J);
1416
1417                exit when Config.Switches (J).Long_Switch /= null
1418                  and then
1419                    not Callback (Config.Switches (J).Long_Switch.all, J);
1420             end if;
1421          end loop;
1422       end if;
1423    end Foreach_Switch;
1424
1425    ------------------
1426    -- Get_Switches --
1427    ------------------
1428
1429    function Get_Switches
1430      (Config      : Command_Line_Configuration;
1431       Switch_Char : Character := '-';
1432       Section     : String := "") return String
1433    is
1434       Ret : Ada.Strings.Unbounded.Unbounded_String;
1435       use Ada.Strings.Unbounded;
1436
1437       function Add_Switch (S : String; Index : Integer) return Boolean;
1438       --  Add a switch to Ret
1439
1440       ----------------
1441       -- Add_Switch --
1442       ----------------
1443
1444       function Add_Switch (S : String; Index : Integer) return Boolean is
1445          pragma Unreferenced (Index);
1446       begin
1447          if S = "*" then
1448             Ret := "*" & Ret;  --  Always first
1449          elsif S (S'First) = Switch_Char then
1450             Append (Ret, " " & S (S'First + 1 .. S'Last));
1451          else
1452             Append (Ret, " " & S);
1453          end if;
1454          return True;
1455       end Add_Switch;
1456
1457       Tmp : Boolean;
1458       pragma Unreferenced (Tmp);
1459
1460       procedure Foreach is new Foreach_Switch (Add_Switch);
1461
1462    --  Start of processing for Get_Switches
1463
1464    begin
1465       if Config = null then
1466          return "";
1467       end if;
1468
1469       Foreach (Config, Section => Section);
1470
1471       --  Adding relevant aliases
1472
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);
1477             end if;
1478          end loop;
1479       end if;
1480
1481       return To_String (Ret);
1482    end Get_Switches;
1483
1484    ------------------------
1485    -- Section_Delimiters --
1486    ------------------------
1487
1488    function Section_Delimiters
1489      (Config : Command_Line_Configuration) return String
1490    is
1491       use Ada.Strings.Unbounded;
1492       Result : Unbounded_String;
1493
1494    begin
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);
1498          end loop;
1499       end if;
1500
1501       return To_String (Result);
1502    end Section_Delimiters;
1503
1504    -----------------------
1505    -- Set_Configuration --
1506    -----------------------
1507
1508    procedure Set_Configuration
1509      (Cmd    : in out Command_Line;
1510       Config : Command_Line_Configuration)
1511    is
1512    begin
1513       Cmd.Config := Config;
1514    end Set_Configuration;
1515
1516    -----------------------
1517    -- Get_Configuration --
1518    -----------------------
1519
1520    function Get_Configuration
1521      (Cmd : Command_Line) return Command_Line_Configuration
1522    is
1523    begin
1524       return Cmd.Config;
1525    end Get_Configuration;
1526
1527    ----------------------
1528    -- Set_Command_Line --
1529    ----------------------
1530
1531    procedure Set_Command_Line
1532      (Cmd                : in out Command_Line;
1533       Switches           : String;
1534       Getopt_Description : String := "";
1535       Switch_Char        : Character := '-')
1536    is
1537       Tmp     : Argument_List_Access;
1538       Parser  : Opt_Parser;
1539       S       : Character;
1540       Section : String_Access := null;
1541
1542       function Real_Full_Switch
1543         (S      : Character;
1544          Parser : Opt_Parser) return String;
1545       --  Ensure that the returned switch value contains the
1546       --  Switch_Char prefix if needed.
1547
1548       ----------------------
1549       -- Real_Full_Switch --
1550       ----------------------
1551
1552       function Real_Full_Switch
1553         (S      : Character;
1554          Parser : Opt_Parser) return String
1555       is
1556       begin
1557          if S = '*' then
1558             return Full_Switch (Parser);
1559          else
1560             return Switch_Char & Full_Switch (Parser);
1561          end if;
1562       end Real_Full_Switch;
1563
1564    --  Start of processing for Set_Command_Line
1565
1566    begin
1567       Free (Cmd.Expanded);
1568       Free (Cmd.Params);
1569
1570       if Switches /= "" then
1571          Tmp := Argument_String_To_List (Switches);
1572          Initialize_Option_Scan (Parser, Tmp, Switch_Char);
1573
1574          loop
1575             begin
1576                S := Getopt (Switches    => "* " & Getopt_Description,
1577                             Concatenate => False,
1578                             Parser      => Parser);
1579                exit when S = ASCII.NUL;
1580
1581                declare
1582                   Sw         : constant String :=
1583                                  Real_Full_Switch (S, Parser);
1584                   Is_Section : Boolean := False;
1585
1586                begin
1587                   if Cmd.Config /= null
1588                     and then Cmd.Config.Sections /= null
1589                   then
1590                      Section_Search :
1591                      for S in Cmd.Config.Sections'Range loop
1592                         if Sw = Cmd.Config.Sections (S).all then
1593                            Section := Cmd.Config.Sections (S);
1594                            Is_Section := True;
1595
1596                            exit Section_Search;
1597                         end if;
1598                      end loop Section_Search;
1599                   end if;
1600
1601                   if not Is_Section then
1602                      if Section = null then
1603                         Add_Switch (Cmd, Sw, Parameter (Parser));
1604                      else
1605                         Add_Switch
1606                           (Cmd, Sw, Parameter (Parser),
1607                            Section => Section.all);
1608                      end if;
1609                   end if;
1610                end;
1611
1612             exception
1613                when Invalid_Parameter =>
1614
1615                   --  Add it with no parameter, if that's the way the user
1616                   --  wants it.
1617
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.
1621
1622                   if Section = null then
1623                      Add_Switch
1624                        (Cmd, Switch_Char & Full_Switch (Parser));
1625                   else
1626                      Add_Switch
1627                        (Cmd, Switch_Char & Full_Switch (Parser),
1628                         Section   => Section.all);
1629                   end if;
1630             end;
1631          end loop;
1632
1633          Free (Parser);
1634       end if;
1635    end Set_Command_Line;
1636
1637    ----------------
1638    -- Looking_At --
1639    ----------------
1640
1641    function Looking_At
1642      (Type_Str  : String;
1643       Index     : Natural;
1644       Substring : String) return Boolean
1645    is
1646    begin
1647       return Index + Substring'Length - 1 <= Type_Str'Last
1648         and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
1649    end Looking_At;
1650
1651    ------------------------
1652    -- Can_Have_Parameter --
1653    ------------------------
1654
1655    function Can_Have_Parameter (S : String) return Boolean is
1656    begin
1657       if S'Length <= 1 then
1658          return False;
1659       end if;
1660
1661       case S (S'Last) is
1662          when '!' | ':' | '?' | '=' =>
1663             return True;
1664          when others =>
1665             return False;
1666       end case;
1667    end Can_Have_Parameter;
1668
1669    -----------------------
1670    -- Require_Parameter --
1671    -----------------------
1672
1673    function Require_Parameter (S : String) return Boolean is
1674    begin
1675       if S'Length <= 1 then
1676          return False;
1677       end if;
1678
1679       case S (S'Last) is
1680          when '!' | ':' | '=' =>
1681             return True;
1682          when others =>
1683             return False;
1684       end case;
1685    end Require_Parameter;
1686
1687    -------------------
1688    -- Actual_Switch --
1689    -------------------
1690
1691    function Actual_Switch (S : String) return String is
1692    begin
1693       if S'Length <= 1 then
1694          return S;
1695       end if;
1696
1697       case S (S'Last) is
1698          when '!' | ':' | '?' | '=' =>
1699             return S (S'First .. S'Last - 1);
1700          when others =>
1701             return S;
1702       end case;
1703    end Actual_Switch;
1704
1705    ----------------------------
1706    -- For_Each_Simple_Switch --
1707    ----------------------------
1708
1709    procedure For_Each_Simple_Switch
1710      (Config    : Command_Line_Configuration;
1711       Section   : String;
1712       Switch    : String;
1713       Parameter : String := "";
1714       Unalias   : Boolean := True)
1715    is
1716       function Group_Analysis
1717         (Prefix : String;
1718          Group  : String) return Boolean;
1719       --  Perform the analysis of a group of switches
1720
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
1726
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
1731
1732       --------------------
1733       -- Group_Analysis --
1734       --------------------
1735
1736       function Group_Analysis
1737         (Prefix : String;
1738          Group  : String) return Boolean
1739       is
1740          Idx   : Natural;
1741          Found : Boolean;
1742
1743          function Analyze_Simple_Switch
1744            (Switch : String; Index : Integer) return Boolean;
1745
1746          ---------------------------
1747          -- Analyze_Simple_Switch --
1748          ---------------------------
1749
1750          function Analyze_Simple_Switch
1751            (Switch : String; Index : Integer) return Boolean
1752          is
1753             pragma Unreferenced (Index);
1754
1755             Full  : constant String := Prefix & Group (Idx .. Group'Last);
1756             Sw    : constant String := Actual_Switch (Switch);
1757             Last  : Natural;
1758             Param : Natural;
1759
1760          begin
1761             if Sw'Length >= Prefix'Length
1762
1763             --  Verify that sw starts with Prefix
1764
1765               and then Looking_At (Sw, Sw'First, Prefix)
1766
1767             --  Verify that the group starts with sw
1768
1769               and then Looking_At (Full, Full'First, Sw)
1770             then
1771                Last  := Idx + Sw'Length - Prefix'Length - 1;
1772                Param := Last + 1;
1773
1774                if Can_Have_Parameter (Switch) then
1775
1776                   --  Include potential parameter to the recursive call.
1777                   --  Only numbers are allowed.
1778
1779                   while Last < Group'Last
1780                     and then Group (Last + 1) in '0' .. '9'
1781                   loop
1782                      Last := Last + 1;
1783                   end loop;
1784                end if;
1785
1786                if not Require_Parameter (Switch)
1787                  or else Last >= Param
1788                then
1789                   if Idx = Group'First
1790                     and then Last = Group'Last
1791                     and then Last < Param
1792                   then
1793                      --  The group only concerns a single switch. Do not
1794                      --  perform recursive call.
1795
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
1799                      --  in aliases.
1800
1801                      return False;
1802                   end if;
1803
1804                   Found := True;
1805
1806                   --  Recursive call, using the detected parameter if any
1807
1808                   if Last >= Param then
1809                      For_Each_Simple_Switch
1810                        (Config,
1811                         Section,
1812                         Prefix & Group (Idx .. Param - 1),
1813                         Group (Param .. Last));
1814                   else
1815                      For_Each_Simple_Switch
1816                        (Config, Section, Prefix & Group (Idx .. Last), "");
1817                   end if;
1818
1819                   Idx := Last + 1;
1820                   return False;
1821                end if;
1822             end if;
1823             return True;
1824          end Analyze_Simple_Switch;
1825
1826          procedure Foreach is new Foreach_Switch (Analyze_Simple_Switch);
1827
1828       --  Start of processing for Group_Analysis
1829
1830       begin
1831          Idx := Group'First;
1832          while Idx <= Group'Last loop
1833             Found := False;
1834
1835             Foreach (Config, Section);
1836
1837             if not Found then
1838                For_Each_Simple_Switch
1839                  (Config, Section, Prefix & Group (Idx), "");
1840                Idx := Idx + 1;
1841             end if;
1842          end loop;
1843
1844          return True;
1845       end Group_Analysis;
1846
1847       ------------------
1848       -- Is_In_Config --
1849       ------------------
1850
1851       function Is_In_Config
1852         (Config_Switch : String; Index : Integer) return Boolean
1853       is
1854          Last : Natural;
1855          P    : Switch_Parameter_Type;
1856
1857       begin
1858          Decompose_Switch (Config_Switch, P, Last);
1859
1860          if Config_Switch (Config_Switch'First .. Last) = Switch then
1861             case P is
1862                when Parameter_None =>
1863                   if Parameter = "" then
1864                      Callback (Switch, "", "", Index => Index);
1865                      Found_In_Config := True;
1866                      return False;
1867                   end if;
1868
1869                when Parameter_With_Optional_Space =>
1870                   if Parameter /= "" then
1871                      Callback (Switch, " ", Parameter, Index => Index);
1872                      Found_In_Config := True;
1873                      return False;
1874                   end if;
1875
1876                when Parameter_With_Space_Or_Equal =>
1877                   if Parameter /= "" then
1878                      Callback (Switch, "=", Parameter, Index => Index);
1879                      Found_In_Config := True;
1880                      return False;
1881                   end if;
1882
1883                when Parameter_No_Space =>
1884                   if Parameter /= "" then
1885                      Callback (Switch, "", Parameter, Index);
1886                      Found_In_Config := True;
1887                      return False;
1888                   end if;
1889
1890                when Parameter_Optional =>
1891                   Callback (Switch, "", Parameter, Index);
1892                   Found_In_Config := True;
1893                   return False;
1894             end case;
1895          end if;
1896
1897          return True;
1898       end Is_In_Config;
1899
1900       -----------------
1901       -- Starts_With --
1902       -----------------
1903
1904       function Starts_With
1905         (Config_Switch : String; Index : Integer) return Boolean
1906       is
1907          Last  : Natural;
1908          Param : Natural;
1909          P     : Switch_Parameter_Type;
1910
1911       begin
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.
1915
1916          Decompose_Switch (Config_Switch, P, Last);
1917
1918          if Looking_At
1919            (Switch, Switch'First, Config_Switch (Config_Switch'First .. Last))
1920          then
1921             --  Set first char of Param, and last char of Switch
1922
1923             Param := Switch'First + Last;
1924             Last  := Switch'First + Last - Config_Switch'First;
1925
1926             case P is
1927
1928                --  None is already handled in Is_In_Config
1929
1930                when Parameter_None =>
1931                   null;
1932
1933                when Parameter_With_Space_Or_Equal =>
1934                   if Param <= Switch'Last
1935                     and then
1936                       (Switch (Param) = ' ' or else Switch (Param) = '=')
1937                   then
1938                      Callback (Switch (Switch'First .. Last),
1939                                "=", Switch (Param + 1 .. Switch'Last), Index);
1940                      Found_In_Config := True;
1941                      return False;
1942                   end if;
1943
1944                when Parameter_With_Optional_Space =>
1945                   if Param <= Switch'Last and then Switch (Param) = ' '  then
1946                      Param := Param + 1;
1947                   end if;
1948
1949                   Callback (Switch (Switch'First .. Last),
1950                             " ", Switch (Param .. Switch'Last), Index);
1951                   Found_In_Config := True;
1952                   return False;
1953
1954                when Parameter_No_Space | Parameter_Optional =>
1955                   Callback (Switch (Switch'First .. Last),
1956                             "", Switch (Param .. Switch'Last), Index);
1957                   Found_In_Config := True;
1958                   return False;
1959             end case;
1960          end if;
1961          return True;
1962       end Starts_With;
1963
1964       procedure Foreach_In_Config is new Foreach_Switch (Is_In_Config);
1965       procedure Foreach_Starts_With is new Foreach_Switch (Starts_With);
1966
1967    --  Start of processing for For_Each_Simple_Switch
1968
1969    begin
1970       --  First determine if the switch corresponds to one belonging to the
1971       --  configuration. If so, run callback and exit.
1972
1973       Foreach_In_Config (Config, Section);
1974
1975       if Found_In_Config then
1976          return;
1977       end if;
1978
1979       --  If adding a switch that can in fact be expanded through aliases,
1980       --  add separately each of its expansions.
1981
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.
1986
1987       if Unalias
1988         and then Config /= null
1989         and then Config.Aliases /= null
1990       then
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 = ""
1995             then
1996                For_Each_Simple_Switch
1997                  (Config, Section, Config.Aliases (A).Expansion.all, "");
1998                return;
1999             end if;
2000          end loop;
2001       end if;
2002
2003       --  If adding a switch grouping several switches, add each of the simple
2004       --  switches instead.
2005
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
2009               and then Looking_At
2010                 (Switch, Switch'First, Config.Prefixes (P).all)
2011             then
2012                --  Alias expansion will be done recursively
2013
2014                if Config.Switches = null then
2015                   for S in Switch'First + Config.Prefixes (P)'Length
2016                             .. Switch'Last
2017                   loop
2018                      For_Each_Simple_Switch
2019                        (Config, Section,
2020                         Config.Prefixes (P).all & Switch (S), "");
2021                   end loop;
2022
2023                   return;
2024
2025                elsif Group_Analysis
2026                  (Config.Prefixes (P).all,
2027                   Switch
2028                     (Switch'First + Config.Prefixes (P)'Length .. Switch'Last))
2029                then
2030                   --  Recursive calls already done on each switch of the group:
2031                   --  Return without executing Callback.
2032                   return;
2033                end if;
2034             end if;
2035          end loop;
2036       end if;
2037
2038       --  Test if added switch is a known switch with parameter attached
2039       --  instead of being specified separately
2040
2041       if Parameter = ""
2042         and then Config /= null
2043         and then Config.Switches /= null
2044       then
2045          Found_In_Config := False;
2046          Foreach_Starts_With (Config, Section);
2047          if Found_In_Config then
2048             return;
2049          end if;
2050       end if;
2051
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
2054       --  all switches.
2055
2056       Callback (Switch, " ", Parameter, Index => -1);
2057    end For_Each_Simple_Switch;
2058
2059    ----------------
2060    -- Add_Switch --
2061    ----------------
2062
2063    procedure Add_Switch
2064      (Cmd        : in out Command_Line;
2065       Switch     : String;
2066       Parameter  : String    := "";
2067       Separator  : Character := ' ';
2068       Section    : String    := "";
2069       Add_Before : Boolean   := False)
2070    is
2071       Success : Boolean;
2072       pragma Unreferenced (Success);
2073    begin
2074       Add_Switch (Cmd, Switch, Parameter, Separator,
2075                   Section, Add_Before, Success);
2076    end Add_Switch;
2077
2078    ----------------
2079    -- Add_Switch --
2080    ----------------
2081
2082    procedure Add_Switch
2083      (Cmd        : in out Command_Line;
2084       Switch     : String;
2085       Parameter  : String := "";
2086       Separator  : Character := ' ';
2087       Section    : String := "";
2088       Add_Before : Boolean := False;
2089       Success    : out Boolean)
2090    is
2091       pragma Unreferenced (Separator);  --  ??? Should be removed eventually
2092
2093       procedure Add_Simple_Switch
2094         (Simple    : String;
2095          Separator : String;
2096          Param     : String;
2097          Index     : Integer);
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.
2100
2101       -----------------------
2102       -- Add_Simple_Switch --
2103       -----------------------
2104
2105       procedure Add_Simple_Switch
2106         (Simple    : String;
2107          Separator : String;
2108          Param     : String;
2109          Index     : Integer)
2110       is
2111          pragma Unreferenced (Index);
2112          Sep : Character;
2113
2114       begin
2115          if Separator = "" then
2116             Sep := ASCII.NUL;
2117          else
2118             Sep := Separator (Separator'First);
2119          end if;
2120
2121          if Cmd.Expanded = null then
2122             Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
2123
2124             if Param /= "" then
2125                Cmd.Params :=
2126                  new Argument_List'(1 .. 1 => new String'(Sep & Param));
2127             else
2128                Cmd.Params := new Argument_List'(1 .. 1 => null);
2129             end if;
2130
2131             if Section = "" then
2132                Cmd.Sections := new Argument_List'(1 .. 1 => null);
2133             else
2134                Cmd.Sections :=
2135                  new Argument_List'(1 .. 1 => new String'(Section));
2136             end if;
2137
2138          else
2139             --  Do we already have this switch?
2140
2141             for C in Cmd.Expanded'Range loop
2142                if Cmd.Expanded (C).all = Simple
2143                  and then
2144                    ((Cmd.Params (C) = null and then Param = "")
2145                      or else
2146                        (Cmd.Params (C) /= null
2147                          and then Cmd.Params (C).all = Sep & Param))
2148                  and then
2149                    ((Cmd.Sections (C) = null and then Section = "")
2150                      or else
2151                        (Cmd.Sections (C) /= null
2152                          and then Cmd.Sections (C).all = Section))
2153                then
2154                   return;
2155                end if;
2156             end loop;
2157
2158             --  Inserting at least one switch
2159
2160             Success := True;
2161             Add (Cmd.Expanded, new String'(Simple), Add_Before);
2162
2163             if Param /= "" then
2164                Add
2165                  (Cmd.Params,
2166                   new String'(Sep & Param),
2167                   Add_Before);
2168             else
2169                Add
2170                  (Cmd.Params,
2171                   null,
2172                   Add_Before);
2173             end if;
2174
2175             if Section = "" then
2176                Add
2177                  (Cmd.Sections,
2178                   null,
2179                   Add_Before);
2180             else
2181                Add
2182                  (Cmd.Sections,
2183                   new String'(Section),
2184                   Add_Before);
2185             end if;
2186          end if;
2187       end Add_Simple_Switch;
2188
2189       procedure Add_Simple_Switches is
2190         new For_Each_Simple_Switch (Add_Simple_Switch);
2191
2192       --  Local Variables
2193
2194       Section_Valid : Boolean := False;
2195
2196    --  Start of processing for Add_Switch
2197
2198    begin
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;
2203                exit;
2204             end if;
2205          end loop;
2206
2207          if not Section_Valid then
2208             raise Invalid_Section;
2209          end if;
2210       end if;
2211
2212       Success := False;
2213       Add_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2214       Free (Cmd.Coalesce);
2215    end Add_Switch;
2216
2217    ------------
2218    -- Remove --
2219    ------------
2220
2221    procedure Remove (Line : in out Argument_List_Access; Index : Integer) is
2222       Tmp : Argument_List_Access := Line;
2223
2224    begin
2225       Line := new Argument_List (Tmp'First .. Tmp'Last - 1);
2226
2227       if Index /= Tmp'First then
2228          Line (Tmp'First .. Index - 1) := Tmp (Tmp'First .. Index - 1);
2229       end if;
2230
2231       Free (Tmp (Index));
2232
2233       if Index /= Tmp'Last then
2234          Line (Index .. Tmp'Last - 1) := Tmp (Index + 1 .. Tmp'Last);
2235       end if;
2236
2237       Unchecked_Free (Tmp);
2238    end Remove;
2239
2240    ---------
2241    -- Add --
2242    ---------
2243
2244    procedure Add
2245      (Line   : in out Argument_List_Access;
2246       Str    : String_Access;
2247       Before : Boolean := False)
2248    is
2249       Tmp : Argument_List_Access := Line;
2250
2251    begin
2252       if Tmp /= null then
2253          Line := new Argument_List (Tmp'First .. Tmp'Last + 1);
2254
2255          if Before then
2256             Line (Tmp'First)                     := Str;
2257             Line (Tmp'First + 1 .. Tmp'Last + 1) := Tmp.all;
2258          else
2259             Line (Tmp'Range)    := Tmp.all;
2260             Line (Tmp'Last + 1) := Str;
2261          end if;
2262
2263          Unchecked_Free (Tmp);
2264
2265       else
2266          Line := new Argument_List'(1 .. 1 => Str);
2267       end if;
2268    end Add;
2269
2270    -------------------
2271    -- Remove_Switch --
2272    -------------------
2273
2274    procedure Remove_Switch
2275      (Cmd           : in out Command_Line;
2276       Switch        : String;
2277       Remove_All    : Boolean := False;
2278       Has_Parameter : Boolean := False;
2279       Section       : String := "")
2280    is
2281       Success : Boolean;
2282       pragma Unreferenced (Success);
2283    begin
2284       Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success);
2285    end Remove_Switch;
2286
2287    -------------------
2288    -- Remove_Switch --
2289    -------------------
2290
2291    procedure Remove_Switch
2292      (Cmd           : in out Command_Line;
2293       Switch        : String;
2294       Remove_All    : Boolean := False;
2295       Has_Parameter : Boolean := False;
2296       Section       : String  := "";
2297       Success       : out Boolean)
2298    is
2299       procedure Remove_Simple_Switch
2300         (Simple, Separator, Param : String; Index : Integer);
2301       --  Removes a simple switch, with no aliasing or grouping
2302
2303       --------------------------
2304       -- Remove_Simple_Switch --
2305       --------------------------
2306
2307       procedure Remove_Simple_Switch
2308         (Simple, Separator, Param : String; Index : Integer)
2309       is
2310          C : Integer;
2311          pragma Unreferenced (Param, Separator, Index);
2312
2313       begin
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
2318                  and then
2319                    (Remove_All
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)
2325                then
2326                   Remove (Cmd.Expanded, C);
2327                   Remove (Cmd.Params, C);
2328                   Remove (Cmd.Sections, C);
2329                   Success := True;
2330
2331                   if not Remove_All then
2332                      return;
2333                   end if;
2334
2335                else
2336                   C := C + 1;
2337                end if;
2338             end loop;
2339          end if;
2340       end Remove_Simple_Switch;
2341
2342       procedure Remove_Simple_Switches is
2343         new For_Each_Simple_Switch (Remove_Simple_Switch);
2344
2345    --  Start of processing for Remove_Switch
2346
2347    begin
2348       Success := False;
2349       Remove_Simple_Switches
2350         (Cmd.Config, Section, Switch, "", Unalias => not Has_Parameter);
2351       Free (Cmd.Coalesce);
2352    end Remove_Switch;
2353
2354    -------------------
2355    -- Remove_Switch --
2356    -------------------
2357
2358    procedure Remove_Switch
2359      (Cmd       : in out Command_Line;
2360       Switch    : String;
2361       Parameter : String;
2362       Section   : String  := "")
2363    is
2364       procedure Remove_Simple_Switch
2365         (Simple, Separator, Param : String; Index : Integer);
2366       --  Removes a simple switch, with no aliasing or grouping
2367
2368       --------------------------
2369       -- Remove_Simple_Switch --
2370       --------------------------
2371
2372       procedure Remove_Simple_Switch
2373         (Simple, Separator, Param : String; Index : Integer)
2374       is
2375          pragma Unreferenced (Separator, Index);
2376          C : Integer;
2377
2378       begin
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
2383                  and then
2384                    ((Cmd.Sections (C) = null
2385                       and then Section = "")
2386                     or else
2387                       (Cmd.Sections (C) /= null
2388                         and then Section = Cmd.Sections (C).all))
2389                  and then
2390                    ((Cmd.Params (C) = null and then Param = "")
2391                       or else
2392                         (Cmd.Params (C) /= null
2393                            and then
2394
2395                            --  Ignore the separator stored in Parameter
2396
2397                              Cmd.Params (C) (Cmd.Params (C)'First + 1
2398                                              .. Cmd.Params (C)'Last) =
2399                            Param))
2400                then
2401                   Remove (Cmd.Expanded, C);
2402                   Remove (Cmd.Params, C);
2403                   Remove (Cmd.Sections, C);
2404
2405                   --  The switch is necessarily unique by construction of
2406                   --  Add_Switch.
2407
2408                   return;
2409
2410                else
2411                   C := C + 1;
2412                end if;
2413             end loop;
2414          end if;
2415       end Remove_Simple_Switch;
2416
2417       procedure Remove_Simple_Switches is
2418         new For_Each_Simple_Switch (Remove_Simple_Switch);
2419
2420    --  Start of processing for Remove_Switch
2421
2422    begin
2423       Remove_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
2424       Free (Cmd.Coalesce);
2425    end Remove_Switch;
2426
2427    --------------------
2428    -- Group_Switches --
2429    --------------------
2430
2431    procedure Group_Switches
2432      (Cmd      : Command_Line;
2433       Result   : Argument_List_Access;
2434       Sections : Argument_List_Access;
2435       Params   : Argument_List_Access)
2436    is
2437       function Compatible_Parameter (Param : String_Access) return Boolean;
2438       --  True when the parameter can be part of a group
2439
2440       --------------------------
2441       -- Compatible_Parameter --
2442       --------------------------
2443
2444       function Compatible_Parameter (Param : String_Access) return Boolean is
2445       begin
2446          --  No parameter OK
2447
2448          if Param = null then
2449             return True;
2450
2451          --  We need parameters without separators
2452
2453          elsif Param (Param'First) /= ASCII.NUL then
2454             return False;
2455
2456          --  Parameters must be all digits
2457
2458          else
2459             for J in Param'First + 1 .. Param'Last loop
2460                if Param (J) not in '0' .. '9' then
2461                   return False;
2462                end if;
2463             end loop;
2464
2465             return True;
2466          end if;
2467       end Compatible_Parameter;
2468
2469       --  Local declarations
2470
2471       Group : Ada.Strings.Unbounded.Unbounded_String;
2472       First : Natural;
2473       use type Ada.Strings.Unbounded.Unbounded_String;
2474
2475    --  Start of processing for Group_Switches
2476
2477    begin
2478       if Cmd.Config = null
2479         or else Cmd.Config.Prefixes = null
2480       then
2481          return;
2482       end if;
2483
2484       for P in Cmd.Config.Prefixes'Range loop
2485          Group   := Ada.Strings.Unbounded.Null_Unbounded_String;
2486          First   := 0;
2487
2488          for C in Result'Range loop
2489             if Result (C) /= null
2490               and then Compatible_Parameter (Params (C))
2491               and then Looking_At
2492                 (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
2493             then
2494                --  If we are still in the same section, group the switches
2495
2496                if First = 0
2497                  or else
2498                    (Sections (C) = null
2499                      and then Sections (First) = null)
2500                  or else
2501                    (Sections (C) /= null
2502                      and then Sections (First) /= null
2503                      and then Sections (C).all = Sections (First).all)
2504                then
2505                   Group :=
2506                     Group &
2507                       Result (C)
2508                         (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2509                          Result (C)'Last);
2510
2511                   if Params (C) /= null then
2512                      Group :=
2513                        Group &
2514                          Params (C) (Params (C)'First + 1 .. Params (C)'Last);
2515                      Free (Params (C));
2516                   end if;
2517
2518                   if First = 0 then
2519                      First := C;
2520                   end if;
2521
2522                   Free (Result (C));
2523
2524                --  We changed section: we put the grouped switches to the first
2525                --  place, on continue with the new section.
2526
2527                else
2528                   Result (First) :=
2529                     new String'
2530                       (Cmd.Config.Prefixes (P).all &
2531                        Ada.Strings.Unbounded.To_String (Group));
2532                   Group :=
2533                     Ada.Strings.Unbounded.To_Unbounded_String
2534                       (Result (C)
2535                        (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
2536                             Result (C)'Last));
2537                   First := C;
2538                end if;
2539             end if;
2540          end loop;
2541
2542          if First > 0 then
2543             Result (First) :=
2544               new String'
2545                 (Cmd.Config.Prefixes (P).all &
2546                  Ada.Strings.Unbounded.To_String (Group));
2547          end if;
2548       end loop;
2549    end Group_Switches;
2550
2551    --------------------
2552    -- Alias_Switches --
2553    --------------------
2554
2555    procedure Alias_Switches
2556      (Cmd    : Command_Line;
2557       Result : Argument_List_Access;
2558       Params : Argument_List_Access)
2559    is
2560       Found : Boolean;
2561       First : Natural;
2562
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.
2568
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
2572
2573       --------------
2574       -- Check_Cb --
2575       --------------
2576
2577       procedure Check_Cb
2578         (Switch, Separator, Param : String; Index : Integer)
2579       is
2580          pragma Unreferenced (Separator, Index);
2581
2582       begin
2583          if Found then
2584             for E in Result'Range loop
2585                if Result (E) /= null
2586                  and then
2587                    (Params (E) = null
2588                     or else Params (E) (Params (E)'First + 1
2589                                             .. Params (E)'Last) = Param)
2590                  and then Result (E).all = Switch
2591                then
2592                   return;
2593                end if;
2594             end loop;
2595
2596             Found := False;
2597          end if;
2598       end Check_Cb;
2599
2600       ---------------
2601       -- Remove_Cb --
2602       ---------------
2603
2604       procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer)
2605       is
2606          pragma Unreferenced (Separator, Index);
2607
2608       begin
2609          for E in Result'Range loop
2610             if Result (E) /= null
2611                  and then
2612                    (Params (E) = null
2613                      or else Params (E) (Params (E)'First + 1
2614                                              .. Params (E)'Last) = Param)
2615               and then Result (E).all = Switch
2616             then
2617                if First > E then
2618                   First := E;
2619                end if;
2620
2621                Free (Result (E));
2622                Free (Params (E));
2623                return;
2624             end if;
2625          end loop;
2626       end Remove_Cb;
2627
2628       procedure Check_All is new For_Each_Simple_Switch (Check_Cb);
2629       procedure Remove_All is new For_Each_Simple_Switch (Remove_Cb);
2630
2631    --  Start of processing for Alias_Switches
2632
2633    begin
2634       if Cmd.Config = null
2635         or else Cmd.Config.Aliases = null
2636       then
2637          return;
2638       end if;
2639
2640       for A in Cmd.Config.Aliases'Range loop
2641
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.
2645
2646          Found := True;
2647          Check_All (Cmd.Config,
2648                     Switch  => Cmd.Config.Aliases (A).Expansion.all,
2649                     Section => Cmd.Config.Aliases (A).Section.all);
2650
2651          if Found then
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);
2657          end if;
2658       end loop;
2659    end Alias_Switches;
2660
2661    -------------------
2662    -- Sort_Sections --
2663    -------------------
2664
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)
2669    is
2670       Sections_List : Argument_List_Access :=
2671                         new Argument_List'(1 .. 1 => null);
2672       Found         : Boolean;
2673       Old_Line      : constant Argument_List := Line.all;
2674       Old_Sections  : constant Argument_List := Sections.all;
2675       Old_Params    : constant Argument_List := Params.all;
2676       Index         : Natural;
2677
2678    begin
2679       if Line = null then
2680          return;
2681       end if;
2682
2683       --  First construct a list of all sections
2684
2685       for E in Line'Range loop
2686          if Sections (E) /= null then
2687             Found := False;
2688             for S in Sections_List'Range loop
2689                if (Sections_List (S) = null and then Sections (E) = null)
2690                  or else
2691                    (Sections_List (S) /= null
2692                      and then Sections (E) /= null
2693                      and then Sections_List (S).all = Sections (E).all)
2694                then
2695                   Found := True;
2696                   exit;
2697                end if;
2698             end loop;
2699
2700             if not Found then
2701                Add (Sections_List, Sections (E));
2702             end if;
2703          end if;
2704       end loop;
2705
2706       Index := Line'First;
2707
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)
2711               or else
2712                 (Sections_List (S) /= null
2713                   and then Old_Sections (E) /= null
2714                   and then Sections_List (S).all = Old_Sections (E).all)
2715             then
2716                Line (Index) := Old_Line (E);
2717                Sections (Index) := Old_Sections (E);
2718                Params (Index) := Old_Params (E);
2719                Index := Index + 1;
2720             end if;
2721          end loop;
2722       end loop;
2723
2724       Unchecked_Free (Sections_List);
2725    end Sort_Sections;
2726
2727    -----------
2728    -- Start --
2729    -----------
2730
2731    procedure Start
2732      (Cmd      : in out Command_Line;
2733       Iter     : in out Command_Line_Iterator;
2734       Expanded : Boolean := False)
2735    is
2736    begin
2737       if Cmd.Expanded = null then
2738          Iter.List := null;
2739          return;
2740       end if;
2741
2742       --  Reorder the expanded line so that sections are grouped
2743
2744       Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
2745
2746       --  Coalesce the switches as much as possible
2747
2748       if not Expanded
2749         and then Cmd.Coalesce = null
2750       then
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);
2754          end loop;
2755
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));
2762          end loop;
2763
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));
2770          end loop;
2771
2772          --  Not a clone, since we will not modify the parameters anyway
2773
2774          Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Params);
2775          Group_Switches
2776            (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Coalesce_Params);
2777       end if;
2778
2779       if Expanded then
2780          Iter.List     := Cmd.Expanded;
2781          Iter.Params   := Cmd.Params;
2782          Iter.Sections := Cmd.Sections;
2783       else
2784          Iter.List     := Cmd.Coalesce;
2785          Iter.Params   := Cmd.Coalesce_Params;
2786          Iter.Sections := Cmd.Coalesce_Sections;
2787       end if;
2788
2789       if Iter.List = null then
2790          Iter.Current := Integer'Last;
2791       else
2792          Iter.Current := Iter.List'First;
2793
2794          while Iter.Current <= Iter.List'Last
2795            and then Iter.List (Iter.Current) = null
2796          loop
2797             Iter.Current := Iter.Current + 1;
2798          end loop;
2799       end if;
2800    end Start;
2801
2802    --------------------
2803    -- Current_Switch --
2804    --------------------
2805
2806    function Current_Switch (Iter : Command_Line_Iterator) return String is
2807    begin
2808       return Iter.List (Iter.Current).all;
2809    end Current_Switch;
2810
2811    --------------------
2812    -- Is_New_Section --
2813    --------------------
2814
2815    function Is_New_Section    (Iter : Command_Line_Iterator) return Boolean is
2816       Section : constant String := Current_Section (Iter);
2817    begin
2818       if Iter.Sections = null then
2819          return False;
2820       elsif Iter.Current = Iter.Sections'First
2821         or else Iter.Sections (Iter.Current - 1) = null
2822       then
2823          return Section /= "";
2824       end if;
2825
2826       return Section /= Iter.Sections (Iter.Current - 1).all;
2827    end Is_New_Section;
2828
2829    ---------------------
2830    -- Current_Section --
2831    ---------------------
2832
2833    function Current_Section (Iter : Command_Line_Iterator) return String is
2834    begin
2835       if Iter.Sections = null
2836         or else Iter.Current > Iter.Sections'Last
2837         or else Iter.Sections (Iter.Current) = null
2838       then
2839          return "";
2840       end if;
2841
2842       return Iter.Sections (Iter.Current).all;
2843    end Current_Section;
2844
2845    -----------------------
2846    -- Current_Separator --
2847    -----------------------
2848
2849    function Current_Separator (Iter : Command_Line_Iterator) return String is
2850    begin
2851       if Iter.Params = null
2852         or else Iter.Current > Iter.Params'Last
2853         or else Iter.Params (Iter.Current) = null
2854       then
2855          return "";
2856
2857       else
2858          declare
2859             Sep : constant Character :=
2860               Iter.Params (Iter.Current) (Iter.Params (Iter.Current)'First);
2861          begin
2862             if Sep = ASCII.NUL then
2863                return "";
2864             else
2865                return "" & Sep;
2866             end if;
2867          end;
2868       end if;
2869    end Current_Separator;
2870
2871    -----------------------
2872    -- Current_Parameter --
2873    -----------------------
2874
2875    function Current_Parameter (Iter : Command_Line_Iterator) return String is
2876    begin
2877       if Iter.Params = null
2878         or else Iter.Current > Iter.Params'Last
2879         or else Iter.Params (Iter.Current) = null
2880       then
2881          return "";
2882
2883       else
2884          declare
2885             P : constant String := Iter.Params (Iter.Current).all;
2886
2887          begin
2888             --  Skip separator
2889
2890             return P (P'First + 1 .. P'Last);
2891          end;
2892       end if;
2893    end Current_Parameter;
2894
2895    --------------
2896    -- Has_More --
2897    --------------
2898
2899    function Has_More (Iter : Command_Line_Iterator) return Boolean is
2900    begin
2901       return Iter.List /= null and then Iter.Current <= Iter.List'Last;
2902    end Has_More;
2903
2904    ----------
2905    -- Next --
2906    ----------
2907
2908    procedure Next (Iter : in out Command_Line_Iterator) is
2909    begin
2910       Iter.Current := Iter.Current + 1;
2911       while Iter.Current <= Iter.List'Last
2912         and then Iter.List (Iter.Current) = null
2913       loop
2914          Iter.Current := Iter.Current + 1;
2915       end loop;
2916    end Next;
2917
2918    ----------
2919    -- Free --
2920    ----------
2921
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);
2927    begin
2928       if Config /= null then
2929          Free (Config.Prefixes);
2930          Free (Config.Sections);
2931          Free (Config.Usage);
2932          Free (Config.Help);
2933
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);
2939             end loop;
2940             Unchecked_Free (Config.Aliases);
2941          end if;
2942
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);
2949             end loop;
2950
2951             Unchecked_Free (Config.Switches);
2952          end if;
2953
2954          Unchecked_Free (Config);
2955       end if;
2956    end Free;
2957
2958    ----------
2959    -- Free --
2960    ----------
2961
2962    procedure Free (Cmd : in out Command_Line) is
2963    begin
2964       Free (Cmd.Expanded);
2965       Free (Cmd.Coalesce);
2966       Free (Cmd.Coalesce_Sections);
2967       Free (Cmd.Coalesce_Params);
2968       Free (Cmd.Params);
2969       Free (Cmd.Sections);
2970    end Free;
2971
2972    ---------------
2973    -- Set_Usage --
2974    ---------------
2975
2976    procedure Set_Usage
2977      (Config : in out Command_Line_Configuration;
2978       Usage  : String := "[switches] [arguments]";
2979       Help   : String := "")
2980    is
2981    begin
2982       if Config = null then
2983          Config := new Command_Line_Configuration_Record;
2984       end if;
2985
2986       Free (Config.Usage);
2987       Config.Usage := new String'(Usage);
2988       Config.Help  := new String'(Help);
2989    end Set_Usage;
2990
2991    ------------------
2992    -- Display_Help --
2993    ------------------
2994
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.
3001
3002       function Param_Name
3003         (P    : Switch_Parameter_Type;
3004          Name : String := "ARG") return String;
3005       --  Return the display for a switch parameter
3006
3007       procedure Display_Section_Help (Section : String);
3008       --  Display the help for a specific section ("" is the default section)
3009
3010       --------------------------
3011       -- Display_Section_Help --
3012       --------------------------
3013
3014       procedure Display_Section_Help (Section : String) is
3015          Max_Len : Natural := 0;
3016       begin
3017          --  ??? Special display for "*"
3018
3019          New_Line;
3020
3021          if Section /= "" then
3022             Put_Line ("Switches after " & Section);
3023          end if;
3024
3025          --  Compute size of the switches column
3026
3027          for S in Config.Switches'Range loop
3028             Max_Len := Natural'Max
3029               (Max_Len, Switch_Name (Config.Switches (S), Section)'Length);
3030          end loop;
3031
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);
3037                end if;
3038             end loop;
3039          end if;
3040
3041          --  Display the switches
3042
3043          for S in Config.Switches'Range loop
3044             declare
3045                N : constant String :=
3046                  Switch_Name (Config.Switches (S), Section);
3047             begin
3048                if N /= "" then
3049                   Put (" ");
3050                   Put (N);
3051                   Put ((1 .. Max_Len - N'Length + 1 => ' '));
3052
3053                   if Config.Switches (S).Help /= null then
3054                      Put (Config.Switches (S).Help.all);
3055                   end if;
3056
3057                   New_Line;
3058                end if;
3059             end;
3060          end loop;
3061
3062          --  Display the aliases
3063
3064          if Config.Aliases /= null then
3065             for A in Config.Aliases'Range loop
3066                if Config.Aliases (A).Section.all = Section then
3067                   Put (" ");
3068                   Put (Config.Aliases (A).Alias.all);
3069                   Put ((1 .. Max_Len - Config.Aliases (A).Alias'Length + 1
3070                        => ' '));
3071                   Put ("Equivalent to " & Config.Aliases (A).Expansion.all);
3072                   New_Line;
3073                end if;
3074             end loop;
3075          end if;
3076       end Display_Section_Help;
3077
3078       ----------------
3079       -- Param_Name --
3080       ----------------
3081
3082       function Param_Name
3083         (P    : Switch_Parameter_Type;
3084          Name : String := "ARG") return String
3085       is
3086       begin
3087          case P is
3088             when Parameter_None =>
3089                return "";
3090
3091             when Parameter_With_Optional_Space =>
3092                return " " & To_Upper (Name);
3093
3094             when Parameter_With_Space_Or_Equal =>
3095                return "=" & To_Upper (Name);
3096
3097             when Parameter_No_Space =>
3098                return To_Upper (Name);
3099
3100             when Parameter_Optional =>
3101                return '[' & To_Upper (Name) & ']';
3102          end case;
3103       end Param_Name;
3104
3105       -----------------
3106       -- Switch_Name --
3107       -----------------
3108
3109       function Switch_Name
3110         (Def : Switch_Definition;
3111          Section : String) return String
3112       is
3113          use Ada.Strings.Unbounded;
3114          Result       : Unbounded_String;
3115          P1, P2       : Switch_Parameter_Type;
3116          Last1, Last2 : Integer := 0;
3117
3118       begin
3119          if (Section = "" and then Def.Section = null)
3120            or else (Def.Section /= null and then Def.Section.all = Section)
3121          then
3122             if Def.Switch /= null
3123               and then Def.Switch.all = "*"
3124             then
3125                return "[any switch]";
3126             end if;
3127
3128             if Def.Switch /= null then
3129                Decompose_Switch (Def.Switch.all, P1, Last1);
3130                Append (Result, Def.Switch (Def.Switch'First .. Last1));
3131
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"));
3137
3138                else
3139                   Append (Result, Param_Name (P1, "ARG"));
3140                end if;
3141
3142             else  --  Long_Switch necessarily not null
3143                Decompose_Switch (Def.Long_Switch.all, P2, Last2);
3144                Append (Result,
3145                        Def.Long_Switch (Def.Long_Switch'First .. Last2));
3146                Append (Result, Param_Name (P2, "ARG"));
3147             end if;
3148          end if;
3149
3150          return To_String (Result);
3151       end Switch_Name;
3152
3153    --  Start of processing for Display_Help
3154
3155    begin
3156       if Config = null then
3157          return;
3158       end if;
3159
3160       if Config.Usage /= null then
3161          Put_Line ("Usage: "
3162                    & Base_Name
3163                      (Ada.Command_Line.Command_Name) & " " & Config.Usage.all);
3164       else
3165          Put_Line ("Usage: " & Base_Name (Ada.Command_Line.Command_Name)
3166                    & " [switches] [arguments]");
3167       end if;
3168
3169       if Config.Help /= null and then Config.Help.all /= "" then
3170          Put_Line (Config.Help.all);
3171       end if;
3172
3173       Display_Section_Help ("");
3174
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);
3178          end loop;
3179       end if;
3180    end Display_Help;
3181
3182    ------------
3183    -- Getopt --
3184    ------------
3185
3186    procedure Getopt
3187      (Config   : Command_Line_Configuration;
3188       Callback : Switch_Handler := null;
3189       Parser   : Opt_Parser := Command_Line_Parser)
3190    is
3191       Getopt_Switches : String_Access;
3192       C   : Character := ASCII.NUL;
3193
3194       Empty_Name : aliased constant String := "";
3195       Current_Section : Integer := -1;
3196       Section_Name : not null access constant String := Empty_Name'Access;
3197
3198       procedure Simple_Callback
3199         (Simple_Switch : String;
3200          Separator     : String;
3201          Parameter     : String;
3202          Index         : Integer);
3203       --  Needs comments ???
3204
3205       procedure Do_Callback (Switch, Parameter : String; Index : Integer);
3206
3207       -----------------
3208       -- Do_Callback --
3209       -----------------
3210
3211       procedure Do_Callback (Switch, Parameter : String; Index : Integer) is
3212       begin
3213          --  Do automatic handling when possible
3214
3215          if Index /= -1 then
3216             case Config.Switches (Index).Typ is
3217                when Switch_Untyped =>
3218                   null;   --  no automatic handling
3219
3220                when Switch_Boolean =>
3221                   Config.Switches (Index).Boolean_Output.all :=
3222                     Config.Switches (Index).Boolean_Value;
3223                   return;
3224
3225                when Switch_Integer =>
3226                   begin
3227                      if Parameter = "" then
3228                         Config.Switches (Index).Integer_Output.all :=
3229                           Config.Switches (Index).Integer_Default;
3230                      else
3231                         Config.Switches (Index).Integer_Output.all :=
3232                           Integer'Value (Parameter);
3233                      end if;
3234                   exception
3235                      when Constraint_Error =>
3236                         raise Invalid_Parameter
3237                           with "Expected integer parameter for '"
3238                             & Switch & "'";
3239                   end;
3240
3241                when Switch_String =>
3242                   Free (Config.Switches (Index).String_Output.all);
3243                   Config.Switches (Index).String_Output.all :=
3244                     new String'(Parameter);
3245             end case;
3246          end if;
3247
3248          --  Otherwise calls the user callback if one was defined
3249
3250          if Callback /= null then
3251             Callback (Switch    => Switch,
3252                       Parameter => Parameter,
3253                       Section   => Section_Name.all);
3254          end if;
3255       end Do_Callback;
3256
3257       procedure For_Each_Simple
3258         is new For_Each_Simple_Switch (Simple_Callback);
3259
3260       ---------------------
3261       -- Simple_Callback --
3262       ---------------------
3263
3264       procedure Simple_Callback
3265         (Simple_Switch : String;
3266          Separator     : String;
3267          Parameter     : String;
3268          Index         : Integer)
3269       is
3270          pragma Unreferenced (Separator);
3271       begin
3272          Do_Callback (Switch    => Simple_Switch,
3273                       Parameter => Parameter,
3274                       Index     => Index);
3275       end Simple_Callback;
3276
3277    --  Start of processing for Getopt
3278
3279    begin
3280       --  Initialize sections
3281
3282       if Config.Sections = null then
3283          Config.Sections := new Argument_List'(1 .. 0 => null);
3284       end if;
3285
3286       Internal_Initialize_Option_Scan
3287         (Parser                   => Parser,
3288          Switch_Char              => Parser.Switch_Character,
3289          Stop_At_First_Non_Switch => Parser.Stop_At_First,
3290          Section_Delimiters       => Section_Delimiters (Config));
3291
3292       Getopt_Switches := new String'
3293         (Get_Switches (Config, Parser.Switch_Character, Section_Name.all)
3294          & " h -help");
3295
3296       --  Initialize output values for automatically handled switches
3297
3298       for S in Config.Switches'Range loop
3299          case Config.Switches (S).Typ is
3300             when Switch_Untyped =>
3301                null;   --  Nothing to do
3302
3303             when Switch_Boolean =>
3304                Config.Switches (S).Boolean_Output.all :=
3305                  not Config.Switches (S).Boolean_Value;
3306
3307             when Switch_Integer =>
3308                Config.Switches (S).Integer_Output.all :=
3309                  Config.Switches (S).Integer_Initial;
3310
3311             when Switch_String =>
3312                Config.Switches (S).String_Output.all := new String'("");
3313          end case;
3314       end loop;
3315
3316       --  For all sections, and all switches within those sections
3317
3318       loop
3319          C := Getopt (Switches    => Getopt_Switches.all,
3320                       Concatenate => True,
3321                       Parser      => Parser);
3322
3323          if C = '*' then
3324             --  Full_Switch already includes the leading '-'
3325
3326             Do_Callback (Switch    => Full_Switch (Parser),
3327                          Parameter => Parameter (Parser),
3328                          Index     => -1);
3329
3330          elsif C /= ASCII.NUL then
3331             if Full_Switch (Parser) = "h"
3332               or else Full_Switch (Parser) = "-help"
3333             then
3334                Display_Help (Config);
3335                raise Exit_From_Command_Line;
3336             end if;
3337
3338             --  Do switch expansion if needed
3339             For_Each_Simple
3340               (Config,
3341                Section   => Section_Name.all,
3342                Switch    => Parser.Switch_Character & Full_Switch (Parser),
3343                Parameter => Parameter (Parser));
3344
3345          else
3346             if Current_Section = -1 then
3347                Current_Section := Config.Sections'First;
3348             else
3349                Current_Section := Current_Section + 1;
3350             end if;
3351
3352             exit when Current_Section > Config.Sections'Last;
3353
3354             Section_Name := Config.Sections (Current_Section);
3355             Goto_Section (Section_Name.all, Parser);
3356
3357             Free (Getopt_Switches);
3358             Getopt_Switches := new String'
3359               (Get_Switches
3360                  (Config, Parser.Switch_Character, Section_Name.all));
3361          end if;
3362       end loop;
3363
3364       Free (Getopt_Switches);
3365
3366    exception
3367       when Invalid_Switch =>
3368          Free (Getopt_Switches);
3369
3370          --  Message inspired by "ls" on Unix
3371
3372          Put_Line (Standard_Error,
3373                    Base_Name (Ada.Command_Line.Command_Name)
3374                    & ": unrecognized option '"
3375                    & Parser.Switch_Character & Full_Switch (Parser)
3376                    & "'");
3377          Put_Line (Standard_Error,
3378                    "Try `"
3379                    & Base_Name (Ada.Command_Line.Command_Name)
3380                    & " --help` for more information.");
3381
3382          raise;
3383
3384       when others =>
3385          Free (Getopt_Switches);
3386          raise;
3387    end Getopt;
3388
3389    -----------
3390    -- Build --
3391    -----------
3392
3393    procedure Build
3394      (Line        : in out Command_Line;
3395       Args        : out GNAT.OS_Lib.Argument_List_Access;
3396       Expanded    : Boolean := False;
3397       Switch_Char : Character := '-')
3398    is
3399       Iter  : Command_Line_Iterator;
3400       Count : Natural := 0;
3401
3402    begin
3403       Start (Line, Iter, Expanded => Expanded);
3404       while Has_More (Iter) loop
3405          if Is_New_Section (Iter) then
3406             Count := Count + 1;
3407          end if;
3408
3409          Count := Count + 1;
3410          Next (Iter);
3411       end loop;
3412
3413       Args := new Argument_List (1 .. Count);
3414       Count := Args'First;
3415
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));
3421             Count := Count + 1;
3422          end if;
3423
3424          Args (Count) := new String'(Current_Switch (Iter)
3425                                      & Current_Separator (Iter)
3426                                      & Current_Parameter (Iter));
3427          Count := Count + 1;
3428          Next (Iter);
3429       end loop;
3430    end Build;
3431
3432 end GNAT.Command_Line;