summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c_fl_sys_menu_bar.cpp162
-rw-r--r--src/c_fl_sys_menu_bar.h53
-rw-r--r--src/fltk-widgets-menus-choices.adb18
-rw-r--r--src/fltk-widgets-menus-menu_bars-systemwide.adb619
-rw-r--r--src/fltk-widgets-menus-menu_bars-systemwide.ads222
-rw-r--r--src/fltk-widgets-menus-menu_bars.adb22
-rw-r--r--src/fltk-widgets-menus-menu_buttons.adb22
-rw-r--r--src/fltk-widgets-menus.adb32
-rw-r--r--src/fltk-widgets-menus.ads18
9 files changed, 1147 insertions, 21 deletions
diff --git a/src/c_fl_sys_menu_bar.cpp b/src/c_fl_sys_menu_bar.cpp
new file mode 100644
index 0000000..d67bf87
--- /dev/null
+++ b/src/c_fl_sys_menu_bar.cpp
@@ -0,0 +1,162 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Sys_Menu_Bar.H>
+#include <FL/Fl_Menu_Item.H>
+#include "c_fl_sys_menu_bar.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+extern "C" void menu_item_callback_hook(void * cobj, void * ud);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Sys_Menu_Bar : public Fl_Sys_Menu_Bar {
+public:
+ using Fl_Sys_Menu_Bar::Fl_Sys_Menu_Bar;
+
+ friend void fl_sys_menu_bar_draw(SYSMENUBAR m);
+ friend int fl_sys_menu_bar_handle(SYSMENUBAR m, int e);
+
+ void draw();
+ int handle(int e);
+};
+
+void My_Sys_Menu_Bar::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Sys_Menu_Bar::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API
+
+SYSMENUBAR new_fl_sys_menu_bar(int x, int y, int w, int h, char* label) {
+ My_Sys_Menu_Bar *m = new My_Sys_Menu_Bar(x, y, w, h, label);
+ return m;
+}
+
+void free_fl_sys_menu_bar(SYSMENUBAR m) {
+ delete static_cast<My_Sys_Menu_Bar*>(m);
+}
+
+
+
+
+int fl_sys_menu_bar_add(SYSMENUBAR m, const char * t) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->add(t);
+}
+
+int fl_sys_menu_bar_add2(SYSMENUBAR m, const char * t, unsigned long s, void * u, unsigned long f) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->add(t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+int fl_sys_menu_bar_add3(SYSMENUBAR m, const char * t, const char * s, void * u, unsigned long f) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->add(t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+int fl_sys_menu_bar_insert(SYSMENUBAR m, int p, const char * t, unsigned long s,
+ void * u, unsigned long f)
+{
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->insert(p, t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+int fl_sys_menu_bar_insert2(SYSMENUBAR m, int p, const char * t, const char * s,
+ void * u, unsigned long f)
+{
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->insert(p, t, s,
+ u==0?0:reinterpret_cast<Fl_Callback_p>(&menu_item_callback_hook), u, f);
+}
+
+void fl_sys_menu_bar_set_menu(SYSMENUBAR m, void * d) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->menu(static_cast<Fl_Menu_*>(d)->menu());
+}
+
+void fl_sys_menu_bar_remove(SYSMENUBAR m, int p) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->remove(p);
+}
+
+void fl_sys_menu_bar_clear(SYSMENUBAR m) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->clear();
+}
+
+int fl_sys_menu_bar_clear_submenu(SYSMENUBAR m, int i) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->clear_submenu(i);
+}
+
+
+
+
+const void * fl_sys_menu_bar_get_item(SYSMENUBAR m, int i) {
+ return &(static_cast<Fl_Sys_Menu_Bar*>(m)->menu()[i]);
+}
+
+
+
+
+void fl_sys_menu_bar_setonly(SYSMENUBAR m, void * mi) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->setonly(static_cast<Fl_Menu_Item*>(mi));
+}
+
+void fl_sys_menu_bar_replace(SYSMENUBAR m, int i, const char * t) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->replace(i, t);
+}
+
+void fl_sys_menu_bar_shortcut(SYSMENUBAR m, int i, unsigned long s) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->shortcut(i, s);
+}
+
+unsigned long fl_sys_menu_bar_get_mode(SYSMENUBAR m, int i) {
+ return static_cast<Fl_Sys_Menu_Bar*>(m)->mode(i);
+}
+
+void fl_sys_menu_bar_set_mode(SYSMENUBAR m, int i, unsigned long f) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->mode(i, f);
+}
+
+
+
+
+void fl_sys_menu_bar_global(SYSMENUBAR m) {
+ static_cast<Fl_Sys_Menu_Bar*>(m)->global();
+}
+
+void fl_sys_menu_bar_update(SYSMENUBAR m) {
+#if FLTK_ABI_VERSION >= 10304
+ static_cast<Fl_Sys_Menu_Bar*>(m)->update();
+#else
+ (void)(m);
+#endif
+}
+
+
+
+
+void fl_sys_menu_bar_draw(SYSMENUBAR m) {
+ static_cast<My_Sys_Menu_Bar*>(m)->Fl_Sys_Menu_Bar::draw();
+}
+
+int fl_sys_menu_bar_handle(SYSMENUBAR m, int e) {
+ return static_cast<My_Sys_Menu_Bar*>(m)->Fl_Sys_Menu_Bar::handle(e);
+}
+
+
diff --git a/src/c_fl_sys_menu_bar.h b/src/c_fl_sys_menu_bar.h
new file mode 100644
index 0000000..67e5f0d
--- /dev/null
+++ b/src/c_fl_sys_menu_bar.h
@@ -0,0 +1,53 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_SYS_MENU_BAR_GUARD
+#define FL_SYS_MENU_BAR_GUARD
+
+
+typedef void* SYSMENUBAR;
+
+
+extern "C" SYSMENUBAR new_fl_sys_menu_bar(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_sys_menu_bar(SYSMENUBAR m);
+
+
+extern "C" int fl_sys_menu_bar_add(SYSMENUBAR m, const char * t);
+extern "C" int fl_sys_menu_bar_add2(SYSMENUBAR m, const char * t,
+ unsigned long s, void * u, unsigned long f);
+extern "C" int fl_sys_menu_bar_add3(SYSMENUBAR m, const char * t,
+ const char * s, void * u, unsigned long f);
+extern "C" int fl_sys_menu_bar_insert(SYSMENUBAR m, int p, const char * t,
+ unsigned long s, void * u, unsigned long f);
+extern "C" int fl_sys_menu_bar_insert2(SYSMENUBAR m, int p, const char * t,
+ const char * s, void * u, unsigned long f);
+extern "C" void fl_sys_menu_bar_set_menu(SYSMENUBAR m, void * d);
+extern "C" void fl_sys_menu_bar_remove(SYSMENUBAR m, int p);
+extern "C" void fl_sys_menu_bar_clear(SYSMENUBAR m);
+extern "C" int fl_sys_menu_bar_clear_submenu(SYSMENUBAR m, int p);
+
+
+extern "C" const void * fl_sys_menu_bar_get_item(SYSMENUBAR m, int i);
+
+
+extern "C" void fl_sys_menu_bar_setonly(SYSMENUBAR m, void * mi);
+extern "C" void fl_sys_menu_bar_replace(SYSMENUBAR m, int i, const char * t);
+extern "C" void fl_sys_menu_bar_shortcut(SYSMENUBAR m, int p, unsigned long s);
+extern "C" unsigned long fl_sys_menu_bar_get_mode(SYSMENUBAR m, int p);
+extern "C" void fl_sys_menu_bar_set_mode(SYSMENUBAR m, int p, unsigned long f);
+
+
+extern "C" void fl_sys_menu_bar_global(SYSMENUBAR m);
+extern "C" void fl_sys_menu_bar_update(SYSMENUBAR m);
+
+
+extern "C" void fl_sys_menu_bar_draw(SYSMENUBAR m);
+extern "C" int fl_sys_menu_bar_handle(SYSMENUBAR m, int e);
+
+
+#endif
+
+
diff --git a/src/fltk-widgets-menus-choices.adb b/src/fltk-widgets-menus-choices.adb
index 1fdf554..e4b52ad 100644
--- a/src/fltk-widgets-menus-choices.adb
+++ b/src/fltk-widgets-menus-choices.adb
@@ -74,6 +74,16 @@ package body FLTK.Widgets.Menus.Choices is
+ function fl_menu_get_item
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_get_item, "fl_menu_get_item");
+ pragma Inline (fl_menu_get_item);
+
+
+
+
-------------------
-- Destructors --
-------------------
@@ -114,8 +124,10 @@ package body FLTK.Widgets.Menus.Choices is
procedure Initialize
(This : in out Choice) is
begin
- This.Draw_Ptr := fl_choice_draw'Address;
- This.Handle_Ptr := fl_choice_handle'Address;
+ This.Draw_Ptr := fl_choice_draw'Address;
+ This.Handle_Ptr := fl_choice_handle'Address;
+ This.Get_Item_Ptr := fl_menu_get_item'Address;
+ This.Value_Ptr := fl_choice_value'Address;
end Initialize;
@@ -162,7 +174,7 @@ package body FLTK.Widgets.Menus.Choices is
(This : in Choice)
return Extended_Index is
begin
- return Extended_Index (fl_choice_value (This.Void_Ptr) + 1);
+ return Menu (This).Chosen_Index;
end Chosen_Index;
diff --git a/src/fltk-widgets-menus-menu_bars-systemwide.adb b/src/fltk-widgets-menus-menu_bars-systemwide.adb
new file mode 100644
index 0000000..aebf9bd
--- /dev/null
+++ b/src/fltk-widgets-menus-menu_bars-systemwide.adb
@@ -0,0 +1,619 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Assertions,
+ Ada.Unchecked_Deallocation,
+ FLTK.Widgets.Groups,
+ Interfaces.C;
+
+use type
+
+ Interfaces.C.int;
+
+
+package body FLTK.Widgets.Menus.Menu_Bars.Systemwide is
+
+
+ package Chk renames Ada.Assertions;
+
+ procedure Free_Item is new Ada.Unchecked_Deallocation
+ (Object => FLTK.Menu_Items.Menu_Item, Name => Item_Access);
+
+
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function new_fl_sys_menu_bar
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_sys_menu_bar, "new_fl_sys_menu_bar");
+ pragma Inline (new_fl_sys_menu_bar);
+
+ procedure free_fl_sys_menu_bar
+ (M : in Storage.Integer_Address);
+ pragma Import (C, free_fl_sys_menu_bar, "free_fl_sys_menu_bar");
+ pragma Inline (free_fl_sys_menu_bar);
+
+
+
+
+ function fl_sys_menu_bar_add
+ (M : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_add, "fl_sys_menu_bar_add");
+ pragma Inline (fl_sys_menu_bar_add);
+
+ function fl_sys_menu_bar_add2
+ (M : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array;
+ S : in Interfaces.C.unsigned_long;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.unsigned_long)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_add2, "fl_sys_menu_bar_add2");
+ pragma Inline (fl_sys_menu_bar_add2);
+
+ function fl_sys_menu_bar_add3
+ (M : in Storage.Integer_Address;
+ T, S : in Interfaces.C.char_array;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.unsigned_long)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_add3, "fl_sys_menu_bar_add3");
+ pragma Inline (fl_sys_menu_bar_add3);
+
+ function fl_sys_menu_bar_insert
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int;
+ T : in Interfaces.C.char_array;
+ S : in Interfaces.C.unsigned_long;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.unsigned_long)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_insert, "fl_sys_menu_bar_insert");
+ pragma Inline (fl_sys_menu_bar_insert);
+
+ function fl_sys_menu_bar_insert2
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int;
+ T, S : in Interfaces.C.char_array;
+ U : in Storage.Integer_Address;
+ F : in Interfaces.C.unsigned_long)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_insert2, "fl_sys_menu_bar_insert2");
+ pragma Inline (fl_sys_menu_bar_insert2);
+
+ procedure fl_sys_menu_bar_set_menu
+ (M, D : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_set_menu, "fl_sys_menu_bar_set_menu");
+ pragma Inline (fl_sys_menu_bar_set_menu);
+
+ procedure fl_sys_menu_bar_remove
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int);
+ pragma Import (C, fl_sys_menu_bar_remove, "fl_sys_menu_bar_remove");
+ pragma Inline (fl_sys_menu_bar_remove);
+
+ procedure fl_sys_menu_bar_clear
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_clear, "fl_sys_menu_bar_clear");
+ pragma Inline (fl_sys_menu_bar_clear);
+
+ function fl_sys_menu_bar_clear_submenu
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_clear_submenu, "fl_sys_menu_bar_clear_submenu");
+ pragma Inline (fl_sys_menu_bar_clear_submenu);
+
+
+
+
+ function fl_sys_menu_bar_get_item
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_sys_menu_bar_get_item, "fl_sys_menu_bar_get_item");
+ pragma Inline (fl_sys_menu_bar_get_item);
+
+
+
+
+ procedure fl_sys_menu_bar_setonly
+ (M, I : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_setonly, "fl_sys_menu_bar_setonly");
+ pragma Inline (fl_sys_menu_bar_setonly);
+
+ procedure fl_sys_menu_bar_replace
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_sys_menu_bar_replace, "fl_sys_menu_bar_replace");
+ pragma Inline (fl_sys_menu_bar_replace);
+
+ procedure fl_sys_menu_bar_shortcut
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ S : in Interfaces.C.unsigned_long);
+ pragma Import (C, fl_sys_menu_bar_shortcut, "fl_sys_menu_bar_shortcut");
+ pragma Inline (fl_sys_menu_bar_shortcut);
+
+ function fl_sys_menu_bar_get_mode
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Interfaces.C.unsigned_long;
+ pragma Import (C, fl_sys_menu_bar_get_mode, "fl_sys_menu_bar_get_mode");
+ pragma Inline (fl_sys_menu_bar_get_mode);
+
+ procedure fl_sys_menu_bar_set_mode
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int;
+ F : in Interfaces.C.unsigned_long);
+ pragma Import (C, fl_sys_menu_bar_set_mode, "fl_sys_menu_bar_set_mode");
+ pragma Inline (fl_sys_menu_bar_set_mode);
+
+
+
+
+ procedure fl_sys_menu_bar_global
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_global, "fl_sys_menu_bar_global");
+ pragma Inline (fl_sys_menu_bar_global);
+
+ procedure fl_sys_menu_bar_update
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_update, "fl_sys_menu_bar_update");
+ pragma Inline (fl_sys_menu_bar_update);
+
+
+
+
+ procedure fl_sys_menu_bar_draw
+ (M : in Storage.Integer_Address);
+ pragma Import (C, fl_sys_menu_bar_draw, "fl_sys_menu_bar_draw");
+ pragma Inline (fl_sys_menu_bar_draw);
+
+ function fl_sys_menu_bar_handle
+ (M : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_sys_menu_bar_handle, "fl_sys_menu_bar_handle");
+ pragma Inline (fl_sys_menu_bar_handle);
+
+
+
+
+ function fl_menu_value
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_value, "fl_menu_value");
+ pragma Inline (fl_menu_value);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Extra_Final
+ (This : in out System_Menu_Bar) is
+ begin
+ Extra_Final (Menu_Bar (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out System_Menu_Bar) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_sys_menu_bar (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out System_Menu_Bar;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Menu_Bar (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out System_Menu_Bar) is
+ begin
+ This.Draw_Ptr := fl_sys_menu_bar_draw'Address;
+ This.Handle_Ptr := fl_sys_menu_bar_handle'Address;
+ This.Get_Item_Ptr := fl_sys_menu_bar_get_item'Address;
+ This.Value_Ptr := fl_menu_value'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return System_Menu_Bar is
+ begin
+ return This : System_Menu_Bar do
+ This.Void_Ptr := new_fl_sys_menu_bar
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return System_Menu_Bar is
+ begin
+ return This : System_Menu_Bar := Create (X, Y, W, H, Text) do
+ Parent.Add (This);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Add
+ (This : in out System_Menu_Bar;
+ Text : in String)
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add
+ (This.Void_Ptr, Interfaces.C.To_C (Text));
+ begin
+ This.Adjust_Item_Store;
+ end Add;
+
+
+ function Add
+ (This : in out System_Menu_Bar;
+ Text : in String)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add
+ (This.Void_Ptr, Interfaces.C.To_C (Text));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Add;
+
+
+ procedure Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add2
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.unsigned_long (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Add;
+
+
+ function Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add2
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.unsigned_long (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Add;
+
+
+ procedure Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add3
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.unsigned_long (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Add;
+
+
+ function Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_add3
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.unsigned_long (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Add;
+
+
+ procedure Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.unsigned_long (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Insert;
+
+
+ function Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.unsigned_long (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Insert;
+
+
+ procedure Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert2
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.unsigned_long (Flags));
+ begin
+ This.Adjust_Item_Store;
+ end Insert;
+
+
+ function Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index
+ is
+ Added_Spot : Interfaces.C.int := fl_sys_menu_bar_insert2
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text),
+ Interfaces.C.To_C (Shortcut),
+ Callback_Convert.To_Address (Action),
+ Interfaces.C.unsigned_long (Flags));
+ begin
+ This.Adjust_Item_Store;
+ return Index (Added_Spot + 1);
+ end Insert;
+
+
+ procedure Use_Same_Items
+ (This : in out System_Menu_Bar;
+ Donor : in Menu'Class) is
+ begin
+ -- Donor menu() pointer will be obtained in C++
+ fl_sys_menu_bar_set_menu (This.Void_Ptr, Donor.Void_Ptr);
+ This.Adjust_Item_Store;
+ end Use_Same_Items;
+
+
+ procedure Remove
+ (This : in out System_Menu_Bar;
+ Place : in Index) is
+ begin
+ fl_sys_menu_bar_remove (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ This.Adjust_Item_Store;
+ end Remove;
+
+
+ procedure Clear
+ (This : in out System_Menu_Bar) is
+ begin
+ for Item of This.My_Items loop
+ Free_Item (Item);
+ end loop;
+ This.My_Items.Clear;
+ fl_sys_menu_bar_clear (This.Void_Ptr);
+ end Clear;
+
+
+ procedure Clear_Submenu
+ (This : in out System_Menu_Bar;
+ Place : in Index)
+ is
+ Result : Interfaces.C.int := fl_sys_menu_bar_clear_submenu
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1);
+ begin
+ if Result = -1 then
+ raise No_Reference_Error;
+ else
+ pragma Assert (Result = 0);
+ This.Adjust_Item_Store;
+ end if;
+ exception
+ when Chk.Assertion_Error => raise Internal_FLTK_Error with
+ "Call to Fl_Sys_Menu_Bar::clear_submenu returned unexpected int result of " &
+ Interfaces.C.int'Image (Result);
+ end Clear_Submenu;
+
+
+
+
+ function Item
+ (This : in System_Menu_Bar;
+ Place : in Index)
+ return FLTK.Menu_Items.Menu_Item_Reference is
+ begin
+ return Menu_Bar (This).Item (Place);
+ end Item;
+
+
+
+
+ procedure Set_Only
+ (This : in out System_Menu_Bar;
+ Item : in out FLTK.Menu_Items.Menu_Item) is
+ begin
+ fl_sys_menu_bar_setonly (This.Void_Ptr, Wrapper (Item).Void_Ptr);
+ end Set_Only;
+
+
+ procedure Set_Label
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String) is
+ begin
+ fl_sys_menu_bar_replace
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.To_C (Text));
+ end Set_Label;
+
+
+ procedure Set_Shortcut
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Press : in Key_Combo) is
+ begin
+ fl_sys_menu_bar_shortcut
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ To_C (Press));
+ end Set_Shortcut;
+
+
+ function Get_Flags
+ (This : in System_Menu_Bar;
+ Place : in Index)
+ return Menu_Flag is
+ begin
+ return Menu_Flag (fl_sys_menu_bar_get_mode (This.Void_Ptr, Interfaces.C.int (Place) - 1));
+ end Get_Flags;
+
+
+ procedure Set_Flags
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Flags : in Menu_Flag) is
+ begin
+ fl_sys_menu_bar_set_mode
+ (This.Void_Ptr,
+ Interfaces.C.int (Place) - 1,
+ Interfaces.C.unsigned_long (Flags));
+ end Set_Flags;
+
+
+
+
+ procedure Make_Global
+ (This : in out System_Menu_Bar) is
+ begin
+ fl_sys_menu_bar_global (This.Void_Ptr);
+ end Make_Global;
+
+
+ procedure Update
+ (This : in out System_Menu_Bar) is
+ begin
+ fl_sys_menu_bar_update (This.Void_Ptr);
+ end Update;
+
+
+
+
+ procedure Draw
+ (This : in out System_Menu_Bar) is
+ begin
+ Menu_Bar (This).Draw;
+ end Draw;
+
+
+end FLTK.Widgets.Menus.Menu_Bars.Systemwide;
+
+
diff --git a/src/fltk-widgets-menus-menu_bars-systemwide.ads b/src/fltk-widgets-menus-menu_bars-systemwide.ads
new file mode 100644
index 0000000..77dba9f
--- /dev/null
+++ b/src/fltk-widgets-menus-menu_bars-systemwide.ads
@@ -0,0 +1,222 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Menu_Items;
+
+limited with
+
+ FLTK.Widgets.Groups;
+
+
+package FLTK.Widgets.Menus.Menu_Bars.Systemwide is
+
+
+ type System_Menu_Bar is new Menu_Bar with private;
+
+ type System_Menu_Bar_Reference (Data : not null access System_Menu_Bar'Class) is limited
+ null record with Implicit_Dereference => Data;
+
+
+
+
+ package Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return System_Menu_Bar;
+
+ function Create
+ (Parent : in out FLTK.Widgets.Groups.Group'Class;
+ X, Y, W, H : in Integer;
+ Text : in String := "")
+ return System_Menu_Bar;
+
+ end Forge;
+
+
+
+
+ procedure Add
+ (This : in out System_Menu_Bar;
+ Text : in String);
+
+ function Add
+ (This : in out System_Menu_Bar;
+ Text : in String)
+ return Index;
+
+ procedure Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal);
+
+ function Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index;
+
+ procedure Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal);
+
+ function Add
+ (This : in out System_Menu_Bar;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index;
+
+ procedure Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal);
+
+ function Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index;
+
+ procedure Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal);
+
+ function Insert
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String;
+ Action : in Widget_Callback := null;
+ Shortcut : in String;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Index;
+
+ procedure Use_Same_Items
+ (This : in out System_Menu_Bar;
+ Donor : in Menu'Class);
+
+ procedure Remove
+ (This : in out System_Menu_Bar;
+ Place : in Index);
+
+ procedure Clear
+ (This : in out System_Menu_Bar);
+
+ procedure Clear_Submenu
+ (This : in out System_Menu_Bar;
+ Place : in Index);
+
+
+
+
+ function Item
+ (This : in System_Menu_Bar;
+ Place : in Index)
+ return FLTK.Menu_Items.Menu_Item_Reference;
+
+
+
+
+ procedure Set_Only
+ (This : in out System_Menu_Bar;
+ Item : in out FLTK.Menu_Items.Menu_Item);
+
+ procedure Set_Label
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Text : in String);
+
+ procedure Set_Shortcut
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Press : in Key_Combo);
+
+ function Get_Flags
+ (This : in System_Menu_Bar;
+ Place : in Index)
+ return Menu_Flag;
+
+ procedure Set_Flags
+ (This : in out System_Menu_Bar;
+ Place : in Index;
+ Flags : in Menu_Flag);
+
+
+
+
+ procedure Make_Global
+ (This : in out System_Menu_Bar);
+
+ procedure Update
+ (This : in out System_Menu_Bar);
+
+
+
+
+ procedure Draw
+ (This : in out System_Menu_Bar);
+
+
+private
+
+
+ type System_Menu_Bar is new Menu_Bar with null record;
+
+ overriding procedure Initialize
+ (This : in out System_Menu_Bar);
+
+ overriding procedure Finalize
+ (This : in out System_Menu_Bar);
+
+ procedure Extra_Init
+ (This : in out System_Menu_Bar;
+ X, Y, W, H : in Integer;
+ Text : in String)
+ with Inline;
+
+ procedure Extra_Final
+ (This : in out System_Menu_Bar)
+ with Inline;
+
+
+ pragma Inline (Item);
+
+ pragma Inline (Set_Only);
+ pragma Inline (Set_Label);
+ pragma Inline (Set_Shortcut);
+ pragma Inline (Get_Flags);
+ pragma Inline (Set_Flags);
+
+ pragma Inline (Make_Global);
+ pragma Inline (Update);
+
+ pragma Inline (Draw);
+
+
+end FLTK.Widgets.Menus.Menu_Bars.Systemwide;
+
+
diff --git a/src/fltk-widgets-menus-menu_bars.adb b/src/fltk-widgets-menus-menu_bars.adb
index d3f1295..f1dba40 100644
--- a/src/fltk-widgets-menus-menu_bars.adb
+++ b/src/fltk-widgets-menus-menu_bars.adb
@@ -47,6 +47,22 @@ package body FLTK.Widgets.Menus.Menu_Bars is
+ function fl_menu_get_item
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_get_item, "fl_menu_get_item");
+ pragma Inline (fl_menu_get_item);
+
+ function fl_menu_value
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_value, "fl_menu_value");
+ pragma Inline (fl_menu_value);
+
+
+
+
-------------------
-- Destructors --
-------------------
@@ -87,8 +103,10 @@ package body FLTK.Widgets.Menus.Menu_Bars is
procedure Initialize
(This : in out Menu_Bar) is
begin
- This.Draw_Ptr := fl_menu_bar_draw'Address;
- This.Handle_Ptr := fl_menu_bar_handle'Address;
+ This.Draw_Ptr := fl_menu_bar_draw'Address;
+ This.Handle_Ptr := fl_menu_bar_handle'Address;
+ This.Get_Item_Ptr := fl_menu_get_item'Address;
+ This.Value_Ptr := fl_menu_value'Address;
end Initialize;
diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb
index f3c290f..b526e49 100644
--- a/src/fltk-widgets-menus-menu_buttons.adb
+++ b/src/fltk-widgets-menus-menu_buttons.adb
@@ -62,6 +62,22 @@ package body FLTK.Widgets.Menus.Menu_Buttons is
+ function fl_menu_get_item
+ (M : in Storage.Integer_Address;
+ I : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_menu_get_item, "fl_menu_get_item");
+ pragma Inline (fl_menu_get_item);
+
+ function fl_menu_value
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_value, "fl_menu_value");
+ pragma Inline (fl_menu_value);
+
+
+
+
-------------------
-- Destructors --
-------------------
@@ -142,8 +158,10 @@ package body FLTK.Widgets.Menus.Menu_Buttons is
procedure Initialize
(This : in out Menu_Button) is
begin
- This.Draw_Ptr := fl_menu_button_draw'Address;
- This.Handle_Ptr := fl_menu_button_handle'Address;
+ This.Draw_Ptr := fl_menu_button_draw'Address;
+ This.Handle_Ptr := fl_menu_button_handle'Address;
+ This.Get_Item_Ptr := fl_menu_get_item'Address;
+ This.Value_Ptr := fl_menu_value'Address;
end Initialize;
diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb
index 9943bc9..3e5df01 100644
--- a/src/fltk-widgets-menus.adb
+++ b/src/fltk-widgets-menus.adb
@@ -495,8 +495,10 @@ package body FLTK.Widgets.Menus is
procedure Initialize
(This : in out Menu) is
begin
- This.Draw_Ptr := fl_menu_draw'Address;
- This.Handle_Ptr := fl_menu_handle'Address;
+ This.Draw_Ptr := fl_menu_draw'Address;
+ This.Handle_Ptr := fl_menu_handle'Address;
+ This.Get_Item_Ptr := fl_menu_get_item'Address;
+ This.Value_Ptr := fl_menu_value'Address;
Wrapper (This.My_Find).Needs_Dealloc := False;
Wrapper (This.My_Pick).Needs_Dealloc := False;
end Initialize;
@@ -735,6 +737,7 @@ package body FLTK.Widgets.Menus is
end loop;
Pointers (Pointers'Last) := Null_Item;
fl_menu_copy (This.Void_Ptr, Storage.To_Integer (Pointers (Pointers'First)'Address));
+ This.Adjust_Item_Store;
end Set_Items;
@@ -744,6 +747,7 @@ package body FLTK.Widgets.Menus is
begin
-- Donor menu() pointer will be obtained in C++
fl_menu_set_menu (This.Void_Ptr, Donor.Void_Ptr);
+ This.Adjust_Item_Store;
end Use_Same_Items;
@@ -810,10 +814,17 @@ package body FLTK.Widgets.Menus is
function Item
(This : in Menu;
Place : in Index)
- return FLTK.Menu_Items.Menu_Item_Reference is
+ return FLTK.Menu_Items.Menu_Item_Reference
+ is
+ function my_get_item
+ (M : in Storage.Integer_Address;
+ P : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ for my_get_item'Address use This.Get_Item_Ptr;
+ pragma Import (Ada, my_get_item);
begin
Wrapper (This.My_Items (Place).all).Void_Ptr :=
- fl_menu_get_item (This.Void_Ptr, Interfaces.C.int (Place) - 1);
+ my_get_item (This.Void_Ptr, Interfaces.C.int (Place) - 1);
return (Data => This.My_Items (Place).all'Unchecked_Access);
end Item;
@@ -1015,8 +1026,7 @@ package body FLTK.Widgets.Menus is
(This : in Menu)
return FLTK.Menu_Items.Menu_Item_Reference
is
- Dis_This : access constant Menu'Class := This'Access;
- Place : Extended_Index := Dis_This.Chosen_Index;
+ Place : Extended_Index := This.Chosen_Index;
begin
if Place = No_Index then
raise No_Reference_Error;
@@ -1041,9 +1051,15 @@ package body FLTK.Widgets.Menus is
function Chosen_Index
(This : in Menu)
- return Extended_Index is
+ return Extended_Index
+ is
+ function my_value
+ (M : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_value'Address use This.Value_Ptr;
+ pragma Import (Ada, my_value);
begin
- return Extended_Index (fl_menu_value (This.Void_Ptr) + 1);
+ return Extended_Index (my_value (This.Void_Ptr) + 1);
end Chosen_Index;
diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads
index 648def2..63828a5 100644
--- a/src/fltk-widgets-menus.ads
+++ b/src/fltk-widgets-menus.ads
@@ -17,7 +17,8 @@ private with
Ada.Containers.Vectors,
Ada.Finalization,
- Interfaces;
+ Interfaces,
+ System;
package FLTK.Widgets.Menus is
@@ -408,9 +409,11 @@ private
Element_Type => Item_Access);
type Menu is new Widget with record
- My_Items : Item_Vectors.Vector;
- My_Find : aliased FLTK.Menu_Items.Menu_Item;
- My_Pick : aliased FLTK.Menu_Items.Menu_Item;
+ My_Items : Item_Vectors.Vector;
+ My_Find : aliased FLTK.Menu_Items.Menu_Item;
+ My_Pick : aliased FLTK.Menu_Items.Menu_Item;
+ Get_Item_Ptr : System.Address;
+ Value_Ptr : System.Address;
end record;
overriding procedure Initialize
@@ -429,6 +432,11 @@ private
(This : in out Menu);
+ -- Used internally after every time the number of menu items is meddled with
+ procedure Adjust_Item_Store
+ (This : in out Menu);
+
+
type Cursor is record
My_Container : access Menu;
My_Index : Index'Base := Index'First;
@@ -457,8 +465,6 @@ private
return Cursor;
- pragma Inline (Use_Same_Items);
-
pragma Inline (Has_Item);
pragma Inline (Item);
pragma Inline (Find_Item);
generated by cgit (git 2.30.0) at 2025-01-22 11:13:22 +0000