Menu
▾
▴
[Gtk2hs-commit] gtk2hs/glib/System/Glib hsgclosure.c,1.2,1.3 hsgclosure.h,1.1,1.2 Signals.chs.pp,1.5,1.6
|
From: Duncan C. <dun...@us...> - 2005-10-11 15:43:47
|
Update of /cvsroot/gtk2hs/gtk2hs/glib/System/Glib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23968/glib/System/Glib Modified Files: hsgclosure.c hsgclosure.h Signals.chs.pp Log Message: bug fixes and improvements to the GClosure-based signal handling Cope with signal handlers that provide a non-null return GValue but with an invalid type by ignoring them (which is what the python version does too). This fixes the Entry onEntryActivate signal and probably others. Also improve the debugging and error checking code and rename the C functions to use the gtk2hs namespace/prefix. Index: hsgclosure.c =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/glib/System/Glib/hsgclosure.c,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- hsgclosure.c 22 Jun 2005 16:00:47 -0000 1.2 +++ hsgclosure.c 11 Oct 2005 15:43:54 -0000 1.3 @@ -1,4 +1,4 @@ -/* GIMP Toolkit (GTK) HsGClosure implementation +/* GIMP Toolkit (GTK) Gtk2HsClosure implementation * * Author : Duncan Coutts * @@ -25,7 +25,6 @@ #include "hsgclosure.h" #ifdef DEBUG -#include <stdio.h> #define WHEN_DEBUG(a) a #else #define WHEN_DEBUG(a) @@ -44,18 +43,18 @@ #define rts_unlock() #endif -/* HsGClosure is a _private_ structure */ -typedef struct _HsGClosure HsGClosure; -struct _HsGClosure { +/* Gtk2HsClosure is a _private_ structure */ +typedef struct _Gtk2HsClosure Gtk2HsClosure; +struct _Gtk2HsClosure { GClosure closure; HsStablePtr callback; }; /* TODO: check if we should be using invalidate or finalise */ static void -hsg_closure_invalidate(gpointer data, GClosure *closure) { - HsGClosure *hc = (HsGClosure *)closure; - WHEN_DEBUG(fprintf(stderr, "hsg_closure_invalidate: enter, callback=%p\n", hc->callback)); +gtk2hs_closure_invalidate(gpointer data, GClosure *closure) { + Gtk2HsClosure *hc = (Gtk2HsClosure *)closure; + WHEN_DEBUG(g_debug("gtk2hs_closure_invalidate: enter, callback=%p", hc->callback)); /* I think invalidate can be called more than once in the case of cycles * so be safe and allow that */ @@ -63,17 +62,17 @@ hs_free_stable_ptr(hc->callback); hc->callback = NULL; - WHEN_DEBUG(fprintf(stderr, "hsg_closure_invalidate: leave\n")); + WHEN_DEBUG(g_debug("gtk2hs_closure_invalidate: leave")); } /* forward defs */ -static HaskellObj hsg_value_as_haskellobj(const GValue *value); -static void hsg_value_from_haskellobj(GValue *value, HaskellObj obj); +static HaskellObj gtk2hs_value_as_haskellobj(const GValue *value); +static void gtk2hs_value_from_haskellobj(GValue *value, HaskellObj obj); extern StgClosure * GHCziStable_deRefStablePtr_closure; static void -hsg_closure_marshal(GClosure *closure, +gtk2hs_closure_marshal(GClosure *closure, GValue *return_value, guint n_param_values, const GValue *param_values, @@ -81,61 +80,62 @@ gpointer marshal_data) { - HsGClosure *hc = (HsGClosure *)closure; + Gtk2HsClosure *hc = (Gtk2HsClosure *)closure; HaskellObj call, ret; SchedulerStatus rc; guint i; - WHEN_DEBUG(fprintf(stderr, "hsg_closure_marshal: about to run callback=%p, n_param_values=%d\n", hc->callback, n_param_values)); + WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: about to run callback=%p, n_param_values=%d", hc->callback, n_param_values)); rts_lock(); call = (StgClosure *)deRefStablePtr(hc->callback); /* construct the function call */ for (i = 0; i < n_param_values; i++) { -#ifdef DEBUG - gchar * value_str_rep = g_strdup_value_contents(¶m_values[i]); - fprintf(stderr, "hsg_closure_marshal: param_values[%d]=%s :: %s\n", i, value_str_rep, g_type_name(G_VALUE_TYPE(¶m_values[i]))); - g_free(value_str_rep); -#endif - call = rts_apply(call, hsg_value_as_haskellobj(¶m_values[i])); + WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: param_values[%d]=%s :: %s", + i, + g_strdup_value_contents(¶m_values[i]), + g_type_name(G_VALUE_TYPE(¶m_values[i])))); + call = rts_apply(call, gtk2hs_value_as_haskellobj(¶m_values[i])); } - WHEN_DEBUG(fprintf(stderr, "hsg_closure_marshal: about to rts_evalIO\n")); + WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: about to rts_evalIO")); /* perform the call */ rc=rts_evalIO(rts_apply((HaskellObj)runIO_closure, call),&ret); - WHEN_DEBUG(fprintf(stderr, "hsg_closure_marshal: about to rts_checkSchedStatus\n")); + WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: about to rts_checkSchedStatus")); /* barf if anything went wrong */ /* TODO: pass a sensible value for call site so we get better error messages */ /* or perhaps we can propogate any error? */ - rts_checkSchedStatus("", rc); + rts_checkSchedStatus("gtk2hs_closure_marshal", rc); if (return_value) { - WHEN_DEBUG(fprintf(stderr, "hsg_closure_marshal: type of return_value=%s\n", g_type_name(G_VALUE_TYPE(return_value)))); - hsg_value_from_haskellobj(return_value, ret); + WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: return_value :: %s", +/* g_strdup_value_contents(return_value), */ + g_type_name(G_VALUE_TYPE(return_value)))); + gtk2hs_value_from_haskellobj(return_value, ret); } rts_unlock(); - WHEN_DEBUG(fprintf(stderr, "hsg_closure_marshal: done running callback\n")); + WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: done running callback")); } GClosure * -hsg_closure_new(HsStablePtr callback) +gtk2hs_closure_new(HsStablePtr callback) { GClosure *closure; - WHEN_DEBUG(fprintf(stderr, "hsg_closure_new: enter, callback=%p\n", callback)); - closure = g_closure_new_simple(sizeof(HsGClosure), NULL); + WHEN_DEBUG(g_debug("gtk2hs_closure_new: enter, callback=%p", callback)); + closure = g_closure_new_simple(sizeof(Gtk2HsClosure), NULL); /* TODO: check if we should be using invalidate or finalise notifier */ - g_closure_add_invalidate_notifier(closure, NULL, hsg_closure_invalidate); - g_closure_set_marshal(closure, hsg_closure_marshal); + g_closure_add_invalidate_notifier(closure, NULL, gtk2hs_closure_invalidate); + g_closure_set_marshal(closure, gtk2hs_closure_marshal); - ((HsGClosure *)closure)->callback = callback; + ((Gtk2HsClosure *)closure)->callback = callback; - WHEN_DEBUG(fprintf(stderr, "hsg_closure_new: leave\n")); + WHEN_DEBUG(g_debug("gtk2hs_closure_new: leave")); return closure; } @@ -143,7 +143,7 @@ /* GValue <-> HaskellObj marshaling functions */ static HaskellObj -hsg_value_as_haskellobj(const GValue *value) { +gtk2hs_value_as_haskellobj(const GValue *value) { switch (G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value))) { case G_TYPE_INTERFACE: if (g_type_is_a(G_VALUE_TYPE(value), G_TYPE_OBJECT)) @@ -182,22 +182,23 @@ return rts_mkPtr(g_value_get_pointer(value)); case G_TYPE_BOXED: return rts_mkPtr(g_value_get_boxed(value)); - case G_TYPE_PARAM: - break; /* TODO */ - /* return g_value_get_param(value); */ +/* case G_TYPE_PARAM: + return g_value_get_param(value); */ case G_TYPE_OBJECT: return rts_mkPtr(g_value_get_object(value)); - default: - break; } - WHEN_DEBUG(fprintf(stderr, "hsg_value_as_haskellobj: unable to handle GValue: %s\n", g_strdup_value_contents(value))); - exit(1); + g_error("gtk2hs_value_as_haskellobj: unable to handle GValue with type %s\n" + "please report this as a bug to gtk...@li...", + g_type_name(G_VALUE_TYPE(value))); } void -hsg_value_from_haskellobj(GValue *value, HaskellObj obj) { +gtk2hs_value_from_haskellobj(GValue *value, HaskellObj obj) { switch (G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value))) { + case G_TYPE_INVALID: + case G_TYPE_NONE: + return; case G_TYPE_INTERFACE: /* we only handle interface types that have a GObject prereq */ if (g_type_is_a(G_VALUE_TYPE(value), G_TYPE_OBJECT)) { @@ -251,20 +252,18 @@ case G_TYPE_POINTER: g_value_set_pointer(value, rts_getPtr(obj)); return; - case G_TYPE_BOXED: { - /* g_value_set_boxed(value, obj); */ - break; /* TODO */ +/* case G_TYPE_BOXED: { + g_value_set_boxed(value, obj); + break; } case G_TYPE_PARAM: - /* g_value_set_param(value, (obj)); */ - break; /* TODO */ + g_value_set_param(value, (obj)); + break; */ case G_TYPE_OBJECT: g_value_set_object(value, rts_getPtr(obj)); return; - default: - break; } - /* FIXME: improve error handling here */ - WHEN_DEBUG(fprintf(stderr, "hsg_value_from_haskellobj: unable to handle GValue with type %s\n", g_type_name(G_VALUE_TYPE((value))))); - exit(1); + g_error("gtk2hs_value_from_haskellobj: unable to handle GValue with type %s\n" + "please report this as a bug to gtk...@li...", + g_type_name(G_VALUE_TYPE(value))); } Index: hsgclosure.h =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/glib/System/Glib/hsgclosure.h,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- hsgclosure.h 6 Apr 2005 20:20:16 -0000 1.1 +++ hsgclosure.h 11 Oct 2005 15:43:54 -0000 1.2 @@ -21,4 +21,4 @@ #include <glib-object.h> -GClosure * hsg_closure_new(HsStablePtr callback); +GClosure * gtk2hs_closure_new(HsStablePtr callback); Index: Signals.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/glib/System/Glib/Signals.chs.pp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- Signals.chs.pp 23 Jul 2005 01:09:51 -0000 1.5 +++ Signals.chs.pp 11 Oct 2005 15:43:54 -0000 1.6 @@ -83,7 +83,7 @@ -> IO (ConnectId obj) connectGeneric signal after obj user = do sptr <- newStablePtr user - gclosurePtr <- hsg_closure_new sptr + gclosurePtr <- gtk2hs_closure_new sptr sigId <- withCString signal $ \signalPtr -> withForeignPtr ((unGObject.toGObject) obj) $ \objPtr -> @@ -94,8 +94,8 @@ (fromBool after) return $ ConnectId sigId obj -foreign import ccall unsafe "hsg_closure_new" - hsg_closure_new :: StablePtr a -> IO (Ptr GClosure) +foreign import ccall unsafe "gtk2hs_closure_new" + gtk2hs_closure_new :: StablePtr a -> IO (Ptr GClosure) #else |