98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
begin
raise Option_Error with "Unknown option " & Image (Name);
end Unknown_Option;
end Handlers;
----------------------------
-- Option list management --
----------------------------
procedure Add_Option
(Config : in out Configuration;
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
begin
raise Option_Error with "Unknown option " & Image (Name);
end Unknown_Option;
end Handlers;
-------------------------------------
-- Simple configuration parameters --
-------------------------------------
function Posixly_Correct (Config : Configuration) return Boolean is
begin
return Config.Posixly_Correct;
end Posixly_Correct;
procedure Posixly_Correct
(Config : in out Configuration;
To : Boolean := True) is
begin
Config.Posixly_Correct := To;
end Posixly_Correct;
function Long_Only (Config : Configuration) return Boolean is
begin
return Config.Long_Only;
end Long_Only;
procedure Use_Long_Only
(Config : in out Configuration;
Value : Boolean := True) is
begin
Config.Long_Only := Value;
end Use_Long_Only;
----------------------------
-- Option list management --
----------------------------
procedure Add_Option
(Config : in out Configuration;
|
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
|
-----------------------------
-- Command-line processing --
-----------------------------
procedure Process
(Config : Configuration;
Handler : in out Handlers.Callback'Class;
Posixly_Correct : Boolean := True;
Long_Only : Boolean := False;
|
<
<
|
504
505
506
507
508
509
510
511
512
513
514
515
516
517
|
-----------------------------
-- Command-line processing --
-----------------------------
procedure Process
(Config : Configuration;
Handler : in out Handlers.Callback'Class;
Argument_Count : not null access function return Natural
:= Ada.Command_Line.Argument_Count'Access;
Argument : not null access function (Number : Positive) return String
:= Ada.Command_Line.Argument'Access)
is
procedure Process_Long_Option (Arg : String);
|
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
|
while Arg_N <= Arg_Count loop
declare
Arg : constant String := Argument (Arg_N);
begin
if Arg'Length <= 1 or else Arg (Arg'First) /= '-' then
-- This is a non-flag argument, abort option processing if
-- posixly correct.
if Posixly_Correct then
exit;
else
Handler.Argument (Arg);
Arg_N := Arg_N + 1;
end if;
elsif Arg (Arg'First + 1) = '-' then
-- "--" stops option processing.
if Arg'Length = 2 then
Arg_N := Arg_N + 1;
exit;
end if;
-- Argument starting with "--": long option.
Process_Long_Option (Arg (Arg'First + 2 .. Arg'Last));
Arg_N := Arg_N + 1;
elsif Long_Only then
-- Force long option on a single dash prefix.
Process_Long_Option (Arg (Arg'First + 1 .. Arg'Last));
Arg_N := Arg_N + 1;
else
-- Process a list of short options, until one with required
-- argument is encountered (and the rest is its argument).
for Arg_I in Arg'First + 1 .. Arg'Last loop
|
|
|
|
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
|
while Arg_N <= Arg_Count loop
declare
Arg : constant String := Argument (Arg_N);
begin
if Arg'Length <= 1 or else Arg (Arg'First) /= '-' then
-- This is a non-flag argument, abort option processing if
-- posixly correct.
if Config.Posixly_Correct then
exit;
else
Handler.Argument (Arg);
Arg_N := Arg_N + 1;
end if;
elsif Arg (Arg'First + 1) = '-' then
-- "--" stops option processing.
if Arg'Length = 2 then
Arg_N := Arg_N + 1;
exit;
end if;
-- Argument starting with "--": long option.
Process_Long_Option (Arg (Arg'First + 2 .. Arg'Last));
Arg_N := Arg_N + 1;
elsif Config.Long_Only then
-- Force long option on a single dash prefix.
Process_Long_Option (Arg (Arg'First + 1 .. Arg'Last));
Arg_N := Arg_N + 1;
else
-- Process a list of short options, until one with required
-- argument is encountered (and the rest is its argument).
for Arg_I in Arg'First + 1 .. Arg'Last loop
|