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
|
-- `Topal': GPG/Pine integration
--
-- Copyright (C) 2001,2002 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 as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- 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, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
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.
-- 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 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 (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;
|
