15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Natools.Getopt_Long is a native Ada implementation of getopt_long() --
-- processor for command line arguments. --
-- --
-- This package is generic, and its only formal parameter is a descrete --
-- type supposed to cover all command-line flags, including a special value --
-- for non-flag command-line arguments. --
-- --
-- Option_Definitions objects hold the list of recognized flags. Flags can --
-- have a single-character short name or a multiple-character long name. --
-- Moreover, there is no limit to the number of flag names referring to the --
-- same Option_Id value. --
-- --
-- Once the Option_Definitions object has been filled with flags recognized --
-- by the client, the actual command-line arguments can be processed. --
-- Process subprogram uses an Option_Definitions objects and a callback --
-- procedure that is repeatedly called for each command-line flag and --
-- argument found in the command line. --
-- --
-- Process also optionally uses callbacks for error conditions, which --
-- allows the client application to recover from it and allow command-line --
-- processing to continue. If there is no error callback (null access), --
-- an Option_Error exception is raised. --
------------------------------------------------------------------------------
with Ada.Command_Line;
private with Ada.Containers.Indefinite_Ordered_Maps;
generic
type Option_Id is (<>);
package Natools.Getopt_Long is
pragma Preelaborate (Getopt_Long);
Option_Error : exception;
Null_Long_Name : constant String := "";
Null_Short_Name : constant Character := Character'Val (0);
|
|
<
|
|
<
<
>
>
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
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
|
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Natools.Getopt_Long is a native Ada implementation of getopt_long() --
-- processor for command line arguments. --
-- --
-- This package is generic, and its only formal parameter is a descrete --
-- type supposed to cover all command-line options. --
-- --
-- Option_Definitions objects hold the list of recognized flags. Flags can --
-- have a single-character short name or a multiple-character long name. --
-- Moreover, there is no limit to the number of flag names referring to the --
-- same Option_Id value. --
-- --
-- Once the Option_Definitions object has been filled with flags recognized --
-- by the client, the actual command-line arguments can be processed, --
-- using the handler callbacks from a Handlers.Callback'Class object. --
-- --
-- Callback subprograms for normal operation are Option, for command-line --
-- flags identified by their Option_Id, and Argument, for top-level command --
-- line arguments. There are also callbacks for error conditions (missing --
-- or unexpected argument, unknown option), whose implementation in --
-- Handlers.Callback are simply to raise Option_Error with an appropriate --
-- message. --
------------------------------------------------------------------------------
with Ada.Command_Line;
private with Ada.Containers.Indefinite_Ordered_Maps;
generic
type Option_Id is (<>);
package Natools.Getopt_Long is
pragma Preelaborate (Getopt_Long);
Null_Long_Name : constant String := "";
Null_Short_Name : constant Character := Character'Val (0);
------------------------------------------
-- Holder for both short and long names --
------------------------------------------
type Name_Style is (Long, Short);
type Any_Name (Style : Name_Style; Size : Positive) is record
case Style is
when Short =>
Short : Character;
when Long =>
Long : String (1 .. Size);
end case;
end record;
function To_Name (Long_Name : String) return Any_Name;
function To_Name (Short_Name : Character) return Any_Name;
function Image (Name : Any_Name) return String;
------------------------
-- Callback interface --
------------------------
Option_Error : exception;
package Handlers is
type Callback is abstract tagged null record;
procedure Option
(Handler : in out Callback;
Id : Option_Id;
Argument : String)
is abstract;
-- Callback for successfully-parsed options.
procedure Argument
(Handler : in out Callback;
Argument : String)
is abstract;
-- Callback for non-flag arguments.
procedure Missing_Argument
(Handler : in out Callback;
Id : Option_Id;
Name : Any_Name);
-- Raise Option_Error (default error handler).
procedure Unexpected_Argument
(Handler : in out Callback;
Id : Option_Id;
Name : Any_Name;
Argument : String);
-- Raise Option_Error (default error handler).
procedure Unknown_Option
(Handler : in out Callback;
Name : Any_Name);
-- Raise Option_Error (default error handler).
end Handlers;
---------------------
-- Option database --
---------------------
type Argument_Requirement is
(No_Argument, Required_Argument, Optional_Argument);
type Option_Definitions is tagged private;
procedure Add_Option
(Options : in out Option_Definitions;
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
-- Iterate over all options, starting with options having a short name,
-- followed by options having only a long name, sorted respectively by
-- short and long name.
-- Process is called for each option; for options lacking a long name,
-- Long_Name is "", and for options lacking a short name, Short_Name
-- is Character'Val (0).
procedure Process
(Options : Option_Definitions;
Top_Level_Argument : Option_Id;
Callback : not null access procedure (Id : Option_Id;
Argument : String);
Missing_Argument : access procedure (Id : Option_Id) := null;
Unexpected_Argument : access procedure (Id : Option_Id;
Arg : String) := null;
Unknown_Long_Option : access procedure (Name : String) := null;
Unknown_Short_Option : access procedure (Name : Character) := null;
-- definitions. Callback is called for each identified option with its
-- idea and the option argument if any, or the empty string otherwise.
-- When encountering a command-line argument not attached to an option,
-- Callback is called with Top_Level_Argument and the argument string.
-- When encontering an option missing a required argument or an unkonwn
-- option name, the relevant callback is called if not null, otherwise
-- Option_Error is raised.
private
type Option (Long_Name_Length : Natural) is record
Id : Option_Id;
Has_Arg : Argument_Requirement;
Long_Name : String (1 .. Long_Name_Length);
|
>
>
>
>
>
>
<
|
<
<
<
<
<
<
|
<
<
<
<
<
<
|
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
|
-- Iterate over all options, starting with options having a short name,
-- followed by options having only a long name, sorted respectively by
-- short and long name.
-- Process is called for each option; for options lacking a long name,
-- Long_Name is "", and for options lacking a short name, Short_Name
-- is Character'Val (0).
--------------------------------------
-- Command line argument processing --
--------------------------------------
procedure Process
(Options : Option_Definitions;
Handler : in out Handlers.Callback'Class;
Posixly_Correct : Boolean := True;
Long_Only : Boolean := False;
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);
-- Process system command line argument list, using the provided option
-- definitions and handler callbacks.
private
type Option (Long_Name_Length : Natural) is record
Id : Option_Id;
Has_Arg : Argument_Requirement;
Long_Name : String (1 .. Long_Name_Length);
|