X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=doc%2Fhtml%2Fada%2Fterminal_interface-curses-menus__adb.htm;fp=doc%2Fhtml%2Fada%2Fterminal_interface-curses-menus__adb.htm;h=73f79cea87e4eb6297ac9c760621d92f15156623;hp=8ea0bc67a35f19b0b97d5626fe89e242ba1c2b3b;hb=cb4427a16794d98049b4d790b810d62217501f9f;hpb=cdaf29481becd3e1c21baa574ac1ab88ea5f3d38
diff --git a/doc/html/ada/terminal_interface-curses-menus__adb.htm b/doc/html/ada/terminal_interface-curses-menus__adb.htm
index 8ea0bc67..73f79cea 100644
--- a/doc/html/ada/terminal_interface-curses-menus__adb.htm
+++ b/doc/html/ada/terminal_interface-curses-menus__adb.htm
@@ -24,7 +24,7 @@
-
+
@@ -52,8 +52,8 @@
-
-
+
+
with Ada.Unchecked_Deallocation;
@@ -69,98 +69,97 @@
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;
+ subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
- procedure Request_Name (Key : Menu_Request_Code;
- Name : out String)
+ procedure Request_Name (Key : Menu_Request_Code;
+ Name : out String)
is
- function Request_Name (Key : C_Int) return chars_ptr;
+ function Request_Name (Key : C_Int) return chars_ptr;
pragma Import (C, Request_Name, "menu_request_name");
begin
- Fill_String (Request_Name (C_Int (Key)), Name);
+ Fill_String (Request_Name (C_Int (Key)), Name);
end Request_Name;
- function Request_Name (Key : Menu_Request_Code) return String
+ function Request_Name (Key : Menu_Request_Code) return String
is
- function Request_Name (Key : C_Int) return chars_ptr;
+ function Request_Name (Key : C_Int) return chars_ptr;
pragma Import (C, Request_Name, "menu_request_name");
begin
- return Fill_String (Request_Name (C_Int (Key)));
+ return Fill_String (Request_Name (C_Int (Key)));
end Request_Name;
- function Create (Name : String;
- Description : String := "") return Item
+ function Create (Name : String;
+ Description : String := "") return Item
is
- type Char_Ptr is access all Interfaces.C.char;
- function Newitem (Name, Desc : Char_Ptr) return Item;
+ type Char_Ptr is access all Interfaces.C.char;
+ function Newitem (Name, Desc : Char_Ptr) return Item;
pragma Import (C, Newitem, "new_item");
type Name_String is new char_array (0 .. Name'Length);
- type Name_String_Ptr is access Name_String;
- pragma Controlled (Name_String_Ptr);
+ type Name_String_Ptr is access Name_String;
+ pragma Controlled (Name_String_Ptr);
type Desc_String is new char_array (0 .. Description'Length);
- type Desc_String_Ptr is access Desc_String;
- pragma Controlled (Desc_String_Ptr);
-
- Name_Str : constant Name_String_Ptr := new Name_String;
- Desc_Str : constant Desc_String_Ptr := new Desc_String;
- Name_Len, Desc_Len : size_t;
- Result : Item;
- begin
- To_C (Name, Name_Str.all, Name_Len);
- To_C (Description, Desc_Str.all, Desc_Len);
- Result := Newitem (Name_Str.all (Name_Str.all'First)'Access,
- Desc_Str.all (Desc_Str.all'First)'Access);
- if Result = Null_Item then
+ type Desc_String_Ptr is access Desc_String;
+ pragma Controlled (Desc_String_Ptr);
+
+ Name_Str : constant Name_String_Ptr := new Name_String;
+ Desc_Str : constant Desc_String_Ptr := new Desc_String;
+ Name_Len, Desc_Len : size_t;
+ Result : Item;
+ begin
+ To_C (Name, Name_Str.all, Name_Len);
+ To_C (Description, Desc_Str.all, Desc_Len);
+ Result := Newitem (Name_Str.all (Name_Str.all'First)'Access,
+ Desc_Str.all (Desc_Str.all'First)'Access);
+ if Result = Null_Item then
raise Eti_System_Error;
end if;
- return Result;
+ return Result;
end Create;
- procedure Delete (Itm : in out Item)
+ procedure Delete (Itm : in out Item)
is
- function Descname (Itm : Item) return chars_ptr;
+ function Descname (Itm : Item) return chars_ptr;
pragma Import (C, Descname, "item_description");
- function Itemname (Itm : Item) return chars_ptr;
+ function Itemname (Itm : Item) return chars_ptr;
pragma Import (C, Itemname, "item_name");
- function Freeitem (Itm : Item) return Eti_Error;
+ function Freeitem (Itm : Item) return Eti_Error;
pragma Import (C, Freeitem, "free_item");
- Ptr : chars_ptr;
+ Ptr : chars_ptr;
begin
- Ptr := Descname (Itm);
- if Ptr /= Null_Ptr then
- Interfaces.C.Strings.Free (Ptr);
+ Ptr := Descname (Itm);
+ if Ptr /= Null_Ptr then
+ Interfaces.C.Strings.Free (Ptr);
end if;
- Ptr := Itemname (Itm);
- if Ptr /= Null_Ptr then
- Interfaces.C.Strings.Free (Ptr);
+ Ptr := Itemname (Itm);
+ if Ptr /= Null_Ptr then
+ Interfaces.C.Strings.Free (Ptr);
end if;
- Eti_Exception (Freeitem (Itm));
+ Eti_Exception (Freeitem (Itm));
Itm := Null_Item;
end Delete;
- procedure Set_Value (Itm : Item;
- Value : Boolean := True)
+ procedure Set_Value (Itm : Item;
+ Value : Boolean := True)
is
- function Set_Item_Val (Itm : Item;
- Val : C_Int) return Eti_Error;
+ function Set_Item_Val (Itm : Item;
+ Val : C_Int) return Eti_Error;
pragma Import (C, Set_Item_Val, "set_item_value");
begin
- Eti_Exception (Set_Item_Val (Itm, Boolean'Pos (Value)));
+ Eti_Exception (Set_Item_Val (Itm, Boolean'Pos (Value)));
end Set_Value;
- function Value (Itm : Item) return Boolean
+ function Value (Itm : Item) return Boolean
is
- function Item_Val (Itm : Item) return C_Int;
+ function Item_Val (Itm : Item) return C_Int;
pragma Import (C, Item_Val, "item_value");
begin
- if Item_Val (Itm) = Curses_False then
+ if Item_Val (Itm) = Curses_False then
return False;
else
return True;
@@ -168,636 +167,636 @@
end Value;
- function Visible (Itm : Item) return Boolean
+ function Visible (Itm : Item) return Boolean
is
- function Item_Vis (Itm : Item) return C_Int;
+ function Item_Vis (Itm : Item) return C_Int;
pragma Import (C, Item_Vis, "item_visible");
begin
- if Item_Vis (Itm) = Curses_False then
+ if Item_Vis (Itm) = Curses_False then
return False;
else
return True;
end if;
end Visible;
- procedure Set_Options (Itm : Item;
- Options : Item_Option_Set)
+ procedure Set_Options (Itm : Item;
+ Options : Item_Option_Set)
is
- function Set_Item_Opts (Itm : Item;
- Opt : Item_Option_Set) return Eti_Error;
+ function Set_Item_Opts (Itm : Item;
+ Opt : Item_Option_Set) return Eti_Error;
pragma Import (C, Set_Item_Opts, "set_item_opts");
begin
- Eti_Exception (Set_Item_Opts (Itm, Options));
+ Eti_Exception (Set_Item_Opts (Itm, Options));
end Set_Options;
- procedure Switch_Options (Itm : Item;
- Options : Item_Option_Set;
- On : Boolean := True)
+ procedure Switch_Options (Itm : Item;
+ Options : Item_Option_Set;
+ On : Boolean := True)
is
- function Item_Opts_On (Itm : Item;
- Opt : Item_Option_Set) return Eti_Error;
+ function Item_Opts_On (Itm : Item;
+ Opt : Item_Option_Set) return Eti_Error;
pragma Import (C, Item_Opts_On, "item_opts_on");
- function Item_Opts_Off (Itm : Item;
- Opt : Item_Option_Set) return Eti_Error;
+ function Item_Opts_Off (Itm : Item;
+ Opt : Item_Option_Set) return Eti_Error;
pragma Import (C, Item_Opts_Off, "item_opts_off");
begin
if On then
- Eti_Exception (Item_Opts_On (Itm, Options));
+ Eti_Exception (Item_Opts_On (Itm, Options));
else
- Eti_Exception (Item_Opts_Off (Itm, Options));
+ Eti_Exception (Item_Opts_Off (Itm, Options));
end if;
end Switch_Options;
- procedure Get_Options (Itm : Item;
- Options : out Item_Option_Set)
+ procedure Get_Options (Itm : Item;
+ Options : out Item_Option_Set)
is
- function Item_Opts (Itm : Item) return Item_Option_Set;
+ function Item_Opts (Itm : Item) return Item_Option_Set;
pragma Import (C, Item_Opts, "item_opts");
begin
- Options := Item_Opts (Itm);
+ Options := Item_Opts (Itm);
end Get_Options;
- function Get_Options (Itm : Item := Null_Item) return Item_Option_Set
+ function Get_Options (Itm : Item := Null_Item) return Item_Option_Set
is
- Ios : Item_Option_Set;
+ Ios : Item_Option_Set;
begin
- Get_Options (Itm, Ios);
- return Ios;
+ Get_Options (Itm, Ios);
+ return Ios;
end Get_Options;
- procedure Name (Itm : Item;
- Name : out String)
+ procedure Name (Itm : Item;
+ Name : out String)
is
- function Itemname (Itm : Item) return chars_ptr;
+ function Itemname (Itm : Item) return chars_ptr;
pragma Import (C, Itemname, "item_name");
begin
- Fill_String (Itemname (Itm), Name);
+ Fill_String (Itemname (Itm), Name);
end Name;
- function Name (Itm : Item) return String
+ function Name (Itm : Item) return String
is
- function Itemname (Itm : Item) return chars_ptr;
+ function Itemname (Itm : Item) return chars_ptr;
pragma Import (C, Itemname, "item_name");
begin
- return Fill_String (Itemname (Itm));
+ return Fill_String (Itemname (Itm));
end Name;
- procedure Description (Itm : Item;
- Description : out String)
+ procedure Description (Itm : Item;
+ Description : out String)
is
- function Descname (Itm : Item) return chars_ptr;
+ function Descname (Itm : Item) return chars_ptr;
pragma Import (C, Descname, "item_description");
begin
- Fill_String (Descname (Itm), Description);
+ Fill_String (Descname (Itm), Description);
end Description;
- function Description (Itm : Item) return String
+ function Description (Itm : Item) return String
is
- function Descname (Itm : Item) return chars_ptr;
+ function Descname (Itm : Item) return chars_ptr;
pragma Import (C, Descname, "item_description");
begin
- return Fill_String (Descname (Itm));
+ return Fill_String (Descname (Itm));
end Description;
- procedure Set_Current (Men : Menu;
- Itm : Item)
+ procedure Set_Current (Men : Menu;
+ Itm : Item)
is
- function Set_Curr_Item (Men : Menu;
- Itm : Item) return Eti_Error;
+ function Set_Curr_Item (Men : Menu;
+ Itm : Item) return Eti_Error;
pragma Import (C, Set_Curr_Item, "set_current_item");
begin
- Eti_Exception (Set_Curr_Item (Men, Itm));
+ Eti_Exception (Set_Curr_Item (Men, Itm));
end Set_Current;
- function Current (Men : Menu) return Item
+ function Current (Men : Menu) return Item
is
- function Curr_Item (Men : Menu) return Item;
+ function Curr_Item (Men : Menu) return Item;
pragma Import (C, Curr_Item, "current_item");
- Res : constant Item := Curr_Item (Men);
+ Res : constant Item := Curr_Item (Men);
begin
- if Res = Null_Item then
+ if Res = Null_Item then
raise Menu_Exception;
end if;
- return Res;
+ return Res;
end Current;
- procedure Set_Top_Row (Men : Menu;
- Line : Line_Position)
+ procedure Set_Top_Row (Men : Menu;
+ Line : Line_Position)
is
- function Set_Toprow (Men : Menu;
- Line : C_Int) return Eti_Error;
+ function Set_Toprow (Men : Menu;
+ Line : C_Int) return Eti_Error;
pragma Import (C, Set_Toprow, "set_top_row");
begin
- Eti_Exception (Set_Toprow (Men, C_Int (Line)));
+ Eti_Exception (Set_Toprow (Men, C_Int (Line)));
end Set_Top_Row;
- function Top_Row (Men : Menu) return Line_Position
+ function Top_Row (Men : Menu) return Line_Position
is
- function Toprow (Men : Menu) return C_Int;
+ function Toprow (Men : Menu) return C_Int;
pragma Import (C, Toprow, "top_row");
- Res : constant C_Int := Toprow (Men);
+ Res : constant C_Int := Toprow (Men);
begin
- if Res = Curses_Err then
+ if Res = Curses_Err then
raise Menu_Exception;
end if;
- return Line_Position (Res);
+ return Line_Position (Res);
end Top_Row;
- function Get_Index (Itm : Item) return Positive
+ function Get_Index (Itm : Item) return Positive
is
- function Get_Itemindex (Itm : Item) return C_Int;
+ function Get_Itemindex (Itm : Item) return C_Int;
pragma Import (C, Get_Itemindex, "item_index");
- Res : constant C_Int := Get_Itemindex (Itm);
+ Res : constant C_Int := Get_Itemindex (Itm);
begin
- if Res = Curses_Err then
+ if Res = Curses_Err then
raise Menu_Exception;
end if;
- return Positive (Natural (Res) + Positive'First);
+ return Positive (Natural (Res) + Positive'First);
end Get_Index;
- procedure Post (Men : Menu;
- Post : Boolean := True)
+ procedure Post (Men : Menu;
+ Post : Boolean := True)
is
- function M_Post (Men : Menu) return Eti_Error;
+ function M_Post (Men : Menu) return Eti_Error;
pragma Import (C, M_Post, "post_menu");
- function M_Unpost (Men : Menu) return Eti_Error;
+ function M_Unpost (Men : Menu) return Eti_Error;
pragma Import (C, M_Unpost, "unpost_menu");
begin
if Post then
- Eti_Exception (M_Post (Men));
+ Eti_Exception (M_Post (Men));
else
- Eti_Exception (M_Unpost (Men));
+ Eti_Exception (M_Unpost (Men));
end if;
end Post;
- procedure Set_Options (Men : Menu;
- Options : Menu_Option_Set)
+ procedure Set_Options (Men : Menu;
+ Options : Menu_Option_Set)
is
- function Set_Menu_Opts (Men : Menu;
- Opt : Menu_Option_Set) return Eti_Error;
+ function Set_Menu_Opts (Men : Menu;
+ Opt : Menu_Option_Set) return Eti_Error;
pragma Import (C, Set_Menu_Opts, "set_menu_opts");
begin
- Eti_Exception (Set_Menu_Opts (Men, Options));
+ Eti_Exception (Set_Menu_Opts (Men, Options));
end Set_Options;
- procedure Switch_Options (Men : Menu;
- Options : Menu_Option_Set;
- On : Boolean := True)
+ procedure Switch_Options (Men : Menu;
+ Options : Menu_Option_Set;
+ On : Boolean := True)
is
- function Menu_Opts_On (Men : Menu;
- Opt : Menu_Option_Set) return Eti_Error;
+ function Menu_Opts_On (Men : Menu;
+ Opt : Menu_Option_Set) return Eti_Error;
pragma Import (C, Menu_Opts_On, "menu_opts_on");
- function Menu_Opts_Off (Men : Menu;
- Opt : Menu_Option_Set) return Eti_Error;
+ function Menu_Opts_Off (Men : Menu;
+ Opt : Menu_Option_Set) return Eti_Error;
pragma Import (C, Menu_Opts_Off, "menu_opts_off");
begin
if On then
- Eti_Exception (Menu_Opts_On (Men, Options));
+ Eti_Exception (Menu_Opts_On (Men, Options));
else
- Eti_Exception (Menu_Opts_Off (Men, Options));
+ Eti_Exception (Menu_Opts_Off (Men, Options));
end if;
end Switch_Options;
- procedure Get_Options (Men : Menu;
- Options : out Menu_Option_Set)
+ procedure Get_Options (Men : Menu;
+ Options : out Menu_Option_Set)
is
- function Menu_Opts (Men : Menu) return Menu_Option_Set;
+ function Menu_Opts (Men : Menu) return Menu_Option_Set;
pragma Import (C, Menu_Opts, "menu_opts");
begin
- Options := Menu_Opts (Men);
+ Options := Menu_Opts (Men);
end Get_Options;
- function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set
+ function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set
is
- Mos : Menu_Option_Set;
+ Mos : Menu_Option_Set;
begin
- Get_Options (Men, Mos);
- return Mos;
+ Get_Options (Men, Mos);
+ return Mos;
end Get_Options;
- procedure Set_Window (Men : Menu;
- Win : Window)
+ procedure Set_Window (Men : Menu;
+ Win : Window)
is
- function Set_Menu_Win (Men : Menu;
- Win : Window) return Eti_Error;
+ function Set_Menu_Win (Men : Menu;
+ Win : Window) return Eti_Error;
pragma Import (C, Set_Menu_Win, "set_menu_win");
begin
- Eti_Exception (Set_Menu_Win (Men, Win));
+ Eti_Exception (Set_Menu_Win (Men, Win));
end Set_Window;
- function Get_Window (Men : Menu) return Window
+ function Get_Window (Men : Menu) return Window
is
- function Menu_Win (Men : Menu) return Window;
+ function Menu_Win (Men : Menu) return Window;
pragma Import (C, Menu_Win, "menu_win");
- W : constant Window := Menu_Win (Men);
+ W : constant Window := Menu_Win (Men);
begin
- return W;
+ return W;
end Get_Window;
- procedure Set_Sub_Window (Men : Menu;
- Win : Window)
+ procedure Set_Sub_Window (Men : Menu;
+ Win : Window)
is
- function Set_Menu_Sub (Men : Menu;
- Win : Window) return Eti_Error;
+ function Set_Menu_Sub (Men : Menu;
+ Win : Window) return Eti_Error;
pragma Import (C, Set_Menu_Sub, "set_menu_sub");
begin
- Eti_Exception (Set_Menu_Sub (Men, Win));
+ Eti_Exception (Set_Menu_Sub (Men, Win));
end Set_Sub_Window;
- function Get_Sub_Window (Men : Menu) return Window
+ function Get_Sub_Window (Men : Menu) return Window
is
- function Menu_Sub (Men : Menu) return Window;
+ function Menu_Sub (Men : Menu) return Window;
pragma Import (C, Menu_Sub, "menu_sub");
- W : constant Window := Menu_Sub (Men);
+ W : constant Window := Menu_Sub (Men);
begin
- return W;
+ return W;
end Get_Sub_Window;
- procedure Scale (Men : Menu;
- Lines : out Line_Count;
- Columns : out Column_Count)
+ procedure Scale (Men : Menu;
+ Lines : out Line_Count;
+ Columns : out Column_Count)
is
- type C_Int_Access is access all C_Int;
- function M_Scale (Men : Menu;
- Yp, Xp : C_Int_Access) return Eti_Error;
+ type C_Int_Access is access all C_Int;
+ function M_Scale (Men : Menu;
+ Yp, Xp : C_Int_Access) return Eti_Error;
pragma Import (C, M_Scale, "scale_menu");
- X, Y : aliased C_Int;
+ X, Y : aliased C_Int;
begin
- Eti_Exception (M_Scale (Men, Y'Access, X'Access));
- Lines := Line_Count (Y);
- Columns := Column_Count (X);
+ Eti_Exception (M_Scale (Men, Y'Access, X'Access));
+ Lines := Line_Count (Y);
+ Columns := Column_Count (X);
end Scale;
- procedure Position_Cursor (Men : Menu)
+ procedure Position_Cursor (Men : Menu)
is
- function Pos_Menu_Cursor (Men : Menu) return Eti_Error;
+ function Pos_Menu_Cursor (Men : Menu) return Eti_Error;
pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor");
begin
- Eti_Exception (Pos_Menu_Cursor (Men));
+ Eti_Exception (Pos_Menu_Cursor (Men));
end Position_Cursor;
- procedure Set_Mark (Men : Menu;
- Mark : String)
+ procedure Set_Mark (Men : Menu;
+ Mark : String)
is
- type Char_Ptr is access all Interfaces.C.char;
- function Set_Mark (Men : Menu;
- Mark : Char_Ptr) return Eti_Error;
+ type Char_Ptr is access all Interfaces.C.char;
+ function Set_Mark (Men : Menu;
+ Mark : Char_Ptr) return Eti_Error;
pragma Import (C, Set_Mark, "set_menu_mark");
- Txt : char_array (0 .. Mark'Length);
- Len : size_t;
+ Txt : char_array (0 .. Mark'Length);
+ Len : size_t;
begin
- To_C (Mark, Txt, Len);
- Eti_Exception (Set_Mark (Men, Txt (Txt'First)'Access));
+ To_C (Mark, Txt, Len);
+ Eti_Exception (Set_Mark (Men, Txt (Txt'First)'Access));
end Set_Mark;
- procedure Mark (Men : Menu;
- Mark : out String)
+ procedure Mark (Men : Menu;
+ Mark : out String)
is
- function Get_Menu_Mark (Men : Menu) return chars_ptr;
+ function Get_Menu_Mark (Men : Menu) return chars_ptr;
pragma Import (C, Get_Menu_Mark, "menu_mark");
begin
- Fill_String (Get_Menu_Mark (Men), Mark);
+ Fill_String (Get_Menu_Mark (Men), Mark);
end Mark;
- function Mark (Men : Menu) return String
+ function Mark (Men : Menu) return String
is
- function Get_Menu_Mark (Men : Menu) return chars_ptr;
+ function Get_Menu_Mark (Men : Menu) return chars_ptr;
pragma Import (C, Get_Menu_Mark, "menu_mark");
begin
- return Fill_String (Get_Menu_Mark (Men));
+ return Fill_String (Get_Menu_Mark (Men));
end Mark;
- procedure Set_Foreground
- (Men : Menu;
- Fore : Character_Attribute_Set := Normal_Video;
- Color : Color_Pair := Color_Pair'First)
+ procedure Set_Foreground
+ (Men : Menu;
+ Fore : Character_Attribute_Set := Normal_Video;
+ Color : Color_Pair := Color_Pair'First)
is
- function Set_Menu_Fore (Men : Menu;
- Attr : Attributed_Character) return Eti_Error;
+ function Set_Menu_Fore (Men : Menu;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Menu_Fore, "set_menu_fore");
- Ch : constant Attributed_Character := (Ch => Character'First,
+ Ch : constant Attributed_Character := (Ch => Character'First,
Color => Color,
Attr => Fore);
begin
- Eti_Exception (Set_Menu_Fore (Men, Ch));
+ Eti_Exception (Set_Menu_Fore (Men, Ch));
end Set_Foreground;
- procedure Foreground (Men : Menu;
- Fore : out Character_Attribute_Set)
+ procedure Foreground (Men : Menu;
+ Fore : out Character_Attribute_Set)
is
- function Menu_Fore (Men : Menu) return Attributed_Character;
+ function Menu_Fore (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Fore, "menu_fore");
begin
- Fore := Menu_Fore (Men).Attr;
+ Fore := Menu_Fore (Men).Attr;
end Foreground;
- procedure Foreground (Men : Menu;
- Fore : out Character_Attribute_Set;
- Color : out Color_Pair)
+ procedure Foreground (Men : Menu;
+ Fore : out Character_Attribute_Set;
+ Color : out Color_Pair)
is
- function Menu_Fore (Men : Menu) return Attributed_Character;
+ function Menu_Fore (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Fore, "menu_fore");
begin
- Fore := Menu_Fore (Men).Attr;
- Color := Menu_Fore (Men).Color;
+ Fore := Menu_Fore (Men).Attr;
+ Color := Menu_Fore (Men).Color;
end Foreground;
- procedure Set_Background
- (Men : Menu;
- Back : Character_Attribute_Set := Normal_Video;
- Color : Color_Pair := Color_Pair'First)
+ procedure Set_Background
+ (Men : Menu;
+ Back : Character_Attribute_Set := Normal_Video;
+ Color : Color_Pair := Color_Pair'First)
is
- function Set_Menu_Back (Men : Menu;
- Attr : Attributed_Character) return Eti_Error;
+ function Set_Menu_Back (Men : Menu;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Menu_Back, "set_menu_back");
- Ch : constant Attributed_Character := (Ch => Character'First,
+ Ch : constant Attributed_Character := (Ch => Character'First,
Color => Color,
Attr => Back);
begin
- Eti_Exception (Set_Menu_Back (Men, Ch));
+ Eti_Exception (Set_Menu_Back (Men, Ch));
end Set_Background;
- procedure Background (Men : Menu;
- Back : out Character_Attribute_Set)
+ procedure Background (Men : Menu;
+ Back : out Character_Attribute_Set)
is
- function Menu_Back (Men : Menu) return Attributed_Character;
+ function Menu_Back (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Back, "menu_back");
begin
- Back := Menu_Back (Men).Attr;
+ Back := Menu_Back (Men).Attr;
end Background;
- procedure Background (Men : Menu;
- Back : out Character_Attribute_Set;
- Color : out Color_Pair)
+ procedure Background (Men : Menu;
+ Back : out Character_Attribute_Set;
+ Color : out Color_Pair)
is
- function Menu_Back (Men : Menu) return Attributed_Character;
+ function Menu_Back (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Back, "menu_back");
begin
- Back := Menu_Back (Men).Attr;
- Color := Menu_Back (Men).Color;
+ Back := Menu_Back (Men).Attr;
+ Color := Menu_Back (Men).Color;
end Background;
- procedure Set_Grey (Men : Menu;
- Grey : Character_Attribute_Set := Normal_Video;
- Color : Color_Pair := Color_Pair'First)
+ procedure Set_Grey (Men : Menu;
+ Grey : Character_Attribute_Set := Normal_Video;
+ Color : Color_Pair := Color_Pair'First)
is
- function Set_Menu_Grey (Men : Menu;
- Attr : Attributed_Character) return Eti_Error;
+ function Set_Menu_Grey (Men : Menu;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Menu_Grey, "set_menu_grey");
- Ch : constant Attributed_Character := (Ch => Character'First,
+ Ch : constant Attributed_Character := (Ch => Character'First,
Color => Color,
Attr => Grey);
begin
- Eti_Exception (Set_Menu_Grey (Men, Ch));
+ Eti_Exception (Set_Menu_Grey (Men, Ch));
end Set_Grey;
- procedure Grey (Men : Menu;
- Grey : out Character_Attribute_Set)
+ procedure Grey (Men : Menu;
+ Grey : out Character_Attribute_Set)
is
- function Menu_Grey (Men : Menu) return Attributed_Character;
+ function Menu_Grey (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Grey, "menu_grey");
begin
- Grey := Menu_Grey (Men).Attr;
+ Grey := Menu_Grey (Men).Attr;
end Grey;
- procedure Grey (Men : Menu;
- Grey : out Character_Attribute_Set;
- Color : out Color_Pair)
+ procedure Grey (Men : Menu;
+ Grey : out Character_Attribute_Set;
+ Color : out Color_Pair)
is
- function Menu_Grey (Men : Menu) return Attributed_Character;
+ function Menu_Grey (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Grey, "menu_grey");
begin
- Grey := Menu_Grey (Men).Attr;
- Color := 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)
+ procedure Set_Pad_Character (Men : Menu;
+ Pad : Character := Space)
is
- function Set_Menu_Pad (Men : Menu;
- Ch : C_Int) return Eti_Error;
+ function Set_Menu_Pad (Men : Menu;
+ Ch : C_Int) return Eti_Error;
pragma Import (C, Set_Menu_Pad, "set_menu_pad");
begin
- Eti_Exception (Set_Menu_Pad (Men, C_Int (Character'Pos (Pad))));
+ Eti_Exception (Set_Menu_Pad (Men, C_Int (Character'Pos (Pad))));
end Set_Pad_Character;
- procedure Pad_Character (Men : Menu;
- Pad : out Character)
+ procedure Pad_Character (Men : Menu;
+ Pad : out Character)
is
- function Menu_Pad (Men : Menu) return C_Int;
+ function Menu_Pad (Men : Menu) return C_Int;
pragma Import (C, Menu_Pad, "menu_pad");
begin
- Pad := Character'Val (Menu_Pad (Men));
+ Pad := Character'Val (Menu_Pad (Men));
end Pad_Character;
- procedure Set_Spacing (Men : Menu;
- Descr : Column_Position := 0;
- Row : Line_Position := 0;
- Col : Column_Position := 0)
+ procedure Set_Spacing (Men : Menu;
+ Descr : Column_Position := 0;
+ Row : Line_Position := 0;
+ Col : Column_Position := 0)
is
- function Set_Spacing (Men : Menu;
- D, R, C : C_Int) return Eti_Error;
+ function Set_Spacing (Men : Menu;
+ D, R, C : C_Int) return Eti_Error;
pragma Import (C, Set_Spacing, "set_menu_spacing");
begin
- Eti_Exception (Set_Spacing (Men,
- C_Int (Descr),
- C_Int (Row),
- C_Int (Col)));
+ Eti_Exception (Set_Spacing (Men,
+ C_Int (Descr),
+ C_Int (Row),
+ C_Int (Col)));
end Set_Spacing;
- procedure Spacing (Men : Menu;
- Descr : out Column_Position;
- Row : out Line_Position;
- Col : out Column_Position)
+ procedure Spacing (Men : Menu;
+ Descr : out Column_Position;
+ Row : out Line_Position;
+ Col : out Column_Position)
is
- type C_Int_Access is access all C_Int;
- function Get_Spacing (Men : Menu;
- D, R, C : C_Int_Access) return Eti_Error;
+ type C_Int_Access is access all C_Int;
+ function Get_Spacing (Men : Menu;
+ D, R, C : C_Int_Access) return Eti_Error;
pragma Import (C, Get_Spacing, "menu_spacing");
- D, R, C : aliased C_Int;
+ D, R, C : aliased C_Int;
begin
- Eti_Exception (Get_Spacing (Men,
- D'Access,
- R'Access,
- C'Access));
- Descr := Column_Position (D);
- Row := Line_Position (R);
- Col := Column_Position (C);
+ 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;
- Text : String) return Boolean
+ function Set_Pattern (Men : Menu;
+ Text : String) return Boolean
is
- type Char_Ptr is access all Interfaces.C.char;
- function Set_Pattern (Men : Menu;
- Pattern : Char_Ptr) return Eti_Error;
+ type Char_Ptr is access all Interfaces.C.char;
+ function Set_Pattern (Men : Menu;
+ Pattern : Char_Ptr) return Eti_Error;
pragma Import (C, Set_Pattern, "set_menu_pattern");
- S : char_array (0 .. Text'Length);
- L : size_t;
- Res : Eti_Error;
+ S : char_array (0 .. Text'Length);
+ L : size_t;
+ Res : Eti_Error;
begin
- To_C (Text, S, L);
- Res := Set_Pattern (Men, S (S'First)'Access);
- case Res is
- when E_No_Match =>
+ To_C (Text, S, L);
+ Res := Set_Pattern (Men, S (S'First)'Access);
+ case Res is
+ when E_No_Match =>
return False;
when others =>
- Eti_Exception (Res);
+ Eti_Exception (Res);
return True;
end case;
end Set_Pattern;
- procedure Pattern (Men : Menu;
- Text : out String)
+ procedure Pattern (Men : Menu;
+ Text : out String)
is
- function Get_Pattern (Men : Menu) return chars_ptr;
+ function Get_Pattern (Men : Menu) return chars_ptr;
pragma Import (C, Get_Pattern, "menu_pattern");
begin
- Fill_String (Get_Pattern (Men), Text);
+ Fill_String (Get_Pattern (Men), Text);
end Pattern;
- procedure Set_Format (Men : Menu;
- Lines : Line_Count;
- Columns : Column_Count)
+ procedure Set_Format (Men : Menu;
+ Lines : Line_Count;
+ Columns : Column_Count)
is
- function Set_Menu_Fmt (Men : Menu;
- Lin : C_Int;
- Col : C_Int) return Eti_Error;
+ function Set_Menu_Fmt (Men : Menu;
+ Lin : C_Int;
+ Col : C_Int) return Eti_Error;
pragma Import (C, Set_Menu_Fmt, "set_menu_format");
begin
- Eti_Exception (Set_Menu_Fmt (Men,
- C_Int (Lines),
- C_Int (Columns)));
+ Eti_Exception (Set_Menu_Fmt (Men,
+ C_Int (Lines),
+ C_Int (Columns)));
end Set_Format;
- procedure Format (Men : Menu;
- Lines : out Line_Count;
- Columns : out Column_Count)
+ procedure Format (Men : Menu;
+ Lines : out Line_Count;
+ Columns : out Column_Count)
is
- type C_Int_Access is access all C_Int;
- function Menu_Fmt (Men : Menu;
- Y, X : C_Int_Access) return Eti_Error;
+ type C_Int_Access is access all C_Int;
+ function Menu_Fmt (Men : Menu;
+ Y, X : C_Int_Access) return Eti_Error;
pragma Import (C, Menu_Fmt, "menu_format");
- L, C : aliased C_Int;
+ L, C : aliased C_Int;
begin
- Eti_Exception (Menu_Fmt (Men, L'Access, C'Access));
- Lines := Line_Count (L);
- Columns := Column_Count (C);
+ 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)
+ procedure Set_Item_Init_Hook (Men : Menu;
+ Proc : Menu_Hook_Function)
is
- function Set_Item_Init (Men : Menu;
- Proc : Menu_Hook_Function) return Eti_Error;
+ function Set_Item_Init (Men : Menu;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Item_Init, "set_item_init");
begin
- Eti_Exception (Set_Item_Init (Men, Proc));
+ Eti_Exception (Set_Item_Init (Men, Proc));
end Set_Item_Init_Hook;
- procedure Set_Item_Term_Hook (Men : Menu;
- Proc : Menu_Hook_Function)
+ procedure Set_Item_Term_Hook (Men : Menu;
+ Proc : Menu_Hook_Function)
is
- function Set_Item_Term (Men : Menu;
- Proc : Menu_Hook_Function) return Eti_Error;
+ function Set_Item_Term (Men : Menu;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Item_Term, "set_item_term");
begin
- Eti_Exception (Set_Item_Term (Men, Proc));
+ Eti_Exception (Set_Item_Term (Men, Proc));
end Set_Item_Term_Hook;
- procedure Set_Menu_Init_Hook (Men : Menu;
- Proc : Menu_Hook_Function)
+ procedure Set_Menu_Init_Hook (Men : Menu;
+ Proc : Menu_Hook_Function)
is
- function Set_Menu_Init (Men : Menu;
- Proc : Menu_Hook_Function) return Eti_Error;
+ function Set_Menu_Init (Men : Menu;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Menu_Init, "set_menu_init");
begin
- Eti_Exception (Set_Menu_Init (Men, Proc));
+ Eti_Exception (Set_Menu_Init (Men, Proc));
end Set_Menu_Init_Hook;
- procedure Set_Menu_Term_Hook (Men : Menu;
- Proc : Menu_Hook_Function)
+ procedure Set_Menu_Term_Hook (Men : Menu;
+ Proc : Menu_Hook_Function)
is
- function Set_Menu_Term (Men : Menu;
- Proc : Menu_Hook_Function) return Eti_Error;
+ function Set_Menu_Term (Men : Menu;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Menu_Term, "set_menu_term");
begin
- Eti_Exception (Set_Menu_Term (Men, Proc));
+ Eti_Exception (Set_Menu_Term (Men, Proc));
end Set_Menu_Term_Hook;
- function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function
+ function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function
is
- function Item_Init (Men : Menu) return Menu_Hook_Function;
+ function Item_Init (Men : Menu) return Menu_Hook_Function;
pragma Import (C, Item_Init, "item_init");
begin
- return Item_Init (Men);
+ return Item_Init (Men);
end Get_Item_Init_Hook;
- function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function
+ function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function
is
- function Item_Term (Men : Menu) return Menu_Hook_Function;
+ function Item_Term (Men : Menu) return Menu_Hook_Function;
pragma Import (C, Item_Term, "item_term");
begin
- return Item_Term (Men);
+ return Item_Term (Men);
end Get_Item_Term_Hook;
- function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function
+ function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function
is
- function Menu_Init (Men : Menu) return Menu_Hook_Function;
+ function Menu_Init (Men : Menu) return Menu_Hook_Function;
pragma Import (C, Menu_Init, "menu_init");
begin
- return Menu_Init (Men);
+ return Menu_Init (Men);
end Get_Menu_Init_Hook;
- function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function
+ function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function
is
- function Menu_Term (Men : Menu) return Menu_Hook_Function;
+ function Menu_Term (Men : Menu) return Menu_Hook_Function;
pragma Import (C, Menu_Term, "menu_term");
begin
- return Menu_Term (Men);
+ return Menu_Term (Men);
end Get_Menu_Term_Hook;
- procedure Redefine (Men : Menu;
- Items : Item_Array_Access)
+ procedure Redefine (Men : Menu;
+ Items : Item_Array_Access)
is
- function Set_Items (Men : Menu;
- Items : System.Address) return Eti_Error;
+ function Set_Items (Men : Menu;
+ Items : System.Address) return Eti_Error;
pragma Import (C, Set_Items, "set_menu_items");
begin
@@ -805,24 +804,24 @@
if Items.all (Items'Last) /= Null_Item then
raise Menu_Exception;
else
- Eti_Exception (Set_Items (Men, Items.all'Address));
+ Eti_Exception (Set_Items (Men, Items.all'Address));
end if;
end Redefine;
- function Item_Count (Men : Menu) return Natural
+ function Item_Count (Men : Menu) return Natural
is
- function Count (Men : Menu) return C_Int;
+ function Count (Men : Menu) return C_Int;
pragma Import (C, Count, "item_count");
begin
- return Natural (Count (Men));
+ return Natural (Count (Men));
end Item_Count;
- function Items (Men : Menu;
- Index : Positive) return Item
+ function Items (Men : Menu;
+ Index : Positive) return Item
is
use I_Array;
- function C_Mitems (Men : Menu) return Pointer;
+ function C_Mitems (Men : Menu) return Pointer;
pragma Import (C, C_Mitems, "menu_items");
P : Pointer := C_Mitems (Men);
@@ -830,74 +829,74 @@
if P = null or else Index > Item_Count (Men) then
raise Menu_Exception;
else
- P := P + ptrdiff_t (C_Int (Index) - 1);
+ P := P + ptrdiff_t (C_Int (Index) - 1);
return P.all;
end if;
end Items;
- function Create (Items : Item_Array_Access) return Menu
+ function Create (Items : Item_Array_Access) return Menu
is
- function Newmenu (Items : System.Address) return Menu;
+ function Newmenu (Items : System.Address) return Menu;
pragma Import (C, Newmenu, "new_menu");
- M : Menu;
+ M : Menu;
begin
pragma Assert (Items.all (Items'Last) = Null_Item);
if Items.all (Items'Last) /= Null_Item then
raise Menu_Exception;
else
- M := Newmenu (Items.all'Address);
- if M = Null_Menu then
+ M := Newmenu (Items.all'Address);
+ if M = Null_Menu then
raise Menu_Exception;
end if;
- return M;
+ return M;
end if;
end Create;
- procedure Delete (Men : in out Menu)
+ procedure Delete (Men : in out Menu)
is
- function Free (Men : Menu) return Eti_Error;
+ function Free (Men : Menu) return Eti_Error;
pragma Import (C, Free, "free_menu");
begin
- Eti_Exception (Free (Men));
+ Eti_Exception (Free (Men));
Men := Null_Menu;
end Delete;
- function Driver (Men : Menu;
- Key : Key_Code) return Driver_Result
+ function Driver (Men : Menu;
+ Key : Key_Code) return Driver_Result
is
- function Driver (Men : Menu;
- Key : C_Int) return Eti_Error;
+ function Driver (Men : Menu;
+ Key : C_Int) return Eti_Error;
pragma Import (C, Driver, "menu_driver");
- R : constant Eti_Error := Driver (Men, C_Int (Key));
+ R : constant Eti_Error := Driver (Men, C_Int (Key));
begin
- case R is
- when E_Unknown_Command =>
+ case R is
+ when E_Unknown_Command =>
return Unknown_Request;
- when E_No_Match =>
+ when E_No_Match =>
return No_Match;
- when E_Request_Denied | E_Not_Selectable =>
+ when E_Request_Denied | E_Not_Selectable =>
return Request_Denied;
when others =>
- Eti_Exception (R);
+ Eti_Exception (R);
return Menu_Ok;
end case;
end Driver;
- procedure Free (IA : in out Item_Array_Access;
- Free_Items : Boolean := False)
+ procedure Free (IA : in out Item_Array_Access;
+ Free_Items : Boolean := False)
is
procedure Release is new Ada.Unchecked_Deallocation
(Item_Array, Item_Array_Access);
begin
if IA /= null and then Free_Items then
- for I in IA'First .. (IA'Last - 1) loop
- if IA.all (I) /= Null_Item then
- Delete (IA.all (I));
+ for I in IA'First .. (IA'Last - 1) loop
+ if IA.all (I) /= Null_Item then
+ Delete (IA.all (I));
end if;
end loop;
end if;
@@ -905,13 +904,13 @@
end Free;
- function Default_Menu_Options return Menu_Option_Set
+ function Default_Menu_Options return Menu_Option_Set
is
begin
return Get_Options (Null_Menu);
end Default_Menu_Options;
- function Default_Item_Options return Item_Option_Set
+ function Default_Item_Options return Item_Option_Set
is
begin
return Get_Options (Null_Item);