Mercurial > pidgin
annotate plugins/tcl/tcl_signals.c @ 13845:d0ff520f87da
[gaim-migrate @ 16301]
This is tcl /cmd support. It doesn't currently let tcl plugins return error
message (I couldn't ever get that to work). But other than that it works.
Ethan please look over this when you get a chance.
committer: Tailor Script <tailor@pidgin.im>
author | Etan Reisner <pidgin@unreliablesource.net> |
---|---|
date | Wed, 21 Jun 2006 04:57:27 +0000 |
parents | ad8ddfa756ad |
children | 4d577b63299a |
rev | line source |
---|---|
6694 | 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); | |
12397
8d1cf3f847b1
[gaim-migrate @ 14704]
Richard Laager <rlaager@wiktel.com>
parents:
10625
diff
changeset
|
38 static Tcl_Obj *new_cb_namespace (void); |
6694 | 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 | |
10597 | 50 Tcl_DecrRefCount(handler->signal); |
13810 | 51 if (handler->namespace) |
52 Tcl_DecrRefCount(handler->namespace); | |
6694 | 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 { | |
10597 | 73 GString *proc; |
74 | |
75 gaim_signal_get_values(handler->instance, | |
76 Tcl_GetString(handler->signal), | |
77 &handler->returntype, &handler->nargs, | |
78 &handler->argtypes); | |
6694 | 79 |
10597 | 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)) | |
6694 | 88 return FALSE; |
89 | |
10597 | 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); | |
6694 | 100 return FALSE; |
10597 | 101 } |
102 g_string_free(proc, TRUE); | |
6694 | 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; | |
10597 | 114 GString *cmd; |
6694 | 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 | |
10597 | 119 && !strcmp(signal, Tcl_GetString(handler->signal))) { |
6694 | 120 gaim_signal_disconnect(instance, signal, handler->interp, |
121 GAIM_CALLBACK(tcl_signal_callback)); | |
10597 | 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); | |
6694 | 126 tcl_signal_handler_free(handler); |
10597 | 127 g_string_free(cmd, TRUE); |
6694 | 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 | |
13815 | 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_STATUS: | |
147 return GaimTclRefStatus; | |
148 default: | |
149 return NULL; | |
150 } | |
151 } | |
152 | |
6694 | 153 static void *tcl_signal_callback(va_list args, struct tcl_signal_handler *handler) |
154 { | |
10597 | 155 GString *name, *val; |
6694 | 156 GaimBlistNode *node; |
157 int error, i; | |
158 void *retval = NULL; | |
10597 | 159 Tcl_Obj *cmd, *arg, *result; |
160 void **vals; /* Used for inout parameters */ | |
161 char ***strs; | |
6694 | 162 |
10597 | 163 vals = g_new0(void *, handler->nargs); |
164 strs = g_new0(char **, handler->nargs); | |
165 name = g_string_sized_new(32); | |
6694 | 166 val = g_string_sized_new(32); |
10597 | 167 |
168 cmd = Tcl_NewListObj(0, NULL); | |
169 Tcl_IncrRefCount(cmd); | |
170 | |
171 arg = Tcl_DuplicateObj(handler->namespace); | |
172 Tcl_AppendStringsToObj(arg, "::cb", NULL); | |
173 Tcl_ListObjAppendElement(handler->interp, cmd, arg); | |
6694 | 174 |
175 for (i = 0; i < handler->nargs; i++) { | |
10597 | 176 if (gaim_value_is_outgoing(handler->argtypes[i])) |
177 g_string_printf(name, "%s::arg%d", | |
178 Tcl_GetString(handler->namespace), i); | |
6694 | 179 |
180 switch(gaim_value_get_type(handler->argtypes[i])) { | |
181 case GAIM_TYPE_UNKNOWN: /* What? I guess just pass the word ... */ | |
182 /* treat this as a pointer, but complain first */ | |
183 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "unknown GaimValue type %d\n", | |
184 gaim_value_get_type(handler->argtypes[i])); | |
185 case GAIM_TYPE_POINTER: | |
186 case GAIM_TYPE_OBJECT: | |
187 case GAIM_TYPE_BOXED: | |
188 /* These are all "pointer" types to us */ | |
13817 | 189 if (gaim_value_is_outgoing(handler->argtypes[i])) |
190 gaim_debug_error("tcl", "pointer types do not currently support outgoing arguments\n"); | |
191 arg = gaim_tcl_ref_new(GaimTclRefPointer, va_arg(args, void *)); | |
6694 | 192 break; |
193 case GAIM_TYPE_BOOLEAN: | |
194 if (gaim_value_is_outgoing(handler->argtypes[i])) { | |
10597 | 195 vals[i] = va_arg(args, gboolean *); |
196 Tcl_LinkVar(handler->interp, name->str, | |
197 (char *)&vals[i], TCL_LINK_BOOLEAN); | |
198 arg = Tcl_NewStringObj(name->str, -1); | |
6694 | 199 } else { |
10597 | 200 arg = Tcl_NewBooleanObj(va_arg(args, gboolean)); |
6694 | 201 } |
202 break; | |
203 case GAIM_TYPE_CHAR: | |
204 case GAIM_TYPE_UCHAR: | |
205 case GAIM_TYPE_SHORT: | |
206 case GAIM_TYPE_USHORT: | |
207 case GAIM_TYPE_INT: | |
208 case GAIM_TYPE_UINT: | |
209 case GAIM_TYPE_LONG: | |
210 case GAIM_TYPE_ULONG: | |
211 case GAIM_TYPE_ENUM: | |
212 /* I should really cast these individually to | |
213 * preserve as much information as possible ... | |
214 * but heh */ | |
215 if (gaim_value_is_outgoing(handler->argtypes[i])) { | |
10597 | 216 vals[i] = va_arg(args, int *); |
217 Tcl_LinkVar(handler->interp, name->str, | |
218 vals[i], TCL_LINK_INT); | |
219 arg = Tcl_NewStringObj(name->str, -1); | |
6694 | 220 } else { |
10597 | 221 arg = Tcl_NewIntObj(va_arg(args, int)); |
222 } | |
223 case GAIM_TYPE_INT64: | |
224 case GAIM_TYPE_UINT64: | |
10625 | 225 /* Tcl < 8.4 doesn't have wide ints, so we have ugly |
226 * ifdefs in here */ | |
10597 | 227 if (gaim_value_is_outgoing(handler->argtypes[i])) { |
10625 | 228 vals[i] = (void *)va_arg(args, gint64 *); |
229 #if (TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 4) | |
10597 | 230 Tcl_LinkVar(handler->interp, name->str, |
231 vals[i], TCL_LINK_WIDE_INT); | |
10625 | 232 #else |
233 /* This is going to cause weirdness at best, | |
234 * but what do you want ... we're losing | |
235 * precision */ | |
236 Tcl_LinkVar(handler->interp, name->str, | |
237 vals[i], TCL_LINK_INT); | |
238 #endif /* Tcl >= 8.4 */ | |
10597 | 239 arg = Tcl_NewStringObj(name->str, -1); |
240 } else { | |
10625 | 241 #if (TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 4) |
242 arg = Tcl_NewWideIntObj(va_arg(args, gint64)); | |
243 #else | |
244 arg = Tcl_NewIntObj((int)va_arg(args, int)); | |
245 #endif /* Tcl >= 8.4 */ | |
6694 | 246 } |
247 break; | |
248 case GAIM_TYPE_STRING: | |
249 if (gaim_value_is_outgoing(handler->argtypes[i])) { | |
10597 | 250 strs[i] = va_arg(args, char **); |
251 if (strs[i] == NULL || *strs[i] == NULL) { | |
252 vals[i] = ckalloc(1); | |
253 *(char *)vals[i] = '\0'; | |
6694 | 254 } else { |
10597 | 255 vals[i] = ckalloc(strlen(*strs[i]) + 1); |
256 strcpy(vals[i], *strs[i]); | |
6694 | 257 } |
10597 | 258 Tcl_LinkVar(handler->interp, name->str, |
259 (char *)&vals[i], TCL_LINK_STRING); | |
260 arg = Tcl_NewStringObj(name->str, -1); | |
6694 | 261 } else { |
10597 | 262 arg = Tcl_NewStringObj(va_arg(args, char *), -1); |
6694 | 263 } |
264 break; | |
265 case GAIM_TYPE_SUBTYPE: | |
266 switch (gaim_value_get_subtype(handler->argtypes[i])) { | |
267 case GAIM_SUBTYPE_UNKNOWN: | |
268 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "subtype unknown\n"); | |
269 case GAIM_SUBTYPE_ACCOUNT: | |
13815 | 270 case GAIM_SUBTYPE_CONNECTION: |
13810 | 271 case GAIM_SUBTYPE_CONVERSATION: |
13815 | 272 case GAIM_SUBTYPE_STATUS: |
13810 | 273 if (gaim_value_is_outgoing(handler->argtypes[i])) |
274 gaim_debug_error("tcl", "pointer subtypes do not currently support outgoing arguments\n"); | |
13815 | 275 arg = gaim_tcl_ref_new(ref_type(gaim_value_get_subtype(handler->argtypes[i])), va_arg(args, void *)); |
13810 | 276 break; |
6694 | 277 case GAIM_SUBTYPE_PLUGIN: |
13219
d0f7f698b6de
[gaim-migrate @ 15583]
Richard Laager <rlaager@wiktel.com>
parents:
12837
diff
changeset
|
278 case GAIM_SUBTYPE_XFER: |
6694 | 279 /* pointers again */ |
280 if (gaim_value_is_outgoing(handler->argtypes[i])) { | |
10597 | 281 vals[i] = va_arg(args, void **); |
282 Tcl_LinkVar(handler->interp, name->str, | |
283 vals[i], TCL_LINK_INT); | |
284 arg = Tcl_NewStringObj(name->str, -1); | |
6694 | 285 } else { |
10597 | 286 arg = Tcl_NewIntObj((int)va_arg(args, void *)); |
6694 | 287 } |
288 break; | |
289 case GAIM_SUBTYPE_BLIST: | |
290 case GAIM_SUBTYPE_BLIST_BUDDY: | |
291 case GAIM_SUBTYPE_BLIST_GROUP: | |
292 case GAIM_SUBTYPE_BLIST_CHAT: | |
293 /* We're going to switch again for code-deduping */ | |
294 if (gaim_value_is_outgoing(handler->argtypes[i])) | |
295 node = *va_arg(args, GaimBlistNode **); | |
296 else | |
297 node = va_arg(args, GaimBlistNode *); | |
298 switch (node->type) { | |
299 case GAIM_BLIST_GROUP_NODE: | |
13810 | 300 arg = Tcl_NewListObj(0, NULL); |
301 Tcl_ListObjAppendElement(handler->interp, arg, | |
302 Tcl_NewStringObj("group", -1)); | |
303 Tcl_ListObjAppendElement(handler->interp, arg, | |
304 Tcl_NewStringObj(((GaimGroup *)node)->name, -1)); | |
6694 | 305 break; |
6735 | 306 case GAIM_BLIST_CONTACT_NODE: |
307 /* g_string_printf(val, "contact {%s}", Contact Name? ); */ | |
13810 | 308 arg = Tcl_NewStringObj("contact", -1); |
6735 | 309 break; |
6694 | 310 case GAIM_BLIST_BUDDY_NODE: |
13810 | 311 arg = Tcl_NewListObj(0, NULL); |
312 Tcl_ListObjAppendElement(handler->interp, arg, | |
313 Tcl_NewStringObj("buddy", -1)); | |
314 Tcl_ListObjAppendElement(handler->interp, arg, | |
315 Tcl_NewStringObj(((GaimBuddy *)node)->name, -1)); | |
316 Tcl_ListObjAppendElement(handler->interp, arg, | |
317 gaim_tcl_ref_new(GaimTclRefAccount, | |
318 ((GaimBuddy *)node)->account)); | |
6694 | 319 break; |
320 case GAIM_BLIST_CHAT_NODE: | |
13810 | 321 arg = Tcl_NewListObj(0, NULL); |
322 Tcl_ListObjAppendElement(handler->interp, arg, | |
323 Tcl_NewStringObj("chat", -1)); | |
324 Tcl_ListObjAppendElement(handler->interp, arg, | |
325 Tcl_NewStringObj(((GaimChat *)node)->alias, -1)); | |
326 Tcl_ListObjAppendElement(handler->interp, arg, | |
327 gaim_tcl_ref_new(GaimTclRefAccount, | |
328 ((GaimChat *)node)->account)); | |
6694 | 329 break; |
330 case GAIM_BLIST_OTHER_NODE: | |
13810 | 331 arg = Tcl_NewStringObj("other", -1); |
6694 | 332 break; |
333 } | |
334 break; | |
335 } | |
336 } | |
10597 | 337 Tcl_ListObjAppendElement(handler->interp, cmd, arg); |
6694 | 338 } |
339 | |
340 /* Call the friggin' procedure already */ | |
10597 | 341 if ((error = Tcl_EvalObjEx(handler->interp, cmd, TCL_EVAL_GLOBAL)) != TCL_OK) { |
6694 | 342 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "error evaluating callback: %s\n", |
343 Tcl_GetString(Tcl_GetObjResult(handler->interp))); | |
344 } else { | |
345 result = Tcl_GetObjResult(handler->interp); | |
346 /* handle return values -- strings and words only */ | |
347 if (handler->returntype) { | |
348 if (gaim_value_get_type(handler->returntype) == GAIM_TYPE_STRING) { | |
349 retval = (void *)g_strdup(Tcl_GetString(result)); | |
350 } else { | |
351 if ((error = Tcl_GetIntFromObj(handler->interp, result, (int *)&retval)) != TCL_OK) { | |
352 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Error retrieving procedure result: %s\n", | |
353 Tcl_GetString(Tcl_GetObjResult(handler->interp))); | |
354 retval = NULL; | |
355 } | |
356 } | |
357 } | |
358 } | |
359 | |
360 /* And finally clean up */ | |
361 for (i = 0; i < handler->nargs; i++) { | |
10597 | 362 g_string_printf(name, "%s::arg%d", |
363 Tcl_GetString(handler->namespace), i); | |
13810 | 364 if (gaim_value_is_outgoing(handler->argtypes[i]) |
365 && gaim_value_get_type(handler->argtypes[i]) != GAIM_TYPE_SUBTYPE) | |
10597 | 366 Tcl_UnlinkVar(handler->interp, name->str); |
13810 | 367 |
10597 | 368 /* We basically only have to deal with strings on the |
369 * way out */ | |
6694 | 370 switch (gaim_value_get_type(handler->argtypes[i])) { |
371 case GAIM_TYPE_STRING: | |
372 if (gaim_value_is_outgoing(handler->argtypes[i])) { | |
10597 | 373 if (vals[i] != NULL && *(char **)vals[i] != NULL) { |
374 g_free(*strs[i]); | |
375 *strs[i] = g_strdup(vals[i]); | |
6694 | 376 } |
10597 | 377 ckfree(vals[i]); |
6694 | 378 } |
379 break; | |
380 default: | |
381 /* nothing */ | |
382 ; | |
383 } | |
384 } | |
385 | |
386 g_string_free(name, TRUE); | |
10504 | 387 g_string_free(val, TRUE); |
10597 | 388 g_free(vals); |
389 g_free(strs); | |
6694 | 390 |
391 return retval; | |
392 } | |
10597 | 393 |
394 static Tcl_Obj *new_cb_namespace () | |
395 { | |
396 static int cbnum; | |
397 char name[32]; | |
398 | |
399 g_snprintf (name, sizeof(name), "::gaim::_callback::cb_%d", cbnum++); | |
400 return Tcl_NewStringObj (name, -1); | |
401 } |