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
|
-- 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.Exceptions;
with Ada.Strings.Maps;
with Ada.Text_IO;
with Echo;
with Misc; use Misc;
package body Char_Menus is
function Menu (Prompt : in String := Default_Prompt) return Index is
use Ada.Strings.Maps;
use Ada.Text_IO;
C : Character;
begin
Debug("+Char_Menu.Menu");
if Accept_Chars'Length /= Char_Words'Length
or Accept_Chars'First /= Char_Words'First then
raise Arrays_Not_Matched;
end if;
if Config.Boolean_Opts(Debug) then
Debug("Char_Menu.Menu: Prompt is `" & Prompt & "'");
begin
for I in Accept_Chars'Range loop
Debug("Char_Menu.Menu: Group "
& Index'Image(I)
& " Accept_Chars=`" & ToStr(Accept_Chars(I)) & "'");
end loop;
exception
when The_Exception : others =>
Debug("Exception raised in Accept_Chars bit: "
& Ada.Exceptions.Exception_Name(The_Exception));
end;
begin
for I in Char_Words'Range loop
Debug("Char_Menu.Menu: Group "
& Index'Image(I)
& " Char_Words=`" & ToStr(Char_Words(I)) & "'");
end loop;
exception
when The_Exception : others =>
Debug("Exception raised in Char_Words bit: "
& Ada.Exceptions.Exception_Name(The_Exception));
end;
end if;
Put(Rewrite_Menu_Prompt(Prompt));
Entry_Loop:
loop
Echo.Clear_Echo;
Debug("Menu.Char_Menu: About to Get_Immediate");
Get_Immediate(C);
Debug("Menu.Char_Menu: Got: `" & C
& "' value " & Integer'Image(Character'Pos(C)));
Echo.Set_Echo;
-- Now, run through the menu.
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);
Debug("-Char_Menu.Menu with value "
& Index'Image(I)
& " for character `"
& C & "'");
return I;
end if;
end loop;
Debug("Menu.Char_Menu: No match for character `" & C & "'");
end loop Entry_Loop;
exception
when others =>
ErrorNE("Char_Menu.Menu: In exception handler. Re-raising.");
raise;
return Index'First; -- Never executed.
end Menu;
end Char_Menus;
|
