14192
|
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 }
|
14453
|
227 break;
|
14192
|
228 case GAIM_TYPE_INT64:
|
|
229 case GAIM_TYPE_UINT64:
|
|
230 /* Tcl < 8.4 doesn't have wide ints, so we have ugly
|
|
231 * ifdefs in here */
|
|
232 if (gaim_value_is_outgoing(handler->argtypes[i])) {
|
|
233 vals[i] = (void *)va_arg(args, gint64 *);
|
|
234 #if (TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 4)
|
|
235 Tcl_LinkVar(handler->interp, name->str,
|
|
236 vals[i], TCL_LINK_WIDE_INT);
|
|
237 #else
|
|
238 /* This is going to cause weirdness at best,
|
|
239 * but what do you want ... we're losing
|
|
240 * precision */
|
|
241 Tcl_LinkVar(handler->interp, name->str,
|
|
242 vals[i], TCL_LINK_INT);
|
|
243 #endif /* Tcl >= 8.4 */
|
|
244 arg = Tcl_NewStringObj(name->str, -1);
|
|
245 } else {
|
|
246 #if (TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 4)
|
|
247 arg = Tcl_NewWideIntObj(va_arg(args, gint64));
|
|
248 #else
|
|
249 arg = Tcl_NewIntObj((int)va_arg(args, int));
|
|
250 #endif /* Tcl >= 8.4 */
|
|
251 }
|
|
252 break;
|
|
253 case GAIM_TYPE_STRING:
|
|
254 if (gaim_value_is_outgoing(handler->argtypes[i])) {
|
|
255 strs[i] = va_arg(args, char **);
|
|
256 if (strs[i] == NULL || *strs[i] == NULL) {
|
|
257 vals[i] = ckalloc(1);
|
|
258 *(char *)vals[i] = '\0';
|
|
259 } else {
|
|
260 vals[i] = ckalloc(strlen(*strs[i]) + 1);
|
|
261 strcpy(vals[i], *strs[i]);
|
|
262 }
|
|
263 Tcl_LinkVar(handler->interp, name->str,
|
|
264 (char *)&vals[i], TCL_LINK_STRING);
|
|
265 arg = Tcl_NewStringObj(name->str, -1);
|
|
266 } else {
|
|
267 arg = Tcl_NewStringObj(va_arg(args, char *), -1);
|
|
268 }
|
|
269 break;
|
|
270 case GAIM_TYPE_SUBTYPE:
|
|
271 switch (gaim_value_get_subtype(handler->argtypes[i])) {
|
|
272 case GAIM_SUBTYPE_UNKNOWN:
|
|
273 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "subtype unknown\n");
|
|
274 case GAIM_SUBTYPE_ACCOUNT:
|
|
275 case GAIM_SUBTYPE_CONNECTION:
|
|
276 case GAIM_SUBTYPE_CONVERSATION:
|
|
277 case GAIM_SUBTYPE_STATUS:
|
|
278 case GAIM_SUBTYPE_PLUGIN:
|
|
279 case GAIM_SUBTYPE_XFER:
|
|
280 if (gaim_value_is_outgoing(handler->argtypes[i]))
|
|
281 gaim_debug_error("tcl", "pointer subtypes do not currently support outgoing arguments\n");
|
|
282 arg = gaim_tcl_ref_new(ref_type(gaim_value_get_subtype(handler->argtypes[i])), va_arg(args, void *));
|
|
283 break;
|
|
284 case GAIM_SUBTYPE_BLIST:
|
|
285 case GAIM_SUBTYPE_BLIST_BUDDY:
|
|
286 case GAIM_SUBTYPE_BLIST_GROUP:
|
|
287 case GAIM_SUBTYPE_BLIST_CHAT:
|
|
288 /* We're going to switch again for code-deduping */
|
|
289 if (gaim_value_is_outgoing(handler->argtypes[i]))
|
|
290 node = *va_arg(args, GaimBlistNode **);
|
|
291 else
|
|
292 node = va_arg(args, GaimBlistNode *);
|
|
293 switch (node->type) {
|
|
294 case GAIM_BLIST_GROUP_NODE:
|
|
295 arg = Tcl_NewListObj(0, NULL);
|
|
296 Tcl_ListObjAppendElement(handler->interp, arg,
|
|
297 Tcl_NewStringObj("group", -1));
|
|
298 Tcl_ListObjAppendElement(handler->interp, arg,
|
|
299 Tcl_NewStringObj(((GaimGroup *)node)->name, -1));
|
|
300 break;
|
|
301 case GAIM_BLIST_CONTACT_NODE:
|
|
302 /* g_string_printf(val, "contact {%s}", Contact Name? ); */
|
|
303 arg = Tcl_NewStringObj("contact", -1);
|
|
304 break;
|
|
305 case GAIM_BLIST_BUDDY_NODE:
|
|
306 arg = Tcl_NewListObj(0, NULL);
|
|
307 Tcl_ListObjAppendElement(handler->interp, arg,
|
|
308 Tcl_NewStringObj("buddy", -1));
|
|
309 Tcl_ListObjAppendElement(handler->interp, arg,
|
|
310 Tcl_NewStringObj(((GaimBuddy *)node)->name, -1));
|
|
311 Tcl_ListObjAppendElement(handler->interp, arg,
|
|
312 gaim_tcl_ref_new(GaimTclRefAccount,
|
|
313 ((GaimBuddy *)node)->account));
|
|
314 break;
|
|
315 case GAIM_BLIST_CHAT_NODE:
|
|
316 arg = Tcl_NewListObj(0, NULL);
|
|
317 Tcl_ListObjAppendElement(handler->interp, arg,
|
|
318 Tcl_NewStringObj("chat", -1));
|
|
319 Tcl_ListObjAppendElement(handler->interp, arg,
|
|
320 Tcl_NewStringObj(((GaimChat *)node)->alias, -1));
|
|
321 Tcl_ListObjAppendElement(handler->interp, arg,
|
|
322 gaim_tcl_ref_new(GaimTclRefAccount,
|
|
323 ((GaimChat *)node)->account));
|
|
324 break;
|
|
325 case GAIM_BLIST_OTHER_NODE:
|
|
326 arg = Tcl_NewStringObj("other", -1);
|
|
327 break;
|
|
328 }
|
|
329 break;
|
|
330 }
|
|
331 }
|
|
332 Tcl_ListObjAppendElement(handler->interp, cmd, arg);
|
|
333 }
|
|
334
|
|
335 /* Call the friggin' procedure already */
|
|
336 if ((error = Tcl_EvalObjEx(handler->interp, cmd, TCL_EVAL_GLOBAL)) != TCL_OK) {
|
|
337 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "error evaluating callback: %s\n",
|
|
338 Tcl_GetString(Tcl_GetObjResult(handler->interp)));
|
|
339 } else {
|
|
340 result = Tcl_GetObjResult(handler->interp);
|
|
341 /* handle return values -- strings and words only */
|
|
342 if (handler->returntype) {
|
|
343 if (gaim_value_get_type(handler->returntype) == GAIM_TYPE_STRING) {
|
|
344 retval = (void *)g_strdup(Tcl_GetString(result));
|
|
345 } else {
|
|
346 if ((error = Tcl_GetIntFromObj(handler->interp, result, (int *)&retval)) != TCL_OK) {
|
|
347 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Error retrieving procedure result: %s\n",
|
|
348 Tcl_GetString(Tcl_GetObjResult(handler->interp)));
|
|
349 retval = NULL;
|
|
350 }
|
|
351 }
|
|
352 }
|
|
353 }
|
|
354
|
|
355 /* And finally clean up */
|
|
356 for (i = 0; i < handler->nargs; i++) {
|
|
357 g_string_printf(name, "%s::arg%d",
|
|
358 Tcl_GetString(handler->namespace), i);
|
|
359 if (gaim_value_is_outgoing(handler->argtypes[i])
|
|
360 && gaim_value_get_type(handler->argtypes[i]) != GAIM_TYPE_SUBTYPE)
|
|
361 Tcl_UnlinkVar(handler->interp, name->str);
|
|
362
|
|
363 /* We basically only have to deal with strings on the
|
|
364 * way out */
|
|
365 switch (gaim_value_get_type(handler->argtypes[i])) {
|
|
366 case GAIM_TYPE_STRING:
|
|
367 if (gaim_value_is_outgoing(handler->argtypes[i])) {
|
|
368 if (vals[i] != NULL && *(char **)vals[i] != NULL) {
|
|
369 g_free(*strs[i]);
|
|
370 *strs[i] = g_strdup(vals[i]);
|
|
371 }
|
|
372 ckfree(vals[i]);
|
|
373 }
|
|
374 break;
|
|
375 default:
|
|
376 /* nothing */
|
|
377 ;
|
|
378 }
|
|
379 }
|
|
380
|
|
381 g_string_free(name, TRUE);
|
|
382 g_string_free(val, TRUE);
|
|
383 g_free(vals);
|
|
384 g_free(strs);
|
|
385
|
|
386 return retval;
|
|
387 }
|
|
388
|
|
389 static Tcl_Obj *new_cb_namespace ()
|
|
390 {
|
|
391 static int cbnum;
|
|
392 char name[32];
|
|
393
|
|
394 g_snprintf (name, sizeof(name), "::gaim::_callback::cb_%d", cbnum++);
|
|
395 return Tcl_NewStringObj (name, -1);
|
|
396 }
|