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