[gtkada] Examples global improvement patch proposals.

Pascal p.p14 at orange.fr
Fri Jul 27 20:51:35 CEST 2012


Hello, in examples from GtkAda GPL 2012, I've made some improvements (from my point of view ;-)
If you don't agree with them please send feedback.
Here is patch proposals:

a) Add a clean quit callback on window delete event:

--- ./examples/cursors/cursor.adb.0	2012-05-18 10:04:13.000000000 +0200
+++ ./examples/cursors/cursor.adb	2012-07-25 09:57:56.000000000 +0200
@@ -11,12 +11,25 @@
 with Gdk.Pixbuf;  use Gdk.Pixbuf;
 with Gtkada.Handlers; use Gtkada.Handlers;
 with Gtk.Widget;  use Gtk.Widget;
+with Gtk.Handlers; use Gtk.Handlers;
 
 procedure Cursor is
    Win : Gtk_Window;
    Pix : Gdk_Pixbuf;
    Error : GError;
 
+   package Window_Cb is new Gtk.Handlers.Return_Callback
+     (Gtk_Window_Record, Boolean);
+   --  Callback for delete_event.
+   function On_Main_Window_Delete_Event
+     (Object : access Gtk_Window_Record'Class) return Boolean
+   is
+      pragma Unreferenced (Object);
+   begin
+      Gtk.Main.Main_Quit;
+      return True;
+   end On_Main_Window_Delete_Event;
+
    procedure On_Realize (Win : access Gtk_Widget_Record'Class) is
       Cursor : Gdk_Cursor;
    begin
@@ -51,6 +64,10 @@
    Put_Line
      ("Maximal cursor size: " & Guint'Image (W) & "x" & Guint'Image (H));
 
+  Window_Cb.Connect
+    (Win, "delete_event",
+     Window_Cb.To_Marshaller (On_Main_Window_Delete_Event'Access));
+
    Show_All (Win);
    Main;
 end Cursor;

--- ./examples/display_switch/test_display_switch.adb.0	2012-05-18 10:04:16.000000000 +0200
+++ ./examples/display_switch/test_display_switch.adb	2012-07-25 09:58:34.000000000 +0200
@@ -41,6 +41,7 @@
 
 with Ada.Text_IO; use Ada.Text_IO;
 with Gtk.Widget;
+with Gtk.Handlers;
 
 procedure Test_Display_Switch is
    Window : Gtk_Window;
@@ -53,6 +54,20 @@
       Gtk.Main.Main_Quit;
    end On_Click;
 
+   package Window_Cb is new Gtk.Handlers.Return_Callback
+     (Gtk_Window_Record, Boolean);
+   function On_Main_Window_Delete_Event
+     (Object : access Gtk_Window_Record'Class) return Boolean;
+   --  Callback for delete_event.
+   function On_Main_Window_Delete_Event
+     (Object : access Gtk_Window_Record'Class) return Boolean
+   is
+      pragma Unreferenced (Object);
+   begin
+      Gtk.Main.Main_Quit;
+      return True;
+   end On_Main_Window_Delete_Event;
+
 begin
    Put_Line ("Enter the display used to initialize GtkAda: ");
 
@@ -96,6 +111,10 @@
          Gtkada.Handlers.Widget_Callback.Connect
            (Button, "clicked", On_Click'Unrestricted_Access);
 
+         Window_Cb.Connect
+           (Window, "delete_event",
+            Window_Cb.To_Marshaller (On_Main_Window_Delete_Event'Access));
+
          --  Show the window
          Show_All (Window);
 
--- ./examples/documentation/contextual.adb.0	2012-05-18 10:04:14.000000000 +0200
+++ ./examples/documentation/contextual.adb	2012-07-25 09:57:43.000000000 +0200
@@ -9,9 +9,22 @@
 with Gtk.Menu_Item; use Gtk.Menu_Item;
 with Gtk.Enums; use Gtk.Enums;
 with Gtk.Main; use Gtk.Main;
+with Gtk.Label; use Gtk.Label;
 
 procedure Contextual is
 
+   package Window_Cb is new Gtk.Handlers.Return_Callback
+     (Gtk_Window_Record, Boolean);
+   --  Callback for delete_event.
+   function On_Main_Window_Delete_Event
+     (Object : access Gtk_Window_Record'Class) return Boolean
+   is
+      pragma Unreferenced (Object);
+   begin
+      Gtk.Main.Main_Quit;
+      return True;
+   end On_Main_Window_Delete_Event;
+
    package Menu_Cb is new Gtk.Handlers.Return_Callback
      (Widget_Type => Gtk_Menu_Record,  Return_Type => Boolean);
 
@@ -34,6 +47,7 @@
    Menu  : Gtk_Menu;
    Win   : Gtk_Window;
    Item  : Gtk_Menu_Item;
+   Label  : Gtk_Label;
 begin
    Gtk.Main.Init;
 
@@ -47,6 +61,12 @@
    --  Prepares it to receive button_press events
    Gtk_New (Win, Window_Toplevel);
    Set_Events (Win, Button_Press_Mask);
+   Gtk.Window.Set_Default_Size
+    (Window => Win,
+     Width  => 230,
+     Height => 150);
+   Gtk_New (Label, "Do a right clic...");
+   Add (Win, Label);
 
    --  Finally, connect both:
    Menu_Cb.Object_Connect
@@ -54,6 +74,10 @@
        Menu_Cb.To_Marshaller (Popup_Menu_Handler'Access),
        Slot_Object => Menu);
 
+   Window_Cb.Connect
+    (Win, "delete_event",
+     Window_Cb.To_Marshaller (On_Main_Window_Delete_Event'Access));
+
    Show_All (Win);
    Gtk.Main.Main;
 end Contextual;

--- ./examples/images/rect.adb.0	2012-05-18 10:04:18.000000000 +0200
+++ ./examples/images/rect.adb	2012-07-25 09:58:22.000000000 +0200
@@ -42,7 +42,7 @@
 with Gtk.Widget;       use Gtk.Widget;
 with Gtk.Window;       use Gtk.Window;
 with Gtkada.Handlers;  use Gtkada.Handlers;
-
+with Gtk.Handlers;
 with Cairo.Region;
 
 procedure Rect is
@@ -264,6 +264,18 @@
       return True;
    end On_Expose;
 
+   package Window_Cb is new Gtk.Handlers.Return_Callback
+     (Gtk_Window_Record, Boolean);
+   --  Callback for delete_event.
+   function On_Main_Window_Delete_Event
+     (Object : access Gtk_Window_Record'Class) return Boolean
+   is
+      pragma Unreferenced (Object);
+   begin
+      Gtk.Main.Main_Quit;
+      return True;
+   end On_Main_Window_Delete_Event;
+
 begin
    Init;
    Gtk_New (Win, Window_Toplevel);
@@ -281,7 +293,7 @@
    --  error code of course, and provide fallbacks.
    --  Note that at this point the image has not been drawn to the screen
 
-   Gdk_New_From_File (Pix, "../../testgtk/alps.png", Error);
+   Gdk_New_From_File (Pix, "../testgtk/alps.png", Error);
 
    --  Connect to the relevant signals
 
@@ -298,6 +310,10 @@
      (Draw, "motion_notify_event",
       Return_Callback.To_Marshaller (On_Move'Unrestricted_Access));
 
+   Window_Cb.Connect
+     (Win, "delete_event",
+      Window_Cb.To_Marshaller (On_Main_Window_Delete_Event'Access));
+
    Show_All (Win);
 
    --  Start the main loop

b) More understandable message on exception:

--- ./examples/user_data/test_handlers.adb.0	2012-05-18 10:04:17.000000000 +0200
+++ ./examples/user_data/test_handlers.adb	2012-07-12 09:26:36.000000000 +0200
@@ -1,4 +1,4 @@
-
+with Ada.Exceptions; use Ada.Exceptions;
 with Ada.Text_IO;  use Ada.Text_IO;
 with Glib;         use Glib;
 with Gtk.Window;   use Gtk.Window;
@@ -47,6 +47,14 @@
       Disconnect (Data.Object, Data.Id);
    end My_Destroy3;
 
+  procedure My_Destroy4
+    (Button : access Gtk_Widget_Record'Class;
+     Data   : Gtk_Widget) is
+  begin
+     Put_Line ("My_Destroy4");
+     Destroy (Data);
+  end My_Destroy4;
+
    Win              : Gtk_Window;
    Button1, Button2 : Gtk_Button;
    Vbox, Hbox       : Gtk_Box;
@@ -122,10 +130,17 @@
 
    Id := User_Callback.Connect
      (Button1, "clicked",
-      User_Callback.To_Marshaller (My_Destroy2'Unrestricted_Access),
+      User_Callback.To_Marshaller (My_Destroy4'Unrestricted_Access),
       Gtk_Widget (Button2));
    Add_Watch (Id, Button2);
 
    Show_All (Win);
    Gtk.Main.Main;
+   exception
+      when E : others =>
+         Put_Line (Exception_Information (E));
+         Put_Line ("If you don't destroy the callback at the sametime, " &
+         "then the next time the callback is called it will try to access " &
+         "some invalid memory (Object being destroyed) " &
+         "and you will likely get a Storage_Error.");
 end Test_Handlers;

c) Ready to use example:

--- ./examples/powergnu/file.tst.0	2012-07-11 22:59:01.000000000 +0200
+++ ./examples/powergnu/file.tst	2012-07-09 16:46:28.000000000 +0200
@@ -1 +1,3 @@
-<enter image name in file.tst>
+../testgtk/alps.png
+../testgtk/background.jpg
+../testgtk/lightning.png

d) Precise help message on screen:

--- ./examples/documentation/banner.adb.0	2012-05-18 10:04:14.000000000 +0200
+++ ./examples/documentation/banner.adb	2012-07-09 13:27:11.000000000 +0200
@@ -18,7 +18,7 @@
    Set_Position (Win, Win_Pos_Center);
    Set_Size_Request (Win, 300, 300);
 
-   Gtk_New (Label, "You should show a pixmap instead...");
+   Gtk_New (Label, "You should show a pixmap instead... (ctrl-c to exit)");
    Add (Win, Label);
 
    Show_All (Win);

HTH, Pascal.
http://blady.pagesperso-orange.fr




More information about the gtkada mailing list