Mercurial > pidgin3 / file comparison

comparison: plugins/tcl/tcl_signals.c

plugins/tcl/tcl_signals.c

changeset 14253
b63ebf84c42b
parent 14252
d10dda2777a9
child 14254
77edc7a6191a
equal deleted inserted replaced
14252:d10dda2777a9 14253:b63ebf84c42b
1 /**
2 * @file tcl_signals.c Gaim Tcl signal API
3 *
4 * gaim
5 *
6 * Copyright (C) 2003 Ethan Blanton <eblanton@cs.purdue.edu>
7 *
8 * This program is free software; you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation; either version 2 of the License, or
11 * (at your option) any later version.
12 *
13 * This program is distributed in the hope that it will be useful,
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 * GNU General Public License for more details.
17 *
18 * You should have received a copy of the GNU General Public License
19 * along with this program; if not, write to the Free Software
20 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 */
22 #include <tcl.h>
23 #include <stdarg.h>
24
25 #include "tcl_gaim.h"
26
27 #include "internal.h"
28 #include "connection.h"
29 #include "conversation.h"
30 #include "signals.h"
31 #include "debug.h"
32 #include "value.h"
33 #include "core.h"
34
35 static GList *tcl_callbacks;
36
37 static void *tcl_signal_callback(va_list args, struct tcl_signal_handler *handler);
38 static Tcl_Obj *new_cb_namespace (void);
39
40 void tcl_signal_init()
41 {
42 tcl_callbacks = NULL;
43 }
44
45 void tcl_signal_handler_free(struct tcl_signal_handler *handler)
46 {
47 if (handler == NULL)
48 return;
49
50 Tcl_DecrRefCount(handler->signal);
51 if (handler->namespace)
52 Tcl_DecrRefCount(handler->namespace);
53 g_free(handler);
54 }
55
56 void tcl_signal_cleanup(Tcl_Interp *interp)
57 {
58 GList *cur;
59 struct tcl_signal_handler *handler;
60
61 for (cur = tcl_callbacks; cur != NULL; cur = g_list_next(cur)) {
62 handler = cur->data;
63 if (handler->interp == interp) {
64 tcl_signal_handler_free(handler);
65 cur->data = NULL;
66 }
67 }
68 tcl_callbacks = g_list_remove_all(tcl_callbacks, NULL);
69 }
70
71 gboolean tcl_signal_connect(struct tcl_signal_handler *handler)
72 {
73 GString *proc;
74
75 gaim_signal_get_values(handler->instance,
76 Tcl_GetString(handler->signal),
77 &handler->returntype, &handler->nargs,
78 &handler->argtypes);
79
80 tcl_signal_disconnect(handler->interp, Tcl_GetString(handler->signal),
81 handler->interp);
82
83 if (!gaim_signal_connect_vargs(handler->instance,
84 Tcl_GetString(handler->signal),
85 (void *)handler->interp,
86 GAIM_CALLBACK(tcl_signal_callback),
87 (void *)handler))
88 return FALSE;
89
90 handler->namespace = new_cb_namespace ();
91 Tcl_IncrRefCount(handler->namespace);
92 proc = g_string_new("");
93 g_string_append_printf(proc, "namespace eval %s { proc cb { %s } { %s } }",
94 Tcl_GetString(handler->namespace),
95 Tcl_GetString(handler->args),
96 Tcl_GetString(handler->proc));
97 if (Tcl_Eval(handler->interp, proc->str) != TCL_OK) {
98 Tcl_DecrRefCount(handler->namespace);
99 g_string_free(proc, TRUE);
100 return FALSE;
101 }
102 g_string_free(proc, TRUE);
103
104 tcl_callbacks = g_list_append(tcl_callbacks, (gpointer)handler);
105
106 return TRUE;
107 }
108
109 void tcl_signal_disconnect(void *instance, const char *signal, Tcl_Interp *interp)
110 {
111 GList *cur;
112 struct tcl_signal_handler *handler;
113 gboolean found = FALSE;
114 GString *cmd;
115
116 for (cur = tcl_callbacks; cur != NULL; cur = g_list_next(cur)) {
117 handler = cur->data;
118 if (handler->interp == interp && handler->instance == instance
119 && !strcmp(signal, Tcl_GetString(handler->signal))) {
120 gaim_signal_disconnect(instance, signal, handler->interp,
121 GAIM_CALLBACK(tcl_signal_callback));
122 cmd = g_string_sized_new(64);
123 g_string_printf(cmd, "namespace delete %s",
124 Tcl_GetString(handler->namespace));
125 Tcl_EvalEx(interp, cmd->str, -1, TCL_EVAL_GLOBAL);
126 tcl_signal_handler_free(handler);
127 g_string_free(cmd, TRUE);
128 cur->data = NULL;
129 found = TRUE;
130 break;
131 }
132 }
133 if (found)
134 tcl_callbacks = g_list_remove_all(tcl_callbacks, NULL);
135 }
136
137 static GaimStringref *ref_type(GaimSubType type)
138 {
139 switch (type) {
140 case GAIM_SUBTYPE_ACCOUNT:
141 return GaimTclRefAccount;
142 case GAIM_SUBTYPE_CONNECTION:
143 return GaimTclRefConnection;
144 case GAIM_SUBTYPE_CONVERSATION:
145 return GaimTclRefConversation;
146 case GAIM_SUBTYPE_PLUGIN:
147 return GaimTclRefPlugin;
148 case GAIM_SUBTYPE_STATUS:
149 return GaimTclRefStatus;
150 case GAIM_SUBTYPE_XFER:
151 return GaimTclRefXfer;
152 default:
153 return NULL;
154 }
155 }
156
157 static void *tcl_signal_callback(va_list args, struct tcl_signal_handler *handler)
158 {
159 GString *name, *val;
160 GaimBlistNode *node;
161 int error, i;
162 void *retval = NULL;
163 Tcl_Obj *cmd, *arg, *result;
164 void **vals; /* Used for inout parameters */
165 char ***strs;
166
167 vals = g_new0(void *, handler->nargs);
168 strs = g_new0(char **, handler->nargs);
169 name = g_string_sized_new(32);
170 val = g_string_sized_new(32);
171
172 cmd = Tcl_NewListObj(0, NULL);
173 Tcl_IncrRefCount(cmd);
174
175 arg = Tcl_DuplicateObj(handler->namespace);
176 Tcl_AppendStringsToObj(arg, "::cb", NULL);
177 Tcl_ListObjAppendElement(handler->interp, cmd, arg);
178
179 for (i = 0; i < handler->nargs; i++) {
180 if (gaim_value_is_outgoing(handler->argtypes[i]))
181 g_string_printf(name, "%s::arg%d",
182 Tcl_GetString(handler->namespace), i);
183
184 switch(gaim_value_get_type(handler->argtypes[i])) {
185 case GAIM_TYPE_UNKNOWN: /* What? I guess just pass the word ... */
186 /* treat this as a pointer, but complain first */
187 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "unknown GaimValue type %d\n",
188 gaim_value_get_type(handler->argtypes[i]));
189 case GAIM_TYPE_POINTER:
190 case GAIM_TYPE_OBJECT:
191 case GAIM_TYPE_BOXED:
192 /* These are all "pointer" types to us */
193 if (gaim_value_is_outgoing(handler->argtypes[i]))
194 gaim_debug_error("tcl", "pointer types do not currently support outgoing arguments\n");
195 arg = gaim_tcl_ref_new(GaimTclRefPointer, va_arg(args, void *));
196 break;
197 case GAIM_TYPE_BOOLEAN:
198 if (gaim_value_is_outgoing(handler->argtypes[i])) {
199 vals[i] = va_arg(args, gboolean *);
200 Tcl_LinkVar(handler->interp, name->str,
201 (char *)&vals[i], TCL_LINK_BOOLEAN);
202 arg = Tcl_NewStringObj(name->str, -1);
203 } else {
204 arg = Tcl_NewBooleanObj(va_arg(args, gboolean));
205 }
206 break;
207 case GAIM_TYPE_CHAR:
208 case GAIM_TYPE_UCHAR:
209 case GAIM_TYPE_SHORT:
210 case GAIM_TYPE_USHORT:
211 case GAIM_TYPE_INT:
212 case GAIM_TYPE_UINT:
213 case GAIM_TYPE_LONG:
214 case GAIM_TYPE_ULONG:
215 case GAIM_TYPE_ENUM:
216 /* I should really cast these individually to
217 * preserve as much information as possible ...
218 * but heh */
219 if (gaim_value_is_outgoing(handler->argtypes[i])) {
220 vals[i] = va_arg(args, int *);
221 Tcl_LinkVar(handler->interp, name->str,
222 vals[i], TCL_LINK_INT);
223 arg = Tcl_NewStringObj(name->str, -1);
224 } else {
225 arg = Tcl_NewIntObj(va_arg(args, int));
226 }
227 case GAIM_TYPE_INT64:
228 case GAIM_TYPE_UINT64:
229 /* Tcl < 8.4 doesn't have wide ints, so we have ugly
230 * ifdefs in here */
231 if (gaim_value_is_outgoing(handler->argtypes[i])) {
232 vals[i] = (void *)va_arg(args, gint64 *);
233 #if (TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 4)
234 Tcl_LinkVar(handler->interp, name->str,
235 vals[i], TCL_LINK_WIDE_INT);
236 #else
237 /* This is going to cause weirdness at best,
238 * but what do you want ... we're losing
239 * precision */
240 Tcl_LinkVar(handler->interp, name->str,
241 vals[i], TCL_LINK_INT);
242 #endif /* Tcl >= 8.4 */
243 arg = Tcl_NewStringObj(name->str, -1);
244 } else {
245 #if (TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 4)
246 arg = Tcl_NewWideIntObj(va_arg(args, gint64));
247 #else
248 arg = Tcl_NewIntObj((int)va_arg(args, int));
249 #endif /* Tcl >= 8.4 */
250 }
251 break;
252 case GAIM_TYPE_STRING:
253 if (gaim_value_is_outgoing(handler->argtypes[i])) {
254 strs[i] = va_arg(args, char **);
255 if (strs[i] == NULL || *strs[i] == NULL) {
256 vals[i] = ckalloc(1);
257 *(char *)vals[i] = '\0';
258 } else {
259 vals[i] = ckalloc(strlen(*strs[i]) + 1);
260 strcpy(vals[i], *strs[i]);
261 }
262 Tcl_LinkVar(handler->interp, name->str,
263 (char *)&vals[i], TCL_LINK_STRING);
264 arg = Tcl_NewStringObj(name->str, -1);
265 } else {
266 arg = Tcl_NewStringObj(va_arg(args, char *), -1);
267 }
268 break;
269 case GAIM_TYPE_SUBTYPE:
270 switch (gaim_value_get_subtype(handler->argtypes[i])) {
271 case GAIM_SUBTYPE_UNKNOWN:
272 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "subtype unknown\n");
273 case GAIM_SUBTYPE_ACCOUNT:
274 case GAIM_SUBTYPE_CONNECTION:
275 case GAIM_SUBTYPE_CONVERSATION:
276 case GAIM_SUBTYPE_STATUS:
277 case GAIM_SUBTYPE_PLUGIN:
278 case GAIM_SUBTYPE_XFER:
279 if (gaim_value_is_outgoing(handler->argtypes[i]))
280 gaim_debug_error("tcl", "pointer subtypes do not currently support outgoing arguments\n");
281 arg = gaim_tcl_ref_new(ref_type(gaim_value_get_subtype(handler->argtypes[i])), va_arg(args, void *));
282 break;
283 case GAIM_SUBTYPE_BLIST:
284 case GAIM_SUBTYPE_BLIST_BUDDY:
285 case GAIM_SUBTYPE_BLIST_GROUP:
286 case GAIM_SUBTYPE_BLIST_CHAT:
287 /* We're going to switch again for code-deduping */
288 if (gaim_value_is_outgoing(handler->argtypes[i]))
289 node = *va_arg(args, GaimBlistNode **);
290 else
291 node = va_arg(args, GaimBlistNode *);
292 switch (node->type) {
293 case GAIM_BLIST_GROUP_NODE:
294 arg = Tcl_NewListObj(0, NULL);
295 Tcl_ListObjAppendElement(handler->interp, arg,
296 Tcl_NewStringObj("group", -1));
297 Tcl_ListObjAppendElement(handler->interp, arg,
298 Tcl_NewStringObj(((GaimGroup *)node)->name, -1));
299 break;
300 case GAIM_BLIST_CONTACT_NODE:
301 /* g_string_printf(val, "contact {%s}", Contact Name? ); */
302 arg = Tcl_NewStringObj("contact", -1);
303 break;
304 case GAIM_BLIST_BUDDY_NODE:
305 arg = Tcl_NewListObj(0, NULL);
306 Tcl_ListObjAppendElement(handler->interp, arg,
307 Tcl_NewStringObj("buddy", -1));
308 Tcl_ListObjAppendElement(handler->interp, arg,
309 Tcl_NewStringObj(((GaimBuddy *)node)->name, -1));
310 Tcl_ListObjAppendElement(handler->interp, arg,
311 gaim_tcl_ref_new(GaimTclRefAccount,
312 ((GaimBuddy *)node)->account));
313 break;
314 case GAIM_BLIST_CHAT_NODE:
315 arg = Tcl_NewListObj(0, NULL);
316 Tcl_ListObjAppendElement(handler->interp, arg,
317 Tcl_NewStringObj("chat", -1));
318 Tcl_ListObjAppendElement(handler->interp, arg,
319 Tcl_NewStringObj(((GaimChat *)node)->alias, -1));
320 Tcl_ListObjAppendElement(handler->interp, arg,
321 gaim_tcl_ref_new(GaimTclRefAccount,
322 ((GaimChat *)node)->account));
323 break;
324 case GAIM_BLIST_OTHER_NODE:
325 arg = Tcl_NewStringObj("other", -1);
326 break;
327 }
328 break;
329 }
330 }
331 Tcl_ListObjAppendElement(handler->interp, cmd, arg);
332 }
333
334 /* Call the friggin' procedure already */
335 if ((error = Tcl_EvalObjEx(handler->interp, cmd, TCL_EVAL_GLOBAL)) != TCL_OK) {
336 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "error evaluating callback: %s\n",
337 Tcl_GetString(Tcl_GetObjResult(handler->interp)));
338 } else {
339 result = Tcl_GetObjResult(handler->interp);
340 /* handle return values -- strings and words only */
341 if (handler->returntype) {
342 if (gaim_value_get_type(handler->returntype) == GAIM_TYPE_STRING) {
343 retval = (void *)g_strdup(Tcl_GetString(result));
344 } else {
345 if ((error = Tcl_GetIntFromObj(handler->interp, result, (int *)&retval)) != TCL_OK) {
346 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Error retrieving procedure result: %s\n",
347 Tcl_GetString(Tcl_GetObjResult(handler->interp)));
348 retval = NULL;
349 }
350 }
351 }
352 }
353
354 /* And finally clean up */
355 for (i = 0; i < handler->nargs; i++) {
356 g_string_printf(name, "%s::arg%d",
357 Tcl_GetString(handler->namespace), i);
358 if (gaim_value_is_outgoing(handler->argtypes[i])
359 && gaim_value_get_type(handler->argtypes[i]) != GAIM_TYPE_SUBTYPE)
360 Tcl_UnlinkVar(handler->interp, name->str);
361
362 /* We basically only have to deal with strings on the
363 * way out */
364 switch (gaim_value_get_type(handler->argtypes[i])) {
365 case GAIM_TYPE_STRING:
366 if (gaim_value_is_outgoing(handler->argtypes[i])) {
367 if (vals[i] != NULL && *(char **)vals[i] != NULL) {
368 g_free(*strs[i]);
369 *strs[i] = g_strdup(vals[i]);
370 }
371 ckfree(vals[i]);
372 }
373 break;
374 default:
375 /* nothing */
376 ;
377 }
378 }
379
380 g_string_free(name, TRUE);
381 g_string_free(val, TRUE);
382 g_free(vals);
383 g_free(strs);
384
385 return retval;
386 }
387
388 static Tcl_Obj *new_cb_namespace ()
389 {
390 static int cbnum;
391 char name[32];
392
393 g_snprintf (name, sizeof(name), "::gaim::_callback::cb_%d", cbnum++);
394 return Tcl_NewStringObj (name, -1);
395 }

Mercurial Repository: pidgin3

mercurial