Help_Dialog now has Show_With_Args

12 files changed, 120 insertions, 61 deletions

diff --git a/src/c_fl_help_dialog.cpp b/src/c_fl_help_dialog.cpp
index 9888df9..5eb719e 100644
--- a/src/c_fl_help_dialog.cpp
+++ b/src/c_fl_help_dialog.cpp
@@ -26,6 +26,10 @@ void fl_help_dialog_show(HELPDIALOG d) {
     reinterpret_cast<Fl_Help_Dialog*>(d)->show();
 }
 
+void fl_help_dialog_show2(HELPDIALOG d, int c, void * v) {
+    reinterpret_cast<Fl_Help_Dialog*>(d)->show(c, static_cast<char**>(v));
+}
+
 void fl_help_dialog_hide(HELPDIALOG d) {
     reinterpret_cast<Fl_Help_Dialog*>(d)->hide();
 }
diff --git a/src/c_fl_help_dialog.h b/src/c_fl_help_dialog.h
index 03846c2..ddabce8 100644
--- a/src/c_fl_help_dialog.h
+++ b/src/c_fl_help_dialog.h
@@ -8,20 +8,15 @@
 #define FL_HELP_DIALOG_GUARD
 
 
-
-
 typedef void* HELPDIALOG;
 
 
-
-
 extern "C" HELPDIALOG new_fl_help_dialog();
 extern "C" void free_fl_help_dialog(HELPDIALOG d);
 
 
-
-
 extern "C" void fl_help_dialog_show(HELPDIALOG d);
+extern "C" void fl_help_dialog_show2(HELPDIALOG d, int c, void * v);
 extern "C" void fl_help_dialog_hide(HELPDIALOG d);
 extern "C" int fl_help_dialog_visible(HELPDIALOG d);
 
diff --git a/src/fltk-help_dialogs.adb b/src/fltk-help_dialogs.adb
index c7cf870..fc5ab07 100644
--- a/src/fltk-help_dialogs.adb
+++ b/src/fltk-help_dialogs.adb
@@ -6,6 +6,7 @@
 
 with
 
+    FLTK.Show_Argv,
     Interfaces.C.Strings;
 
 use type
@@ -38,6 +39,13 @@ package body FLTK.Help_Dialogs is
     pragma Import (C, fl_help_dialog_show, "fl_help_dialog_show");
     pragma Inline (fl_help_dialog_show);
 
+    procedure fl_help_dialog_show2
+           (D : in Storage.Integer_Address;
+            C : in Interfaces.C.int;
+            V : in Storage.Integer_Address);
+    pragma Import (C, fl_help_dialog_show2, "fl_help_dialog_show2");
+    pragma Inline (fl_help_dialog_show2);
+
     procedure fl_help_dialog_hide
            (D : in Storage.Integer_Address);
     pragma Import (C, fl_help_dialog_hide, "fl_help_dialog_hide");
@@ -199,6 +207,13 @@ package body FLTK.Help_Dialogs is
     end Show;
 
 
+    procedure Show_With_Args
+           (This : in out Help_Dialog) is
+    begin
+        FLTK.Show_Argv.Dispatch (fl_help_dialog_show2'Access, This.Void_Ptr);
+    end Show_With_Args;
+
+
     procedure Hide
            (This : in out Help_Dialog) is
     begin
diff --git a/src/fltk-help_dialogs.ads b/src/fltk-help_dialogs.ads
index ebe59df..655e357 100644
--- a/src/fltk-help_dialogs.ads
+++ b/src/fltk-help_dialogs.ads
@@ -36,6 +36,9 @@ package FLTK.Help_Dialogs is
     procedure Show
            (This : in out Help_Dialog);
 
+    procedure Show_With_Args
+           (This : in out Help_Dialog);
+
     procedure Hide
            (This : in out Help_Dialog);
 
@@ -120,6 +123,7 @@ private
 
 
     pragma Inline (Show);
+    pragma Inline (Show_With_Args);
     pragma Inline (Hide);
     pragma Inline (Is_Visible);
 
diff --git a/src/fltk-show_argv.adb b/src/fltk-show_argv.adb
new file mode 100644
index 0000000..52e22e2
--- /dev/null
+++ b/src/fltk-show_argv.adb
@@ -0,0 +1,50 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+with
+
+    Ada.Command_Line,
+    Interfaces.C.Strings;
+
+
+package body FLTK.Show_Argv is
+
+
+    package ACom renames Ada.Command_Line;
+    package IntC renames Interfaces.C;
+    package ICS  renames Interfaces.C.Strings;
+
+
+    function Create_Argv
+        return ICS.chars_ptr_array
+    is
+        Result : ICS.chars_ptr_array (0 .. IntC.size_t (ACom.Argument_Count));
+    begin
+        Result (0) := ICS.New_String (ACom.Command_Name);
+        for Index in Integer range 1 .. ACom.Argument_Count loop
+            Result (IntC.size_t (Index)) := ICS.New_String (ACom.Argument (Index));
+        end loop;
+        return Result;
+    end Create_Argv;
+
+
+    procedure Dispatch
+           (Func : in Show_With_Args_Func;
+            CObj : in Storage.Integer_Address)
+    is
+        Argv : ICS.chars_ptr_array := Create_Argv;
+    begin
+        Func (CObj, IntC.int (ACom.Argument_Count + 1),
+            Storage.To_Integer (Argv (Argv'First)'Address));
+        for Ptr of Argv loop
+            ICS.Free (Ptr);
+        end loop;
+    end Dispatch;
+
+
+end FLTK.Show_Argv;
+
+
diff --git a/src/fltk-show_argv.ads b/src/fltk-show_argv.ads
new file mode 100644
index 0000000..231b875
--- /dev/null
+++ b/src/fltk-show_argv.ads
@@ -0,0 +1,35 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+with
+
+    Interfaces.C;
+
+
+private package FLTK.Show_Argv is
+
+
+    --  Used for implementing show(argc,argv)
+
+    type Show_With_Args_Func is access procedure
+           (CObj : in Storage.Integer_Address;
+            Argc : in Interfaces.C.int;
+            Argv : in Storage.Integer_Address);
+
+    procedure Dispatch
+           (Func : in Show_With_Args_Func;
+            CObj : in Storage.Integer_Address);
+
+
+private
+
+
+    pragma Convention (C, Show_With_Args_Func);
+
+
+end FLTK.Show_Argv;
+
+
diff --git a/src/fltk-widgets-groups-windows-double-overlay.adb b/src/fltk-widgets-groups-windows-double-overlay.adb
index 3b16b62..53ba257 100644
--- a/src/fltk-widgets-groups-windows-double-overlay.adb
+++ b/src/fltk-widgets-groups-windows-double-overlay.adb
@@ -6,6 +6,7 @@
 
 with
 
+    FLTK.Show_Argv,
     Interfaces.C,
     System.Address_To_Access_Conversions;
 
@@ -222,7 +223,7 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is
     procedure Show_With_Args
            (This : in out Overlay_Window) is
     begin
-        Dispatch_Show_With_Args (fl_overlay_window_show2'Access, This.Void_Ptr);
+        FLTK.Show_Argv.Dispatch (fl_overlay_window_show2'Access, This.Void_Ptr);
     end Show_With_Args;
 
 
diff --git a/src/fltk-widgets-groups-windows-double.adb b/src/fltk-widgets-groups-windows-double.adb
index 044bf38..bb7e3da 100644
--- a/src/fltk-widgets-groups-windows-double.adb
+++ b/src/fltk-widgets-groups-windows-double.adb
@@ -6,6 +6,7 @@
 
 with
 
+    FLTK.Show_Argv,
     Interfaces.C;
 
 
@@ -190,7 +191,7 @@ package body FLTK.Widgets.Groups.Windows.Double is
     procedure Show_With_Args
            (This : in out Double_Window) is
     begin
-        Dispatch_Show_With_Args (fl_double_window_show2'Access, This.Void_Ptr);
+        FLTK.Show_Argv.Dispatch (fl_double_window_show2'Access, This.Void_Ptr);
     end Show_With_Args;
 
 
diff --git a/src/fltk-widgets-groups-windows-opengl.adb b/src/fltk-widgets-groups-windows-opengl.adb
index 1b8bea7..e949f2d 100644
--- a/src/fltk-widgets-groups-windows-opengl.adb
+++ b/src/fltk-widgets-groups-windows-opengl.adb
@@ -6,6 +6,7 @@
 
 with
 
+    FLTK.Show_Argv,
     Interfaces.C,
     System;
 
@@ -316,7 +317,7 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is
     procedure Show_With_Args
            (This : in out GL_Window) is
     begin
-        Dispatch_Show_With_Args (fl_gl_window_show2'Access, This.Void_Ptr);
+        FLTK.Show_Argv.Dispatch (fl_gl_window_show2'Access, This.Void_Ptr);
     end Show_With_Args;
 
 
diff --git a/src/fltk-widgets-groups-windows-single.adb b/src/fltk-widgets-groups-windows-single.adb
index 6e7c7c1..a74b122 100644
--- a/src/fltk-widgets-groups-windows-single.adb
+++ b/src/fltk-widgets-groups-windows-single.adb
@@ -6,6 +6,7 @@
 
 with
 
+    FLTK.Show_Argv,
     Interfaces.C;
 
 
@@ -178,7 +179,7 @@ package body FLTK.Widgets.Groups.Windows.Single is
     procedure Show_With_Args
            (This : in out Single_Window) is
     begin
-        Dispatch_Show_With_Args (fl_single_window_show2'Access, This.Void_Ptr);
+        FLTK.Show_Argv.Dispatch (fl_single_window_show2'Access, This.Void_Ptr);
     end Show_With_Args;
 
 
diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb
index afd17ae..b79f937 100644
--- a/src/fltk-widgets-groups-windows.adb
+++ b/src/fltk-widgets-groups-windows.adb
@@ -8,7 +8,8 @@ with
 
     Ada.Command_Line,
     Interfaces.C.Strings,
-    FLTK.Images.RGB;
+    FLTK.Images.RGB,
+    FLTK.Show_Argv;
 
 use type
 
@@ -299,42 +300,6 @@ package body FLTK.Widgets.Groups.Windows is
 
 
 
-    ------------------------
-    --  Internal Utility  --
-    ------------------------
-
-    function Create_Argv
-        return Interfaces.C.Strings.chars_ptr_array
-    is
-        package ICS renames Interfaces.C.Strings;
-        package ACom renames Ada.Command_Line;
-
-        Result : ICS.chars_ptr_array (0 .. Interfaces.C.size_t (ACom.Argument_Count));
-    begin
-        Result (0) := ICS.New_String (ACom.Command_Name);
-        for Index in Integer range 1 .. ACom.Argument_Count loop
-            Result (Interfaces.C.size_t (Index)) := ICS.New_String (ACom.Argument (Index));
-        end loop;
-        return Result;
-    end Create_Argv;
-
-
-    procedure Dispatch_Show_With_Args
-           (Func : in Show_With_Args_Func;
-            CObj : in Storage.Integer_Address)
-    is
-        Argv : Interfaces.C.Strings.chars_ptr_array := Create_Argv;
-    begin
-        Func (CObj, Interfaces.C.int (Ada.Command_Line.Argument_Count + 1),
-            Storage.To_Integer (Argv (Argv'First)'Address));
-        for Ptr of Argv loop
-            Interfaces.C.Strings.Free (Ptr);
-        end loop;
-    end Dispatch_Show_With_Args;
-
-
-
-
     -------------------
     --  Destructors  --
     -------------------
@@ -432,7 +397,7 @@ package body FLTK.Widgets.Groups.Windows is
     procedure Show_With_Args
            (This : in out Window) is
     begin
-        Dispatch_Show_With_Args (fl_window_show2'Access, This.Void_Ptr);
+        FLTK.Show_Argv.Dispatch (fl_window_show2'Access, This.Void_Ptr);
     end Show_With_Args;
 
 
diff --git a/src/fltk-widgets-groups-windows.ads b/src/fltk-widgets-groups-windows.ads
index 97d79d9..d00d3d7 100644
--- a/src/fltk-widgets-groups-windows.ads
+++ b/src/fltk-widgets-groups-windows.ads
@@ -235,19 +235,6 @@ private
     with Inline;
 
 
-    --  Used for implementing show(argc,argv)
-    type Show_With_Args_Func is access procedure
-           (CObj : in Storage.Integer_Address;
-            Argc : in Interfaces.C.int;
-            Argv : in Storage.Integer_Address);
-
-    pragma Convention (C, Show_With_Args_Func);
-
-    procedure Dispatch_Show_With_Args
-           (Func : in Show_With_Args_Func;
-            CObj : in Storage.Integer_Address);
-
-
     pragma Inline (Show);
     pragma Inline (Show_With_Args);
     pragma Inline (Hide);