Menu
▾
▴
[Gaim-commits] CVS: gaim/plugins/perl perl-common.c,1.13,1.14 perl-common.h,1.7,1.8 perl-handlers.c,1.13,1.14 perl-handlers.h,1.6,1.7 perl.c,1.43,1.44
|
From: John H. K. <joh...@us...> - 2005-07-29 13:38:08
|
Update of /cvsroot/gaim/gaim/plugins/perl In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29453 Modified Files: perl-common.c perl-common.h perl-handlers.c perl-handlers.h perl.c Log Message: Fixed some bugs and made some additions to the XSUBS. Added some of my test scripts which are incomplete, but mostly functional. GaimPluginPrefs and GaimGtkPluginPrefs--using evals to do the Gtk widgets with gtk2-perl--work. Plugin actions can now be added, but only one for now. Index: perl-common.c =================================================================== RCS file: /cvsroot/gaim/gaim/plugins/perl/perl-common.c,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -p -r1.13 -r1.14 --- perl-common.c 21 Apr 2004 01:34:21 -0000 1.13 +++ perl-common.c 29 Jul 2005 13:37:59 -0000 1.14 @@ -7,6 +7,23 @@ extern PerlInterpreter *my_perl; static GHashTable *object_stashes = NULL; +void gaim_perl_normalize_script_name(char *name) +{ + char *c; + + c = strrchr(name, '.'); + + if (c != NULL) + *c = '\0'; + + for (c = name; *c != '\0'; c++) + { + if (*c != '_' && !g_ascii_isalnum(*c)) + *c = '_'; + } +} + + static int magic_free_object(pTHX_ SV *sv, MAGIC *mg) { Index: perl-common.h =================================================================== RCS file: /cvsroot/gaim/gaim/plugins/perl/perl-common.h,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -p -r1.7 -r1.8 --- perl-common.h 24 Sep 2003 00:52:16 -0000 1.7 +++ perl-common.h 29 Jul 2005 13:37:59 -0000 1.8 @@ -23,6 +23,9 @@ gaim_perl_callXS(boot_Gaim__##x, cv, mark); \ } +void gaim_perl_normalize_script_name(char *name); + + SV *newSVGChar(const char *str); void gaim_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark); Index: perl-handlers.c =================================================================== RCS file: /cvsroot/gaim/gaim/plugins/perl/perl-handlers.c,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -p -r1.13 -r1.14 --- perl-handlers.c 18 Jul 2005 16:27:53 -0000 1.13 +++ perl-handlers.c 29 Jul 2005 13:37:59 -0000 1.14 @@ -4,23 +4,113 @@ #include "debug.h" #include "signals.h" + static GList *timeout_handlers = NULL; static GList *signal_handlers = NULL; static char *perl_plugin_pref_cb; +static char *perl_gtk_plugin_pref_cb; extern PerlInterpreter *my_perl; +/* For now a plugin can only have one action */ +void gaim_perl_plugin_action_cb(GaimPluginAction * gpa) { + + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + + /* We put the plugin handle on the stack so it can pass it along */ + /* to anythng 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. */ + + XPUSHs(gaim_perl_bless_object(gpa->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); + SPAGAIN; + + PUTBACK; + FREETMPS; + LEAVE; +} + +GList *gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context) { + GaimPluginAction *act = NULL; + GList *gl = NULL; + + /* TODO: Fix the way we create action handlers so we can have mroe 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); + + return gl; +} + + +GaimGtkPluginUiInfo *gaim_perl_gtk_plugin_pref(const char * frame_cb) { + + GaimGtkPluginUiInfo *ui_info; + + ui_info = g_new0(GaimGtkPluginUiInfo, 1); + perl_gtk_plugin_pref_cb = g_strdup(frame_cb); + ui_info->get_config_frame = gaim_perl_gtk_get_plugin_frame; + + return ui_info; +} + +GtkWidget *gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin) { + + SV * sv; + GtkWidget *ret; + MAGIC *mg; + dSP; + int count; + + ENTER; + SAVETMPS; + + count = call_pv(perl_gtk_plugin_pref_cb, 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; + + /* We have a Gtk2::Frame on top of the stack */ + sv = POPs; + + /* The magic field hides the pointer to the actuale GtkWidget */ + mg = mg_find(SvRV(sv), PERL_MAGIC_ext); + ret = (GtkWidget *)mg->mg_ptr; + + PUTBACK; + FREETMPS; + LEAVE; + + return ret; +} + + + /* Called to create a pointer to GaimPluginUiInfo for the GaimPluginInfo */ /* It will then inturn create ui_info with the C function pointer */ /* that will eventually do a call_pv to call a perl functions so users */ /* can create their own frames in the prefs */ -GaimPluginUiInfo *gaim_perl_plugin_pref(char * frame_cb) { +GaimPluginUiInfo *gaim_perl_plugin_pref(const char * frame_cb) { GaimPluginUiInfo *ui_info; ui_info = g_new0(GaimPluginUiInfo, 1); - - perl_plugin_pref_cb = frame_cb; - + perl_plugin_pref_cb = g_strdup(frame_cb); ui_info->get_plugin_pref_frame = gaim_perl_get_plugin_frame; return ui_info; @@ -53,7 +143,7 @@ GaimPluginPrefFrame *gaim_perl_get_plugi PUTBACK; FREETMPS; LEAVE; - + return ret_frame; } Index: perl-handlers.h =================================================================== RCS file: /cvsroot/gaim/gaim/plugins/perl/perl-handlers.h,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -p -r1.6 -r1.7 --- perl-handlers.h 18 Jul 2005 16:27:53 -0000 1.6 +++ perl-handlers.h 29 Jul 2005 13:37:59 -0000 1.7 @@ -4,6 +4,13 @@ #include "plugin.h" #include "prefs.h" #include "pluginpref.h" +#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 { @@ -24,9 +31,15 @@ typedef struct } GaimPerlSignalHandler; -GaimPluginUiInfo *gaim_perl_plugin_pref(char * frame_cb); +void gaim_perl_plugin_action_cb(GaimPluginAction * gpa); +GList *gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context); + +GaimPluginUiInfo *gaim_perl_plugin_pref(const char * frame_cb); GaimPluginPrefFrame *gaim_perl_get_plugin_frame(GaimPlugin *plugin); +GaimGtkPluginUiInfo *gaim_perl_gtk_plugin_pref(const char * frame_cb); +GtkWidget *gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin); + void gaim_perl_timeout_add(GaimPlugin *plugin, int seconds, SV *callback, SV *data); void gaim_perl_timeout_clear_for_plugin(GaimPlugin *plugin); Index: perl.c =================================================================== RCS file: /cvsroot/gaim/gaim/plugins/perl/perl.c,v retrieving revision 1.43 retrieving revision 1.44 diff -u -d -p -r1.43 -r1.44 --- perl.c 18 Jul 2005 16:27:53 -0000 1.43 +++ perl.c 29 Jul 2005 13:37:59 -0000 1.44 @@ -102,7 +102,6 @@ typedef struct char *package; char *load_sub; char *unload_sub; - } GaimPerlScript; @@ -222,23 +221,6 @@ gaim_perl_callXS(void (*subaddr)(pTHX_ C PUTBACK; } -static void -normalize_script_name(char *name) -{ - char *c; - - c = strrchr(name, '.'); - - if (c != NULL) - *c = '\0'; - - for (c = name; *c != '\0'; c++) - { - if (*c != '_' && !g_ascii_isalnum(*c)) - *c = '_'; - } -} - static gboolean probe_perl_plugin(GaimPlugin *plugin) { @@ -301,7 +283,7 @@ probe_perl_plugin(GaimPlugin *plugin) gps->plugin = plugin; basename = g_path_get_basename(plugin->path); - normalize_script_name(basename); + gaim_perl_normalize_script_name(basename); gps->package = g_strdup_printf("Gaim::Script::%s", basename); g_free(basename); @@ -309,9 +291,12 @@ probe_perl_plugin(GaimPlugin *plugin) key = hv_fetch(plugin_info, "name", strlen("name"), 0); info->name = g_strdup(SvPV(*key, len)); + if ((key = hv_fetch(plugin_info, "GTK_UI", strlen("GTK_UI"), 0))) + info->ui_requirement = GAIM_GTK_PLUGIN_TYPE; + if ((key = hv_fetch(plugin_info, "url", strlen("url"), 0))) info->homepage = g_strdup(SvPV(*key, len)); - + if ((key = hv_fetch(plugin_info, "author", strlen("author"), 0))) info->author = g_strdup(SvPV(*key, len)); @@ -334,10 +319,46 @@ probe_perl_plugin(GaimPlugin *plugin) gps->unload_sub = g_strdup_printf("%s::%s", gps->package, SvPV(*key, len)); + /********************************************************/ + /* Only one of the next two options should be present */ + /* */ + /* prefs_info - Uses non-GUI (read GTK) gaim API calls */ + /* and creates a GaimPluginPrefInfo type. */ + /* */ + /* gtk_prefs_info - Requires gtk2-perl be installed by */ + /* the user and he must create a GtkWidget */ + /* representing the plugin preferences */ + /* page. */ + /********************************************************/ if ((key = hv_fetch(plugin_info, "prefs_info", strlen("prefs_info"), 0))) { /* key now is the name of the Perl sub that will create a frame for us */ info->prefs_info = gaim_perl_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len))); } + + if ((key = hv_fetch(plugin_info, "gtk_prefs_info", strlen("gtk_prefs_info"), 0))) { + /* key now is the name of the Perl sub that will create a frame for us */ + info->ui_info = gaim_perl_gtk_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len))); + } + + /********************************************************/ + /* */ + /* 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; + } plugin->info = info; info->extra_info = gps; @@ -345,7 +366,7 @@ probe_perl_plugin(GaimPlugin *plugin) status = gaim_plugin_register(plugin); } } - + perl_destruct(prober); perl_free(prober); |