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 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 <juergen.pfeifer@gmx.net> 1996
42 -- Binding Version 01.00
43 ------------------------------------------------------------------------------
44 include(`Menu_Base_Defs')
46 with Ada.Characters.Latin_1;
48 package Terminal_Interface.Curses.Menus is
49 pragma Preelaborate (Terminal_Interface.Curses.Menus);
50 include(`Menu_Linker_Options')dnl
51 include(`Linker_Options')
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 : in Menu_Request_Code;
107 function Request_Name (Key : Menu_Request_Code) return String;
114 Menu_Exception : exception;
118 pragma Warnings (Off);
119 include(`Menu_Opt_Rep')dnl
121 pragma Warnings (On);
123 function Default_Menu_Options return Menu_Option_Set;
124 -- Initial default options for a menu.
125 pragma Inline (Default_Menu_Options);
129 pragma Warnings (Off);
130 include(`Item_Rep')dnl
132 pragma Warnings (On);
134 function Default_Item_Options return Item_Option_Set;
135 -- Initial default options for an item.
136 pragma Inline (Default_Item_Options);
141 type Item_Array is array (Positive range <>) of aliased Item;
142 pragma Convention (C, Item_Array);
144 type Item_Array_Access is access Item_Array;
146 procedure Free (IA : in out Item_Array_Access;
147 Free_Items : Boolean := False);
148 -- Release the memory for an allocated item array
149 -- If Free_Items is True, call Delete() for all the items in
152 -- MANPAGE(`mitem_new.3x')
154 -- ANCHOR(`new_item()',`Create')
155 function Create (Name : String;
156 Description : String := "") return Item;
160 -- ANCHOR(`new_item()',`New_Item')
161 function New_Item (Name : String;
162 Description : String := "") return Item
166 -- ANCHOR(`free_item()',`Delete')
167 procedure Delete (Itm : in out Item);
169 -- Resets Itm to Null_Item
171 -- MANPAGE(`mitem_value.3x')
173 -- ANCHOR(`set_item_value()',`Set_Value')
174 procedure Set_Value (Itm : in Item;
175 Value : in Boolean := True);
177 pragma Inline (Set_Value);
179 -- ANCHOR(`item_value()',`Value')
180 function Value (Itm : Item) return Boolean;
182 pragma Inline (Value);
184 -- MANPAGE(`mitem_visible.3x')
186 -- ANCHOR(`item_visible()',`Visible')
187 function Visible (Itm : Item) return Boolean;
189 pragma Inline (Visible);
191 -- MANPAGE(`mitem_opts.3x')
193 -- ANCHOR(`set_item_opts()',`Set_Options')
194 procedure Set_Options (Itm : in Item;
195 Options : in Item_Option_Set);
197 -- An overloaded Set_Options is defined later. Pragma Inline appears there
199 -- ANCHOR(`item_opts_on()',`Switch_Options')
200 procedure Switch_Options (Itm : in Item;
201 Options : in Item_Option_Set;
202 On : Boolean := True);
204 -- ALIAS(`item_opts_off()')
205 -- An overloaded Switch_Options is defined later.
206 -- Pragma Inline appears there
208 -- ANCHOR(`item_opts()',`Get_Options')
209 procedure Get_Options (Itm : in Item;
210 Options : out Item_Option_Set);
213 -- ANCHOR(`item_opts()',`Get_Options')
214 function Get_Options (Itm : Item := Null_Item) return Item_Option_Set;
216 -- An overloaded Get_Options is defined later. Pragma Inline appears there
218 -- MANPAGE(`mitem_name.3x')
220 -- ANCHOR(`item_name()',`Name')
221 procedure Name (Itm : in Item;
224 function Name (Itm : Item) return String;
226 -- Implemented as function
227 pragma Inline (Name);
229 -- ANCHOR(`item_description();',`Description')
230 procedure Description (Itm : in Item;
231 Description : out String);
234 function Description (Itm : Item) return String;
236 -- Implemented as function
237 pragma Inline (Description);
239 -- MANPAGE(`mitem_current.3x')
241 -- ANCHOR(`set_current_item()',`Set_Current')
242 procedure Set_Current (Men : in Menu;
245 pragma Inline (Set_Current);
247 -- ANCHOR(`current_item()',`Current')
248 function Current (Men : Menu) return Item;
250 pragma Inline (Current);
252 -- ANCHOR(`set_top_row()',`Set_Top_Row')
253 procedure Set_Top_Row (Men : in Menu;
254 Line : in Line_Position);
256 pragma Inline (Set_Top_Row);
258 -- ANCHOR(`top_row()',`Top_Row')
259 function Top_Row (Men : Menu) return Line_Position;
261 pragma Inline (Top_Row);
263 -- ANCHOR(`item_index()',`Get_Index')
264 function Get_Index (Itm : Item) return Positive;
266 -- Please note that in this binding we start the numbering of items
267 -- with 1. So this is number is one more than you get from the low
269 pragma Inline (Get_Index);
271 -- MANPAGE(`menu_post.3x')
273 -- ANCHOR(`post_menu()',`Post')
274 procedure Post (Men : in Menu;
275 Post : in Boolean := True);
277 -- ALIAS(`unpost_menu()')
278 pragma Inline (Post);
280 -- MANPAGE(`menu_opts.3x')
282 -- ANCHOR(`set_menu_opts()',`Set_Options')
283 procedure Set_Options (Men : in Menu;
284 Options : in Menu_Option_Set);
286 pragma Inline (Set_Options);
288 -- ANCHOR(`menu_opts_on()',`Switch_Options')
289 procedure Switch_Options (Men : in Menu;
290 Options : in Menu_Option_Set;
291 On : Boolean := True);
293 -- ALIAS(`menu_opts_off()')
294 pragma Inline (Switch_Options);
296 -- ANCHOR(`menu_opts()',`Get_Options')
297 procedure Get_Options (Men : in Menu;
298 Options : out Menu_Option_Set);
301 -- ANCHOR(`menu_opts()',`Get_Options')
302 function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set;
304 pragma Inline (Get_Options);
306 -- MANPAGE(`menu_win.3x')
308 -- ANCHOR(`set_menu_win()',`Set_Window')
309 procedure Set_Window (Men : in Menu;
312 pragma Inline (Set_Window);
314 -- ANCHOR(`menu_win()',`Get_Window')
315 function Get_Window (Men : Menu) return Window;
317 pragma Inline (Get_Window);
319 -- ANCHOR(`set_menu_sub()',`Set_Sub_Window')
320 procedure Set_Sub_Window (Men : in Menu;
323 pragma Inline (Set_Sub_Window);
325 -- ANCHOR(`menu_sub()',`Get_Sub_Window')
326 function Get_Sub_Window (Men : Menu) return Window;
328 pragma Inline (Get_Sub_Window);
330 -- ANCHOR(`scale_menu()',`Scale')
331 procedure Scale (Men : in Menu;
332 Lines : out Line_Count;
333 Columns : out Column_Count);
335 pragma Inline (Scale);
337 -- MANPAGE(`menu_cursor.3x')
339 -- ANCHOR(`pos_menu_cursor()',`Position_Cursor')
340 procedure Position_Cursor (Men : Menu);
342 pragma Inline (Position_Cursor);
344 -- MANPAGE(`menu_mark.3x')
346 -- ANCHOR(`set_menu_mark()',`Set_Mark')
347 procedure Set_Mark (Men : in Menu;
350 pragma Inline (Set_Mark);
352 -- ANCHOR(`menu_mark()',`Mark')
353 procedure Mark (Men : in Menu;
357 function Mark (Men : Menu) return String;
359 -- Implemented as function
360 pragma Inline (Mark);
362 -- MANPAGE(`menu_attribs.3x')
364 -- ANCHOR(`set_menu_fore()',`Set_Foreground')
365 procedure Set_Foreground
367 Fore : in Character_Attribute_Set := Normal_Video;
368 Color : in Color_Pair := Color_Pair'First);
370 pragma Inline (Set_Foreground);
372 -- ANCHOR(`menu_fore()',`Foreground')
373 procedure Foreground (Men : in Menu;
374 Fore : out Character_Attribute_Set);
377 -- ANCHOR(`menu_fore()',`Foreground')
378 procedure Foreground (Men : in Menu;
379 Fore : out Character_Attribute_Set;
380 Color : out Color_Pair);
382 pragma Inline (Foreground);
384 -- ANCHOR(`set_menu_back()',`Set_Background')
385 procedure Set_Background
387 Back : in Character_Attribute_Set := Normal_Video;
388 Color : in Color_Pair := Color_Pair'First);
390 pragma Inline (Set_Background);
392 -- ANCHOR(`menu_back()',`Background')
393 procedure Background (Men : in Menu;
394 Back : out Character_Attribute_Set);
396 -- ANCHOR(`menu_back()',`Background')
398 procedure Background (Men : in Menu;
399 Back : out Character_Attribute_Set;
400 Color : out Color_Pair);
402 pragma Inline (Background);
404 -- ANCHOR(`set_menu_grey()',`Set_Grey')
407 Grey : in Character_Attribute_Set := Normal_Video;
408 Color : in Color_Pair := Color_Pair'First);
410 pragma Inline (Set_Grey);
412 -- ANCHOR(`menu_grey()',`Grey')
413 procedure Grey (Men : in Menu;
414 Grey : out Character_Attribute_Set);
417 -- ANCHOR(`menu_grey()',`Grey')
420 Grey : out Character_Attribute_Set;
421 Color : out Color_Pair);
423 pragma Inline (Grey);
425 -- ANCHOR(`set_menu_pad()',`Set_Pad_Character')
426 procedure Set_Pad_Character (Men : in Menu;
427 Pad : in Character := Space);
429 pragma Inline (Set_Pad_Character);
431 -- ANCHOR(`menu_pad()',`Pad_Character')
432 procedure Pad_Character (Men : in Menu;
433 Pad : out Character);
435 pragma Inline (Pad_Character);
437 -- MANPAGE(`menu_spacing.3x')
439 -- ANCHOR(`set_menu_spacing()',`Set_Spacing')
440 procedure Set_Spacing (Men : in Menu;
441 Descr : in Column_Position := 0;
442 Row : in Line_Position := 0;
443 Col : in Column_Position := 0);
445 pragma Inline (Set_Spacing);
447 -- ANCHOR(`menu_spacing()',`Spacing')
448 procedure Spacing (Men : in Menu;
449 Descr : out Column_Position;
450 Row : out Line_Position;
451 Col : out Column_Position);
453 pragma Inline (Spacing);
455 -- MANPAGE(`menu_pattern.3x')
457 -- ANCHOR(`set_menu_pattern()',`Set_Pattern')
458 function Set_Pattern (Men : Menu;
459 Text : String) return Boolean;
461 -- Return TRUE if the pattern matches, FALSE otherwise
462 pragma Inline (Set_Pattern);
464 -- ANCHOR(`menu_pattern()',`Pattern')
465 procedure Pattern (Men : in Menu;
468 pragma Inline (Pattern);
470 -- MANPAGE(`menu_format.3x')
472 -- ANCHOR(`set_menu_format()',`Set_Format')
473 procedure Set_Format (Men : in Menu;
474 Lines : in Line_Count;
475 Columns : in Column_Count);
477 pragma Inline (Set_Format);
479 -- ANCHOR(`menu_format()',`Format')
480 procedure Format (Men : in Menu;
481 Lines : out Line_Count;
482 Columns : out Column_Count);
484 pragma Inline (Format);
486 -- MANPAGE(`menu_hook.3x')
488 type Menu_Hook_Function is access procedure (Men : in Menu);
489 pragma Convention (C, Menu_Hook_Function);
491 -- ANCHOR(`set_item_init()',`Set_Item_Init_Hook')
492 procedure Set_Item_Init_Hook (Men : in Menu;
493 Proc : in Menu_Hook_Function);
495 pragma Inline (Set_Item_Init_Hook);
497 -- ANCHOR(`set_item_term()',`Set_Item_Term_Hook')
498 procedure Set_Item_Term_Hook (Men : in Menu;
499 Proc : in Menu_Hook_Function);
501 pragma Inline (Set_Item_Term_Hook);
503 -- ANCHOR(`set_menu_init()',`Set_Menu_Init_Hook')
504 procedure Set_Menu_Init_Hook (Men : in Menu;
505 Proc : in Menu_Hook_Function);
507 pragma Inline (Set_Menu_Init_Hook);
509 -- ANCHOR(`set_menu_term()',`Set_Menu_Term_Hook')
510 procedure Set_Menu_Term_Hook (Men : in Menu;
511 Proc : in Menu_Hook_Function);
513 pragma Inline (Set_Menu_Term_Hook);
515 -- ANCHOR(`item_init()',`Get_Item_Init_Hook')
516 function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function;
518 pragma Inline (Get_Item_Init_Hook);
520 -- ANCHOR(`item_term()',`Get_Item_Term_Hook')
521 function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function;
523 pragma Inline (Get_Item_Term_Hook);
525 -- ANCHOR(`menu_init()',`Get_Menu_Init_Hook')
526 function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function;
528 pragma Inline (Get_Menu_Init_Hook);
530 -- ANCHOR(`menu_term()',`Get_Menu_Term_Hook')
531 function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function;
533 pragma Inline (Get_Menu_Term_Hook);
535 -- MANPAGE(`menu_items.3x')
537 -- ANCHOR(`set_menu_items()',`Redefine')
538 procedure Redefine (Men : in Menu;
539 Items : in Item_Array_Access);
541 pragma Inline (Redefine);
543 procedure Set_Items (Men : in Menu;
544 Items : in Item_Array_Access) renames Redefine;
545 pragma Inline (Set_Items);
547 -- ANCHOR(`menu_items()',`Items')
548 function Items (Men : Menu;
549 Index : Positive) return Item;
551 pragma Inline (Items);
553 -- ANCHOR(`item_count()',`Item_Count')
554 function Item_Count (Men : Menu) return Natural;
556 pragma Inline (Item_Count);
558 -- MANPAGE(`menu_new.3x')
560 -- ANCHOR(`new_menu()',`Create')
561 function Create (Items : Item_Array_Access) return Menu;
565 function New_Menu (Items : Item_Array_Access) return Menu renames Create;
567 -- ANCHOR(`free_menu()',`Delete')
568 procedure Delete (Men : in out Menu);
570 -- Reset Men to Null_Menu
573 -- MANPAGE(`menu_new.3x')
575 type Driver_Result is (Menu_Ok,
580 -- ANCHOR(`menu_driver()',`Driver')
581 function Driver (Men : Menu;
582 Key : Key_Code) return Driver_Result;
584 -- Driver is not inlined
586 -------------------------------------------------------------------------------
588 type Item is new System.Storage_Elements.Integer_Address;
589 type Menu is new System.Storage_Elements.Integer_Address;
591 Null_Item : constant Item := 0;
592 Null_Menu : constant Menu := 0;
594 end Terminal_Interface.Curses.Menus;