Menu subprograms that return Menu_Item references fixed

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;