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
|
-- Topal: GPG/GnuPG and Alpine/Pine integration
-- Copyright (C) 2001--2010 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.Strings.Maps;
with Ada.Text_IO;
with Echo;
with Misc; use Misc;
package body CL_Menus is
function Menu (Numbered_Menu : in MNA;
Number_Word : in String := Default_Number_Word;
Prompt : in String := Default_Prompt;
Number_Trailword : in String := Default_Number_Trailword)
return CLM_Return is
use Ada.Strings.Maps;
use Ada.Text_IO;
CL_Menu_Page_Step : constant Natural := 8;
C : Character;
F : Integer := Numbered_Menu'First;
L : Integer := F + CL_Menu_Page_Step;
V : Integer;
-- Previous values of F and L.
PF, PL : Integer;
begin
Debug("+Menus.CL_Menu");
if Accept_Chars'Length /= Char_Words'Length
or Accept_Chars'First /= Char_Words'First then
raise Arrays_Not_Matched;
end if;
if L > Numbered_Menu'Last then
L := Numbered_Menu'Last;
end if;
-- Offset PF and PL so that we draw the choices initially.
PF := F + 1;
PL := L + 1;
Entry_Loop:
loop
if (PF /= F) or (PL /= L) then
Put(Rewrite_Menu_Prompt(Prompt));
Put_Line("Displaying choices "
& Trim_Leading_Spaces(Integer'Image(F))
& " to "
& Trim_Leading_Spaces(Integer'Image(L))
& " of "
& Trim_Leading_Spaces(Integer'Image(Numbered_Menu'First))
& " to "
& Trim_Leading_Spaces(Integer'Image(Numbered_Menu'Last))
& " (<,) page up (>.) page down ");
for I in F..L loop
Put_Line(Do_SGR(Config.UBS_Opts(Colour_Menu_Key))
& Integer'Image(I-F+1)
& Reset_SGR
& " - " & ToStr(Numbered_Menu(I)));
end loop;
PF := F;
PL := L;
end if;
Echo.Clear_Echo;
Debug("Menus.CL_Menu: About to Get_Immediate");
Get_Immediate(C);
Debug("Menus.CL_Menu: Got: `" & C & "'");
Echo.Set_Echo;
-- Now, run through the menu of characters.
if C = '<' or C = ',' then
F := F - CL_Menu_Page_Step;
if F < Numbered_Menu'First then
F := Numbered_Menu'First;
end if;
L := F + CL_Menu_Page_Step;
if L > Numbered_Menu'Last then
L := Numbered_Menu'Last;
end if;
elsif C = '>' or C = '.' then
L := L + CL_Menu_Page_Step;
if L > Numbered_Menu'Last then
L := Numbered_Menu'Last;
end if;
F := L - CL_Menu_Page_Step;
if F < Numbered_Menu'First then
F := Numbered_Menu'First;
end if;
else
begin
V := String_To_Integer(C & "") + F - 1;
if V >= Numbered_Menu'First and V <= Numbered_Menu'Last then
Put(Do_SGR(Config.UBS_Opts(Colour_Menu_Choice))
& Number_Word
& ToStr(Numbered_Menu(V))
& Number_Trailword
& Reset_SGR);
New_Line(2);
return CLM_Return'(Is_Num => True,
I => Index'First,
N => V);
end if;
exception
when String_Not_Integer =>
-- Silently ignore duff exchanges.
null;
end;
end if;
for I in Accept_Chars'Range loop
if Is_In(C, To_Set(ToStr(Accept_Chars(I)))) then
Put(Do_SGR(Config.UBS_Opts(Colour_Menu_Choice))
& ToStr(Char_Words(I))
& Reset_SGR);
New_Line(2);
return CLM_Return'(Is_Num => False,
I => I,
N => 0);
end if;
end loop;
end loop Entry_Loop;
exception
when others =>
ErrorNE("Problem in CL_Menu.Menu.");
raise;
end Menu;
end CL_Menus;
|
