diff options
Diffstat (limited to 'Ada95/src/terminal_interface-curses-menus.adb')
| -rw-r--r-- | Ada95/src/terminal_interface-curses-menus.adb | 347 |
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; |