# HG changeset patch # User Etan Reisner # Date 1137925774 0 # Node ID b457aa723babcf397fb8513680b36195e851c200 # Parent 750968cab201a978b310481549389633ff664cf8 [gaim-migrate @ 15341] Perl plugins can now have more than one plugin action. This isn't exactly the nicest way to have done this, as it requires a "global" plugin_actions hash to work, but I couldn't get the cleaner way to work and this is better than nothing. committer: Tailor Script diff -r 750968cab201 -r b457aa723bab plugins/perl/perl-common.h --- a/plugins/perl/perl-common.h Sun Jan 22 07:37:22 2006 +0000 +++ b/plugins/perl/perl-common.h Sun Jan 22 10:29:34 2006 +0000 @@ -32,6 +32,7 @@ char *unload_sub; char *prefs_sub; char *gtk_prefs_sub; + char *plugin_action_sub; } GaimPerlScript; void gaim_perl_normalize_script_name(char *name); diff -r 750968cab201 -r b457aa723bab plugins/perl/perl-handlers.c --- a/plugins/perl/perl-handlers.c Sun Jan 22 07:37:22 2006 +0000 +++ b/plugins/perl/perl-handlers.c Sun Jan 22 10:29:34 2006 +0000 @@ -14,28 +14,38 @@ #define PERL_MAGIC_ext '~' #endif -/* For now a plugin can only have one action */ void -gaim_perl_plugin_action_cb(GaimPluginAction * gpa) +gaim_perl_plugin_action_cb(GaimPluginAction *action) { + SV **callback; + HV *hv = NULL; + gchar *hvname; + GaimPlugin *plugin; + GaimPerlScript *gps; dSP; + + plugin = action->plugin; + gps = (GaimPerlScript *)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.", gaim_plugin_get_name(plugin)); + ENTER; SAVETMPS; - PUSHMARK(sp); + + callback = hv_fetch(hv, action->label, strlen(action->label), 0); - /* We put the plugin handle on the stack so it can pass it along */ - /* to anything called from the callback. It is supposed to pass */ - /* the Action, but there is no way to access the plugin handle from */ - /* the GaimPluginAction in perl...yet. */ + if (callback == NULL || *callback == NULL) + croak("No plugin_action function named \"%s\" in \"%s\" plugin.", action->label, gaim_plugin_get_name(plugin)); - XPUSHs(gaim_perl_bless_object(gpa->plugin, "Gaim::Plugin")); + PUSHMARK(sp); + XPUSHs(gaim_perl_bless_object(gps->plugin, "Gaim::Plugin")); PUTBACK; - /* gaim_perl_plugin_action_callback_sub defined in the header is set - * in perl.c during plugin probe by a PLUGIN_INFO hash value limiting - * us to only one action for right now even though the action member - * of GaimPluginInfo can take (does take) a GList. */ - call_pv(gaim_perl_plugin_action_callback_sub, G_EVAL | G_SCALAR); + call_sv(*callback, G_VOID | G_DISCARD); SPAGAIN; PUTBACK; @@ -44,22 +54,53 @@ } GList * -gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context) +gaim_perl_plugin_actions(GaimPlugin *plugin, gpointer context) { - GaimPluginAction *act = NULL; - GList *gl = NULL; + GList *l = NULL; + GaimPerlScript *gps; + int i = 0, count = 0; + dSP; + + gps = (GaimPerlScript *)plugin->info->extra_info; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, "Gaim::Plugin"))); + /* XXX This *will* cease working correctly if context gets changed to + * ever be able to hold anything other than a GaimConnection */ + if (context != NULL) + XPUSHs(sv_2mortal(gaim_perl_bless_object(context, "Gaim::Connection"))); + else + XPUSHs(&PL_sv_undef); + PUTBACK; + + count = call_pv(gps->plugin_action_sub, G_ARRAY); - /* TODO: Fix the way we create action handlers so we can have more - * than one action in perl. Maybe there is a clever work around, but - * so far I have not figured it out. There is no way to tie the perl - * sub's name to the callback function without these global variables - * and there is no way to create a callback on the fly so each would - * have to be hardcoded--more than one would just be arbitrary. */ - act = gaim_plugin_action_new(gaim_perl_plugin_action_label, - gaim_perl_plugin_action_cb); - gl = g_list_append(gl, act); + SPAGAIN; + + if (count == 0) + croak("The plugin_actions sub didn't return anything.\n"); + + for (i = 0; i < count; i++) { + SV *sv; + gchar *label; + GaimPluginAction *act = NULL; - return gl; + sv = POPs; + label = SvPV_nolen(sv); + /* XXX I think this leaks, but doing it without the strdup + * just showed garbage */ + act = gaim_plugin_action_new(g_strdup(label), gaim_perl_plugin_action_cb); + l = g_list_append(l, act); + } + + PUTBACK; + FREETMPS; + LEAVE; + + return l; } GtkWidget * diff -r 750968cab201 -r b457aa723bab plugins/perl/perl-handlers.h --- a/plugins/perl/perl-handlers.h Sun Jan 22 07:37:22 2006 +0000 +++ b/plugins/perl/perl-handlers.h Sun Jan 22 10:29:34 2006 +0000 @@ -8,11 +8,6 @@ #include "gtkplugin.h" #include "gtkutils.h" -/* TODO: Find a better way to access the perl names from the plugin prober */ -/* and store them for gaim_perl_plugin_action_* functions. */ -char * gaim_perl_plugin_action_callback_sub; -char * gaim_perl_plugin_action_label; - typedef struct { GaimCmdId id; @@ -43,7 +38,7 @@ } GaimPerlSignalHandler; void gaim_perl_plugin_action_cb(GaimPluginAction * gpa); -GList *gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context); +GList *gaim_perl_plugin_actions(GaimPlugin *plugin, gpointer context); GaimPluginPrefFrame *gaim_perl_get_plugin_frame(GaimPlugin *plugin); diff -r 750968cab201 -r b457aa723bab plugins/perl/perl.c --- a/plugins/perl/perl.c Sun Jan 22 07:37:22 2006 +0000 +++ b/plugins/perl/perl.c Sun Jan 22 10:29:34 2006 +0000 @@ -376,28 +376,12 @@ info->ui_info = >k_ui_info; } - /********************************************************/ - /* */ - /* plugin_action - This is given to the plugin info */ - /* as the action GList. There are two */ - /* parts so the user can set the title */ - /* as it will appear in the plugin */ - /* action menu. The name is extracted */ - /* and then the callback perl sub's */ - /* name both of which then are handled */ - /* by an internal gaim_perl function */ - /* that sets up the single cb function */ - /* which is then inserted into 'info'. */ - /********************************************************/ - if ((key = hv_fetch(plugin_info, "plugin_action_label", - strlen("plugin_action_label"), 0))) { - gaim_perl_plugin_action_label = g_strdup(SvPV(*key, len)); - } - - if ((key = hv_fetch(plugin_info, "plugin_action", - strlen("plugin_action"), 0))) { - gaim_perl_plugin_action_callback_sub = g_strdup_printf("%s::%s", gps->package, SvPV(*key, len)); - info->actions = gaim_perl_plugin_action; + if ((key = hv_fetch(plugin_info, "plugin_action_sub", + strlen("plugin_action_sub"), 0))) { + gps->plugin_action_sub = g_strdup_printf("%s::%s", + gps->package, + SvPV(*key, len)); + info->actions = gaim_perl_plugin_actions; } plugin->info = info; diff -r 750968cab201 -r b457aa723bab plugins/perl/scripts/plugin_action.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/plugins/perl/scripts/plugin_action.pl Sun Jan 22 10:29:34 2006 +0000 @@ -0,0 +1,58 @@ +$MODULE_NAME = "Plugin Action Test Plugin"; +use Gaim; + +sub plugin_init { + return %PLUGIN_INFO; +} + +sub plugin_load { + my $plugin = shift; +} + +sub plugin_unload { + my $plugin = shift; +} + +sub fun1 { + print "1\n"; +} + +sub fun2 { + print "2\n"; +} + +sub fun3 { + print "3\n"; +} + +%plugin_actions = ( + "Action 1" => \&fun1, + "Action 2" => \&fun2, + "Action 3" => \&fun3 +# "Action 1" => sub { print "1\n"; }, +# "Action 2" => sub { print "2\n"; }, +# "Action 3" => sub { print "3\n"; } +); + +sub plugin_action_names { + foreach $key (keys %plugin_actions) { + push @array, $key; + } + + return @array; +} + +# All the information Gaim gets about our nifty plugin +%PLUGIN_INFO = ( + perl_api_version => 2, + name => "Perl: $MODULE_NAME", + version => "0.1", + summary => "Test plugin for the Perl interpreter.", + description => "Just a basic test plugin template.", + author => "Etan Reisner ", + url => "http://sourceforge.net/users/deryni9/", + + load => "plugin_load", + unload => "plugin_unload", + plugin_action_sub => "plugin_action_names" +);