[Gd-chatter] r11421 - branches/opendylan-melange/gtk-duim

[andreas at gwydiondylan.org]

Author: andreas
Date: Tue Jul  3 23:34:47 2007
New Revision: 11421

Modified:
   branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan
   branches/opendylan-melange/gtk-duim/gtk-menus.dylan
Log:
job: fd

 * Popup menus, not quite working yet


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	Tue Jul  3 23:34:47 2007
@@ -1157,16 +1157,16 @@
   let widget = mirror-widget(mirror);
   let selection = with-gdk-lock gtk-tree-view-get-selection(widget) end;
   g-signal-connect(selection, "changed", method (#rest args) handle-gtk-select-row-event(sheet) end);
-  //duim-g-signal-connect(sheet, #"button-press-event") (widget, event, #rest args) handle-gtk-button-press-event(sheet, event) end;
-  //with-gdk-lock
-  //  gtk-widget-add-events(widget, $GDK-BUTTON-PRESS-MASK);
-  //end
+  duim-g-signal-connect(sheet, #"button-press-event") (widget, event, #rest args) handle-gtk-button-press-event(sheet, event) end;
+  with-gdk-lock
+    gtk-widget-add-events(widget, $GDK-BUTTON-PRESS-MASK);
+  end
 end method install-event-handlers;
 
 define sealed method handle-gtk-select-row-event
     (gadget :: <gtk-tree-view-control-mixin>)
  => (handled? :: <boolean>)
-  gtk-debug("Clicked on list control!");
+  gtk-debug("Selected list control item!");
   let mirror = gadget.sheet-direct-mirror;
   let widget = mirror-widget(mirror);
   let selection = gtk-tree-view-get-selection(widget);
@@ -1215,6 +1215,12 @@
       distribute-activate-callback(gadget);
     end;
     #t
+  elseif ((event.GdkEventButton-type == $GDK-BUTTON-PRESS) & (event.GdkEventButton-button == 3)) //right click
+    gtk-debug("right clicked on list control!");
+    when (gadget-popup-menu-callback(gadget))
+      distribute-popup-menu-callback(gadget, 0, x: round(event.GdkEventButton-x), y: round(event.GdkEventButton-y));
+    end;
+    #t
   end
 end method handle-gtk-button-press-event;
 

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	Tue Jul  3 23:34:47 2007
@@ -30,6 +30,18 @@
                           mirror-widget(child))
   end
 end method set-mirror-parent;
+
+define method set-mirror-parent
+    (child :: <menu-button-mirror>, parent :: <popup-menu-mirror>)
+ => ()
+  duim-debug-message("Adding %= to popup menu %=",
+		gadget-label(mirror-sheet(child)),
+		gadget-label(mirror-sheet(parent)));
+  with-gdk-lock
+    gtk-menu-shell-append(mirror-widget(parent),
+                          mirror-widget(child))
+  end
+end method set-mirror-parent;
     
 define method set-mirror-parent
     (child :: <menu-mirror>, parent :: <menu-mirror>)
@@ -405,13 +417,28 @@
   sealed slot menu-record-selection? = #f;
 end class <gtk-menu>;
 
+define sealed class <gtk-popup-menu> (<gtk-menu>)
+end;
 define sealed method class-for-make-pane 
-    (framem :: <gtk-frame-manager>, class == <menu>, #key)
+    (framem :: <gtk-frame-manager>, class == <menu>, #key owner)
  => (class :: <class>, options :: false-or(<sequence>))
-  values(<gtk-menu>, #f)
+  if (owner)
+    values(<gtk-popup-menu>, #f);
+  else
+    values(<gtk-menu>, #f)
+  end;
 end method class-for-make-pane;
 
 define sealed method make-gtk-mirror
+  (gadget :: <gtk-popup-menu>) => (mirror :: <menu-mirror>)
+  let widget = with-gdk-lock gtk-menu-new() end;
+  let selection-owner = menu-record-selection?(gadget) & gadget;
+  make(<popup-menu-mirror>, 
+       widget: widget,
+       sheet:  gadget, 
+       selection-owner: selection-owner)
+end;   
+define sealed method make-gtk-mirror
     (gadget :: <gtk-menu>)
  => (mirror :: <menu-mirror>)
   let (text, image, mnemonic, index)
@@ -420,35 +447,27 @@
     ignoring("menu with image")
   end;
   let widget = with-gdk-lock gtk-menu-item-new-with-label(text) end;
-  let owner = menu-owner(gadget);
-  let owner = if (frame?(owner)) top-level-sheet(owner) else owner end;
-  make-menu-mirror-for-owner(owner, gadget, widget)
-end method make-gtk-mirror;
-
-define sealed method make-menu-mirror-for-owner
-    (owner :: <sheet>, gadget :: <gtk-menu>, widget :: <GtkMenuItem>)
- => (mirror :: <popup-menu-mirror>)
-  let selection-owner = menu-record-selection?(gadget) & gadget;
-  make(<popup-menu-mirror>, 
-       widget: widget,
-       sheet:  gadget, 
-       selection-owner: selection-owner)
-end method make-menu-mirror-for-owner;
-
-define sealed method make-menu-mirror-for-owner
-    (owner == #f, gadget :: <gtk-menu>, widget :: <GtkMenuItem>)
- => (mirror :: <menu-mirror>)
   make(<menu-mirror>,
        widget: widget,
        sheet:  gadget)
-end method make-menu-mirror-for-owner;
+end method make-gtk-mirror;
 
 define sealed method map-mirror
-    (_port :: <gtk-port>, menu :: <gtk-menu>, 
+    (_port :: <gtk-port>, menu :: <gtk-popup-menu>, 
      mirror :: <popup-menu-mirror>) => ()
-  ignoring("map-mirror on a popup menu")
+  next-method();
+  with-gdk-lock
+    gtk-menu-popup(mirror.mirror-widget, null-pointer(<GtkWidget>), null-pointer(<GtkWidget>), null-pointer(<GtkMenuPositionFunc>),
+                   null-pointer(<GPointer>), 3, 0);
+  end
 end method map-mirror;
 
+define sealed method set-mirror-parent (menu :: <popup-menu-mirror>, widget :: <gtk-mirror>) => ()
+  with-gdk-lock
+    gtk-menu-attach-to-widget(menu.mirror-widget, menu.mirror-sheet.menu-owner.top-level-sheet.sheet-direct-mirror.mirror-widget, null-pointer(<GtkMenuDetachFunc>));
+  end
+end;
+
 /*---*** Should be called just before a menu pops up
 define method handle-menu-update
     (menu :: <gtk-menu>) => ()