libpurple/plugins/tcl/tcl_cmd.c

Wed, 13 May 2009 20:29:03 +0000

author
Marcus Lundblad <malu@pidgin.im>
date
Wed, 13 May 2009 20:29:03 +0000
changeset 27110
05ca719b901b
parent 24683
3481a3320313
child 30626
bec413ce77c7
permissions
-rw-r--r--

Support custom smileys in MUCs (when all participants support BoB and a maximum
of 10 participants are in the chat).
Always announce support for BoB, since disable custom smileys will still turn
off fetching them, and BoB can be used for other purposes further on.

13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
1 /**
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
2 * @file tcl_cmd.c Purple Tcl cmd API
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
3 *
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
4 * purple
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
5 *
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
6 * Copyright (C) 2006 Etan Reisner <deryni@gmail.com>
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
7 *
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
8 * This program is free software; you can redistribute it and/or modify
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
9 * it under the terms of the GNU General Public License as published by
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
10 * the Free Software Foundation; either version 2 of the License, or
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
11 * (at your option) any later version.
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
12 *
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
13 * This program is distributed in the hope that it will be useful,
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
16 * GNU General Public License for more details.
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
17 *
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
18 * You should have received a copy of the GNU General Public License
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
19 * along with this program; if not, write to the Free Software
19859
71d37b57eff2 The FSF changed its address a while ago; our files were out of date.
John Bailey <rekkanoryo@rekkanoryo.org>
parents: 15884
diff changeset
20 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02111-1301 USA
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
21 */
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
22 #include <tcl.h>
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
23
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
24 #include "tcl_purple.h"
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
25
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
26 #include "internal.h"
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
27 #include "cmds.h"
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
28 #include "debug.h"
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
29
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
30 static GList *tcl_cmd_callbacks;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
31
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
32 static PurpleCmdRet tcl_cmd_callback(PurpleConversation *conv, const gchar *cmd,
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
33 gchar **args, gchar **errors,
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
34 struct tcl_cmd_handler *handler);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
35 static Tcl_Obj *new_cmd_cb_namespace(void);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
36
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
37 void tcl_cmd_init()
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
38 {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
39 tcl_cmd_callbacks = NULL;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
40 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
41
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
42 void tcl_cmd_handler_free(struct tcl_cmd_handler *handler)
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
43 {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
44 if (handler == NULL)
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
45 return;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
46
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
47 Tcl_DecrRefCount(handler->namespace);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
48 g_free(handler);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
49 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
50
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
51 void tcl_cmd_cleanup(Tcl_Interp *interp)
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
52 {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
53 GList *cur;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
54 struct tcl_cmd_handler *handler;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
55
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
56 for (cur = tcl_cmd_callbacks; cur != NULL; cur = g_list_next(cur)) {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
57 handler = cur->data;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
58 if (handler->interp == interp) {
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
59 purple_cmd_unregister(handler->id);
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
60 tcl_cmd_handler_free(handler);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
61 cur->data = NULL;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
62 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
63 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
64 tcl_cmd_callbacks = g_list_remove_all(tcl_cmd_callbacks, NULL);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
65 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
66
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
67 PurpleCmdId tcl_cmd_register(struct tcl_cmd_handler *handler)
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
68 {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
69 int id;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
70 GString *proc;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
71
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
72 if ((id = purple_cmd_register(Tcl_GetString(handler->cmd),
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
73 handler->args, handler->priority,
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
74 handler->flags, handler->prpl_id,
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
75 PURPLE_CMD_FUNC(tcl_cmd_callback),
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
76 handler->helpstr, (void *)handler)) == 0)
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
77 return 0;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
78
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
79 handler->namespace = new_cmd_cb_namespace ();
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
80 Tcl_IncrRefCount(handler->namespace);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
81 proc = g_string_new("");
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
82 g_string_append_printf(proc, "namespace eval %s { proc cb { conv cmd arglist } { %s } }",
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
83 Tcl_GetString(handler->namespace),
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
84 Tcl_GetString(handler->proc));
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
85 if (Tcl_Eval(handler->interp, proc->str) != TCL_OK) {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
86 Tcl_DecrRefCount(handler->namespace);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
87 g_string_free(proc, TRUE);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
88 return 0;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
89 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
90 g_string_free(proc, TRUE);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
91
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
92 tcl_cmd_callbacks = g_list_append(tcl_cmd_callbacks, (gpointer)handler);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
93
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
94 return id;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
95 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
96
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
97 void tcl_cmd_unregister(PurpleCmdId id, Tcl_Interp *interp)
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
98 {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
99 GList *cur;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
100 GString *cmd;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
101 gboolean found = FALSE;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
102 struct tcl_cmd_handler *handler;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
103
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
104 for (cur = tcl_cmd_callbacks; cur != NULL; cur = g_list_next(cur)) {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
105 handler = cur->data;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
106 if (handler->interp == interp && handler->id == id) {
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
107 purple_cmd_unregister(id);
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
108 cmd = g_string_sized_new(64);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
109 g_string_printf(cmd, "namespace delete %s",
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
110 Tcl_GetString(handler->namespace));
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
111 Tcl_EvalEx(interp, cmd->str, -1, TCL_EVAL_GLOBAL);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
112 tcl_cmd_handler_free(handler);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
113 g_string_free(cmd, TRUE);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
114 cur->data = NULL;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
115 found = TRUE;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
116 break;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
117 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
118 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
119
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
120 if (found)
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
121 tcl_cmd_callbacks = g_list_remove_all(tcl_cmd_callbacks, NULL);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
122 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
123
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
124 static PurpleCmdRet tcl_cmd_callback(PurpleConversation *conv, const gchar *cmd,
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
125 gchar **args, gchar **errors,
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
126 struct tcl_cmd_handler *handler)
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
127 {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
128 int retval, error, i;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
129 Tcl_Obj *command, *arg, *tclargs, *result;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
130
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
131 command = Tcl_NewListObj(0, NULL);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
132 Tcl_IncrRefCount(command);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
133
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
134 /* The callback */
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
135 arg = Tcl_DuplicateObj(handler->namespace);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
136 Tcl_AppendStringsToObj(arg, "::cb", NULL);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
137 Tcl_ListObjAppendElement(handler->interp, command, arg);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
138
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
139 /* The conversation */
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
140 arg = purple_tcl_ref_new(PurpleTclRefConversation, conv);
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
141 Tcl_ListObjAppendElement(handler->interp, command, arg);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
142
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
143 /* The command */
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
144 arg = Tcl_NewStringObj(cmd, -1);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
145 Tcl_ListObjAppendElement(handler->interp, command, arg);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
146
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
147 /* The args list */
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
148 tclargs = Tcl_NewListObj(0, NULL);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
149 for (i = 0; i < handler->nargs; i++) {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
150 arg = Tcl_NewStringObj(args[i], -1);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
151
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
152 Tcl_ListObjAppendElement(handler->interp, tclargs, arg);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
153 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
154 Tcl_ListObjAppendElement(handler->interp, command, tclargs);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
155
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
156 if ((error = Tcl_EvalObjEx(handler->interp, command,
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
157 TCL_EVAL_GLOBAL)) != TCL_OK) {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
158 gchar *errorstr;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
159
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
160 errorstr = g_strdup_printf("error evaluating callback: %s\n",
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
161 Tcl_GetString(Tcl_GetObjResult(handler->interp)));
24683
3481a3320313 Backport the 'purple_debug_*(msg)' -> 'purple_debug_*("%s", msg);' fixes.
Richard Laager <rlaager@pidgin.im>
parents: 19859
diff changeset
162 purple_debug(PURPLE_DEBUG_ERROR, "tcl", "%s", errorstr);
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
163 *errors = errorstr;
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
164 retval = PURPLE_CMD_RET_FAILED;
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
165 } else {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
166 result = Tcl_GetObjResult(handler->interp);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
167 if ((error = Tcl_GetIntFromObj(handler->interp, result,
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
168 &retval)) != TCL_OK) {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
169 gchar *errorstr;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
170
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
171 errorstr = g_strdup_printf("Error retreiving procedure result: %s\n",
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
172 Tcl_GetString(Tcl_GetObjResult(handler->interp)));
24683
3481a3320313 Backport the 'purple_debug_*(msg)' -> 'purple_debug_*("%s", msg);' fixes.
Richard Laager <rlaager@pidgin.im>
parents: 19859
diff changeset
173 purple_debug(PURPLE_DEBUG_ERROR, "tcl", "%s", errorstr);
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
174 *errors = errorstr;
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
175 retval = PURPLE_CMD_RET_FAILED;
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
176 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
177 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
178
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
179 return retval;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
180 }
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
181
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
182 static Tcl_Obj *new_cmd_cb_namespace()
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
183 {
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
184 char name[32];
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
185 static int cbnum;
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
186
15884
4de1981757fc sed -ie 's/gaim/purple/g'
Sean Egan <seanegan@pidgin.im>
parents: 15435
diff changeset
187 g_snprintf(name, sizeof(name), "::purple::_cmd_callback::cb_%d",
13850
fc565de2de20 [gaim-migrate @ 16304]
Etan Reisner <deryni@pidgin.im>
parents: 13849
diff changeset
188 cbnum++);
13847
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
189 return Tcl_NewStringObj(name, -1);
89bc33bfe294 [gaim-migrate @ 16301]
Etan Reisner <deryni@pidgin.im>
parents:
diff changeset
190 }

mercurial