1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding --
5 -- Terminal_Interface.Curses.Menus --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998 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 <Juergen.Pfeifer@T-Online.de> 1996
39 -- Binding Version 00.93
40 ------------------------------------------------------------------------------
41 with Ada.Unchecked_Deallocation;
42 with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
44 with Interfaces.C; use Interfaces.C;
45 with Interfaces.C.Strings; use Interfaces.C.Strings;
46 with Terminal_Interface.Curses;
48 with Unchecked_Conversion;
50 package body Terminal_Interface.Curses.Menus is
52 use type System.Bit_Order;
53 subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
55 function MOS_2_CInt is new
56 Unchecked_Conversion (Menu_Option_Set,
59 function CInt_2_MOS is new
60 Unchecked_Conversion (C_Int,
63 function IOS_2_CInt is new
64 Unchecked_Conversion (Item_Option_Set,
67 function CInt_2_IOS is new
68 Unchecked_Conversion (C_Int,
71 ------------------------------------------------------------------------------
72 procedure Request_Name (Key : in Menu_Request_Code;
75 function Request_Name (Key : C_Int) return chars_ptr;
76 pragma Import (C, Request_Name, "menu_request_name");
78 Fill_String (Request_Name (C_Int (Key)), Name);
81 function Request_Name (Key : Menu_Request_Code) return String
83 function Request_Name (Key : C_Int) return chars_ptr;
84 pragma Import (C, Request_Name, "menu_request_name");
86 return Fill_String (Request_Name (C_Int (Key)));
89 function Create (Name : String;
90 Description : String := "") return Item
92 type Char_Ptr is access all Interfaces.C.Char;
93 function Newitem (Name, Desc : Char_Ptr) return Item;
94 pragma Import (C, Newitem, "new_item");
96 type Name_String is new char_array (0 .. Name'Length);
97 type Name_String_Ptr is access Name_String;
98 pragma Controlled (Name_String_Ptr);
100 type Desc_String is new char_array (0 .. Description'Length);
101 type Desc_String_Ptr is access Desc_String;
102 pragma Controlled (Desc_String_Ptr);
104 Name_Str : Name_String_Ptr := new Name_String;
105 Desc_Str : Desc_String_Ptr := new Desc_String;
106 Name_Len, Desc_Len : size_t;
109 To_C (Name, Name_Str.all, Name_Len);
110 To_C (Description, Desc_Str.all, Desc_Len);
111 Result := Newitem (Name_Str.all (Name_Str.all'First)'Access,
112 Desc_Str.all (Desc_Str.all'First)'Access);
113 if Result = Null_Item then
114 raise Eti_System_Error;
119 procedure Delete (Itm : in out Item)
121 function Descname (Itm : Item) return chars_ptr;
122 pragma Import (C, Descname, "item_description");
123 function Itemname (Itm : Item) return chars_ptr;
124 pragma Import (C, Itemname, "item_name");
126 function Freeitem (Itm : Item) return C_Int;
127 pragma Import (C, Freeitem, "free_item");
132 Ptr := Descname (Itm);
133 if Ptr /= Null_Ptr then
134 Interfaces.C.Strings.Free (Ptr);
136 Ptr := Itemname (Itm);
137 if Ptr /= Null_Ptr then
138 Interfaces.C.Strings.Free (Ptr);
140 Res := Freeitem (Itm);
146 -------------------------------------------------------------------------------
147 procedure Set_Value (Itm : in Item;
148 Value : in Boolean := True)
150 function Set_Item_Val (Itm : Item;
151 Val : C_Int) return C_Int;
152 pragma Import (C, Set_Item_Val, "set_item_value");
154 Res : constant Eti_Error := Set_Item_Val (Itm, Boolean'Pos (Value));
161 function Value (Itm : Item) return Boolean
163 function Item_Val (Itm : Item) return C_Int;
164 pragma Import (C, Item_Val, "item_value");
166 if Item_Val (Itm) = Curses_False then
173 -------------------------------------------------------------------------------
174 function Visible (Itm : Item) return Boolean
176 function Item_Vis (Itm : Item) return C_Int;
177 pragma Import (C, Item_Vis, "item_visible");
179 if Item_Vis (Itm) = Curses_False then
185 -------------------------------------------------------------------------------
186 procedure Normalize_Item_Options (Options : in out C_Int);
187 pragma Import (C, Normalize_Item_Options, "_nc_ada_normalize_item_opts");
189 procedure Set_Options (Itm : in Item;
190 Options : in Item_Option_Set)
192 function Set_Item_Opts (Itm : Item;
193 Opt : C_Int) return C_Int;
194 pragma Import (C, Set_Item_Opts, "set_item_opts");
196 Opt : C_Int := IOS_2_CInt (Options);
199 Normalize_Item_Options (Opt);
200 Res := Set_Item_Opts (Itm, Opt);
206 procedure Switch_Options (Itm : in Item;
207 Options : in Item_Option_Set;
208 On : Boolean := True)
210 function Item_Opts_On (Itm : Item;
211 Opt : C_Int) return C_Int;
212 pragma Import (C, Item_Opts_On, "item_opts_on");
213 function Item_Opts_Off (Itm : Item;
214 Opt : C_Int) return C_Int;
215 pragma Import (C, Item_Opts_Off, "item_opts_off");
217 Opt : C_Int := IOS_2_CInt (Options);
220 Normalize_Item_Options (Opt);
222 Err := Item_Opts_On (Itm, Opt);
224 Err := Item_Opts_Off (Itm, Opt);
231 procedure Get_Options (Itm : in 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 : C_Int := Item_Opts (Itm);
239 Normalize_Item_Options (Res);
240 Options := CInt_2_IOS (Res);
243 function Get_Options (Itm : Item := Null_Item) return Item_Option_Set
245 Ios : Item_Option_Set;
247 Get_Options (Itm, Ios);
250 -------------------------------------------------------------------------------
251 procedure Name (Itm : in Item;
254 function Itemname (Itm : Item) return chars_ptr;
255 pragma Import (C, Itemname, "item_name");
257 Fill_String (Itemname (Itm), Name);
260 function Name (Itm : in Item) return String
262 function Itemname (Itm : Item) return chars_ptr;
263 pragma Import (C, Itemname, "item_name");
265 return Fill_String (Itemname (Itm));
268 procedure Description (Itm : in Item;
269 Description : out String)
271 function Descname (Itm : Item) return chars_ptr;
272 pragma Import (C, Descname, "item_description");
274 Fill_String (Descname (Itm), Description);
277 function Description (Itm : in Item) return String
279 function Descname (Itm : Item) return chars_ptr;
280 pragma Import (C, Descname, "item_description");
282 return Fill_String (Descname (Itm));
284 -------------------------------------------------------------------------------
285 procedure Set_Current (Men : in Menu;
288 function Set_Curr_Item (Men : Menu;
289 Itm : Item) return C_Int;
290 pragma Import (C, Set_Curr_Item, "set_current_item");
292 Res : constant Eti_Error := Set_Curr_Item (Men, Itm);
299 function Current (Men : Menu) return Item
301 function Curr_Item (Men : Menu) return Item;
302 pragma Import (C, Curr_Item, "current_item");
304 Res : constant Item := Curr_Item (Men);
306 if Res = Null_Item then
307 raise Menu_Exception;
312 procedure Set_Top_Row (Men : in Menu;
313 Line : in Line_Position)
315 function Set_Toprow (Men : Menu;
316 Line : C_Int) return C_Int;
317 pragma Import (C, Set_Toprow, "set_top_row");
319 Res : constant Eti_Error := Set_Toprow (Men, C_Int (Line));
326 function Top_Row (Men : Menu) return Line_Position
328 function Toprow (Men : Menu) return C_Int;
329 pragma Import (C, Toprow, "top_row");
331 Res : constant C_Int := Toprow (Men);
333 if Res = Curses_Err then
334 raise Menu_Exception;
336 return Line_Position (Res);
339 function Get_Index (Itm : Item) return Positive
341 function Get_Itemindex (Itm : Item) return C_Int;
342 pragma Import (C, Get_Itemindex, "item_index");
344 Res : constant C_Int := Get_Itemindex (Itm);
346 if Res = Curses_Err then
347 raise Menu_Exception;
349 return Positive (Natural (Res) + Positive'First);
351 -------------------------------------------------------------------------------
352 procedure Post (Men : in Menu;
353 Post : in Boolean := True)
355 function M_Post (Men : Menu) return C_Int;
356 pragma Import (C, M_Post, "post_menu");
357 function M_Unpost (Men : Menu) return C_Int;
358 pragma Import (C, M_Unpost, "unpost_menu");
365 Res := M_Unpost (Men);
371 -------------------------------------------------------------------------------
372 procedure Normalize_Menu_Options (Options : in out C_Int);
373 pragma Import (C, Normalize_Menu_Options, "_nc_ada_normalize_menu_opts");
375 procedure Set_Options (Men : in Menu;
376 Options : in Menu_Option_Set)
378 function Set_Menu_Opts (Men : Menu;
379 Opt : C_Int) return C_Int;
380 pragma Import (C, Set_Menu_Opts, "set_menu_opts");
382 Opt : C_Int := MOS_2_CInt (Options);
385 Normalize_Menu_Options (Opt);
386 Res := Set_Menu_Opts (Men, Opt);
392 procedure Switch_Options (Men : in Menu;
393 Options : in Menu_Option_Set;
394 On : in Boolean := True)
396 function Menu_Opts_On (Men : Menu;
397 Opt : C_Int) return C_Int;
398 pragma Import (C, Menu_Opts_On, "menu_opts_on");
399 function Menu_Opts_Off (Men : Menu;
400 Opt : C_Int) return C_Int;
401 pragma Import (C, Menu_Opts_Off, "menu_opts_off");
403 Opt : C_Int := MOS_2_CInt (Options);
406 Normalize_Menu_Options (Opt);
408 Err := Menu_Opts_On (Men, Opt);
410 Err := Menu_Opts_Off (Men, Opt);
417 procedure Get_Options (Men : in Menu;
418 Options : out Menu_Option_Set)
420 function Menu_Opts (Men : Menu) return C_Int;
421 pragma Import (C, Menu_Opts, "menu_opts");
423 Res : C_Int := Menu_Opts (Men);
425 Normalize_Menu_Options (Res);
426 Options := CInt_2_MOS (Res);
429 function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set
431 Mos : Menu_Option_Set;
433 Get_Options (Men, Mos);
436 -------------------------------------------------------------------------------
437 procedure Set_Window (Men : in Menu;
440 function Set_Menu_Win (Men : Menu;
441 Win : Window) return C_Int;
442 pragma Import (C, Set_Menu_Win, "set_menu_win");
444 Res : constant Eti_Error := Set_Menu_Win (Men, Win);
451 function Get_Window (Men : Menu) return Window
453 function Menu_Win (Men : Menu) return Window;
454 pragma Import (C, Menu_Win, "menu_win");
456 W : constant Window := Menu_Win (Men);
461 procedure Set_Sub_Window (Men : in Menu;
464 function Set_Menu_Sub (Men : Menu;
465 Win : Window) return C_Int;
466 pragma Import (C, Set_Menu_Sub, "set_menu_sub");
468 Res : constant Eti_Error := Set_Menu_Sub (Men, Win);
475 function Get_Sub_Window (Men : Menu) return Window
477 function Menu_Sub (Men : Menu) return Window;
478 pragma Import (C, Menu_Sub, "menu_sub");
480 W : constant Window := Menu_Sub (Men);
485 procedure Scale (Men : in Menu;
486 Lines : out Line_Count;
487 Columns : out Column_Count)
489 type C_Int_Access is access all C_Int;
490 function M_Scale (Men : Menu;
491 Yp, Xp : C_Int_Access) return C_Int;
492 pragma Import (C, M_Scale, "scale_menu");
494 X, Y : aliased C_Int;
495 Res : constant Eti_Error := M_Scale (Men, Y'Access, X'Access);
500 Lines := Line_Count (Y);
501 Columns := Column_Count (X);
503 -------------------------------------------------------------------------------
504 procedure Position_Cursor (Men : Menu)
506 function Pos_Menu_Cursor (Men : Menu) return C_Int;
507 pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor");
509 Res : constant Eti_Error := Pos_Menu_Cursor (Men);
516 -------------------------------------------------------------------------------
517 procedure Set_Mark (Men : in Menu;
520 type Char_Ptr is access all Interfaces.C.Char;
521 function Set_Mark (Men : Menu;
522 Mark : Char_Ptr) return C_Int;
523 pragma Import (C, Set_Mark, "set_menu_mark");
525 Txt : char_array (0 .. Mark'Length);
529 To_C (Mark, Txt, Len);
530 Res := Set_Mark (Men, Txt (Txt'First)'Access);
536 procedure Mark (Men : in Menu;
539 function Get_Menu_Mark (Men : Menu) return chars_ptr;
540 pragma Import (C, Get_Menu_Mark, "menu_mark");
542 Fill_String (Get_Menu_Mark (Men), Mark);
545 function Mark (Men : Menu) return String
547 function Get_Menu_Mark (Men : Menu) return chars_ptr;
548 pragma Import (C, Get_Menu_Mark, "menu_mark");
550 return Fill_String (Get_Menu_Mark (Men));
553 -------------------------------------------------------------------------------
554 procedure Set_Foreground
556 Fore : in Character_Attribute_Set := Normal_Video;
557 Color : in Color_Pair := Color_Pair'First)
559 function Set_Menu_Fore (Men : Menu;
560 Attr : C_Int) return C_Int;
561 pragma Import (C, Set_Menu_Fore, "set_menu_fore");
563 Ch : constant Attributed_Character := (Ch => Character'First,
566 Res : constant Eti_Error := Set_Menu_Fore (Men, Chtype_To_CInt (Ch));
573 procedure Foreground (Men : in Menu;
574 Fore : out Character_Attribute_Set)
576 function Menu_Fore (Men : Menu) return C_Int;
577 pragma Import (C, Menu_Fore, "menu_fore");
579 Fore := CInt_To_Chtype (Menu_Fore (Men)).Attr;
582 procedure Foreground (Men : in Menu;
583 Fore : out Character_Attribute_Set;
584 Color : out Color_Pair)
586 function Menu_Fore (Men : Menu) return C_Int;
587 pragma Import (C, Menu_Fore, "menu_fore");
589 Fore := CInt_To_Chtype (Menu_Fore (Men)).Attr;
590 Color := CInt_To_Chtype (Menu_Fore (Men)).Color;
593 procedure Set_Background
595 Back : in Character_Attribute_Set := Normal_Video;
596 Color : in Color_Pair := Color_Pair'First)
598 function Set_Menu_Back (Men : Menu;
599 Attr : C_Int) return C_Int;
600 pragma Import (C, Set_Menu_Back, "set_menu_back");
602 Ch : constant Attributed_Character := (Ch => Character'First,
605 Res : constant Eti_Error := Set_Menu_Back (Men, Chtype_To_CInt (Ch));
612 procedure Background (Men : in Menu;
613 Back : out Character_Attribute_Set)
615 function Menu_Back (Men : Menu) return C_Int;
616 pragma Import (C, Menu_Back, "menu_back");
618 Back := CInt_To_Chtype (Menu_Back (Men)).Attr;
621 procedure Background (Men : in Menu;
622 Back : out Character_Attribute_Set;
623 Color : out Color_Pair)
625 function Menu_Back (Men : Menu) return C_Int;
626 pragma Import (C, Menu_Back, "menu_back");
628 Back := CInt_To_Chtype (Menu_Back (Men)).Attr;
629 Color := CInt_To_Chtype (Menu_Back (Men)).Color;
632 procedure Set_Grey (Men : in Menu;
633 Grey : in Character_Attribute_Set := Normal_Video;
634 Color : in Color_Pair := Color_Pair'First)
636 function Set_Menu_Grey (Men : Menu;
637 Attr : C_Int) return C_Int;
638 pragma Import (C, Set_Menu_Grey, "set_menu_grey");
640 Ch : constant Attributed_Character := (Ch => Character'First,
644 Res : constant Eti_Error := Set_Menu_Grey (Men, Chtype_To_CInt (Ch));
651 procedure Grey (Men : in Menu;
652 Grey : out Character_Attribute_Set)
654 function Menu_Grey (Men : Menu) return C_Int;
655 pragma Import (C, Menu_Grey, "menu_grey");
657 Grey := CInt_To_Chtype (Menu_Grey (Men)).Attr;
660 procedure Grey (Men : in Menu;
661 Grey : out Character_Attribute_Set;
662 Color : out Color_Pair)
664 function Menu_Grey (Men : Menu) return C_Int;
665 pragma Import (C, Menu_Grey, "menu_grey");
667 Grey := CInt_To_Chtype (Menu_Grey (Men)).Attr;
668 Color := CInt_To_Chtype (Menu_Grey (Men)).Color;
671 procedure Set_Pad_Character (Men : in Menu;
672 Pad : in Character := Space)
674 function Set_Menu_Pad (Men : Menu;
675 Ch : C_Int) return C_Int;
676 pragma Import (C, Set_Menu_Pad, "set_menu_pad");
678 Res : constant Eti_Error := Set_Menu_Pad (Men,
679 C_Int (Character'Pos (Pad)));
684 end Set_Pad_Character;
686 procedure Pad_Character (Men : in Menu;
689 function Menu_Pad (Men : Menu) return C_Int;
690 pragma Import (C, Menu_Pad, "menu_pad");
692 Pad := Character'Val (Menu_Pad (Men));
694 -------------------------------------------------------------------------------
695 procedure Set_Spacing (Men : in Menu;
696 Descr : in Column_Position := 0;
697 Row : in Line_Position := 0;
698 Col : in Column_Position := 0)
700 function Set_Spacing (Men : Menu;
701 D, R, C : C_Int) return C_Int;
702 pragma Import (C, Set_Spacing, "set_menu_spacing");
704 Res : constant Eti_Error := Set_Spacing (Men,
714 procedure Spacing (Men : in Menu;
715 Descr : out Column_Position;
716 Row : out Line_Position;
717 Col : out Column_Position)
719 type C_Int_Access is access all C_Int;
720 function Get_Spacing (Men : Menu;
721 D, R, C : C_Int_Access) return C_Int;
722 pragma Import (C, Get_Spacing, "menu_spacing");
724 D, R, C : aliased C_Int;
725 Res : constant Eti_Error := Get_Spacing (Men,
733 Descr := Column_Position (D);
734 Row := Line_Position (R);
735 Col := Column_Position (C);
738 -------------------------------------------------------------------------------
739 function Set_Pattern (Men : Menu;
740 Text : String) return Boolean
742 type Char_Ptr is access all Interfaces.C.Char;
743 function Set_Pattern (Men : Menu;
744 Pattern : Char_Ptr) return C_Int;
745 pragma Import (C, Set_Pattern, "set_menu_pattern");
747 S : char_array (0 .. Text'Length);
752 Res := Set_Pattern (Men, S (S'First)'Access);
754 when E_No_Match => return False;
755 when E_Ok => return True;
762 procedure Pattern (Men : in Menu;
765 function Get_Pattern (Men : Menu) return chars_ptr;
766 pragma Import (C, Get_Pattern, "menu_pattern");
768 Fill_String (Get_Pattern (Men), Text);
770 -------------------------------------------------------------------------------
771 procedure Set_Format (Men : in Menu;
772 Lines : in Line_Count;
773 Columns : in Column_Count)
775 function Set_Menu_Fmt (Men : Menu;
777 Col : C_Int) return C_Int;
778 pragma Import (C, Set_Menu_Fmt, "set_menu_format");
780 Res : constant Eti_Error := Set_Menu_Fmt (Men,
789 procedure Format (Men : in Menu;
790 Lines : out Line_Count;
791 Columns : out Column_Count)
793 type C_Int_Access is access all C_Int;
794 function Menu_Fmt (Men : Menu;
795 Y, X : C_Int_Access) return C_Int;
796 pragma Import (C, Menu_Fmt, "menu_format");
798 L, C : aliased C_Int;
799 Res : constant Eti_Error := Menu_Fmt (Men, L'Access, C'Access);
804 Lines := Line_Count (L);
805 Columns := Column_Count (C);
808 -------------------------------------------------------------------------------
809 procedure Set_Item_Init_Hook (Men : in Menu;
810 Proc : in Menu_Hook_Function)
812 function Set_Item_Init (Men : Menu;
813 Proc : Menu_Hook_Function) return C_Int;
814 pragma Import (C, Set_Item_Init, "set_item_init");
816 Res : constant Eti_Error := Set_Item_Init (Men, Proc);
821 end Set_Item_Init_Hook;
823 procedure Set_Item_Term_Hook (Men : in Menu;
824 Proc : in Menu_Hook_Function)
826 function Set_Item_Term (Men : Menu;
827 Proc : Menu_Hook_Function) return C_Int;
828 pragma Import (C, Set_Item_Term, "set_item_term");
830 Res : constant Eti_Error := Set_Item_Term (Men, Proc);
835 end Set_Item_Term_Hook;
837 procedure Set_Menu_Init_Hook (Men : in Menu;
838 Proc : in Menu_Hook_Function)
840 function Set_Menu_Init (Men : Menu;
841 Proc : Menu_Hook_Function) return C_Int;
842 pragma Import (C, Set_Menu_Init, "set_menu_init");
844 Res : constant Eti_Error := Set_Menu_Init (Men, Proc);
849 end Set_Menu_Init_Hook;
851 procedure Set_Menu_Term_Hook (Men : in Menu;
852 Proc : in Menu_Hook_Function)
854 function Set_Menu_Term (Men : Menu;
855 Proc : Menu_Hook_Function) return C_Int;
856 pragma Import (C, Set_Menu_Term, "set_menu_term");
858 Res : constant Eti_Error := Set_Menu_Term (Men, Proc);
863 end Set_Menu_Term_Hook;
865 function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function
867 function Item_Init (Men : Menu) return Menu_Hook_Function;
868 pragma Import (C, Item_Init, "item_init");
870 return Item_Init (Men);
871 end Get_Item_Init_Hook;
873 function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function
875 function Item_Term (Men : Menu) return Menu_Hook_Function;
876 pragma Import (C, Item_Term, "item_term");
878 return Item_Term (Men);
879 end Get_Item_Term_Hook;
881 function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function
883 function Menu_Init (Men : Menu) return Menu_Hook_Function;
884 pragma Import (C, Menu_Init, "menu_init");
886 return Menu_Init (Men);
887 end Get_Menu_Init_Hook;
889 function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function
891 function Menu_Term (Men : Menu) return Menu_Hook_Function;
892 pragma Import (C, Menu_Term, "menu_term");
894 return Menu_Term (Men);
895 end Get_Menu_Term_Hook;
896 -------------------------------------------------------------------------------
897 procedure Redefine (Men : in Menu;
898 Items : in Item_Array_Access)
900 function Set_Items (Men : Menu;
901 Items : System.Address) return C_Int;
902 pragma Import (C, Set_Items, "set_menu_items");
906 pragma Assert (Items (Items'Last) = Null_Item);
907 if Items (Items'Last) /= Null_Item then
908 raise Menu_Exception;
910 Res := Set_Items (Men, Items (Items'First)'Address);
917 function Item_Count (Men : Menu) return Natural
919 function Count (Men : Menu) return C_Int;
920 pragma Import (C, Count, "item_count");
922 return Natural (Count (Men));
925 function Items (Men : Menu;
926 Index : Positive) return Item
928 function M_Items (Men : Menu;
929 Idx : C_Int) return Item;
930 pragma Import (C, M_Items, "_nc_get_item");
932 if Men = Null_Menu or else Index not in 1 .. Item_Count (Men) then
933 raise Menu_Exception;
935 return M_Items (Men, C_Int (Index) - 1);
939 -------------------------------------------------------------------------------
940 function Create (Items : Item_Array_Access) return Menu
942 function Newmenu (Items : System.Address) return Menu;
943 pragma Import (C, Newmenu, "new_menu");
946 I : Item_Array_Access;
948 pragma Assert (Items (Items'Last) = Null_Item);
949 if Items (Items'Last) /= Null_Item then
950 raise Menu_Exception;
952 M := Newmenu (Items (Items'First)'Address);
953 if M = Null_Menu then
954 raise Menu_Exception;
960 procedure Delete (Men : in out Menu)
962 function Free (Men : Menu) return C_Int;
963 pragma Import (C, Free, "free_menu");
965 Res : constant Eti_Error := Free (Men);
973 ------------------------------------------------------------------------------
974 function Driver (Men : Menu;
975 Key : Key_Code) return Driver_Result
977 function Driver (Men : Menu;
978 Key : C_Int) return C_Int;
979 pragma Import (C, Driver, "menu_driver");
981 R : Eti_Error := Driver (Men, C_Int (Key));
985 when E_Unknown_Command => return Unknown_Request;
986 when E_No_Match => return No_Match;
987 when E_Request_Denied |
988 E_Not_Selectable => return Request_Denied;
996 procedure Free (IA : in out Item_Array_Access;
997 Free_Items : in Boolean := False)
999 procedure Release is new Ada.Unchecked_Deallocation
1000 (Item_Array, Item_Array_Access);
1002 if IA /= null and then Free_Items then
1003 for I in IA'First .. (IA'Last - 1) loop
1004 if (IA (I) /= Null_Item) then
1012 -------------------------------------------------------------------------------
1013 function Default_Menu_Options return Menu_Option_Set
1016 return Get_Options (Null_Menu);
1017 end Default_Menu_Options;
1019 function Default_Item_Options return Item_Option_Set
1022 return Get_Options (Null_Item);
1023 end Default_Item_Options;
1024 -------------------------------------------------------------------------------
1026 end Terminal_Interface.Curses.Menus;