1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
-- Topal: GPG/GnuPG and Alpine/Pine integration
-- Copyright (C) 2001--2008 Phillip J. Brooke
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3 as
-- published by the Free Software Foundation.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO;
package body Command_Line_Wrapper is
J : Integer := 1; -- A pointer into the argument list.
-- This deals with leading hyphens. As long as both have at least
-- one leading hyphen, then the leading hyphens will be treated as
-- the same.
function Compare (A, B : String) return Boolean is
-- Do A and B have hyphens?
AH, BH : Boolean := False;
-- Start points for A and B.
AS, BS : Integer;
begin
-- Get the start point, check for leading hyphen, advance past them.
AS := A'First;
AH := A(AS) = '-';
while A(AS) = '-' and AS <= A'Last loop
AS := AS + 1;
end loop;
-- Get the start point, check for leading hyphen, advance past them.
BS := B'First;
BH := B(BS) = '-';
while B(BS) = '-' and BS <= B'Last loop
BS := BS + 1;
end loop;
-- Now we can compare the remains....
return (AH = BH) and (A(AS..A'Last) = B(BS..B'Last));
end Compare;
-- Three functions for working through the command line.
-- The first only advances the pointer if the test was true.
-- Two forms, one taking a string, one taking a UBS_Array.
function Match (A : in String) return Boolean is
begin
if J <= Argument_Count then
if Compare(A, Argument(J)) then
J := J + 1;
return True;
else
return False;
end if;
else
raise Argument_Overrun;
return False; -- Never reached.
end if;
exception
when others =>
Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
"Exception raised in Command_Line_Wrapper.Match (A)");
raise;
end Match;
function Match (A : in UBS_Array) return Boolean is
A_Match : Boolean := False;
begin
if J <= Argument_Count then
for I in A'First .. A'Last loop
A_Match := A_Match or Compare(ToStr(A(I)), Argument(J));
end loop;
if A_Match then
J := J + 1;
return True;
else
return False;
end if;
else
raise Argument_Overrun;
return False; -- Never reached.
end if;
exception
when others =>
Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
"Exception raised in Command_Line_Wrapper.Match (B)");
raise;
end Match;
-- This second function always advances.
function Eat return UBS is
R : UBS;
begin
if J <= Argument_Count then
R := ToUBS(Argument(J));
J := J + 1;
return R;
else
raise Argument_Overrun;
return ToUBS(""); -- Never reached.
end if;
exception
when others =>
Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
"Exception raised in Command_Line_Wrapper.Eat");
raise;
end Eat;
-- This last function returns true if there is still something to read.
function More (Needed : Positive := 1) return Boolean is
begin
return J + Needed - 1 <= Argument_Count;
exception
when others =>
Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
"Exception raised in Command_Line_Wrapper.More");
raise;
end More;
-- Given J, the index of the first command line argument to drop into an
-- array, drop J, J+1, etc. into an array and return it.
function Eat_Remaining_Arguments return UBS_Array_Pointer is
-- The array we return starts at 1.
-- Command line index: J, J+1, ..., Argument_Count
-- Returned array index: 1, 2, ..., Argument_Count - J + 1
-- If I is the index into the return array index, then
-- I + J - 1 is the index into the command line index.
A : UBS_Array_Pointer;
begin
A := new UBS_Array(1..Argument_Count - J + 1);
for I in 1 .. Argument_Count - J + 1 loop
A(I) := ToUBS(Argument(I + J - 1));
end loop;
J := Argument_Count + 1;
return A;
exception
when others =>
Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
"Exception raised in Command_Line_Wrapper.Eat_Remaining_Arguments");
raise;
end Eat_Remaining_Arguments;
-- Display the current argument.
function Current return String is
begin
if J <= Argument_Count then
return Argument(J);
else
raise Argument_Overrun;
return ""; -- Never reached.
end if;
exception
when others =>
Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
"Exception raised in Command_Line_Wrapper.Current");
raise;
end Current;
end Command_Line_Wrapper;
|
