1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding --
5 -- Terminal_Interface.Curses.Menus --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998-2014,2018 Free Software Foundation, Inc. --
12 -- Permission is hereby granted, free of charge, to any person obtaining a --
13 -- copy of this software and associated documentation files (the --
14 -- "Software"), to deal in the Software without restriction, including --
15 -- without limitation the rights to use, copy, modify, merge, publish, --
16 -- distribute, distribute with modifications, sublicense, and/or sell --
17 -- copies of the Software, and to permit persons to whom the Software is --
18 -- furnished to do so, subject to the following conditions: --
20 -- The above copyright notice and this permission notice shall be included --
21 -- in all copies or substantial portions of the Software. --
23 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
24 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
25 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
26 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
27 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
28 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
29 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
31 -- Except as contained in this notice, the name(s) of the above copyright --
32 -- holders shall not be used in advertising or otherwise to promote the --
33 -- sale, use or other dealings in this Software without prior written --
35 ------------------------------------------------------------------------------
36 -- Author: Juergen Pfeifer, 1996
39 -- $Date: 2018/07/07 23:36:44 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with Ada.Unchecked_Deallocation;
43 with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
45 with Interfaces.C; use Interfaces.C;
46 with Interfaces.C.Strings; use Interfaces.C.Strings;
47 with Interfaces.C.Pointers;
49 package body Terminal_Interface.Curses.Menus is
51 type C_Item_Array is array (Natural range <>) of aliased Item;
52 package I_Array is new
53 Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item);
55 subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
57 ------------------------------------------------------------------------------
58 procedure Request_Name (Key : Menu_Request_Code;
61 function Request_Name (Key : C_Int) return chars_ptr;
62 pragma Import (C, Request_Name, "menu_request_name");
64 Fill_String (Request_Name (C_Int (Key)), Name);
67 function Request_Name (Key : Menu_Request_Code) return String
69 function Request_Name (Key : C_Int) return chars_ptr;
70 pragma Import (C, Request_Name, "menu_request_name");
72 return Fill_String (Request_Name (C_Int (Key)));
75 function Create (Name : String;
76 Description : String := "") return Item
78 type Char_Ptr is access all Interfaces.C.char;
79 function Newitem (Name, Desc : Char_Ptr) return Item;
80 pragma Import (C, Newitem, "new_item");
82 type Name_String is new char_array (0 .. Name'Length);
83 type Name_String_Ptr is access Name_String;
84 pragma Controlled (Name_String_Ptr);
86 type Desc_String is new char_array (0 .. Description'Length);
87 type Desc_String_Ptr is access Desc_String;
88 pragma Controlled (Desc_String_Ptr);
90 Name_Str : constant Name_String_Ptr := new Name_String;
91 Desc_Str : constant Desc_String_Ptr := new Desc_String;
92 Name_Len, Desc_Len : size_t;
95 To_C (Name, Name_Str.all, Name_Len);
96 To_C (Description, Desc_Str.all, Desc_Len);
97 Result := Newitem (Name_Str.all (Name_Str.all'First)'Access,
98 Desc_Str.all (Desc_Str.all'First)'Access);
99 if Result = Null_Item then
100 raise Eti_System_Error;
105 procedure Delete (Itm : in out Item)
107 function Descname (Itm : Item) return chars_ptr;
108 pragma Import (C, Descname, "item_description");
109 function Itemname (Itm : Item) return chars_ptr;
110 pragma Import (C, Itemname, "item_name");
112 function Freeitem (Itm : Item) return Eti_Error;
113 pragma Import (C, Freeitem, "free_item");
117 Ptr := Descname (Itm);
118 if Ptr /= Null_Ptr then
119 Interfaces.C.Strings.Free (Ptr);
121 Ptr := Itemname (Itm);
122 if Ptr /= Null_Ptr then
123 Interfaces.C.Strings.Free (Ptr);
125 Eti_Exception (Freeitem (Itm));
128 -------------------------------------------------------------------------------
129 procedure Set_Value (Itm : Item;
130 Value : Boolean := True)
132 function Set_Item_Val (Itm : Item;
133 Val : C_Int) return Eti_Error;
134 pragma Import (C, Set_Item_Val, "set_item_value");
137 Eti_Exception (Set_Item_Val (Itm, Boolean'Pos (Value)));
140 function Value (Itm : Item) return Boolean
142 function Item_Val (Itm : Item) return C_Int;
143 pragma Import (C, Item_Val, "item_value");
145 if Item_Val (Itm) = Curses_False then
152 -------------------------------------------------------------------------------
153 function Visible (Itm : Item) return Boolean
155 function Item_Vis (Itm : Item) return C_Int;
156 pragma Import (C, Item_Vis, "item_visible");
158 if Item_Vis (Itm) = Curses_False then
164 -------------------------------------------------------------------------------
165 procedure Set_Options (Itm : Item;
166 Options : Item_Option_Set)
168 function Set_Item_Opts (Itm : Item;
169 Opt : Item_Option_Set) return Eti_Error;
170 pragma Import (C, Set_Item_Opts, "set_item_opts");
173 Eti_Exception (Set_Item_Opts (Itm, Options));
176 procedure Switch_Options (Itm : Item;
177 Options : Item_Option_Set;
178 On : Boolean := True)
180 function Item_Opts_On (Itm : Item;
181 Opt : Item_Option_Set) return Eti_Error;
182 pragma Import (C, Item_Opts_On, "item_opts_on");
183 function Item_Opts_Off (Itm : Item;
184 Opt : Item_Option_Set) return Eti_Error;
185 pragma Import (C, Item_Opts_Off, "item_opts_off");
189 Eti_Exception (Item_Opts_On (Itm, Options));
191 Eti_Exception (Item_Opts_Off (Itm, Options));
195 procedure Get_Options (Itm : Item;
196 Options : out Item_Option_Set)
198 function Item_Opts (Itm : Item) return Item_Option_Set;
199 pragma Import (C, Item_Opts, "item_opts");
202 Options := Item_Opts (Itm);
205 function Get_Options (Itm : Item := Null_Item) return Item_Option_Set
207 Ios : Item_Option_Set;
209 Get_Options (Itm, Ios);
212 -------------------------------------------------------------------------------
213 procedure Name (Itm : Item;
216 function Itemname (Itm : Item) return chars_ptr;
217 pragma Import (C, Itemname, "item_name");
219 Fill_String (Itemname (Itm), Name);
222 function Name (Itm : Item) return String
224 function Itemname (Itm : Item) return chars_ptr;
225 pragma Import (C, Itemname, "item_name");
227 return Fill_String (Itemname (Itm));
230 procedure Description (Itm : Item;
231 Description : out String)
233 function Descname (Itm : Item) return chars_ptr;
234 pragma Import (C, Descname, "item_description");
236 Fill_String (Descname (Itm), Description);
239 function Description (Itm : Item) return String
241 function Descname (Itm : Item) return chars_ptr;
242 pragma Import (C, Descname, "item_description");
244 return Fill_String (Descname (Itm));
246 -------------------------------------------------------------------------------
247 procedure Set_Current (Men : Menu;
250 function Set_Curr_Item (Men : Menu;
251 Itm : Item) return Eti_Error;
252 pragma Import (C, Set_Curr_Item, "set_current_item");
255 Eti_Exception (Set_Curr_Item (Men, Itm));
258 function Current (Men : Menu) return Item
260 function Curr_Item (Men : Menu) return Item;
261 pragma Import (C, Curr_Item, "current_item");
263 Res : constant Item := Curr_Item (Men);
265 if Res = Null_Item then
266 raise Menu_Exception;
271 procedure Set_Top_Row (Men : Menu;
272 Line : Line_Position)
274 function Set_Toprow (Men : Menu;
275 Line : C_Int) return Eti_Error;
276 pragma Import (C, Set_Toprow, "set_top_row");
279 Eti_Exception (Set_Toprow (Men, C_Int (Line)));
282 function Top_Row (Men : Menu) return Line_Position
284 function Toprow (Men : Menu) return C_Int;
285 pragma Import (C, Toprow, "top_row");
287 Res : constant C_Int := Toprow (Men);
289 if Res = Curses_Err then
290 raise Menu_Exception;
292 return Line_Position (Res);
295 function Get_Index (Itm : Item) return Positive
297 function Get_Itemindex (Itm : Item) return C_Int;
298 pragma Import (C, Get_Itemindex, "item_index");
300 Res : constant C_Int := Get_Itemindex (Itm);
302 if Res = Curses_Err then
303 raise Menu_Exception;
305 return Positive (Natural (Res) + Positive'First);
307 -------------------------------------------------------------------------------
308 procedure Post (Men : Menu;
309 Post : Boolean := True)
311 function M_Post (Men : Menu) return Eti_Error;
312 pragma Import (C, M_Post, "post_menu");
313 function M_Unpost (Men : Menu) return Eti_Error;
314 pragma Import (C, M_Unpost, "unpost_menu");
318 Eti_Exception (M_Post (Men));
320 Eti_Exception (M_Unpost (Men));
323 -------------------------------------------------------------------------------
324 procedure Set_Options (Men : Menu;
325 Options : Menu_Option_Set)
327 function Set_Menu_Opts (Men : Menu;
328 Opt : Menu_Option_Set) return Eti_Error;
329 pragma Import (C, Set_Menu_Opts, "set_menu_opts");
332 Eti_Exception (Set_Menu_Opts (Men, Options));
335 procedure Switch_Options (Men : Menu;
336 Options : Menu_Option_Set;
337 On : Boolean := True)
339 function Menu_Opts_On (Men : Menu;
340 Opt : Menu_Option_Set) return Eti_Error;
341 pragma Import (C, Menu_Opts_On, "menu_opts_on");
342 function Menu_Opts_Off (Men : Menu;
343 Opt : Menu_Option_Set) return Eti_Error;
344 pragma Import (C, Menu_Opts_Off, "menu_opts_off");
348 Eti_Exception (Menu_Opts_On (Men, Options));
350 Eti_Exception (Menu_Opts_Off (Men, Options));
354 procedure Get_Options (Men : Menu;
355 Options : out Menu_Option_Set)
357 function Menu_Opts (Men : Menu) return Menu_Option_Set;
358 pragma Import (C, Menu_Opts, "menu_opts");
361 Options := Menu_Opts (Men);
364 function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set
366 Mos : Menu_Option_Set;
368 Get_Options (Men, Mos);
371 -------------------------------------------------------------------------------
372 procedure Set_Window (Men : Menu;
375 function Set_Menu_Win (Men : Menu;
376 Win : Window) return Eti_Error;
377 pragma Import (C, Set_Menu_Win, "set_menu_win");
380 Eti_Exception (Set_Menu_Win (Men, Win));
383 function Get_Window (Men : Menu) return Window
385 function Menu_Win (Men : Menu) return Window;
386 pragma Import (C, Menu_Win, "menu_win");
388 W : constant Window := Menu_Win (Men);
393 procedure Set_Sub_Window (Men : Menu;
396 function Set_Menu_Sub (Men : Menu;
397 Win : Window) return Eti_Error;
398 pragma Import (C, Set_Menu_Sub, "set_menu_sub");
401 Eti_Exception (Set_Menu_Sub (Men, Win));
404 function Get_Sub_Window (Men : Menu) return Window
406 function Menu_Sub (Men : Menu) return Window;
407 pragma Import (C, Menu_Sub, "menu_sub");
409 W : constant Window := Menu_Sub (Men);
414 procedure Scale (Men : Menu;
415 Lines : out Line_Count;
416 Columns : out Column_Count)
418 type C_Int_Access is access all C_Int;
419 function M_Scale (Men : Menu;
420 Yp, Xp : C_Int_Access) return Eti_Error;
421 pragma Import (C, M_Scale, "scale_menu");
423 X, Y : aliased C_Int;
425 Eti_Exception (M_Scale (Men, Y'Access, X'Access));
426 Lines := Line_Count (Y);
427 Columns := Column_Count (X);
429 -------------------------------------------------------------------------------
430 procedure Position_Cursor (Men : Menu)
432 function Pos_Menu_Cursor (Men : Menu) return Eti_Error;
433 pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor");
436 Eti_Exception (Pos_Menu_Cursor (Men));
439 -------------------------------------------------------------------------------
440 procedure Set_Mark (Men : Menu;
443 type Char_Ptr is access all Interfaces.C.char;
444 function Set_Mark (Men : Menu;
445 Mark : Char_Ptr) return Eti_Error;
446 pragma Import (C, Set_Mark, "set_menu_mark");
448 Txt : char_array (0 .. Mark'Length);
451 To_C (Mark, Txt, Len);
452 Eti_Exception (Set_Mark (Men, Txt (Txt'First)'Access));
455 procedure Mark (Men : Menu;
458 function Get_Menu_Mark (Men : Menu) return chars_ptr;
459 pragma Import (C, Get_Menu_Mark, "menu_mark");
461 Fill_String (Get_Menu_Mark (Men), Mark);
464 function Mark (Men : Menu) return String
466 function Get_Menu_Mark (Men : Menu) return chars_ptr;
467 pragma Import (C, Get_Menu_Mark, "menu_mark");
469 return Fill_String (Get_Menu_Mark (Men));
472 -------------------------------------------------------------------------------
473 procedure Set_Foreground
475 Fore : Character_Attribute_Set := Normal_Video;
476 Color : Color_Pair := Color_Pair'First)
478 function Set_Menu_Fore (Men : Menu;
479 Attr : Attributed_Character) return Eti_Error;
480 pragma Import (C, Set_Menu_Fore, "set_menu_fore");
482 Ch : constant Attributed_Character := (Ch => Character'First,
486 Eti_Exception (Set_Menu_Fore (Men, Ch));
489 procedure Foreground (Men : Menu;
490 Fore : out Character_Attribute_Set)
492 function Menu_Fore (Men : Menu) return Attributed_Character;
493 pragma Import (C, Menu_Fore, "menu_fore");
495 Fore := Menu_Fore (Men).Attr;
498 procedure Foreground (Men : Menu;
499 Fore : out Character_Attribute_Set;
500 Color : out Color_Pair)
502 function Menu_Fore (Men : Menu) return Attributed_Character;
503 pragma Import (C, Menu_Fore, "menu_fore");
505 Fore := Menu_Fore (Men).Attr;
506 Color := Menu_Fore (Men).Color;
509 procedure Set_Background
511 Back : Character_Attribute_Set := Normal_Video;
512 Color : Color_Pair := Color_Pair'First)
514 function Set_Menu_Back (Men : Menu;
515 Attr : Attributed_Character) return Eti_Error;
516 pragma Import (C, Set_Menu_Back, "set_menu_back");
518 Ch : constant Attributed_Character := (Ch => Character'First,
522 Eti_Exception (Set_Menu_Back (Men, Ch));
525 procedure Background (Men : Menu;
526 Back : out Character_Attribute_Set)
528 function Menu_Back (Men : Menu) return Attributed_Character;
529 pragma Import (C, Menu_Back, "menu_back");
531 Back := Menu_Back (Men).Attr;
534 procedure Background (Men : Menu;
535 Back : out Character_Attribute_Set;
536 Color : out Color_Pair)
538 function Menu_Back (Men : Menu) return Attributed_Character;
539 pragma Import (C, Menu_Back, "menu_back");
541 Back := Menu_Back (Men).Attr;
542 Color := Menu_Back (Men).Color;
545 procedure Set_Grey (Men : Menu;
546 Grey : Character_Attribute_Set := Normal_Video;
547 Color : Color_Pair := Color_Pair'First)
549 function Set_Menu_Grey (Men : Menu;
550 Attr : Attributed_Character) return Eti_Error;
551 pragma Import (C, Set_Menu_Grey, "set_menu_grey");
553 Ch : constant Attributed_Character := (Ch => Character'First,
558 Eti_Exception (Set_Menu_Grey (Men, Ch));
561 procedure Grey (Men : Menu;
562 Grey : out Character_Attribute_Set)
564 function Menu_Grey (Men : Menu) return Attributed_Character;
565 pragma Import (C, Menu_Grey, "menu_grey");
567 Grey := Menu_Grey (Men).Attr;
570 procedure Grey (Men : Menu;
571 Grey : out Character_Attribute_Set;
572 Color : out Color_Pair)
574 function Menu_Grey (Men : Menu) return Attributed_Character;
575 pragma Import (C, Menu_Grey, "menu_grey");
577 Grey := Menu_Grey (Men).Attr;
578 Color := Menu_Grey (Men).Color;
581 procedure Set_Pad_Character (Men : Menu;
582 Pad : Character := Space)
584 function Set_Menu_Pad (Men : Menu;
585 Ch : C_Int) return Eti_Error;
586 pragma Import (C, Set_Menu_Pad, "set_menu_pad");
589 Eti_Exception (Set_Menu_Pad (Men, C_Int (Character'Pos (Pad))));
590 end Set_Pad_Character;
592 procedure Pad_Character (Men : Menu;
595 function Menu_Pad (Men : Menu) return C_Int;
596 pragma Import (C, Menu_Pad, "menu_pad");
598 Pad := Character'Val (Menu_Pad (Men));
600 -------------------------------------------------------------------------------
601 procedure Set_Spacing (Men : Menu;
602 Descr : Column_Position := 0;
603 Row : Line_Position := 0;
604 Col : Column_Position := 0)
606 function Set_Spacing (Men : Menu;
607 D, R, C : C_Int) return Eti_Error;
608 pragma Import (C, Set_Spacing, "set_menu_spacing");
611 Eti_Exception (Set_Spacing (Men,
617 procedure Spacing (Men : Menu;
618 Descr : out Column_Position;
619 Row : out Line_Position;
620 Col : out Column_Position)
622 type C_Int_Access is access all C_Int;
623 function Get_Spacing (Men : Menu;
624 D, R, C : C_Int_Access) return Eti_Error;
625 pragma Import (C, Get_Spacing, "menu_spacing");
627 D, R, C : aliased C_Int;
629 Eti_Exception (Get_Spacing (Men,
633 Descr := Column_Position (D);
634 Row := Line_Position (R);
635 Col := Column_Position (C);
637 -------------------------------------------------------------------------------
638 function Set_Pattern (Men : Menu;
639 Text : String) return Boolean
641 type Char_Ptr is access all Interfaces.C.char;
642 function Set_Pattern (Men : Menu;
643 Pattern : Char_Ptr) return Eti_Error;
644 pragma Import (C, Set_Pattern, "set_menu_pattern");
646 S : char_array (0 .. Text'Length);
651 Res := Set_Pattern (Men, S (S'First)'Access);
661 procedure Pattern (Men : Menu;
664 function Get_Pattern (Men : Menu) return chars_ptr;
665 pragma Import (C, Get_Pattern, "menu_pattern");
667 Fill_String (Get_Pattern (Men), Text);
669 -------------------------------------------------------------------------------
670 procedure Set_Format (Men : Menu;
672 Columns : Column_Count)
674 function Set_Menu_Fmt (Men : Menu;
676 Col : C_Int) return Eti_Error;
677 pragma Import (C, Set_Menu_Fmt, "set_menu_format");
680 Eti_Exception (Set_Menu_Fmt (Men,
686 procedure Format (Men : Menu;
687 Lines : out Line_Count;
688 Columns : out Column_Count)
690 type C_Int_Access is access all C_Int;
691 function Menu_Fmt (Men : Menu;
692 Y, X : C_Int_Access) return Eti_Error;
693 pragma Import (C, Menu_Fmt, "menu_format");
695 L, C : aliased C_Int;
697 Eti_Exception (Menu_Fmt (Men, L'Access, C'Access));
698 Lines := Line_Count (L);
699 Columns := Column_Count (C);
701 -------------------------------------------------------------------------------
702 procedure Set_Item_Init_Hook (Men : Menu;
703 Proc : Menu_Hook_Function)
705 function Set_Item_Init (Men : Menu;
706 Proc : Menu_Hook_Function) return Eti_Error;
707 pragma Import (C, Set_Item_Init, "set_item_init");
710 Eti_Exception (Set_Item_Init (Men, Proc));
711 end Set_Item_Init_Hook;
713 procedure Set_Item_Term_Hook (Men : Menu;
714 Proc : Menu_Hook_Function)
716 function Set_Item_Term (Men : Menu;
717 Proc : Menu_Hook_Function) return Eti_Error;
718 pragma Import (C, Set_Item_Term, "set_item_term");
721 Eti_Exception (Set_Item_Term (Men, Proc));
722 end Set_Item_Term_Hook;
724 procedure Set_Menu_Init_Hook (Men : Menu;
725 Proc : Menu_Hook_Function)
727 function Set_Menu_Init (Men : Menu;
728 Proc : Menu_Hook_Function) return Eti_Error;
729 pragma Import (C, Set_Menu_Init, "set_menu_init");
732 Eti_Exception (Set_Menu_Init (Men, Proc));
733 end Set_Menu_Init_Hook;
735 procedure Set_Menu_Term_Hook (Men : Menu;
736 Proc : Menu_Hook_Function)
738 function Set_Menu_Term (Men : Menu;
739 Proc : Menu_Hook_Function) return Eti_Error;
740 pragma Import (C, Set_Menu_Term, "set_menu_term");
743 Eti_Exception (Set_Menu_Term (Men, Proc));
744 end Set_Menu_Term_Hook;
746 function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function
748 function Item_Init (Men : Menu) return Menu_Hook_Function;
749 pragma Import (C, Item_Init, "item_init");
751 return Item_Init (Men);
752 end Get_Item_Init_Hook;
754 function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function
756 function Item_Term (Men : Menu) return Menu_Hook_Function;
757 pragma Import (C, Item_Term, "item_term");
759 return Item_Term (Men);
760 end Get_Item_Term_Hook;
762 function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function
764 function Menu_Init (Men : Menu) return Menu_Hook_Function;
765 pragma Import (C, Menu_Init, "menu_init");
767 return Menu_Init (Men);
768 end Get_Menu_Init_Hook;
770 function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function
772 function Menu_Term (Men : Menu) return Menu_Hook_Function;
773 pragma Import (C, Menu_Term, "menu_term");
775 return Menu_Term (Men);
776 end Get_Menu_Term_Hook;
777 -------------------------------------------------------------------------------
778 procedure Redefine (Men : Menu;
779 Items : Item_Array_Access)
781 function Set_Items (Men : Menu;
782 Items : System.Address) return Eti_Error;
783 pragma Import (C, Set_Items, "set_menu_items");
786 pragma Assert (Items.all (Items'Last) = Null_Item);
787 if Items.all (Items'Last) /= Null_Item then
788 raise Menu_Exception;
790 Eti_Exception (Set_Items (Men, Items.all'Address));
794 function Item_Count (Men : Menu) return Natural
796 function Count (Men : Menu) return C_Int;
797 pragma Import (C, Count, "item_count");
799 return Natural (Count (Men));
802 function Items (Men : Menu;
803 Index : Positive) return Item
807 function C_Mitems (Men : Menu) return Pointer;
808 pragma Import (C, C_Mitems, "menu_items");
810 P : Pointer := C_Mitems (Men);
812 if P = null or else Index > Item_Count (Men) then
813 raise Menu_Exception;
815 P := P + ptrdiff_t (C_Int (Index) - 1);
820 -------------------------------------------------------------------------------
821 function Create (Items : Item_Array_Access) return Menu
823 function Newmenu (Items : System.Address) return Menu;
824 pragma Import (C, Newmenu, "new_menu");
828 pragma Assert (Items.all (Items'Last) = Null_Item);
829 if Items.all (Items'Last) /= Null_Item then
830 raise Menu_Exception;
832 M := Newmenu (Items.all'Address);
833 if M = Null_Menu then
834 raise Menu_Exception;
840 procedure Delete (Men : in out Menu)
842 function Free (Men : Menu) return Eti_Error;
843 pragma Import (C, Free, "free_menu");
846 Eti_Exception (Free (Men));
850 ------------------------------------------------------------------------------
851 function Driver (Men : Menu;
852 Key : Key_Code) return Driver_Result
854 function Driver (Men : Menu;
855 Key : C_Int) return Eti_Error;
856 pragma Import (C, Driver, "menu_driver");
858 R : constant Eti_Error := Driver (Men, C_Int (Key));
861 when E_Unknown_Command =>
862 return Unknown_Request;
865 when E_Request_Denied | E_Not_Selectable =>
866 return Request_Denied;
873 procedure Free (IA : in out Item_Array_Access;
874 Free_Items : Boolean := False)
876 procedure Release is new Ada.Unchecked_Deallocation
877 (Item_Array, Item_Array_Access);
879 if IA /= null and then Free_Items then
880 for I in IA'First .. (IA'Last - 1) loop
881 if IA.all (I) /= Null_Item then
889 -------------------------------------------------------------------------------
890 function Default_Menu_Options return Menu_Option_Set
893 return Get_Options (Null_Menu);
894 end Default_Menu_Options;
896 function Default_Item_Options return Item_Option_Set
899 return Get_Options (Null_Item);
900 end Default_Item_Options;
901 -------------------------------------------------------------------------------
903 end Terminal_Interface.Curses.Menus;