ncurses 4.1
[ncurses.git] / Ada95 / gen / terminal_interface-curses-menus.ads.m4
1 --  -*- ada -*-
2 define(`HTMLNAME',`terminal_interface-curses-menus_s.html')dnl
3 include(M4MACRO)dnl
4 ------------------------------------------------------------------------------
5 --                                                                          --
6 --                           GNAT ncurses Binding                           --
7 --                                                                          --
8 --                      Terminal_Interface.Curses.Menu                      --
9 --                                                                          --
10 --                                 S P E C                                  --
11 --                                                                          --
12 --  Version 00.92                                                           --
13 --                                                                          --
14 --  The ncurses Ada95 binding is copyrighted 1996 by                        --
15 --  Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de                     --
16 --                                                                          --
17 --  Permission is hereby granted to reproduce and distribute this           --
18 --  binding by any means and for any fee, whether alone or as part          --
19 --  of a larger distribution, in source or in binary form, PROVIDED         --
20 --  this notice is included with any such distribution, and is not          --
21 --  removed from any of its header files. Mention of ncurses and the        --
22 --  author of this binding in any applications linked with it is            --
23 --  highly appreciated.                                                     --
24 --                                                                          --
25 --  This binding comes AS IS with no warranty, implied or expressed.        --
26 ------------------------------------------------------------------------------
27 --  Version Control:
28 --  $Revision: 1.7 $
29 ------------------------------------------------------------------------------
30 include(`Menu_Base_Defs')
31 with System;
32 with Interfaces.C;
33 with Ada.Characters.Latin_1;
34
35 package Terminal_Interface.Curses.Menus is
36
37 include(`Menu_Linker_Options')
38
39
40    Space : Character renames Ada.Characters.Latin_1.Space;
41
42    type Item is private;
43    type Menu is private;
44
45    ---------------------------
46    --  Interface constants  --
47    ---------------------------
48    Null_Item : constant Item;
49    Null_Menu : constant Menu;
50
51    subtype Menu_Request_Code is Key_Code
52      range (Key_Max + 1) .. (Key_Max + 17);
53
54    --  The prefix M_ stands for "Menu Request"
55    M_Left_Item       : constant Menu_Request_Code := Key_Max + 1;
56    M_Right_Item      : constant Menu_Request_Code := Key_Max + 2;
57    M_Up_Item         : constant Menu_Request_Code := Key_Max + 3;
58    M_Down_Item       : constant Menu_Request_Code := Key_Max + 4;
59    M_ScrollUp_Line   : constant Menu_Request_Code := Key_Max + 5;
60    M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6;
61    M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7;
62    M_ScrollUp_Page   : constant Menu_Request_Code := Key_Max + 8;
63    M_First_Item      : constant Menu_Request_Code := Key_Max + 9;
64    M_Last_Item       : constant Menu_Request_Code := Key_Max + 10;
65    M_Next_Item       : constant Menu_Request_Code := Key_Max + 11;
66    M_Previous_Item   : constant Menu_Request_Code := Key_Max + 12;
67    M_Toggle_Item     : constant Menu_Request_Code := Key_Max + 13;
68    M_Clear_Pattern   : constant Menu_Request_Code := Key_Max + 14;
69    M_Back_Pattern    : constant Menu_Request_Code := Key_Max + 15;
70    M_Next_Match      : constant Menu_Request_Code := Key_Max + 16;
71    M_Previous_Match  : constant Menu_Request_Code := Key_Max + 17;
72
73    --  For those who like the old 'C' names for the request codes
74    REQ_LEFT_ITEM     : Menu_Request_Code renames M_Left_Item;
75    REQ_RIGHT_ITEM    : Menu_Request_Code renames M_Right_Item;
76    REQ_UP_ITEM       : Menu_Request_Code renames M_Up_Item;
77    REQ_DOWN_ITEM     : Menu_Request_Code renames M_Down_Item;
78    REQ_SCR_ULINE     : Menu_Request_Code renames M_ScrollUp_Line;
79    REQ_SCR_DLINE     : Menu_Request_Code renames M_ScrollDown_Line;
80    REQ_SCR_DPAGE     : Menu_Request_Code renames M_ScrollDown_Page;
81    REQ_SCR_UPAGE     : Menu_Request_Code renames M_ScrollUp_Page;
82    REQ_FIRST_ITEM    : Menu_Request_Code renames M_First_Item;
83    REQ_LAST_ITEM     : Menu_Request_Code renames M_Last_Item;
84    REQ_NEXT_ITEM     : Menu_Request_Code renames M_Next_Item;
85    REQ_PREV_ITEM     : Menu_Request_Code renames M_Previous_Item;
86    REQ_TOGGLE_ITEM   : Menu_Request_Code renames M_Toggle_Item;
87    REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern;
88    REQ_BACK_PATTERN  : Menu_Request_Code renames M_Back_Pattern;
89    REQ_NEXT_MATCH    : Menu_Request_Code renames M_Next_Match;
90    REQ_PREV_MATCH    : Menu_Request_Code renames M_Previous_Match;
91
92    procedure Request_Name (Key  : in Menu_Request_Code;
93                            Name : out String);
94
95    ------------------
96    --  Exceptions  --
97    ------------------
98
99    Menu_Exception : exception;
100    --
101    --  Menu options
102    --
103
104 include(`Menu_Opt_Rep')
105
106    Default_Menu_Options : Menu_Option_Set;
107    --  Initial default options for a menu.
108
109    --
110    --  Item options
111    --
112 include(`Item_Rep')
113
114    Default_Item_Options : Item_Option_Set;
115    --  Initial default options for an item.
116
117    --
118    --  Item Array
119    --
120    type Item_Array is array (Positive range <>) of aliased Item;
121    pragma Convention (C, Item_Array);
122
123    type Item_Array_Access is access all Item_Array;
124
125    --  MANPAGE(`mitem_new.3x')
126
127    --  ANCHOR(`new_item()',`Create')
128    function Create (Name        : String;
129                     Description : String := "") return Item;
130    --  AKA
131
132    --  ANCHOR(`new_item()',`New_Item')
133    function New_Item (Name        : String;
134                       Description : String := "") return Item
135      renames Create;
136    --  AKA
137
138    --  ANCHOR(`free_item()',`Delete')
139    procedure Delete (Itm : in out Item);
140    --  AKA
141    --  Resets Itm to Null_Item
142
143    --  MANPAGE(`mitem_value.3x')
144
145    --  ANCHOR(`set_item_value()',`Set_Value')
146    procedure Set_Value (Itm   : in Item;
147                         Value : in Boolean := True);
148    --  AKA
149
150    --  ANCHOR(`item_value()',`Value')
151    function Value (Itm : Item) return Boolean;
152    --  AKA
153
154    --  MANPAGE(`mitem_visible.3x')
155
156    --  ANCHOR(`item_visible()',`Visible')
157    function Visible (Itm : Item) return Boolean;
158    --  AKA
159
160    --  MANPAGE(`mitem_opts.3x')
161
162    --  ANCHOR(`set_item_opts()',`Set_Options')
163    procedure Set_Options (Itm     : in Item;
164                           Options : in Item_Option_Set);
165    --  AKA
166
167    --  ANCHOR(`item_opts_on()',`Switch_Options')
168    procedure Switch_Options (Itm     : in Item;
169                              Options : in Item_Option_Set;
170                              On      : Boolean := True);
171    --  AKA
172    --  ALIAS(`item_opts_off()')
173
174    --  ANCHOR(`item_opts()',`Get_Options')
175    procedure Get_Options (Itm     : in  Item;
176                           Options : out Item_Option_Set);
177    --  AKA
178
179    --  ANCHOR(`item_opts()',`Get_Options')
180    function Get_Options (Itm : Item := Null_Item) return Item_Option_Set;
181    --  AKA
182
183    --  MANPAGE(`mitem_name.3x')
184
185    --  ANCHOR(`item_name()',`Name')
186    procedure Name (Itm  : in Item;
187                    Name : out String);
188    --  AKA
189
190    --  ANCHOR(`item_description();',`Description')
191    procedure Description (Itm         : in Item;
192                           Description : out String);
193    --  AKA
194
195    --  MANPAGE(`mitem_current.3x')
196
197    --  ANCHOR(`set_current_item()',`Set_Current')
198    procedure Set_Current (Men : in Menu;
199                           Itm : in Item);
200    --  AKA
201
202    --  ANCHOR(`current_item()',`Current')
203    function Current (Men : Menu) return Item;
204    --  AKA
205
206    --  ANCHOR(`set_top_row()',`Set_Top_Row')
207    procedure Set_Top_Row (Men  : in Menu;
208                           Line : in Line_Position);
209    --  AKA
210
211    --  ANCHOR(`top_row()',`Top_Row')
212    function Top_Row (Men : Menu) return Line_Position;
213    --  AKA
214
215    --  ANCHOR(`item_index()',`Get_Index')
216    function Get_Index (Itm : Item) return Positive;
217    --  AKA
218    --  Please note that in this binding we start the numbering of items
219    --  with 1. So this is number is one more than you get from the low
220    --  level call.
221
222    --  MANPAGE(`menu_post.3x')
223
224    --  ANCHOR(`post_menu()',`Post')
225    procedure Post (Men  : in Menu;
226                    Post : in Boolean := True);
227    --  AKA
228    --  ALIAS(`unpost_menu()')
229
230    --  MANPAGE(`menu_opts.3x')
231
232    --  ANCHOR(`set_menu_opts()',`Set_Options')
233    procedure Set_Options (Men     : in Menu;
234                           Options : in Menu_Option_Set);
235    --  AKA
236
237    --  ANCHOR(`menu_opts_on()',`Switch_Options')
238    procedure Switch_Options (Men     : in Menu;
239                              Options : in Menu_Option_Set;
240                              On      : Boolean := True);
241    --  AKA
242    --  ALIAS(`menu_opts_off()')
243
244    --  ANCHOR(`menu_opts()',`Get_Options')
245    procedure Get_Options (Men     : in  Menu;
246                           Options : out Menu_Option_Set);
247    --  AKA
248
249    --  ANCHOR(`menu_opts()',`Get_Options')
250    function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set;
251    --  AKA
252
253    --  MANPAGE(`menu_win.3x')
254
255    --  ANCHOR(`set_menu_win()',`Set_Window')
256    procedure Set_Window (Men : in Menu;
257                          Win : in Window);
258    --  AKA
259
260    --  ANCHOR(`menu_win()',`Get_Window')
261    function Get_Window (Men : Menu) return Window;
262    --  AKA
263
264    --  ANCHOR(`set_menu_sub()',`Set_Sub_Window')
265    procedure Set_Sub_Window (Men : in Menu;
266                              Win : in Window);
267    --  AKA
268
269    --  ANCHOR(`menu_sub()',`Get_Sub_Window')
270    function Get_Sub_Window (Men : Menu) return Window;
271    --  AKA
272
273    --  ANCHOR(`scale_menu()',`Scale')
274    procedure Scale (Men     : in Menu;
275                     Lines   : out Line_Count;
276                     Columns : out Column_Count);
277    --  AKA
278
279    --  MANPAGE(`menu_cursor.3x')
280
281    --  ANCHOR(`pos_menu_cursor()',`Position_Cursor')
282    procedure Position_Cursor (Men : Menu);
283    --  AKA
284
285    --  MANPAGE(`menu_mark.3x')
286
287    --  ANCHOR(`set_menu_mark()',`Set_Mark')
288    procedure Set_Mark (Men  : in Menu;
289                        Mark : in String);
290    --  AKA
291
292    --  ANCHOR(`menu_mark()',`Mark')
293    procedure Mark (Men  : in  Menu;
294                    Mark : out String);
295    --  AKA
296
297    --  MANPAGE(`menu_attribs.3x')
298
299    --  ANCHOR(`set_menu_fore()',`Set_Foreground')
300    procedure Set_Foreground
301      (Men   : in Menu;
302       Fore  : in Character_Attribute_Set := Normal_Video;
303       Color : in Color_Pair := Color_Pair'First);
304    --  AKA
305
306    --  ANCHOR(`menu_fore()',`Foreground')
307    procedure Foreground (Men   : in  Menu;
308                          Fore  : out Character_Attribute_Set);
309    --  AKA
310
311    --  ANCHOR(`menu_fore()',`Foreground')
312    procedure Foreground (Men   : in  Menu;
313                          Fore  : out Character_Attribute_Set;
314                          Color : out Color_Pair);
315    --  AKA
316
317    --  ANCHOR(`set_menu_back()',`Set_Background')
318    procedure Set_Background
319      (Men   : in Menu;
320       Back  : in Character_Attribute_Set := Normal_Video;
321       Color : in Color_Pair := Color_Pair'First);
322    --  AKA
323
324    --  ANCHOR(`menu_back()',`Background')
325    procedure Background (Men  : in  Menu;
326                          Back : out Character_Attribute_Set);
327    --  AKA
328    --  ANCHOR(`menu_back()',`Background')
329
330    procedure Background (Men   : in  Menu;
331                          Back  : out Character_Attribute_Set;
332                          Color : out Color_Pair);
333    --  AKA
334
335    --  ANCHOR(`set_menu_grey()',`Set_Grey')
336    procedure Set_Grey
337      (Men   : in Menu;
338       Grey  : in Character_Attribute_Set := Normal_Video;
339       Color : in Color_Pair := Color_Pair'First);
340    --  AKA
341
342    --  ANCHOR(`menu_grey()',`Grey')
343    procedure Grey (Men  : in  Menu;
344                    Grey : out Character_Attribute_Set);
345    --  AKA
346
347    --  ANCHOR(`menu_grey()',`Grey')
348    procedure Grey
349      (Men   : in  Menu;
350       Grey  : out Character_Attribute_Set;
351       Color : out Color_Pair);
352    --  AKA
353
354    --  ANCHOR(`set_menu_pad()',`Set_Pad_Character')
355    procedure Set_Pad_Character (Men : in Menu;
356                                 Pad : in Character := Space);
357    --  AKA
358
359    --  ANCHOR(`menu_pad()',`Pad_Character')
360    procedure Pad_Character (Men : in  Menu;
361                             Pad : out Character);
362    --  AKA
363
364    --  MANPAGE(`menu_spacing.3x')
365
366    --  ANCHOR(`set_menu_spacing()',`Set_Spacing')
367    procedure Set_Spacing (Men   : in Menu;
368                           Descr : in Column_Position := 0;
369                           Row   : in Line_Position   := 0;
370                           Col   : in Column_Position := 0);
371    --  AKA
372
373    --  ANCHOR(`menu_spacing()',`Spacing')
374    procedure Spacing (Men   : in Menu;
375                       Descr : out Column_Position;
376                       Row   : out Line_Position;
377                       Col   : out Column_Position);
378    --  AKA
379
380    --  MANPAGE(`menu_pattern.3x')
381
382    --  ANCHOR(`set_menu_pattern()',`Set_Pattern')
383    function Set_Pattern (Men  : Menu;
384                          Text : String) return Boolean;
385    --  AKA
386    --  Return TRUE if the pattern matches, FALSE otherwise
387
388    --  ANCHOR(`menu_pattern()',`Pattern')
389    procedure Pattern (Men  : in  Menu;
390                       Text : out String);
391    --  AKA
392
393    --  MANPAGE(`menu_format.3x')
394
395    --  ANCHOR(`set_menu_format()',`Set_Format')
396    procedure Set_Format (Men     : in Menu;
397                          Lines   : in Line_Count;
398                          Columns : in Column_Count);
399    --  AKA
400
401    --  ANCHOR(`menu_format()',`Format')
402    procedure Format (Men     : in  Menu;
403                      Lines   : out Line_Count;
404                      Columns : out Column_Count);
405    --  AKA
406
407    --  MANPAGE(`menu_hook.3x')
408
409    type Menu_Hook_Function is access procedure (Men : in Menu);
410    pragma Convention (C, Menu_Hook_Function);
411
412    --  ANCHOR(`set_item_init()',`Set_Item_Init_Hook')
413    procedure Set_Item_Init_Hook (Men  : in Menu;
414                                  Proc : in Menu_Hook_Function);
415    --  AKA
416
417    --  ANCHOR(`set_item_term()',`Set_Item_Term_Hook')
418    procedure Set_Item_Term_Hook (Men  : in Menu;
419                                  Proc : in Menu_Hook_Function);
420    --  AKA
421
422    --  ANCHOR(`set_menu_init()',`Set_Menu_Init_Hook')
423    procedure Set_Menu_Init_Hook (Men  : in Menu;
424                                  Proc : in Menu_Hook_Function);
425    --  AKA
426
427    --  ANCHOR(`set_menu_term()',`Set_Menu_Term_Hook')
428    procedure Set_Menu_Term_Hook (Men  : in Menu;
429                                  Proc : in Menu_Hook_Function);
430    --  AKA
431
432    --  ANCHOR(`item_init()',`Get_Item_Init_Hook')
433    function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function;
434    --  AKA
435
436    --  ANCHOR(`item_term()',`Get_Item_Term_Hook')
437    function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function;
438    --  AKA
439
440    --  ANCHOR(`menu_init()',`Get_Menu_Init_Hook')
441    function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function;
442    --  AKA
443
444    --  ANCHOR(`menu_term()',`Get_Menu_Term_Hook')
445    function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function;
446    --  AKA
447
448    --  MANPAGE(`menu_items.3x')
449
450    --  ANCHOR(`set_menu_items()',`Redefine')
451    procedure Redefine (Men   : in Menu;
452                        Items : in Item_Array);
453    --  AKA
454    --  With a bit more comfort. You don´t need to terminate the Item_Array
455    --  with a null entry. This is handled internally in the binding.
456
457    procedure Set_Items (Men   : in Menu;
458                         Items : in Item_Array) renames Redefine;
459
460    --  ANCHOR(`menu_items()',`Items')
461    function Items (Men : Menu) return Item_Array_Access;
462    --  AKA
463
464    --  ANCHOR(`item_count()',`Item_Count')
465    function Item_Count (Men : Menu) return Natural;
466    --  AKA
467
468    --  MANPAGE(`menu_new.3x')
469
470    --  ANCHOR(`new_menu()',`Create')
471    function Create (Items : Item_Array) return Menu;
472    --  AKA
473
474    function New_Menu (Items : Item_Array) return Menu renames Create;
475
476    --  ANCHOR(`free_menu()',`Delete')
477    procedure Delete (Men : in out Menu);
478    --  AKA
479    --  Reset Men to Null_Menu
480
481    --  MANPAGE(`menu_new.3x')
482
483    type Driver_Result is (Menu_Ok,
484                           Request_Denied,
485                           Unknown_Request,
486                           No_Match);
487
488    --  ANCHOR(`menu_driver()',`Driver')
489    function Driver (Men : Menu;
490                     Key : Key_Code) return Driver_Result;
491    --  AKA
492
493 -------------------------------------------------------------------------------
494 private
495    type Item   is new System.Address;
496    type Menu   is new System.Address;
497
498    Null_Item : constant Item := Item (System.Null_Address);
499    Null_Menu : constant Menu := Menu (System.Null_Address);
500
501    --  This binding uses the original user pointer mechanism of a menu to store
502    --  specific informations about a menu. This wrapper record carries this
503    --  specifics and contains a field to maintain a new user pointer. Please
504    --  note that you must take this into account if you wan't to use the user
505    --  pointer mechanism of a menu created with this binding in low-level C
506    --  routines.
507    type Ada_User_Wrapper is
508       record
509          U : System.Address;
510          I : Item_Array_Access;
511       end record;
512    pragma Convention (C, Ada_User_Wrapper);
513    type Ada_User_Wrapper_Access is access all Ada_User_Wrapper;
514    pragma Controlled (Ada_User_Wrapper_Access);
515
516    Generation_Bit_Order : constant System.Bit_Order := System.M4_BIT_ORDER;
517    --  This constant may be different on your system.
518
519 end Terminal_Interface.Curses.Menus;