summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/fltk-widgets-menus.adb84
-rw-r--r--src/fltk-widgets-menus.ads5
2 files changed, 60 insertions, 29 deletions
diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb
index a4e3c01..4ff0f94 100644
--- a/src/fltk-widgets-menus.adb
+++ b/src/fltk-widgets-menus.adb
@@ -333,27 +333,26 @@ package body FLTK.Widgets.Menus is
Shortcut : in Key_Combo := No_Key;
Flags : in Menu_Flag := Flag_Normal)
is
- Place : Interfaces.C.int;
+ Ret_Place : Interfaces.C.int;
Callback, User_Data : System.Address := System.Null_Address;
- New_Item : Item_Access;
begin
if Action /= null then
Callback := Item_Hook'Address;
User_Data := Callback_Convert.To_Address (Action);
end if;
-
- Place := fl_menu_add
+ Ret_Place := fl_menu_add
(This.Void_Ptr,
Interfaces.C.To_C (Text),
To_C (Shortcut),
Callback,
User_Data,
Interfaces.C.unsigned_long (Flags));
-
- New_Item := new FLTK.Menu_Items.Menu_Item;
- Wrapper (New_Item.all).Void_Ptr := fl_menu_get_item (This.Void_Ptr, Place);
- Wrapper (New_Item.all).Needs_Dealloc := False;
- This.My_Items.Append (New_Item);
+ This.My_Items.Append (new FLTK.Menu_Items.Menu_Item);
+ Wrapper (This.My_Items.Last_Element.all).Needs_Dealloc := False;
+ if Flags + Flag_Submenu = Flags then
+ This.My_Items.Append (new FLTK.Menu_Items.Menu_Item);
+ Wrapper (This.My_Items.Last_Element.all).Needs_Dealloc := False;
+ end if;
end Add;
@@ -367,13 +366,11 @@ package body FLTK.Widgets.Menus is
is
Ret_Place : Interfaces.C.int;
Callback, User_Data : System.Address := System.Null_Address;
- New_Item : Item_Access;
begin
if Action /= null then
Callback := Item_Hook'Address;
User_Data := Callback_Convert.To_Address (Action);
end if;
-
Ret_Place := fl_menu_insert
(This.Void_Ptr,
Interfaces.C.int (Place) - 1,
@@ -382,11 +379,12 @@ package body FLTK.Widgets.Menus is
Callback,
User_Data,
Interfaces.C.unsigned_long (Flags));
-
- New_Item := new FLTK.Menu_Items.Menu_Item;
- Wrapper (New_Item.all).Void_Ptr := fl_menu_get_item (This.Void_Ptr, Ret_Place);
- Wrapper (New_Item.all).Needs_Dealloc := False;
- This.My_Items.Insert (Positive (Ret_Place + 1), New_Item);
+ This.My_Items.Append (new FLTK.Menu_Items.Menu_Item);
+ Wrapper (This.My_Items.Last_Element.all).Needs_Dealloc := False;
+ if Flags + Flag_Submenu = Flags then
+ This.My_Items.Append (new FLTK.Menu_Items.Menu_Item);
+ Wrapper (This.My_Items.Last_Element.all).Needs_Dealloc := False;
+ end if;
end Insert;
@@ -406,7 +404,7 @@ package body FLTK.Widgets.Menus is
for Item of This.My_Items loop
Free_Item (Item);
end loop;
- This.My_Items := Item_Vectors.Empty_Vector;
+ This.My_Items.Clear;
fl_menu_clear (This.Void_Ptr);
end Clear;
@@ -435,7 +433,9 @@ package body FLTK.Widgets.Menus is
Place : in Index)
return FLTK.Menu_Items.Menu_Item_Reference is
begin
- return (Data => This.My_Items.Element (Place));
+ Wrapper (This.My_Items (Place).all).Void_Ptr :=
+ fl_menu_get_item (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ return (Data => This.My_Items (Place));
end Item;
@@ -451,18 +451,32 @@ package body FLTK.Widgets.Menus is
function Find_Item
(This : in Menu;
Name : in String)
- return FLTK.Menu_Items.Menu_Item_Reference is
+ return FLTK.Menu_Items.Menu_Item_Reference
+ is
+ Place : Extended_Index := This.Find_Index (Name);
begin
- return (Data => This.My_Items.Element (This.Find_Index (Name)));
+ if Place = No_Index then
+ raise No_Reference;
+ end if;
+ Wrapper (This.My_Items (Place).all).Void_Ptr :=
+ fl_menu_find_item (This.Void_Ptr, Interfaces.C.To_C (Name));
+ return (Data => This.My_Items (Place));
end Find_Item;
function Find_Item
(This : in Menu;
Action : in Widget_Callback)
- return FLTK.Menu_Items.Menu_Item_Reference is
+ return FLTK.Menu_Items.Menu_Item_Reference
+ is
+ Place : Extended_Index := This.Find_Index (Action);
begin
- return (Data => This.My_Items.Element (This.Find_Index (Action)));
+ if Place = No_Index then
+ raise No_Reference;
+ end if;
+ Wrapper (This.My_Items (Place).all).Void_Ptr :=
+ fl_menu_find_item2 (This.Void_Ptr, Callback_Convert.To_Address (Action));
+ return (Data => This.My_Items (Place));
end Find_Item;
@@ -568,9 +582,15 @@ package body FLTK.Widgets.Menus is
function Chosen
(This : in Menu)
- return FLTK.Menu_Items.Menu_Item_Reference is
+ return FLTK.Menu_Items.Menu_Item_Reference
+ is
+ Place : Extended_Index := This.Chosen_Index;
begin
- return (Data => This.My_Items.Element (This.Chosen_Index));
+ if Place = No_Index then
+ raise No_Reference;
+ end if;
+ Wrapper (This.My_Items (Place).all).Void_Ptr := fl_menu_mvalue (This.Void_Ptr);
+ return (Data => This.My_Items (Place));
end Chosen;
@@ -719,9 +739,13 @@ package body FLTK.Widgets.Menus is
Interfaces.C.int (Y),
Interfaces.C.To_C (Title),
Interfaces.C.int (Initial) - 1);
- Place : Index := Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1);
+ Place : Extended_Index := Extended_Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1);
begin
- return (Data => This.My_Items.Element (Place));
+ if Place = No_Index then
+ raise No_Reference;
+ end if;
+ Wrapper (This.My_Items (Place).all).Void_Ptr := Ptr;
+ return (Data => This.My_Items (Place));
end Popup;
@@ -738,9 +762,13 @@ package body FLTK.Widgets.Menus is
Interfaces.C.int (W),
Interfaces.C.int (H),
Interfaces.C.int (Initial) - 1);
- Place : Index := Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1);
+ Place : Extended_Index := Extended_Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1);
begin
- return (Data => This.My_Items.Element (Place));
+ if Place = No_Index then
+ raise No_Reference;
+ end if;
+ Wrapper (This.My_Items (Place).all).Void_Ptr := Ptr;
+ return (Data => This.My_Items (Place));
end Pulldown;
diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads
index 41eda3a..eb2d17a 100644
--- a/src/fltk-widgets-menus.ads
+++ b/src/fltk-widgets-menus.ads
@@ -25,7 +25,9 @@ package FLTK.Widgets.Menus is
subtype Index is Positive;
subtype Extended_Index is Natural;
+
No_Index : constant Extended_Index := Extended_Index'First;
+ No_Reference : exception;
type Cursor is private;
@@ -241,7 +243,8 @@ private
type Item_Access is access FLTK.Menu_Items.Menu_Item;
package Item_Vectors is new Ada.Containers.Vectors
- (Index_Type => Positive, Element_Type => Item_Access);
+ (Index_Type => Positive,
+ Element_Type => Item_Access);
type Menu is new Widget with record
My_Items : Item_Vectors.Vector;