Mercurial > pidgin.yaz
comparison plugins/perl/perl.c @ 11170:0e9e2b923d09
[gaim-migrate @ 13271]
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.
committer: Tailor Script <tailor@pidgin.im>
author | John H. Kelm <johnkelm@gmail.com> |
---|---|
date | Fri, 29 Jul 2005 13:38:00 +0000 |
parents | 4315bb5f427b |
children | bb0d7b719af2 |
comparison
equal
deleted
inserted
replaced
11169:778d5464a9b8 | 11170:0e9e2b923d09 |
---|---|
100 { | 100 { |
101 GaimPlugin *plugin; | 101 GaimPlugin *plugin; |
102 char *package; | 102 char *package; |
103 char *load_sub; | 103 char *load_sub; |
104 char *unload_sub; | 104 char *unload_sub; |
105 | |
106 } GaimPerlScript; | 105 } GaimPerlScript; |
107 | 106 |
108 | 107 |
109 PerlInterpreter *my_perl = NULL; | 108 PerlInterpreter *my_perl = NULL; |
110 | 109 |
220 (*subaddr)(aTHX_ cv); | 219 (*subaddr)(aTHX_ cv); |
221 | 220 |
222 PUTBACK; | 221 PUTBACK; |
223 } | 222 } |
224 | 223 |
225 static void | |
226 normalize_script_name(char *name) | |
227 { | |
228 char *c; | |
229 | |
230 c = strrchr(name, '.'); | |
231 | |
232 if (c != NULL) | |
233 *c = '\0'; | |
234 | |
235 for (c = name; *c != '\0'; c++) | |
236 { | |
237 if (*c != '_' && !g_ascii_isalnum(*c)) | |
238 *c = '_'; | |
239 } | |
240 } | |
241 | |
242 static gboolean | 224 static gboolean |
243 probe_perl_plugin(GaimPlugin *plugin) | 225 probe_perl_plugin(GaimPlugin *plugin) |
244 { | 226 { |
245 /* XXX This would be much faster if I didn't create a new | 227 /* XXX This would be much faster if I didn't create a new |
246 * PerlInterpreter every time I probed a plugin */ | 228 * PerlInterpreter every time I probed a plugin */ |
299 PERL_PLUGIN_ID); | 281 PERL_PLUGIN_ID); |
300 | 282 |
301 gps->plugin = plugin; | 283 gps->plugin = plugin; |
302 | 284 |
303 basename = g_path_get_basename(plugin->path); | 285 basename = g_path_get_basename(plugin->path); |
304 normalize_script_name(basename); | 286 gaim_perl_normalize_script_name(basename); |
305 gps->package = g_strdup_printf("Gaim::Script::%s", basename); | 287 gps->package = g_strdup_printf("Gaim::Script::%s", basename); |
306 g_free(basename); | 288 g_free(basename); |
307 | 289 |
308 /* We know this one exists. */ | 290 /* We know this one exists. */ |
309 key = hv_fetch(plugin_info, "name", strlen("name"), 0); | 291 key = hv_fetch(plugin_info, "name", strlen("name"), 0); |
310 info->name = g_strdup(SvPV(*key, len)); | 292 info->name = g_strdup(SvPV(*key, len)); |
311 | 293 |
294 if ((key = hv_fetch(plugin_info, "GTK_UI", strlen("GTK_UI"), 0))) | |
295 info->ui_requirement = GAIM_GTK_PLUGIN_TYPE; | |
296 | |
312 if ((key = hv_fetch(plugin_info, "url", strlen("url"), 0))) | 297 if ((key = hv_fetch(plugin_info, "url", strlen("url"), 0))) |
313 info->homepage = g_strdup(SvPV(*key, len)); | 298 info->homepage = g_strdup(SvPV(*key, len)); |
314 | 299 |
315 if ((key = hv_fetch(plugin_info, "author", strlen("author"), 0))) | 300 if ((key = hv_fetch(plugin_info, "author", strlen("author"), 0))) |
316 info->author = g_strdup(SvPV(*key, len)); | 301 info->author = g_strdup(SvPV(*key, len)); |
317 | 302 |
318 if ((key = hv_fetch(plugin_info, "summary", | 303 if ((key = hv_fetch(plugin_info, "summary", |
319 strlen("summary"), 0))) | 304 strlen("summary"), 0))) |
332 | 317 |
333 if ((key = hv_fetch(plugin_info, "unload", strlen("unload"), 0))) | 318 if ((key = hv_fetch(plugin_info, "unload", strlen("unload"), 0))) |
334 gps->unload_sub = g_strdup_printf("%s::%s", gps->package, | 319 gps->unload_sub = g_strdup_printf("%s::%s", gps->package, |
335 SvPV(*key, len)); | 320 SvPV(*key, len)); |
336 | 321 |
322 /********************************************************/ | |
323 /* Only one of the next two options should be present */ | |
324 /* */ | |
325 /* prefs_info - Uses non-GUI (read GTK) gaim API calls */ | |
326 /* and creates a GaimPluginPrefInfo type. */ | |
327 /* */ | |
328 /* gtk_prefs_info - Requires gtk2-perl be installed by */ | |
329 /* the user and he must create a GtkWidget */ | |
330 /* representing the plugin preferences */ | |
331 /* page. */ | |
332 /********************************************************/ | |
337 if ((key = hv_fetch(plugin_info, "prefs_info", strlen("prefs_info"), 0))) { | 333 if ((key = hv_fetch(plugin_info, "prefs_info", strlen("prefs_info"), 0))) { |
338 /* key now is the name of the Perl sub that will create a frame for us */ | 334 /* key now is the name of the Perl sub that will create a frame for us */ |
339 info->prefs_info = gaim_perl_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len))); | 335 info->prefs_info = gaim_perl_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len))); |
340 } | 336 } |
337 | |
338 if ((key = hv_fetch(plugin_info, "gtk_prefs_info", strlen("gtk_prefs_info"), 0))) { | |
339 /* key now is the name of the Perl sub that will create a frame for us */ | |
340 info->ui_info = gaim_perl_gtk_plugin_pref(g_strdup_printf("%s::%s", gps->package, SvPV(*key, len))); | |
341 } | |
342 | |
343 /********************************************************/ | |
344 /* */ | |
345 /* plugin_action - This is given to the plugin info */ | |
346 /* as the action GList. There are two parts */ | |
347 /* so the user can set the title as it will appear */ | |
348 /* in the plugin action menu. The name is */ | |
349 /* extracted and then the callback perl sub's name */ | |
350 /* both of which then are handled by an internal */ | |
351 /* gaim_perl function that sets up the single cb */ | |
352 /* function which is then inserted into 'info'. */ | |
353 /********************************************************/ | |
354 if ((key = hv_fetch(plugin_info, "plugin_action_label", strlen("plugin_action_label"), 0))) { | |
355 gaim_perl_plugin_action_label = g_strdup(SvPV(*key, len)); | |
356 } | |
357 | |
358 if ((key = hv_fetch(plugin_info, "plugin_action", strlen("plugin_action"), 0))) { | |
359 gaim_perl_plugin_action_callback_sub = g_strdup_printf("%s::%s", gps->package, SvPV(*key, len)); | |
360 info->actions = gaim_perl_plugin_action; | |
361 } | |
341 | 362 |
342 plugin->info = info; | 363 plugin->info = info; |
343 info->extra_info = gps; | 364 info->extra_info = gps; |
344 | 365 |
345 status = gaim_plugin_register(plugin); | 366 status = gaim_plugin_register(plugin); |
346 } | 367 } |
347 } | 368 } |
348 | 369 |
349 perl_destruct(prober); | 370 perl_destruct(prober); |
350 perl_free(prober); | 371 perl_free(prober); |
351 | 372 |
352 return status; | 373 return status; |
353 } | 374 } |