| -- -*- ada -*- |
| define(`HTMLNAME',`terminal_interface-curses-menus__ads.htm')dnl |
| include(M4MACRO)dnl |
| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT ncurses Binding -- |
| -- -- |
| -- Terminal_Interface.Curses.Menu -- |
| -- -- |
| -- S P E C -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| -- Copyright (c) 1998,2006 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 -- |
| -- "Software"), to deal in the Software without restriction, including -- |
| -- without limitation the rights to use, copy, modify, merge, publish, -- |
| -- distribute, distribute with modifications, sublicense, and/or sell -- |
| -- copies of the Software, and to permit persons to whom the Software is -- |
| -- furnished to do so, subject to the following conditions: -- |
| -- -- |
| -- The above copyright notice and this permission notice shall be included -- |
| -- in all copies or substantial portions of the Software. -- |
| -- -- |
| -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- |
| -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- |
| -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- |
| -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- |
| -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- |
| -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- |
| -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- |
| -- -- |
| -- Except as contained in this notice, the name(s) of the above copyright -- |
| -- holders shall not be used in advertising or otherwise to promote the -- |
| -- sale, use or other dealings in this Software without prior written -- |
| -- authorization. -- |
| ------------------------------------------------------------------------------ |
| -- Author: Juergen Pfeifer, 1996 |
| -- Version Control: |
| -- $Revision: 1.27 $ |
| -- $Date: 2007/05/05 20:20:52 $ |
| -- Binding Version 01.00 |
| ------------------------------------------------------------------------------ |
| include(`Menu_Base_Defs') |
| with System; |
| with Ada.Characters.Latin_1; |
| |
| package Terminal_Interface.Curses.Menus is |
| pragma Preelaborate (Terminal_Interface.Curses.Menus); |
| include(`Menu_Linker_Options')dnl |
| include(`Linker_Options') |
| Space : Character renames Ada.Characters.Latin_1.Space; |
| |
| type Item is private; |
| type Menu is private; |
| |
| --------------------------- |
| -- Interface constants -- |
| --------------------------- |
| Null_Item : constant Item; |
| Null_Menu : constant Menu; |
| |
| subtype Menu_Request_Code is Key_Code |
| range (Key_Max + 1) .. (Key_Max + 17); |
| |
| -- The prefix M_ stands for "Menu Request" |
| M_Left_Item : constant Menu_Request_Code := Key_Max + 1; |
| M_Right_Item : constant Menu_Request_Code := Key_Max + 2; |
| M_Up_Item : constant Menu_Request_Code := Key_Max + 3; |
| M_Down_Item : constant Menu_Request_Code := Key_Max + 4; |
| M_ScrollUp_Line : constant Menu_Request_Code := Key_Max + 5; |
| M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6; |
| M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7; |
| M_ScrollUp_Page : constant Menu_Request_Code := Key_Max + 8; |
| M_First_Item : constant Menu_Request_Code := Key_Max + 9; |
| M_Last_Item : constant Menu_Request_Code := Key_Max + 10; |
| M_Next_Item : constant Menu_Request_Code := Key_Max + 11; |
| M_Previous_Item : constant Menu_Request_Code := Key_Max + 12; |
| M_Toggle_Item : constant Menu_Request_Code := Key_Max + 13; |
| M_Clear_Pattern : constant Menu_Request_Code := Key_Max + 14; |
| M_Back_Pattern : constant Menu_Request_Code := Key_Max + 15; |
| M_Next_Match : constant Menu_Request_Code := Key_Max + 16; |
| M_Previous_Match : constant Menu_Request_Code := Key_Max + 17; |
| |
| -- For those who like the old 'C' names for the request codes |
| REQ_LEFT_ITEM : Menu_Request_Code renames M_Left_Item; |
| REQ_RIGHT_ITEM : Menu_Request_Code renames M_Right_Item; |
| REQ_UP_ITEM : Menu_Request_Code renames M_Up_Item; |
| REQ_DOWN_ITEM : Menu_Request_Code renames M_Down_Item; |
| REQ_SCR_ULINE : Menu_Request_Code renames M_ScrollUp_Line; |
| REQ_SCR_DLINE : Menu_Request_Code renames M_ScrollDown_Line; |
| REQ_SCR_DPAGE : Menu_Request_Code renames M_ScrollDown_Page; |
| REQ_SCR_UPAGE : Menu_Request_Code renames M_ScrollUp_Page; |
| REQ_FIRST_ITEM : Menu_Request_Code renames M_First_Item; |
| REQ_LAST_ITEM : Menu_Request_Code renames M_Last_Item; |
| REQ_NEXT_ITEM : Menu_Request_Code renames M_Next_Item; |
| REQ_PREV_ITEM : Menu_Request_Code renames M_Previous_Item; |
| REQ_TOGGLE_ITEM : Menu_Request_Code renames M_Toggle_Item; |
| REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern; |
| REQ_BACK_PATTERN : Menu_Request_Code renames M_Back_Pattern; |
| REQ_NEXT_MATCH : Menu_Request_Code renames M_Next_Match; |
| REQ_PREV_MATCH : Menu_Request_Code renames M_Previous_Match; |
| |
| procedure Request_Name (Key : in Menu_Request_Code; |
| Name : out String); |
| |
| function Request_Name (Key : Menu_Request_Code) return String; |
| -- Same as function |
| |
| ------------------ |
| -- Exceptions -- |
| ------------------ |
| |
| Menu_Exception : exception; |
| -- |
| -- Menu options |
| -- |
| pragma Warnings (Off); |
| include(`Menu_Opt_Rep')dnl |
| |
| pragma Warnings (On); |
| |
| function Default_Menu_Options return Menu_Option_Set; |
| -- Initial default options for a menu. |
| pragma Inline (Default_Menu_Options); |
| -- |
| -- Item options |
| -- |
| pragma Warnings (Off); |
| include(`Item_Rep')dnl |
| |
| pragma Warnings (On); |
| |
| function Default_Item_Options return Item_Option_Set; |
| -- Initial default options for an item. |
| pragma Inline (Default_Item_Options); |
| |
| -- |
| -- Item Array |
| -- |
| type Item_Array is array (Positive range <>) of aliased Item; |
| pragma Convention (C, Item_Array); |
| |
| type Item_Array_Access is access Item_Array; |
| |
| procedure Free (IA : in out Item_Array_Access; |
| Free_Items : Boolean := False); |
| -- Release the memory for an allocated item array |
| -- If Free_Items is True, call Delete() for all the items in |
| -- the array. |
| |
| -- MANPAGE(`mitem_new.3x') |
| |
| -- ANCHOR(`new_item()',`Create') |
| function Create (Name : String; |
| Description : String := "") return Item; |
| -- AKA |
| -- Not inlined. |
| |
| -- ANCHOR(`new_item()',`New_Item') |
| function New_Item (Name : String; |
| Description : String := "") return Item |
| renames Create; |
| -- AKA |
| |
| -- ANCHOR(`free_item()',`Delete') |
| procedure Delete (Itm : in out Item); |
| -- AKA |
| -- Resets Itm to Null_Item |
| |
| -- MANPAGE(`mitem_value.3x') |
| |
| -- ANCHOR(`set_item_value()',`Set_Value') |
| procedure Set_Value (Itm : in Item; |
| Value : in Boolean := True); |
| -- AKA |
| pragma Inline (Set_Value); |
| |
| -- ANCHOR(`item_value()',`Value') |
| function Value (Itm : Item) return Boolean; |
| -- AKA |
| pragma Inline (Value); |
| |
| -- MANPAGE(`mitem_visible.3x') |
| |
| -- ANCHOR(`item_visible()',`Visible') |
| function Visible (Itm : Item) return Boolean; |
| -- AKA |
| pragma Inline (Visible); |
| |
| -- MANPAGE(`mitem_opts.3x') |
| |
| -- ANCHOR(`set_item_opts()',`Set_Options') |
| procedure Set_Options (Itm : in Item; |
| Options : in Item_Option_Set); |
| -- AKA |
| -- An overloaded Set_Options is defined later. Pragma Inline appears there |
| |
| -- ANCHOR(`item_opts_on()',`Switch_Options') |
| procedure Switch_Options (Itm : in Item; |
| Options : in Item_Option_Set; |
| On : Boolean := True); |
| -- AKA |
| -- ALIAS(`item_opts_off()') |
| -- An overloaded Switch_Options is defined later. |
| -- Pragma Inline appears there |
| |
| -- ANCHOR(`item_opts()',`Get_Options') |
| procedure Get_Options (Itm : in Item; |
| Options : out Item_Option_Set); |
| -- AKA |
| |
| -- ANCHOR(`item_opts()',`Get_Options') |
| function Get_Options (Itm : Item := Null_Item) return Item_Option_Set; |
| -- AKA |
| -- An overloaded Get_Options is defined later. Pragma Inline appears there |
| |
| -- MANPAGE(`mitem_name.3x') |
| |
| -- ANCHOR(`item_name()',`Name') |
| procedure Name (Itm : in Item; |
| Name : out String); |
| -- AKA |
| function Name (Itm : Item) return String; |
| -- AKA |
| -- Implemented as function |
| pragma Inline (Name); |
| |
| -- ANCHOR(`item_description();',`Description') |
| procedure Description (Itm : in Item; |
| Description : out String); |
| -- AKA |
| |
| function Description (Itm : Item) return String; |
| -- AKA |
| -- Implemented as function |
| pragma Inline (Description); |
| |
| -- MANPAGE(`mitem_current.3x') |
| |
| -- ANCHOR(`set_current_item()',`Set_Current') |
| procedure Set_Current (Men : in Menu; |
| Itm : in Item); |
| -- AKA |
| pragma Inline (Set_Current); |
| |
| -- ANCHOR(`current_item()',`Current') |
| function Current (Men : Menu) return Item; |
| -- AKA |
| pragma Inline (Current); |
| |
| -- ANCHOR(`set_top_row()',`Set_Top_Row') |
| procedure Set_Top_Row (Men : in Menu; |
| Line : in Line_Position); |
| -- AKA |
| pragma Inline (Set_Top_Row); |
| |
| -- ANCHOR(`top_row()',`Top_Row') |
| function Top_Row (Men : Menu) return Line_Position; |
| -- AKA |
| pragma Inline (Top_Row); |
| |
| -- ANCHOR(`item_index()',`Get_Index') |
| function Get_Index (Itm : Item) return Positive; |
| -- AKA |
| -- Please note that in this binding we start the numbering of items |
| -- with 1. So this is number is one more than you get from the low |
| -- level call. |
| pragma Inline (Get_Index); |
| |
| -- MANPAGE(`menu_post.3x') |
| |
| -- ANCHOR(`post_menu()',`Post') |
| procedure Post (Men : in Menu; |
| Post : in Boolean := True); |
| -- AKA |
| -- ALIAS(`unpost_menu()') |
| pragma Inline (Post); |
| |
| -- MANPAGE(`menu_opts.3x') |
| |
| -- ANCHOR(`set_menu_opts()',`Set_Options') |
| procedure Set_Options (Men : in Menu; |
| Options : in Menu_Option_Set); |
| -- AKA |
| pragma Inline (Set_Options); |
| |
| -- ANCHOR(`menu_opts_on()',`Switch_Options') |
| procedure Switch_Options (Men : in Menu; |
| Options : in Menu_Option_Set; |
| On : Boolean := True); |
| -- AKA |
| -- ALIAS(`menu_opts_off()') |
| pragma Inline (Switch_Options); |
| |
| -- ANCHOR(`menu_opts()',`Get_Options') |
| procedure Get_Options (Men : in Menu; |
| Options : out Menu_Option_Set); |
| -- AKA |
| |
| -- ANCHOR(`menu_opts()',`Get_Options') |
| function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set; |
| -- AKA |
| pragma Inline (Get_Options); |
| |
| -- MANPAGE(`menu_win.3x') |
| |
| -- ANCHOR(`set_menu_win()',`Set_Window') |
| procedure Set_Window (Men : in Menu; |
| Win : in Window); |
| -- AKA |
| pragma Inline (Set_Window); |
| |
| -- ANCHOR(`menu_win()',`Get_Window') |
| function Get_Window (Men : Menu) return Window; |
| -- AKA |
| pragma Inline (Get_Window); |
| |
| -- ANCHOR(`set_menu_sub()',`Set_Sub_Window') |
| procedure Set_Sub_Window (Men : in Menu; |
| Win : in Window); |
| -- AKA |
| pragma Inline (Set_Sub_Window); |
| |
| -- ANCHOR(`menu_sub()',`Get_Sub_Window') |
| function Get_Sub_Window (Men : Menu) return Window; |
| -- AKA |
| pragma Inline (Get_Sub_Window); |
| |
| -- ANCHOR(`scale_menu()',`Scale') |
| procedure Scale (Men : in Menu; |
| Lines : out Line_Count; |
| Columns : out Column_Count); |
| -- AKA |
| pragma Inline (Scale); |
| |
| -- MANPAGE(`menu_cursor.3x') |
| |
| -- ANCHOR(`pos_menu_cursor()',`Position_Cursor') |
| procedure Position_Cursor (Men : Menu); |
| -- AKA |
| pragma Inline (Position_Cursor); |
| |
| -- MANPAGE(`menu_mark.3x') |
| |
| -- ANCHOR(`set_menu_mark()',`Set_Mark') |
| procedure Set_Mark (Men : in Menu; |
| Mark : in String); |
| -- AKA |
| pragma Inline (Set_Mark); |
| |
| -- ANCHOR(`menu_mark()',`Mark') |
| procedure Mark (Men : in Menu; |
| Mark : out String); |
| -- AKA |
| |
| function Mark (Men : Menu) return String; |
| -- AKA |
| -- Implemented as function |
| pragma Inline (Mark); |
| |
| -- MANPAGE(`menu_attributes.3x') |
| |
| -- ANCHOR(`set_menu_fore()',`Set_Foreground') |
| procedure Set_Foreground |
| (Men : in Menu; |
| Fore : in Character_Attribute_Set := Normal_Video; |
| Color : in Color_Pair := Color_Pair'First); |
| -- AKA |
| pragma Inline (Set_Foreground); |
| |
| -- ANCHOR(`menu_fore()',`Foreground') |
| procedure Foreground (Men : in Menu; |
| Fore : out Character_Attribute_Set); |
| -- AKA |
| |
| -- ANCHOR(`menu_fore()',`Foreground') |
| procedure Foreground (Men : in Menu; |
| Fore : out Character_Attribute_Set; |
| Color : out Color_Pair); |
| -- AKA |
| pragma Inline (Foreground); |
| |
| -- ANCHOR(`set_menu_back()',`Set_Background') |
| procedure Set_Background |
| (Men : in Menu; |
| Back : in Character_Attribute_Set := Normal_Video; |
| Color : in Color_Pair := Color_Pair'First); |
| -- AKA |
| pragma Inline (Set_Background); |
| |
| -- ANCHOR(`menu_back()',`Background') |
| procedure Background (Men : in Menu; |
| Back : out Character_Attribute_Set); |
| -- AKA |
| -- ANCHOR(`menu_back()',`Background') |
| |
| procedure Background (Men : in Menu; |
| Back : out Character_Attribute_Set; |
| Color : out Color_Pair); |
| -- AKA |
| pragma Inline (Background); |
| |
| -- ANCHOR(`set_menu_grey()',`Set_Grey') |
| procedure Set_Grey |
| (Men : in Menu; |
| Grey : in Character_Attribute_Set := Normal_Video; |
| Color : in Color_Pair := Color_Pair'First); |
| -- AKA |
| pragma Inline (Set_Grey); |
| |
| -- ANCHOR(`menu_grey()',`Grey') |
| procedure Grey (Men : in Menu; |
| Grey : out Character_Attribute_Set); |
| -- AKA |
| |
| -- ANCHOR(`menu_grey()',`Grey') |
| procedure Grey |
| (Men : in Menu; |
| Grey : out Character_Attribute_Set; |
| Color : out Color_Pair); |
| -- AKA |
| pragma Inline (Grey); |
| |
| -- ANCHOR(`set_menu_pad()',`Set_Pad_Character') |
| procedure Set_Pad_Character (Men : in Menu; |
| Pad : in Character := Space); |
| -- AKA |
| pragma Inline (Set_Pad_Character); |
| |
| -- ANCHOR(`menu_pad()',`Pad_Character') |
| procedure Pad_Character (Men : in Menu; |
| Pad : out Character); |
| -- AKA |
| pragma Inline (Pad_Character); |
| |
| -- MANPAGE(`menu_spacing.3x') |
| |
| -- ANCHOR(`set_menu_spacing()',`Set_Spacing') |
| procedure Set_Spacing (Men : in Menu; |
| Descr : in Column_Position := 0; |
| Row : in Line_Position := 0; |
| Col : in Column_Position := 0); |
| -- AKA |
| pragma Inline (Set_Spacing); |
| |
| -- ANCHOR(`menu_spacing()',`Spacing') |
| procedure Spacing (Men : in Menu; |
| Descr : out Column_Position; |
| Row : out Line_Position; |
| Col : out Column_Position); |
| -- AKA |
| pragma Inline (Spacing); |
| |
| -- MANPAGE(`menu_pattern.3x') |
| |
| -- ANCHOR(`set_menu_pattern()',`Set_Pattern') |
| function Set_Pattern (Men : Menu; |
| Text : String) return Boolean; |
| -- AKA |
| -- Return TRUE if the pattern matches, FALSE otherwise |
| pragma Inline (Set_Pattern); |
| |
| -- ANCHOR(`menu_pattern()',`Pattern') |
| procedure Pattern (Men : in Menu; |
| Text : out String); |
| -- AKA |
| pragma Inline (Pattern); |
| |
| -- MANPAGE(`menu_format.3x') |
| |
| -- ANCHOR(`set_menu_format()',`Set_Format') |
| procedure Set_Format (Men : in Menu; |
| Lines : in Line_Count; |
| Columns : in Column_Count); |
| -- Not implemented: 0 argument for Lines or Columns; |
| -- instead use Format to get the current sizes |
| -- The default format is 16 rows, 1 column. Calling |
| -- set_menu_format with a null menu pointer will change this |
| -- default. A zero row or column argument to set_menu_format |
| -- is interpreted as a request not to change the current |
| -- value. |
| -- AKA |
| pragma Inline (Set_Format); |
| |
| -- ANCHOR(`menu_format()',`Format') |
| procedure Format (Men : in Menu; |
| Lines : out Line_Count; |
| Columns : out Column_Count); |
| -- AKA |
| pragma Inline (Format); |
| |
| -- MANPAGE(`menu_hook.3x') |
| |
| type Menu_Hook_Function is access procedure (Men : in Menu); |
| pragma Convention (C, Menu_Hook_Function); |
| |
| -- ANCHOR(`set_item_init()',`Set_Item_Init_Hook') |
| procedure Set_Item_Init_Hook (Men : in Menu; |
| Proc : in Menu_Hook_Function); |
| -- AKA |
| pragma Inline (Set_Item_Init_Hook); |
| |
| -- ANCHOR(`set_item_term()',`Set_Item_Term_Hook') |
| procedure Set_Item_Term_Hook (Men : in Menu; |
| Proc : in Menu_Hook_Function); |
| -- AKA |
| pragma Inline (Set_Item_Term_Hook); |
| |
| -- ANCHOR(`set_menu_init()',`Set_Menu_Init_Hook') |
| procedure Set_Menu_Init_Hook (Men : in Menu; |
| Proc : in Menu_Hook_Function); |
| -- AKA |
| pragma Inline (Set_Menu_Init_Hook); |
| |
| -- ANCHOR(`set_menu_term()',`Set_Menu_Term_Hook') |
| procedure Set_Menu_Term_Hook (Men : in Menu; |
| Proc : in Menu_Hook_Function); |
| -- AKA |
| pragma Inline (Set_Menu_Term_Hook); |
| |
| -- ANCHOR(`item_init()',`Get_Item_Init_Hook') |
| function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function; |
| -- AKA |
| pragma Inline (Get_Item_Init_Hook); |
| |
| -- ANCHOR(`item_term()',`Get_Item_Term_Hook') |
| function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function; |
| -- AKA |
| pragma Inline (Get_Item_Term_Hook); |
| |
| -- ANCHOR(`menu_init()',`Get_Menu_Init_Hook') |
| function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function; |
| -- AKA |
| pragma Inline (Get_Menu_Init_Hook); |
| |
| -- ANCHOR(`menu_term()',`Get_Menu_Term_Hook') |
| function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function; |
| -- AKA |
| pragma Inline (Get_Menu_Term_Hook); |
| |
| -- MANPAGE(`menu_items.3x') |
| |
| -- ANCHOR(`set_menu_items()',`Redefine') |
| procedure Redefine (Men : in Menu; |
| Items : in Item_Array_Access); |
| -- AKA |
| pragma Inline (Redefine); |
| |
| procedure Set_Items (Men : in Menu; |
| Items : in Item_Array_Access) renames Redefine; |
| -- pragma Inline (Set_Items); |
| |
| -- ANCHOR(`menu_items()',`Items') |
| function Items (Men : Menu; |
| Index : Positive) return Item; |
| -- AKA |
| pragma Inline (Items); |
| |
| -- ANCHOR(`item_count()',`Item_Count') |
| function Item_Count (Men : Menu) return Natural; |
| -- AKA |
| pragma Inline (Item_Count); |
| |
| -- MANPAGE(`menu_new.3x') |
| |
| -- ANCHOR(`new_menu()',`Create') |
| function Create (Items : Item_Array_Access) return Menu; |
| -- AKA |
| -- Not inlined |
| |
| function New_Menu (Items : Item_Array_Access) return Menu renames Create; |
| |
| -- ANCHOR(`free_menu()',`Delete') |
| procedure Delete (Men : in out Menu); |
| -- AKA |
| -- Reset Men to Null_Menu |
| -- Not inlined |
| |
| -- MANPAGE(`menu_driver.3x') |
| |
| type Driver_Result is (Menu_Ok, |
| Request_Denied, |
| Unknown_Request, |
| No_Match); |
| |
| -- ANCHOR(`menu_driver()',`Driver') |
| function Driver (Men : Menu; |
| Key : Key_Code) return Driver_Result; |
| -- AKA |
| -- Driver is not inlined |
| |
| -- ANCHOR(`menu_requestname.3x') |
| -- Not Implemented: menu_request_name, menu_request_by_name |
| ------------------------------------------------------------------------------- |
| private |
| type Item is new System.Storage_Elements.Integer_Address; |
| type Menu is new System.Storage_Elements.Integer_Address; |
| |
| Null_Item : constant Item := 0; |
| Null_Menu : constant Menu := 0; |
| |
| end Terminal_Interface.Curses.Menus; |