2 define(`HTMLNAME',`terminal_interface-curses-menus__ads.htm')dnl
4 ------------------------------------------------------------------------------
6 -- GNAT ncurses Binding --
8 -- Terminal_Interface.Curses.Menu --
12 ------------------------------------------------------------------------------
13 -- Copyright (c) 1998-2009,2014 Free Software Foundation, Inc. --
15 -- Permission is hereby granted, free of charge, to any person obtaining a --
16 -- copy of this software and associated documentation files (the --
17 -- "Software"), to deal in the Software without restriction, including --
18 -- without limitation the rights to use, copy, modify, merge, publish, --
19 -- distribute, distribute with modifications, sublicense, and/or sell --
20 -- copies of the Software, and to permit persons to whom the Software is --
21 -- furnished to do so, subject to the following conditions: --
23 -- The above copyright notice and this permission notice shall be included --
24 -- in all copies or substantial portions of the Software. --
26 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
27 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
28 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
29 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
30 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
31 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
32 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
34 -- Except as contained in this notice, the name(s) of the above copyright --
35 -- holders shall not be used in advertising or otherwise to promote the --
36 -- sale, use or other dealings in this Software without prior written --
38 ------------------------------------------------------------------------------
39 -- Author: Juergen Pfeifer, 1996
42 -- $Date: 2014/05/24 21:31:57 $
43 -- Binding Version 01.00
44 ------------------------------------------------------------------------------
46 with Ada.Characters.Latin_1;
48 package Terminal_Interface.Curses.Menus is
49 pragma Preelaborate (Terminal_Interface.Curses.Menus);
50 pragma Linker_Options ("-lmenu" & Curses_Constants.DFT_ARG_SUFFIX);
52 Space : Character renames Ada.Characters.Latin_1.Space;
57 ---------------------------
58 -- Interface constants --
59 ---------------------------
60 Null_Item : constant Item;
61 Null_Menu : constant Menu;
63 subtype Menu_Request_Code is Key_Code
64 range (Key_Max + 1) .. (Key_Max + 17);
66 -- The prefix M_ stands for "Menu Request"
67 M_Left_Item : constant Menu_Request_Code := Key_Max + 1;
68 M_Right_Item : constant Menu_Request_Code := Key_Max + 2;
69 M_Up_Item : constant Menu_Request_Code := Key_Max + 3;
70 M_Down_Item : constant Menu_Request_Code := Key_Max + 4;
71 M_ScrollUp_Line : constant Menu_Request_Code := Key_Max + 5;
72 M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6;
73 M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7;
74 M_ScrollUp_Page : constant Menu_Request_Code := Key_Max + 8;
75 M_First_Item : constant Menu_Request_Code := Key_Max + 9;
76 M_Last_Item : constant Menu_Request_Code := Key_Max + 10;
77 M_Next_Item : constant Menu_Request_Code := Key_Max + 11;
78 M_Previous_Item : constant Menu_Request_Code := Key_Max + 12;
79 M_Toggle_Item : constant Menu_Request_Code := Key_Max + 13;
80 M_Clear_Pattern : constant Menu_Request_Code := Key_Max + 14;
81 M_Back_Pattern : constant Menu_Request_Code := Key_Max + 15;
82 M_Next_Match : constant Menu_Request_Code := Key_Max + 16;
83 M_Previous_Match : constant Menu_Request_Code := Key_Max + 17;
85 -- For those who like the old 'C' names for the request codes
86 REQ_LEFT_ITEM : Menu_Request_Code renames M_Left_Item;
87 REQ_RIGHT_ITEM : Menu_Request_Code renames M_Right_Item;
88 REQ_UP_ITEM : Menu_Request_Code renames M_Up_Item;
89 REQ_DOWN_ITEM : Menu_Request_Code renames M_Down_Item;
90 REQ_SCR_ULINE : Menu_Request_Code renames M_ScrollUp_Line;
91 REQ_SCR_DLINE : Menu_Request_Code renames M_ScrollDown_Line;
92 REQ_SCR_DPAGE : Menu_Request_Code renames M_ScrollDown_Page;
93 REQ_SCR_UPAGE : Menu_Request_Code renames M_ScrollUp_Page;
94 REQ_FIRST_ITEM : Menu_Request_Code renames M_First_Item;
95 REQ_LAST_ITEM : Menu_Request_Code renames M_Last_Item;
96 REQ_NEXT_ITEM : Menu_Request_Code renames M_Next_Item;
97 REQ_PREV_ITEM : Menu_Request_Code renames M_Previous_Item;
98 REQ_TOGGLE_ITEM : Menu_Request_Code renames M_Toggle_Item;
99 REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern;
100 REQ_BACK_PATTERN : Menu_Request_Code renames M_Back_Pattern;
101 REQ_NEXT_MATCH : Menu_Request_Code renames M_Next_Match;
102 REQ_PREV_MATCH : Menu_Request_Code renames M_Previous_Match;
104 procedure Request_Name (Key : Menu_Request_Code;
107 function Request_Name (Key : Menu_Request_Code) return String;
114 Menu_Exception : exception;
118 type Menu_Option_Set is
120 One_Valued : Boolean;
121 Show_Descriptions : Boolean;
122 Row_Major_Order : Boolean;
123 Ignore_Case : Boolean;
124 Show_Matches : Boolean;
125 Non_Cyclic : Boolean;
127 pragma Convention (C_Pass_By_Copy, Menu_Option_Set);
129 for Menu_Option_Set use
131 One_Valued at 0 range Curses_Constants.O_ONEVALUE_First
132 .. Curses_Constants.O_ONEVALUE_Last;
133 Show_Descriptions at 0 range Curses_Constants.O_SHOWDESC_First
134 .. Curses_Constants.O_SHOWDESC_Last;
135 Row_Major_Order at 0 range Curses_Constants.O_ROWMAJOR_First
136 .. Curses_Constants.O_ROWMAJOR_Last;
137 Ignore_Case at 0 range Curses_Constants.O_IGNORECASE_First
138 .. Curses_Constants.O_IGNORECASE_Last;
139 Show_Matches at 0 range Curses_Constants.O_SHOWMATCH_First
140 .. Curses_Constants.O_SHOWMATCH_Last;
141 Non_Cyclic at 0 range Curses_Constants.O_NONCYCLIC_First
142 .. Curses_Constants.O_NONCYCLIC_Last;
144 pragma Warnings (Off);
145 for Menu_Option_Set'Size use Curses_Constants.Menu_Options_Size;
146 pragma Warnings (On);
148 function Default_Menu_Options return Menu_Option_Set;
149 -- Initial default options for a menu.
150 pragma Inline (Default_Menu_Options);
154 type Item_Option_Set is
156 Selectable : Boolean;
158 pragma Convention (C_Pass_By_Copy, Item_Option_Set);
160 for Item_Option_Set use
162 Selectable at 0 range Curses_Constants.O_SELECTABLE_First
163 .. Curses_Constants.O_SELECTABLE_Last;
165 pragma Warnings (Off);
166 for Item_Option_Set'Size use Curses_Constants.Item_Options_Size;
167 pragma Warnings (On);
169 function Default_Item_Options return Item_Option_Set;
170 -- Initial default options for an item.
171 pragma Inline (Default_Item_Options);
176 type Item_Array is array (Positive range <>) of aliased Item;
177 pragma Convention (C, Item_Array);
179 type Item_Array_Access is access Item_Array;
181 procedure Free (IA : in out Item_Array_Access;
182 Free_Items : Boolean := False);
183 -- Release the memory for an allocated item array
184 -- If Free_Items is True, call Delete() for all the items in
187 -- MANPAGE(`mitem_new.3x')
189 -- ANCHOR(`new_item()',`Create')
190 function Create (Name : String;
191 Description : String := "") return Item;
195 -- ANCHOR(`new_item()',`New_Item')
196 function New_Item (Name : String;
197 Description : String := "") return Item
201 -- ANCHOR(`free_item()',`Delete')
202 procedure Delete (Itm : in out Item);
204 -- Resets Itm to Null_Item
206 -- MANPAGE(`mitem_value.3x')
208 -- ANCHOR(`set_item_value()',`Set_Value')
209 procedure Set_Value (Itm : Item;
210 Value : Boolean := True);
212 pragma Inline (Set_Value);
214 -- ANCHOR(`item_value()',`Value')
215 function Value (Itm : Item) return Boolean;
217 pragma Inline (Value);
219 -- MANPAGE(`mitem_visible.3x')
221 -- ANCHOR(`item_visible()',`Visible')
222 function Visible (Itm : Item) return Boolean;
224 pragma Inline (Visible);
226 -- MANPAGE(`mitem_opts.3x')
228 -- ANCHOR(`set_item_opts()',`Set_Options')
229 procedure Set_Options (Itm : Item;
230 Options : Item_Option_Set);
232 -- An overloaded Set_Options is defined later. Pragma Inline appears there
234 -- ANCHOR(`item_opts_on()',`Switch_Options')
235 procedure Switch_Options (Itm : Item;
236 Options : Item_Option_Set;
237 On : Boolean := True);
239 -- ALIAS(`item_opts_off()')
240 -- An overloaded Switch_Options is defined later.
241 -- Pragma Inline appears there
243 -- ANCHOR(`item_opts()',`Get_Options')
244 procedure Get_Options (Itm : Item;
245 Options : out Item_Option_Set);
248 -- ANCHOR(`item_opts()',`Get_Options')
249 function Get_Options (Itm : Item := Null_Item) return Item_Option_Set;
251 -- An overloaded Get_Options is defined later. Pragma Inline appears there
253 -- MANPAGE(`mitem_name.3x')
255 -- ANCHOR(`item_name()',`Name')
256 procedure Name (Itm : Item;
259 function Name (Itm : Item) return String;
261 -- Implemented as function
262 pragma Inline (Name);
264 -- ANCHOR(`item_description();',`Description')
265 procedure Description (Itm : Item;
266 Description : out String);
269 function Description (Itm : Item) return String;
271 -- Implemented as function
272 pragma Inline (Description);
274 -- MANPAGE(`mitem_current.3x')
276 -- ANCHOR(`set_current_item()',`Set_Current')
277 procedure Set_Current (Men : Menu;
280 pragma Inline (Set_Current);
282 -- ANCHOR(`current_item()',`Current')
283 function Current (Men : Menu) return Item;
285 pragma Inline (Current);
287 -- ANCHOR(`set_top_row()',`Set_Top_Row')
288 procedure Set_Top_Row (Men : Menu;
289 Line : Line_Position);
291 pragma Inline (Set_Top_Row);
293 -- ANCHOR(`top_row()',`Top_Row')
294 function Top_Row (Men : Menu) return Line_Position;
296 pragma Inline (Top_Row);
298 -- ANCHOR(`item_index()',`Get_Index')
299 function Get_Index (Itm : Item) return Positive;
301 -- Please note that in this binding we start the numbering of items
302 -- with 1. So this is number is one more than you get from the low
304 pragma Inline (Get_Index);
306 -- MANPAGE(`menu_post.3x')
308 -- ANCHOR(`post_menu()',`Post')
309 procedure Post (Men : Menu;
310 Post : Boolean := True);
312 -- ALIAS(`unpost_menu()')
313 pragma Inline (Post);
315 -- MANPAGE(`menu_opts.3x')
317 -- ANCHOR(`set_menu_opts()',`Set_Options')
318 procedure Set_Options (Men : Menu;
319 Options : Menu_Option_Set);
321 pragma Inline (Set_Options);
323 -- ANCHOR(`menu_opts_on()',`Switch_Options')
324 procedure Switch_Options (Men : Menu;
325 Options : Menu_Option_Set;
326 On : Boolean := True);
328 -- ALIAS(`menu_opts_off()')
329 pragma Inline (Switch_Options);
331 -- ANCHOR(`menu_opts()',`Get_Options')
332 procedure Get_Options (Men : Menu;
333 Options : out Menu_Option_Set);
336 -- ANCHOR(`menu_opts()',`Get_Options')
337 function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set;
339 pragma Inline (Get_Options);
341 -- MANPAGE(`menu_win.3x')
343 -- ANCHOR(`set_menu_win()',`Set_Window')
344 procedure Set_Window (Men : Menu;
347 pragma Inline (Set_Window);
349 -- ANCHOR(`menu_win()',`Get_Window')
350 function Get_Window (Men : Menu) return Window;
352 pragma Inline (Get_Window);
354 -- ANCHOR(`set_menu_sub()',`Set_Sub_Window')
355 procedure Set_Sub_Window (Men : Menu;
358 pragma Inline (Set_Sub_Window);
360 -- ANCHOR(`menu_sub()',`Get_Sub_Window')
361 function Get_Sub_Window (Men : Menu) return Window;
363 pragma Inline (Get_Sub_Window);
365 -- ANCHOR(`scale_menu()',`Scale')
366 procedure Scale (Men : Menu;
367 Lines : out Line_Count;
368 Columns : out Column_Count);
370 pragma Inline (Scale);
372 -- MANPAGE(`menu_cursor.3x')
374 -- ANCHOR(`pos_menu_cursor()',`Position_Cursor')
375 procedure Position_Cursor (Men : Menu);
377 pragma Inline (Position_Cursor);
379 -- MANPAGE(`menu_mark.3x')
381 -- ANCHOR(`set_menu_mark()',`Set_Mark')
382 procedure Set_Mark (Men : Menu;
385 pragma Inline (Set_Mark);
387 -- ANCHOR(`menu_mark()',`Mark')
388 procedure Mark (Men : Menu;
392 function Mark (Men : Menu) return String;
394 -- Implemented as function
395 pragma Inline (Mark);
397 -- MANPAGE(`menu_attributes.3x')
399 -- ANCHOR(`set_menu_fore()',`Set_Foreground')
400 procedure Set_Foreground
402 Fore : Character_Attribute_Set := Normal_Video;
403 Color : Color_Pair := Color_Pair'First);
405 pragma Inline (Set_Foreground);
407 -- ANCHOR(`menu_fore()',`Foreground')
408 procedure Foreground (Men : Menu;
409 Fore : out Character_Attribute_Set);
412 -- ANCHOR(`menu_fore()',`Foreground')
413 procedure Foreground (Men : Menu;
414 Fore : out Character_Attribute_Set;
415 Color : out Color_Pair);
417 pragma Inline (Foreground);
419 -- ANCHOR(`set_menu_back()',`Set_Background')
420 procedure Set_Background
422 Back : Character_Attribute_Set := Normal_Video;
423 Color : Color_Pair := Color_Pair'First);
425 pragma Inline (Set_Background);
427 -- ANCHOR(`menu_back()',`Background')
428 procedure Background (Men : Menu;
429 Back : out Character_Attribute_Set);
431 -- ANCHOR(`menu_back()',`Background')
433 procedure Background (Men : Menu;
434 Back : out Character_Attribute_Set;
435 Color : out Color_Pair);
437 pragma Inline (Background);
439 -- ANCHOR(`set_menu_grey()',`Set_Grey')
442 Grey : Character_Attribute_Set := Normal_Video;
443 Color : Color_Pair := Color_Pair'First);
445 pragma Inline (Set_Grey);
447 -- ANCHOR(`menu_grey()',`Grey')
448 procedure Grey (Men : Menu;
449 Grey : out Character_Attribute_Set);
452 -- ANCHOR(`menu_grey()',`Grey')
455 Grey : out Character_Attribute_Set;
456 Color : out Color_Pair);
458 pragma Inline (Grey);
460 -- ANCHOR(`set_menu_pad()',`Set_Pad_Character')
461 procedure Set_Pad_Character (Men : Menu;
462 Pad : Character := Space);
464 pragma Inline (Set_Pad_Character);
466 -- ANCHOR(`menu_pad()',`Pad_Character')
467 procedure Pad_Character (Men : Menu;
468 Pad : out Character);
470 pragma Inline (Pad_Character);
472 -- MANPAGE(`menu_spacing.3x')
474 -- ANCHOR(`set_menu_spacing()',`Set_Spacing')
475 procedure Set_Spacing (Men : Menu;
476 Descr : Column_Position := 0;
477 Row : Line_Position := 0;
478 Col : Column_Position := 0);
480 pragma Inline (Set_Spacing);
482 -- ANCHOR(`menu_spacing()',`Spacing')
483 procedure Spacing (Men : Menu;
484 Descr : out Column_Position;
485 Row : out Line_Position;
486 Col : out Column_Position);
488 pragma Inline (Spacing);
490 -- MANPAGE(`menu_pattern.3x')
492 -- ANCHOR(`set_menu_pattern()',`Set_Pattern')
493 function Set_Pattern (Men : Menu;
494 Text : String) return Boolean;
496 -- Return TRUE if the pattern matches, FALSE otherwise
497 pragma Inline (Set_Pattern);
499 -- ANCHOR(`menu_pattern()',`Pattern')
500 procedure Pattern (Men : Menu;
503 pragma Inline (Pattern);
505 -- MANPAGE(`menu_format.3x')
507 -- ANCHOR(`set_menu_format()',`Set_Format')
508 procedure Set_Format (Men : Menu;
510 Columns : Column_Count);
511 -- Not implemented: 0 argument for Lines or Columns;
512 -- instead use Format to get the current sizes
513 -- The default format is 16 rows, 1 column. Calling
514 -- set_menu_format with a null menu pointer will change this
515 -- default. A zero row or column argument to set_menu_format
516 -- is interpreted as a request not to change the current
519 pragma Inline (Set_Format);
521 -- ANCHOR(`menu_format()',`Format')
522 procedure Format (Men : Menu;
523 Lines : out Line_Count;
524 Columns : out Column_Count);
526 pragma Inline (Format);
528 -- MANPAGE(`menu_hook.3x')
530 type Menu_Hook_Function is access procedure (Men : Menu);
531 pragma Convention (C, Menu_Hook_Function);
533 -- ANCHOR(`set_item_init()',`Set_Item_Init_Hook')
534 procedure Set_Item_Init_Hook (Men : Menu;
535 Proc : Menu_Hook_Function);
537 pragma Inline (Set_Item_Init_Hook);
539 -- ANCHOR(`set_item_term()',`Set_Item_Term_Hook')
540 procedure Set_Item_Term_Hook (Men : Menu;
541 Proc : Menu_Hook_Function);
543 pragma Inline (Set_Item_Term_Hook);
545 -- ANCHOR(`set_menu_init()',`Set_Menu_Init_Hook')
546 procedure Set_Menu_Init_Hook (Men : Menu;
547 Proc : Menu_Hook_Function);
549 pragma Inline (Set_Menu_Init_Hook);
551 -- ANCHOR(`set_menu_term()',`Set_Menu_Term_Hook')
552 procedure Set_Menu_Term_Hook (Men : Menu;
553 Proc : Menu_Hook_Function);
555 pragma Inline (Set_Menu_Term_Hook);
557 -- ANCHOR(`item_init()',`Get_Item_Init_Hook')
558 function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function;
560 pragma Inline (Get_Item_Init_Hook);
562 -- ANCHOR(`item_term()',`Get_Item_Term_Hook')
563 function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function;
565 pragma Inline (Get_Item_Term_Hook);
567 -- ANCHOR(`menu_init()',`Get_Menu_Init_Hook')
568 function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function;
570 pragma Inline (Get_Menu_Init_Hook);
572 -- ANCHOR(`menu_term()',`Get_Menu_Term_Hook')
573 function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function;
575 pragma Inline (Get_Menu_Term_Hook);
577 -- MANPAGE(`menu_items.3x')
579 -- ANCHOR(`set_menu_items()',`Redefine')
580 procedure Redefine (Men : Menu;
581 Items : Item_Array_Access);
583 pragma Inline (Redefine);
585 procedure Set_Items (Men : Menu;
586 Items : Item_Array_Access) renames Redefine;
587 -- pragma Inline (Set_Items);
589 -- ANCHOR(`menu_items()',`Items')
590 function Items (Men : Menu;
591 Index : Positive) return Item;
593 pragma Inline (Items);
595 -- ANCHOR(`item_count()',`Item_Count')
596 function Item_Count (Men : Menu) return Natural;
598 pragma Inline (Item_Count);
600 -- MANPAGE(`menu_new.3x')
602 -- ANCHOR(`new_menu()',`Create')
603 function Create (Items : Item_Array_Access) return Menu;
607 function New_Menu (Items : Item_Array_Access) return Menu renames Create;
609 -- ANCHOR(`free_menu()',`Delete')
610 procedure Delete (Men : in out Menu);
612 -- Reset Men to Null_Menu
615 -- MANPAGE(`menu_driver.3x')
617 type Driver_Result is (Menu_Ok,
622 -- ANCHOR(`menu_driver()',`Driver')
623 function Driver (Men : Menu;
624 Key : Key_Code) return Driver_Result;
626 -- Driver is not inlined
628 -- ANCHOR(`menu_requestname.3x')
629 -- Not Implemented: menu_request_name, menu_request_by_name
630 -------------------------------------------------------------------------------
632 type Item is new System.Storage_Elements.Integer_Address;
633 type Menu is new System.Storage_Elements.Integer_Address;
635 Null_Item : constant Item := 0;
636 Null_Menu : constant Menu := 0;
638 end Terminal_Interface.Curses.Menus;