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