1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding --
5 -- Terminal_Interface.Curses.Menus --
9 ------------------------------------------------------------------------------
10 -- Copyright 2018,2020 Thomas E. Dickey --
11 -- Copyright 1999-2011,2014 Free Software Foundation, Inc. --
13 -- Permission is hereby granted, free of charge, to any person obtaining a --
14 -- copy of this software and associated documentation files (the --
15 -- "Software"), to deal in the Software without restriction, including --
16 -- without limitation the rights to use, copy, modify, merge, publish, --
17 -- distribute, distribute with modifications, sublicense, and/or sell --
18 -- copies of the Software, and to permit persons to whom the Software is --
19 -- furnished to do so, subject to the following conditions: --
21 -- The above copyright notice and this permission notice shall be included --
22 -- in all copies or substantial portions of the Software. --
24 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
25 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
26 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
27 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
28 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
29 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
30 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
32 -- Except as contained in this notice, the name(s) of the above copyright --
33 -- holders shall not be used in advertising or otherwise to promote the --
34 -- sale, use or other dealings in this Software without prior written --
36 ------------------------------------------------------------------------------
37 -- Author: Juergen Pfeifer, 1996
40 -- $Date: 2020/02/02 23:34:34 $
41 -- Binding Version 01.00
42 ------------------------------------------------------------------------------
43 with Ada.Unchecked_Deallocation;
44 with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
46 with Interfaces.C; use Interfaces.C;
47 with Interfaces.C.Strings; use Interfaces.C.Strings;
48 with Interfaces.C.Pointers;
50 package body Terminal_Interface.Curses.Menus is
52 type C_Item_Array is array (Natural range <>) of aliased Item;
53 package I_Array is new
54 Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item);
56 subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
58 ------------------------------------------------------------------------------
59 procedure Request_Name (Key : Menu_Request_Code;
62 function Request_Name (Key : C_Int) return chars_ptr;
63 pragma Import (C, Request_Name, "menu_request_name");
65 Fill_String (Request_Name (C_Int (Key)), Name);
68 function Request_Name (Key : Menu_Request_Code) return String
70 function Request_Name (Key : C_Int) return chars_ptr;
71 pragma Import (C, Request_Name, "menu_request_name");
73 return Fill_String (Request_Name (C_Int (Key)));
76 function Create (Name : String;
77 Description : String := "") return Item
79 type Char_Ptr is access all Interfaces.C.char;
80 function Newitem (Name, Desc : Char_Ptr) return Item;
81 pragma Import (C, Newitem, "new_item");
83 type Name_String is new char_array (0 .. Name'Length);
84 type Name_String_Ptr is access Name_String;
85 pragma Controlled (Name_String_Ptr);
87 type Desc_String is new char_array (0 .. Description'Length);
88 type Desc_String_Ptr is access Desc_String;
89 pragma Controlled (Desc_String_Ptr);
91 Name_Str : constant Name_String_Ptr := new Name_String;
92 Desc_Str : constant Desc_String_Ptr := new Desc_String;
93 Name_Len, Desc_Len : size_t;
96 To_C (Name, Name_Str.all, Name_Len);
97 To_C (Description, Desc_Str.all, Desc_Len);
98 Result := Newitem (Name_Str.all (Name_Str.all'First)'Access,
99 Desc_Str.all (Desc_Str.all'First)'Access);
100 if Result = Null_Item then
101 raise Eti_System_Error;
106 procedure Delete (Itm : in out Item)
108 function Descname (Itm : Item) return chars_ptr;
109 pragma Import (C, Descname, "item_description");
110 function Itemname (Itm : Item) return chars_ptr;
111 pragma Import (C, Itemname, "item_name");
113 function Freeitem (Itm : Item) return Eti_Error;
114 pragma Import (C, Freeitem, "free_item");
118 Ptr := Descname (Itm);
119 if Ptr /= Null_Ptr then
120 Interfaces.C.Strings.Free (Ptr);
122 Ptr := Itemname (Itm);
123 if Ptr /= Null_Ptr then
124 Interfaces.C.Strings.Free (Ptr);
126 Eti_Exception (Freeitem (Itm));
129 -------------------------------------------------------------------------------
130 procedure Set_Value (Itm : Item;
131 Value : Boolean := True)
133 function Set_Item_Val (Itm : Item;
134 Val : C_Int) return Eti_Error;
135 pragma Import (C, Set_Item_Val, "set_item_value");
138 Eti_Exception (Set_Item_Val (Itm, Boolean'Pos (Value)));
141 function Value (Itm : Item) return Boolean
143 function Item_Val (Itm : Item) return C_Int;
144 pragma Import (C, Item_Val, "item_value");
146 if Item_Val (Itm) = Curses_False then
153 -------------------------------------------------------------------------------
154 function Visible (Itm : Item) return Boolean
156 function Item_Vis (Itm : Item) return C_Int;
157 pragma Import (C, Item_Vis, "item_visible");
159 if Item_Vis (Itm) = Curses_False then
165 -------------------------------------------------------------------------------
166 procedure Set_Options (Itm : Item;
167 Options : Item_Option_Set)
169 function Set_Item_Opts (Itm : Item;
170 Opt : Item_Option_Set) return Eti_Error;
171 pragma Import (C, Set_Item_Opts, "set_item_opts");
174 Eti_Exception (Set_Item_Opts (Itm, Options));
177 procedure Switch_Options (Itm : Item;
178 Options : Item_Option_Set;
179 On : Boolean := True)
181 function Item_Opts_On (Itm : Item;
182 Opt : Item_Option_Set) return Eti_Error;
183 pragma Import (C, Item_Opts_On, "item_opts_on");
184 function Item_Opts_Off (Itm : Item;
185 Opt : Item_Option_Set) return Eti_Error;
186 pragma Import (C, Item_Opts_Off, "item_opts_off");
190 Eti_Exception (Item_Opts_On (Itm, Options));
192 Eti_Exception (Item_Opts_Off (Itm, Options));
196 procedure Get_Options (Itm : Item;
197 Options : out Item_Option_Set)
199 function Item_Opts (Itm : Item) return Item_Option_Set;
200 pragma Import (C, Item_Opts, "item_opts");
203 Options := Item_Opts (Itm);
206 function Get_Options (Itm : Item := Null_Item) return Item_Option_Set
208 Ios : Item_Option_Set;
210 Get_Options (Itm, Ios);
213 -------------------------------------------------------------------------------
214 procedure Name (Itm : Item;
217 function Itemname (Itm : Item) return chars_ptr;
218 pragma Import (C, Itemname, "item_name");
220 Fill_String (Itemname (Itm), Name);
223 function Name (Itm : Item) return String
225 function Itemname (Itm : Item) return chars_ptr;
226 pragma Import (C, Itemname, "item_name");
228 return Fill_String (Itemname (Itm));
231 procedure Description (Itm : Item;
232 Description : out String)
234 function Descname (Itm : Item) return chars_ptr;
235 pragma Import (C, Descname, "item_description");
237 Fill_String (Descname (Itm), Description);
240 function Description (Itm : Item) return String
242 function Descname (Itm : Item) return chars_ptr;
243 pragma Import (C, Descname, "item_description");
245 return Fill_String (Descname (Itm));
247 -------------------------------------------------------------------------------
248 procedure Set_Current (Men : Menu;
251 function Set_Curr_Item (Men : Menu;
252 Itm : Item) return Eti_Error;
253 pragma Import (C, Set_Curr_Item, "set_current_item");
256 Eti_Exception (Set_Curr_Item (Men, Itm));
259 function Current (Men : Menu) return Item
261 function Curr_Item (Men : Menu) return Item;
262 pragma Import (C, Curr_Item, "current_item");
264 Res : constant Item := Curr_Item (Men);
266 if Res = Null_Item then
267 raise Menu_Exception;
272 procedure Set_Top_Row (Men : Menu;
273 Line : Line_Position)
275 function Set_Toprow (Men : Menu;
276 Line : C_Int) return Eti_Error;
277 pragma Import (C, Set_Toprow, "set_top_row");
280 Eti_Exception (Set_Toprow (Men, C_Int (Line)));
283 function Top_Row (Men : Menu) return Line_Position
285 function Toprow (Men : Menu) return C_Int;
286 pragma Import (C, Toprow, "top_row");
288 Res : constant C_Int := Toprow (Men);
290 if Res = Curses_Err then
291 raise Menu_Exception;
293 return Line_Position (Res);
296 function Get_Index (Itm : Item) return Positive
298 function Get_Itemindex (Itm : Item) return C_Int;
299 pragma Import (C, Get_Itemindex, "item_index");
301 Res : constant C_Int := Get_Itemindex (Itm);
303 if Res = Curses_Err then
304 raise Menu_Exception;
306 return Positive (Natural (Res) + Positive'First);
308 -------------------------------------------------------------------------------
309 procedure Post (Men : Menu;
310 Post : Boolean := True)
312 function M_Post (Men : Menu) return Eti_Error;
313 pragma Import (C, M_Post, "post_menu");
314 function M_Unpost (Men : Menu) return Eti_Error;
315 pragma Import (C, M_Unpost, "unpost_menu");
319 Eti_Exception (M_Post (Men));
321 Eti_Exception (M_Unpost (Men));
324 -------------------------------------------------------------------------------
325 procedure Set_Options (Men : Menu;
326 Options : Menu_Option_Set)
328 function Set_Menu_Opts (Men : Menu;
329 Opt : Menu_Option_Set) return Eti_Error;
330 pragma Import (C, Set_Menu_Opts, "set_menu_opts");
333 Eti_Exception (Set_Menu_Opts (Men, Options));
336 procedure Switch_Options (Men : Menu;
337 Options : Menu_Option_Set;
338 On : Boolean := True)
340 function Menu_Opts_On (Men : Menu;
341 Opt : Menu_Option_Set) return Eti_Error;
342 pragma Import (C, Menu_Opts_On, "menu_opts_on");
343 function Menu_Opts_Off (Men : Menu;
344 Opt : Menu_Option_Set) return Eti_Error;
345 pragma Import (C, Menu_Opts_Off, "menu_opts_off");
349 Eti_Exception (Menu_Opts_On (Men, Options));
351 Eti_Exception (Menu_Opts_Off (Men, Options));
355 procedure Get_Options (Men : Menu;
356 Options : out Menu_Option_Set)
358 function Menu_Opts (Men : Menu) return Menu_Option_Set;
359 pragma Import (C, Menu_Opts, "menu_opts");
362 Options := Menu_Opts (Men);
365 function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set
367 Mos : Menu_Option_Set;
369 Get_Options (Men, Mos);
372 -------------------------------------------------------------------------------
373 procedure Set_Window (Men : Menu;
376 function Set_Menu_Win (Men : Menu;
377 Win : Window) return Eti_Error;
378 pragma Import (C, Set_Menu_Win, "set_menu_win");
381 Eti_Exception (Set_Menu_Win (Men, Win));
384 function Get_Window (Men : Menu) return Window
386 function Menu_Win (Men : Menu) return Window;
387 pragma Import (C, Menu_Win, "menu_win");
389 W : constant Window := Menu_Win (Men);
394 procedure Set_Sub_Window (Men : Menu;
397 function Set_Menu_Sub (Men : Menu;
398 Win : Window) return Eti_Error;
399 pragma Import (C, Set_Menu_Sub, "set_menu_sub");
402 Eti_Exception (Set_Menu_Sub (Men, Win));
405 function Get_Sub_Window (Men : Menu) return Window
407 function Menu_Sub (Men : Menu) return Window;
408 pragma Import (C, Menu_Sub, "menu_sub");
410 W : constant Window := Menu_Sub (Men);
415 procedure Scale (Men : Menu;
416 Lines : out Line_Count;
417 Columns : out Column_Count)
419 type C_Int_Access is access all C_Int;
420 function M_Scale (Men : Menu;
421 Yp, Xp : C_Int_Access) return Eti_Error;
422 pragma Import (C, M_Scale, "scale_menu");
424 X, Y : aliased C_Int;
426 Eti_Exception (M_Scale (Men, Y'Access, X'Access));
427 Lines := Line_Count (Y);
428 Columns := Column_Count (X);
430 -------------------------------------------------------------------------------
431 procedure Position_Cursor (Men : Menu)
433 function Pos_Menu_Cursor (Men : Menu) return Eti_Error;
434 pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor");
437 Eti_Exception (Pos_Menu_Cursor (Men));
440 -------------------------------------------------------------------------------
441 procedure Set_Mark (Men : Menu;
444 type Char_Ptr is access all Interfaces.C.char;
445 function Set_Mark (Men : Menu;
446 Mark : Char_Ptr) return Eti_Error;
447 pragma Import (C, Set_Mark, "set_menu_mark");
449 Txt : char_array (0 .. Mark'Length);
452 To_C (Mark, Txt, Len);
453 Eti_Exception (Set_Mark (Men, Txt (Txt'First)'Access));
456 procedure Mark (Men : Menu;
459 function Get_Menu_Mark (Men : Menu) return chars_ptr;
460 pragma Import (C, Get_Menu_Mark, "menu_mark");
462 Fill_String (Get_Menu_Mark (Men), Mark);
465 function Mark (Men : Menu) return String
467 function Get_Menu_Mark (Men : Menu) return chars_ptr;
468 pragma Import (C, Get_Menu_Mark, "menu_mark");
470 return Fill_String (Get_Menu_Mark (Men));
473 -------------------------------------------------------------------------------
474 procedure Set_Foreground
476 Fore : Character_Attribute_Set := Normal_Video;
477 Color : Color_Pair := Color_Pair'First)
479 function Set_Menu_Fore (Men : Menu;
480 Attr : Attributed_Character) return Eti_Error;
481 pragma Import (C, Set_Menu_Fore, "set_menu_fore");
483 Ch : constant Attributed_Character := (Ch => Character'First,
487 Eti_Exception (Set_Menu_Fore (Men, Ch));
490 procedure Foreground (Men : Menu;
491 Fore : out Character_Attribute_Set)
493 function Menu_Fore (Men : Menu) return Attributed_Character;
494 pragma Import (C, Menu_Fore, "menu_fore");
496 Fore := Menu_Fore (Men).Attr;
499 procedure Foreground (Men : Menu;
500 Fore : out Character_Attribute_Set;
501 Color : out Color_Pair)
503 function Menu_Fore (Men : Menu) return Attributed_Character;
504 pragma Import (C, Menu_Fore, "menu_fore");
506 Fore := Menu_Fore (Men).Attr;
507 Color := Menu_Fore (Men).Color;
510 procedure Set_Background
512 Back : Character_Attribute_Set := Normal_Video;
513 Color : Color_Pair := Color_Pair'First)
515 function Set_Menu_Back (Men : Menu;
516 Attr : Attributed_Character) return Eti_Error;
517 pragma Import (C, Set_Menu_Back, "set_menu_back");
519 Ch : constant Attributed_Character := (Ch => Character'First,
523 Eti_Exception (Set_Menu_Back (Men, Ch));
526 procedure Background (Men : Menu;
527 Back : out Character_Attribute_Set)
529 function Menu_Back (Men : Menu) return Attributed_Character;
530 pragma Import (C, Menu_Back, "menu_back");
532 Back := Menu_Back (Men).Attr;
535 procedure Background (Men : Menu;
536 Back : out Character_Attribute_Set;
537 Color : out Color_Pair)
539 function Menu_Back (Men : Menu) return Attributed_Character;
540 pragma Import (C, Menu_Back, "menu_back");
542 Back := Menu_Back (Men).Attr;
543 Color := Menu_Back (Men).Color;
546 procedure Set_Grey (Men : Menu;
547 Grey : Character_Attribute_Set := Normal_Video;
548 Color : Color_Pair := Color_Pair'First)
550 function Set_Menu_Grey (Men : Menu;
551 Attr : Attributed_Character) return Eti_Error;
552 pragma Import (C, Set_Menu_Grey, "set_menu_grey");
554 Ch : constant Attributed_Character := (Ch => Character'First,
559 Eti_Exception (Set_Menu_Grey (Men, Ch));
562 procedure Grey (Men : Menu;
563 Grey : out Character_Attribute_Set)
565 function Menu_Grey (Men : Menu) return Attributed_Character;
566 pragma Import (C, Menu_Grey, "menu_grey");
568 Grey := Menu_Grey (Men).Attr;
571 procedure Grey (Men : Menu;
572 Grey : out Character_Attribute_Set;
573 Color : out Color_Pair)
575 function Menu_Grey (Men : Menu) return Attributed_Character;
576 pragma Import (C, Menu_Grey, "menu_grey");
578 Grey := Menu_Grey (Men).Attr;
579 Color := Menu_Grey (Men).Color;
582 procedure Set_Pad_Character (Men : Menu;
583 Pad : Character := Space)
585 function Set_Menu_Pad (Men : Menu;
586 Ch : C_Int) return Eti_Error;
587 pragma Import (C, Set_Menu_Pad, "set_menu_pad");
590 Eti_Exception (Set_Menu_Pad (Men, C_Int (Character'Pos (Pad))));
591 end Set_Pad_Character;
593 procedure Pad_Character (Men : Menu;
596 function Menu_Pad (Men : Menu) return C_Int;
597 pragma Import (C, Menu_Pad, "menu_pad");
599 Pad := Character'Val (Menu_Pad (Men));
601 -------------------------------------------------------------------------------
602 procedure Set_Spacing (Men : Menu;
603 Descr : Column_Position := 0;
604 Row : Line_Position := 0;
605 Col : Column_Position := 0)
607 function Set_Spacing (Men : Menu;
608 D, R, C : C_Int) return Eti_Error;
609 pragma Import (C, Set_Spacing, "set_menu_spacing");
612 Eti_Exception (Set_Spacing (Men,
618 procedure Spacing (Men : Menu;
619 Descr : out Column_Position;
620 Row : out Line_Position;
621 Col : out Column_Position)
623 type C_Int_Access is access all C_Int;
624 function Get_Spacing (Men : Menu;
625 D, R, C : C_Int_Access) return Eti_Error;
626 pragma Import (C, Get_Spacing, "menu_spacing");
628 D, R, C : aliased C_Int;
630 Eti_Exception (Get_Spacing (Men,
634 Descr := Column_Position (D);
635 Row := Line_Position (R);
636 Col := Column_Position (C);
638 -------------------------------------------------------------------------------
639 function Set_Pattern (Men : Menu;
640 Text : String) return Boolean
642 type Char_Ptr is access all Interfaces.C.char;
643 function Set_Pattern (Men : Menu;
644 Pattern : Char_Ptr) return Eti_Error;
645 pragma Import (C, Set_Pattern, "set_menu_pattern");
647 S : char_array (0 .. Text'Length);
652 Res := Set_Pattern (Men, S (S'First)'Access);
662 procedure Pattern (Men : Menu;
665 function Get_Pattern (Men : Menu) return chars_ptr;
666 pragma Import (C, Get_Pattern, "menu_pattern");
668 Fill_String (Get_Pattern (Men), Text);
670 -------------------------------------------------------------------------------
671 procedure Set_Format (Men : Menu;
673 Columns : Column_Count)
675 function Set_Menu_Fmt (Men : Menu;
677 Col : C_Int) return Eti_Error;
678 pragma Import (C, Set_Menu_Fmt, "set_menu_format");
681 Eti_Exception (Set_Menu_Fmt (Men,
687 procedure Format (Men : Menu;
688 Lines : out Line_Count;
689 Columns : out Column_Count)
691 type C_Int_Access is access all C_Int;
692 function Menu_Fmt (Men : Menu;
693 Y, X : C_Int_Access) return Eti_Error;
694 pragma Import (C, Menu_Fmt, "menu_format");
696 L, C : aliased C_Int;
698 Eti_Exception (Menu_Fmt (Men, L'Access, C'Access));
699 Lines := Line_Count (L);
700 Columns := Column_Count (C);
702 -------------------------------------------------------------------------------
703 procedure Set_Item_Init_Hook (Men : Menu;
704 Proc : Menu_Hook_Function)
706 function Set_Item_Init (Men : Menu;
707 Proc : Menu_Hook_Function) return Eti_Error;
708 pragma Import (C, Set_Item_Init, "set_item_init");
711 Eti_Exception (Set_Item_Init (Men, Proc));
712 end Set_Item_Init_Hook;
714 procedure Set_Item_Term_Hook (Men : Menu;
715 Proc : Menu_Hook_Function)
717 function Set_Item_Term (Men : Menu;
718 Proc : Menu_Hook_Function) return Eti_Error;
719 pragma Import (C, Set_Item_Term, "set_item_term");
722 Eti_Exception (Set_Item_Term (Men, Proc));
723 end Set_Item_Term_Hook;
725 procedure Set_Menu_Init_Hook (Men : Menu;
726 Proc : Menu_Hook_Function)
728 function Set_Menu_Init (Men : Menu;
729 Proc : Menu_Hook_Function) return Eti_Error;
730 pragma Import (C, Set_Menu_Init, "set_menu_init");
733 Eti_Exception (Set_Menu_Init (Men, Proc));
734 end Set_Menu_Init_Hook;
736 procedure Set_Menu_Term_Hook (Men : Menu;
737 Proc : Menu_Hook_Function)
739 function Set_Menu_Term (Men : Menu;
740 Proc : Menu_Hook_Function) return Eti_Error;
741 pragma Import (C, Set_Menu_Term, "set_menu_term");
744 Eti_Exception (Set_Menu_Term (Men, Proc));
745 end Set_Menu_Term_Hook;
747 function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function
749 function Item_Init (Men : Menu) return Menu_Hook_Function;
750 pragma Import (C, Item_Init, "item_init");
752 return Item_Init (Men);
753 end Get_Item_Init_Hook;
755 function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function
757 function Item_Term (Men : Menu) return Menu_Hook_Function;
758 pragma Import (C, Item_Term, "item_term");
760 return Item_Term (Men);
761 end Get_Item_Term_Hook;
763 function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function
765 function Menu_Init (Men : Menu) return Menu_Hook_Function;
766 pragma Import (C, Menu_Init, "menu_init");
768 return Menu_Init (Men);
769 end Get_Menu_Init_Hook;
771 function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function
773 function Menu_Term (Men : Menu) return Menu_Hook_Function;
774 pragma Import (C, Menu_Term, "menu_term");
776 return Menu_Term (Men);
777 end Get_Menu_Term_Hook;
778 -------------------------------------------------------------------------------
779 procedure Redefine (Men : Menu;
780 Items : Item_Array_Access)
782 function Set_Items (Men : Menu;
783 Items : System.Address) return Eti_Error;
784 pragma Import (C, Set_Items, "set_menu_items");
787 pragma Assert (Items.all (Items'Last) = Null_Item);
788 if Items.all (Items'Last) /= Null_Item then
789 raise Menu_Exception;
791 Eti_Exception (Set_Items (Men, Items.all'Address));
795 function Item_Count (Men : Menu) return Natural
797 function Count (Men : Menu) return C_Int;
798 pragma Import (C, Count, "item_count");
800 return Natural (Count (Men));
803 function Items (Men : Menu;
804 Index : Positive) return Item
808 function C_Mitems (Men : Menu) return Pointer;
809 pragma Import (C, C_Mitems, "menu_items");
811 P : Pointer := C_Mitems (Men);
813 if P = null or else Index > Item_Count (Men) then
814 raise Menu_Exception;
816 P := P + ptrdiff_t (C_Int (Index) - 1);
821 -------------------------------------------------------------------------------
822 function Create (Items : Item_Array_Access) return Menu
824 function Newmenu (Items : System.Address) return Menu;
825 pragma Import (C, Newmenu, "new_menu");
829 pragma Assert (Items.all (Items'Last) = Null_Item);
830 if Items.all (Items'Last) /= Null_Item then
831 raise Menu_Exception;
833 M := Newmenu (Items.all'Address);
834 if M = Null_Menu then
835 raise Menu_Exception;
841 procedure Delete (Men : in out Menu)
843 function Free (Men : Menu) return Eti_Error;
844 pragma Import (C, Free, "free_menu");
847 Eti_Exception (Free (Men));
851 ------------------------------------------------------------------------------
852 function Driver (Men : Menu;
853 Key : Key_Code) return Driver_Result
855 function Driver (Men : Menu;
856 Key : C_Int) return Eti_Error;
857 pragma Import (C, Driver, "menu_driver");
859 R : constant Eti_Error := Driver (Men, C_Int (Key));
862 when E_Unknown_Command =>
863 return Unknown_Request;
866 when E_Request_Denied | E_Not_Selectable =>
867 return Request_Denied;
874 procedure Free (IA : in out Item_Array_Access;
875 Free_Items : Boolean := False)
877 procedure Release is new Ada.Unchecked_Deallocation
878 (Item_Array, Item_Array_Access);
880 if IA /= null and then Free_Items then
881 for I in IA'First .. (IA'Last - 1) loop
882 if IA.all (I) /= Null_Item then
890 -------------------------------------------------------------------------------
891 function Default_Menu_Options return Menu_Option_Set
894 return Get_Options (Null_Menu);
895 end Default_Menu_Options;
897 function Default_Item_Options return Item_Option_Set
900 return Get_Options (Null_Item);
901 end Default_Item_Options;
902 -------------------------------------------------------------------------------
904 end Terminal_Interface.Curses.Menus;