changeset 6694:2d2f04c5c7d2

[gaim-migrate @ 7220] Sean probably won't think this is contact support. This is in fact a Tcl script plugin loader. That's probably what he'll think it is. committer: Tailor Script <[e-mail]>

--- a/configure.ac	Tue Sep 02 03:29:53 2003 +0000
+++ b/configure.ac	Tue Sep 02 03:34:37 2003 +0000
@@ -125,6 +125,10 @@
 AC_ARG_ENABLE(nas,     [  --enable-nas            enable NAS (Network Audio System) support],,enable_nas=no)
 AC_ARG_ENABLE(plugins, [  --disable-plugins       compile without plugin support],,enable_plugins=yes)
 AC_ARG_ENABLE(perl,    [  --disable-perl          compile without perl scripting],,enable_perl=yes)
+AC_ARG_ENABLE(tcl,     [  --disable-tcl	          compile without Tcl scripting],,enable_tcl=yes)
+AC_ARG_WITH(tclconfig, [  --with-tclconfig=DIR    directory containing tclConfig.sh])
+AC_ARG_ENABLE(tk,      [  --disable-tk            compile without Tcl support for Tk],,enable_tk=yes)
+AC_ARG_WITH(tkconfig,  [  --with-tkconfig=DIR     directory containing tkConfig.sh])
 AC_ARG_ENABLE(gtkspell, [  --disable-gtkspell      compile without GtkSpell automatic spell checking],,enable_gtkspell=yes)
 AC_ARG_ENABLE(debug,   [  --enable-debug          compile with debugging support],,enable_debug=no)
 AC_ARG_ENABLE(screensaver,   [  --disable-screensaver   compile without X screensaver extension],,enable_xss=yes)
@@ -330,6 +334,75 @@
 	AM_CONDITIONAL(USE_PERL, false)
 fi
 
+dnl Check for Tcl
+if test "$enable_tcl" = yes; then
+	AC_MSG_CHECKING([for tclConfig.sh])
+        TCLCONFIG=no
+	for dir in $with_tclconfig /usr/lib /usr/local/lib; do
+		if test -f $dir/tclConfig.sh; then
+			TCLCONFIG=$dir/tclConfig.sh
+			AC_MSG_RESULT([yes ($TCLCONFIG)])
+		fi
+	done
+	if test "$TCLONFIG" = "no"; then
+		AC_MSG_RESULT([no])
+		enable_tcl=no
+	else
+		. $TCLCONFIG
+		eval "TCL_LIB_SPEC=\"$TCL_LIB_SPEC\""
+		AC_MSG_CHECKING([for Tcl linkability])
+		oldLIBS=$LIBS
+		LIBS="$LIBS $TCL_LIB_SPEC"
+		AC_TRY_LINK([#include <tcl.h>], [Tcl_Interp *interp; Tcl_Init(interp)],
+			    [AC_MSG_RESULT([yes]);enable_tcl=yes],
+			    [AC_MSG_RESULT([no]);enable_tcl=no])
+		LIBS="$oldLIBS"
+	fi
+fi
+
+if test "$enable_tcl" = yes; then
+	AM_CONDITIONAL(USE_TCL, true)
+	TCL_LIBS=$TCL_LIB_SPEC
+	AC_SUBST(TCL_LIBS)
+else
+	AM_CONDITIONAL(USE_TCL, false)
+fi
+
+dnl Check for Tk
+if test "$enable_tcl" = yes -a "$enable_tk" = yes; then
+	AC_MSG_CHECKING([for tkConfig.sh])
+	TKCONFIG=no
+	for dir in $with_tkconfig /usr/lib /usr/local/lib; do
+		if test -f $dir/tkConfig.sh; then
+			TKCONFIG=$dir/tkConfig.sh
+			AC_MSG_RESULT([yes ($TKCONFIG)])
+		fi
+	done
+	if test "$TKCONFIG" = "no"; then
+		AC_MSG_RESULT([no])
+		enable_tk=no
+	else
+		. $TKCONFIG
+		eval "TK_LIB_SPEC=\"$TK_LIB_SPEC\""
+		AC_MSG_CHECKING([for Tk linkability])
+		oldLIBS=$LIBS
+		LIBS="$LIBS $TCL_LIB_SPEC $TK_LIB_SPEC"
+		AC_TRY_LINK([#include <tk.h>], [Tcl_Interp *interp; Tcl_Init(interp); Tk_Init(interp);],
+			    [AC_MSG_RESULT([yes]);enable_tk=yes],
+			    [AC_MSG_RESULT([no]);enable_tk=no])
+		LIBS="$oldLIBS"
+	fi
+fi
+
+if test "$enable_tk" = yes; then
+	AM_CONDITIONAL(USE_TK, true)
+	AC_DEFINE(HAVE_TK, [1], [Compile with support for the Tk toolkit])
+	TK_LIBS=$TK_LIB_SPEC
+	AC_SUBST(TK_LIBS)
+else
+	AM_CONDITIONAL(USE_TK, false)
+fi
+
 dnl Thanks, Evan.
 if test "$enable_gtkspell" = yes ; then
 	PKG_CHECK_MODULES(GTKSPELL, gtkspell-2.0 >= 2.0.2, , enable_gtkspell=no)
@@ -463,6 +536,7 @@
 	   plugins/gestures/Makefile
 	   plugins/perl/Makefile
 	   plugins/perl/common/Makefile.PL
+	   plugins/tcl/Makefile
 	   plugins/ticker/Makefile
 	   po/Makefile.in
            sounds/Makefile
@@ -492,6 +566,8 @@
 echo
 echo Build with Plugin support..... : $enable_plugins
 echo Build with Perl support....... : $enable_perl
+echo Build with Tcl support........ : $enable_tcl
+echo Build with Tk support......... : $enable_tk
 echo Build with Audio support...... : $enable_audio
 echo Build with NAS support........ : $enable_nas
 echo Build with GtkSpell support... : $enable_gtkspell

--- a/plugins/Makefile.am	Tue Sep 02 03:29:53 2003 +0000
+++ b/plugins/Makefile.am	Tue Sep 02 03:34:37 2003 +0000
@@ -1,10 +1,14 @@
-DIST_SUBDIRS = docklet gaim-remote gestures perl ticker
+DIST_SUBDIRS = docklet gaim-remote gestures perl tcl ticker
 
 if USE_PERL
 PERL_DIR = perl
 endif
 
-SUBDIRS = docklet gaim-remote gestures $(PERL_DIR) ticker
+if USE_TCL
+TCL_DIR = tcl
+endif
+
+SUBDIRS = docklet gaim-remote gestures $(PERL_DIR) $(TCL_DIR) ticker
 
 plugindir = $(libdir)/gaim
 

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/tcl/.cvsignore	Tue Sep 02 03:34:37 2003 +0000
@@ -0,0 +1,7 @@
+Makefile.in
+Makefile
+tcl.so
+tcl.la
+.deps
+.libs
+*.lo

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/tcl/Makefile.am	Tue Sep 02 03:34:37 2003 +0000
@@ -0,0 +1,17 @@
+plugindir = $(libdir)/gaim
+
+tcl_la_LDFLAGS = -module -avoid-version $(TCL_LIBS) $(TK_LIBS)
+
+plugin_LTLIBRARIES = tcl.la
+
+tcl_la_SOURCES = tcl.c tcl_glib.c tcl_cmds.c tcl_signals.c tcl_gaim.h
+
+AM_CPPFLAGS = \
+	-DVERSION=\"$(VERSION)\" \
+	-I$(top_srcdir) \
+	-I$(top_srcdir)/src \
+	$(DEBUG_CFLAGS) \
+	$(GLIB_CFLAGS) \
+	$(PLUGIN_CFLAGS) \
+	$(TK_CFLAGS) \
+	$(TCL_CFLAGS)

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/tcl/TCL-HOWTO	Tue Sep 02 03:34:37 2003 +0000
@@ -0,0 +1,310 @@
+Gaim Tcl plugin-writing HOWTO
+
+INTRODUCTION
+
+The Gaim Tcl interface provides a Tcl API for many useful gaim
+functions.  Like the perl API, the Tcl API does not provide access to
+every corner of gaim exposed by the C interface.  It does, however,
+provide a very powerful interface to many of Gaim's functions through
+a simple to learn and extend scripting language.
+
+If you are not familiar with Tcl, you will probably find it somewhat
+different from what you are used to.  Despite being somewhat unique
+(more akin to shell programming than other traditional scripting
+languages such as perl or python), it is simple to learn for beginners
+and experienced programmers alike.  There are numerous books on the
+subject, we will not discuss it any further here.
+
+GETTING STARTED
+
+The only requirement placed on a Gaim Tcl script by Gaim is the
+existence of a procedure called 'plugin_init'.  This procedure has
+some limitations placed upon it; it will be parsed and evaluated
+before the rest of the Tcl script, so it cannot reference any other
+variables or procedures declared in the script.  In practice this is
+not a problem, as the only thing this procedure should do is return a
+simple list containing five items: the name of the script, its version
+number, a short description, the author, and a web page.  For example:
+
+proc plugin_init { } {
+  return [ list "Example Plugin" \
+                "1.0" \
+		"Example of how to register a plugin for the Tcl HOWTO" \
+		"Ethan Blanton <[e-mail]>" \
+		"http://gaim.sf.net/" ]
+}
+
+The rest of the script will generally be registration to recieve
+notification of various Gaim signals (more about this below) and
+definitions of procedures to be executed when those signals occur.
+
+INTERPRETER DETAILS
+
+Gaim initializes and drives the Tcl event loop (similar to Tk),
+meaning that commands like fileevent and after are available and
+do not require 'vwait' etc.  'vwait' actually seems to be somewhat
+broken due to a bug somewhere in the Tcl/Glib event loop glue, and it
+should not be used for now.
+
+The gaim-specific functions are provided in a statically-linked
+package called 'gaim'; this means that if you spawn a child
+interpreter and wish to use the gaim-specific functions, you will need
+to execute 'load {} gaim' in that interpreter.
+
+GAIM INTERNAL PROCEDURES AND VARIABLES
+
+All of the information provided for your use by Gaim will be in the
+::gaim namespace.  This means that in order to access it you will
+either have to import the gaim namespace (e.g. via the command
+'namespace import gaim::*') or reference it explicitly.  The following
+descriptions will reference it explicitly for clarity.
+
+* Variables
+
+gaim::version
+
+  This contains the version of the gaim process which loaded the
+  script.
+
+* Commands
+
+gaim::account alias account
+gaim::account connect account
+gaim::account connection account
+gaim::account disconnect account
+gaim::account find username protocol
+gaim::account handle
+gaim::account isconnected account
+gaim::account list ?option?
+gaim::account protocol account
+gaim::account username account
+
+  The 'gaim::account' command consists of a set of subcommands
+  pertaining to gaim accounts.
+
+  'alias' returns the alias for the account 'account'.  If there is no
+  alias for the given account, it returns the empty string.
+
+  The subcommand 'connect' connects the named account if it is not
+  connected, and does nothing if it is.  In either case, it returns
+  the gc for the account.
+
+  'connection' returns the gc of the given account if it is connected,
+  or 0 if it is not.  This gc is the gc used by gaim::connection and
+  other functions.
+
+  'disconnect' disconnects the given account if it is connected, or
+  does nothing if it is.
+
+  'find' finds an account by its username and protocol (as returned by
+  'gaim::account username' and 'gaim::account protocol') and returns
+  the account if found, or 0 otherwise.
+
+  'handle' returns the instance handle required to connect to account
+  signals.  (See 'gaim::signal connect').
+
+  The 'isconnected' query returns true if the given account is
+  connected and false otherwise.
+
+  The 'list' subcommand returns a list of all of the accounts known to
+  Gaim.  The elements of this lists are accounts appropriate for the
+  'account' argument of the other subcommands.  The '-all' option
+  (default) returns all accounts, while the '-online' option returns
+  only those accounts which are online.
+
+  The 'protocol' subcommand returns the protocol ID (e.g. "prpl-msn")
+  for the given account.
+
+  The 'username' subcommand returns the username for the account
+  'account'.
+
+gaim::buddy alias buddy
+gaim::buddy handle
+gaim::buddy info ( buddy | account username )
+gaim::buddy list
+
+  'gaim::buddy' is a set of commands for retrieving information about
+  buddies and manipulating the buddy list.  For the purposes of Tcl,
+  a "buddy" is currently a list of several elements, the first of
+  which being the type.  The currently recognized types are "group",
+  "buddy", and "chat".  A group node looks like:
+	{ group name { buddies } }
+  A buddy node is:
+	{ buddy name account }
+  And a chat node is:
+	{ chat alias account }
+
+  The 'alias' subcommand returns the alias for the given buddy if it
+  exists, or the empty string if it does not.
+
+  'handle' returns the blist handle for the purposes of connecting
+  signals to buddy list events.  (See 'gaim::signal connect').
+
+  'info' causes gaim to display the info dialog for the given buddy.
+  Since it is possible to request user info for a buddy not in your
+  buddy list, you may also specify a buddy by his or her username and
+  the account through which you wish to retrieve info.
+
+  'list' returns a list of 'group' structures, filled out with buddies
+  and chats as described above.
+
+gaim::connection account gc
+gaim::connection handle
+gaim::connection list
+
+  'gaim::connection' is a collection of subcommands pertaining to
+  account connections.
+
+  'account' returns the Gaim account associated with 'gc'.  This
+  account is the same account used by gaim::account and other
+  commands.
+
+  'handle' returns the gaim connections instance handle.  (See
+  'gaim::signal connect').
+
+  'list' returns a list of all known connections.  The elements of
+  this list are appropriate as 'gc' arguments to the other
+  gaim::connection subcommands or other commands requiring a gc.
+
+
+gaim::conv_send account who text
+
+  'gaim::conv' is simply a convenience wrapper for 'gaim::send_im' and
+  'gaim::conversation write'.  It sends the IM, determines the from
+  and to arguments for 'gaim::conversation write', and prints the text
+  sent to the conversation as one would expect.  For the curious, you
+  may view the source for it by typing 'info body gaim::conv_send' at
+  a Gaim Commander prompt.
+
+  Note that an error in either gaim::send_im or 'gaim::conversation
+  write' will not be caught by this procedure, and will be propagated
+  to the caller.
+
+gaim::conversation find ?-account account? name
+gaim::conversation handle
+gaim::conversation list
+gaim::conversation new ?-chat? ?-im? account name
+gaim::conversation write conversation style from to text
+
+  'gaim::conversation' provides an API for dealing with conversations.
+  Given that Gaim is an instant messenger program, you'll probably
+  spend a lot of time here.
+
+  The command 'find' attempts to find an existing conversation with
+  username 'name'.  If the '-account' option is given, it refines its
+  search to include only conversations on that account.
+
+  'handle' returns the conversations instance handle for the purposes
+  of signal connection.  (See 'gaim::signal connect').
+
+  'list' returns a list of all currently open conversations.
+
+  The 'new' subcommand can be used to create a new conversation with
+  a specified user on a specified account if one does not exist, or
+  retrieve the existing conversation if it does.  The '-chat' and
+  '-im' options specify whether the created conversation should be a
+  chat or a standard IM, respectively.
+
+  'write' is used to write to the specified conversation.  The 'style'
+  argument specifies how the text should be printed -- as text coming
+  from the gaim user (style 'send'), being sent to the gaim user
+  (style 'recv'), or as a system message (such as "so-and-so has
+  signed off", style 'system').  From is the name to whom the text
+  should be attributed -- you probably want to check for aliases here,
+  lest you confuse the user.  'text' is the text to print.
+
+gaim::core handle
+gaim::core quit
+
+  This command exposes functionality provided by the gaim core API.
+
+  'gaim::core handle' returns a handle to the gaim core for signal
+  connection.  (See 'gaim::signal connect').
+
+  'quit' exits gaim cleanly, and should be used in preference to the
+  tcl 'exit' command.  (Note that 'exit' has not been removed,
+  however.)
+
+gaim::debug level category message
+
+  Equivalent to the C gaim_debug function, this command outputs
+  debugging information to the gaim debug window (or stdout if gaim is
+  invoked with -n).  The valid levels are, in increasing level of
+  severity, -misc, -info, -warning, and -error.  'category' is a short
+  (a few characters ... for instance, "tcl" or "tcl plugin") "topic"
+  type name for this message, and 'message' is the text of the
+  message. In the style of Tcl 'puts' (and differing from gaim_debug),
+  no trailing \n is required.  (However, embedded newlines may be
+  generated with \n).
+
+gaim::notify ?type? title primary secondary
+
+  Also a direct equivalent to a C function, gaim_notify, this command
+  causes gaim to present the provided notification information to the
+  user via some appropriate UI method.  The 'type' argument, if
+  present, must be one of -error, -warning, or -info. The following
+  three arguments' absolute meanings may vary with the Gaim UI being
+  used (presently only a Gtk2 UI is available), but 'title' should
+  generally be the title of the window, and 'primary' and 'secondary'
+  text within that window; in the Gtk2 UI, 'primary' is slightly
+  larger than 'secondary' and displayed in a boldface font.
+
+gaim::send_im gc who text
+
+  This sends an IM in the fashion of serv_send_im.  'gc' is the GC of
+  the connection on which you wish to send (as returned by most event
+  handlers), 'who' is the nick of the buddy to which you wish to send,
+  and 'text' is the text of the message.
+
+gaim::signal connect instance signal args proc
+gaim::signal disconnect instance signal
+
+  'gaim::signal' is a set of subcommands for dealing with gaim signals
+  (known as "events" prior to gaim 0.68).
+
+  The 'connect' subcommand registers the procedure 'proc' as a handler
+  for the signal 'signal' on the instance 'instance'.  'instance'
+  should be an instance handle as returned by one of the 'handle'
+  commands from the various parts of gaim. 'args' and 'proc' are as in
+  the Tcl 'proc' command; note that the number of arguments in 'args'
+  must match the number of arguments emitted by the signal exactly,
+  although you need not use them all.  The procedure 'proc' may be
+  either a simple command or a procedure in curly brackets.  Note that
+  only one procedure may be associated with each signal; an attempt to
+  connect a second procedure to the same signal will remove the
+  existing binding and replace it with the new procedure.
+  'gaim::signal connect' returns 0 on success and 1 on failure.
+
+  'disconnect' removes any existing signal handler for the named
+  signal and instance.
+
+gaim::unload
+
+  This unloads the current plugin.  Note that preferences will not be
+  updated (yet).
+
+SIGNALS
+
+Check the file SIGNALS for the meaning of these signals; this is
+intended to be a list only of their arguments.  Signal callbacks will
+be made in their own namespace, and arguments to those signal
+callbacks will live in the namespace 'event' underneath that
+namespace.  To briefly illustrate, the signal received-im-msg is
+provided with three arguments; the account on which the IM was
+received, the screen name of the user sending the IM, and the text of
+the IM.  These arguments live in the variables event::account,
+event::sender, and event::buffer, respectively.  Therefore a callback
+which notifies the user of an incoming IM containing the word 'shizzle'
+might look like this:
+
+gaim::add_event_handler received-im-msg {
+	if {[ string match "*shizzle*" $event::buffer ]} {
+		gaim::notify -info "tcl plugin" "Fo' shizzle" \
+			"$event::sender is down with the shizzle"
+	}
+}
+
+Note that for some signals (notably received-im-msg, sending-im-msg,
+and their chat counterparts), changes to the event arguments will
+change the message itself from Gaim's vantage.  For those signals
+whose return value is meaningful, returning a value from the Tcl event

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/tcl/signal-test.tcl	Tue Sep 02 03:34:37 2003 +0000
@@ -0,0 +1,105 @@
+gaim::signal connect [gaim::account handle] account-away { account state message } {
+	gaim::debug -info "tcl signal" "account-away [gaim::account username $account] \"$state\" \"$message\""
+}
+
+gaim::signal connect [gaim::account handle] account-connecting { account } {
+	gaim::debug -info "tcl signal" "account-connecting [gaim::account username $account]"
+}
+
+gaim::signal connect [gaim::account handle] account-set-info { account info } {
+	gaim::debug -info "tcl signal" "account-set-info [gaim::account username $account] $info"
+}
+
+gaim::signal connect [gaim::account handle] account-setting-info { account info } {
+	gaim::debug -info "tcl signal" "account-set-info [gaim::account username $account] $info"
+}
+
+gaim::signal connect [gaim::account handle] account-warned { account who level } {
+	gaim::debug -info "tcl signal" "account-warned [gaim::account username $account] $who $level"
+}
+
+gaim::signal connect [gaim::buddy handle] buddy-away { buddy } {
+	gaim::debug -info "tcl signal" "buddy-away [gaim::account username [lindex $buddy 2]] [lindex $buddy 1]"
+}
+
+gaim::signal connect [gaim::buddy handle] buddy-back { buddy } {
+	gaim::debug -info "tcl signal" "buddy-back [gaim::account username [lindex $buddy 2]] [lindex $buddy 1]"
+}
+
+gaim::signal connect [gaim::buddy handle] buddy-idle { buddy } {
+	gaim::debug -info "tcl signal" "buddy-idle [gaim::account username [lindex $buddy 2]] [lindex $buddy 1]"
+}
+
+gaim::signal connect [gaim::buddy handle] buddy-unidle { buddy } {
+	gaim::debug -info "tcl signal" "buddy-unidle [gaim::account username [lindex $buddy 2]] [lindex $buddy 1]"
+}
+
+gaim::signal connect [gaim::buddy handle] buddy-signed-on { buddy } {
+	gaim::debug -info "tcl signal" "buddy-signed-on [gaim::account username [lindex $buddy 2]] [lindex $buddy 1]"
+}
+
+gaim::signal connect [gaim::buddy handle] buddy-signed-off { buddy } {
+	gaim::debug -info "tcl signal" "buddy-signed-off [gaim::account username [lindex $buddy 2]] [lindex $buddy 1]"
+}
+
+gaim::signal connect [gaim::core handle] quitting {} {
+	gaim::debug -info "tcl signal" "quitting"
+}
+
+gaim::signal connect [gaim::conversation handle] received-chat-msg { account who what id } {
+	gaim::debug -info "tcl signal" "received-chat-msg [gaim::account username $account] $id $who \"$what\""
+	return 0
+}
+
+gaim::signal connect [gaim::conversation handle] received-im-msg { account who what flags } {
+	gaim::debug -info "tcl signal" "received-im-msg [gaim::account username $account] $flags $who \"$what\""
+	return 0
+}
+
+gaim::signal connect [gaim::conversation handle] sending-chat-msg { account what id } {
+	gaim::debug -info "tcl signal" "sending-chat-msg [gaim::account username $account] $id \"$what\""
+	return 0
+}
+
+gaim::signal connect [gaim::conversation handle] sending-im-msg { account who what } {
+	gaim::debug -info "tcl signal" "sending-im-msg [gaim::account username $account] $who \"$what\""
+	return 0
+}
+
+gaim::signal connect [gaim::conversation handle] sent-chat-msg { account id what } {
+	gaim::debug -info "tcl signal" "sent-chat-msg [gaim::account username $account] $id \"$what\""
+}
+
+gaim::signal connect [gaim::conversation handle] sent-im-msg { account who what } {
+	gaim::debug -info "tcl signal" "sent-im-msg [gaim::account username $account] $who \"$what\""
+}
+
+gaim::signal connect [gaim::connection handle] signed-on { gc } {
+	gaim::debug -info "tcl signal" "signed-on [gaim::account username [gaim::connection account $gc]"
+}
+
+gaim::signal connect [gaim::connection handle] signed-off { gc } {
+	gaim::debug -info "tcl signal" "signed-off [gaim::account username [gaim::connection account $gc]]"
+}
+
+gaim::signal connect [gaim::connection handle] signing-on { gc } {
+	gaim::debug -info "tcl signal" "signing-on [gaim::account username [gaim::connection account $gc]]"
+}
+
+if { 0 } {
+gaim::signal connect signing-off {
+	gaim::debug -info "tcl signal" "signing-off [gaim::account username [gaim::connection account $event::gc]]"
+}
+
+gaim::signal connect update-idle {
+	gaim::debug -info "tcl signal" "update-idle"
+}
+}
+
+proc plugin_init { } {
+	list "Tcl Signal Test" \
+             "$gaim::version" \
+             "Debugs a ridiculous amount of signal information." \
+             "Ethan Blanton <[e-mail]>" \
+             "http://gaim.sourceforge.net/"
+}

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/tcl/tcl.c	Tue Sep 02 03:34:37 2003 +0000
@@ -0,0 +1,366 @@
+/**
+ * @file tcl.c Gaim Tcl plugin bindings
+ *
+ * gaim
+ *
+ * Copyright (C) 2003 Ethan Blanton <[e-mail]>
+ * 
+ * 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
+ */
+
+#include "config.h"
+
+#include <tcl.h>
+
+#ifdef HAVE_TK
+#include <tk.h>
+#endif
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <string.h>
+
+#include "tcl_glib.h"
+#include "tcl_gaim.h"
+
+#include "internal.h"
+#include "connection.h"
+#include "plugin.h"
+#include "signals.h"
+#include "debug.h"
+#include "util.h"
+
+struct tcl_plugin_data {
+	GaimPlugin *plugin;
+	Tcl_Interp *interp;
+};
+
+static GHashTable *tcl_plugins = NULL;
+
+GaimPlugin *_tcl_plugin;
+
+GaimPlugin *tcl_interp_get_plugin(Tcl_Interp *interp)
+{
+	struct tcl_plugin_data *data;
+
+	if (tcl_plugins == NULL)
+		return NULL;
+
+	data = g_hash_table_lookup(tcl_plugins, (gpointer)interp);
+	return data != NULL ? data->plugin : NULL;
+}
+
+static int tcl_init_interp(Tcl_Interp *interp)
+{
+	char *rcfile;
+	char init[] = 
+		"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"
+		"\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"
+		"\n"
+		"		if {![string length $myalias]} {\n"
+		"			set myalias [gaim::account username $account]\n"
+		"		}\n"
+		"\n"
+		"		gaim::send_im $gc $who $text\n"
+		"		gaim::conversation write $convo	send $myalias $text\n"
+		"	}\n"
+		"}\n"
+		"\n"
+		"proc bgerror { message } {\n"
+		"	global errorInfo\n"
+		"	gaim::notify -error \"Tcl Error\" \"Tcl Error: $message\" \"$errorInfo\"\n"
+		"}\n";
+
+	if (Tcl_EvalEx(interp, init, -1, TCL_EVAL_GLOBAL) != TCL_OK) {
+		return 1;
+	}
+
+	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);
+	g_free(rcfile);
+
+	Tcl_SetVar(interp, "::gaim::version", VERSION, TCL_GLOBAL_ONLY);
+	Tcl_SetVar(interp, "::gaim::user_dir", gaim_user_dir(), TCL_GLOBAL_ONLY);
+#ifdef HAVE_TK
+	Tcl_SetVar(interp, "::gaim::tk_available", "1", TCL_GLOBAL_ONLY);
+#else
+	Tcl_SetVar(interp, "::gaim::tk_available", "0", TCL_GLOBAL_ONLY);
+#endif /* HAVE_TK */
+
+	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);
+
+	return 0;
+}
+
+static Tcl_Interp *tcl_create_interp()
+{
+	Tcl_Interp *interp;
+
+	interp = Tcl_CreateInterp();
+	if (Tcl_Init(interp) == TCL_ERROR) {
+		Tcl_DeleteInterp(interp);
+		return NULL;
+	}
+
+#ifdef HAVE_TK
+	Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
+#endif /* HAVE_TK */
+
+	if (tcl_init_interp(interp)) {
+		Tcl_DeleteInterp(interp);
+		return NULL;
+	}
+	Tcl_StaticPackage(interp, "gaim", tcl_init_interp, NULL);
+
+	return interp;
+}
+
+static gboolean tcl_probe_plugin(GaimPlugin *plugin)
+{
+	GaimPluginInfo *info;
+	Tcl_Interp *interp;
+	Tcl_Parse parse;
+	Tcl_Obj *result, **listitems;
+	struct stat st;
+	FILE *fp;
+	char *buf, *cur;
+	int len, found = 0, err = 0, nelems;
+	gboolean status = FALSE;
+
+	if ((fp = fopen(plugin->path, "r")) == NULL)
+		return FALSE;
+	if (fstat(fileno(fp), &st)) {
+		fclose(fp);
+		return FALSE;
+	}
+	len = st.st_size;
+
+	buf = g_malloc(len + 1);
+	if ((fread(buf, len, 1, fp)) != 1) {
+		g_free(buf);
+		fclose(fp);
+		return FALSE;
+	}
+	fclose(fp);
+	buf[len] = '\0';
+
+	if ((interp = tcl_create_interp()) == NULL) {
+		return FALSE;
+	}
+
+	cur = buf;
+	do {
+		if (Tcl_ParseCommand(interp, cur, len, 0, &parse) == TCL_ERROR) {
+			gaim_debug(GAIM_DEBUG_ERROR, "tcl", "parse error in %s: %s\n", plugin->path,
+				   Tcl_GetString(Tcl_GetObjResult(interp)));
+			err = 1;
+			break;
+		}
+		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) {
+					Tcl_FreeParse(&parse);
+					break;
+				}
+				found = 1;
+				/* We'll continue parsing the file, just in case */
+			}
+		}
+		len -= (parse.commandStart + parse.commandSize) - cur;
+		cur = parse.commandStart + parse.commandSize;
+		Tcl_FreeParse(&parse);
+	} while (len);
+
+	if (found && !err) {
+		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) {
+				if (nelems == 5) {
+					info = g_new0(GaimPluginInfo, 1);
+					
+					info->api_version = 2;
+					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->description = g_strdup(Tcl_GetString(listitems[2]));;
+					info->author = g_strdup(Tcl_GetString(listitems[3]));
+					info->homepage = g_strdup(Tcl_GetString(listitems[4]));
+					
+					plugin->info = info;
+					
+					if (gaim_plugin_register(plugin))
+						status = TRUE;
+				}
+			}
+		}
+	}
+
+	Tcl_DeleteInterp(interp);
+	g_free(buf);
+	return status;
+}
+
+static gboolean tcl_load_plugin(GaimPlugin *plugin)
+{
+	struct tcl_plugin_data *data;
+	Tcl_Interp *interp;
+	Tcl_Obj *result;
+
+	plugin->extra = NULL;
+
+	if ((interp = tcl_create_interp()) == NULL) {
+		gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Could not initialize Tcl interpreter\n");
+		return FALSE;
+	}
+
+	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);
+		return FALSE;
+	}
+
+	Tcl_Preserve((ClientData)interp);
+
+	data = g_new0(struct tcl_plugin_data, 1);
+	data->plugin = plugin;
+	data->interp = interp;
+	plugin->extra = data;
+
+	g_hash_table_insert(tcl_plugins, (gpointer)interp, (gpointer)data);
+
+	return TRUE;
+}
+
+static gboolean tcl_unload_plugin(GaimPlugin *plugin)
+{
+	struct tcl_plugin_data *data;
+
+	if (plugin == NULL)
+		return TRUE;
+
+	data = plugin->extra;
+
+	g_hash_table_remove(tcl_plugins, (gpointer)data);
+	if (data != NULL) {
+		gaim_signals_disconnect_by_handle(data->interp);
+		tcl_signal_cleanup(data->interp);
+		Tcl_Release((ClientData)data->interp);
+		Tcl_DeleteInterp(data->interp);
+		g_free(data);
+	}
+
+	return TRUE;
+}
+
+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);
+	}
+
+	return;
+}
+
+static gboolean tcl_load(GaimPlugin *plugin)
+{
+	tcl_glib_init();
+	tcl_signal_init();
+	tcl_plugins = g_hash_table_new(g_direct_hash, g_direct_equal);
+
+	return TRUE;
+}
+
+static gboolean tcl_unload(GaimPlugin *plugin)
+{
+	g_hash_table_destroy(tcl_plugins);
+	tcl_plugins = NULL;
+
+	return TRUE;
+}
+
+static GaimPluginLoaderInfo tcl_loader_info =
+{
+	NULL,
+	tcl_probe_plugin,
+	tcl_load_plugin,
+	tcl_unload_plugin,
+	tcl_destroy_plugin,
+};
+
+static GaimPluginInfo tcl_info =
+{
+	2,
+	GAIM_PLUGIN_LOADER,
+	NULL,
+	0,
+	NULL,
+	GAIM_PRIORITY_DEFAULT,
+	"core-tcl",
+	N_("Tcl Plugin Loader"),
+	VERSION,
+	N_("Provides support for loading Tcl plugins"),
+	N_("Provides support for loading Tcl plugins"),
+	"Ethan Blanton <[e-mail]>",
+	GAIM_WEBSITE,
+	tcl_load,
+	tcl_unload,
+	NULL,
+	NULL,
+	&tcl_loader_info
+};
+
+static void tcl_init_plugin(GaimPlugin *plugin)
+{
+	_tcl_plugin = plugin;
+
+	Tcl_FindExecutable("gaim");
+
+	tcl_loader_info.exts = g_list_append(tcl_loader_info.exts, "tcl");
+}
+
+GAIM_INIT_PLUGIN(tcl, tcl_init_plugin, tcl_info);

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/tcl/tcl_cmds.c	Tue Sep 02 03:34:37 2003 +0000
@@ -0,0 +1,913 @@
+/**
+ * @file tcl_cmds.c Commands for the Gaim Tcl plugin bindings
+ *
+ * gaim
+ *
+ * Copyright (C) 2003 Ethan Blanton <[e-mail]>
+ * 
+ * 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
+ */
+
+#include <tcl.h>
+
+#include "internal.h"
+#include "conversation.h"
+#include "connection.h"
+#include "account.h"
+#include "server.h"
+#include "notify.h"
+#include "debug.h"
+#include "prefs.h"
+#include "core.h"
+
+#include "tcl_gaim.h"
+
+static gboolean tcl_validate_account(GaimAccount *account, Tcl_Interp *interp);
+static gboolean tcl_validate_gc(GaimConnection *gc);
+
+static gboolean tcl_validate_account(GaimAccount *account, Tcl_Interp *interp)
+{
+	GList *cur;
+	for (cur = gaim_accounts_get_all(); cur != NULL; cur = g_list_next(cur)) {
+		if (account == cur->data)
+			return TRUE;
+	}
+	if (interp != NULL)
+		Tcl_SetStringObj(Tcl_GetObjResult(interp), "invalid account", -1);
+	return FALSE;
+}
+
+static gboolean tcl_validate_conversation(GaimConversation *convo, Tcl_Interp *interp)
+{
+	GList *cur;
+
+	for (cur = gaim_get_conversations(); cur != NULL; cur = g_list_next(cur)) {
+		if (convo == cur->data)
+			return TRUE;
+	}
+	if (interp != NULL)
+		Tcl_SetStringObj(Tcl_GetObjResult(interp), "invalid account", -1);
+	return FALSE;
+}
+
+static gboolean tcl_validate_gc(GaimConnection *gc)
+{
+	GList *cur;
+	for (cur = gaim_connections_get_all(); cur != NULL; cur = g_list_next(cur)) {
+		if (gc == cur->data)
+			return TRUE;
+	}
+	return FALSE;
+}
+
+int tcl_cmd_account(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	Tcl_Obj *result = Tcl_GetObjResult(interp), *list, *elem;
+	char *cmds[] = { "alias", "connect", "connection", "disconnect", "find", 
+			 "handle", "isconnected", "list", "protocol", "username",
+			 NULL };
+	enum { CMD_ACCOUNT_ALIAS, CMD_ACCOUNT_CONNECT, CMD_ACCOUNT_CONNECTION,
+	       CMD_ACCOUNT_DISCONNECT, CMD_ACCOUNT_FIND, CMD_ACCOUNT_HANDLE,
+	       CMD_ACCOUNT_ISCONNECTED, CMD_ACCOUNT_LIST, CMD_ACCOUNT_PROTOCOL,
+	       CMD_ACCOUNT_USERNAME } cmd;
+	char *listopts[] = { "-all", "-online", NULL };
+	enum { CMD_ACCOUNTLIST_ALL, CMD_ACCOUNTLIST_ONLINE } listopt;
+	const char *alias;
+	GList *cur;
+	GaimAccount *account;
+	int error;
+
+	if (objc < 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
+		return TCL_ERROR;
+	}
+
+	if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK)
+		return error;
+
+	switch (cmd) {
+	case CMD_ACCOUNT_ALIAS:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "account");
+			return TCL_ERROR;
+		}
+		error = Tcl_GetIntFromObj(interp, objv[2], (int *)&account);
+		if (error || !tcl_validate_account(account, interp))
+			return TCL_ERROR;
+		alias = gaim_account_get_alias(account);
+		Tcl_SetStringObj(result, alias ? (char *)alias : "", -1);
+		break;
+	case CMD_ACCOUNT_CONNECT:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "account");
+			return TCL_ERROR;
+		}
+		error = Tcl_GetIntFromObj(interp, objv[2], (int *)&account);
+		if (error || !tcl_validate_account(account, interp))
+			return TCL_ERROR;
+		if (gaim_account_is_connected(account))
+			Tcl_SetIntObj(result, (int)gaim_account_get_connection(account));
+		else
+			Tcl_SetIntObj(result, (int)gaim_account_connect(account));
+		break;
+	case CMD_ACCOUNT_CONNECTION:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "account");
+			return TCL_ERROR;
+		}
+		error = Tcl_GetIntFromObj(interp, objv[2], (int *)&account);
+		if (error || !tcl_validate_account(account, interp))
+			return TCL_ERROR;
+		Tcl_SetIntObj(result, (int)gaim_account_get_connection(account));
+		break;
+	case CMD_ACCOUNT_DISCONNECT:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "account");
+			return TCL_ERROR;
+		}
+		error = Tcl_GetIntFromObj(interp, objv[2], (int *)&account);
+		if (error || !tcl_validate_account(account, interp))
+			return TCL_ERROR;
+		gaim_account_disconnect(account);
+		break;
+	case CMD_ACCOUNT_FIND:
+		if (objc != 4) {
+			Tcl_WrongNumArgs(interp, 2, objv, "username protocol");
+			return TCL_ERROR;
+		}
+		Tcl_SetIntObj(result, (int)gaim_accounts_find_with_prpl_id(Tcl_GetString(objv[2]),
+									   Tcl_GetString(objv[3])));
+		break;
+	case CMD_ACCOUNT_HANDLE:
+		if (objc != 2) {
+			Tcl_WrongNumArgs(interp, 2, objv, "");
+			return TCL_ERROR;
+		}
+		Tcl_SetIntObj(result, (int)gaim_accounts_get_handle());
+		break;
+	case CMD_ACCOUNT_ISCONNECTED:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "account");
+			return TCL_ERROR;
+		}
+		error = Tcl_GetIntFromObj(interp, objv[2], (int *)&account);
+		if (error || !tcl_validate_account(account, interp))
+			return TCL_ERROR;
+		Tcl_SetBooleanObj(result, gaim_account_is_connected(account));
+		break;
+	case CMD_ACCOUNT_LIST:
+		listopt = CMD_ACCOUNTLIST_ALL;
+		if (objc > 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "?option?");
+			return TCL_ERROR;
+		}
+		if (objc == 3) {
+			if ((error = Tcl_GetIndexFromObj(interp, objv[2], listopts, "option", 0, (int *)&listopt)) != TCL_OK)
+				return error;
+		}
+		list = Tcl_NewListObj(0, NULL);
+		for (cur = gaim_accounts_get_all(); cur != NULL; cur = g_list_next(cur)) {
+			account = cur->data;
+			if (listopt == CMD_ACCOUNTLIST_ONLINE && !gaim_account_is_connected(account))
+				continue;
+			elem = Tcl_NewIntObj((int)account);
+			Tcl_ListObjAppendElement(interp, list, elem);
+		}
+		Tcl_SetObjResult(interp, list);
+		break;
+	case CMD_ACCOUNT_PROTOCOL:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "account");
+			return TCL_ERROR;
+		}
+		error = Tcl_GetIntFromObj(interp, objv[2], (int *)&account);
+		if (error || !tcl_validate_account(account, interp))
+			return TCL_ERROR;
+		Tcl_SetStringObj(result, (char *)gaim_account_get_protocol_id(account), -1);
+		break;
+	case CMD_ACCOUNT_USERNAME:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "account");
+			return TCL_ERROR;
+		}
+		error = Tcl_GetIntFromObj(interp, objv[2], (int *)&account);
+		if (error || !tcl_validate_account(account, interp))
+			return TCL_ERROR;
+		Tcl_SetStringObj(result, (char *)gaim_account_get_username(account), -1);
+		break;
+	}
+
+	return TCL_OK;
+}
+
+static GaimBlistNode *tcl_list_to_buddy(Tcl_Interp *interp, int count, Tcl_Obj **elems)
+{
+	GaimBlistNode *node = NULL;
+	GaimAccount *account;
+	char *name;
+	char *type;
+
+	if (count < 3) {
+		Tcl_SetStringObj(Tcl_GetObjResult(interp), "list too short", -1);
+		return NULL;
+	}
+
+	type = Tcl_GetString(elems[0]);
+	name = Tcl_GetString(elems[1]);
+	if (Tcl_GetIntFromObj(interp, elems[2], (int *)&account) != TCL_OK)
+		return NULL;
+	if (!tcl_validate_account(account, interp))
+		return NULL;
+
+	if (!strcmp(type, "buddy")) {
+		node = (GaimBlistNode *)gaim_find_buddy(account, name);
+	} else if (!strcmp(type, "group")) {
+		node = (GaimBlistNode *)gaim_blist_find_chat(account, name);
+	}
+
+	return node;
+}
+
+int tcl_cmd_buddy(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	Tcl_Obj *list, *tclgroup, *tclgrouplist, *tclbud, **elems, *result;
+	char *cmds[] = { "alias", "handle", "info", "list", NULL };
+	enum { CMD_BUDDY_ALIAS, CMD_BUDDY_HANDLE, CMD_BUDDY_INFO, CMD_BUDDY_LIST } cmd;
+	struct gaim_buddy_list *blist;
+	GaimBlistNode *node, *gnode;
+	GaimAccount *account;
+	struct buddy *bnode;
+	struct chat *cnode;
+	int error, all = 0, count;
+
+	if (objc < 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
+		return TCL_ERROR;
+	}
+	if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK)
+		return error;
+
+	result = Tcl_GetObjResult(interp);
+
+	switch (cmd) {
+	case CMD_BUDDY_ALIAS:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "buddy");
+			return TCL_ERROR;
+		}
+		if ((error = Tcl_ListObjGetElements(interp, objv[2], &count, &elems)) != TCL_OK)
+			return error;
+		if ((node = tcl_list_to_buddy(interp, count, elems)) == NULL)
+			return TCL_ERROR;
+		if (node->type == GAIM_BLIST_CHAT_NODE)
+			Tcl_SetStringObj(result, ((struct chat *)node)->alias, -1);
+		else if (node->type == GAIM_BLIST_BUDDY_NODE)
+			Tcl_SetStringObj(result, gaim_get_buddy_alias((struct buddy *)node), -1);
+		return TCL_OK;
+		break;
+	case CMD_BUDDY_HANDLE:
+		if (objc != 2) {
+			Tcl_WrongNumArgs(interp, 2, objv, "");
+			return TCL_ERROR;
+		}
+		Tcl_SetIntObj(result, (int)gaim_blist_get_handle());
+		break;
+	case CMD_BUDDY_INFO:
+		if (objc != 3 && objc != 4) {
+			Tcl_WrongNumArgs(interp, 2, objv, "( buddy | account username )");
+			return TCL_ERROR;
+		}
+		if (objc == 3) {
+			if ((error = Tcl_ListObjGetElements(interp, objv[2], &count, &elems)) != TCL_OK)
+				return error;
+			if (count < 3) {
+				Tcl_SetStringObj(result, "buddy too short", -1);
+				return TCL_ERROR;
+			}
+			if (strcmp("buddy", Tcl_GetString(elems[0]))) {
+				Tcl_SetStringObj(result, "invalid buddy", -1);
+				return TCL_ERROR;
+			}
+			if ((error = Tcl_GetIntFromObj(interp, elems[2], (int *)&account)) != TCL_OK)
+				return TCL_ERROR;
+			if (!tcl_validate_account(account, interp))
+				return TCL_ERROR;
+			serv_get_info(gaim_account_get_connection(account), Tcl_GetString(elems[1]));
+		} else {
+			if ((error = Tcl_GetIntFromObj(interp, objv[2], (int *)&account)) != TCL_OK)
+				return error;
+			if (!tcl_validate_account(account, interp))
+				return TCL_ERROR;
+			serv_get_info(gaim_account_get_connection(account), Tcl_GetString(objv[3]));
+		}
+		break;
+	case CMD_BUDDY_LIST:
+		if (objc == 3) {
+			if (!strcmp("-all", Tcl_GetString(objv[2]))) {
+				all = 1;
+			} else {
+				Tcl_SetStringObj(result, "", -1);
+				Tcl_AppendStringsToObj(result, "unknown option: ", Tcl_GetString(objv[2]), NULL);
+				return TCL_ERROR;
+			}
+		}
+		list = Tcl_NewListObj(0, NULL);
+		blist = gaim_get_blist();
+		for (gnode = blist->root; gnode != NULL; gnode = gnode->next) {
+			tclgroup = Tcl_NewListObj(0, NULL);
+			Tcl_ListObjAppendElement(interp, tclgroup, Tcl_NewStringObj("group", -1));
+			Tcl_ListObjAppendElement(interp, tclgroup,
+						 Tcl_NewStringObj(((struct group *)gnode)->name, -1));
+			tclgrouplist = Tcl_NewListObj(0, NULL);
+			for (node = gnode->child; node != NULL; node = node->next) {
+				switch (node->type) {
+				case GAIM_BLIST_BUDDY_NODE:
+					bnode = (struct buddy *)node;
+					if (!all && !gaim_account_is_connected(bnode->account))
+						continue;
+					tclbud = Tcl_NewListObj(0, NULL);
+					Tcl_ListObjAppendElement(interp, tclbud, Tcl_NewStringObj("buddy", -1));
+					Tcl_ListObjAppendElement(interp, tclbud, Tcl_NewStringObj(bnode->name, -1));
+					Tcl_ListObjAppendElement(interp, tclbud, Tcl_NewIntObj((int)bnode->account));
+					break;
+				case GAIM_BLIST_CHAT_NODE:
+					cnode = (struct chat *)node;
+					if (!all && !gaim_account_is_connected(cnode->account))
+						continue;
+					tclbud = Tcl_NewListObj(0, NULL);
+					Tcl_ListObjAppendElement(interp, tclbud, Tcl_NewStringObj("chat", -1));
+					Tcl_ListObjAppendElement(interp, tclbud, Tcl_NewStringObj(cnode->alias, -1));
+					Tcl_ListObjAppendElement(interp, tclbud, Tcl_NewIntObj((int)cnode->account));
+					break;
+				default:
+					continue;
+				}
+				Tcl_ListObjAppendElement(interp, tclgrouplist, tclbud);
+			}
+			Tcl_ListObjAppendElement(interp, tclgroup, tclgrouplist);
+			Tcl_ListObjAppendElement(interp, list, tclgroup);
+		}
+		Tcl_SetObjResult(interp, list);
+		break;
+	}
+
+	return TCL_OK;
+}
+
+int tcl_cmd_connection(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	Tcl_Obj *result = Tcl_GetObjResult(interp), *list, *elem;
+	char *cmds[] = { "account", "handle", "list", NULL };
+	enum { CMD_CONN_ACCOUNT, CMD_CONN_HANDLE, CMD_CONN_LIST } cmd;
+	int error;
+	GList *cur;
+	GaimConnection *gc;
+
+	if (objc < 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
+		return TCL_ERROR;
+	}
+
+	if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK)
+		return error;
+
+	switch (cmd) {
+	case CMD_CONN_ACCOUNT:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, _("gc"));
+			return TCL_ERROR;
+		}
+		error = Tcl_GetIntFromObj(interp, objv[2], (int *)&gc);
+		if (error || !tcl_validate_gc(gc)) {
+			Tcl_SetStringObj(result, "invalid gc", -1);
+			return TCL_ERROR;
+		}
+		Tcl_SetIntObj(result, (int)gaim_connection_get_account(gc));
+		break;
+	case CMD_CONN_HANDLE:
+		if (objc != 2) {
+			Tcl_WrongNumArgs(interp, 2, objv, "");
+			return TCL_ERROR;
+		}
+		Tcl_SetIntObj(result, (int)gaim_connections_get_handle());
+		break;
+	case CMD_CONN_LIST:
+		if (objc != 2) {
+			Tcl_WrongNumArgs(interp, 2, objv, "");
+			return TCL_ERROR;
+		}
+		list = Tcl_NewListObj(0, NULL);
+		for (cur = gaim_connections_get_all(); cur != NULL; cur = g_list_next(cur)) {
+			elem = Tcl_NewIntObj((int)cur->data);
+			Tcl_ListObjAppendElement(interp, list, elem);
+		}
+		Tcl_SetObjResult(interp, list);
+		break;
+	}
+
+	return TCL_OK;
+}
+
+int tcl_cmd_conversation(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	Tcl_Obj *list, *elem, *result = Tcl_GetObjResult(interp);
+	char *cmds[] = { "find", "handle", "list", "new", "write", NULL };
+	enum { CMD_CONV_FIND, CMD_CONV_HANDLE, CMD_CONV_LIST, CMD_CONV_NEW, CMD_CONV_WRITE } cmd;
+	char *styles[] = { "send", "recv", "system", NULL };
+	enum { CMD_CONV_WRITE_SEND, CMD_CONV_WRITE_RECV, CMD_CONV_WRITE_SYSTEM } style;
+	char *findopts[] = { "-account", NULL };
+	enum { CMD_CONV_FIND_ACCOUNT } findopt;
+	char *newopts[] = { "-chat", "-im" };
+	enum { CMD_CONV_NEW_CHAT, CMD_CONV_NEW_IM } newopt;
+	GaimConversation *convo;
+	GaimAccount *account;
+	GaimConversationType type;
+	GList *cur;
+	char *opt, *from, *what;
+	int error, argsused, flags;
+
+	if (objc < 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
+		return TCL_ERROR;
+	}
+
+	if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK)
+		return error;
+
+	switch (cmd) {
+	case CMD_CONV_FIND:
+		if (objc < 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "?options? name");
+			return TCL_ERROR;
+		}
+		argsused = 2;
+		account = NULL;
+		while (argsused < objc) {
+			opt = Tcl_GetString(objv[argsused]);
+			if (*opt == '-') {
+				if ((error = Tcl_GetIndexFromObj(interp, objv[argsused], findopts,
+								 "option", 0, (int *)&findopt)) != TCL_OK)
+					return error;
+				argsused++;
+				switch (findopt) {
+				case CMD_CONV_FIND_ACCOUNT:
+					if (argsused == objc - 1) {
+						Tcl_SetStringObj(result, "-account requires an argument", -1);
+						return TCL_ERROR;
+					}
+					if ((error = Tcl_GetIntFromObj(interp, objv[argsused],
+								       (int *)&account)) != TCL_OK)
+						return error;
+					if (!tcl_validate_account(account, interp))
+						return TCL_ERROR;
+					argsused++;
+					break;
+				}
+			} else {
+				break;
+			}
+		}
+		if (objc - argsused != 1) {
+			Tcl_WrongNumArgs(interp, 2, objv, "?options? name");
+			return error;
+		}
+		if (account != NULL) {
+			convo = gaim_find_conversation_with_account(Tcl_GetString(objv[argsused]), account);
+		} else {
+			convo = gaim_find_conversation(Tcl_GetString(objv[argsused]));
+		}
+		Tcl_SetIntObj(result, (int)convo);
+		break;
+	case CMD_CONV_HANDLE:
+		if (objc != 2) {
+			Tcl_WrongNumArgs(interp, 2, objv, "");
+			return TCL_ERROR;
+		}
+		Tcl_SetIntObj(result, (int)gaim_conversations_get_handle());
+		break;
+	case CMD_CONV_LIST:
+		list = Tcl_NewListObj(0, NULL);
+		for (cur = gaim_get_conversations(); cur != NULL; cur = g_list_next(cur)) {
+			elem = Tcl_NewIntObj((int)cur->data);
+			Tcl_ListObjAppendElement(interp, list, elem);
+		}
+		Tcl_SetObjResult(interp, list);
+		break;
+	case CMD_CONV_NEW:
+		if (objc < 4) {
+			Tcl_WrongNumArgs(interp, 2, objv, "?options? account name");
+			return TCL_ERROR;
+		}
+		argsused = 2;
+		type = GAIM_CONV_IM;
+		while (argsused < objc) {
+			opt = Tcl_GetString(objv[argsused]);
+			if (*opt == '-') {
+				if ((error = Tcl_GetIndexFromObj(interp, objv[argsused], newopts,
+								 "option", 0, (int *)&newopt)) != TCL_OK)
+					return error;
+				argsused++;
+				switch (newopt) {
+				case CMD_CONV_NEW_CHAT:
+					type = GAIM_CONV_CHAT;
+					break;
+				case CMD_CONV_NEW_IM:
+					type = GAIM_CONV_IM;
+					break;
+				}
+			} else {
+				break;
+			}
+		}
+		if (objc - argsused != 2) {
+			Tcl_WrongNumArgs(interp, 2, objv, "?options? account name");
+			return TCL_ERROR;
+		}
+		if ((error = Tcl_GetIntFromObj(interp, objv[argsused++], (int *)&account)) != TCL_OK)
+			return error;
+		if (!tcl_validate_account(account, interp))
+			return TCL_ERROR;
+		convo = gaim_conversation_new(type, account, Tcl_GetString(objv[argsused]));
+		Tcl_SetIntObj(result, (int)convo);
+		break;
+	case CMD_CONV_WRITE:
+		if (objc != 6) {
+			Tcl_WrongNumArgs(interp, 2, objv, "conversation style from what");
+			return TCL_ERROR;
+		}
+		if ((error = Tcl_GetIntFromObj(interp, objv[2], (int *)&convo)) != TCL_OK)
+			return error;
+		if ((error = Tcl_GetIndexFromObj(interp, objv[3], styles, "style", 0, (int *)&style)) != TCL_OK)
+			return error;
+		if (!tcl_validate_conversation(convo, interp))
+			return TCL_ERROR;
+		from = Tcl_GetString(objv[4]);
+		what = Tcl_GetString(objv[5]);
+		
+		switch (style) {
+		case CMD_CONV_WRITE_SEND:
+			flags = GAIM_MESSAGE_SEND;
+			break;
+		case CMD_CONV_WRITE_RECV:
+			flags = GAIM_MESSAGE_RECV;
+			break;
+		case CMD_CONV_WRITE_SYSTEM:
+			flags = GAIM_MESSAGE_SYSTEM;
+			break;
+		}
+		if (gaim_conversation_get_type(convo) == GAIM_CONV_CHAT)
+			gaim_chat_write(GAIM_CHAT(convo), from, what, flags, time(NULL));
+		else
+			gaim_im_write(GAIM_IM(convo), from, what, -1, flags, time(NULL));
+		break;
+	}
+
+	return TCL_OK;
+}
+
+int tcl_cmd_core(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	Tcl_Obj *result = Tcl_GetObjResult(interp);
+	char *cmds[] = { "handle", "quit", NULL };
+	enum { CMD_CORE_HANDLE, CMD_CORE_QUIT } cmd;
+	int error;
+
+	if (objc < 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
+		return TCL_ERROR;
+	}
+
+	if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK)
+		return error;
+
+	switch (cmd) {
+	case CMD_CORE_HANDLE:
+		if (objc != 2) {
+			Tcl_WrongNumArgs(interp, 2, objv, "");
+			return TCL_ERROR;
+		}
+		Tcl_SetIntObj(result, (int)gaim_get_core());
+		break;
+	case CMD_CORE_QUIT:
+		if (objc != 2) {
+			Tcl_WrongNumArgs(interp, 2, objv, "");
+			return TCL_ERROR;
+		}
+		gaim_core_quit();
+		break;
+	}
+
+	return TCL_OK;
+}
+
+int tcl_cmd_debug(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	char *category, *message;
+	int lev;
+	char *levels[] = { "-misc", "-info", "-warning", "-error", NULL };
+	GaimDebugLevel levelind[] = { GAIM_DEBUG_MISC, GAIM_DEBUG_INFO, GAIM_DEBUG_WARNING, GAIM_DEBUG_ERROR };
+	int error;
+
+	if (objc != 4) {
+		Tcl_WrongNumArgs(interp, 1, objv, "level category message");
+		return TCL_ERROR;
+	}
+
+	error = Tcl_GetIndexFromObj(interp, objv[1], levels, "debug level", 0, &lev);
+	if (error != TCL_OK)
+		return error;
+
+	category = Tcl_GetString(objv[2]);
+	message = Tcl_GetString(objv[3]);
+
+	gaim_debug(levelind[lev], category, "%s\n", message);
+
+	return TCL_OK;
+}
+
+int tcl_cmd_notify(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	int error, type;
+	char *opts[] = { "-error", "-warning", "-info", NULL };
+	GaimNotifyMsgType optind[] = { GAIM_NOTIFY_MSG_ERROR, GAIM_NOTIFY_MSG_WARNING, GAIM_NOTIFY_MSG_INFO };
+	char *title, *msg1, *msg2;
+
+	if (objc < 4 || objc > 5) {
+		Tcl_WrongNumArgs(interp, 1, objv, "?type? title primary secondary");
+		return TCL_ERROR;
+	}
+
+	if (objc == 4) {
+		title = Tcl_GetString(objv[1]);
+		msg1 = Tcl_GetString(objv[2]);
+		msg2 = Tcl_GetString(objv[3]);
+	} else {
+		error = Tcl_GetIndexFromObj(interp, objv[1], opts, "message type", 0, &type);
+		if (error != TCL_OK)
+			return error;
+		title = Tcl_GetString(objv[2]);
+		msg1 = Tcl_GetString(objv[3]);
+		msg2 = Tcl_GetString(objv[4]);
+	}
+
+	gaim_notify_message(_tcl_plugin, optind[type], title, msg1, msg2, NULL, NULL);
+
+	return TCL_OK;
+}
+
+int tcl_cmd_prefs(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	Tcl_Obj *result, *list, *elem, **elems;
+	char *cmds[] = { "get", "set", "type", NULL };
+	enum { CMD_PREFS_GET, CMD_PREFS_SET, CMD_PREFS_TYPE } cmd;
+	/* char *types[] = { "none", "boolean", "int", "string", "stringlist", NULL }; */
+	/* enum { TCL_PREFS_NONE, TCL_PREFS_BOOL, TCL_PREFS_INT, TCL_PREFS_STRING, TCL_PREFS_STRINGLIST } type; */
+	GaimPrefType preftype;
+	GList *cur;
+	int error, intval, nelem, i;
+
+	if (objc < 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
+		return TCL_ERROR;
+	}
+
+	if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK)
+		return error;
+
+	result = Tcl_GetObjResult(interp);
+	switch (cmd) {
+	case CMD_PREFS_GET:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 1, objv, "path");
+			return TCL_ERROR;
+		}
+		preftype = gaim_prefs_get_type(Tcl_GetString(objv[2]));
+		switch (preftype) {
+		case GAIM_PREF_NONE:
+			Tcl_SetStringObj(result, "pref type none", -1);
+			return TCL_ERROR;
+			break;
+		case GAIM_PREF_BOOLEAN:
+			Tcl_SetBooleanObj(result, gaim_prefs_get_bool(Tcl_GetString(objv[2])));
+			break;
+		case GAIM_PREF_INT:
+			Tcl_SetIntObj(result, gaim_prefs_get_int(Tcl_GetString(objv[2])));
+			break;
+		case GAIM_PREF_STRING:
+			Tcl_SetStringObj(result, (char *)gaim_prefs_get_string(Tcl_GetString(objv[2])), -1);
+			break;
+		case GAIM_PREF_STRING_LIST:
+			cur = gaim_prefs_get_string_list(Tcl_GetString(objv[2]));
+			list = Tcl_NewListObj(0, NULL);
+			while (cur != NULL) {
+				elem = Tcl_NewStringObj((char *)cur->data, -1);
+				Tcl_ListObjAppendElement(interp, list, elem);
+				cur = g_list_next(cur);
+			}
+			Tcl_SetObjResult(interp, list);
+			break;
+		default:
+			gaim_debug(GAIM_DEBUG_ERROR, "tcl", "tcl does not know about pref type %d\n", preftype);
+			Tcl_SetStringObj(result, "unknown pref type", -1);
+			return TCL_ERROR;
+		}
+		break;
+	case CMD_PREFS_SET:
+		if (objc != 4) {
+			Tcl_WrongNumArgs(interp, 1, objv, "path value");
+			return TCL_ERROR;
+		}
+		preftype = gaim_prefs_get_type(Tcl_GetString(objv[2]));
+		switch (preftype) {
+		case GAIM_PREF_NONE:
+			Tcl_SetStringObj(result, "bad path or pref type none", -1);
+			return TCL_ERROR;
+			break;
+		case GAIM_PREF_BOOLEAN:
+			if ((error = Tcl_GetBooleanFromObj(interp, objv[3], &intval)) != TCL_OK)
+				return error;
+			gaim_prefs_set_bool(Tcl_GetString(objv[2]), intval);
+			break;
+		case GAIM_PREF_INT:
+			if ((error = Tcl_GetIntFromObj(interp, objv[3], &intval)) != TCL_OK)
+				return error;
+			gaim_prefs_set_int(Tcl_GetString(objv[2]), intval);
+			break;
+		case GAIM_PREF_STRING:
+			gaim_prefs_set_string(Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
+			break;
+		case GAIM_PREF_STRING_LIST:
+			if ((error = Tcl_ListObjGetElements(interp, objv[3], &nelem, &elems)) != TCL_OK)
+				return error;
+			cur = NULL;
+			for (i = 0; i < nelem; i++) {
+				cur = g_list_append(cur, (gpointer)Tcl_GetString(elems[i]));
+			}
+			gaim_prefs_set_string_list(Tcl_GetString(objv[2]), cur);
+			g_list_free(cur);
+			break;
+		default:
+			gaim_debug(GAIM_DEBUG_ERROR, "tcl", "tcl does not know about pref type %d\n", preftype);
+			return TCL_ERROR;
+		}
+		break;
+	case CMD_PREFS_TYPE:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 1, objv, "path");
+			return TCL_ERROR;
+		}
+		preftype = gaim_prefs_get_type(Tcl_GetString(objv[2]));
+		switch (preftype) {
+		case GAIM_PREF_NONE:
+			Tcl_SetStringObj(result, "none", -1);
+			break;
+		case GAIM_PREF_BOOLEAN:
+			Tcl_SetStringObj(result, "boolean", -1);
+			break;
+		case GAIM_PREF_INT:
+			Tcl_SetStringObj(result, "int", -1);
+			break;
+		case GAIM_PREF_STRING:
+			Tcl_SetStringObj(result, "string", -1);
+			break;
+		case GAIM_PREF_STRING_LIST:
+			Tcl_SetStringObj(result, "stringlist", -1);
+			break;
+		default:
+			gaim_debug(GAIM_DEBUG_ERROR, "tcl", "tcl does not know about pref type %d\n", preftype);
+			Tcl_SetStringObj(result, "unknown", -1);
+		}
+		break;
+	}
+
+	return TCL_OK;
+}
+
+int tcl_cmd_send_im(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	GaimConnection *gc;
+	char *who, *text;
+	int error;
+	Tcl_Obj *result;
+
+	if (objc != 4) {
+		Tcl_WrongNumArgs(interp, 1, objv, "gc who text");
+		return TCL_ERROR;
+	}
+
+	if ((error = Tcl_GetIntFromObj(interp, objv[1], (int *)&gc)) != TCL_OK)
+		return error;
+	if (!tcl_validate_gc(gc)) {
+		result = Tcl_GetObjResult(interp);
+		Tcl_SetStringObj(result, "invalid gc", -1);
+		return TCL_ERROR;
+	}
+
+	who = Tcl_GetString(objv[2]);
+	text = Tcl_GetString(objv[3]);
+
+	serv_send_im(gc, who, text, -1, 0);
+
+	return TCL_OK;
+}
+
+int tcl_cmd_signal(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	char *cmds[] = { "connect", "disconnect", NULL };
+	enum { CMD_SIGNAL_CONNECT, CMD_SIGNAL_DISCONNECT } cmd;
+	struct tcl_signal_handler *handler;
+	Tcl_Obj **elems, *result = Tcl_GetObjResult(interp);
+	void *instance;
+	int error, nelems, i;
+
+	if (objc < 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
+		return TCL_ERROR;
+	}
+
+	if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK)
+		return error;
+
+	switch (cmd) {
+	case CMD_SIGNAL_CONNECT:
+		if (objc != 6) {
+			Tcl_WrongNumArgs(interp, 2, objv, "instance signal args proc");
+			return TCL_ERROR;
+		}
+		if ((error = Tcl_ListObjGetElements(interp, objv[4], &nelems, &elems)) != TCL_OK)
+			return error;
+		handler = g_new0(struct tcl_signal_handler, 1);
+		if ((error = Tcl_GetIntFromObj(interp, objv[2], (int *)&handler->instance)) != TCL_OK) {
+			g_free(handler);
+			return error;
+		}
+		handler->signal = g_strdup(Tcl_GetString(objv[3]));
+		if (nelems) {
+			handler->argnames = g_new0(char *, nelems);
+			for (i = 0; i < nelems; i++) {
+				handler->argnames[i] = g_strdup(Tcl_GetString(elems[i]));
+			}
+		}
+		handler->nnames = nelems;
+		handler->proc = Tcl_NewStringObj("namespace eval ::gaim::_callback { ", -1);
+		Tcl_AppendStringsToObj(handler->proc, Tcl_GetString(objv[5]), " }", NULL);
+		Tcl_IncrRefCount(handler->proc);
+		handler->interp = interp;
+		if (!tcl_signal_connect(handler)) {
+			tcl_signal_handler_free(handler);
+			Tcl_SetIntObj(result, 1);
+		} else {
+			Tcl_SetIntObj(result, 0);
+		}
+		break;
+	case CMD_SIGNAL_DISCONNECT:
+		if (objc != 4) {
+			Tcl_WrongNumArgs(interp, 2, objv, "signal");
+			return TCL_ERROR;
+		}
+		if ((error = Tcl_GetIntFromObj(interp, objv[2], (int *)&instance)) != TCL_OK)
+			return error;
+		tcl_signal_disconnect(instance, Tcl_GetString(objv[3]), interp);
+		break;
+	}
+
+	return TCL_OK;
+}
+
+static gboolean unload_self(gpointer data)
+{
+	GaimPlugin *plugin = data;
+	gaim_plugin_unload(plugin);
+	return FALSE;
+}
+
+int tcl_cmd_unload(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	GaimPlugin *plugin;
+	if (objc != 1) {
+		Tcl_WrongNumArgs(interp, 1, objv, "");
+		return TCL_ERROR;
+	}
+
+	if ((plugin = tcl_interp_get_plugin(interp)) == NULL) {
+		/* This isn't exactly OK, but heh.  What do you do? */
+		return TCL_OK;
+	}
+	/* We can't unload immediately, but we can unload at the first 
+	 * known safe opportunity. */
+	g_idle_add(unload_self, (gpointer)plugin);
+
+	return TCL_OK;
+}

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/tcl/tcl_gaim.h	Tue Sep 02 03:34:37 2003 +0000
@@ -0,0 +1,69 @@
+/**
+ * @file tcl_gaim.h Gaim Tcl definitions
+ *
+ * gaim
+ *
+ * Copyright (C) 2003 Ethan Blanton <[e-mail]>
+ * 
+ * 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
+ */
+
+#ifndef _GAIM_TCL_GAIM_H_
+#define _GAIM_TCL_GAIM_H_
+
+#include <tcl.h>
+
+#include "internal.h"
+#include "plugin.h"
+#include "value.h"
+
+struct tcl_signal_handler {
+	char *signal;
+	Tcl_Interp *interp;
+
+	void *instance;
+	Tcl_Obj *proc;
+	int nnames;
+	char **argnames;
+
+	GaimValue *returntype;
+	int nargs;
+	GaimValue **argtypes;
+};
+
+extern GaimPlugin *_tcl_plugin;
+
+GaimPlugin *tcl_interp_get_plugin(Tcl_Interp *interp);
+
+void tcl_signal_init();
+void tcl_signal_handler_free(struct tcl_signal_handler *handler);
+void tcl_signal_cleanup(Tcl_Interp *interp);
+gboolean tcl_signal_connect(struct tcl_signal_handler *handler);
+void tcl_signal_disconnect(void *instance, const char *signal, Tcl_Interp *interp);
+
+Tcl_ObjCmdProc tcl_cmd_account;
+Tcl_ObjCmdProc tcl_cmd_signal_connect;
+Tcl_ObjCmdProc tcl_cmd_buddy;
+Tcl_ObjCmdProc tcl_cmd_connection;
+Tcl_ObjCmdProc tcl_cmd_conversation;
+Tcl_ObjCmdProc tcl_cmd_core;
+Tcl_ObjCmdProc tcl_cmd_debug;
+Tcl_ObjCmdProc tcl_cmd_notify;
+Tcl_ObjCmdProc tcl_cmd_prefs;
+Tcl_ObjCmdProc tcl_cmd_send_im;
+Tcl_ObjCmdProc tcl_cmd_signal;
+Tcl_ObjCmdProc tcl_cmd_unload;
+
+#endif /* _GAIM_TCL_GAIM_H_ */

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/tcl/tcl_glib.c	Tue Sep 02 03:34:37 2003 +0000
@@ -0,0 +1,225 @@
+/*
+ * Tcl/Glib glue
+ *
+ * Copyright (C) 2003 Ethan Blanton <[e-mail]>
+ * 
+ * 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
+ * 
+ * NOTES
+ * 
+ * This file was developed for the Gaim project.  It inserts the Tcl
+ * event loop into the glib2 event loop for the purposes of providing
+ * Tcl bindings in a glib2 (e.g. Gtk2) program.  To use it, simply
+ * link it into your executable, include tcl_glib.h, and call the
+ * function tcl_glib_init() before creating or using any Tcl
+ * interpreters.  Then go ahead and use Tcl, Tk, whatever to your
+ * heart's content.
+ * 
+ * BUGS
+ * 
+ * tcl_wait_for_event seems to have a bug that makes vwait not work so
+ * well...  I'm not sure why, yet, but I haven't put much time into
+ * it.  Hopefully I will figure it out soon.  In the meantime, this
+ * means that Tk's bgerror function (which is called when there is an
+ * error in a callback function) causes some Bad Mojo -- you should
+ * override it with a function that does not use Tk
+ */
+
+#include <tcl.h>
+#include <glib.h>
+#include <string.h>
+
+#include "tcl_glib.h"
+
+struct tcl_file_handler {
+	int source;
+	int fd;
+	int mask;
+	int pending;
+	Tcl_FileProc *proc;
+	ClientData data;
+};
+
+struct tcl_file_event {
+	Tcl_Event header;
+	int fd;
+};
+
+static guint tcl_timer;
+static gboolean tcl_timer_pending;
+static GHashTable *tcl_file_handlers;
+
+static void tcl_set_timer(Tcl_Time *timePtr);
+static int tcl_wait_for_event(Tcl_Time *timePtr);
+static void tcl_create_file_handler(int fd, int mask, Tcl_FileProc *proc, ClientData data);
+static void tcl_delete_file_handler(int fd);
+
+static gboolean tcl_kick(gpointer data);
+static gboolean tcl_file_callback(GIOChannel *source, GIOCondition condition, gpointer data);
+static int tcl_file_event_callback(Tcl_Event *event, int flags);
+
+ClientData Tcl_InitNotifier()
+{
+	return NULL;
+}
+
+void tcl_glib_init ()
+{
+	Tcl_NotifierProcs notifier;
+
+	notifier.createFileHandlerProc = tcl_create_file_handler;
+	notifier.deleteFileHandlerProc = tcl_delete_file_handler;
+	notifier.setTimerProc = tcl_set_timer;
+	notifier.waitForEventProc = tcl_wait_for_event;
+
+	Tcl_SetNotifier(&notifier);
+	Tcl_SetServiceMode(TCL_SERVICE_ALL);
+
+	tcl_timer_pending = FALSE;
+	tcl_file_handlers = g_hash_table_new(g_direct_hash, g_direct_equal);
+}
+
+static void tcl_set_timer(Tcl_Time *timePtr)
+{
+	guint interval;
+
+	if (tcl_timer_pending)
+		g_source_remove(tcl_timer);
+
+	if (timePtr == NULL) {
+		tcl_timer_pending = FALSE;
+		return;
+	}
+
+	interval = timePtr->sec * 1000 + (timePtr->usec ? timePtr->usec / 1000 : 0);
+	tcl_timer = g_timeout_add(interval, tcl_kick, NULL);
+	tcl_timer_pending = TRUE;
+}
+
+static int tcl_wait_for_event(Tcl_Time *timePtr)
+{
+	if (!timePtr || (timePtr->sec == 0 && timePtr->usec == 0)) {
+		g_main_context_iteration(NULL, FALSE);
+		return 1;
+	} else {
+		tcl_set_timer(timePtr);
+	}
+
+	g_main_context_iteration(NULL, TRUE);
+
+	return 1;
+}
+
+static void tcl_create_file_handler(int fd, int mask, Tcl_FileProc *proc, ClientData data)
+{
+	struct tcl_file_handler *tfh = g_new0(struct tcl_file_handler, 1);
+	GIOChannel *channel;
+	GIOCondition cond = 0;
+
+	if (g_hash_table_lookup(tcl_file_handlers, (gpointer)fd))
+		tcl_delete_file_handler(fd);
+	
+	if (mask & TCL_READABLE)
+		cond |= G_IO_IN;
+	if (mask & TCL_WRITABLE)
+		cond |= G_IO_OUT;
+	if (mask & TCL_EXCEPTION)
+		cond |= G_IO_ERR|G_IO_HUP|G_IO_NVAL;
+
+	tfh->fd = fd;
+	tfh->mask = mask;
+	tfh->proc = proc;
+	tfh->data = data;
+
+	channel = g_io_channel_unix_new(fd);
+	tfh->source = g_io_add_watch_full(channel, G_PRIORITY_DEFAULT, cond, tcl_file_callback, tfh, g_free);
+	g_io_channel_unref(channel);
+
+	g_hash_table_insert(tcl_file_handlers, (gpointer)fd, tfh);
+
+	Tcl_ServiceAll();
+}
+
+static void tcl_delete_file_handler(int fd)
+{
+	struct tcl_file_handler *tfh = g_hash_table_lookup(tcl_file_handlers, (gpointer)fd);
+
+	if (tfh == NULL)
+		return;
+
+	g_source_remove(tfh->source);
+	g_hash_table_remove(tcl_file_handlers, (gpointer)fd);
+
+	Tcl_ServiceAll();
+}
+
+static gboolean tcl_kick(gpointer data)
+{
+	tcl_timer_pending = FALSE;
+
+	Tcl_ServiceAll();
+
+	return FALSE;
+}
+
+static gboolean tcl_file_callback(GIOChannel *source, GIOCondition condition, gpointer data)
+{
+	struct tcl_file_handler *tfh = data;
+	struct tcl_file_event *fev;
+	int mask = 0;
+
+	if (condition & G_IO_IN)
+		mask |= TCL_READABLE;
+	if (condition & G_IO_OUT)
+		mask |= TCL_WRITABLE;
+	if (condition & (G_IO_ERR|G_IO_HUP|G_IO_NVAL))
+		mask |= TCL_EXCEPTION;
+
+	if (!(tfh->mask & (mask & ~tfh->pending)))
+		return TRUE;
+
+	tfh->pending |= mask;
+	fev = (struct tcl_file_event *)ckalloc(sizeof(struct tcl_file_event));
+	memset(fev, 0, sizeof(struct tcl_file_event));
+	fev->header.proc = tcl_file_event_callback;
+	fev->fd = tfh->fd;
+	Tcl_QueueEvent((Tcl_Event *)fev, TCL_QUEUE_TAIL);
+
+	Tcl_ServiceAll();
+
+	return TRUE;
+}
+
+int tcl_file_event_callback(Tcl_Event *event, int flags)
+{
+	struct tcl_file_handler *tfh;
+	struct tcl_file_event *fev = (struct tcl_file_event *)event;
+	int mask;
+
+	if (!(flags & TCL_FILE_EVENTS)) {
+		return 0;
+	}
+
+	tfh = g_hash_table_lookup(tcl_file_handlers, (gpointer)fev->fd);
+	if (tfh == NULL)
+		return 1;
+
+	mask = tfh->mask & tfh->pending;
+	if (mask)
+		(*tfh->proc)(tfh->data, mask);
+	tfh->pending = 0;
+
+	return 1;
+}

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/tcl/tcl_glib.h	Tue Sep 02 03:34:37 2003 +0000
@@ -0,0 +1,29 @@
+/*
+ * Tcl/Glib glue
+ *
+ * Copyright (C) 2003 Ethan Blanton <[e-mail]>
+ * 
+ * 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
+ */
+
+#ifndef _GAIM_TCL_GLIB_H_
+#define _GAIM_TCL_GLIB_H_
+
+#include <tcl.h>
+#include <glib.h>
+
+void tcl_glib_init();
+
+#endif /* _GAIM_TCL_GLIB_H_ */

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/tcl/tcl_signals.c	Tue Sep 02 03:34:37 2003 +0000
@@ -0,0 +1,314 @@
+/**
+ * @file tcl_signals.c Gaim Tcl signal API
+ *
+ * gaim
+ *
+ * Copyright (C) 2003 Ethan Blanton <[e-mail]>
+ * 
+ * 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
+ */
+#include <tcl.h>
+#include <stdarg.h>
+
+#include "tcl_gaim.h"
+
+#include "internal.h"
+#include "connection.h"
+#include "conversation.h"
+#include "signals.h"
+#include "debug.h"
+#include "value.h"
+#include "core.h"
+
+static GList *tcl_callbacks;
+
+static void *tcl_signal_callback(va_list args, struct tcl_signal_handler *handler);
+
+void tcl_signal_init()
+{
+	tcl_callbacks = NULL;
+}
+
+void tcl_signal_handler_free(struct tcl_signal_handler *handler)
+{
+	if (handler == NULL)
+		return;
+
+	g_free(handler->signal);
+        if (handler->argnames != NULL)
+		g_free(handler->argnames);
+	Tcl_DecrRefCount(handler->proc);
+	g_free(handler);
+}
+
+void tcl_signal_cleanup(Tcl_Interp *interp)
+{
+	GList *cur;
+	struct tcl_signal_handler *handler;
+
+	for (cur = tcl_callbacks; cur != NULL; cur = g_list_next(cur)) {
+		handler = cur->data;
+		if (handler->interp == interp) {
+			tcl_signal_handler_free(handler);
+			cur->data = NULL;
+		}
+	}
+	tcl_callbacks = g_list_remove_all(tcl_callbacks, NULL);
+}
+
+gboolean tcl_signal_connect(struct tcl_signal_handler *handler)
+{
+	gaim_signal_get_values(handler->instance, handler->signal, &handler->returntype,
+			       &handler->nargs, &handler->argtypes);
+
+	if (handler->nargs != handler->nnames)
+		return FALSE;
+
+	tcl_signal_disconnect(handler->interp, handler->signal, handler->interp);
+
+	if (!gaim_signal_connect_vargs(handler->instance, handler->signal, (void *)handler->interp,
+				       GAIM_CALLBACK(tcl_signal_callback), (void *)handler))
+		return FALSE;
+
+	tcl_callbacks = g_list_append(tcl_callbacks, (gpointer)handler);
+
+	return TRUE;
+}
+
+void tcl_signal_disconnect(void *instance, const char *signal, Tcl_Interp *interp)
+{
+	GList *cur;
+	struct tcl_signal_handler *handler;
+	gboolean found = FALSE;
+
+	for (cur = tcl_callbacks; cur != NULL; cur = g_list_next(cur)) {
+		handler = cur->data;
+		if (handler->interp == interp && handler->instance == instance 
+		    && !strcmp(signal, handler->signal)) {
+			gaim_signal_disconnect(instance, signal, handler->interp,
+					       GAIM_CALLBACK(tcl_signal_callback));
+			tcl_signal_handler_free(handler);
+			cur->data = NULL;
+			found = TRUE;
+			break;
+		}
+	}
+	if (found)
+		tcl_callbacks = g_list_remove_all(tcl_callbacks, NULL);
+}
+
+static void *tcl_signal_callback(va_list args, struct tcl_signal_handler *handler)
+{
+	struct var {
+		void *val;
+		char *str;
+	} *vars;
+	GString *val, *name;
+	GaimBlistNode *node;
+	int error, i;
+	void *retval = NULL;
+	Tcl_Obj *result;
+
+	vars = g_new0(struct var, handler->nargs);
+	val = g_string_sized_new(32);
+	name = g_string_sized_new(32);
+
+	for (i = 0; i < handler->nargs; i++) {
+		g_string_printf(name, "::gaim::_callback::%s", handler->argnames[i]);
+
+		switch(gaim_value_get_type(handler->argtypes[i])) {
+		default: /* Yes, at the top */
+		case GAIM_TYPE_UNKNOWN:	/* What?  I guess just pass the word ... */
+			/* treat this as a pointer, but complain first */
+			gaim_debug(GAIM_DEBUG_ERROR, "tcl", "unknown GaimValue type %d\n",
+				   gaim_value_get_type(handler->argtypes[i]));
+		case GAIM_TYPE_POINTER:
+		case GAIM_TYPE_OBJECT:
+		case GAIM_TYPE_BOXED:
+			/* These are all "pointer" types to us */
+			if (gaim_value_is_outgoing(handler->argtypes[i])) {
+				vars[i].val = va_arg(args, void **);
+				Tcl_LinkVar(handler->interp, name->str, vars[i].val, TCL_LINK_INT);
+			} else {
+				vars[i].val = va_arg(args, void *);
+				Tcl_LinkVar(handler->interp, name->str, (char *)&vars[i].val,
+					    TCL_LINK_INT|TCL_LINK_READ_ONLY);
+			}
+			break;
+		case GAIM_TYPE_BOOLEAN:
+			if (gaim_value_is_outgoing(handler->argtypes[i])) {
+				vars[i].val = va_arg(args, gboolean *);
+				Tcl_LinkVar(handler->interp, name->str, vars[i].val, TCL_LINK_BOOLEAN);
+			} else {
+				vars[i].val = (void *)va_arg(args, gboolean);
+				Tcl_LinkVar(handler->interp, name->str, (char *)&vars[i].val,
+					    TCL_LINK_BOOLEAN|TCL_LINK_READ_ONLY);
+			}
+			break;
+		case GAIM_TYPE_CHAR:
+		case GAIM_TYPE_UCHAR:
+		case GAIM_TYPE_SHORT:
+		case GAIM_TYPE_USHORT:
+		case GAIM_TYPE_INT:
+		case GAIM_TYPE_UINT:
+		case GAIM_TYPE_LONG:
+		case GAIM_TYPE_ULONG:
+		case GAIM_TYPE_ENUM:
+			/* These next two are totally bogus */
+		case GAIM_TYPE_INT64:
+		case GAIM_TYPE_UINT64:
+			/* I should really cast these individually to
+			 * preserve as much information as possible ...
+			 * but heh */
+			if (gaim_value_is_outgoing(handler->argtypes[i])) {
+				vars[i].val = (void *)va_arg(args, int *);
+				Tcl_LinkVar(handler->interp, name->str, vars[i].val, TCL_LINK_INT);
+			} else {
+				vars[i].val = (void *)va_arg(args, int);
+				Tcl_LinkVar(handler->interp, name->str, (char *)&vars[i].val,
+					    TCL_LINK_INT|TCL_LINK_READ_ONLY);
+			}
+			break;
+		case GAIM_TYPE_STRING:
+			if (gaim_value_is_outgoing(handler->argtypes[i])) {
+				vars[i].val = (void *)va_arg(args, char **);
+				if (vars[i].val != NULL && *(char **)vars[i].val != NULL) {
+					vars[i].str = (char *)ckalloc(strlen(*(char **)vars[i].val) + 1);
+					strcpy(vars[i].str, *(char **)vars[i].val);
+				} else {
+					vars[i].str = (char *)ckalloc(1);
+					*vars[i].str = '\0';
+				}
+				Tcl_LinkVar(handler->interp, name->str, (char *)&vars[i].str, TCL_LINK_STRING);
+			} else {
+				vars[i].val = (void *)va_arg(args, char *);
+				Tcl_LinkVar(handler->interp, name->str, (char *)&vars[i].val,
+					    TCL_LINK_STRING|TCL_LINK_READ_ONLY);
+			}
+			break;
+		case GAIM_TYPE_SUBTYPE:
+			switch (gaim_value_get_subtype(handler->argtypes[i])) {
+			default:
+			case GAIM_SUBTYPE_UNKNOWN:
+				gaim_debug(GAIM_DEBUG_ERROR, "tcl", "subtype unknown\n");
+			case GAIM_SUBTYPE_ACCOUNT:
+			case GAIM_SUBTYPE_CONNECTION:
+			case GAIM_SUBTYPE_CONVERSATION:
+			case GAIM_SUBTYPE_CONV_WINDOW:
+			case GAIM_SUBTYPE_PLUGIN:
+				/* pointers again */
+				if (gaim_value_is_outgoing(handler->argtypes[i])) {
+					vars[i].val = va_arg(args, void **);
+					Tcl_LinkVar(handler->interp, name->str, vars[i].val, TCL_LINK_INT);
+				} else {
+					vars[i].val = va_arg(args, void *);
+					Tcl_LinkVar(handler->interp, name->str, (char *)&vars[i].val,
+						    TCL_LINK_INT|TCL_LINK_READ_ONLY);
+				}
+				break;
+			case GAIM_SUBTYPE_BLIST:
+			case GAIM_SUBTYPE_BLIST_BUDDY:
+			case GAIM_SUBTYPE_BLIST_GROUP:
+			case GAIM_SUBTYPE_BLIST_CHAT:
+				/* We're going to switch again for code-deduping */
+				if (gaim_value_is_outgoing(handler->argtypes[i]))
+					node = *va_arg(args, GaimBlistNode **);
+				else
+					node = va_arg(args, GaimBlistNode *);
+				switch (node->type) {
+				case GAIM_BLIST_GROUP_NODE:
+					g_string_printf(val, "group {%s}", ((struct group *)node)->name);
+					break;
+				case GAIM_BLIST_BUDDY_NODE:
+					g_string_printf(val, "buddy {%s} %lu", ((struct buddy *)node)->name,
+							(unsigned long)((struct buddy *)node)->account);
+					break;
+				case GAIM_BLIST_CHAT_NODE:
+					g_string_printf(val, "chat {%s} %lu", ((struct chat *)node)->alias,
+							(unsigned long)((struct chat *)node)->account);
+					break;
+				case GAIM_BLIST_OTHER_NODE:
+					g_string_printf(val, "other");
+					break;
+				}
+				vars[i].str = g_strdup(val->str);
+				Tcl_LinkVar(handler->interp, name->str, (char *)&vars[i].str,
+					    TCL_LINK_STRING|TCL_LINK_READ_ONLY);
+				break;
+			}
+		}
+	}
+
+	/* Call the friggin' procedure already */
+	if ((error = Tcl_EvalObjEx(handler->interp, handler->proc, TCL_EVAL_GLOBAL)) != TCL_OK) {
+		gaim_debug(GAIM_DEBUG_ERROR, "tcl", "error evaluating callback: %s\n",
+			   Tcl_GetString(Tcl_GetObjResult(handler->interp)));
+	} else {
+		result = Tcl_GetObjResult(handler->interp);
+		/* handle return values -- strings and words only */
+		if (handler->returntype) {
+			if (gaim_value_get_type(handler->returntype) == GAIM_TYPE_STRING) {
+				retval = (void *)g_strdup(Tcl_GetString(result));
+			} else {
+				if ((error = Tcl_GetIntFromObj(handler->interp, result, (int *)&retval)) != TCL_OK) {
+					gaim_debug(GAIM_DEBUG_ERROR, "tcl", "Error retrieving procedure result: %s\n",
+						   Tcl_GetString(Tcl_GetObjResult(handler->interp)));
+					retval = NULL;
+				}
+			}
+		}
+	}
+
+	/* And finally clean up */
+	for (i = 0; i < handler->nargs; i++) {
+		g_string_printf(name, "::gaim::_callback::%s", handler->argnames[i]);
+		Tcl_UnlinkVar(handler->interp, name->str);
+		/* We basically only have to deal with strings and buddies
+		 * on the way out */
+		switch (gaim_value_get_type(handler->argtypes[i])) {
+		case GAIM_TYPE_STRING:
+			if (gaim_value_is_outgoing(handler->argtypes[i])) {
+				if (vars[i].val != NULL && *(char **)vars[i].val != NULL) {
+					g_free(*(char **)vars[i].val);
+					*(char **)vars[i].val = g_strdup(vars[i].str);
+				}
+				ckfree(vars[i].str);
+			}
+			break;
+		case GAIM_TYPE_SUBTYPE:
+			switch(gaim_value_get_subtype(handler->argtypes[i])) {
+			case GAIM_SUBTYPE_BLIST:
+			case GAIM_SUBTYPE_BLIST_BUDDY:
+			case GAIM_SUBTYPE_BLIST_GROUP:
+			case GAIM_SUBTYPE_BLIST_CHAT:
+				g_free(vars[i].str);
+				break;
+			default:
+				/* nothing */
+				;
+			}
+			break;
+		default:
+			/* nothing */
+			;
+		}
+	}
+
+	g_string_free(name, TRUE);
+	g_string_free(val, FALSE);
+	g_free(vars);
+
+	return retval;
+}