From ba1719013e5bab82a2accb4aadfd8451c3ebc931 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Thu, 16 Jan 2025 12:17:46 +1300 Subject: Fixed bug in Fl_Choice binding, filled small hole in Fl_Menu_Button binding --- doc/fl_choice.html | 31 ++++++++++++------------ doc/fl_menu_button.html | 13 ++++++++-- src/c_fl_choice.cpp | 8 +++---- src/c_fl_choice.h | 4 ++-- src/c_fl_menu.cpp | 8 +++---- src/c_fl_menu.h | 4 ++-- src/c_fl_menu_button.cpp | 4 ---- src/c_fl_menu_button.h | 1 - src/fltk-widgets-menus-choices.adb | 42 ++++++++++++++++++++------------- src/fltk-widgets-menus-choices.ads | 21 ++++++++++------- src/fltk-widgets-menus-menu_buttons.adb | 24 ++++++++++++------- src/fltk-widgets-menus-menu_buttons.ads | 7 +++++- src/fltk-widgets-menus.adb | 33 +++++++++++++------------- src/fltk-widgets-menus.ads | 16 ++++++------- src/fltk-widgets.ads | 13 ++++++++++ 15 files changed, 138 insertions(+), 91 deletions(-) diff --git a/doc/fl_choice.html b/doc/fl_choice.html index 9f83a30..777cece 100644 --- a/doc/fl_choice.html +++ b/doc/fl_choice.html @@ -79,15 +79,6 @@ function Handle - -Get the index into the Fl_Menu_Item array and do a manual lookup. -
-function Get_Chosen
-       (This : in Choice)
-    return FLTK.Menu_Items.Menu_Item_Reference;
-
- - 
 int value() const;
@@ -101,23 +92,33 @@ function Chosen_Index
 
   
 
-int value(int v);
+int value(const Fl_Menu_Item *v);
 

 
 procedure Set_Chosen
-       (This  : in out Choice;
-        Place : in     Index);
+       (This : in out Choice;
+        Item : in     FLTK.Menu_Items.Menu_Item);
+
+function Set_Chosen
+       (This : in out Choice;
+        Item : in     FLTK.Menu_Items.Menu_Item)
+    return Boolean;
 

   
 
   
 
-int value(const Fl_Menu_Item *v);
+int value(int v);
 

 
 procedure Set_Chosen
-       (This : in out Choice;
-        Item : in     FLTK.Menu_Items.Menu_Item);
+       (This  : in out Choice;
+        Place : in     Index);
+
+function Set_Chosen
+       (This  : in out Choice;
+        Place : in     Index)
+    return Boolean;
 

   
 
diff --git a/doc/fl_menu_button.html b/doc/fl_menu_button.html
index e0fbeaa..f264774 100644
--- a/doc/fl_menu_button.html
+++ b/doc/fl_menu_button.html
@@ -96,11 +96,20 @@ function Popup
   
 
   
-Use the type method in Fl_Widget with the popup_buttons enum.
+Use the type methods in Fl_Widget with the popup_buttons enum.
+
+function Get_Popup_Kind
+       (This : in Menu_Button)
+    return Popup_Buttons;
+

+  
+
+  
+Use the type methods in Fl_Widget with the popup_buttons enum.
 
 procedure Set_Popup_Kind
        (This : in out Menu_Button;
-        Pop  : in     Popup_Buttons);
+        Kind : in     Popup_Buttons);
 

   
 
diff --git a/src/c_fl_choice.cpp b/src/c_fl_choice.cpp
index e8c8374..0b7c65c 100644
--- a/src/c_fl_choice.cpp
+++ b/src/c_fl_choice.cpp
@@ -60,12 +60,12 @@ int fl_choice_value(CHOICE c) {
     return reinterpret_cast(c)->value();
 }
 
-int fl_choice_set_value(CHOICE c, int p) {
-    return reinterpret_cast(c)->value(p);
+int fl_choice_set_value(CHOICE c, void * i) {
+    return reinterpret_cast(c)->value(reinterpret_cast(i));
 }
 
-int fl_choice_set_value2(CHOICE c, void * i) {
-    return reinterpret_cast(c)->value(reinterpret_cast(i));
+int fl_choice_set_value2(CHOICE c, int p) {
+    return reinterpret_cast(c)->value(p);
 }
 
 
diff --git a/src/c_fl_choice.h b/src/c_fl_choice.h
index 5d076b1..031e67e 100644
--- a/src/c_fl_choice.h
+++ b/src/c_fl_choice.h
@@ -16,8 +16,8 @@ extern "C" void free_fl_choice(CHOICE b);
 
 
 extern "C" int fl_choice_value(CHOICE c);
-extern "C" int fl_choice_set_value(CHOICE c, int p);
-extern "C" int fl_choice_set_value2(CHOICE c, void * i);
+extern "C" int fl_choice_set_value(CHOICE c, void * i);
+extern "C" int fl_choice_set_value2(CHOICE c, int p);
 
 
 extern "C" void fl_choice_draw(CHOICE n);
diff --git a/src/c_fl_menu.cpp b/src/c_fl_menu.cpp
index 2ae9289..e42e985 100644
--- a/src/c_fl_menu.cpp
+++ b/src/c_fl_menu.cpp
@@ -153,12 +153,12 @@ int fl_menu_value(MENU m) {
     return static_cast(m)->value();
 }
 
-int fl_menu_set_value(MENU m, int p) {
-    return static_cast(m)->value(p);
+int fl_menu_set_value(MENU m, void * i) {
+    return static_cast(m)->value(static_cast(i));
 }
 
-int fl_menu_set_value2(MENU m, void * i) {
-    return static_cast(m)->value(static_cast(i));
+int fl_menu_set_value2(MENU m, int p) {
+    return static_cast(m)->value(p);
 }
 
 
diff --git a/src/c_fl_menu.h b/src/c_fl_menu.h
index 0b046bb..17ae326 100644
--- a/src/c_fl_menu.h
+++ b/src/c_fl_menu.h
@@ -41,8 +41,8 @@ extern "C" int fl_menu_size(MENU m);
 //  mvalue is subsumed by value
 extern "C" const char * fl_menu_text(MENU m);
 extern "C" int fl_menu_value(MENU m);
-extern "C" int fl_menu_set_value(MENU m, int p);
-extern "C" int fl_menu_set_value2(MENU m, void * i);
+extern "C" int fl_menu_set_value(MENU m, void * i);
+extern "C" int fl_menu_set_value2(MENU m, int p);
 
 
 extern "C" void fl_menu_setonly(MENU m, void * mi);
diff --git a/src/c_fl_menu_button.cpp b/src/c_fl_menu_button.cpp
index 4a32ca6..8866b89 100644
--- a/src/c_fl_menu_button.cpp
+++ b/src/c_fl_menu_button.cpp
@@ -72,10 +72,6 @@ void free_fl_menu_button(MENUBUTTON m) {
 
 
 
-void fl_menu_button_type(MENUBUTTON m, unsigned int t) {
-    reinterpret_cast(m)->type(t);
-}
-
 const void * fl_menu_button_popup(MENUBUTTON m) {
     return reinterpret_cast(m)->popup();
 }
diff --git a/src/c_fl_menu_button.h b/src/c_fl_menu_button.h
index e0e2b00..d567e4f 100644
--- a/src/c_fl_menu_button.h
+++ b/src/c_fl_menu_button.h
@@ -20,7 +20,6 @@ extern "C" MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label
 extern "C" void free_fl_menu_button(MENUBUTTON m);
 
 
-extern "C" void fl_menu_button_type(MENUBUTTON m, unsigned int t);
 extern "C" const void * fl_menu_button_popup(MENUBUTTON m);
 
 
diff --git a/src/fltk-widgets-menus-choices.adb b/src/fltk-widgets-menus-choices.adb
index f0fb03a..09c58b8 100644
--- a/src/fltk-widgets-menus-choices.adb
+++ b/src/fltk-widgets-menus-choices.adb
@@ -43,14 +43,14 @@ package body FLTK.Widgets.Menus.Choices is
     pragma Inline (fl_choice_value);
 
     function fl_choice_set_value
-           (M : in Storage.Integer_Address;
-            I : in Interfaces.C.int)
+           (M, I : in Storage.Integer_Address)
         return Interfaces.C.int;
     pragma Import (C, fl_choice_set_value, "fl_choice_set_value");
     pragma Inline (fl_choice_set_value);
 
     function fl_choice_set_value2
-           (M, I : in Storage.Integer_Address)
+           (M : in Storage.Integer_Address;
+            I : in Interfaces.C.int)
         return Interfaces.C.int;
     pragma Import (C, fl_choice_set_value2, "fl_choice_set_value2");
     pragma Inline (fl_choice_set_value2);
@@ -145,14 +145,6 @@ package body FLTK.Widgets.Menus.Choices is
     --  API Subprograms  --
     -----------------------
 
-    function Get_Chosen
-           (This : in Choice)
-        return FLTK.Menu_Items.Menu_Item_Reference is
-    begin
-        return (Data => This.My_Items.Element (This.Chosen_Index));
-    end Get_Chosen;
-
-
     function Chosen_Index
            (This : in Choice)
         return Extended_Index is
@@ -162,22 +154,40 @@ package body FLTK.Widgets.Menus.Choices is
 
 
     procedure Set_Chosen
-           (This  : in out Choice;
-            Place : in     Index)
+           (This : in out Choice;
+            Item : in     FLTK.Menu_Items.Menu_Item)
     is
         Ignore_Ret : Interfaces.C.int;
     begin
-        Ignore_Ret := fl_choice_set_value (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+        Ignore_Ret := fl_choice_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr);
     end Set_Chosen;
 
 
-    procedure Set_Chosen
+    function Set_Chosen
            (This : in out Choice;
             Item : in     FLTK.Menu_Items.Menu_Item)
+        return Boolean is
+    begin
+        return fl_choice_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr) /= 0;
+    end Set_Chosen;
+
+
+    procedure Set_Chosen
+           (This  : in out Choice;
+            Place : in     Index)
     is
         Ignore_Ret : Interfaces.C.int;
     begin
-        Ignore_Ret := fl_choice_set_value2 (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+        Ignore_Ret := fl_choice_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+    end Set_Chosen;
+
+
+    function Set_Chosen
+           (This  : in out Choice;
+            Place : in     Index)
+        return Boolean is
+    begin
+        return fl_choice_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1) /= 0;
     end Set_Chosen;
 
 
diff --git a/src/fltk-widgets-menus-choices.ads b/src/fltk-widgets-menus-choices.ads
index 86ddd60..6d12fc9 100644
--- a/src/fltk-widgets-menus-choices.ads
+++ b/src/fltk-widgets-menus-choices.ads
@@ -27,21 +27,27 @@ package FLTK.Widgets.Menus.Choices is
 
 
 
-    function Get_Chosen
-           (This : in Choice)
-        return FLTK.Menu_Items.Menu_Item_Reference;
-
     function Chosen_Index
            (This : in Choice)
         return Extended_Index;
 
+    procedure Set_Chosen
+           (This : in out Choice;
+            Item : in     FLTK.Menu_Items.Menu_Item);
+
+    function Set_Chosen
+           (This : in out Choice;
+            Item : in     FLTK.Menu_Items.Menu_Item)
+        return Boolean;
+
     procedure Set_Chosen
            (This  : in out Choice;
             Place : in     Index);
 
-    procedure Set_Chosen
-           (This : in out Choice;
-            Item : in     FLTK.Menu_Items.Menu_Item);
+    function Set_Chosen
+           (This  : in out Choice;
+            Place : in     Index)
+        return Boolean;
 
 
 
@@ -77,7 +83,6 @@ private
     with Inline;
 
 
-    pragma Inline (Chosen);
     pragma Inline (Chosen_Index);
     pragma Inline (Set_Chosen);
 
diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb
index ae9ae75..5d56e4d 100644
--- a/src/fltk-widgets-menus-menu_buttons.adb
+++ b/src/fltk-widgets-menus-menu_buttons.adb
@@ -31,12 +31,6 @@ package body FLTK.Widgets.Menus.Menu_Buttons is
 
 
 
-    procedure fl_menu_button_type
-           (M : in Storage.Integer_Address;
-            T : in Interfaces.C.unsigned);
-    pragma Import (C, fl_menu_button_type, "fl_menu_button_type");
-    pragma Inline (fl_menu_button_type);
-
     function fl_menu_button_popup
            (M : in Storage.Integer_Address)
         return Storage.Integer_Address;
@@ -179,11 +173,25 @@ package body FLTK.Widgets.Menus.Menu_Buttons is
     --  API Subprograms  --
     -----------------------
 
+    function Get_Popup_Kind
+           (This : in Menu_Button)
+        return Popup_Buttons
+    is
+        Result : Interfaces.C.unsigned_char := fl_widget_get_type (This.Void_Ptr);
+    begin
+        return Popup_Buttons'Val (Result);
+    exception
+    when Constraint_Error => raise Internal_FLTK_Error with
+        "Fl_Menu_Button::type returned unexpected Popup_Buttons value of " &
+        Interfaces.C.unsigned_char'Image (Result);
+    end Get_Popup_Kind;
+
+
     procedure Set_Popup_Kind
            (This : in out Menu_Button;
-            Pop  : in     Popup_Buttons) is
+            Kind : in     Popup_Buttons) is
     begin
-        fl_menu_button_type (This.Void_Ptr, Popup_Buttons'Pos (Pop));
+        fl_widget_set_type (This.Void_Ptr, Popup_Buttons'Pos (Kind));
     end Set_Popup_Kind;
 
 
diff --git a/src/fltk-widgets-menus-menu_buttons.ads b/src/fltk-widgets-menus-menu_buttons.ads
index 4ba09a3..6d866a0 100644
--- a/src/fltk-widgets-menus-menu_buttons.ads
+++ b/src/fltk-widgets-menus-menu_buttons.ads
@@ -35,9 +35,13 @@ package FLTK.Widgets.Menus.Menu_Buttons is
 
 
 
+    function Get_Popup_Kind
+           (This : in Menu_Button)
+        return Popup_Buttons;
+
     procedure Set_Popup_Kind
            (This : in out Menu_Button;
-            Pop  : in     Popup_Buttons);
+            Kind : in     Popup_Buttons);
 
     function Popup
            (This : in out Menu_Button)
@@ -77,6 +81,7 @@ private
     with Inline;
 
 
+    pragma Inline (Get_Popup_Kind);
     pragma Inline (Set_Popup_Kind);
     pragma Inline (Popup);
 
diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb
index efdeec5..67c5ac9 100644
--- a/src/fltk-widgets-menus.adb
+++ b/src/fltk-widgets-menus.adb
@@ -192,14 +192,14 @@ package body FLTK.Widgets.Menus is
     pragma Inline (fl_menu_value);
 
     function fl_menu_set_value
-           (M : in Storage.Integer_Address;
-            I : in Interfaces.C.int)
+           (M, I : in Storage.Integer_Address)
         return Interfaces.C.int;
     pragma Import (C, fl_menu_set_value, "fl_menu_set_value");
     pragma Inline (fl_menu_set_value);
 
     function fl_menu_set_value2
-           (M, I : in Storage.Integer_Address)
+           (M : in Storage.Integer_Address;
+            I : in Interfaces.C.int)
         return Interfaces.C.int;
     pragma Import (C, fl_menu_set_value2, "fl_menu_set_value2");
     pragma Inline (fl_menu_set_value2);
@@ -1002,7 +1002,8 @@ package body FLTK.Widgets.Menus is
            (This : in Menu)
         return FLTK.Menu_Items.Menu_Item_Reference
     is
-        Place : Extended_Index := This.Chosen_Index;
+        Dis_This : access constant Menu'Class := This'Access;
+        Place : Extended_Index := Dis_This.Chosen_Index;
     begin
         if Place = No_Index then
             raise No_Reference_Error;
@@ -1034,40 +1035,40 @@ package body FLTK.Widgets.Menus is
 
 
     procedure Set_Chosen
-           (This  : in out Menu;
-            Place : in     Index)
+           (This : in out Menu;
+            Item : in     FLTK.Menu_Items.Menu_Item)
     is
         Ignore : Interfaces.C.int;
     begin
-        Ignore := fl_menu_set_value (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+        Ignore := fl_menu_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr);
     end Set_Chosen;
 
 
     function Set_Chosen
-           (This  : in out Menu;
-            Place : in     Index)
+           (This : in out Menu;
+            Item : in     FLTK.Menu_Items.Menu_Item)
         return Boolean is
     begin
-        return fl_menu_set_value (This.Void_Ptr, Interfaces.C.int (Place) - 1) /= 0;
+        return fl_menu_set_value (This.Void_Ptr, Wrapper (Item).Void_Ptr) /= 0;
     end Set_Chosen;
 
 
     procedure Set_Chosen
-           (This : in out Menu;
-            Item : in     FLTK.Menu_Items.Menu_Item)
+           (This  : in out Menu;
+            Place : in     Index)
     is
         Ignore : Interfaces.C.int;
     begin
-        Ignore := fl_menu_set_value2 (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+        Ignore := fl_menu_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1);
     end Set_Chosen;
 
 
     function Set_Chosen
-           (This : in out Menu;
-            Item : in     FLTK.Menu_Items.Menu_Item)
+           (This  : in out Menu;
+            Place : in     Index)
         return Boolean is
     begin
-        return fl_menu_set_value2 (This.Void_Ptr, Wrapper (Item).Void_Ptr) /= 0;
+        return fl_menu_set_value2 (This.Void_Ptr, Interfaces.C.int (Place) - 1) /= 0;
     end Set_Chosen;
 
 
diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads
index 5285414..75670b8 100644
--- a/src/fltk-widgets-menus.ads
+++ b/src/fltk-widgets-menus.ads
@@ -236,21 +236,21 @@ package FLTK.Widgets.Menus is
         return Extended_Index;
 
     procedure Set_Chosen
-           (This  : in out Menu;
-            Place : in     Index);
+           (This : in out Menu;
+            Item : in     FLTK.Menu_Items.Menu_Item);
 
     function Set_Chosen
-           (This  : in out Menu;
-            Place : in     Index)
+           (This : in out Menu;
+            Item : in     FLTK.Menu_Items.Menu_Item)
         return Boolean;
 
     procedure Set_Chosen
-           (This : in out Menu;
-            Item : in     FLTK.Menu_Items.Menu_Item);
+           (This  : in out Menu;
+            Place : in     Index);
 
     function Set_Chosen
-           (This : in out Menu;
-            Item : in     FLTK.Menu_Items.Menu_Item)
+           (This  : in out Menu;
+            Place : in     Index)
         return Boolean;
 
 
diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads
index 5765196..03c3a59 100644
--- a/src/fltk-widgets.ads
+++ b/src/fltk-widgets.ads
@@ -433,6 +433,19 @@ private
     pragma Inline (fl_widget_set_label);
 
 
+    function fl_widget_get_type
+           (W : in Storage.Integer_Address)
+        return Interfaces.C.unsigned_char;
+    pragma Import (C, fl_widget_get_type, "fl_widget_get_type");
+    pragma Inline (fl_widget_get_type);
+
+    procedure fl_widget_set_type
+           (W : in Storage.Integer_Address;
+            T : in Interfaces.C.unsigned_char);
+    pragma Import (C, fl_widget_set_type, "fl_widget_set_type");
+    pragma Inline (fl_widget_set_type);
+
+
     pragma Inline (Activate);
     pragma Inline (Deactivate);
     pragma Inline (Is_Active);
-- 
cgit