gee
oldstatus
2005-09-19, Nathan Walp
* @file tcl.c Gaim Tcl plugin bindings * Copyright (C) 2003 Ethan Blanton <eblanton@cs.purdue.edu> * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA static GHashTable *tcl_plugins = NULL; static gboolean tcl_loaded = FALSE; GaimPlugin *tcl_interp_get_plugin(Tcl_Interp *interp) struct tcl_plugin_data *data; data = g_hash_table_lookup(tcl_plugins, (gpointer)interp); return data != NULL ? data->plugin : NULL; static int tcl_init_interp(Tcl_Interp *interp) "namespace eval ::gaim {\n" " namespace export account buddy connection conversation\n" " namespace export core debug notify prefs send_im\n" " namespace export signal unload\n" " namespace eval _callback { }\n" " proc conv_send { account who text } {\n" " set gc [gaim::account connection $account]\n" " set convo [gaim::conversation new $account $who]\n" " set myalias [gaim::account alias $account]\n" " if {![string length $myalias]} {\n" " set myalias [gaim::account username $account]\n" " gaim::send_im $gc $who $text\n" " gaim::conversation write $convo send $myalias $text\n" "proc bgerror { message } {\n" " gaim::notify -error \"Tcl Error\" \"Tcl Error: $message\" \"$errorInfo\"\n" if (Tcl_EvalEx(interp, init, -1, TCL_EVAL_GLOBAL) != TCL_OK) { Tcl_SetVar(interp, "argc", "0", TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "argv0", "gaim", TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); rcfile = g_strdup_printf("%s" G_DIR_SEPARATOR_S "tclrc", gaim_user_dir()); Tcl_SetVar(interp, "tcl_rcFileName", rcfile, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "::gaim::version", VERSION, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "::gaim::user_dir", gaim_user_dir(), TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "::gaim::tk_available", "1", TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "::gaim::tk_available", "0", TCL_GLOBAL_ONLY); Tcl_CreateObjCommand(interp, "::gaim::account", tcl_cmd_account, (ClientData)NULL, NULL); Tcl_CreateObjCommand(interp, "::gaim::buddy", tcl_cmd_buddy, (ClientData)NULL, NULL); Tcl_CreateObjCommand(interp, "::gaim::connection", tcl_cmd_connection, (ClientData)NULL, NULL); Tcl_CreateObjCommand(interp, "::gaim::conversation", tcl_cmd_conversation, (ClientData)NULL, NULL); Tcl_CreateObjCommand(interp, "::gaim::core", tcl_cmd_core, (ClientData)NULL, NULL); Tcl_CreateObjCommand(interp, "::gaim::debug", tcl_cmd_debug, (ClientData)NULL, NULL); Tcl_CreateObjCommand(interp, "::gaim::notify", tcl_cmd_notify, (ClientData)NULL, NULL); Tcl_CreateObjCommand(interp, "::gaim::prefs", tcl_cmd_prefs, (ClientData)NULL, NULL); Tcl_CreateObjCommand(interp, "::gaim::send_im", tcl_cmd_send_im, (ClientData)NULL, NULL); Tcl_CreateObjCommand(interp, "::gaim::signal", tcl_cmd_signal, (ClientData)NULL, NULL); Tcl_CreateObjCommand(interp, "::gaim::unload", tcl_cmd_unload, (ClientData)NULL, NULL); static Tcl_Interp *tcl_create_interp() interp = Tcl_CreateInterp(); if (Tcl_Init(interp) == TCL_ERROR) { Tcl_DeleteInterp(interp); if (tcl_init_interp(interp)) { Tcl_DeleteInterp(interp); Tcl_StaticPackage(interp, "gaim", tcl_init_interp, NULL); static gboolean tcl_probe_plugin(GaimPlugin *plugin) Tcl_Obj *result, **listitems; int len, found = 0, err = 0, nelems; if ((fp = g_fopen(plugin->path, "r")) == NULL) if (fstat(fileno(fp), &st)) { while (fgets(cur, (int) buf - (buf - cur), fp)) { gaim_debug(GAIM_DEBUG_ERROR, "tcl", "error reading %s (%s)\n", plugin->path, strerror(errno)); if ((interp = tcl_create_interp()) == NULL) { if (Tcl_ParseCommand(interp, next, len, 0, &parse) == TCL_ERROR) { gaim_debug(GAIM_DEBUG_ERROR, "tcl", "parse error in %s: %s\n", plugin->path, Tcl_GetString(Tcl_GetObjResult(interp))); if (parse.tokenPtr[0].type == TCL_TOKEN_SIMPLE_WORD && !strncmp(parse.tokenPtr[0].start, "proc", parse.tokenPtr[0].size)) { if (!strncmp(parse.tokenPtr[2].start, "plugin_init", parse.tokenPtr[2].size)) { if (Tcl_EvalEx(interp, parse.commandStart, parse.commandSize, TCL_EVAL_GLOBAL) != TCL_OK) { /* We'll continue parsing the file, just in case */ len -= (parse.commandStart + parse.commandSize) - next; next = parse.commandStart + parse.commandSize; if (Tcl_EvalEx(interp, "plugin_init", -1, TCL_EVAL_GLOBAL) == TCL_OK) { result = Tcl_GetObjResult(interp); if (Tcl_ListObjGetElements(interp, result, &nelems, &listitems) == TCL_OK) { info = g_new0(GaimPluginInfo, 1); info->magic = GAIM_PLUGIN_MAGIC; info->major_version = GAIM_MAJOR_VERSION; info->minor_version = GAIM_MINOR_VERSION; info->type = GAIM_PLUGIN_STANDARD; info->dependencies = g_list_append(info->dependencies, "core-tcl"); info->name = g_strdup(Tcl_GetString(listitems[0])); info->version = g_strdup(Tcl_GetString(listitems[1])); info->summary = g_strdup(Tcl_GetString(listitems[2])); info->description = g_strdup(Tcl_GetString(listitems[3])); info->author = g_strdup(Tcl_GetString(listitems[4])); info->homepage = g_strdup(Tcl_GetString(listitems[5])); if (gaim_plugin_register(plugin)) Tcl_DeleteInterp(interp); static gboolean tcl_load_plugin(GaimPlugin *plugin) struct tcl_plugin_data *data; if ((interp = tcl_create_interp()) == NULL) { gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Could not initialize Tcl interpreter\n"); Tcl_SourceRCFile(interp); if (Tcl_EvalFile(interp, plugin->path) != TCL_OK) { result = Tcl_GetObjResult(interp); gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Error evaluating %s: %s\n", plugin->path, Tcl_GetString(result)); Tcl_DeleteInterp(interp); Tcl_Preserve((ClientData)interp); data = g_new0(struct tcl_plugin_data, 1); g_hash_table_insert(tcl_plugins, (gpointer)interp, (gpointer)data); static gboolean tcl_unload_plugin(GaimPlugin *plugin) struct tcl_plugin_data *data; g_hash_table_remove(tcl_plugins, (gpointer)(data->interp)); gaim_signals_disconnect_by_handle(data->interp); tcl_signal_cleanup(data->interp); Tcl_Release((ClientData)data->interp); Tcl_DeleteInterp(data->interp); static void tcl_destroy_plugin(GaimPlugin *plugin) if (plugin->info != NULL) { g_free(plugin->info->name); g_free(plugin->info->version); g_free(plugin->info->description); g_free(plugin->info->author); g_free(plugin->info->homepage); static gboolean tcl_load(GaimPlugin *plugin) tcl_plugins = g_hash_table_new(g_direct_hash, g_direct_equal); Tcl_StaticPackage(NULL, "Tk", Tk_Init, Tk_SafeInit); static gboolean tcl_unload(GaimPlugin *plugin) g_hash_table_destroy(tcl_plugins); static GaimPluginLoaderInfo tcl_loader_info = static GaimPluginInfo tcl_info = N_("Provides support for loading Tcl plugins"), N_("Provides support for loading Tcl plugins"), "Ethan Blanton <eblanton@cs.purdue.edu>", extern Tcl_Interp* (CALLBACK* wtcl_CreateInterp)(); extern void (CALLBACK* wtk_Init)(Tcl_Interp*); #define Tcl_CreateInterp wtcl_CreateInterp static void tcl_init_plugin(GaimPlugin *plugin) if(!(interp=Tcl_CreateInterp())) if(!Tcl_InitStubs(interp, TCL_VERSION, 0)) { gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Tcl_InitStubs: %s\n", interp->result); Tcl_FindExecutable("gaim"); #if defined(USE_TK_STUBS) && defined(HAVE_TK) if(!Tk_InitStubs(interp, TK_VERSION, 0)) { gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Error Tk_InitStubs: %s\n", interp->result); Tcl_DeleteInterp(interp); Tcl_DeleteInterp(interp); tcl_loader_info.exts = g_list_append(tcl_loader_info.exts, "tcl"); GAIM_INIT_PLUGIN(tcl, tcl_init_plugin, tcl_info)