Mercurial > pidgin.yaz
comparison libgaim/plugins/tcl/tcl.c @ 14192:60b1bc8dbf37
[gaim-migrate @ 16863]
Renamed 'core' to 'libgaim'
committer: Tailor Script <tailor@pidgin.im>
author | Evan Schoenberg <evan.s@dreskin.net> |
---|---|
date | Sat, 19 Aug 2006 01:50:10 +0000 |
parents | |
children | 036927fddcba |
comparison
equal
deleted
inserted
replaced
14191:009db0b357b5 | 14192:60b1bc8dbf37 |
---|---|
1 /** | |
2 * @file tcl.c Gaim Tcl plugin bindings | |
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 | |
23 #include "config.h" | |
24 | |
25 #include <tcl.h> | |
26 | |
27 #ifdef HAVE_TK | |
28 #include <tk.h> | |
29 #endif | |
30 | |
31 #include <stdio.h> | |
32 #include <sys/types.h> | |
33 #include <sys/stat.h> | |
34 #include <unistd.h> | |
35 #include <string.h> | |
36 | |
37 #include "tcl_glib.h" | |
38 #include "tcl_gaim.h" | |
39 | |
40 #include "internal.h" | |
41 #include "connection.h" | |
42 #include "plugin.h" | |
43 #include "signals.h" | |
44 #include "debug.h" | |
45 #include "util.h" | |
46 #include "version.h" | |
47 | |
48 struct tcl_plugin_data { | |
49 GaimPlugin *plugin; | |
50 Tcl_Interp *interp; | |
51 }; | |
52 | |
53 GaimStringref *GaimTclRefAccount; | |
54 GaimStringref *GaimTclRefConnection; | |
55 GaimStringref *GaimTclRefConversation; | |
56 GaimStringref *GaimTclRefPointer; | |
57 GaimStringref *GaimTclRefPlugin; | |
58 GaimStringref *GaimTclRefPresence; | |
59 GaimStringref *GaimTclRefStatus; | |
60 GaimStringref *GaimTclRefStatusAttr; | |
61 GaimStringref *GaimTclRefStatusType; | |
62 GaimStringref *GaimTclRefXfer; | |
63 | |
64 static GHashTable *tcl_plugins = NULL; | |
65 | |
66 GaimPlugin *_tcl_plugin; | |
67 | |
68 static gboolean tcl_loaded = FALSE; | |
69 | |
70 GaimPlugin *tcl_interp_get_plugin(Tcl_Interp *interp) | |
71 { | |
72 struct tcl_plugin_data *data; | |
73 | |
74 if (tcl_plugins == NULL) | |
75 return NULL; | |
76 | |
77 data = g_hash_table_lookup(tcl_plugins, (gpointer)interp); | |
78 return data != NULL ? data->plugin : NULL; | |
79 } | |
80 | |
81 static int tcl_init_interp(Tcl_Interp *interp) | |
82 { | |
83 char *rcfile; | |
84 char init[] = | |
85 "namespace eval ::gaim {\n" | |
86 " namespace export account buddy connection conversation\n" | |
87 " namespace export core debug notify prefs send_im\n" | |
88 " namespace export signal unload\n" | |
89 " namespace eval _callback { }\n" | |
90 "\n" | |
91 " proc conv_send { account who text } {\n" | |
92 " set gc [gaim::account connection $account]\n" | |
93 " set convo [gaim::conversation new $account $who]\n" | |
94 " set myalias [gaim::account alias $account]\n" | |
95 "\n" | |
96 " if {![string length $myalias]} {\n" | |
97 " set myalias [gaim::account username $account]\n" | |
98 " }\n" | |
99 "\n" | |
100 " gaim::send_im $gc $who $text\n" | |
101 " gaim::conversation write $convo send $myalias $text\n" | |
102 " }\n" | |
103 "}\n" | |
104 "\n" | |
105 "proc bgerror { message } {\n" | |
106 " global errorInfo\n" | |
107 " gaim::notify -error \"Tcl Error\" \"Tcl Error: $message\" \"$errorInfo\"\n" | |
108 "}\n"; | |
109 | |
110 if (Tcl_EvalEx(interp, init, -1, TCL_EVAL_GLOBAL) != TCL_OK) { | |
111 return 1; | |
112 } | |
113 | |
114 Tcl_SetVar(interp, "argc", "0", TCL_GLOBAL_ONLY); | |
115 Tcl_SetVar(interp, "argv0", "gaim", TCL_GLOBAL_ONLY); | |
116 Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); | |
117 rcfile = g_strdup_printf("%s" G_DIR_SEPARATOR_S "tclrc", gaim_user_dir()); | |
118 Tcl_SetVar(interp, "tcl_rcFileName", rcfile, TCL_GLOBAL_ONLY); | |
119 g_free(rcfile); | |
120 | |
121 Tcl_SetVar(interp, "::gaim::version", VERSION, TCL_GLOBAL_ONLY); | |
122 Tcl_SetVar(interp, "::gaim::user_dir", gaim_user_dir(), TCL_GLOBAL_ONLY); | |
123 #ifdef HAVE_TK | |
124 Tcl_SetVar(interp, "::gaim::tk_available", "1", TCL_GLOBAL_ONLY); | |
125 #else | |
126 Tcl_SetVar(interp, "::gaim::tk_available", "0", TCL_GLOBAL_ONLY); | |
127 #endif /* HAVE_TK */ | |
128 | |
129 Tcl_CreateObjCommand(interp, "::gaim::account", tcl_cmd_account, (ClientData)NULL, NULL); | |
130 Tcl_CreateObjCommand(interp, "::gaim::buddy", tcl_cmd_buddy, (ClientData)NULL, NULL); | |
131 Tcl_CreateObjCommand(interp, "::gaim::cmd", tcl_cmd_cmd, (ClientData)NULL, NULL); | |
132 Tcl_CreateObjCommand(interp, "::gaim::connection", tcl_cmd_connection, (ClientData)NULL, NULL); | |
133 Tcl_CreateObjCommand(interp, "::gaim::conversation", tcl_cmd_conversation, (ClientData)NULL, NULL); | |
134 Tcl_CreateObjCommand(interp, "::gaim::core", tcl_cmd_core, (ClientData)NULL, NULL); | |
135 Tcl_CreateObjCommand(interp, "::gaim::debug", tcl_cmd_debug, (ClientData)NULL, NULL); | |
136 Tcl_CreateObjCommand(interp, "::gaim::notify", tcl_cmd_notify, (ClientData)NULL, NULL); | |
137 Tcl_CreateObjCommand(interp, "::gaim::prefs", tcl_cmd_prefs, (ClientData)NULL, NULL); | |
138 Tcl_CreateObjCommand(interp, "::gaim::presence", tcl_cmd_presence, (ClientData)NULL, NULL); | |
139 Tcl_CreateObjCommand(interp, "::gaim::send_im", tcl_cmd_send_im, (ClientData)NULL, NULL); | |
140 Tcl_CreateObjCommand(interp, "::gaim::signal", tcl_cmd_signal, (ClientData)NULL, NULL); | |
141 Tcl_CreateObjCommand(interp, "::gaim::status", tcl_cmd_status, (ClientData)NULL, NULL); | |
142 Tcl_CreateObjCommand(interp, "::gaim::status_attr", tcl_cmd_status_attr, (ClientData)NULL, NULL); | |
143 Tcl_CreateObjCommand(interp, "::gaim::status_type", tcl_cmd_status_type, (ClientData)NULL, NULL); | |
144 Tcl_CreateObjCommand(interp, "::gaim::unload", tcl_cmd_unload, (ClientData)NULL, NULL); | |
145 | |
146 return 0; | |
147 } | |
148 | |
149 static Tcl_Interp *tcl_create_interp() | |
150 { | |
151 Tcl_Interp *interp; | |
152 | |
153 interp = Tcl_CreateInterp(); | |
154 if (Tcl_Init(interp) == TCL_ERROR) { | |
155 Tcl_DeleteInterp(interp); | |
156 return NULL; | |
157 } | |
158 | |
159 if (tcl_init_interp(interp)) { | |
160 Tcl_DeleteInterp(interp); | |
161 return NULL; | |
162 } | |
163 Tcl_StaticPackage(interp, "gaim", tcl_init_interp, NULL); | |
164 | |
165 return interp; | |
166 } | |
167 | |
168 static gboolean tcl_probe_plugin(GaimPlugin *plugin) | |
169 { | |
170 GaimPluginInfo *info; | |
171 Tcl_Interp *interp; | |
172 Tcl_Parse parse; | |
173 Tcl_Obj *result, **listitems; | |
174 struct stat st; | |
175 FILE *fp; | |
176 char *buf, *cur; | |
177 const char *next; | |
178 int len, found = 0, err = 0, nelems; | |
179 gboolean status = FALSE; | |
180 if ((fp = g_fopen(plugin->path, "r")) == NULL) | |
181 return FALSE; | |
182 if (fstat(fileno(fp), &st)) { | |
183 fclose(fp); | |
184 return FALSE; | |
185 } | |
186 len = st.st_size; | |
187 | |
188 buf = g_malloc(len + 1); | |
189 | |
190 cur = buf; | |
191 while (fgets(cur, GPOINTER_TO_INT(buf) - (buf - cur), fp)) { | |
192 cur += strlen(cur); | |
193 if (feof(fp)) | |
194 break; | |
195 } | |
196 | |
197 if (ferror(fp)) { | |
198 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "error reading %s (%s)\n", plugin->path, strerror(errno)); | |
199 g_free(buf); | |
200 fclose(fp); | |
201 return FALSE; | |
202 } | |
203 | |
204 fclose(fp); | |
205 | |
206 if ((interp = tcl_create_interp()) == NULL) { | |
207 return FALSE; | |
208 } | |
209 | |
210 next = buf; | |
211 do { | |
212 if (Tcl_ParseCommand(interp, next, len, 0, &parse) == TCL_ERROR) { | |
213 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "parse error in %s: %s\n", plugin->path, | |
214 Tcl_GetString(Tcl_GetObjResult(interp))); | |
215 err = 1; | |
216 break; | |
217 } | |
218 if (parse.tokenPtr[0].type == TCL_TOKEN_SIMPLE_WORD | |
219 && !strncmp(parse.tokenPtr[0].start, "proc", parse.tokenPtr[0].size)) { | |
220 if (!strncmp(parse.tokenPtr[2].start, "plugin_init", parse.tokenPtr[2].size)) { | |
221 if (Tcl_EvalEx(interp, parse.commandStart, parse.commandSize, TCL_EVAL_GLOBAL) != TCL_OK) { | |
222 Tcl_FreeParse(&parse); | |
223 break; | |
224 } | |
225 found = 1; | |
226 /* We'll continue parsing the file, just in case */ | |
227 } | |
228 } | |
229 len -= (parse.commandStart + parse.commandSize) - next; | |
230 next = parse.commandStart + parse.commandSize; | |
231 Tcl_FreeParse(&parse); | |
232 } while (len); | |
233 | |
234 if (found && !err) { | |
235 if (Tcl_EvalEx(interp, "plugin_init", -1, TCL_EVAL_GLOBAL) == TCL_OK) { | |
236 result = Tcl_GetObjResult(interp); | |
237 if (Tcl_ListObjGetElements(interp, result, &nelems, &listitems) == TCL_OK) { | |
238 if ((nelems == 6) || (nelems == 7)) { | |
239 info = g_new0(GaimPluginInfo, 1); | |
240 | |
241 info->magic = GAIM_PLUGIN_MAGIC; | |
242 info->major_version = GAIM_MAJOR_VERSION; | |
243 info->minor_version = GAIM_MINOR_VERSION; | |
244 info->type = GAIM_PLUGIN_STANDARD; | |
245 info->dependencies = g_list_append(info->dependencies, "core-tcl"); | |
246 | |
247 info->name = g_strdup(Tcl_GetString(listitems[0])); | |
248 info->version = g_strdup(Tcl_GetString(listitems[1])); | |
249 info->summary = g_strdup(Tcl_GetString(listitems[2])); | |
250 info->description = g_strdup(Tcl_GetString(listitems[3])); | |
251 info->author = g_strdup(Tcl_GetString(listitems[4])); | |
252 info->homepage = g_strdup(Tcl_GetString(listitems[5])); | |
253 | |
254 if (nelems == 6) | |
255 info->id = g_strdup_printf("tcl-%s", Tcl_GetString(listitems[0])); | |
256 else if (nelems == 7) | |
257 info->id = g_strdup_printf("tcl-%s", Tcl_GetString(listitems[6])); | |
258 | |
259 plugin->info = info; | |
260 | |
261 if (gaim_plugin_register(plugin)) | |
262 status = TRUE; | |
263 } | |
264 } | |
265 } | |
266 } | |
267 | |
268 Tcl_DeleteInterp(interp); | |
269 g_free(buf); | |
270 return status; | |
271 } | |
272 | |
273 static gboolean tcl_load_plugin(GaimPlugin *plugin) | |
274 { | |
275 struct tcl_plugin_data *data; | |
276 Tcl_Interp *interp; | |
277 Tcl_Obj *result; | |
278 | |
279 plugin->extra = NULL; | |
280 | |
281 if ((interp = tcl_create_interp()) == NULL) { | |
282 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Could not initialize Tcl interpreter\n"); | |
283 return FALSE; | |
284 } | |
285 | |
286 Tcl_SourceRCFile(interp); | |
287 | |
288 if (Tcl_EvalFile(interp, plugin->path) != TCL_OK) { | |
289 result = Tcl_GetObjResult(interp); | |
290 gaim_debug(GAIM_DEBUG_ERROR, "tcl", | |
291 "Error evaluating %s: %s\n", plugin->path, | |
292 Tcl_GetString(result)); | |
293 Tcl_DeleteInterp(interp); | |
294 return FALSE; | |
295 } | |
296 | |
297 Tcl_Preserve((ClientData)interp); | |
298 | |
299 data = g_new0(struct tcl_plugin_data, 1); | |
300 data->plugin = plugin; | |
301 data->interp = interp; | |
302 plugin->extra = data; | |
303 | |
304 g_hash_table_insert(tcl_plugins, (gpointer)interp, (gpointer)data); | |
305 | |
306 return TRUE; | |
307 } | |
308 | |
309 static gboolean tcl_unload_plugin(GaimPlugin *plugin) | |
310 { | |
311 struct tcl_plugin_data *data; | |
312 | |
313 if (plugin == NULL) | |
314 return TRUE; | |
315 | |
316 data = plugin->extra; | |
317 | |
318 if (data != NULL) { | |
319 g_hash_table_remove(tcl_plugins, (gpointer)(data->interp)); | |
320 gaim_signals_disconnect_by_handle(data->interp); | |
321 tcl_cmd_cleanup(data->interp); | |
322 tcl_signal_cleanup(data->interp); | |
323 Tcl_Release((ClientData)data->interp); | |
324 Tcl_DeleteInterp(data->interp); | |
325 g_free(data); | |
326 } | |
327 | |
328 return TRUE; | |
329 } | |
330 | |
331 static void tcl_destroy_plugin(GaimPlugin *plugin) | |
332 { | |
333 if (plugin->info != NULL) { | |
334 g_free(plugin->info->id); | |
335 g_free(plugin->info->name); | |
336 g_free(plugin->info->version); | |
337 g_free(plugin->info->description); | |
338 g_free(plugin->info->author); | |
339 g_free(plugin->info->homepage); | |
340 } | |
341 | |
342 return; | |
343 } | |
344 | |
345 static gboolean tcl_load(GaimPlugin *plugin) | |
346 { | |
347 if(!tcl_loaded) | |
348 return FALSE; | |
349 tcl_glib_init(); | |
350 tcl_cmd_init(); | |
351 tcl_signal_init(); | |
352 gaim_tcl_ref_init(); | |
353 | |
354 GaimTclRefAccount = gaim_stringref_new("Account"); | |
355 GaimTclRefConnection = gaim_stringref_new("Connection"); | |
356 GaimTclRefConversation = gaim_stringref_new("Conversation"); | |
357 GaimTclRefPointer = gaim_stringref_new("Pointer"); | |
358 GaimTclRefPlugin = gaim_stringref_new("Plugin"); | |
359 GaimTclRefPresence = gaim_stringref_new("Presence"); | |
360 GaimTclRefStatus = gaim_stringref_new("Status"); | |
361 GaimTclRefStatusAttr = gaim_stringref_new("StatusAttr"); | |
362 GaimTclRefStatusType = gaim_stringref_new("StatusType"); | |
363 GaimTclRefXfer = gaim_stringref_new("Xfer"); | |
364 | |
365 tcl_plugins = g_hash_table_new(g_direct_hash, g_direct_equal); | |
366 | |
367 #ifdef HAVE_TK | |
368 Tcl_StaticPackage(NULL, "Tk", Tk_Init, Tk_SafeInit); | |
369 #endif /* HAVE_TK */ | |
370 | |
371 return TRUE; | |
372 } | |
373 | |
374 static gboolean tcl_unload(GaimPlugin *plugin) | |
375 { | |
376 g_hash_table_destroy(tcl_plugins); | |
377 tcl_plugins = NULL; | |
378 | |
379 gaim_stringref_unref(GaimTclRefAccount); | |
380 gaim_stringref_unref(GaimTclRefConnection); | |
381 gaim_stringref_unref(GaimTclRefConversation); | |
382 gaim_stringref_unref(GaimTclRefPointer); | |
383 gaim_stringref_unref(GaimTclRefPlugin); | |
384 gaim_stringref_unref(GaimTclRefPresence); | |
385 gaim_stringref_unref(GaimTclRefStatus); | |
386 gaim_stringref_unref(GaimTclRefStatusAttr); | |
387 gaim_stringref_unref(GaimTclRefStatusType); | |
388 gaim_stringref_unref(GaimTclRefXfer); | |
389 | |
390 return TRUE; | |
391 } | |
392 | |
393 static GaimPluginLoaderInfo tcl_loader_info = | |
394 { | |
395 NULL, | |
396 tcl_probe_plugin, | |
397 tcl_load_plugin, | |
398 tcl_unload_plugin, | |
399 tcl_destroy_plugin, | |
400 }; | |
401 | |
402 static GaimPluginInfo tcl_info = | |
403 { | |
404 GAIM_PLUGIN_MAGIC, | |
405 GAIM_MAJOR_VERSION, | |
406 GAIM_MINOR_VERSION, | |
407 GAIM_PLUGIN_LOADER, | |
408 NULL, | |
409 0, | |
410 NULL, | |
411 GAIM_PRIORITY_DEFAULT, | |
412 "core-tcl", | |
413 N_("Tcl Plugin Loader"), | |
414 VERSION, | |
415 N_("Provides support for loading Tcl plugins"), | |
416 N_("Provides support for loading Tcl plugins"), | |
417 "Ethan Blanton <eblanton@cs.purdue.edu>", | |
418 GAIM_WEBSITE, | |
419 tcl_load, | |
420 tcl_unload, | |
421 NULL, | |
422 NULL, | |
423 &tcl_loader_info, | |
424 NULL, | |
425 NULL | |
426 }; | |
427 | |
428 #ifdef _WIN32 | |
429 typedef Tcl_Interp* (CALLBACK* LPFNTCLCREATEINTERP)(void); | |
430 typedef void (CALLBACK* LPFNTKINIT)(Tcl_Interp*); | |
431 | |
432 LPFNTCLCREATEINTERP wtcl_CreateInterp = NULL; | |
433 LPFNTKINIT wtk_Init = NULL; | |
434 #undef Tcl_CreateInterp | |
435 #define Tcl_CreateInterp wtcl_CreateInterp | |
436 #undef Tk_Init | |
437 #define Tk_Init wtk_Init | |
438 | |
439 static gboolean tcl_win32_init() { | |
440 gaim_debug(GAIM_DEBUG_INFO, "tcl", | |
441 "Initializing the Tcl runtime. If Gaim doesn't load, it is " | |
442 "most likely because you have cygwin in your PATH and you " | |
443 "should remove it. See http://gaim.sf.net/win32 for more " | |
444 "information\n"); | |
445 | |
446 if(!(wtcl_CreateInterp = (LPFNTCLCREATEINTERP) wgaim_find_and_loadproc("tcl84.dll", "Tcl_CreateInterp"))) { | |
447 gaim_debug(GAIM_DEBUG_INFO, "tcl", "tcl_win32_init error loading Tcl_CreateInterp\n"); | |
448 return FALSE; | |
449 } | |
450 | |
451 if(!(wtk_Init = (LPFNTKINIT) wgaim_find_and_loadproc("tk84.dll", "Tk_Init"))) { | |
452 HMODULE mod; | |
453 gaim_debug(GAIM_DEBUG_INFO, "tcl", "tcl_win32_init error loading Tk_Init\n"); | |
454 if((mod = GetModuleHandle("tcl84.dll"))) | |
455 FreeLibrary(mod); | |
456 return FALSE; | |
457 } | |
458 | |
459 if (GetModuleHandle("cygwin1.dll")) { | |
460 HMODULE mod; | |
461 gaim_debug(GAIM_DEBUG_INFO, "tcl", "Cygwin has been loaded by tcl84.dll and/or tk84.dll. Disabling Tcl support to avoid problems.\n"); | |
462 if((mod = GetModuleHandle("tcl84.dll"))) | |
463 FreeLibrary(mod); | |
464 if((mod = GetModuleHandle("tk84.dll"))) | |
465 FreeLibrary(mod); | |
466 return FALSE; | |
467 } | |
468 | |
469 return TRUE; | |
470 } | |
471 | |
472 #endif /* _WIN32 */ | |
473 | |
474 static void tcl_init_plugin(GaimPlugin *plugin) | |
475 { | |
476 #ifdef USE_TCL_STUBS | |
477 Tcl_Interp *interp = NULL; | |
478 #endif | |
479 _tcl_plugin = plugin; | |
480 | |
481 #ifdef USE_TCL_STUBS | |
482 #ifdef _WIN32 | |
483 if(!tcl_win32_init()) | |
484 return; | |
485 #endif | |
486 if(!(interp = Tcl_CreateInterp())) | |
487 return; | |
488 | |
489 if(!Tcl_InitStubs(interp, TCL_VERSION, 0)) { | |
490 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Tcl_InitStubs: %s\n", interp->result); | |
491 return; | |
492 } | |
493 #endif | |
494 | |
495 Tcl_FindExecutable("gaim"); | |
496 | |
497 #if defined(USE_TK_STUBS) && defined(HAVE_TK) | |
498 Tk_Init(interp); | |
499 | |
500 if(!Tk_InitStubs(interp, TK_VERSION, 0)) { | |
501 gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Error Tk_InitStubs: %s\n", interp->result); | |
502 Tcl_DeleteInterp(interp); | |
503 return; | |
504 } | |
505 #endif | |
506 tcl_loaded = TRUE; | |
507 #ifdef USE_TCL_STUBS | |
508 Tcl_DeleteInterp(interp); | |
509 #endif | |
510 tcl_loader_info.exts = g_list_append(tcl_loader_info.exts, "tcl"); | |
511 } | |
512 | |
513 GAIM_INIT_PLUGIN(tcl, tcl_init_plugin, tcl_info) |