コード例 #1
0
ファイル: perl-handlers.c プロジェクト: dylex/pidgin
static gboolean
perl_timeout_cb(gpointer data)
{
	PurplePerlTimeoutHandler *handler = data;
	gboolean ret = FALSE;

	dSP;
	ENTER;
	SAVETMPS;
	PUSHMARK(sp);
	XPUSHs((SV *)handler->data);
	PUTBACK;
	call_sv(handler->callback, G_EVAL | G_SCALAR);
	SPAGAIN;

	if (SvTRUE(ERRSV)) {
		purple_debug_error("perl",
		                 "Perl timeout function exited abnormally: %s\n",
		                 SvPVutf8_nolen(ERRSV));
	}

	ret = POPi;

	PUTBACK;
	FREETMPS;
	LEAVE;

	if (ret == FALSE)
		destroy_timeout_handler(handler);

	return ret;
}
コード例 #2
0
/* this is public so that other extensions which use GtkMenuPosFunc (e.g.
 * libgnomeui) don't need to reimplement it. */
void
gtk2perl_menu_position_func (GtkMenu * menu,
                             gint * x,
                             gint * y,
                             gboolean * push_in,
                             GPerlCallback * callback)
{
	int n;
	dGPERL_CALLBACK_MARSHAL_SP;

	GPERL_CALLBACK_MARSHAL_INIT (callback);

	ENTER;
	SAVETMPS;

	PUSHMARK (SP);

	EXTEND (SP, 3);
	PUSHs (sv_2mortal (newSVGtkMenu (menu)));
	PUSHs (sv_2mortal (newSViv (*x)));
	PUSHs (sv_2mortal (newSViv (*y)));
	if (callback->data)
		XPUSHs (sv_2mortal (newSVsv (callback->data)));

	/* A die() from callback->func is suspected to be bad or very bad.
	   Circa Gtk 2.18 a jump out of $menu->popup seems to leave an X
	   grab with no way to get rid of it (no keyboard Esc, and no mouse
	   click handlers).  The position func can also be called later for
	   things like resizing or move to a different GdkScreen, and such a
	   call might come straight from the main loop, where a die() would
	   jump out of Gtk2->main.  */

	PUTBACK;
	n = call_sv (callback->func, G_ARRAY | G_EVAL);
	SPAGAIN;

	if (SvTRUE (ERRSV)) {
		g_warning ("menu position callback ignoring error: %s",
			   SvPVutf8_nolen (ERRSV));
	} else if (n < 2 || n > 3) {
		g_warning ("menu position callback must return two integers "
			   "(x, and y) or two integers and a boolean "
			   "(x, y, and push_in)");
	} else {
		/* POPs and POPi take things off the *end* of the stack! */
		if (n > 2) {
			SV *sv = POPs;
			*push_in = sv_2bool (sv);
		}
		if (n > 1) *y = POPi;
		if (n > 0) *x = POPi;
	}

	PUTBACK;
	FREETMPS;
	LEAVE;
}
コード例 #3
0
ファイル: perl-handlers.c プロジェクト: bf4/pidgin-mac
static PurpleCmdRet
perl_cmd_cb(PurpleConversation *conv, const gchar *command,
            gchar **args, gchar **error, void *data)
{
	int i = 0, count, ret_value = PURPLE_CMD_RET_OK;
	SV *cmdSV, *tmpSV, *convSV;
	PurplePerlCmdHandler *handler = data;

	dSP;
	ENTER;
	SAVETMPS;
	PUSHMARK(SP);

	/* Push the conversation onto the perl stack */
	convSV = sv_2mortal(purple_perl_bless_object(conv, "Purple::Conversation"));
	XPUSHs(convSV);

	/* Push the command string onto the perl stack */
	cmdSV = newSVpv(command, 0);
	cmdSV = sv_2mortal(cmdSV);
	XPUSHs(cmdSV);

	/* Push the data onto the perl stack */
	XPUSHs((SV *)handler->data);

	/* Push any arguments we may have */
	for (i = 0; args[i] != NULL; i++) {
		/* XXX The mortality of these created SV's should prevent
		 * memory issues, if I read/understood everything correctly...
		 */
		tmpSV = newSVpv(args[i], 0);
		tmpSV = sv_2mortal(tmpSV);
		XPUSHs(tmpSV);
	}

	PUTBACK;
	count = call_sv(handler->callback, G_EVAL | G_SCALAR);

	if (count != 1)
		croak("call_sv: Did not return the correct number of values.\n");

	if (SvTRUE(ERRSV)) {
		purple_debug_error("perl",
		                 "Perl plugin command function exited abnormally: %s\n",
		                 SvPVutf8_nolen(ERRSV));
	}

	SPAGAIN;

	ret_value = POPi;

	PUTBACK;
	FREETMPS;
	LEAVE;

	return ret_value;
}
コード例 #4
0
ファイル: perl-handlers.c プロジェクト: bf4/pidgin-mac
void
purple_perl_plugin_action_cb(PurplePluginAction *action)
{
	SV **callback;
	HV *hv = NULL;
	gchar *hvname;
	PurplePlugin *plugin;
	PurplePerlScript *gps;
	dSP;

	plugin = action->plugin;
	gps = (PurplePerlScript *)plugin->info->extra_info;
	hvname = g_strdup_printf("%s::plugin_actions", gps->package);
	hv = get_hv(hvname, FALSE);
	g_free(hvname);

	if (hv == NULL)
		croak("No plugin_actions hash found in \"%s\" plugin.", purple_plugin_get_name(plugin));

	ENTER;
	SAVETMPS;

	callback = hv_fetch(hv, action->label, strlen(action->label), 0);

	if (callback == NULL || *callback == NULL)
		croak("No plugin_action function named \"%s\" in \"%s\" plugin.", action->label, purple_plugin_get_name(plugin));

	PUSHMARK(sp);
	XPUSHs(purple_perl_bless_object(gps->plugin, "Purple::Plugin"));
	PUTBACK;

	call_sv(*callback, G_EVAL | G_VOID | G_DISCARD);

	SPAGAIN;

	if (SvTRUE(ERRSV)) {
		purple_debug_error("perl",
		                 "Perl plugin action function exited abnormally: %s\n",
		                 SvPVutf8_nolen(ERRSV));
	}

	PUTBACK;
	FREETMPS;
	LEAVE;
}
コード例 #5
0
ファイル: perl-handlers.c プロジェクト: bf4/pidgin-mac
PurplePluginPrefFrame *
purple_perl_get_plugin_frame(PurplePlugin *plugin)
{
	/* Sets up the Perl Stack for our call back into the script to run the
	 * plugin_pref... sub */
	int count;
	PurplePerlScript *gps;
	PurplePluginPrefFrame *ret_frame;
	dSP;

	gps = (PurplePerlScript *)plugin->info->extra_info;

	ENTER;
	SAVETMPS;
	/* Some perl magic to run perl_plugin_pref_frame_SV perl sub and
	 * return the frame */
	PUSHMARK(SP);
	PUTBACK;

	count = call_pv(gps->prefs_sub, G_EVAL | G_SCALAR | G_NOARGS);

	SPAGAIN;

	if (SvTRUE(ERRSV)) {
		purple_debug_error("perl",
		                 "Perl plugin prefs frame init exited abnormally: %s\n",
		                 SvPVutf8_nolen(ERRSV));
	}

	if (count != 1)
		croak("call_pv: Did not return the correct number of values.\n");
	/* the frame was created in a perl sub and is returned */
	ret_frame = (PurplePluginPrefFrame *)purple_perl_ref_object(POPs);

	/* Tidy up the Perl stack */
	PUTBACK;
	FREETMPS;
	LEAVE;

	return ret_frame;
}
コード例 #6
0
ファイル: perl-handlers.c プロジェクト: bf4/pidgin-mac
GtkWidget *
purple_perl_gtk_get_plugin_frame(PurplePlugin *plugin)
{
	SV * sv;
	int count;
	MAGIC *mg;
	GtkWidget *ret;
	PurplePerlScript *gps;
	dSP;

	gps = plugin->info->extra_info;

	ENTER;
	SAVETMPS;

	count = call_pv(gps->gtk_prefs_sub, G_EVAL | G_SCALAR | G_NOARGS);
	if (count != 1)
		croak("call_pv: Did not return the correct number of values.\n");

	/* the frame was created in a perl sub and is returned */
	SPAGAIN;

	if (SvTRUE(ERRSV)) {
		purple_debug_error("perl",
		                 "Perl gtk plugin frame init exited abnormally: %s\n",
		                 SvPVutf8_nolen(ERRSV));
	}

	/* We have a Gtk2::Frame on top of the stack */
	sv = POPs;

	/* The magic field hides the pointer to the actual GtkWidget */
	mg = mg_find(SvRV(sv), PERL_MAGIC_ext);
	ret = (GtkWidget *)mg->mg_ptr;

	PUTBACK;
	FREETMPS;
	LEAVE;

	return ret;
}
コード例 #7
0
ファイル: perl-handlers.c プロジェクト: bf4/pidgin-mac
static void *
perl_signal_cb(va_list args, void *data)
{
	PurplePerlSignalHandler *handler = data;
	void *ret_val = NULL;
	int i;
	int count;
	int value_count;
	PurpleValue *ret_value, **values;
	SV **sv_args;
	DATATYPE **copy_args;

	dSP;
	ENTER;
	SAVETMPS;
	PUSHMARK(sp);

	purple_signal_get_values(handler->instance, handler->signal,
	                         &ret_value, &value_count, &values);

	sv_args   = g_new(SV *,    value_count);
	copy_args = g_new(void **, value_count);

	for (i = 0; i < value_count; i++) {
		sv_args[i] = purple_perl_sv_from_vargs(values[i],
#ifdef VA_COPY_AS_ARRAY
		                                       args,
#else
		                                       (va_list*)&args,
#endif
		                                       &copy_args[i]);

		XPUSHs(sv_args[i]);
	}

	XPUSHs((SV *)handler->data);

	PUTBACK;

	if (ret_value != NULL) {
		count = call_sv(handler->callback, G_EVAL | G_SCALAR);

		SPAGAIN;

		if (count != 1)
			croak("Uh oh! call_sv returned %i != 1", i);
		else
			ret_val = purple_perl_data_from_sv(ret_value, POPs);
	} else {
		call_sv(handler->callback, G_EVAL | G_SCALAR);

		SPAGAIN;
	}

	if (SvTRUE(ERRSV)) {
		purple_debug_error("perl",
		                 "Perl function exited abnormally: %s\n",
		                 SvPVutf8_nolen(ERRSV));
	}

	/* See if any parameters changed. */
	for (i = 0; i < value_count; i++) {
		if (purple_value_is_outgoing(values[i])) {
			switch (purple_value_get_type(values[i])) {
				case PURPLE_TYPE_BOOLEAN:
					*((gboolean *)copy_args[i]) = SvIV(sv_args[i]);
					break;

				case PURPLE_TYPE_INT:
					*((int *)copy_args[i]) = SvIV(sv_args[i]);
					break;

				case PURPLE_TYPE_UINT:
					*((unsigned int *)copy_args[i]) = SvUV(sv_args[i]);
					break;

				case PURPLE_TYPE_LONG:
					*((long *)copy_args[i]) = SvIV(sv_args[i]);
					break;

				case PURPLE_TYPE_ULONG:
					*((unsigned long *)copy_args[i]) = SvUV(sv_args[i]);
					break;

				case PURPLE_TYPE_INT64:
					*((gint64 *)copy_args[i]) = SvIV(sv_args[i]);
					break;

				case PURPLE_TYPE_UINT64:
					*((guint64 *)copy_args[i]) = SvUV(sv_args[i]);
					break;

				case PURPLE_TYPE_STRING:
					if (strcmp(*((char **)copy_args[i]), SvPVX(sv_args[i]))) {
						g_free(*((char **)copy_args[i]));
						*((char **)copy_args[i]) =
							g_strdup(SvPVutf8_nolen(sv_args[i]));
					}
					/* Clean up sv_args[i] - we're done with it */
					sv_2mortal(sv_args[i]);
					break;

				case PURPLE_TYPE_POINTER:
				case PURPLE_TYPE_BOXED:
					*((void **)copy_args[i]) = (void *)SvIV(sv_args[i]);
					break;
				case PURPLE_TYPE_SUBTYPE:
					*((void **)copy_args[i]) = purple_perl_ref_object(sv_args[i]);
					break;

				default:
					break;
			}


#if 0
			*((void **)copy_args[i]) = purple_perl_data_from_sv(values[i],
															  sv_args[i]);
#endif
		}
	}

	PUTBACK;
	FREETMPS;
	LEAVE;

	g_free(sv_args);
	g_free(copy_args);

	purple_debug_misc("perl", "ret_val = %p\n", ret_val);

	return ret_val;
}