[Gd-chatter] r11389 - in branches/opendylan-melange: gtk gtk-duim
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Tue Jun 5 23:24:53 CEST 2007
Author: andreas
Date: Tue Jun 5 23:24:51 2007
New Revision: 11389
Modified:
branches/opendylan-melange/gtk-duim/gtk-dialogs.dylan
branches/opendylan-melange/gtk-duim/gtk-gadgets.dylan
branches/opendylan-melange/gtk-duim/gtk-mirror.dylan
branches/opendylan-melange/gtk/gtk.dylan
branches/opendylan-melange/gtk/support.c
Log:
job: fd
* Properly nullify GValue structs on init
* add missing methods for <drawing-area-mirror>
* add do-choose-file implementation
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 Tue Jun 5 23:24:51 2007
@@ -29,7 +29,6 @@
define sealed method make-top-level-mirror
(sheet :: <top-level-sheet>, frame :: <dialog-frame>)
=> (mirror :: <top-level-mirror>)
-// let widget = GTK-WINDOW(gtk-window-new($GTK-WINDOW-DIALOG));
let widget = gtk-dialog-new();
let owner = frame-owner(frame);
make(<dialog-mirror>,
@@ -333,87 +332,41 @@
/// Choose file
-/*---
define sealed method do-choose-file
(framem :: <gtk-frame-manager>, owner :: <sheet>,
direction :: one-of(#"input", #"output"),
#key title :: false-or(<string>), documentation :: false-or(<string>), exit-boxes,
if-exists, if-does-not-exist = #"ask",
default :: false-or(<string>), default-type = $unsupplied,
- filters, default-filter,
+ filters, default-filter, selection-mode,
#all-keys)
=> (locator :: false-or(<string>), filter :: false-or(<integer>))
ignore(if-exists);
let _port = port(owner);
- let x-display = _port.%display;
let parent-widget = mirror-widget(sheet-mirror(owner));
- let (visual, colormap, depth) = xt/widget-visual-specs(parent-widget);
- let (directory, pattern) = gtk-directory-and-pattern(default, default-type);
- let shell-resources
- = vector(visual:, visual,
- colormap:, colormap,
- depth:, depth);
- let resources
- = vector(directory:, directory,
- pattern:, pattern,
- dialog-title:, title,
- dialog-style:, xm/$XmDIALOG-FULL-APPLICATION-MODAL,
- default-position:, #f);
-
- when (file-label)
- resources
- := concatenate!(resources, vector(file-list-label-string:, file-label))
- end;
- when (directory-label)
- resources
- := concatenate!(resources, vector(dir-list-label-string:, directory-label))
+ let mtitle = title | if (direction == #"output") "Save File" else "Open File" end;
+ let action = if (direction == #"output")
+ $GTK-FILE-CHOOSER-ACTION-SAVE
+ else
+ $GTK-FILE-CHOOSER-ACTION-OPEN
+ end;
+ let dialog = gtk-file-chooser-dialog-new (mtitle,
+ parent-widget,
+ action,
+ null-pointer(<gchar*>));
+ if (default)
+ gtk-file-chooser-set-filename(dialog, default)
end;
- let (x, y)
- = begin
- let (x, y) = sheet-size(owner);
- let (x, y) = values(floor/(x, 2), floor/(y, 2));
- with-device-coordinates (sheet-device-transform(owner), x, y)
- values(x, y)
- end
- end;
- let shell = #f;
- let dialog = #f;
- let result = #f;
- let client-data = #f;
- block ()
- local method waiter () result end method,
- method setter (value) result := value end method;
- shell := xt/XtCreatePopupShell("ChooseFileShell", xm/<dialog-shell>, parent-widget,
- resources: shell-resources);
- dialog := xm/XmCreateFileSelectionBox(shell, "ChooseFile",
- resources: resources);
- client-data := make(<callback-client-data>,
- owner-widget: parent-widget,
- x-display: x-display,
- pointer-x: x,
- pointer-y: y,
- setter: setter);
- xt/XtAddCallback(dialog, "okCallback", choose-file-button-press-callback, client-data);
- xt/XtAddCallback(dialog, "cancelCallback", choose-file-button-press-callback, client-data)
- xt/XtUnmanageChild(xm/XmFileSelectionBoxGetChild(dialog, xm/$XmDIALOG-HELP-BUTTON))
- xt/XtAddCallback(dialog, "mapCallback", notifier-map-callback, client-data);
- xm/XmAddWmProtocolCallback(xt/XtParent(dialog), "wmDeleteWindow", notifier-delete-window-callback, setter);
- xt/XtManageChild(dialog);
- //---*** CLIM does this: '(mp:process-wait "Waiting for CLIM:SELECT-FILE" #'waiter)'
- if (result == #"cancel")
- values(#f, #f)
- else
- values(result, #f)
- end
- cleanup
- when (dialog)
- x/XSync(x-display, #f);
- xt/XtUnmanageChild(dialog);
- xt/XtDestroyWidget(shell)
+ let filename =
+ if (gtk-dialog-run (dialog) == $GTK-RESPONSE-ACCEPT)
+ gtk-file-chooser-get-filename(dialog); // FIXME: leaks the filename C string
end;
- end
+ gtk-widget-destroy(dialog);
+ values(filename, #f)
end method do-choose-file;
+
+/*---
define xm/xm-callback-function choose-file-button-press-callback
(widget, client-data :: <callback-client-data>, call-data :: xm/<XmFileSelectionBoxCallbackStruct>)
ignore(widget);
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 Jun 5 23:24:51 2007
@@ -185,7 +185,7 @@
ignore(client);
next-method();
let widget = gadget-widget(gadget);
- with-gdk-lock
+ widget & with-gdk-lock
gtk-widget-set-sensitive(widget, $false)
end
end method note-gadget-disabled;
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 Tue Jun 5 23:24:51 2007
@@ -391,6 +391,15 @@
x, y)
end method set-mirror-parent;
+define method set-mirror-parent
+ (child :: <widget-mirror>, parent :: <drawing-area-mirror>)
+ => ()
+ let (x, y) = sheet-native-edges(mirror-sheet(child));
+ gtk-fixed-put(mirror-widget(parent),
+ mirror-widget(child),
+ x, y)
+end method set-mirror-parent;
+
/*
define method set-mirror-parent
(child :: <popup-menu-mirror>, parent :: <display-mirror>)
@@ -417,6 +426,14 @@
set-mirror-size(child, width, height)
end method size-mirror;
+define method size-mirror
+ (parent :: <drawing-area-mirror>, child :: <widget-mirror>,
+ width :: <integer>, height :: <integer>)
+ => ()
+ ignore(parent);
+ set-mirror-size(child, width, height)
+end method size-mirror;
+
define method set-mirror-size
(mirror :: <widget-mirror>, width :: <integer>, height :: <integer>)
=> ()
Modified: branches/opendylan-melange/gtk/gtk.dylan
==============================================================================
--- branches/opendylan-melange/gtk/gtk.dylan (original)
+++ branches/opendylan-melange/gtk/gtk.dylan Tue Jun 5 23:24:51 2007
@@ -335,15 +335,18 @@
}
end;
+define C-function g-value-nullify
+ parameter gvalue :: <GValue>;
+ c-name: "g_value_nullify";
+end;
+
define macro property-setter-definer
{ define property-setter ?:name :: ?type:name on ?class:name end }
=> { define method "@" ## ?name ## "-setter" (res, object :: ?class) => (res)
with-stack-structure (gvalue :: <GValue>)
// FIXME: hack, because we cannot request initialization with zero
// from with-stack-structure
- if (g-is-value(gvalue) ~= 0)
- g-value-unset(gvalue)
- end;
+ g-value-nullify(gvalue);
g-value-set-value(gvalue, res);
g-object-set-property(object, ?"name", gvalue);
end;
Modified: branches/opendylan-melange/gtk/support.c
==============================================================================
--- branches/opendylan-melange/gtk/support.c (original)
+++ branches/opendylan-melange/gtk/support.c Tue Jun 5 23:24:51 2007
@@ -34,3 +34,13 @@
return &(widget->allocation);
}
+void g_value_nullify(GValue* gvalue) {
+ char* foo = (char*)gvalue;
+ int i;
+
+ for(i=0; i<sizeof(GValue); i++,foo++)
+ *foo = 0;
+}
+
+
+
More information about the chatter
mailing list