[Gd-chatter] r11395 - in branches/opendylan-melange: gtk gtk-duim
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Fri Jun 8 03:26:41 CEST 2007
Author: andreas
Date: Fri Jun 8 03:26:38 2007
New Revision: 11395
Modified:
branches/opendylan-melange/gtk-duim/gtk-dialogs.dylan
branches/opendylan-melange/gtk-duim/gtk-events.dylan
branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan
branches/opendylan-melange/gtk/gtk.dylan
branches/opendylan-melange/gtk/module.dylan
branches/opendylan-melange/gtk/support.c
Log:
Job: fd
*lock only once
*do not lock in signal handlers
*use GtkTreeView instead of the deprecated GtkClist
*started to implement gtk-table-control
*"fixed" dialogs by using gtk-window-new instead of the dialog API
Modified: branches/opendylan-melange/gtk-duim/gtk-dialogs.dylan
==============================================================================
--- branches/opendylan-melange/gtk-duim/gtk-dialogs.dylan (original)
+++ branches/opendylan-melange/gtk-duim/gtk-dialogs.dylan Fri Jun 8 03:26:38 2007
@@ -29,7 +29,7 @@
define sealed method make-top-level-mirror
(sheet :: <top-level-sheet>, frame :: <dialog-frame>)
=> (mirror :: <top-level-mirror>)
- let widget = gtk-dialog-new();
+ let widget = gtk-window-new($GTK-WINDOW-TOPLEVEL);
let owner = frame-owner(frame);
make(<dialog-mirror>,
widget: widget,
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 Fri Jun 8 03:26:38 2007
@@ -28,8 +28,9 @@
=> (timed-out? :: <boolean>)
//--- We should do something with the timeout
ignore(timeout);
+ sleep(1);
with-gdk-lock
- gtk-main-iteration();
+ gtk-main();
end;
#f;
end method process-next-event;
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 Fri Jun 8 03:26:38 2007
@@ -175,7 +175,7 @@
ignore(client);
next-method();
let widget = gadget-widget(gadget);
- with-gdk-lock
+ widget & with-gdk-lock
gtk-widget-set-sensitive(widget, $true)
end
end method note-gadget-enabled;
@@ -1148,30 +1148,31 @@
next-method();
with-gdk-lock
let widget = mirror.mirror-widget;
- gtk-clist-set-selection-mode
- (widget,
+ let selection = gtk-tree-view-get-selection(widget);
+ gtk-tree-selection-set-mode
+ (selection,
select (gadget-selection-mode(gadget))
- #"none" => $GTK-SELECTION-BROWSE;
- #"single" => $GTK-SELECTION-SINGLE;
- #"multiple" => $GTK-SELECTION-EXTENDED;
+ #"none" => $GTK-SELECTION-NONE;
+ #"single" => $GTK-SELECTION-BROWSE;
+ #"multiple" => $GTK-SELECTION-MULTIPLE;
end);
- gtk-clist-set-shadow-type(widget, $GTK-SHADOW-IN);
if (instance?(gadget, <table-control>))
- gtk-clist-column-titles-show(widget)
+ widget. at headers-visible := #t;
else
- gtk-clist-column-titles-hide(widget);
+ widget. at headers-visible := #f;
//---*** How should we decide this?
- gtk-clist-set-column-width(widget, 0, 500)
+// gtk-clist-set-column-width(widget, 0, 500)
end;
- update-list-control-items(gadget, mirror)
- end
+ end;
+ update-list-control-items(gadget, mirror)
end method update-mirror-attributes;
define method install-event-handlers
(sheet :: <gtk-list-control-mixin>, mirror :: <gadget-mirror>) => ()
next-method();
let widget = mirror-widget(mirror);
- duim-g-signal-connect(sheet, #"select-row") (widget, row, column, event, #rest args) handle-gtk-select-row-event(sheet, row, event) end;
+ let selection = gtk-tree-view-get-selection(widget);
+ 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);
@@ -1179,12 +1180,34 @@
end method install-event-handlers;
define sealed method handle-gtk-select-row-event
- (gadget :: <gtk-list-control-mixin>, row :: <integer>, event :: <GdkEventButton>)
+ (gadget :: <gtk-list-control-mixin>)
=> (handled? :: <boolean>)
gtk-debug("Clicked on list control!");
- let selection = list(row); //list-selection(gadget, sheet-direct-mirror(gadget));
- gtk-debug(" Selection now %=", selection);
- distribute-selection-changed-callback(gadget, selection);
+ let mirror = gadget.sheet-direct-mirror;
+ let widget = mirror-widget(mirror);
+ let selection = gtk-tree-view-get-selection(widget);
+ let new-selection = make(<stretchy-vector>);
+
+ with-stack-structure (model :: <GtkTreeModel*>)
+ let selected-paths = glist-to-vector
+ (gtk-tree-selection-get-selected-rows
+ (selection, model),
+ <GtkTreePath>);
+
+ for (path in selected-paths)
+ with-stack-structure (iter :: <GtkTreeIter>)
+ gtk-tree-model-get-iter(model[0], iter, path);
+ with-stack-structure (value :: <GValue>)
+ g-value-nullify(value);
+ gtk-tree-model-get-value(model[0], iter, 0, value);
+ add!(new-selection, g-value-to-dylan(value));
+ end;
+ end;
+ end;
+ end;
+
+ gtk-debug(" Selection now %=", new-selection);
+ distribute-selection-changed-callback(gadget, new-selection);
#t
end method handle-gtk-select-row-event;
@@ -1208,15 +1231,6 @@
end
end method handle-gtk-button-press-event;
-define method list-selection
- (gadget :: <gtk-list-control-mixin>, mirror :: <gadget-mirror>)
- => (vector :: <vector>)
-/* TODO: GtkCList is deprecated in GTK2 */
- let widget = mirror.mirror-widget;
- let selection = widget.selection-value;
- glist-to-vector(selection, <integer>)
-end method list-selection;
-
define method glist-to-vector
(GList :: <GList>, type :: <type>)
=> (vector :: <stretchy-object-vector>)
@@ -1227,8 +1241,8 @@
null-pointer?(GList) =>
#f;
otherwise =>
- add!(vector, c-type-cast(type, glist.data-value));
- process-list(glist.next-value);
+ add!(vector, c-type-cast(type, glist.GList-data));
+ process-list(glist.GList-next);
end
end;
process-list(GList);
@@ -1256,16 +1270,25 @@
let items = gadget-items(gadget);
let label-function = gadget-label-key(gadget);
with-gdk-lock
- gtk-clist-clear(widget);
- with-stack-structure(string* :: <C-string*>)
- for (item in items)
+ let type-vector = make(<GType*>, element-count: 2);
+ type-vector[0] := $G-TYPE-INT;
+ type-vector[1] := $G-TYPE-STRING;
+ let model = gtk-list-store-newv(2, type-vector);
+ with-stack-structure(iter :: <GtkTreeIter>)
+ for (item in items, i from 0)
let label = label-function(item);
- with-c-string (string = label)
- string*[0] := string;
- gtk-clist-append(widget, pointer-cast(<gchar**>, string*))
+ gtk-list-store-append(model, iter);
+ with-stack-structure (gvalue :: <GValue>)
+ g-value-nullify(gvalue);
+ g-value-set-value(gvalue, i);
+ gtk-list-store-set-value(model, iter, 0, gvalue);
+ g-value-nullify(gvalue);
+ g-value-set-value(gvalue, label);
+ gtk-list-store-set-value(model, iter, 1, gvalue);
end;
end
end;
+ widget. at model := model;
end
end method update-list-control-items;
@@ -1319,8 +1342,12 @@
(gadget :: <gtk-list-box>)
=> (mirror :: <gadget-mirror>)
with-gdk-lock
- let widget = gtk-clist-new(1);
- assert(~null-pointer?(widget), "gtk-clist-new failed");
+ let widget = gtk-tree-view-new();
+ 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", 1);
+ gtk-tree-view-append-column(widget, column);
make(<gadget-mirror>,
widget: widget,
sheet: gadget)
@@ -1347,8 +1374,12 @@
(gadget :: <gtk-list-control>)
=> (mirror :: <gadget-mirror>)
with-gdk-lock
- let widget = gtk-clist-new(1);
- assert(~null-pointer?(widget), "gtk-clist-new failed");
+ let widget = gtk-tree-view-new();
+ 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", 1);
+ gtk-tree-view-append-column(widget, column);
make(<gadget-mirror>,
widget: widget,
sheet: gadget)
@@ -1357,7 +1388,6 @@
// Table controls
-/*---*** Use the fake ones for now...
define sealed class <gtk-table-control>
(<gtk-list-control-mixin>,
<table-control>,
@@ -1374,39 +1404,73 @@
(gadget :: <gtk-table-control>)
=> (mirror :: <gadget-mirror>)
let columns = table-control-columns(gadget);
- with-gdk-lock
- let widget = GTK-CLIST(gtk-clist-new(columns.size));
- assert(~null-pointer?(widget), "gtk-clist-new failed");
- make(<gadget-mirror>,
- widget: widget,
- sheet: gadget)
- end;
+ 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);
+ end;
+ update-mirror-attributes(gadget, res);
+ res;
end method make-gtk-mirror;
define method update-mirror-attributes
(gadget :: <gtk-table-control>, mirror :: <gadget-mirror>) => ()
next-method();
- let widget = GTK-CLIST(mirror.mirror-widget);
- gtk-clist-column-titles-active(widget);
- for (i :: <integer> from 0,
- column :: <table-column> in table-control-columns(gadget))
- let heading = table-column-heading(column);
- let width = table-column-width(column);
- let alignment = table-column-alignment(column);
- with-c-string (c-string = heading)
- gtk-clist-set-column-title(widget, i, c-string)
+ let widget = mirror.mirror-widget;
+ let columns = table-control-columns(gadget);
+ with-gdk-lock
+ for (c in columns, i from 0)
+ let column = gtk-tree-view-get-column(widget, i);
+ column. at title := c.table-column-heading;
+ column. at alignment
+ := select (c.table-column-alignment)
+ #"left" => $GTK-JUSTIFY-LEFT;
+ #"right" => $GTK-JUSTIFY-RIGHT;
+ #"center" => $GTK-JUSTIFY-CENTER;
+ end;
+ column. at fixed-width := c.table-column-width;
+ gtk-tree-view-append-column(widget, column);
end;
- gtk-clist-set-column-width(widget, i, width);
- gtk-clist-set-column-justification
- (widget, i,
- select (alignment)
- #"left" => $GTK-JUSTIFY-LEFT;
- #"right" => $GTK-JUSTIFY-RIGHT;
- #"center" => $GTK-JUSTIFY-CENTER;
- end)
- end
+ end;
+ //gtk-clist-column-titles-active(widget);
end method update-mirror-attributes;
+define sealed class <gtk-table-item> (<table-item>)
+ sealed slot %table :: false-or(<table-control>) = #f;
+end;
+
+define sealed domain make (singleton(<gtk-table-item>));
+define sealed domain initialize(<gtk-table-item>);
+
+define sealed method do-make-item
+ (pane :: <gtk-table-control>, class == <table-item>, #key object)
+ => (item :: <gtk-table-item>)
+ make(<gtk-table-item>, object: object);
+end;
+
+define sealed method do-add-item
+ (pane :: <gtk-table-control>, item :: <gtk-table-item>, #key after) => ()
+// let items = pane.gadget-items;
+// let index = (after & position(items, after)) | size(items);
+// insert-at!(items, item, index);
+// item.%table := pane;
+ let mirror = sheet-direct-mirror(pane);
+ when (mirror)
+ update-list-control-items(pane, mirror);
+ end;
+end;
+
+/*
define method install-event-handlers
(sheet :: <gtk-table-control>, mirror :: <gadget-mirror>) => ()
next-method();
@@ -1428,34 +1492,49 @@
gtk-debug("Resized column!");
#t
end method handle-gtk-resize-column-event;
-
+*/
define sealed method update-list-control-items
(gadget :: <gtk-table-control>, mirror :: <gadget-mirror>)
=> ()
- let widget = GTK-CLIST(mirror.mirror-widget);
+ let widget = mirror.mirror-widget;
let items = gadget-items(gadget);
- let label-function = gadget-label-key(gadget);
let columns = table-control-columns(gadget);
let no-of-columns = columns.size;
- gtk-clist-clear(widget);
- for (item in items)
- let label = label-function(item);
- let object = item-object(item);
- let string* = make(<C-string*>, element-count: no-of-columns);
- for (index :: <integer> from 0 below no-of-columns,
- column :: <table-column> in columns)
- let generator = table-column-generator(column);
- let label = label-function(generator(object));
- string*[index] := as(<C-string>, label)
+ with-gdk-lock
+ let type-vector = make(<GType*>, element-count: 1 + no-of-columns);
+ type-vector[0] := $G-TYPE-INT;
+ for (i from 1 to no-of-columns)
+ type-vector[i] := $G-TYPE-STRING;
end;
- block ()
- gtk-clist-append(widget, string*);
- cleanup
- map(destroy, string*)
- end
- end
+ let model = gtk-list-store-newv(no-of-columns + 1, type-vector);
+ with-stack-structure(iter :: <GtkTreeIter>)
+ for (item in items, i from 0)
+ format-out("item %=\n", item);
+ //item := item-object(item);
+ gtk-list-store-append(model, iter);
+ with-stack-structure (gvalue :: <GValue>)
+ g-value-nullify(gvalue);
+ g-value-set-value(gvalue, i);
+ gtk-list-store-set-value(model, iter, 0, gvalue);
+ format-out("set first column\n");
+ for (c in columns, j from 1)
+ let generator = table-column-generator(c);
+ format-out("received generator for column\n");
+ let label = gadget-item-label(gadget, generator(item));
+ format-out("got label %= \n", label);
+ unless (instance?(label, <string>))
+ label := format-to-string("%=", label);
+ end;
+ g-value-nullify(gvalue);
+ g-value-set-value(gvalue, label);
+ gtk-list-store-set-value(model, iter, j, gvalue);
+ end;
+ end;
+ end;
+ end;
+ widget. at model := model;
+ end;
end method update-list-control-items;
-*/
/// Option boxes
@@ -1477,7 +1556,7 @@
define sealed method make-gtk-mirror
(gadget :: <gtk-option-box>)
=> (mirror :: <gadget-mirror>)
- let widget = gtk-clist-new(1);
+ let widget = with-gdk-lock gtk-clist-new(1) end;
assert(~null-pointer?(widget), "gtk-clist-new failed");
make(<gadget-mirror>,
widget: widget,
@@ -1521,7 +1600,7 @@
define sealed method make-gtk-mirror
(gadget :: <gtk-combo-box>)
=> (mirror :: <gadget-mirror>)
- let widget = gtk-clist-new(1);
+ let widget = with-gdk-lock gtk-combo-box-new() end;
assert(~null-pointer?(widget), "gtk-clist-new failed");
make(<gadget-mirror>,
widget: widget,
@@ -1740,13 +1819,13 @@
define method make-gtk-mirror
(sheet :: <gtk-viewport>)
=> (mirror :: <widget-mirror>)
-// let widget = GTK-DRAWING-AREA(gtk-drawing-area-new());
- let widget = gtk-drawing-area-new();
-// gtk-drawing-area-size(widget, 200, 200);
- gtk-widget-set-size-request(widget, 200, 200);
- make(<drawing-area-mirror>,
- widget: widget,
- sheet: sheet);
+ with-gdk-lock
+ let widget = gtk-drawing-area-new();
+ gtk-widget-set-size-request(widget, 200, 200);
+ make(<drawing-area-mirror>,
+ widget: widget,
+ sheet: sheet);
+ end
end method;
@@ -1876,7 +1955,7 @@
define sealed method make-gtk-mirror
(gadget :: <gtk-horizontal-slider>)
=> (mirror :: <gadget-mirror>)
- let widget = gtk-hscale-new(null-pointer(<GtkAdjustment>));
+ let widget = with-gdk-lock gtk-hscale-new(null-pointer(<GtkAdjustment>)) end;
assert(~null-pointer?(widget), "gtk-hscale-new failed");
make(<gadget-mirror>,
widget: widget,
@@ -1886,7 +1965,7 @@
define sealed method make-gtk-mirror
(gadget :: <gtk-vertical-slider>)
=> (mirror :: <gadget-mirror>)
- let widget = gtk-vscale-new(null-pointer(<GtkAdjustment>));
+ let widget = with-gdk-lock gtk-vscale-new(null-pointer(<GtkAdjustment>)) end;
assert(~null-pointer?(widget), "gtk-vscale-new failed");
make(<gadget-mirror>,
widget: widget,
Modified: branches/opendylan-melange/gtk/gtk.dylan
==============================================================================
--- branches/opendylan-melange/gtk/gtk.dylan (original)
+++ branches/opendylan-melange/gtk/gtk.dylan Fri Jun 8 03:26:38 2007
@@ -38,6 +38,31 @@
c-name: "gtk_widget_get_allocation";
end;
+define C-function gtk-dialog-get-vbox
+ input parameter dialog :: <GtkDialog>;
+ result vbox :: <GtkWidget>;
+ c-name: "gtk_dialog_get_vbox";
+end;
+
+define C-function gtk-dialog-get-action-area
+ input parameter dialog :: <GtkDialog>;
+ result vbox :: <GtkWidget>;
+ c-name: "gtk_dialog_get_action_area";
+end;
+
+
+define macro with-gdk-lock
+ { with-gdk-lock ?:body end }
+ =>
+ { block()
+ *holding-gdk-lock* > 0 | gdk-threads-enter();
+ *holding-gdk-lock* := *holding-gdk-lock* + 1;
+ ?body
+ cleanup
+ *holding-gdk-lock* := *holding-gdk-lock* - 1;
+ *holding-gdk-lock* > 0 | gdk-threads-leave();
+ end }
+end;
define method make(type :: subclass(<GTypeInstance>), #rest args,
@@ -68,7 +93,9 @@
define method finalize (instance :: <GTypeInstance>)
=> ();
- g-object-unref(instance)
+ with-gdk-lock
+ g-object-unref(instance)
+ end with-gdk-lock;
end;
define function all-subclasses(x :: <class>)
@@ -102,6 +129,8 @@
define constant $all-gtype-instances = all-subclasses(<_GTypeInstance>);
+define thread variable *holding-gdk-lock* = 0;
+
define function dylan-meta-marshaller (closure :: <GClosure>,
return-value :: <GValue>,
n-param-values :: <integer>,
@@ -125,7 +154,9 @@
// value*;
end for;
values := reverse!(values);
+ *holding-gdk-lock* := 1;
let res = apply(import-c-dylan-object(c-type-cast(<C-dylan-object>, marshal-data)), values);
+ *holding-gdk-lock* := 0;
if(return-value ~= null-pointer(<gvalue>))
select(g-value-type(return-value))
$G-TYPE-BOOLEAN => g-value-set-boolean(return-value,
@@ -173,17 +204,6 @@
if(run-after?) 1 else 0 end)
end function g-signal-connect;
-define macro with-gdk-lock
- { with-gdk-lock ?:body end }
- =>
- { block()
- gdk-threads-enter();
- ?body
- cleanup
- gdk-threads-leave();
- end }
-end;
-
define function initialize-gtk
() => ()
g-thread-init(null-pointer(<GThreadFunctions>));
@@ -311,11 +331,15 @@
g-value-set-float(gvalue, value);
end;
define method g-value-set-value (gvalue :: <GValue>, value :: <integer>)
+ g-value-init(gvalue, $G-TYPE-INT);
+ g-value-set-int(gvalue, value);
+end;
+define method g-value-set-value (gvalue :: <GValue>, value :: <boolean>)
g-value-init(gvalue, $G-TYPE-BOOLEAN);
- g-value-set-boolean(gvalue, value);
+ g-value-set-boolean(gvalue, if (value) 1 else 0 end);
end;
define method g-value-set-value (gvalue :: <GValue>, value :: <GTypeInstance>)
- g-value-init(gvalue, $G-TYPE-OBJECT);
+ g-value-init(gvalue, g-type-from-instance(value));
g-value-set-object(gvalue, value);
end;
Modified: branches/opendylan-melange/gtk/module.dylan
==============================================================================
--- branches/opendylan-melange/gtk/module.dylan (original)
+++ branches/opendylan-melange/gtk/module.dylan Fri Jun 8 03:26:38 2007
@@ -14,6 +14,11 @@
gtk-widget-get-window,
gtk-widget-get-state,
gtk-widget-get-allocation,
+ gtk-dialog-get-vbox,
+ gtk-dialog-get-action-area,
+ g-value-nullify,
+ g-value-to-dylan,
+ g-value-set-value,
property-getter-definer,
property-setter-definer,
\with-gdk-lock;
Modified: branches/opendylan-melange/gtk/support.c
==============================================================================
--- branches/opendylan-melange/gtk/support.c (original)
+++ branches/opendylan-melange/gtk/support.c Fri Jun 8 03:26:38 2007
@@ -1,6 +1,7 @@
#include <glib-object.h>
#include <gtk/gtkwidget.h>
#include <gdk/gdkwindow.h>
+#include <gtk/gtkdialog.h>
GType g_type_from_instance (GTypeInstance* instance) {
return G_TYPE_FROM_INSTANCE(instance);
@@ -30,6 +31,14 @@
return GTK_WIDGET_STATE(widget);
}
+GtkWidget* gtk_dialog_get_vbox (GtkDialog* dialog) {
+ return GTK_DIALOG(dialog)->vbox;
+}
+
+GtkWidget* gtk_dialog_get_action_area (GtkDialog* dialog) {
+ return GTK_DIALOG(dialog)->action_area;
+}
+
struct GtkAllocation* gtk_widget_get_allocation (GtkWidget* widget) {
return &(widget->allocation);
}
More information about the chatter
mailing list