2 define(`HTMLNAME',`terminal_interface-curses-menus__ads.htm')dnl
4 ------------------------------------------------------------------------------
6 -- GNAT ncurses Binding --
8 -- Terminal_Interface.Curses.Menu --
12 ------------------------------------------------------------------------------
13 -- Copyright 2020 Thomas E. Dickey --
14 -- Copyright 1998-2009,2014 Free Software Foundation, Inc. --
16 -- Permission is hereby granted, free of charge, to any person obtaining a --
17 -- copy of this software and associated documentation files (the --
18 -- "Software"), to deal in the Software without restriction, including --
19 -- without limitation the rights to use, copy, modify, merge, publish, --
20 -- distribute, distribute with modifications, sublicense, and/or sell --
21 -- copies of the Software, and to permit persons to whom the Software is --
22 -- furnished to do so, subject to the following conditions: --
24 -- The above copyright notice and this permission notice shall be included --
25 -- in all copies or substantial portions of the Software. --
27 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
28 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
29 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
30 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
31 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
32 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
33 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
35 -- Except as contained in this notice, the name(s) of the above copyright --
36 -- holders shall not be used in advertising or otherwise to promote the --
37 -- sale, use or other dealings in this Software without prior written --
39 ------------------------------------------------------------------------------
40 -- Author: Juergen Pfeifer, 1996
43 -- $Date: 2020/02/02 23:34:34 $
44 -- Binding Version 01.00
45 ------------------------------------------------------------------------------
47 with Ada.Characters.Latin_1;
49 package Terminal_Interface.Curses.Menus is
50 pragma Preelaborate (Terminal_Interface.Curses.Menus);
51 pragma Linker_Options ("-lmenu" & Curses_Constants.DFT_ARG_SUFFIX);
53 Space : Character renames Ada.Characters.Latin_1.Space;
58 ---------------------------
59 -- Interface constants --
60 ---------------------------
61 Null_Item : constant Item;
62 Null_Menu : constant Menu;
64 subtype Menu_Request_Code is Key_Code
65 range (Key_Max + 1) .. (Key_Max + 17);
67 -- The prefix M_ stands for "Menu Request"
68 M_Left_Item : constant Menu_Request_Code := Key_Max + 1;
69 M_Right_Item : constant Menu_Request_Code := Key_Max + 2;
70 M_Up_Item : constant Menu_Request_Code := Key_Max + 3;
71 M_Down_Item : constant Menu_Request_Code := Key_Max + 4;
72 M_ScrollUp_Line : constant Menu_Request_Code := Key_Max + 5;
73 M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6;
74 M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7;
75 M_ScrollUp_Page : constant Menu_Request_Code := Key_Max + 8;
76 M_First_Item : constant Menu_Request_Code := Key_Max + 9;
77 M_Last_Item : constant Menu_Request_Code := Key_Max + 10;
78 M_Next_Item : constant Menu_Request_Code := Key_Max + 11;
79 M_Previous_Item : constant Menu_Request_Code := Key_Max + 12;
80 M_Toggle_Item : constant Menu_Request_Code := Key_Max + 13;
81 M_Clear_Pattern : constant Menu_Request_Code := Key_Max + 14;
82 M_Back_Pattern : constant Menu_Request_Code := Key_Max + 15;
83 M_Next_Match : constant Menu_Request_Code := Key_Max + 16;
84 M_Previous_Match : constant Menu_Request_Code := Key_Max + 17;
86 -- For those who like the old 'C' names for the request codes
87 REQ_LEFT_ITEM : Menu_Request_Code renames M_Left_Item;
88 REQ_RIGHT_ITEM : Menu_Request_Code renames M_Right_Item;
89 REQ_UP_ITEM : Menu_Request_Code renames M_Up_Item;
90 REQ_DOWN_ITEM : Menu_Request_Code renames M_Down_Item;
91 REQ_SCR_ULINE : Menu_Request_Code renames M_ScrollUp_Line;
92 REQ_SCR_DLINE : Menu_Request_Code renames M_ScrollDown_Line;
93 REQ_SCR_DPAGE : Menu_Request_Code renames M_ScrollDown_Page;
94 REQ_SCR_UPAGE : Menu_Request_Code renames M_ScrollUp_Page;
95 REQ_FIRST_ITEM : Menu_Request_Code renames M_First_Item;
96 REQ_LAST_ITEM : Menu_Request_Code renames M_Last_Item;
97 REQ_NEXT_ITEM : Menu_Request_Code renames M_Next_Item;
98 REQ_PREV_ITEM : Menu_Request_Code renames M_Previous_Item;
99 REQ_TOGGLE_ITEM : Menu_Request_Code renames M_Toggle_Item;
100 REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern;
101 REQ_BACK_PATTERN : Menu_Request_Code renames M_Back_Pattern;
102 REQ_NEXT_MATCH : Menu_Request_Code renames M_Next_Match;
103 REQ_PREV_MATCH : Menu_Request_Code renames M_Previous_Match;
105 procedure Request_Name (Key : Menu_Request_Code;
108 function Request_Name (Key : Menu_Request_Code) return String;
115 Menu_Exception : exception;
119 type Menu_Option_Set is
121 One_Valued : Boolean;
122 Show_Descriptions : Boolean;
123 Row_Major_Order : Boolean;
124 Ignore_Case : Boolean;
125 Show_Matches : Boolean;
126 Non_Cyclic : Boolean;
128 pragma Convention (C_Pass_By_Copy, Menu_Option_Set);
130 for Menu_Option_Set use
132 One_Valued at 0 range Curses_Constants.O_ONEVALUE_First
133 .. Curses_Constants.O_ONEVALUE_Last;
134 Show_Descriptions at 0 range Curses_Constants.O_SHOWDESC_First
135 .. Curses_Constants.O_SHOWDESC_Last;
136 Row_Major_Order at 0 range Curses_Constants.O_ROWMAJOR_First
137 .. Curses_Constants.O_ROWMAJOR_Last;
138 Ignore_Case at 0 range Curses_Constants.O_IGNORECASE_First
139 .. Curses_Constants.O_IGNORECASE_Last;
140 Show_Matches at 0 range Curses_Constants.O_SHOWMATCH_First
141 .. Curses_Constants.O_SHOWMATCH_Last;
142 Non_Cyclic at 0 range Curses_Constants.O_NONCYCLIC_First
143 .. Curses_Constants.O_NONCYCLIC_Last;
145 pragma Warnings (Off);
146 for Menu_Option_Set'Size use Curses_Constants.Menu_Options_Size;
147 pragma Warnings (On);
149 function Default_Menu_Options return Menu_Option_Set;
150 -- Initial default options for a menu.
151 pragma Inline (Default_Menu_Options);
155 type Item_Option_Set is
157 Selectable : Boolean;
159 pragma Convention (C_Pass_By_Copy, Item_Option_Set);
161 for Item_Option_Set use
163 Selectable at 0 range Curses_Constants.O_SELECTABLE_First
164 .. Curses_Constants.O_SELECTABLE_Last;
166 pragma Warnings (Off);
167 for Item_Option_Set'Size use Curses_Constants.Item_Options_Size;
168 pragma Warnings (On);
170 function Default_Item_Options return Item_Option_Set;
171 -- Initial default options for an item.
172 pragma Inline (Default_Item_Options);
177 type Item_Array is array (Positive range <>) of aliased Item;
178 pragma Convention (C, Item_Array);
180 type Item_Array_Access is access Item_Array;
182 procedure Free (IA : in out Item_Array_Access;
183 Free_Items : Boolean := False);
184 -- Release the memory for an allocated item array
185 -- If Free_Items is True, call Delete() for all the items in
188 -- MANPAGE(`mitem_new.3x')
190 -- ANCHOR(`new_item()',`Create')
191 function Create (Name : String;
192 Description : String := "") return Item;
196 -- ANCHOR(`new_item()',`New_Item')
197 function New_Item (Name : String;
198 Description : String := "") return Item
202 -- ANCHOR(`free_item()',`Delete')
203 procedure Delete (Itm : in out Item);
205 -- Resets Itm to Null_Item
207 -- MANPAGE(`mitem_value.3x')
209 -- ANCHOR(`set_item_value()',`Set_Value')
210 procedure Set_Value (Itm : Item;
211 Value : Boolean := True);
213 pragma Inline (Set_Value);
215 -- ANCHOR(`item_value()',`Value')
216 function Value (Itm : Item) return Boolean;
218 pragma Inline (Value);
220 -- MANPAGE(`mitem_visible.3x')
222 -- ANCHOR(`item_visible()',`Visible')
223 function Visible (Itm : Item) return Boolean;
225 pragma Inline (Visible);
227 -- MANPAGE(`mitem_opts.3x')
229 -- ANCHOR(`set_item_opts()',`Set_Options')
230 procedure Set_Options (Itm : Item;
231 Options : Item_Option_Set);
233 -- An overloaded Set_Options is defined later. Pragma Inline appears there
235 -- ANCHOR(`item_opts_on()',`Switch_Options')
236 procedure Switch_Options (Itm : Item;
237 Options : Item_Option_Set;
238 On : Boolean := True);
240 -- ALIAS(`item_opts_off()')
241 -- An overloaded Switch_Options is defined later.
242 -- Pragma Inline appears there
244 -- ANCHOR(`item_opts()',`Get_Options')
245 procedure Get_Options (Itm : Item;
246 Options : out Item_Option_Set);
249 -- ANCHOR(`item_opts()',`Get_Options')
250 function Get_Options (Itm : Item := Null_Item) return Item_Option_Set;
252 -- An overloaded Get_Options is defined later. Pragma Inline appears there
254 -- MANPAGE(`mitem_name.3x')
256 -- ANCHOR(`item_name()',`Name')
257 procedure Name (Itm : Item;
260 function Name (Itm : Item) return String;
262 -- Implemented as function
263 pragma Inline (Name);
265 -- ANCHOR(`item_description();',`Description')
266 procedure Description (Itm : Item;
267 Description : out String);
270 function Description (Itm : Item) return String;
272 -- Implemented as function
273 pragma Inline (Description);
275 -- MANPAGE(`mitem_current.3x')
277 -- ANCHOR(`set_current_item()',`Set_Current')
278 procedure Set_Current (Men : Menu;
281 pragma Inline (Set_Current);
283 -- ANCHOR(`current_item()',`Current')
284 function Current (Men : Menu) return Item;
286 pragma Inline (Current);
288 -- ANCHOR(`set_top_row()',`Set_Top_Row')
289 procedure Set_Top_Row (Men : Menu;
290 Line : Line_Position);
292 pragma Inline (Set_Top_Row);
294 -- ANCHOR(`top_row()',`Top_Row')
295 function Top_Row (Men : Menu) return Line_Position;
297 pragma Inline (Top_Row);
299 -- ANCHOR(`item_index()',`Get_Index')
300 function Get_Index (Itm : Item) return Positive;
302 -- Please note that in this binding we start the numbering of items
303 -- with 1. So this is number is one more than you get from the low
305 pragma Inline (Get_Index);
307 -- MANPAGE(`menu_post.3x')
309 -- ANCHOR(`post_menu()',`Post')
310 procedure Post (Men : Menu;
311 Post : Boolean := True);
313 -- ALIAS(`unpost_menu()')
314 pragma Inline (Post);
316 -- MANPAGE(`menu_opts.3x')
318 -- ANCHOR(`set_menu_opts()',`Set_Options')
319 procedure Set_Options (Men : Menu;
320 Options : Menu_Option_Set);
322 pragma Inline (Set_Options);
324 -- ANCHOR(`menu_opts_on()',`Switch_Options')
325 procedure Switch_Options (Men : Menu;
326 Options : Menu_Option_Set;
327 On : Boolean := True);
329 -- ALIAS(`menu_opts_off()')
330 pragma Inline (Switch_Options);
332 -- ANCHOR(`menu_opts()',`Get_Options')
333 procedure Get_Options (Men : Menu;
334 Options : out Menu_Option_Set);
337 -- ANCHOR(`menu_opts()',`Get_Options')
338 function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set;
340 pragma Inline (Get_Options);
342 -- MANPAGE(`menu_win.3x')
344 -- ANCHOR(`set_menu_win()',`Set_Window')
345 procedure Set_Window (Men : Menu;
348 pragma Inline (Set_Window);
350 -- ANCHOR(`menu_win()',`Get_Window')
351 function Get_Window (Men : Menu) return Window;
353 pragma Inline (Get_Window);
355 -- ANCHOR(`set_menu_sub()',`Set_Sub_Window')
356 procedure Set_Sub_Window (Men : Menu;
359 pragma Inline (Set_Sub_Window);
361 -- ANCHOR(`menu_sub()',`Get_Sub_Window')
362 function Get_Sub_Window (Men : Menu) return Window;
364 pragma Inline (Get_Sub_Window);
366 -- ANCHOR(`scale_menu()',`Scale')
367 procedure Scale (Men : Menu;
368 Lines : out Line_Count;
369 Columns : out Column_Count);
371 pragma Inline (Scale);
373 -- MANPAGE(`menu_cursor.3x')
375 -- ANCHOR(`pos_menu_cursor()',`Position_Cursor')
376 procedure Position_Cursor (Men : Menu);
378 pragma Inline (Position_Cursor);
380 -- MANPAGE(`menu_mark.3x')
382 -- ANCHOR(`set_menu_mark()',`Set_Mark')
383 procedure Set_Mark (Men : Menu;
386 pragma Inline (Set_Mark);
388 -- ANCHOR(`menu_mark()',`Mark')
389 procedure Mark (Men : Menu;
393 function Mark (Men : Menu) return String;
395 -- Implemented as function
396 pragma Inline (Mark);
398 -- MANPAGE(`menu_attributes.3x')
400 -- ANCHOR(`set_menu_fore()',`Set_Foreground')
401 procedure Set_Foreground
403 Fore : Character_Attribute_Set := Normal_Video;
404 Color : Color_Pair := Color_Pair'First);
406 pragma Inline (Set_Foreground);
408 -- ANCHOR(`menu_fore()',`Foreground')
409 procedure Foreground (Men : Menu;
410 Fore : out Character_Attribute_Set);
413 -- ANCHOR(`menu_fore()',`Foreground')
414 procedure Foreground (Men : Menu;
415 Fore : out Character_Attribute_Set;
416 Color : out Color_Pair);
418 pragma Inline (Foreground);
420 -- ANCHOR(`set_menu_back()',`Set_Background')
421 procedure Set_Background
423 Back : Character_Attribute_Set := Normal_Video;
424 Color : Color_Pair := Color_Pair'First);
426 pragma Inline (Set_Background);
428 -- ANCHOR(`menu_back()',`Background')
429 procedure Background (Men : Menu;
430 Back : out Character_Attribute_Set);
432 -- ANCHOR(`menu_back()',`Background')
434 procedure Background (Men : Menu;
435 Back : out Character_Attribute_Set;
436 Color : out Color_Pair);
438 pragma Inline (Background);
440 -- ANCHOR(`set_menu_grey()',`Set_Grey')
443 Grey : Character_Attribute_Set := Normal_Video;
444 Color : Color_Pair := Color_Pair'First);
446 pragma Inline (Set_Grey);
448 -- ANCHOR(`menu_grey()',`Grey')
449 procedure Grey (Men : Menu;
450 Grey : out Character_Attribute_Set);
453 -- ANCHOR(`menu_grey()',`Grey')
456 Grey : out Character_Attribute_Set;
457 Color : out Color_Pair);
459 pragma Inline (Grey);
461 -- ANCHOR(`set_menu_pad()',`Set_Pad_Character')
462 procedure Set_Pad_Character (Men : Menu;
463 Pad : Character := Space);
465 pragma Inline (Set_Pad_Character);
467 -- ANCHOR(`menu_pad()',`Pad_Character')
468 procedure Pad_Character (Men : Menu;
469 Pad : out Character);
471 pragma Inline (Pad_Character);
473 -- MANPAGE(`menu_spacing.3x')
475 -- ANCHOR(`set_menu_spacing()',`Set_Spacing')
476 procedure Set_Spacing (Men : Menu;
477 Descr : Column_Position := 0;
478 Row : Line_Position := 0;
479 Col : Column_Position := 0);
481 pragma Inline (Set_Spacing);
483 -- ANCHOR(`menu_spacing()',`Spacing')
484 procedure Spacing (Men : Menu;
485 Descr : out Column_Position;
486 Row : out Line_Position;
487 Col : out Column_Position);
489 pragma Inline (Spacing);
491 -- MANPAGE(`menu_pattern.3x')
493 -- ANCHOR(`set_menu_pattern()',`Set_Pattern')
494 function Set_Pattern (Men : Menu;
495 Text : String) return Boolean;
497 -- Return TRUE if the pattern matches, FALSE otherwise
498 pragma Inline (Set_Pattern);
500 -- ANCHOR(`menu_pattern()',`Pattern')
501 procedure Pattern (Men : Menu;
504 pragma Inline (Pattern);
506 -- MANPAGE(`menu_format.3x')
508 -- ANCHOR(`set_menu_format()',`Set_Format')
509 procedure Set_Format (Men : Menu;
511 Columns : Column_Count);
512 -- Not implemented: 0 argument for Lines or Columns;
513 -- instead use Format to get the current sizes
514 -- The default format is 16 rows, 1 column. Calling
515 -- set_menu_format with a null menu pointer will change this
516 -- default. A zero row or column argument to set_menu_format
517 -- is interpreted as a request not to change the current
520 pragma Inline (Set_Format);
522 -- ANCHOR(`menu_format()',`Format')
523 procedure Format (Men : Menu;
524 Lines : out Line_Count;
525 Columns : out Column_Count);
527 pragma Inline (Format);
529 -- MANPAGE(`menu_hook.3x')
531 type Menu_Hook_Function is access procedure (Men : Menu);
532 pragma Convention (C, Menu_Hook_Function);
534 -- ANCHOR(`set_item_init()',`Set_Item_Init_Hook')
535 procedure Set_Item_Init_Hook (Men : Menu;
536 Proc : Menu_Hook_Function);
538 pragma Inline (Set_Item_Init_Hook);
540 -- ANCHOR(`set_item_term()',`Set_Item_Term_Hook')
541 procedure Set_Item_Term_Hook (Men : Menu;
542 Proc : Menu_Hook_Function);
544 pragma Inline (Set_Item_Term_Hook);
546 -- ANCHOR(`set_menu_init()',`Set_Menu_Init_Hook')
547 procedure Set_Menu_Init_Hook (Men : Menu;
548 Proc : Menu_Hook_Function);
550 pragma Inline (Set_Menu_Init_Hook);
552 -- ANCHOR(`set_menu_term()',`Set_Menu_Term_Hook')
553 procedure Set_Menu_Term_Hook (Men : Menu;
554 Proc : Menu_Hook_Function);
556 pragma Inline (Set_Menu_Term_Hook);
558 -- ANCHOR(`item_init()',`Get_Item_Init_Hook')
559 function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function;
561 pragma Inline (Get_Item_Init_Hook);
563 -- ANCHOR(`item_term()',`Get_Item_Term_Hook')
564 function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function;
566 pragma Inline (Get_Item_Term_Hook);
568 -- ANCHOR(`menu_init()',`Get_Menu_Init_Hook')
569 function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function;
571 pragma Inline (Get_Menu_Init_Hook);
573 -- ANCHOR(`menu_term()',`Get_Menu_Term_Hook')
574 function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function;
576 pragma Inline (Get_Menu_Term_Hook);
578 -- MANPAGE(`menu_items.3x')
580 -- ANCHOR(`set_menu_items()',`Redefine')
581 procedure Redefine (Men : Menu;
582 Items : Item_Array_Access);
584 pragma Inline (Redefine);
586 procedure Set_Items (Men : Menu;
587 Items : Item_Array_Access) renames Redefine;
588 -- pragma Inline (Set_Items);
590 -- ANCHOR(`menu_items()',`Items')
591 function Items (Men : Menu;
592 Index : Positive) return Item;
594 pragma Inline (Items);
596 -- ANCHOR(`item_count()',`Item_Count')
597 function Item_Count (Men : Menu) return Natural;
599 pragma Inline (Item_Count);
601 -- MANPAGE(`menu_new.3x')
603 -- ANCHOR(`new_menu()',`Create')
604 function Create (Items : Item_Array_Access) return Menu;
608 function New_Menu (Items : Item_Array_Access) return Menu renames Create;
610 -- ANCHOR(`free_menu()',`Delete')
611 procedure Delete (Men : in out Menu);
613 -- Reset Men to Null_Menu
616 -- MANPAGE(`menu_driver.3x')
618 type Driver_Result is (Menu_Ok,
623 -- ANCHOR(`menu_driver()',`Driver')
624 function Driver (Men : Menu;
625 Key : Key_Code) return Driver_Result;
627 -- Driver is not inlined
629 -- ANCHOR(`menu_requestname.3x')
630 -- Not Implemented: menu_request_name, menu_request_by_name
631 -------------------------------------------------------------------------------
633 type Item is new System.Storage_Elements.Integer_Address;
634 type Menu is new System.Storage_Elements.Integer_Address;
636 Null_Item : constant Item := 0;
637 Null_Menu : constant Menu := 0;
639 end Terminal_Interface.Curses.Menus;