[Gd-chatter] r11397 - branches/opendylan-melange/gtk-duim
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Sat Jun 9 03:36:52 CEST 2007
Author: andreas
Date: Sat Jun 9 03:36:49 2007
New Revision: 11397
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-port.dylan
branches/opendylan-melange/gtk-duim/gtk-top.dylan
Log:
job: fd
* more with-gdk-lock
* less with-c-string
* native GTK separator widgets
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 Sat Jun 9 03:36:49 2007
@@ -28,7 +28,6 @@
=> (timed-out? :: <boolean>)
//--- We should do something with the timeout
ignore(timeout);
- sleep(1);
with-gdk-lock
gtk-main();
end;
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 Sat Jun 9 03:36:49 2007
@@ -341,17 +341,14 @@
define sealed method update-mirror-label
(gadget :: <gtk-label>, mirror :: <gadget-mirror>) => ()
- with-c-string (c-string = defaulted-gadget-label(gadget))
- let widget = mirror-widget(mirror);
- with-gdk-lock
- gtk-label-set-text(widget, c-string)
- end
+ let widget = mirror-widget(mirror);
+ with-gdk-lock
+ gtk-label-set-text(widget, defaulted-gadget-label(gadget))
end
end method update-mirror-label;
/// Separators
-/*---*** Use the default separators
define sealed class <gtk-separator>
(<gtk-gadget-mixin>,
<separator>,
@@ -368,34 +365,16 @@
define sealed method make-gtk-mirror
(gadget :: <gtk-separator>)
=> (mirror :: <gadget-mirror>)
- let parent = sheet-device-parent(gadget);
- let parent-widget = gadget-widget(parent);
- let (foreground, background, font) = widget-attributes(_port, gadget);
- ignore(font);
- let resources
- = vector(mapped-when-managed:, #f);
- let widget
- = xt/XtCreateManagedWidget("DUIMSeparator", xm/<XmSeparatorGadget>, parent-widget,
- resources:
- concatenate(resources, foreground, background));
- values(widget, #f)
-end method make-gtk-mirror;
-
-define sealed method do-compose-space
- (pane :: <gtk-separator>, #key width, height)
- => (space-requirement :: <space-requirement>)
- select (gadget-orientation(pane))
- #"horizontal" =>
- make(<space-requirement>,
- min-width: 1, width: width | 1, max-width: $fill,
- height: 2);
- #"vertical" =>
- make(<space-requirement>,
- width: 2,
- min-height: 1, height: height | 1, max-height: $fill);
+ with-gdk-lock
+ let widget = select(gadget-orientation(gadget))
+ #"horizontal" => gtk-hseparator-new();
+ #"vertical" => gtk-vseparator-new();
+ end;
+ make(<gadget-mirror>,
+ widget: widget,
+ sheet: gadget)
end
-end method do-compose-space;
-*/
+end method make-gtk-mirror;
/// Buttons
@@ -1404,23 +1383,20 @@
(gadget :: <gtk-table-control>)
=> (mirror :: <gadget-mirror>)
let columns = table-control-columns(gadget);
- let res
- = with-gdk-lock
- let widget = gtk-tree-view-new();
- let columns = table-control-columns(gadget);
- for (c in columns, i from 1)
- let renderer = gtk-cell-renderer-text-new();
- let column = gtk-tree-view-column-new();
- gtk-tree-view-column-pack-start(column, renderer, 0);
- gtk-tree-view-column-add-attribute(column, renderer, "text", i);
- gtk-tree-view-append-column(widget, column);
- end;
- make(<gadget-mirror>,
- widget: widget,
- sheet: gadget);
+ with-gdk-lock
+ let widget = gtk-tree-view-new();
+ let columns = table-control-columns(gadget);
+ for (c in columns, i from 1)
+ let renderer = gtk-cell-renderer-text-new();
+ let column = gtk-tree-view-column-new();
+ gtk-tree-view-column-pack-start(column, renderer, 0);
+ gtk-tree-view-column-add-attribute(column, renderer, "text", i);
+ gtk-tree-view-append-column(widget, column);
end;
- update-mirror-attributes(gadget, res);
- res;
+ make(<gadget-mirror>,
+ widget: widget,
+ sheet: gadget);
+ end;
end method make-gtk-mirror;
define method update-mirror-attributes
@@ -1814,13 +1790,13 @@
values(<gtk-viewport>, #f)
end method class-for-make-pane;
-// ---*** make viewports drawing areas for now so that we can see some content
define method make-gtk-mirror
(sheet :: <gtk-viewport>)
=> (mirror :: <widget-mirror>)
with-gdk-lock
- let widget = gtk-drawing-area-new();
- gtk-widget-set-size-request(widget, 200, 200);
+ let widget = gtk-viewport-new(gtk-adjustment-new(0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0),
+ gtk-adjustment-new(0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0));
+// gtk-widget-set-size-request(widget, 200, 200);
make(<drawing-area-mirror>,
widget: widget,
sheet: sheet);
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 Sat Jun 9 03:36:49 2007
@@ -25,19 +25,23 @@
duim-debug-message("Adding %= to menu %=",
gadget-label(mirror-sheet(child)),
gadget-label(mirror-sheet(parent)));
- gtk-menu-shell-append(mirror-widget(parent).Gtk-Menu-Item-get-submenu,
- mirror-widget(child))
+ with-gdk-lock
+ gtk-menu-shell-append(mirror-widget(parent).Gtk-Menu-Item-get-submenu,
+ mirror-widget(child))
+ end
end method set-mirror-parent;
define method set-mirror-parent
(child :: <menu-mirror>, parent :: <menu-mirror>)
=> ()
- let widget = mirror-widget(child);
- let menu = gtk-menu-new();
- duim-debug-message("Creating submenu for %s",
- gadget-label(mirror-sheet(child)));
- gtk-menu-item-set-submenu(widget, menu);
- gtk-menu-shell-append(mirror-widget(parent).Gtk-Menu-Item-get-submenu, widget)
+ with-gdk-lock
+ let widget = mirror-widget(child);
+ let menu = gtk-menu-new();
+ duim-debug-message("Creating submenu for %s",
+ gadget-label(mirror-sheet(child)));
+ gtk-menu-item-set-submenu(widget, menu);
+ gtk-menu-shell-append(mirror-widget(parent).Gtk-Menu-Item-get-submenu, widget)
+ end
end method set-mirror-parent;
define method set-mirror-parent
@@ -45,15 +49,17 @@
=> ()
if (instance?(parent.mirror-sheet, <menu-bar>))
let widget = mirror-widget(child);
- if (child.mirror-sheet.gadget-label = "Help")
-// gtk-menu-item-right-justify(widget)
- gtk-menu-item-set-right-justified ((widget), /* TRUE */ 1)
- end;
- let menu = gtk-menu-new();
- duim-debug-message("Creating submenu for menu bar");
- gtk-menu-item-set-submenu(widget, menu);
- gtk-menu-shell-append(mirror-widget(parent),
- widget)
+ with-gdk-lock
+ if (child.mirror-sheet.gadget-label = "Help")
+ // gtk-menu-item-right-justify(widget)
+ gtk-menu-item-set-right-justified ((widget), /* TRUE */ 1)
+ end;
+ let menu = gtk-menu-new();
+ duim-debug-message("Creating submenu for menu bar");
+ gtk-menu-item-set-submenu(widget, menu);
+ gtk-menu-shell-append(mirror-widget(parent),
+ widget)
+ end
else
next-method()
end
@@ -157,7 +163,7 @@
define sealed method compute-mnemonic-from-label
(gadget :: <gtk-gadget-mixin>, label :: <string>,
- #key remove-ampersand? = #f)
+ #key remove-ampersand? = #t)
=> (label, mnemonic :: false-or(<mnemonic>), index :: false-or(<integer>))
let (label, mnemonic, index) = next-method();
if (mnemonic)
@@ -169,7 +175,7 @@
end method compute-mnemonic-from-label;
define sealed method compute-standard-gtk-mnemonic
- (gadget :: <gadget>, label :: <string>, #key remove-ampersand? = #f)
+ (gadget :: <gadget>, label :: <string>, #key remove-ampersand? = #t)
=> (label, mnemonic :: false-or(<mnemonic>), index :: false-or(<integer>))
let length :: <integer> = size(label);
let dots :: <byte-string> = "...";
@@ -305,7 +311,7 @@
define sealed method make-gtk-mirror
(gadget :: <gtk-menu-bar>)
=> (mirror :: <gadget-mirror>)
- let widget = gtk-menu-bar-new();
+ let widget = with-gdk-lock gtk-menu-bar-new() end;
make(<gadget-mirror>,
widget: widget,
sheet: gadget)
@@ -352,12 +358,10 @@
unless (mnemonic)
mnemonic := allocate-unique-mnemonic(gadget, text)
end;
- with-c-string (c-string = text)
- let widget = gtk-menu-item-new-with-label(c-string);
- make(<menu-button-mirror>,
- widget: widget,
- sheet: gadget)
- end
+ let widget = with-gdk-lock gtk-menu-item-new-with-label(text) end;
+ make(<menu-button-mirror>,
+ widget: widget,
+ sheet: gadget)
end method make-gtk-mirror;
define method install-event-handlers
@@ -366,13 +370,6 @@
duim-g-signal-connect(sheet, #"activate") (#rest args) activate-gtk-gadget(sheet) end;
end method install-event-handlers;
-// #"activate" signal
-define method gtk-activate-signal-handler (gadget :: <gtk-menu-button-mixin>,
- user-data :: <gpointer>)
- ignore(user-data);
- activate-gtk-gadget(gadget);
-end;
-
define method update-mirror-attributes
(gadget :: <gtk-menu-button-mixin>, mirror :: <menu-button-mirror>) => ()
next-method();
@@ -409,12 +406,10 @@
if (image)
ignoring("menu with image")
end;
- with-c-string (c-string = text)
- let widget = gtk-menu-item-new-with-label(c-string);
- 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
+ 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
Modified: branches/opendylan-melange/gtk-duim/gtk-port.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-port.dylan (original)
+++ branches/opendylan-melange/gtk-duim/gtk-port.dylan Sat Jun 9 03:36:49 2007
@@ -27,24 +27,6 @@
(_port :: <gtk-port>, #key server-path) => ()
initialize-gtk();
next-method();
-/*---*** What to do here?
- let type = head(server-path);
- let display = get-property(tail(server-path), #"display",
- default: environment-variable("DISPLAY"));
- ignore(type);
- let (shell, context, unused-args)
- = construct-application("DUIM port", // class name -- defines resources
- display-name: display,
- app-context-name: format-to-string("DUIM port on %s", display),
- fallback-resources: $primitive-resources);
- ignore(unused-args);
- _port.%display := xt/XtDisplay(shell);
- _port.%app-shell := shell;
- _port.%app-context := context;
- _port.%modifier-map := initialize-modifier-map(_port.%display);
- install-default-palette(_port);
- install-default-text-style-mappings(_port);
-*/
end method initialize;
register-port-class(#"gtk", <gtk-port>, default?: #t);
@@ -170,14 +152,14 @@
//---*** Get real current time...
let current-time = 0;
result
- := gdk-pointer-grab(widget,
- 0, // owner events
- logior($GDK-POINTER-MOTION-MASK,
- $GDK-BUTTON-PRESS-MASK,
- $GDK-BUTTON-RELEASE-MASK),
- null-pointer(<GdkWindow>), // confine to
- null-pointer(<GdkCursor>), // cursor
- current-time);
+ := with-gdk-lock gdk-pointer-grab(widget,
+ 0, // owner events
+ logior($GDK-POINTER-MOTION-MASK,
+ $GDK-BUTTON-PRESS-MASK,
+ $GDK-BUTTON-RELEASE-MASK),
+ null-pointer(<GdkWindow>), // confine to
+ null-pointer(<GdkCursor>), // cursor
+ current-time) end;
end;
result ~= 0
end method grab-pointer;
@@ -192,7 +174,7 @@
if (widget)
//---*** How do we get the current time?
let current-time = 0;
- gdk-pointer-ungrab(current-time);
+ with-gdk-lock gdk-pointer-ungrab(current-time) end;
#t
end
end method ungrab-pointer;
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 Sat Jun 9 03:36:49 2007
@@ -44,8 +44,10 @@
(child :: <widget-mirror>, parent :: <top-level-mirror>)
=> ()
let (x, y) = sheet-native-edges(mirror-sheet(child));
- gtk-container-add(mirror-widget(parent),
- mirror-widget(child))
+ with-gdk-lock
+ gtk-container-add(mirror-widget(parent),
+ mirror-widget(child))
+ end
end method set-mirror-parent;
define method move-mirror
@@ -368,11 +370,11 @@
let widget = mirror-widget(mirror);
let modal? = frame-mode(frame) == #"modal";
let title = frame-title(frame) | $default-window-title;
- with-c-string (c-string = title)
- gtk-window-set-title(widget, c-string)
- end;
- gtk-window-set-modal(widget, if (modal?) $true else $false end);
- gtk-container-set-border-width(widget, $top-level-border);
+ with-gdk-lock
+ gtk-window-set-title(widget, title);
+ gtk-window-set-modal(widget, if (modal?) $true else $false end);
+ gtk-container-set-border-width(widget, $top-level-border);
+ end
end method update-mirror-attributes;
define method install-event-handlers
@@ -398,7 +400,9 @@
sheet :: <gtk-top-level-sheet-mixin>, mirror :: <top-level-mirror>)
=> ()
let widget = mirror-widget(mirror);
- gtk-widget-hide(widget)
+ with-gdk-lock
+ gtk-widget-hide(widget)
+ end
end method unmap-mirror;
define sealed method raise-mirror
@@ -406,7 +410,10 @@
mirror :: <top-level-mirror>,
#key activate? :: <boolean> = #f)
=> ()
- ignoring("raise-mirror")
+ let widget = mirror-widget(mirror);
+ with-gdk-lock
+ gtk-window-present(widget);
+ end
end method raise-mirror;
define sealed method lower-mirror
@@ -435,7 +442,9 @@
=> ()
duim-debug-message("destroy-mirror of %=", mirror);
let widget = mirror-widget(mirror);
- gtk-widget-destroy(widget);
+ with-gdk-lock
+ gtk-widget-destroy(widget);
+ end;
next-method();
end method destroy-mirror;
@@ -546,12 +555,11 @@
let height = event.GdkEventConfigure-height;
let region = make-bounding-box(left, top, left + width, top + height);
let (old-width, old-height) = box-size(sheet-region(sheet));
- //---*** Switch back to duim-debug-message
duim-debug-message("Resizing %= to %dx%d -- was %dx%d",
- sheet, width, height, old-width, old-height);
+ sheet, width, height, old-width, old-height);
distribute-event(port(sheet),
- make(<window-configuration-event>,
- sheet: sheet,
- region: region));
+ make(<window-configuration-event>,
+ sheet: sheet,
+ region: region));
#t
end method handle-gtk-configure-event;
More information about the chatter
mailing list