static void perl_pref_cb(const char *name, PurplePrefType type, gconstpointer value, gpointer data) { PurplePerlPrefsHandler *handler = data; dSP; ENTER; SAVETMPS; PUSHMARK(sp); XPUSHs(sv_2mortal(newSVpv(name, 0))); XPUSHs(sv_2mortal(newSViv(type))); switch(type) { case PURPLE_PREF_INT: XPUSHs(sv_2mortal(newSViv(GPOINTER_TO_INT(value)))); break; case PURPLE_PREF_BOOLEAN: XPUSHs((GPOINTER_TO_INT(value) == FALSE) ? &PL_sv_no : &PL_sv_yes); break; case PURPLE_PREF_STRING: case PURPLE_PREF_PATH: XPUSHs(sv_2mortal(newSVGChar(value))); break; case PURPLE_PREF_STRING_LIST: case PURPLE_PREF_PATH_LIST: { AV* av = newAV(); const GList *l = value; /* Append stuff backward to preserve order */ while (l && l->next) l = l->next; while (l) { av_push(av, sv_2mortal(newSVGChar(l->data))); l = l->prev; } XPUSHs(sv_2mortal(newRV_noinc((SV *) av))); } break; default: case PURPLE_PREF_NONE: XPUSHs(&PL_sv_undef); break; } XPUSHs((SV *)handler->data); PUTBACK; call_sv(handler->callback, G_EVAL | G_VOID | G_DISCARD); SPAGAIN; if (SvTRUE(ERRSV)) { purple_debug_error("perl", "Perl prefs callback function exited abnormally: %s\n", SvPVutf8_nolen(ERRSV)); } PUTBACK; FREETMPS; LEAVE; }
static SV * newSVGtkStockItem (GtkStockItem * item) { HV * hv = newHV(); gperl_hv_take_sv_s (hv, "stock_id", newSVGChar (item->stock_id)); gperl_hv_take_sv_s (hv, "label", newSVGChar (item->label)); gperl_hv_take_sv_s (hv, "modifier", newSVGdkModifierType (item->modifier)); gperl_hv_take_sv_s (hv, "keyval", newSVuv (item->keyval)); if (item->translation_domain) gperl_hv_take_sv_s (hv, "translation_domain", newSVGChar (item->translation_domain)); return newRV_noinc ((SV *) hv); }
static void gtk2perl_cell_layout_add_attribute (GtkCellLayout *cell_layout, GtkCellRenderer *cell, const gchar *attribute, gint column) { GET_METHOD_OR_DIE (cell_layout, "ADD_ATTRIBUTE"); { PREP (cell_layout); XPUSHs (sv_2mortal (newSVGtkCellRenderer (cell))); XPUSHs (sv_2mortal (newSVGChar (attribute))); XPUSHs (sv_2mortal (newSViv (column))); CALL; FINISH; } }
static SV * arg_to_sv (GIArgument * arg, GITypeInfo * info, GITransfer transfer, GPerlI11nInvocationInfo *iinfo) { GITypeTag tag = g_type_info_get_tag (info); gboolean own = transfer >= GI_TRANSFER_CONTAINER; dwarn (" arg_to_sv: info %p with type tag %d (%s)\n", info, tag, g_type_tag_to_string (tag)); switch (tag) { case GI_TYPE_TAG_VOID: { SV *sv = callback_data_to_sv (arg->v_pointer, iinfo); dwarn (" argument with no type information -> %s\n", sv ? "callback data" : "undef"); return sv ? SvREFCNT_inc (sv) : &PL_sv_undef; } case GI_TYPE_TAG_BOOLEAN: return boolSV (arg->v_boolean); case GI_TYPE_TAG_INT8: return newSViv (arg->v_int8); case GI_TYPE_TAG_UINT8: return newSVuv (arg->v_uint8); case GI_TYPE_TAG_INT16: return newSViv (arg->v_int16); case GI_TYPE_TAG_UINT16: return newSVuv (arg->v_uint16); case GI_TYPE_TAG_INT32: return newSViv (arg->v_int32); case GI_TYPE_TAG_UINT32: return newSVuv (arg->v_uint32); case GI_TYPE_TAG_INT64: return newSVGInt64 (arg->v_int64); case GI_TYPE_TAG_UINT64: return newSVGUInt64 (arg->v_uint64); case GI_TYPE_TAG_FLOAT: return newSVnv (arg->v_float); case GI_TYPE_TAG_DOUBLE: return newSVnv (arg->v_double); case GI_TYPE_TAG_UNICHAR: { SV *sv; gchar buffer[6]; gint length = g_unichar_to_utf8 (arg->v_uint32, buffer); sv = newSVpv (buffer, length); SvUTF8_on (sv); return sv; } case GI_TYPE_TAG_GTYPE: { /* GType == gsize */ const char *package = gperl_package_from_type (arg->v_size); if (!package) package = g_type_name (arg->v_size); return newSVpv (package, PL_na); } case GI_TYPE_TAG_ARRAY: return array_to_sv (info, arg->v_pointer, transfer, iinfo); case GI_TYPE_TAG_INTERFACE: return interface_to_sv (info, arg, own, iinfo); case GI_TYPE_TAG_GLIST: case GI_TYPE_TAG_GSLIST: return glist_to_sv (info, arg->v_pointer, transfer); case GI_TYPE_TAG_GHASH: return ghash_to_sv (info, arg->v_pointer, transfer); case GI_TYPE_TAG_ERROR: ccroak ("FIXME - GI_TYPE_TAG_ERROR"); break; case GI_TYPE_TAG_UTF8: { SV *sv = newSVGChar (arg->v_string); if (own) g_free (arg->v_string); return sv; } case GI_TYPE_TAG_FILENAME: { SV *sv = newSVpv (arg->v_string, PL_na); if (own) g_free (arg->v_string); return sv; } default: ccroak ("Unhandled info tag %d in arg_to_sv", tag); } return NULL; }