1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding --
5 -- Terminal_Interface.Curses.Menus --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998-2009,2011 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: 2011/03/22 23:38:12 $
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 with Ada.Unchecked_Conversion;
51 package body Terminal_Interface.Curses.Menus is
53 type C_Item_Array is array (Natural range <>) of aliased Item;
54 package I_Array is new
55 Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item);
57 use type System.Bit_Order;
58 subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
60 function MOS_2_CInt is new
61 Ada.Unchecked_Conversion (Menu_Option_Set,
64 function CInt_2_MOS is new
65 Ada.Unchecked_Conversion (C_Int,
68 function IOS_2_CInt is new
69 Ada.Unchecked_Conversion (Item_Option_Set,
72 function CInt_2_IOS is new
73 Ada.Unchecked_Conversion (C_Int,
76 ------------------------------------------------------------------------------
77 procedure Request_Name (Key : Menu_Request_Code;
80 function Request_Name (Key : C_Int) return chars_ptr;
81 pragma Import (C, Request_Name, "menu_request_name");
83 Fill_String (Request_Name (C_Int (Key)), Name);
86 function Request_Name (Key : Menu_Request_Code) return String
88 function Request_Name (Key : C_Int) return chars_ptr;
89 pragma Import (C, Request_Name, "menu_request_name");
91 return Fill_String (Request_Name (C_Int (Key)));
94 function Create (Name : String;
95 Description : String := "") return Item
97 type Char_Ptr is access all Interfaces.C.char;
98 function Newitem (Name, Desc : Char_Ptr) return Item;
99 pragma Import (C, Newitem, "new_item");
101 type Name_String is new char_array (0 .. Name'Length);
102 type Name_String_Ptr is access Name_String;
103 pragma Controlled (Name_String_Ptr);
105 type Desc_String is new char_array (0 .. Description'Length);
106 type Desc_String_Ptr is access Desc_String;
107 pragma Controlled (Desc_String_Ptr);
109 Name_Str : constant Name_String_Ptr := new Name_String;
110 Desc_Str : constant Desc_String_Ptr := new Desc_String;
111 Name_Len, Desc_Len : size_t;
114 To_C (Name, Name_Str.all, Name_Len);
115 To_C (Description, Desc_Str.all, Desc_Len);
116 Result := Newitem (Name_Str.all (Name_Str.all'First)'Access,
117 Desc_Str.all (Desc_Str.all'First)'Access);
118 if Result = Null_Item then
119 raise Eti_System_Error;
124 procedure Delete (Itm : in out Item)
126 function Descname (Itm : Item) return chars_ptr;
127 pragma Import (C, Descname, "item_description");
128 function Itemname (Itm : Item) return chars_ptr;
129 pragma Import (C, Itemname, "item_name");
131 function Freeitem (Itm : Item) return C_Int;
132 pragma Import (C, Freeitem, "free_item");
137 Ptr := Descname (Itm);
138 if Ptr /= Null_Ptr then
139 Interfaces.C.Strings.Free (Ptr);
141 Ptr := Itemname (Itm);
142 if Ptr /= Null_Ptr then
143 Interfaces.C.Strings.Free (Ptr);
145 Res := Freeitem (Itm);
151 -------------------------------------------------------------------------------
152 procedure Set_Value (Itm : Item;
153 Value : Boolean := True)
155 function Set_Item_Val (Itm : Item;
156 Val : C_Int) return C_Int;
157 pragma Import (C, Set_Item_Val, "set_item_value");
159 Res : constant Eti_Error := Set_Item_Val (Itm, Boolean'Pos (Value));
166 function Value (Itm : Item) return Boolean
168 function Item_Val (Itm : Item) return C_Int;
169 pragma Import (C, Item_Val, "item_value");
171 if Item_Val (Itm) = Curses_False then
178 -------------------------------------------------------------------------------
179 function Visible (Itm : Item) return Boolean
181 function Item_Vis (Itm : Item) return C_Int;
182 pragma Import (C, Item_Vis, "item_visible");
184 if Item_Vis (Itm) = Curses_False then
190 -------------------------------------------------------------------------------
191 procedure Set_Options (Itm : Item;
192 Options : Item_Option_Set)
194 function Set_Item_Opts (Itm : Item;
195 Opt : C_Int) return C_Int;
196 pragma Import (C, Set_Item_Opts, "set_item_opts");
198 Opt : constant C_Int := IOS_2_CInt (Options);
201 Res := Set_Item_Opts (Itm, Opt);
207 procedure Switch_Options (Itm : Item;
208 Options : Item_Option_Set;
209 On : Boolean := True)
211 function Item_Opts_On (Itm : Item;
212 Opt : C_Int) return C_Int;
213 pragma Import (C, Item_Opts_On, "item_opts_on");
214 function Item_Opts_Off (Itm : Item;
215 Opt : C_Int) return C_Int;
216 pragma Import (C, Item_Opts_Off, "item_opts_off");
218 Opt : constant C_Int := IOS_2_CInt (Options);
222 Err := Item_Opts_On (Itm, Opt);
224 Err := Item_Opts_Off (Itm, Opt);
231 procedure Get_Options (Itm : Item;
232 Options : out Item_Option_Set)
234 function Item_Opts (Itm : Item) return C_Int;
235 pragma Import (C, Item_Opts, "item_opts");
237 Res : constant C_Int := Item_Opts (Itm);
239 Options := CInt_2_IOS (Res);
242 function Get_Options (Itm : Item := Null_Item) return Item_Option_Set
244 Ios : Item_Option_Set;
246 Get_Options (Itm, Ios);
249 -------------------------------------------------------------------------------
250 procedure Name (Itm : Item;
253 function Itemname (Itm : Item) return chars_ptr;
254 pragma Import (C, Itemname, "item_name");
256 Fill_String (Itemname (Itm), Name);
259 function Name (Itm : Item) return String
261 function Itemname (Itm : Item) return chars_ptr;
262 pragma Import (C, Itemname, "item_name");
264 return Fill_String (Itemname (Itm));
267 procedure Description (Itm : Item;
268 Description : out String)
270 function Descname (Itm : Item) return chars_ptr;
271 pragma Import (C, Descname, "item_description");
273 Fill_String (Descname (Itm), Description);
276 function Description (Itm : Item) return String
278 function Descname (Itm : Item) return chars_ptr;
279 pragma Import (C, Descname, "item_description");
281 return Fill_String (Descname (Itm));
283 -------------------------------------------------------------------------------
284 procedure Set_Current (Men : Menu;
287 function Set_Curr_Item (Men : Menu;
288 Itm : Item) return C_Int;
289 pragma Import (C, Set_Curr_Item, "set_current_item");
291 Res : constant Eti_Error := Set_Curr_Item (Men, Itm);
298 function Current (Men : Menu) return Item
300 function Curr_Item (Men : Menu) return Item;
301 pragma Import (C, Curr_Item, "current_item");
303 Res : constant Item := Curr_Item (Men);
305 if Res = Null_Item then
306 raise Menu_Exception;
311 procedure Set_Top_Row (Men : Menu;
312 Line : Line_Position)
314 function Set_Toprow (Men : Menu;
315 Line : C_Int) return C_Int;
316 pragma Import (C, Set_Toprow, "set_top_row");
318 Res : constant Eti_Error := Set_Toprow (Men, C_Int (Line));
325 function Top_Row (Men : Menu) return Line_Position
327 function Toprow (Men : Menu) return C_Int;
328 pragma Import (C, Toprow, "top_row");
330 Res : constant C_Int := Toprow (Men);
332 if Res = Curses_Err then
333 raise Menu_Exception;
335 return Line_Position (Res);
338 function Get_Index (Itm : Item) return Positive
340 function Get_Itemindex (Itm : Item) return C_Int;
341 pragma Import (C, Get_Itemindex, "item_index");
343 Res : constant C_Int := Get_Itemindex (Itm);
345 if Res = Curses_Err then
346 raise Menu_Exception;
348 return Positive (Natural (Res) + Positive'First);
350 -------------------------------------------------------------------------------
351 procedure Post (Men : Menu;
352 Post : Boolean := True)
354 function M_Post (Men : Menu) return C_Int;
355 pragma Import (C, M_Post, "post_menu");
356 function M_Unpost (Men : Menu) return C_Int;
357 pragma Import (C, M_Unpost, "unpost_menu");
364 Res := M_Unpost (Men);
370 -------------------------------------------------------------------------------
371 procedure Set_Options (Men : Menu;
372 Options : Menu_Option_Set)
374 function Set_Menu_Opts (Men : Menu;
375 Opt : C_Int) return C_Int;
376 pragma Import (C, Set_Menu_Opts, "set_menu_opts");
378 Opt : constant C_Int := MOS_2_CInt (Options);
381 Res := Set_Menu_Opts (Men, Opt);
387 procedure Switch_Options (Men : Menu;
388 Options : Menu_Option_Set;
389 On : Boolean := True)
391 function Menu_Opts_On (Men : Menu;
392 Opt : C_Int) return C_Int;
393 pragma Import (C, Menu_Opts_On, "menu_opts_on");
394 function Menu_Opts_Off (Men : Menu;
395 Opt : C_Int) return C_Int;
396 pragma Import (C, Menu_Opts_Off, "menu_opts_off");
398 Opt : constant C_Int := MOS_2_CInt (Options);
402 Err := Menu_Opts_On (Men, Opt);
404 Err := Menu_Opts_Off (Men, Opt);
411 procedure Get_Options (Men : Menu;
412 Options : out Menu_Option_Set)
414 function Menu_Opts (Men : Menu) return C_Int;
415 pragma Import (C, Menu_Opts, "menu_opts");
417 Res : constant C_Int := Menu_Opts (Men);
419 Options := CInt_2_MOS (Res);
422 function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set
424 Mos : Menu_Option_Set;
426 Get_Options (Men, Mos);
429 -------------------------------------------------------------------------------
430 procedure Set_Window (Men : Menu;
433 function Set_Menu_Win (Men : Menu;
434 Win : Window) return C_Int;
435 pragma Import (C, Set_Menu_Win, "set_menu_win");
437 Res : constant Eti_Error := Set_Menu_Win (Men, Win);
444 function Get_Window (Men : Menu) return Window
446 function Menu_Win (Men : Menu) return Window;
447 pragma Import (C, Menu_Win, "menu_win");
449 W : constant Window := Menu_Win (Men);
454 procedure Set_Sub_Window (Men : Menu;
457 function Set_Menu_Sub (Men : Menu;
458 Win : Window) return C_Int;
459 pragma Import (C, Set_Menu_Sub, "set_menu_sub");
461 Res : constant Eti_Error := Set_Menu_Sub (Men, Win);
468 function Get_Sub_Window (Men : Menu) return Window
470 function Menu_Sub (Men : Menu) return Window;
471 pragma Import (C, Menu_Sub, "menu_sub");
473 W : constant Window := Menu_Sub (Men);
478 procedure Scale (Men : Menu;
479 Lines : out Line_Count;
480 Columns : out Column_Count)
482 type C_Int_Access is access all C_Int;
483 function M_Scale (Men : Menu;
484 Yp, Xp : C_Int_Access) return C_Int;
485 pragma Import (C, M_Scale, "scale_menu");
487 X, Y : aliased C_Int;
488 Res : constant Eti_Error := M_Scale (Men, Y'Access, X'Access);
493 Lines := Line_Count (Y);
494 Columns := Column_Count (X);
496 -------------------------------------------------------------------------------
497 procedure Position_Cursor (Men : Menu)
499 function Pos_Menu_Cursor (Men : Menu) return C_Int;
500 pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor");
502 Res : constant Eti_Error := Pos_Menu_Cursor (Men);
509 -------------------------------------------------------------------------------
510 procedure Set_Mark (Men : Menu;
513 type Char_Ptr is access all Interfaces.C.char;
514 function Set_Mark (Men : Menu;
515 Mark : Char_Ptr) return C_Int;
516 pragma Import (C, Set_Mark, "set_menu_mark");
518 Txt : char_array (0 .. Mark'Length);
522 To_C (Mark, Txt, Len);
523 Res := Set_Mark (Men, Txt (Txt'First)'Access);
529 procedure Mark (Men : Menu;
532 function Get_Menu_Mark (Men : Menu) return chars_ptr;
533 pragma Import (C, Get_Menu_Mark, "menu_mark");
535 Fill_String (Get_Menu_Mark (Men), Mark);
538 function Mark (Men : Menu) return String
540 function Get_Menu_Mark (Men : Menu) return chars_ptr;
541 pragma Import (C, Get_Menu_Mark, "menu_mark");
543 return Fill_String (Get_Menu_Mark (Men));
546 -------------------------------------------------------------------------------
547 procedure Set_Foreground
549 Fore : Character_Attribute_Set := Normal_Video;
550 Color : Color_Pair := Color_Pair'First)
552 function Set_Menu_Fore (Men : Menu;
553 Attr : C_Chtype) return C_Int;
554 pragma Import (C, Set_Menu_Fore, "set_menu_fore");
556 Ch : constant Attributed_Character := (Ch => Character'First,
559 Res : constant Eti_Error := Set_Menu_Fore (Men, AttrChar_To_Chtype (Ch));
566 procedure Foreground (Men : Menu;
567 Fore : out Character_Attribute_Set)
569 function Menu_Fore (Men : Menu) return C_Chtype;
570 pragma Import (C, Menu_Fore, "menu_fore");
572 Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
575 procedure Foreground (Men : Menu;
576 Fore : out Character_Attribute_Set;
577 Color : out Color_Pair)
579 function Menu_Fore (Men : Menu) return C_Chtype;
580 pragma Import (C, Menu_Fore, "menu_fore");
582 Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
583 Color := Chtype_To_AttrChar (Menu_Fore (Men)).Color;
586 procedure Set_Background
588 Back : Character_Attribute_Set := Normal_Video;
589 Color : Color_Pair := Color_Pair'First)
591 function Set_Menu_Back (Men : Menu;
592 Attr : C_Chtype) return C_Int;
593 pragma Import (C, Set_Menu_Back, "set_menu_back");
595 Ch : constant Attributed_Character := (Ch => Character'First,
598 Res : constant Eti_Error := Set_Menu_Back (Men, AttrChar_To_Chtype (Ch));
605 procedure Background (Men : Menu;
606 Back : out Character_Attribute_Set)
608 function Menu_Back (Men : Menu) return C_Chtype;
609 pragma Import (C, Menu_Back, "menu_back");
611 Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
614 procedure Background (Men : Menu;
615 Back : out Character_Attribute_Set;
616 Color : out Color_Pair)
618 function Menu_Back (Men : Menu) return C_Chtype;
619 pragma Import (C, Menu_Back, "menu_back");
621 Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
622 Color := Chtype_To_AttrChar (Menu_Back (Men)).Color;
625 procedure Set_Grey (Men : Menu;
626 Grey : Character_Attribute_Set := Normal_Video;
627 Color : Color_Pair := Color_Pair'First)
629 function Set_Menu_Grey (Men : Menu;
630 Attr : C_Chtype) return C_Int;
631 pragma Import (C, Set_Menu_Grey, "set_menu_grey");
633 Ch : constant Attributed_Character := (Ch => Character'First,
637 Res : constant Eti_Error := Set_Menu_Grey (Men, AttrChar_To_Chtype (Ch));
644 procedure Grey (Men : Menu;
645 Grey : out Character_Attribute_Set)
647 function Menu_Grey (Men : Menu) return C_Chtype;
648 pragma Import (C, Menu_Grey, "menu_grey");
650 Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
653 procedure Grey (Men : Menu;
654 Grey : out Character_Attribute_Set;
655 Color : out Color_Pair)
657 function Menu_Grey (Men : Menu) return C_Chtype;
658 pragma Import (C, Menu_Grey, "menu_grey");
660 Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
661 Color := Chtype_To_AttrChar (Menu_Grey (Men)).Color;
664 procedure Set_Pad_Character (Men : Menu;
665 Pad : Character := Space)
667 function Set_Menu_Pad (Men : Menu;
668 Ch : C_Int) return C_Int;
669 pragma Import (C, Set_Menu_Pad, "set_menu_pad");
671 Res : constant Eti_Error := Set_Menu_Pad (Men,
672 C_Int (Character'Pos (Pad)));
677 end Set_Pad_Character;
679 procedure Pad_Character (Men : Menu;
682 function Menu_Pad (Men : Menu) return C_Int;
683 pragma Import (C, Menu_Pad, "menu_pad");
685 Pad := Character'Val (Menu_Pad (Men));
687 -------------------------------------------------------------------------------
688 procedure Set_Spacing (Men : Menu;
689 Descr : Column_Position := 0;
690 Row : Line_Position := 0;
691 Col : Column_Position := 0)
693 function Set_Spacing (Men : Menu;
694 D, R, C : C_Int) return C_Int;
695 pragma Import (C, Set_Spacing, "set_menu_spacing");
697 Res : constant Eti_Error := Set_Spacing (Men,
707 procedure Spacing (Men : Menu;
708 Descr : out Column_Position;
709 Row : out Line_Position;
710 Col : out Column_Position)
712 type C_Int_Access is access all C_Int;
713 function Get_Spacing (Men : Menu;
714 D, R, C : C_Int_Access) return C_Int;
715 pragma Import (C, Get_Spacing, "menu_spacing");
717 D, R, C : aliased C_Int;
718 Res : constant Eti_Error := Get_Spacing (Men,
726 Descr := Column_Position (D);
727 Row := Line_Position (R);
728 Col := Column_Position (C);
731 -------------------------------------------------------------------------------
732 function Set_Pattern (Men : Menu;
733 Text : String) return Boolean
735 type Char_Ptr is access all Interfaces.C.char;
736 function Set_Pattern (Men : Menu;
737 Pattern : Char_Ptr) return C_Int;
738 pragma Import (C, Set_Pattern, "set_menu_pattern");
740 S : char_array (0 .. Text'Length);
745 Res := Set_Pattern (Men, S (S'First)'Access);
747 when E_No_Match => return False;
748 when E_Ok => return True;
755 procedure Pattern (Men : Menu;
758 function Get_Pattern (Men : Menu) return chars_ptr;
759 pragma Import (C, Get_Pattern, "menu_pattern");
761 Fill_String (Get_Pattern (Men), Text);
763 -------------------------------------------------------------------------------
764 procedure Set_Format (Men : Menu;
766 Columns : Column_Count)
768 function Set_Menu_Fmt (Men : Menu;
770 Col : C_Int) return C_Int;
771 pragma Import (C, Set_Menu_Fmt, "set_menu_format");
773 Res : constant Eti_Error := Set_Menu_Fmt (Men,
782 procedure Format (Men : Menu;
783 Lines : out Line_Count;
784 Columns : out Column_Count)
786 type C_Int_Access is access all C_Int;
787 function Menu_Fmt (Men : Menu;
788 Y, X : C_Int_Access) return C_Int;
789 pragma Import (C, Menu_Fmt, "menu_format");
791 L, C : aliased C_Int;
792 Res : constant Eti_Error := Menu_Fmt (Men, L'Access, C'Access);
797 Lines := Line_Count (L);
798 Columns := Column_Count (C);
801 -------------------------------------------------------------------------------
802 procedure Set_Item_Init_Hook (Men : Menu;
803 Proc : Menu_Hook_Function)
805 function Set_Item_Init (Men : Menu;
806 Proc : Menu_Hook_Function) return C_Int;
807 pragma Import (C, Set_Item_Init, "set_item_init");
809 Res : constant Eti_Error := Set_Item_Init (Men, Proc);
814 end Set_Item_Init_Hook;
816 procedure Set_Item_Term_Hook (Men : Menu;
817 Proc : Menu_Hook_Function)
819 function Set_Item_Term (Men : Menu;
820 Proc : Menu_Hook_Function) return C_Int;
821 pragma Import (C, Set_Item_Term, "set_item_term");
823 Res : constant Eti_Error := Set_Item_Term (Men, Proc);
828 end Set_Item_Term_Hook;
830 procedure Set_Menu_Init_Hook (Men : Menu;
831 Proc : Menu_Hook_Function)
833 function Set_Menu_Init (Men : Menu;
834 Proc : Menu_Hook_Function) return C_Int;
835 pragma Import (C, Set_Menu_Init, "set_menu_init");
837 Res : constant Eti_Error := Set_Menu_Init (Men, Proc);
842 end Set_Menu_Init_Hook;
844 procedure Set_Menu_Term_Hook (Men : Menu;
845 Proc : Menu_Hook_Function)
847 function Set_Menu_Term (Men : Menu;
848 Proc : Menu_Hook_Function) return C_Int;
849 pragma Import (C, Set_Menu_Term, "set_menu_term");
851 Res : constant Eti_Error := Set_Menu_Term (Men, Proc);
856 end Set_Menu_Term_Hook;
858 function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function
860 function Item_Init (Men : Menu) return Menu_Hook_Function;
861 pragma Import (C, Item_Init, "item_init");
863 return Item_Init (Men);
864 end Get_Item_Init_Hook;
866 function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function
868 function Item_Term (Men : Menu) return Menu_Hook_Function;
869 pragma Import (C, Item_Term, "item_term");
871 return Item_Term (Men);
872 end Get_Item_Term_Hook;
874 function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function
876 function Menu_Init (Men : Menu) return Menu_Hook_Function;
877 pragma Import (C, Menu_Init, "menu_init");
879 return Menu_Init (Men);
880 end Get_Menu_Init_Hook;
882 function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function
884 function Menu_Term (Men : Menu) return Menu_Hook_Function;
885 pragma Import (C, Menu_Term, "menu_term");
887 return Menu_Term (Men);
888 end Get_Menu_Term_Hook;
889 -------------------------------------------------------------------------------
890 procedure Redefine (Men : Menu;
891 Items : Item_Array_Access)
893 function Set_Items (Men : Menu;
894 Items : System.Address) return C_Int;
895 pragma Import (C, Set_Items, "set_menu_items");
899 pragma Assert (Items.all (Items'Last) = Null_Item);
900 if Items.all (Items'Last) /= Null_Item then
901 raise Menu_Exception;
903 Res := Set_Items (Men, Items.all'Address);
910 function Item_Count (Men : Menu) return Natural
912 function Count (Men : Menu) return C_Int;
913 pragma Import (C, Count, "item_count");
915 return Natural (Count (Men));
918 function Items (Men : Menu;
919 Index : Positive) return Item
923 function C_Mitems (Men : Menu) return Pointer;
924 pragma Import (C, C_Mitems, "menu_items");
926 P : Pointer := C_Mitems (Men);
928 if P = null or else Index > Item_Count (Men) then
929 raise Menu_Exception;
931 P := P + ptrdiff_t (C_Int (Index) - 1);
936 -------------------------------------------------------------------------------
937 function Create (Items : Item_Array_Access) return Menu
939 function Newmenu (Items : System.Address) return Menu;
940 pragma Import (C, Newmenu, "new_menu");
944 pragma Assert (Items.all (Items'Last) = Null_Item);
945 if Items.all (Items'Last) /= Null_Item then
946 raise Menu_Exception;
948 M := Newmenu (Items.all'Address);
949 if M = Null_Menu then
950 raise Menu_Exception;
956 procedure Delete (Men : in out Menu)
958 function Free (Men : Menu) return C_Int;
959 pragma Import (C, Free, "free_menu");
961 Res : constant Eti_Error := Free (Men);
969 ------------------------------------------------------------------------------
970 function Driver (Men : Menu;
971 Key : Key_Code) return Driver_Result
973 function Driver (Men : Menu;
974 Key : C_Int) return C_Int;
975 pragma Import (C, Driver, "menu_driver");
977 R : constant Eti_Error := Driver (Men, C_Int (Key));
981 when E_Unknown_Command => return Unknown_Request;
982 when E_No_Match => return No_Match;
983 when E_Request_Denied |
984 E_Not_Selectable => return Request_Denied;
992 procedure Free (IA : in out Item_Array_Access;
993 Free_Items : Boolean := False)
995 procedure Release is new Ada.Unchecked_Deallocation
996 (Item_Array, Item_Array_Access);
998 if IA /= null and then Free_Items then
999 for I in IA'First .. (IA'Last - 1) loop
1000 if IA.all (I) /= Null_Item then
1001 Delete (IA.all (I));
1008 -------------------------------------------------------------------------------
1009 function Default_Menu_Options return Menu_Option_Set
1012 return Get_Options (Null_Menu);
1013 end Default_Menu_Options;
1015 function Default_Item_Options return Item_Option_Set
1018 return Get_Options (Null_Item);
1019 end Default_Item_Options;
1020 -------------------------------------------------------------------------------
1022 end Terminal_Interface.Curses.Menus;