comparison plugins/perl/perl-handlers.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 f8e22fef03fc
comparison
equal deleted inserted replaced
11169:778d5464a9b8 11170:0e9e2b923d09
1 #include "perl-common.h" 1 #include "perl-common.h"
2 #include "perl-handlers.h" 2 #include "perl-handlers.h"
3 3
4 #include "debug.h" 4 #include "debug.h"
5 #include "signals.h" 5 #include "signals.h"
6
6 7
7 static GList *timeout_handlers = NULL; 8 static GList *timeout_handlers = NULL;
8 static GList *signal_handlers = NULL; 9 static GList *signal_handlers = NULL;
9 static char *perl_plugin_pref_cb; 10 static char *perl_plugin_pref_cb;
11 static char *perl_gtk_plugin_pref_cb;
10 extern PerlInterpreter *my_perl; 12 extern PerlInterpreter *my_perl;
13
14 /* For now a plugin can only have one action */
15 void gaim_perl_plugin_action_cb(GaimPluginAction * gpa) {
16
17 dSP;
18 ENTER;
19 SAVETMPS;
20 PUSHMARK(sp);
21
22 /* We put the plugin handle on the stack so it can pass it along */
23 /* to anythng called from the callback. It is supposed to pass */
24 /* the Action, but there is no way to access the plugin handle from */
25 /* the GaimPluginAction in perl...yet. */
26
27 XPUSHs(gaim_perl_bless_object(gpa->plugin, "Gaim::Plugin"));
28 PUTBACK;
29
30 /* gaim_perl_plugin_action_callback_sub defined in the header is set */
31 /* in perl.c during plugin probe by a PLUGIN_INFO hash value limiting */
32 /* us to only one action for right now even though the action member of */
33 /* GaimPluginInfo can take (does take) a GList. */
34 call_pv(gaim_perl_plugin_action_callback_sub, G_EVAL | G_SCALAR);
35 SPAGAIN;
36
37 PUTBACK;
38 FREETMPS;
39 LEAVE;
40 }
41
42 GList *gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context) {
43 GaimPluginAction *act = NULL;
44 GList *gl = NULL;
45
46 /* TODO: Fix the way we create action handlers so we can have mroe than */
47 /* one action in perl. Maybe there is a clever work around, but so far */
48 /* I have not figured it out. There is no way to tie the perl sub's */
49 /* name to the callback function without these global variables and */
50 /* there is no way to create a callback on the fly so each would have */
51 /* to be hardcoded--more than one would just be arbitrary. */
52 act = gaim_plugin_action_new(gaim_perl_plugin_action_label, gaim_perl_plugin_action_cb);
53 gl = g_list_append(gl, act);
54
55 return gl;
56 }
57
58
59 GaimGtkPluginUiInfo *gaim_perl_gtk_plugin_pref(const char * frame_cb) {
60
61 GaimGtkPluginUiInfo *ui_info;
62
63 ui_info = g_new0(GaimGtkPluginUiInfo, 1);
64 perl_gtk_plugin_pref_cb = g_strdup(frame_cb);
65 ui_info->get_config_frame = gaim_perl_gtk_get_plugin_frame;
66
67 return ui_info;
68 }
69
70 GtkWidget *gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin) {
71
72 SV * sv;
73 GtkWidget *ret;
74 MAGIC *mg;
75 dSP;
76 int count;
77
78 ENTER;
79 SAVETMPS;
80
81 count = call_pv(perl_gtk_plugin_pref_cb, G_SCALAR | G_NOARGS);
82 if (count != 1)
83 croak("call_pv: Did not return the correct number of values.\n");
84
85 /* the frame was created in a perl sub and is returned */
86 SPAGAIN;
87
88 /* We have a Gtk2::Frame on top of the stack */
89 sv = POPs;
90
91 /* The magic field hides the pointer to the actuale GtkWidget */
92 mg = mg_find(SvRV(sv), PERL_MAGIC_ext);
93 ret = (GtkWidget *)mg->mg_ptr;
94
95 PUTBACK;
96 FREETMPS;
97 LEAVE;
98
99 return ret;
100 }
101
102
11 103
12 104
13 /* Called to create a pointer to GaimPluginUiInfo for the GaimPluginInfo */ 105 /* Called to create a pointer to GaimPluginUiInfo for the GaimPluginInfo */
14 /* It will then inturn create ui_info with the C function pointer */ 106 /* It will then inturn create ui_info with the C function pointer */
15 /* that will eventually do a call_pv to call a perl functions so users */ 107 /* that will eventually do a call_pv to call a perl functions so users */
16 /* can create their own frames in the prefs */ 108 /* can create their own frames in the prefs */
17 GaimPluginUiInfo *gaim_perl_plugin_pref(char * frame_cb) { 109 GaimPluginUiInfo *gaim_perl_plugin_pref(const char * frame_cb) {
18 GaimPluginUiInfo *ui_info; 110 GaimPluginUiInfo *ui_info;
19 111
20 ui_info = g_new0(GaimPluginUiInfo, 1); 112 ui_info = g_new0(GaimPluginUiInfo, 1);
21 113 perl_plugin_pref_cb = g_strdup(frame_cb);
22 perl_plugin_pref_cb = frame_cb;
23
24 ui_info->get_plugin_pref_frame = gaim_perl_get_plugin_frame; 114 ui_info->get_plugin_pref_frame = gaim_perl_get_plugin_frame;
25 115
26 return ui_info; 116 return ui_info;
27 } 117 }
28 118
51 141
52 /* Tidy up the Perl stack */ 142 /* Tidy up the Perl stack */
53 PUTBACK; 143 PUTBACK;
54 FREETMPS; 144 FREETMPS;
55 LEAVE; 145 LEAVE;
56 146
57 return ret_frame; 147 return ret_frame;
58 } 148 }
59 149
60 static void 150 static void
61 destroy_timeout_handler(GaimPerlTimeoutHandler *handler) 151 destroy_timeout_handler(GaimPerlTimeoutHandler *handler)