comparison: plugins/perl/perl-handlers.c
plugins/perl/perl-handlers.c
- changeset 12988
- 2a53945982f5
- parent 12882
- 44dfc6467081
- child 13017
- d3bcadbf3094
equal
deleted
inserted
replaced
| 12987:b451eafc33bc | 12988:2a53945982f5 |
|---|---|
| 12 /* perl < 5.8.0 doesn't define PERL_MAGIC_ext */ | 12 /* perl < 5.8.0 doesn't define PERL_MAGIC_ext */ |
| 13 #ifndef PERL_MAGIC_ext | 13 #ifndef PERL_MAGIC_ext |
| 14 #define PERL_MAGIC_ext '~' | 14 #define PERL_MAGIC_ext '~' |
| 15 #endif | 15 #endif |
| 16 | 16 |
| 17 /* For now a plugin can only have one action */ | 17 void |
| 18 void | 18 gaim_perl_plugin_action_cb(GaimPluginAction *action) |
| 19 gaim_perl_plugin_action_cb(GaimPluginAction * gpa) | 19 { |
| 20 { | 20 SV **callback; |
| 21 HV *hv = NULL; | |
| 22 gchar *hvname; | |
| 23 GaimPlugin *plugin; | |
| 24 GaimPerlScript *gps; | |
| 21 dSP; | 25 dSP; |
| 26 | |
| 27 plugin = action->plugin; | |
| 28 gps = (GaimPerlScript *)plugin->info->extra_info; | |
| 29 hvname = g_strdup_printf("%s::plugin_actions", gps->package); | |
| 30 hv = get_hv(hvname, FALSE); | |
| 31 g_free(hvname); | |
| 32 | |
| 33 if (hv == NULL) | |
| 34 croak("No plugin_actions hash found in \"%s\" plugin.", gaim_plugin_get_name(plugin)); | |
| 35 | |
| 22 ENTER; | 36 ENTER; |
| 23 SAVETMPS; | 37 SAVETMPS; |
| 38 | |
| 39 callback = hv_fetch(hv, action->label, strlen(action->label), 0); | |
| 40 | |
| 41 if (callback == NULL || *callback == NULL) | |
| 42 croak("No plugin_action function named \"%s\" in \"%s\" plugin.", action->label, gaim_plugin_get_name(plugin)); | |
| 43 | |
| 24 PUSHMARK(sp); | 44 PUSHMARK(sp); |
| 25 | 45 XPUSHs(gaim_perl_bless_object(gps->plugin, "Gaim::Plugin")); |
| 26 /* We put the plugin handle on the stack so it can pass it along */ | 46 PUTBACK; |
| 27 /* to anything called from the callback. It is supposed to pass */ | 47 |
| 28 /* the Action, but there is no way to access the plugin handle from */ | 48 call_sv(*callback, G_VOID | G_DISCARD); |
| 29 /* the GaimPluginAction in perl...yet. */ | |
| 30 | |
| 31 XPUSHs(gaim_perl_bless_object(gpa->plugin, "Gaim::Plugin")); | |
| 32 PUTBACK; | |
| 33 | |
| 34 /* gaim_perl_plugin_action_callback_sub defined in the header is set | |
| 35 * in perl.c during plugin probe by a PLUGIN_INFO hash value limiting | |
| 36 * us to only one action for right now even though the action member | |
| 37 * of GaimPluginInfo can take (does take) a GList. */ | |
| 38 call_pv(gaim_perl_plugin_action_callback_sub, G_EVAL | G_SCALAR); | |
| 39 SPAGAIN; | 49 SPAGAIN; |
| 40 | 50 |
| 41 PUTBACK; | 51 PUTBACK; |
| 42 FREETMPS; | 52 FREETMPS; |
| 43 LEAVE; | 53 LEAVE; |
| 44 } | 54 } |
| 45 | 55 |
| 46 GList * | 56 GList * |
| 47 gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context) | 57 gaim_perl_plugin_actions(GaimPlugin *plugin, gpointer context) |
| 48 { | 58 { |
| 49 GaimPluginAction *act = NULL; | 59 GList *l = NULL; |
| 50 GList *gl = NULL; | 60 GaimPerlScript *gps; |
| 51 | 61 int i = 0, count = 0; |
| 52 /* TODO: Fix the way we create action handlers so we can have more | 62 dSP; |
| 53 * than one action in perl. Maybe there is a clever work around, but | 63 |
| 54 * so far I have not figured it out. There is no way to tie the perl | 64 gps = (GaimPerlScript *)plugin->info->extra_info; |
| 55 * sub's name to the callback function without these global variables | 65 |
| 56 * and there is no way to create a callback on the fly so each would | 66 ENTER; |
| 57 * have to be hardcoded--more than one would just be arbitrary. */ | 67 SAVETMPS; |
| 58 act = gaim_plugin_action_new(gaim_perl_plugin_action_label, | 68 |
| 59 gaim_perl_plugin_action_cb); | 69 PUSHMARK(SP); |
| 60 gl = g_list_append(gl, act); | 70 XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, "Gaim::Plugin"))); |
| 61 | 71 /* XXX This *will* cease working correctly if context gets changed to |
| 62 return gl; | 72 * ever be able to hold anything other than a GaimConnection */ |
| 73 if (context != NULL) | |
| 74 XPUSHs(sv_2mortal(gaim_perl_bless_object(context, "Gaim::Connection"))); | |
| 75 else | |
| 76 XPUSHs(&PL_sv_undef); | |
| 77 PUTBACK; | |
| 78 | |
| 79 count = call_pv(gps->plugin_action_sub, G_ARRAY); | |
| 80 | |
| 81 SPAGAIN; | |
| 82 | |
| 83 if (count == 0) | |
| 84 croak("The plugin_actions sub didn't return anything.\n"); | |
| 85 | |
| 86 for (i = 0; i < count; i++) { | |
| 87 SV *sv; | |
| 88 gchar *label; | |
| 89 GaimPluginAction *act = NULL; | |
| 90 | |
| 91 sv = POPs; | |
| 92 label = SvPV_nolen(sv); | |
| 93 /* XXX I think this leaks, but doing it without the strdup | |
| 94 * just showed garbage */ | |
| 95 act = gaim_plugin_action_new(g_strdup(label), gaim_perl_plugin_action_cb); | |
| 96 l = g_list_append(l, act); | |
| 97 } | |
| 98 | |
| 99 PUTBACK; | |
| 100 FREETMPS; | |
| 101 LEAVE; | |
| 102 | |
| 103 return l; | |
| 63 } | 104 } |
| 64 | 105 |
| 65 GtkWidget * | 106 GtkWidget * |
| 66 gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin) | 107 gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin) |
| 67 { | 108 { |
