aboutsummaryrefslogtreecommitdiff
path: root/Ada95/src/terminal_interface-curses-menus.adb
diff options
context:
space:
mode:
authorBaptiste Daroussin <bapt@FreeBSD.org>2020-02-07 08:36:41 +0000
committerBaptiste Daroussin <bapt@FreeBSD.org>2020-02-07 08:36:41 +0000
commitf0179cb6083cc92e5947ae56e6a0a5c5328aead0 (patch)
treebcee0ba9c2149b71f0bfc036df1e61e3105bf980 /Ada95/src/terminal_interface-curses-menus.adb
parentcea297eb34d2361e79529034397465068ae34ecd (diff)
downloadsrc-f0179cb6083cc92e5947ae56e6a0a5c5328aead0.tar.gz
src-f0179cb6083cc92e5947ae56e6a0a5c5328aead0.zip
Vendor import ncurses 6.1-20200118vendor/ncurses/6.1-20200118
Notes
Notes: svn path=/vendor/ncurses/dist/; revision=357645 svn path=/vendor/ncurses/6.1-20200118/; revision=357646; tag=vendor/ncurses/6.1-20200118
Diffstat (limited to 'Ada95/src/terminal_interface-curses-menus.adb')
-rw-r--r--Ada95/src/terminal_interface-curses-menus.adb347
1 files changed, 114 insertions, 233 deletions
diff --git a/Ada95/src/terminal_interface-curses-menus.adb b/Ada95/src/terminal_interface-curses-menus.adb
index a7dca07c2876..fc840e2a978f 100644
--- a/Ada95/src/terminal_interface-curses-menus.adb
+++ b/Ada95/src/terminal_interface-curses-menus.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2014,2018 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.28 $
--- $Date: 2011/03/22 23:38:12 $
+-- $Revision: 1.33 $
+-- $Date: 2018/07/07 23:36:44 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
@@ -46,33 +46,14 @@ with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Interfaces.C.Pointers;
-with Ada.Unchecked_Conversion;
-
package body Terminal_Interface.Curses.Menus is
type C_Item_Array is array (Natural range <>) of aliased Item;
package I_Array is new
Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item);
- use type System.Bit_Order;
subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
- function MOS_2_CInt is new
- Ada.Unchecked_Conversion (Menu_Option_Set,
- C_Int);
-
- function CInt_2_MOS is new
- Ada.Unchecked_Conversion (C_Int,
- Menu_Option_Set);
-
- function IOS_2_CInt is new
- Ada.Unchecked_Conversion (Item_Option_Set,
- C_Int);
-
- function CInt_2_IOS is new
- Ada.Unchecked_Conversion (C_Int,
- Item_Option_Set);
-
------------------------------------------------------------------------------
procedure Request_Name (Key : Menu_Request_Code;
Name : out String)
@@ -128,10 +109,9 @@ package body Terminal_Interface.Curses.Menus is
function Itemname (Itm : Item) return chars_ptr;
pragma Import (C, Itemname, "item_name");
- function Freeitem (Itm : Item) return C_Int;
+ function Freeitem (Itm : Item) return Eti_Error;
pragma Import (C, Freeitem, "free_item");
- Res : Eti_Error;
Ptr : chars_ptr;
begin
Ptr := Descname (Itm);
@@ -142,10 +122,7 @@ package body Terminal_Interface.Curses.Menus is
if Ptr /= Null_Ptr then
Interfaces.C.Strings.Free (Ptr);
end if;
- Res := Freeitem (Itm);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Freeitem (Itm));
Itm := Null_Item;
end Delete;
-------------------------------------------------------------------------------
@@ -153,14 +130,11 @@ package body Terminal_Interface.Curses.Menus is
Value : Boolean := True)
is
function Set_Item_Val (Itm : Item;
- Val : C_Int) return C_Int;
+ Val : C_Int) return Eti_Error;
pragma Import (C, Set_Item_Val, "set_item_value");
- Res : constant Eti_Error := Set_Item_Val (Itm, Boolean'Pos (Value));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Item_Val (Itm, Boolean'Pos (Value)));
end Set_Value;
function Value (Itm : Item) return Boolean
@@ -192,16 +166,11 @@ package body Terminal_Interface.Curses.Menus is
Options : Item_Option_Set)
is
function Set_Item_Opts (Itm : Item;
- Opt : C_Int) return C_Int;
+ Opt : Item_Option_Set) return Eti_Error;
pragma Import (C, Set_Item_Opts, "set_item_opts");
- Opt : constant C_Int := IOS_2_CInt (Options);
- Res : Eti_Error;
begin
- Res := Set_Item_Opts (Itm, Opt);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Item_Opts (Itm, Options));
end Set_Options;
procedure Switch_Options (Itm : Item;
@@ -209,34 +178,28 @@ package body Terminal_Interface.Curses.Menus is
On : Boolean := True)
is
function Item_Opts_On (Itm : Item;
- Opt : C_Int) return C_Int;
+ Opt : Item_Option_Set) return Eti_Error;
pragma Import (C, Item_Opts_On, "item_opts_on");
function Item_Opts_Off (Itm : Item;
- Opt : C_Int) return C_Int;
+ Opt : Item_Option_Set) return Eti_Error;
pragma Import (C, Item_Opts_Off, "item_opts_off");
- Opt : constant C_Int := IOS_2_CInt (Options);
- Err : Eti_Error;
begin
if On then
- Err := Item_Opts_On (Itm, Opt);
+ Eti_Exception (Item_Opts_On (Itm, Options));
else
- Err := Item_Opts_Off (Itm, Opt);
- end if;
- if Err /= E_Ok then
- Eti_Exception (Err);
+ Eti_Exception (Item_Opts_Off (Itm, Options));
end if;
end Switch_Options;
procedure Get_Options (Itm : Item;
Options : out Item_Option_Set)
is
- function Item_Opts (Itm : Item) return C_Int;
+ function Item_Opts (Itm : Item) return Item_Option_Set;
pragma Import (C, Item_Opts, "item_opts");
- Res : constant C_Int := Item_Opts (Itm);
begin
- Options := CInt_2_IOS (Res);
+ Options := Item_Opts (Itm);
end Get_Options;
function Get_Options (Itm : Item := Null_Item) return Item_Option_Set
@@ -285,14 +248,11 @@ package body Terminal_Interface.Curses.Menus is
Itm : Item)
is
function Set_Curr_Item (Men : Menu;
- Itm : Item) return C_Int;
+ Itm : Item) return Eti_Error;
pragma Import (C, Set_Curr_Item, "set_current_item");
- Res : constant Eti_Error := Set_Curr_Item (Men, Itm);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Curr_Item (Men, Itm));
end Set_Current;
function Current (Men : Menu) return Item
@@ -312,14 +272,11 @@ package body Terminal_Interface.Curses.Menus is
Line : Line_Position)
is
function Set_Toprow (Men : Menu;
- Line : C_Int) return C_Int;
+ Line : C_Int) return Eti_Error;
pragma Import (C, Set_Toprow, "set_top_row");
- Res : constant Eti_Error := Set_Toprow (Men, C_Int (Line));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Toprow (Men, C_Int (Line)));
end Set_Top_Row;
function Top_Row (Men : Menu) return Line_Position
@@ -351,20 +308,16 @@ package body Terminal_Interface.Curses.Menus is
procedure Post (Men : Menu;
Post : Boolean := True)
is
- function M_Post (Men : Menu) return C_Int;
+ function M_Post (Men : Menu) return Eti_Error;
pragma Import (C, M_Post, "post_menu");
- function M_Unpost (Men : Menu) return C_Int;
+ function M_Unpost (Men : Menu) return Eti_Error;
pragma Import (C, M_Unpost, "unpost_menu");
- Res : Eti_Error;
begin
if Post then
- Res := M_Post (Men);
+ Eti_Exception (M_Post (Men));
else
- Res := M_Unpost (Men);
- end if;
- if Res /= E_Ok then
- Eti_Exception (Res);
+ Eti_Exception (M_Unpost (Men));
end if;
end Post;
-------------------------------------------------------------------------------
@@ -372,16 +325,11 @@ package body Terminal_Interface.Curses.Menus is
Options : Menu_Option_Set)
is
function Set_Menu_Opts (Men : Menu;
- Opt : C_Int) return C_Int;
+ Opt : Menu_Option_Set) return Eti_Error;
pragma Import (C, Set_Menu_Opts, "set_menu_opts");
- Opt : constant C_Int := MOS_2_CInt (Options);
- Res : Eti_Error;
begin
- Res := Set_Menu_Opts (Men, Opt);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Opts (Men, Options));
end Set_Options;
procedure Switch_Options (Men : Menu;
@@ -389,34 +337,28 @@ package body Terminal_Interface.Curses.Menus is
On : Boolean := True)
is
function Menu_Opts_On (Men : Menu;
- Opt : C_Int) return C_Int;
+ Opt : Menu_Option_Set) return Eti_Error;
pragma Import (C, Menu_Opts_On, "menu_opts_on");
function Menu_Opts_Off (Men : Menu;
- Opt : C_Int) return C_Int;
+ Opt : Menu_Option_Set) return Eti_Error;
pragma Import (C, Menu_Opts_Off, "menu_opts_off");
- Opt : constant C_Int := MOS_2_CInt (Options);
- Err : Eti_Error;
begin
if On then
- Err := Menu_Opts_On (Men, Opt);
+ Eti_Exception (Menu_Opts_On (Men, Options));
else
- Err := Menu_Opts_Off (Men, Opt);
- end if;
- if Err /= E_Ok then
- Eti_Exception (Err);
+ Eti_Exception (Menu_Opts_Off (Men, Options));
end if;
end Switch_Options;
procedure Get_Options (Men : Menu;
Options : out Menu_Option_Set)
is
- function Menu_Opts (Men : Menu) return C_Int;
+ function Menu_Opts (Men : Menu) return Menu_Option_Set;
pragma Import (C, Menu_Opts, "menu_opts");
- Res : constant C_Int := Menu_Opts (Men);
begin
- Options := CInt_2_MOS (Res);
+ Options := Menu_Opts (Men);
end Get_Options;
function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set
@@ -431,14 +373,11 @@ package body Terminal_Interface.Curses.Menus is
Win : Window)
is
function Set_Menu_Win (Men : Menu;
- Win : Window) return C_Int;
+ Win : Window) return Eti_Error;
pragma Import (C, Set_Menu_Win, "set_menu_win");
- Res : constant Eti_Error := Set_Menu_Win (Men, Win);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Win (Men, Win));
end Set_Window;
function Get_Window (Men : Menu) return Window
@@ -455,14 +394,11 @@ package body Terminal_Interface.Curses.Menus is
Win : Window)
is
function Set_Menu_Sub (Men : Menu;
- Win : Window) return C_Int;
+ Win : Window) return Eti_Error;
pragma Import (C, Set_Menu_Sub, "set_menu_sub");
- Res : constant Eti_Error := Set_Menu_Sub (Men, Win);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Sub (Men, Win));
end Set_Sub_Window;
function Get_Sub_Window (Men : Menu) return Window
@@ -481,29 +417,23 @@ package body Terminal_Interface.Curses.Menus is
is
type C_Int_Access is access all C_Int;
function M_Scale (Men : Menu;
- Yp, Xp : C_Int_Access) return C_Int;
+ Yp, Xp : C_Int_Access) return Eti_Error;
pragma Import (C, M_Scale, "scale_menu");
X, Y : aliased C_Int;
- Res : constant Eti_Error := M_Scale (Men, Y'Access, X'Access);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (M_Scale (Men, Y'Access, X'Access));
Lines := Line_Count (Y);
Columns := Column_Count (X);
end Scale;
-------------------------------------------------------------------------------
procedure Position_Cursor (Men : Menu)
is
- function Pos_Menu_Cursor (Men : Menu) return C_Int;
+ function Pos_Menu_Cursor (Men : Menu) return Eti_Error;
pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor");
- Res : constant Eti_Error := Pos_Menu_Cursor (Men);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Pos_Menu_Cursor (Men));
end Position_Cursor;
-------------------------------------------------------------------------------
@@ -512,18 +442,14 @@ package body Terminal_Interface.Curses.Menus is
is
type Char_Ptr is access all Interfaces.C.char;
function Set_Mark (Men : Menu;
- Mark : Char_Ptr) return C_Int;
+ Mark : Char_Ptr) return Eti_Error;
pragma Import (C, Set_Mark, "set_menu_mark");
Txt : char_array (0 .. Mark'Length);
Len : size_t;
- Res : Eti_Error;
begin
To_C (Mark, Txt, Len);
- Res := Set_Mark (Men, Txt (Txt'First)'Access);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Mark (Men, Txt (Txt'First)'Access));
end Set_Mark;
procedure Mark (Men : Menu;
@@ -550,37 +476,34 @@ package body Terminal_Interface.Curses.Menus is
Color : Color_Pair := Color_Pair'First)
is
function Set_Menu_Fore (Men : Menu;
- Attr : C_Chtype) return C_Int;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Menu_Fore, "set_menu_fore");
Ch : constant Attributed_Character := (Ch => Character'First,
Color => Color,
Attr => Fore);
- Res : constant Eti_Error := Set_Menu_Fore (Men, AttrChar_To_Chtype (Ch));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Fore (Men, Ch));
end Set_Foreground;
procedure Foreground (Men : Menu;
Fore : out Character_Attribute_Set)
is
- function Menu_Fore (Men : Menu) return C_Chtype;
+ function Menu_Fore (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Fore, "menu_fore");
begin
- Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
+ Fore := Menu_Fore (Men).Attr;
end Foreground;
procedure Foreground (Men : Menu;
Fore : out Character_Attribute_Set;
Color : out Color_Pair)
is
- function Menu_Fore (Men : Menu) return C_Chtype;
+ function Menu_Fore (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Fore, "menu_fore");
begin
- Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
- Color := Chtype_To_AttrChar (Menu_Fore (Men)).Color;
+ Fore := Menu_Fore (Men).Attr;
+ Color := Menu_Fore (Men).Color;
end Foreground;
procedure Set_Background
@@ -589,37 +512,34 @@ package body Terminal_Interface.Curses.Menus is
Color : Color_Pair := Color_Pair'First)
is
function Set_Menu_Back (Men : Menu;
- Attr : C_Chtype) return C_Int;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Menu_Back, "set_menu_back");
Ch : constant Attributed_Character := (Ch => Character'First,
Color => Color,
Attr => Back);
- Res : constant Eti_Error := Set_Menu_Back (Men, AttrChar_To_Chtype (Ch));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Back (Men, Ch));
end Set_Background;
procedure Background (Men : Menu;
Back : out Character_Attribute_Set)
is
- function Menu_Back (Men : Menu) return C_Chtype;
+ function Menu_Back (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Back, "menu_back");
begin
- Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
+ Back := Menu_Back (Men).Attr;
end Background;
procedure Background (Men : Menu;
Back : out Character_Attribute_Set;
Color : out Color_Pair)
is
- function Menu_Back (Men : Menu) return C_Chtype;
+ function Menu_Back (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Back, "menu_back");
begin
- Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
- Color := Chtype_To_AttrChar (Menu_Back (Men)).Color;
+ Back := Menu_Back (Men).Attr;
+ Color := Menu_Back (Men).Color;
end Background;
procedure Set_Grey (Men : Menu;
@@ -627,53 +547,46 @@ package body Terminal_Interface.Curses.Menus is
Color : Color_Pair := Color_Pair'First)
is
function Set_Menu_Grey (Men : Menu;
- Attr : C_Chtype) return C_Int;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Menu_Grey, "set_menu_grey");
Ch : constant Attributed_Character := (Ch => Character'First,
Color => Color,
Attr => Grey);
- Res : constant Eti_Error := Set_Menu_Grey (Men, AttrChar_To_Chtype (Ch));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Grey (Men, Ch));
end Set_Grey;
procedure Grey (Men : Menu;
Grey : out Character_Attribute_Set)
is
- function Menu_Grey (Men : Menu) return C_Chtype;
+ function Menu_Grey (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Grey, "menu_grey");
begin
- Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
+ Grey := Menu_Grey (Men).Attr;
end Grey;
procedure Grey (Men : Menu;
Grey : out Character_Attribute_Set;
Color : out Color_Pair)
is
- function Menu_Grey (Men : Menu) return C_Chtype;
+ function Menu_Grey (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Grey, "menu_grey");
begin
- Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
- Color := Chtype_To_AttrChar (Menu_Grey (Men)).Color;
+ Grey := Menu_Grey (Men).Attr;
+ Color := Menu_Grey (Men).Color;
end Grey;
procedure Set_Pad_Character (Men : Menu;
Pad : Character := Space)
is
function Set_Menu_Pad (Men : Menu;
- Ch : C_Int) return C_Int;
+ Ch : C_Int) return Eti_Error;
pragma Import (C, Set_Menu_Pad, "set_menu_pad");
- Res : constant Eti_Error := Set_Menu_Pad (Men,
- C_Int (Character'Pos (Pad)));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Pad (Men, C_Int (Character'Pos (Pad))));
end Set_Pad_Character;
procedure Pad_Character (Men : Menu;
@@ -691,17 +604,14 @@ package body Terminal_Interface.Curses.Menus is
Col : Column_Position := 0)
is
function Set_Spacing (Men : Menu;
- D, R, C : C_Int) return C_Int;
+ D, R, C : C_Int) return Eti_Error;
pragma Import (C, Set_Spacing, "set_menu_spacing");
- Res : constant Eti_Error := Set_Spacing (Men,
- C_Int (Descr),
- C_Int (Row),
- C_Int (Col));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Spacing (Men,
+ C_Int (Descr),
+ C_Int (Row),
+ C_Int (Col)));
end Set_Spacing;
procedure Spacing (Men : Menu;
@@ -711,22 +621,18 @@ package body Terminal_Interface.Curses.Menus is
is
type C_Int_Access is access all C_Int;
function Get_Spacing (Men : Menu;
- D, R, C : C_Int_Access) return C_Int;
+ D, R, C : C_Int_Access) return Eti_Error;
pragma Import (C, Get_Spacing, "menu_spacing");
D, R, C : aliased C_Int;
- Res : constant Eti_Error := Get_Spacing (Men,
- D'Access,
- R'Access,
- C'Access);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- else
- Descr := Column_Position (D);
- Row := Line_Position (R);
- Col := Column_Position (C);
- end if;
+ Eti_Exception (Get_Spacing (Men,
+ D'Access,
+ R'Access,
+ C'Access));
+ Descr := Column_Position (D);
+ Row := Line_Position (R);
+ Col := Column_Position (C);
end Spacing;
-------------------------------------------------------------------------------
function Set_Pattern (Men : Menu;
@@ -734,7 +640,7 @@ package body Terminal_Interface.Curses.Menus is
is
type Char_Ptr is access all Interfaces.C.char;
function Set_Pattern (Men : Menu;
- Pattern : Char_Ptr) return C_Int;
+ Pattern : Char_Ptr) return Eti_Error;
pragma Import (C, Set_Pattern, "set_menu_pattern");
S : char_array (0 .. Text'Length);
@@ -744,11 +650,11 @@ package body Terminal_Interface.Curses.Menus is
To_C (Text, S, L);
Res := Set_Pattern (Men, S (S'First)'Access);
case Res is
- when E_No_Match => return False;
- when E_Ok => return True;
+ when E_No_Match =>
+ return False;
when others =>
Eti_Exception (Res);
- return False;
+ return True;
end case;
end Set_Pattern;
@@ -767,16 +673,14 @@ package body Terminal_Interface.Curses.Menus is
is
function Set_Menu_Fmt (Men : Menu;
Lin : C_Int;
- Col : C_Int) return C_Int;
+ Col : C_Int) return Eti_Error;
pragma Import (C, Set_Menu_Fmt, "set_menu_format");
- Res : constant Eti_Error := Set_Menu_Fmt (Men,
- C_Int (Lines),
- C_Int (Columns));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Fmt (Men,
+ C_Int (Lines),
+ C_Int (Columns)));
+
end Set_Format;
procedure Format (Men : Menu;
@@ -785,74 +689,58 @@ package body Terminal_Interface.Curses.Menus is
is
type C_Int_Access is access all C_Int;
function Menu_Fmt (Men : Menu;
- Y, X : C_Int_Access) return C_Int;
+ Y, X : C_Int_Access) return Eti_Error;
pragma Import (C, Menu_Fmt, "menu_format");
L, C : aliased C_Int;
- Res : constant Eti_Error := Menu_Fmt (Men, L'Access, C'Access);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- else
- Lines := Line_Count (L);
- Columns := Column_Count (C);
- end if;
+ Eti_Exception (Menu_Fmt (Men, L'Access, C'Access));
+ Lines := Line_Count (L);
+ Columns := Column_Count (C);
end Format;
-------------------------------------------------------------------------------
procedure Set_Item_Init_Hook (Men : Menu;
Proc : Menu_Hook_Function)
is
function Set_Item_Init (Men : Menu;
- Proc : Menu_Hook_Function) return C_Int;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Item_Init, "set_item_init");
- Res : constant Eti_Error := Set_Item_Init (Men, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Item_Init (Men, Proc));
end Set_Item_Init_Hook;
procedure Set_Item_Term_Hook (Men : Menu;
Proc : Menu_Hook_Function)
is
function Set_Item_Term (Men : Menu;
- Proc : Menu_Hook_Function) return C_Int;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Item_Term, "set_item_term");
- Res : constant Eti_Error := Set_Item_Term (Men, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Item_Term (Men, Proc));
end Set_Item_Term_Hook;
procedure Set_Menu_Init_Hook (Men : Menu;
Proc : Menu_Hook_Function)
is
function Set_Menu_Init (Men : Menu;
- Proc : Menu_Hook_Function) return C_Int;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Menu_Init, "set_menu_init");
- Res : constant Eti_Error := Set_Menu_Init (Men, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Init (Men, Proc));
end Set_Menu_Init_Hook;
procedure Set_Menu_Term_Hook (Men : Menu;
Proc : Menu_Hook_Function)
is
function Set_Menu_Term (Men : Menu;
- Proc : Menu_Hook_Function) return C_Int;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Menu_Term, "set_menu_term");
- Res : constant Eti_Error := Set_Menu_Term (Men, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Term (Men, Proc));
end Set_Menu_Term_Hook;
function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function
@@ -891,19 +779,15 @@ package body Terminal_Interface.Curses.Menus is
Items : Item_Array_Access)
is
function Set_Items (Men : Menu;
- Items : System.Address) return C_Int;
+ Items : System.Address) return Eti_Error;
pragma Import (C, Set_Items, "set_menu_items");
- Res : Eti_Error;
begin
pragma Assert (Items.all (Items'Last) = Null_Item);
if Items.all (Items'Last) /= Null_Item then
raise Menu_Exception;
else
- Res := Set_Items (Men, Items.all'Address);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Items (Men, Items.all'Address));
end if;
end Redefine;
@@ -955,14 +839,11 @@ package body Terminal_Interface.Curses.Menus is
procedure Delete (Men : in out Menu)
is
- function Free (Men : Menu) return C_Int;
+ function Free (Men : Menu) return Eti_Error;
pragma Import (C, Free, "free_menu");
- Res : constant Eti_Error := Free (Men);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Free (Men));
Men := Null_Menu;
end Delete;
@@ -971,22 +852,22 @@ package body Terminal_Interface.Curses.Menus is
Key : Key_Code) return Driver_Result
is
function Driver (Men : Menu;
- Key : C_Int) return C_Int;
+ Key : C_Int) return Eti_Error;
pragma Import (C, Driver, "menu_driver");
R : constant Eti_Error := Driver (Men, C_Int (Key));
begin
- if R /= E_Ok then
- case R is
- when E_Unknown_Command => return Unknown_Request;
- when E_No_Match => return No_Match;
- when E_Request_Denied |
- E_Not_Selectable => return Request_Denied;
- when others =>
- Eti_Exception (R);
- end case;
- end if;
- return Menu_Ok;
+ case R is
+ when E_Unknown_Command =>
+ return Unknown_Request;
+ when E_No_Match =>
+ return No_Match;
+ when E_Request_Denied | E_Not_Selectable =>
+ return Request_Denied;
+ when others =>
+ Eti_Exception (R);
+ return Menu_Ok;
+ end case;
end Driver;
procedure Free (IA : in out Item_Array_Access;