[Gd-chatter] r11371 - in branches/opendylan-melange: gtk gtk-duim

andreas at gwydiondylan.org andreas at gwydiondylan.org
Wed May 23 02:54:58 CEST 2007


Author: andreas
Date: Wed May 23 02:54:56 2007
New Revision: 11371

Modified:
   branches/opendylan-melange/gtk-duim/gtk-events.dylan
   branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan
   branches/opendylan-melange/gtk-duim/gtk-menus.dylan
   branches/opendylan-melange/gtk-duim/gtk-mirror.dylan
   branches/opendylan-melange/gtk-duim/gtk-top.dylan
   branches/opendylan-melange/gtk/gtk.dylan
Log:
Job: fd
more signal hacking
allow creation of objects at address null


Modified: branches/opendylan-melange/gtk-duim/gtk-events.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-events.dylan	(original)
+++ branches/opendylan-melange/gtk-duim/gtk-events.dylan	Wed May 23 02:54:56 2007
@@ -9,23 +9,8 @@
 
 /// GTK signals
 
-define function install-named-handlers
-    (mirror :: <gtk-mirror>, handlers :: <sequence>, #key adjustment) => ()
-  let widget = mirror-widget(mirror);
-  gtk-widget-add-events(widget,
-      logior($GDK-EXPOSURE-MASK, $GDK-LEAVE-NOTIFY-MASK,
-             if (member?(#"motion_notify_event", handlers))
-              logior($GDK-POINTER-MOTION-MASK, $GDK-POINTER-MOTION-HINT-MASK)
-             else
-              0
-             end,
-             if (member?(#"button_press_event", handlers))
-              logior($GDK-BUTTON-PRESS-MASK, $GDK-BUTTON-RELEASE-MASK)
-             else
-              0
-            end));
-end function install-named-handlers;
 
+  
 
 /// Install event handlers
 

Modified: branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan	(original)
+++ branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan	Wed May 23 02:54:56 2007
@@ -396,8 +396,7 @@
 define method install-event-handlers
     (sheet :: <gtk-button-mixin>, mirror :: <gadget-mirror>) => ()
   next-method();
-  let widget = mirror-widget(mirror);
-  g-signal-connect(widget, "clicked", method (#rest args) handle-button-gadget-click(sheet) end);
+  duim-g-signal-connect(sheet, #"clicked") (#rest args) handle-button-gadget-click(sheet) end;
 end method install-event-handlers;
 
 define sealed method handle-gtk-clicked-event
@@ -527,9 +526,9 @@
 define method update-mirror-attributes
     (gadget :: <gtk-radio-button>, mirror :: <gadget-mirror>) => ()
   next-method();
-  let widget = mirror.mirror-widget;
   let selected? = gadget-value(gadget);
-  with-disabled-event-handler (widget, #"clicked")
+  let widget = mirror-widget(mirror);
+  with-disabled-event-handler (mirror, #"clicked")
     gtk-toggle-button-set-active
       (widget, if (selected?) $true else $false end)
   end
@@ -597,9 +596,9 @@
 define method update-mirror-attributes
     (gadget :: <gtk-check-button>, mirror :: <gadget-mirror>) => ()
   next-method();
-  let widget = mirror.mirror-widget;
   let selected? = gadget-value(gadget);
-  with-disabled-event-handler (widget, #"clicked")
+  let widget = mirror-widget(mirror);
+  with-disabled-event-handler (mirror, #"clicked")
     gtk-toggle-button-set-active
       (widget, if (selected?) $true else $false end)
   end
@@ -633,9 +632,8 @@
 define method install-event-handlers
     (sheet :: <gtk-text-gadget-mixin>, mirror :: <gadget-mirror>) => ()
   next-method();
-  let widget = mirror-widget(mirror);
-  g-signal-connect(widget, "activate", method (#rest args) activate-gtk-gadget(sheet) end);
-  g-signal-connect(widget, "changed", method(#rest args) handle-text-gadget-changing(sheet) end);
+  duim-g-signal-connect(sheet, #"activate") (#rest args) activate-gtk-gadget(sheet) end;
+  duim-g-signal-connect(sheet, #"changed") (#rest args) handle-text-gadget-changing(sheet) end;
 end method install-event-handlers;
 
 define sealed method update-mirror-attributes
@@ -811,7 +809,7 @@
   ignore(mirror);
   let widget = gadget-widget(gadget);
   let new-text = gadget-text-buffer(gadget);
-  with-disabled-event-handler (widget, #"changed")
+  with-disabled-event-handler (mirror, #"changed")
     with-c-string (c-text = new-text)
       gtk-entry-set-text(widget, c-text);
     end;
@@ -912,7 +910,7 @@
     when (update?)
       block ()
 	gtk-text-freeze(widget);
-	with-disabled-event-handler (widget, #"changed")
+	with-disabled-event-handler (mirror, #"changed")
 	  set-text-widget-text(widget, new-text);
 	end;
       cleanup
@@ -1038,7 +1036,7 @@
     (sheet :: <gtk-scroll-bar>, mirror :: <gadget-mirror>) => ()
   next-method();
   let widget = mirror-widget(mirror);
-  g-signal-connect(widget, "value-changed", method (#rest args) gtk-adjustment-value-changed-signal-handler(sheet, widget) end);
+  duim-g-signal-connect(sheet, #"value-changed") (adjustment, #rest args) gtk-adjustment-value-changed-signal-handler(sheet, widget) end;
 end method install-event-handlers;
 
 define method gtk-adjustment-value-changed-signal-handler
@@ -1127,8 +1125,8 @@
     (sheet :: <gtk-list-control-mixin>, mirror :: <gadget-mirror>) => ()
   next-method();
   let widget = mirror-widget(mirror);
-  g-signal-connect(widget, "select-row", method (widget, row, column, event, #rest args) handle-gtk-select-row-event(sheet, row, event) end);
-  g-signal-connect(widget, "button-press-event", method (widget, event, #rest args) handle-gtk-button-press-event(sheet, event) end);
+  duim-g-signal-connect(sheet, #"select-row") (widget, row, column, event, #rest args) handle-gtk-select-row-event(sheet, row, event) end;
+  duim-g-signal-connect(sheet, #"button-press-event") (widget, event, #rest args) handle-gtk-button-press-event(sheet, event) end;
   gtk-widget-add-events(widget, $GDK-BUTTON-PRESS-MASK);
 end method install-event-handlers;
 

Modified: branches/opendylan-melange/gtk-duim/gtk-menus.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-menus.dylan	(original)
+++ branches/opendylan-melange/gtk-duim/gtk-menus.dylan	Wed May 23 02:54:56 2007
@@ -363,8 +363,7 @@
 define method install-event-handlers
     (sheet :: <gtk-menu-button-mixin>, mirror :: <gadget-mirror>) => ()
   next-method();
-  let widget = mirror-widget(mirror);
-  g-signal-connect(widget, "activate", method (#rest args) activate-gtk-gadget(sheet) end);
+  duim-g-signal-connect(sheet, #"activate") (#rest args) activate-gtk-gadget(sheet) end;
 end method install-event-handlers;
 
 // #"activate" signal

Modified: branches/opendylan-melange/gtk-duim/gtk-mirror.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-mirror.dylan	(original)
+++ branches/opendylan-melange/gtk-duim/gtk-mirror.dylan	Wed May 23 02:54:56 2007
@@ -27,6 +27,7 @@
 define open abstract class <gtk-mirror> (<mirror>)
   sealed slot mirror-sheet :: <sheet>,
     required-init-keyword: sheet:;
+  sealed slot signal-handler-ids :: <table> = make(<table>);
 end class <gtk-mirror>;
 
 define method initialize
@@ -311,11 +312,36 @@
        sheet:  sheet);
 end method do-make-gtk-mirror;
 
+define macro duim-g-signal-connect
+ { duim-g-signal-connect (?sheet:name, ?signal-name:expression) (?args:*) ?body:* end }
+  => { begin
+         let mirror = ?sheet.sheet-direct-mirror;
+         let widget = mirror-widget(mirror);
+         let handler-id = g-signal-connect(widget, as(<string>, ?signal-name),
+                                           method(?args) ?body end);
+         mirror.signal-handler-ids[?signal-name] := handler-id;
+       end; }
+end;
+                                             
+define macro with-disabled-event-handler
+  { with-disabled-event-handler (?mirror:expression, ?signal-name:expression)
+      ?body:*
+    end }
+ => { let signal-handler-id = element(?mirror.signal-handler-ids, ?signal-name);
+      let widget = mirror-widget(?mirror);
+      block()
+        g-signal-handler-block(widget, signal-handler-id);
+        ?body
+      cleanup
+        g-signal-handler-unblock(widget, signal-handler-id);
+      end; }
+end;
+
 define method install-event-handlers
     (sheet :: <mirrored-sheet-mixin>, mirror :: <fixed-container-mirror>) => ()
   next-method();
   let widget = mirror-widget(mirror);
-  g-signal-connect(widget, "expose-event", method (widget, event, #rest args) handle-gtk-expose-event(sheet, event) end);
+  duim-g-signal-connect(sheet, #"expose-event") (widget, event) handle-gtk-expose-event(sheet, event) end;
   gtk-widget-add-events(widget, $GDK-EXPOSURE-MASK);
 end method install-event-handlers;
 
@@ -323,13 +349,13 @@
     (sheet :: <mirrored-sheet-mixin>, mirror :: <drawing-area-mirror>) => ()
   next-method();
   let widget = mirror-widget(mirror);
-  g-signal-connect(widget, "expose-event", method (widget, event, #rest args) handle-gtk-expose-event(sheet, event) end);
+  duim-g-signal-connect(sheet, #"expose-event") (widget, event) handle-gtk-expose-event(sheet, event) end;
   gtk-widget-add-events(widget, $GDK-EXPOSURE-MASK);
-  g-signal-connect(widget, "button-press-event", method (widget, event) handle-gtk-button-event(sheet, event) end);
+  duim-g-signal-connect(sheet, #"button-press-event") (widget, event) handle-gtk-button-event(sheet, event) end;
   gtk-widget-add-events(widget, $GDK-BUTTON-PRESS-MASK);
-  g-signal-connect(widget, "button-release-event", method (widget, event) handle-gtk-button-event(sheet, event) end);
+  duim-g-signal-connect(sheet, #"button-release-event") (widget, event) handle-gtk-button-event(sheet, event) end;
   gtk-widget-add-events(widget, $GDK-BUTTON-RELEASE-MASK);
-  g-signal-connect(widget, "motion-notify-event", method (widget, event, #rest args) handle-gtk-motion-event(sheet, event) end);
+  duim-g-signal-connect(sheet, #"motion-notify-event") (widget, event) handle-gtk-motion-event(sheet, event) end;
   gtk-widget-add-events(widget, logior($GDK-POINTER-MOTION-MASK, $GDK-POINTER-MOTION-HINT-MASK));
 end method install-event-handlers;
 

Modified: branches/opendylan-melange/gtk-duim/gtk-top.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-top.dylan	(original)
+++ branches/opendylan-melange/gtk-duim/gtk-top.dylan	Wed May 23 02:54:56 2007
@@ -378,9 +378,8 @@
 define method install-event-handlers
     (sheet :: <gtk-top-level-sheet-mixin>, mirror :: <top-level-mirror>) => ()
   next-method();
-  let widget = mirror-widget(mirror);
-  g-signal-connect(widget, "delete-event", method (#rest args) handle-gtk-delete-event(sheet) end);
-  g-signal-connect(widget, "configure-event", method (widget, event, #rest args) handle-gtk-configure-event(sheet, widget, event) end);
+  duim-g-signal-connect(sheet, #"delete-event") (#rest args) handle-gtk-delete-event(sheet) end;
+  duim-g-signal-connect(sheet, #"configure-event") (widget, event, #rest args) handle-gtk-configure-event(sheet, widget, event) end;
 end method install-event-handlers;
 
 

Modified: branches/opendylan-melange/gtk/gtk.dylan
==============================================================================
--- branches/opendylan-melange/gtk/gtk.dylan	(original)
+++ branches/opendylan-melange/gtk/gtk.dylan	Wed May 23 02:54:56 2007
@@ -37,17 +37,21 @@
 define method make(type :: subclass(<GTypeInstance>), #rest args, 
                    #key address, #all-keys)
  => (result :: <GTypeInstance>)
-  if(address & (as(<integer>, address) ~= 0))
-    let instance = next-method(<GTypeInstance>, address: address);
-    let g-type = g-type-from-instance(instance);
-    let dylan-type = find-gtype(g-type);
-    unless (dylan-type)
-      error("Unknown GType encountered. Re-run melange or implement dynamic class generation.");
-    end;
-    let result = next-method(dylan-type, address: address);
-    g-object-ref-sink(result);
-    finalize-when-unreachable(result);
-    result;
+  if(address)
+    if (as(<integer>, address) ~= 0)
+      let instance = next-method(<GTypeInstance>, address: address);
+      let g-type = g-type-from-instance(instance);
+      let dylan-type = find-gtype(g-type);
+      unless (dylan-type)
+        error("Unknown GType encountered. Re-run melange or implement dynamic class generation.");
+      end;
+      let result = next-method(dylan-type, address: address);
+      g-object-ref-sink(result);
+      finalize-when-unreachable(result);
+      result;
+    else
+      next-method();
+    end
   else
     // possible route: convert #rest args into GParamSpec, call g_object_newv()
     error("Can't create GTypeInstance on my own from %=", type.debug-name);



More information about the chatter mailing list