Wed, 13 May 2009 20:29:03 +0000
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.
| 6694 | 1 | /** |
| 15884 | 2 | * @file tcl_cmds.c Commands for the Purple Tcl plugin bindings |
| 6694 | 3 | * |
| 15884 | 4 | * purple |
| 6694 | 5 | * |
| 6 | * Copyright (C) 2003 Ethan Blanton <eblanton@cs.purdue.edu> | |
| 7 | * | |
| 8 | * This program is free software; you can redistribute it and/or modify | |
| 9 | * it under the terms of the GNU General Public License as published by | |
| 10 | * the Free Software Foundation; either version 2 of the License, or | |
| 11 | * (at your option) any later version. | |
| 12 | * | |
| 13 | * This program is distributed in the hope that it will be useful, | |
| 14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 16 | * GNU General Public License for more details. | |
| 17 | * | |
| 18 | * You should have received a copy of the GNU General Public License | |
| 19 | * along with this program; if not, write to the Free Software | |
|
19859
71d37b57eff2
The FSF changed its address a while ago; our files were out of date.
John Bailey <rekkanoryo@rekkanoryo.org>
parents:
19726
diff
changeset
|
20 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02111-1301 USA |
| 6694 | 21 | */ |
| 22 | ||
| 23 | #include <tcl.h> | |
| 24 | ||
| 25 | #include "internal.h" | |
| 26 | #include "conversation.h" | |
| 27 | #include "connection.h" | |
|
22353
daef90676a8f
One more g_idle_add call
Mark Doliner <markdoliner@pidgin.im>
parents:
22240
diff
changeset
|
28 | #include "eventloop.h" |
| 6694 | 29 | #include "account.h" |
| 30 | #include "server.h" | |
| 31 | #include "notify.h" | |
| 6700 | 32 | #include "blist.h" |
|
15758
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
33 | #include "savedstatuses.h" |
| 6694 | 34 | #include "debug.h" |
| 35 | #include "prefs.h" | |
| 36 | #include "core.h" | |
| 37 | ||
| 15884 | 38 | #include "tcl_purple.h" |
| 6694 | 39 | |
| 15884 | 40 | static PurpleAccount *tcl_validate_account(Tcl_Obj *obj, Tcl_Interp *interp); |
| 41 | static PurpleConversation *tcl_validate_conversation(Tcl_Obj *obj, Tcl_Interp *interp); | |
| 42 | static PurpleConnection *tcl_validate_gc(Tcl_Obj *obj, Tcl_Interp *interp); | |
| 6694 | 43 | |
| 15884 | 44 | static PurpleAccount *tcl_validate_account(Tcl_Obj *obj, Tcl_Interp *interp) |
| 6694 | 45 | { |
| 15884 | 46 | PurpleAccount *account; |
|
18122
9bf9970c1b6a
disapproval of revision '2d8ea56b90971e7851442d96b7d74ecb4f052126'
Richard Laager <rlaager@pidgin.im>
parents:
18121
diff
changeset
|
47 | GList *cur; |
| 13812 | 48 | |
| 15884 | 49 | account = purple_tcl_ref_get(interp, obj, PurpleTclRefAccount); |
| 13812 | 50 | |
| 51 | if (account == NULL) | |
| 52 | return NULL; | |
| 53 | ||
| 15884 | 54 | for (cur = purple_accounts_get_all(); cur != NULL; cur = g_list_next(cur)) { |
| 6694 | 55 | if (account == cur->data) |
| 13812 | 56 | return account; |
| 6694 | 57 | } |
| 58 | if (interp != NULL) | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
59 | Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid account", -1)); |
| 13812 | 60 | return NULL; |
| 6694 | 61 | } |
| 62 | ||
| 15884 | 63 | static PurpleConversation *tcl_validate_conversation(Tcl_Obj *obj, Tcl_Interp *interp) |
| 6694 | 64 | { |
| 15884 | 65 | PurpleConversation *convo; |
|
18122
9bf9970c1b6a
disapproval of revision '2d8ea56b90971e7851442d96b7d74ecb4f052126'
Richard Laager <rlaager@pidgin.im>
parents:
18121
diff
changeset
|
66 | GList *cur; |
| 6694 | 67 | |
| 15884 | 68 | convo = purple_tcl_ref_get(interp, obj, PurpleTclRefConversation); |
| 13812 | 69 | |
| 70 | if (convo == NULL) | |
| 71 | return NULL; | |
| 72 | ||
| 15884 | 73 | for (cur = purple_get_conversations(); cur != NULL; cur = g_list_next(cur)) { |
| 6694 | 74 | if (convo == cur->data) |
| 13812 | 75 | return convo; |
| 6694 | 76 | } |
| 77 | if (interp != NULL) | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
78 | Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid conversation", -1)); |
| 13812 | 79 | return NULL; |
| 6694 | 80 | } |
| 81 | ||
| 15884 | 82 | static PurpleConnection *tcl_validate_gc(Tcl_Obj *obj, Tcl_Interp *interp) |
| 6694 | 83 | { |
| 15884 | 84 | PurpleConnection *gc; |
|
18122
9bf9970c1b6a
disapproval of revision '2d8ea56b90971e7851442d96b7d74ecb4f052126'
Richard Laager <rlaager@pidgin.im>
parents:
18121
diff
changeset
|
85 | GList *cur; |
| 13817 | 86 | |
| 15884 | 87 | gc = purple_tcl_ref_get(interp, obj, PurpleTclRefConnection); |
| 13817 | 88 | |
| 89 | if (gc == NULL) | |
| 90 | return NULL; | |
| 91 | ||
| 15884 | 92 | for (cur = purple_connections_get_all(); cur != NULL; cur = g_list_next(cur)) { |
| 6694 | 93 | if (gc == cur->data) |
| 13817 | 94 | return gc; |
| 6694 | 95 | } |
| 13817 | 96 | return NULL; |
| 6694 | 97 | } |
| 98 | ||
| 99 | int tcl_cmd_account(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) | |
| 100 | { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
101 | Tcl_Obj *result, *list, *elem; |
| 13828 | 102 | const char *cmds[] = { "alias", "connect", "connection", "disconnect", |
| 103 | "enabled", "find", "handle", "isconnected", | |
| 104 | "list", "presence", "protocol", "status", | |
| 105 | "status_type", "status_types", "username", | |
| 106 | NULL }; | |
| 107 | enum { CMD_ACCOUNT_ALIAS, | |
| 13812 | 108 | CMD_ACCOUNT_CONNECT, CMD_ACCOUNT_CONNECTION, |
| 109 | CMD_ACCOUNT_DISCONNECT, CMD_ACCOUNT_ENABLED, CMD_ACCOUNT_FIND, | |
| 110 | CMD_ACCOUNT_HANDLE, CMD_ACCOUNT_ISCONNECTED, CMD_ACCOUNT_LIST, | |
| 13828 | 111 | CMD_ACCOUNT_PRESENCE, CMD_ACCOUNT_PROTOCOL, CMD_ACCOUNT_STATUS, |
| 112 | CMD_ACCOUNT_STATUS_TYPE, CMD_ACCOUNT_STATUS_TYPES, | |
| 113 | CMD_ACCOUNT_USERNAME } cmd; | |
|
10339
246feba79f04
[gaim-migrate @ 11548]
Mark Doliner <markdoliner@pidgin.im>
parents:
10246
diff
changeset
|
114 | const char *listopts[] = { "-all", "-online", NULL }; |
| 6694 | 115 | enum { CMD_ACCOUNTLIST_ALL, CMD_ACCOUNTLIST_ONLINE } listopt; |
|
8834
0a798e3d2b84
[gaim-migrate @ 9598]
Mark Doliner <markdoliner@pidgin.im>
parents:
7713
diff
changeset
|
116 | const char *alias; |
|
18190
bcf28ef7e8ff
Re-fix the DBus list handling code by killing const GList* / const GSList*
Richard Laager <rlaager@pidgin.im>
parents:
18122
diff
changeset
|
117 | GList *cur; |
| 15884 | 118 | PurpleAccount *account; |
| 119 | PurpleStatus *status; | |
| 120 | PurpleStatusType *status_type; | |
| 121 | PurpleValue *value; | |
| 13828 | 122 | char *attr_id; |
| 6694 | 123 | int error; |
| 13828 | 124 | int b, i; |
| 6694 | 125 | |
| 126 | if (objc < 2) { | |
| 127 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 128 | return TCL_ERROR; | |
| 129 | } | |
| 130 | ||
| 131 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 132 | return error; | |
| 133 | ||
| 134 | switch (cmd) { | |
| 135 | case CMD_ACCOUNT_ALIAS: | |
| 136 | if (objc != 3) { | |
| 137 | Tcl_WrongNumArgs(interp, 2, objv, "account"); | |
| 138 | return TCL_ERROR; | |
| 139 | } | |
| 13812 | 140 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) |
| 6694 | 141 | return TCL_ERROR; |
| 15884 | 142 | alias = purple_account_get_alias(account); |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
143 | Tcl_SetObjResult(interp, Tcl_NewStringObj(alias ? (char *)alias : "", -1)); |
| 6694 | 144 | break; |
| 145 | case CMD_ACCOUNT_CONNECT: | |
| 146 | if (objc != 3) { | |
| 147 | Tcl_WrongNumArgs(interp, 2, objv, "account"); | |
| 148 | return TCL_ERROR; | |
| 149 | } | |
| 13812 | 150 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) |
| 6694 | 151 | return TCL_ERROR; |
| 15884 | 152 | if (!purple_account_is_connected(account)) |
| 153 | purple_account_connect(account); | |
| 13817 | 154 | Tcl_SetObjResult(interp, |
| 15884 | 155 | purple_tcl_ref_new(PurpleTclRefConnection, |
| 156 | purple_account_get_connection(account))); | |
| 6694 | 157 | break; |
| 158 | case CMD_ACCOUNT_CONNECTION: | |
| 159 | if (objc != 3) { | |
| 160 | Tcl_WrongNumArgs(interp, 2, objv, "account"); | |
| 161 | return TCL_ERROR; | |
| 162 | } | |
| 13812 | 163 | |
| 164 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) | |
| 6694 | 165 | return TCL_ERROR; |
| 13817 | 166 | Tcl_SetObjResult(interp, |
| 15884 | 167 | purple_tcl_ref_new(PurpleTclRefConnection, |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
168 | purple_account_get_connection(account))); |
| 6694 | 169 | break; |
| 170 | case CMD_ACCOUNT_DISCONNECT: | |
| 171 | if (objc != 3) { | |
| 172 | Tcl_WrongNumArgs(interp, 2, objv, "account"); | |
| 173 | return TCL_ERROR; | |
| 174 | } | |
| 13812 | 175 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) |
| 6694 | 176 | return TCL_ERROR; |
| 15884 | 177 | purple_account_disconnect(account); |
| 6694 | 178 | break; |
| 13812 | 179 | case CMD_ACCOUNT_ENABLED: |
| 180 | if (objc != 3 && objc != 4) { | |
| 181 | Tcl_WrongNumArgs(interp, 2, objv, "account ?enabled?"); | |
| 182 | return TCL_ERROR; | |
| 183 | } | |
| 184 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) | |
| 185 | return TCL_ERROR; | |
| 186 | if (objc == 3) { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
187 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
188 | Tcl_NewBooleanObj( |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
189 | purple_account_get_enabled(account, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
190 | purple_core_get_ui()))); |
| 13812 | 191 | } else { |
| 192 | if ((error = Tcl_GetBooleanFromObj(interp, objv[3], &b)) != TCL_OK) | |
| 193 | return TCL_ERROR; | |
| 15884 | 194 | purple_account_set_enabled(account, purple_core_get_ui(), b); |
| 13812 | 195 | } |
| 196 | break; | |
| 6694 | 197 | case CMD_ACCOUNT_FIND: |
| 198 | if (objc != 4) { | |
| 199 | Tcl_WrongNumArgs(interp, 2, objv, "username protocol"); | |
| 200 | return TCL_ERROR; | |
| 201 | } | |
| 15884 | 202 | account = purple_accounts_find(Tcl_GetString(objv[2]), |
| 13817 | 203 | Tcl_GetString(objv[3])); |
| 204 | Tcl_SetObjResult(interp, | |
| 15884 | 205 | purple_tcl_ref_new(PurpleTclRefAccount, account)); |
| 6694 | 206 | break; |
| 207 | case CMD_ACCOUNT_HANDLE: | |
| 208 | if (objc != 2) { | |
| 209 | Tcl_WrongNumArgs(interp, 2, objv, ""); | |
| 210 | return TCL_ERROR; | |
| 211 | } | |
|
20393
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
212 | Tcl_SetObjResult(interp, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
213 | purple_tcl_ref_new(PurpleTclRefHandle, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
214 | purple_accounts_get_handle())); |
| 6694 | 215 | break; |
| 216 | case CMD_ACCOUNT_ISCONNECTED: | |
| 217 | if (objc != 3) { | |
| 218 | Tcl_WrongNumArgs(interp, 2, objv, "account"); | |
| 219 | return TCL_ERROR; | |
| 220 | } | |
| 13812 | 221 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) |
| 6694 | 222 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
223 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
224 | Tcl_NewBooleanObj( |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
225 | purple_account_is_connected(account))); |
| 6694 | 226 | break; |
| 227 | case CMD_ACCOUNT_LIST: | |
| 228 | listopt = CMD_ACCOUNTLIST_ALL; | |
| 229 | if (objc > 3) { | |
| 230 | Tcl_WrongNumArgs(interp, 2, objv, "?option?"); | |
| 231 | return TCL_ERROR; | |
| 232 | } | |
| 233 | if (objc == 3) { | |
| 234 | if ((error = Tcl_GetIndexFromObj(interp, objv[2], listopts, "option", 0, (int *)&listopt)) != TCL_OK) | |
| 235 | return error; | |
| 236 | } | |
| 237 | list = Tcl_NewListObj(0, NULL); | |
| 15884 | 238 | for (cur = purple_accounts_get_all(); cur != NULL; cur = g_list_next(cur)) { |
| 6694 | 239 | account = cur->data; |
| 15884 | 240 | if (listopt == CMD_ACCOUNTLIST_ONLINE && !purple_account_is_connected(account)) |
| 6694 | 241 | continue; |
| 15884 | 242 | elem = purple_tcl_ref_new(PurpleTclRefAccount, account); |
| 6694 | 243 | Tcl_ListObjAppendElement(interp, list, elem); |
| 244 | } | |
| 245 | Tcl_SetObjResult(interp, list); | |
| 246 | break; | |
| 13823 | 247 | case CMD_ACCOUNT_PRESENCE: |
| 248 | if (objc != 3) { | |
| 249 | Tcl_WrongNumArgs(interp, 2, objv, "account"); | |
| 250 | return TCL_ERROR; | |
| 251 | } | |
| 252 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) | |
| 253 | return TCL_ERROR; | |
| 15884 | 254 | Tcl_SetObjResult(interp, purple_tcl_ref_new(PurpleTclRefPresence, |
| 255 | purple_account_get_presence(account))); | |
| 13823 | 256 | break; |
| 6694 | 257 | case CMD_ACCOUNT_PROTOCOL: |
| 258 | if (objc != 3) { | |
| 259 | Tcl_WrongNumArgs(interp, 2, objv, "account"); | |
| 260 | return TCL_ERROR; | |
| 261 | } | |
| 13812 | 262 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) |
| 6694 | 263 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
264 | Tcl_SetObjResult(interp, Tcl_NewStringObj((char *)purple_account_get_protocol_id(account), -1)); |
| 6694 | 265 | break; |
| 13828 | 266 | case CMD_ACCOUNT_STATUS: |
| 267 | if (objc < 3) { | |
| 268 | Tcl_WrongNumArgs(interp, 2, objv, "account ?status_id name value ...?"); | |
| 269 | return TCL_ERROR; | |
| 270 | } | |
| 271 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) | |
| 272 | return TCL_ERROR; | |
| 273 | if (objc == 3) { | |
| 274 | Tcl_SetObjResult(interp, | |
| 15884 | 275 | purple_tcl_ref_new(PurpleTclRefStatus, |
| 276 | purple_account_get_active_status(account))); | |
| 13828 | 277 | } else { |
| 278 | GList *l = NULL; | |
| 279 | if (objc % 2) { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
280 | Tcl_SetObjResult(interp, Tcl_NewStringObj("name without value setting status", -1)); |
| 13828 | 281 | return TCL_ERROR; |
| 282 | } | |
| 15884 | 283 | status = purple_account_get_status(account, Tcl_GetString(objv[3])); |
| 13828 | 284 | if (status == NULL) { |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
285 | Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid status for account", -1)); |
| 13828 | 286 | return TCL_ERROR; |
| 287 | } | |
| 288 | for (i = 4; i < objc; i += 2) { | |
| 289 | attr_id = Tcl_GetString(objv[i]); | |
| 15884 | 290 | value = purple_status_get_attr_value(status, attr_id); |
| 13828 | 291 | if (value == NULL) { |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
292 | Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid attribute for account", -1)); |
| 13828 | 293 | return TCL_ERROR; |
| 294 | } | |
| 15884 | 295 | switch (purple_value_get_type(value)) { |
| 296 | case PURPLE_TYPE_BOOLEAN: | |
| 13828 | 297 | error = Tcl_GetBooleanFromObj(interp, objv[i + 1], &b); |
| 298 | if (error != TCL_OK) | |
| 299 | return error; | |
| 300 | l = g_list_append(l, attr_id); | |
| 301 | l = g_list_append(l, GINT_TO_POINTER(b)); | |
| 302 | break; | |
| 15884 | 303 | case PURPLE_TYPE_INT: |
| 13828 | 304 | error = Tcl_GetIntFromObj(interp, objv[i + 1], &b); |
| 305 | if (error != TCL_OK) | |
| 306 | return error; | |
| 307 | l = g_list_append(l, attr_id); | |
| 308 | l = g_list_append(l, GINT_TO_POINTER(b)); | |
| 309 | break; | |
| 15884 | 310 | case PURPLE_TYPE_STRING: |
| 13828 | 311 | l = g_list_append(l, attr_id); |
| 312 | l = g_list_append(l, Tcl_GetString(objv[i + 1])); | |
| 313 | break; | |
| 314 | default: | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
315 | Tcl_SetObjResult(interp, Tcl_NewStringObj("unknown PurpleValue type", -1)); |
| 13828 | 316 | return TCL_ERROR; |
| 317 | } | |
| 318 | } | |
| 15884 | 319 | purple_account_set_status_list(account, Tcl_GetString(objv[3]), TRUE, l); |
| 13828 | 320 | g_list_free(l); |
| 321 | } | |
| 322 | break; | |
| 13812 | 323 | case CMD_ACCOUNT_STATUS_TYPE: |
| 324 | if (objc != 4 && objc != 5) { | |
| 325 | Tcl_WrongNumArgs(interp, 2, objv, "account ?statustype? ?-primitive primitive?"); | |
| 326 | return TCL_ERROR; | |
| 327 | } | |
| 328 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) | |
| 329 | return TCL_ERROR; | |
| 330 | if (objc == 4) { | |
| 15884 | 331 | status_type = purple_account_get_status_type(account, |
| 13812 | 332 | Tcl_GetString(objv[3])); |
| 333 | } else { | |
| 15884 | 334 | PurpleStatusPrimitive primitive; |
| 13812 | 335 | if (strcmp(Tcl_GetString(objv[3]), "-primitive")) { |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
336 | result = Tcl_NewStringObj("bad option \"", -1); |
| 13812 | 337 | Tcl_AppendObjToObj(result, objv[3]); |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
338 | Tcl_AppendToObj(result, "\": should be -primitive", -1); |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
339 | Tcl_SetObjResult(interp,result); |
| 13812 | 340 | return TCL_ERROR; |
| 341 | } | |
| 15884 | 342 | primitive = purple_primitive_get_type_from_id(Tcl_GetString(objv[4])); |
| 343 | status_type = purple_account_get_status_type_with_primitive(account, | |
| 13812 | 344 | primitive); |
| 345 | } | |
| 346 | if (status_type == NULL) { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
347 | Tcl_SetObjResult(interp, Tcl_NewStringObj("status type not found", -1)); |
| 13812 | 348 | return TCL_ERROR; |
| 349 | } | |
| 350 | Tcl_SetObjResult(interp, | |
| 15884 | 351 | purple_tcl_ref_new(PurpleTclRefStatusType, |
| 13812 | 352 | status_type)); |
| 353 | break; | |
| 354 | case CMD_ACCOUNT_STATUS_TYPES: | |
| 355 | if (objc != 3) { | |
| 356 | Tcl_WrongNumArgs(interp, 2, objv, "account"); | |
| 357 | return TCL_ERROR; | |
| 358 | } | |
| 359 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) | |
| 360 | return TCL_ERROR; | |
| 361 | list = Tcl_NewListObj(0, NULL); | |
| 15884 | 362 | for (cur = purple_account_get_status_types(account); cur != NULL; |
| 13812 | 363 | cur = g_list_next(cur)) { |
| 364 | Tcl_ListObjAppendElement(interp, list, | |
| 15884 | 365 | purple_tcl_ref_new(PurpleTclRefStatusType, |
| 13812 | 366 | cur->data)); |
| 367 | } | |
| 368 | Tcl_SetObjResult(interp, list); | |
| 369 | break; | |
| 6694 | 370 | case CMD_ACCOUNT_USERNAME: |
| 371 | if (objc != 3) { | |
| 372 | Tcl_WrongNumArgs(interp, 2, objv, "account"); | |
| 373 | return TCL_ERROR; | |
| 374 | } | |
| 13812 | 375 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) |
| 6694 | 376 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
377 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
378 | Tcl_NewStringObj((char *)purple_account_get_username(account), -1)); |
| 6694 | 379 | break; |
| 380 | } | |
| 381 | ||
| 382 | return TCL_OK; | |
| 383 | } | |
| 384 | ||
| 15884 | 385 | static PurpleBlistNode *tcl_list_to_buddy(Tcl_Interp *interp, int count, Tcl_Obj **elems) |
| 6694 | 386 | { |
| 15884 | 387 | PurpleBlistNode *node = NULL; |
| 388 | PurpleAccount *account; | |
| 6694 | 389 | char *name; |
| 390 | char *type; | |
| 391 | ||
| 392 | if (count < 3) { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
393 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
394 | Tcl_NewStringObj("list too short", -1)); |
| 6694 | 395 | return NULL; |
| 396 | } | |
| 397 | ||
| 398 | type = Tcl_GetString(elems[0]); | |
| 399 | name = Tcl_GetString(elems[1]); | |
| 13812 | 400 | if ((account = tcl_validate_account(elems[2], interp)) == NULL) |
| 6694 | 401 | return NULL; |
| 402 | ||
| 403 | if (!strcmp(type, "buddy")) { | |
|
24974
a81952e9babb
Update some casts (that the script didn't fix correctly) to GObject macros.
Richard Laager <rlaager@pidgin.im>
parents:
24560
diff
changeset
|
404 | node = PURPLE_BLIST_NODE(purple_find_buddy(account, name)); |
| 6694 | 405 | } else if (!strcmp(type, "group")) { |
|
24974
a81952e9babb
Update some casts (that the script didn't fix correctly) to GObject macros.
Richard Laager <rlaager@pidgin.im>
parents:
24560
diff
changeset
|
406 | node = PURPLE_BLIST_NODE(purple_blist_find_chat(account, name)); |
| 6694 | 407 | } |
| 408 | ||
| 409 | return node; | |
| 410 | } | |
| 411 | ||
| 412 | int tcl_cmd_buddy(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) | |
| 413 | { | |
| 6746 | 414 | Tcl_Obj *list, *tclgroup, *tclgrouplist, *tclcontact, *tclcontactlist, *tclbud, **elems, *result; |
|
10339
246feba79f04
[gaim-migrate @ 11548]
Mark Doliner <markdoliner@pidgin.im>
parents:
10246
diff
changeset
|
415 | const char *cmds[] = { "alias", "handle", "info", "list", NULL }; |
| 6694 | 416 | enum { CMD_BUDDY_ALIAS, CMD_BUDDY_HANDLE, CMD_BUDDY_INFO, CMD_BUDDY_LIST } cmd; |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
417 | PurpleBlistNodeType type; |
| 15884 | 418 | PurpleBlistNode *node, *gnode, *bnode; |
| 419 | PurpleAccount *account; | |
| 420 | PurpleBuddy *bud; | |
| 421 | PurpleChat *cnode; | |
| 6694 | 422 | int error, all = 0, count; |
| 423 | ||
| 424 | if (objc < 2) { | |
| 425 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 426 | return TCL_ERROR; | |
| 427 | } | |
| 428 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 429 | return error; | |
| 430 | ||
| 431 | switch (cmd) { | |
| 432 | case CMD_BUDDY_ALIAS: | |
| 433 | if (objc != 3) { | |
| 434 | Tcl_WrongNumArgs(interp, 2, objv, "buddy"); | |
| 435 | return TCL_ERROR; | |
| 436 | } | |
| 437 | if ((error = Tcl_ListObjGetElements(interp, objv[2], &count, &elems)) != TCL_OK) | |
| 438 | return error; | |
| 439 | if ((node = tcl_list_to_buddy(interp, count, elems)) == NULL) | |
| 440 | return TCL_ERROR; | |
| 24560 | 441 | type = purple_blist_node_get_type(node); |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
442 | if (type == PURPLE_BLIST_CHAT_NODE) |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
443 | Tcl_SetObjResult(interp, |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
444 | Tcl_NewStringObj(purple_chat_get_name((PurpleChat *)node), -1)); |
|
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
445 | else if (type == PURPLE_BLIST_BUDDY_NODE) |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
446 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
447 | Tcl_NewStringObj((char *)purple_buddy_get_alias((PurpleBuddy *)node), -1)); |
| 6694 | 448 | return TCL_OK; |
| 449 | break; | |
| 450 | case CMD_BUDDY_HANDLE: | |
| 451 | if (objc != 2) { | |
| 452 | Tcl_WrongNumArgs(interp, 2, objv, ""); | |
| 453 | return TCL_ERROR; | |
| 454 | } | |
|
20393
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
455 | Tcl_SetObjResult(interp, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
456 | purple_tcl_ref_new(PurpleTclRefHandle, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
457 | purple_blist_get_handle())); |
| 6694 | 458 | break; |
| 459 | case CMD_BUDDY_INFO: | |
| 460 | if (objc != 3 && objc != 4) { | |
| 461 | Tcl_WrongNumArgs(interp, 2, objv, "( buddy | account username )"); | |
| 462 | return TCL_ERROR; | |
| 463 | } | |
| 464 | if (objc == 3) { | |
| 465 | if ((error = Tcl_ListObjGetElements(interp, objv[2], &count, &elems)) != TCL_OK) | |
| 466 | return error; | |
| 467 | if (count < 3) { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
468 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
469 | Tcl_NewStringObj("buddy too short", -1)); |
| 6694 | 470 | return TCL_ERROR; |
| 471 | } | |
| 472 | if (strcmp("buddy", Tcl_GetString(elems[0]))) { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
473 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
474 | Tcl_NewStringObj("invalid buddy", -1)); |
| 6694 | 475 | return TCL_ERROR; |
| 476 | } | |
| 13812 | 477 | if ((account = tcl_validate_account(elems[2], interp)) == NULL) |
| 6694 | 478 | return TCL_ERROR; |
| 15884 | 479 | serv_get_info(purple_account_get_connection(account), Tcl_GetString(elems[1])); |
| 6694 | 480 | } else { |
| 13812 | 481 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) |
| 6694 | 482 | return TCL_ERROR; |
| 15884 | 483 | serv_get_info(purple_account_get_connection(account), Tcl_GetString(objv[3])); |
| 6694 | 484 | } |
| 485 | break; | |
| 486 | case CMD_BUDDY_LIST: | |
| 487 | if (objc == 3) { | |
| 488 | if (!strcmp("-all", Tcl_GetString(objv[2]))) { | |
| 489 | all = 1; | |
| 490 | } else { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
491 | result = Tcl_NewStringObj("",-1); |
| 6694 | 492 | Tcl_AppendStringsToObj(result, "unknown option: ", Tcl_GetString(objv[2]), NULL); |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
493 | Tcl_SetObjResult(interp,result); |
| 6694 | 494 | return TCL_ERROR; |
| 495 | } | |
| 496 | } | |
| 497 | list = Tcl_NewListObj(0, NULL); | |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
498 | for (gnode = purple_blist_get_root(); gnode != NULL; gnode = purple_blist_node_get_sibling_next(gnode)) { |
| 6694 | 499 | tclgroup = Tcl_NewListObj(0, NULL); |
| 500 | Tcl_ListObjAppendElement(interp, tclgroup, Tcl_NewStringObj("group", -1)); | |
| 501 | Tcl_ListObjAppendElement(interp, tclgroup, | |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
502 | Tcl_NewStringObj(purple_group_get_name((PurpleGroup *)gnode), -1)); |
| 6694 | 503 | tclgrouplist = Tcl_NewListObj(0, NULL); |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
504 | for (node = purple_blist_node_get_first_child(gnode); node != NULL; node = purple_blist_node_get_sibling_next(node)) { |
|
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
505 | PurpleAccount *account; |
|
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
506 | |
|
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
507 | type = purple_blist_node_get_type(node); |
|
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
508 | switch (type) { |
| 15884 | 509 | case PURPLE_BLIST_CONTACT_NODE: |
| 6746 | 510 | tclcontact = Tcl_NewListObj(0, NULL); |
| 511 | Tcl_IncrRefCount(tclcontact); | |
| 512 | Tcl_ListObjAppendElement(interp, tclcontact, Tcl_NewStringObj("contact", -1)); | |
| 513 | tclcontactlist = Tcl_NewListObj(0, NULL); | |
| 514 | Tcl_IncrRefCount(tclcontactlist); | |
| 515 | count = 0; | |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
516 | for (bnode = purple_blist_node_get_first_child(node); bnode != NULL; bnode = purple_blist_node_get_sibling_next(bnode)) { |
|
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
517 | if (purple_blist_node_get_type(bnode) != PURPLE_BLIST_BUDDY_NODE) |
| 6746 | 518 | continue; |
| 15884 | 519 | bud = (PurpleBuddy *)bnode; |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
520 | account = purple_buddy_get_account(bud); |
|
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
521 | if (!all && !purple_account_is_connected(account)) |
| 6746 | 522 | continue; |
| 523 | count++; | |
| 524 | tclbud = Tcl_NewListObj(0, NULL); | |
| 525 | Tcl_ListObjAppendElement(interp, tclbud, Tcl_NewStringObj("buddy", -1)); | |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
526 | Tcl_ListObjAppendElement(interp, tclbud, Tcl_NewStringObj(purple_buddy_get_name(bud), -1)); |
|
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
527 | Tcl_ListObjAppendElement(interp, tclbud, purple_tcl_ref_new(PurpleTclRefAccount, account)); |
| 6746 | 528 | Tcl_ListObjAppendElement(interp, tclcontactlist, tclbud); |
| 529 | } | |
| 530 | if (count) { | |
| 531 | Tcl_ListObjAppendElement(interp, tclcontact, tclcontactlist); | |
| 532 | Tcl_ListObjAppendElement(interp, tclgrouplist, tclcontact); | |
| 533 | } | |
| 534 | Tcl_DecrRefCount(tclcontact); | |
| 535 | Tcl_DecrRefCount(tclcontactlist); | |
| 6694 | 536 | break; |
| 15884 | 537 | case PURPLE_BLIST_CHAT_NODE: |
| 538 | cnode = (PurpleChat *)node; | |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
539 | account = purple_chat_get_account(cnode); |
|
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
540 | if (!all && !purple_account_is_connected(account)) |
| 6694 | 541 | continue; |
| 542 | tclbud = Tcl_NewListObj(0, NULL); | |
| 543 | Tcl_ListObjAppendElement(interp, tclbud, Tcl_NewStringObj("chat", -1)); | |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
544 | Tcl_ListObjAppendElement(interp, tclbud, Tcl_NewStringObj(purple_chat_get_name(cnode), -1)); |
|
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
545 | Tcl_ListObjAppendElement(interp, tclbud, purple_tcl_ref_new(PurpleTclRefAccount, account)); |
| 6746 | 546 | Tcl_ListObjAppendElement(interp, tclgrouplist, tclbud); |
| 6694 | 547 | break; |
| 548 | default: | |
|
24556
8c9cf439084a
Fix Tcl to compile with the hidden structs.
Richard Laager <rlaager@pidgin.im>
parents:
22353
diff
changeset
|
549 | purple_debug(PURPLE_DEBUG_WARNING, "tcl", "Unexpected buddy type %d", type); |
| 6694 | 550 | continue; |
| 551 | } | |
| 552 | } | |
| 553 | Tcl_ListObjAppendElement(interp, tclgroup, tclgrouplist); | |
| 554 | Tcl_ListObjAppendElement(interp, list, tclgroup); | |
| 555 | } | |
| 556 | Tcl_SetObjResult(interp, list); | |
| 557 | break; | |
| 558 | } | |
| 559 | ||
| 560 | return TCL_OK; | |
| 561 | } | |
| 562 | ||
| 13847 | 563 | int tcl_cmd_cmd(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) |
| 564 | { | |
|
19726
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
565 | const char *cmds[] = { "do", "help", "list", "register", "unregister", NULL }; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
566 | enum { CMD_CMD_DO, CMD_CMD_HELP, CMD_CMD_LIST, CMD_CMD_REGISTER, CMD_CMD_UNREGISTER } cmd; |
| 13847 | 567 | struct tcl_cmd_handler *handler; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
568 | Tcl_Obj *list, *elem; |
|
19726
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
569 | PurpleConversation *convo; |
| 15884 | 570 | PurpleCmdId id; |
|
19726
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
571 | PurpleCmdStatus status; |
| 13847 | 572 | int error; |
|
19726
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
573 | GList *l, *cur; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
574 | gchar *escaped, *errstr = NULL; |
| 13847 | 575 | |
| 576 | if (objc < 2) { | |
| 577 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 578 | return TCL_ERROR; | |
| 579 | } | |
| 580 | ||
| 581 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 582 | return error; | |
| 583 | ||
| 584 | switch (cmd) { | |
|
19726
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
585 | case CMD_CMD_DO: |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
586 | if (objc != 4) { |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
587 | Tcl_WrongNumArgs(interp, 2, objv, "conversation command"); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
588 | return TCL_ERROR; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
589 | } |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
590 | if ((convo = tcl_validate_conversation(objv[2], interp)) == NULL) |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
591 | return TCL_ERROR; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
592 | escaped = g_markup_escape_text(Tcl_GetString(objv[3]), -1); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
593 | status = purple_cmd_do_command(convo, Tcl_GetString(objv[3]), |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
594 | escaped, &errstr); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
595 | g_free(escaped); |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
596 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
597 | Tcl_NewStringObj(errstr ? (char *)errstr : "", -1)); |
|
19726
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
598 | g_free(errstr); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
599 | if (status != PURPLE_CMD_STATUS_OK) { |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
600 | return TCL_ERROR; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
601 | } |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
602 | break; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
603 | case CMD_CMD_HELP: |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
604 | if (objc != 4) { |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
605 | Tcl_WrongNumArgs(interp, 2, objv, "conversation name"); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
606 | return TCL_ERROR; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
607 | } |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
608 | if ((convo = tcl_validate_conversation(objv[2], interp)) == NULL) |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
609 | return TCL_ERROR; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
610 | l = cur = purple_cmd_help(convo, Tcl_GetString(objv[3])); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
611 | list = Tcl_NewListObj(0, NULL); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
612 | while (cur != NULL) { |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
613 | elem = Tcl_NewStringObj((char *)cur->data, -1); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
614 | Tcl_ListObjAppendElement(interp, list, elem); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
615 | cur = g_list_next(cur); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
616 | } |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
617 | g_list_free(l); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
618 | Tcl_SetObjResult(interp, list); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
619 | break; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
620 | case CMD_CMD_LIST: |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
621 | if (objc != 3) { |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
622 | Tcl_WrongNumArgs(interp, 2, objv, "conversation"); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
623 | return TCL_ERROR; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
624 | } |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
625 | if ((convo = tcl_validate_conversation(objv[2], interp)) == NULL) |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
626 | return TCL_ERROR; |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
627 | l = cur = purple_cmd_list(convo); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
628 | list = Tcl_NewListObj(0, NULL); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
629 | while (cur != NULL) { |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
630 | elem = Tcl_NewStringObj((char *)cur->data, -1); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
631 | Tcl_ListObjAppendElement(interp, list, elem); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
632 | cur = g_list_next(cur); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
633 | } |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
634 | g_list_free(l); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
635 | Tcl_SetObjResult(interp, list); |
|
22a31d50bab5
Patch from Dossy Shiobara which improves Tcl support for purple
Ethan Blanton <elb@pidgin.im>
parents:
18190
diff
changeset
|
636 | break; |
| 13847 | 637 | case CMD_CMD_REGISTER: |
| 638 | if (objc != 9) { | |
| 639 | Tcl_WrongNumArgs(interp, 2, objv, "cmd arglist priority flags prpl_id proc helpstr"); | |
| 640 | return TCL_ERROR; | |
| 641 | } | |
| 642 | handler = g_new0(struct tcl_cmd_handler, 1); | |
| 643 | handler->cmd = objv[2]; | |
| 644 | handler->args = Tcl_GetString(objv[3]); | |
| 645 | handler->nargs = strlen(handler->args); | |
| 646 | if ((error = Tcl_GetIntFromObj(interp, objv[4], | |
| 647 | &handler->priority)) != TCL_OK) { | |
| 648 | g_free(handler); | |
| 649 | return error; | |
| 650 | } | |
| 651 | if ((error = Tcl_GetIntFromObj(interp, objv[5], | |
| 652 | &handler->flags)) != TCL_OK) { | |
| 653 | g_free(handler); | |
| 654 | return error; | |
| 655 | } | |
| 656 | handler->prpl_id = Tcl_GetString(objv[6]); | |
| 657 | handler->proc = objv[7]; | |
| 658 | handler->helpstr = Tcl_GetString(objv[8]); | |
| 659 | handler->interp = interp; | |
| 660 | if ((id = tcl_cmd_register(handler)) == 0) { | |
| 661 | tcl_cmd_handler_free(handler); | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
662 | Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); |
| 13847 | 663 | } else { |
| 664 | handler->id = id; | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
665 | Tcl_SetObjResult(interp, Tcl_NewIntObj(id)); |
| 13847 | 666 | } |
| 667 | break; | |
| 668 | case CMD_CMD_UNREGISTER: | |
| 669 | if (objc != 3) { | |
| 670 | Tcl_WrongNumArgs(interp, 2, objv, "id"); | |
| 671 | return TCL_ERROR; | |
| 672 | } | |
| 673 | if ((error = Tcl_GetIntFromObj(interp, objv[2], | |
| 674 | (int *)&id)) != TCL_OK) | |
| 675 | return error; | |
| 676 | tcl_cmd_unregister(id, interp); | |
| 677 | break; | |
| 678 | } | |
| 679 | ||
| 680 | return TCL_OK; | |
| 681 | } | |
| 682 | ||
| 6694 | 683 | int tcl_cmd_connection(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) |
| 684 | { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
685 | Tcl_Obj *list, *elem; |
|
26824
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
686 | const char *cmds[] = { "account", "displayname", "handle", "list", "state", NULL }; |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
687 | enum { CMD_CONN_ACCOUNT, CMD_CONN_DISPLAYNAME, CMD_CONN_HANDLE, |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
688 | CMD_CONN_LIST, CMD_CONN_STATE } cmd; |
| 6694 | 689 | int error; |
|
18122
9bf9970c1b6a
disapproval of revision '2d8ea56b90971e7851442d96b7d74ecb4f052126'
Richard Laager <rlaager@pidgin.im>
parents:
18121
diff
changeset
|
690 | GList *cur; |
| 15884 | 691 | PurpleConnection *gc; |
| 6694 | 692 | |
| 693 | if (objc < 2) { | |
| 694 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 695 | return TCL_ERROR; | |
| 696 | } | |
| 697 | ||
| 698 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 699 | return error; | |
| 700 | ||
| 701 | switch (cmd) { | |
| 702 | case CMD_CONN_ACCOUNT: | |
| 703 | if (objc != 3) { | |
|
6864
359bc55e767f
[gaim-migrate @ 7410]
Björn Voigt <bjoern@cs.tu-berlin.de>
parents:
6746
diff
changeset
|
704 | Tcl_WrongNumArgs(interp, 2, objv, "gc"); |
| 6694 | 705 | return TCL_ERROR; |
| 706 | } | |
| 13817 | 707 | if ((gc = tcl_validate_gc(objv[2], interp)) == NULL) |
| 6694 | 708 | return TCL_ERROR; |
| 13817 | 709 | Tcl_SetObjResult(interp, |
| 15884 | 710 | purple_tcl_ref_new(PurpleTclRefAccount, |
| 711 | purple_connection_get_account(gc))); | |
| 6694 | 712 | break; |
| 7713 | 713 | case CMD_CONN_DISPLAYNAME: |
| 714 | if (objc != 3) { | |
| 715 | Tcl_WrongNumArgs(interp, 2, objv, "gc"); | |
| 716 | return TCL_ERROR; | |
| 717 | } | |
| 13817 | 718 | if ((gc = tcl_validate_gc(objv[2], interp)) == NULL) |
| 7713 | 719 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
720 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
721 | Tcl_NewStringObj(purple_connection_get_display_name(gc), -1)); |
| 7713 | 722 | break; |
| 6694 | 723 | case CMD_CONN_HANDLE: |
| 724 | if (objc != 2) { | |
| 725 | Tcl_WrongNumArgs(interp, 2, objv, ""); | |
| 726 | return TCL_ERROR; | |
| 727 | } | |
|
20393
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
728 | Tcl_SetObjResult(interp, purple_tcl_ref_new(PurpleTclRefHandle, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
729 | purple_connections_get_handle())); |
| 6694 | 730 | break; |
| 731 | case CMD_CONN_LIST: | |
| 732 | if (objc != 2) { | |
| 733 | Tcl_WrongNumArgs(interp, 2, objv, ""); | |
| 734 | return TCL_ERROR; | |
| 735 | } | |
| 736 | list = Tcl_NewListObj(0, NULL); | |
| 15884 | 737 | for (cur = purple_connections_get_all(); cur != NULL; cur = g_list_next(cur)) { |
| 738 | elem = purple_tcl_ref_new(PurpleTclRefConnection, cur->data); | |
| 6694 | 739 | Tcl_ListObjAppendElement(interp, list, elem); |
| 740 | } | |
| 741 | Tcl_SetObjResult(interp, list); | |
| 742 | break; | |
|
26824
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
743 | case CMD_CONN_STATE: |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
744 | if (objc != 3) { |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
745 | Tcl_WrongNumArgs(interp, 2, objv, "gc"); |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
746 | return TCL_ERROR; |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
747 | } |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
748 | if ((gc = tcl_validate_gc(objv[2], interp)) == NULL) |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
749 | return TCL_ERROR; |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
750 | switch (purple_connection_get_state(gc)) { |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
751 | case PURPLE_DISCONNECTED: |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
752 | Tcl_SetObjResult(interp, Tcl_NewStringObj("disconnected", -1)); |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
753 | break; |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
754 | case PURPLE_CONNECTED: |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
755 | Tcl_SetObjResult(interp, Tcl_NewStringObj("connected", -1)); |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
756 | break; |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
757 | case PURPLE_CONNECTING: |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
758 | Tcl_SetObjResult(interp, Tcl_NewStringObj("connecting", -1)); |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
759 | break; |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
760 | } |
|
c7ba07f9ca42
Add the Tcl command purple::connection state (purple_connection_get_state).
Ethan Blanton <elb@pidgin.im>
parents:
25913
diff
changeset
|
761 | break; |
| 6694 | 762 | } |
| 763 | ||
| 764 | return TCL_OK; | |
| 765 | } | |
| 766 | ||
| 767 | int tcl_cmd_conversation(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) | |
| 768 | { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
769 | Tcl_Obj *list, *elem; |
| 14425 | 770 | const char *cmds[] = { "find", "handle", "list", "new", "write", "name", "title", "send", NULL }; |
| 771 | enum { CMD_CONV_FIND, CMD_CONV_HANDLE, CMD_CONV_LIST, CMD_CONV_NEW, CMD_CONV_WRITE , CMD_CONV_NAME, CMD_CONV_TITLE, CMD_CONV_SEND } cmd; | |
|
10339
246feba79f04
[gaim-migrate @ 11548]
Mark Doliner <markdoliner@pidgin.im>
parents:
10246
diff
changeset
|
772 | const char *styles[] = { "send", "recv", "system", NULL }; |
| 6694 | 773 | enum { CMD_CONV_WRITE_SEND, CMD_CONV_WRITE_RECV, CMD_CONV_WRITE_SYSTEM } style; |
|
10339
246feba79f04
[gaim-migrate @ 11548]
Mark Doliner <markdoliner@pidgin.im>
parents:
10246
diff
changeset
|
774 | const char *newopts[] = { "-chat", "-im" }; |
| 6694 | 775 | enum { CMD_CONV_NEW_CHAT, CMD_CONV_NEW_IM } newopt; |
| 15884 | 776 | PurpleConversation *convo; |
| 777 | PurpleAccount *account; | |
| 778 | PurpleConversationType type; | |
|
18122
9bf9970c1b6a
disapproval of revision '2d8ea56b90971e7851442d96b7d74ecb4f052126'
Richard Laager <rlaager@pidgin.im>
parents:
18121
diff
changeset
|
779 | GList *cur; |
| 6694 | 780 | char *opt, *from, *what; |
| 7156 | 781 | int error, argsused, flags = 0; |
| 6694 | 782 | |
| 783 | if (objc < 2) { | |
| 784 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 785 | return TCL_ERROR; | |
| 786 | } | |
| 787 | ||
| 788 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 789 | return error; | |
| 790 | ||
| 791 | switch (cmd) { | |
| 792 | case CMD_CONV_FIND: | |
| 10829 | 793 | if (objc != 4) { |
| 794 | Tcl_WrongNumArgs(interp, 2, objv, "account name"); | |
| 6694 | 795 | return TCL_ERROR; |
| 796 | } | |
| 797 | account = NULL; | |
| 13812 | 798 | if ((account = tcl_validate_account(objv[2], interp)) == NULL) |
| 10829 | 799 | return TCL_ERROR; |
| 15884 | 800 | convo = purple_find_conversation_with_account(PURPLE_CONV_TYPE_ANY, |
| 10829 | 801 | Tcl_GetString(objv[3]), |
| 802 | account); | |
| 15884 | 803 | Tcl_SetObjResult(interp, purple_tcl_ref_new(PurpleTclRefConversation, convo)); |
| 6694 | 804 | break; |
| 805 | case CMD_CONV_HANDLE: | |
| 806 | if (objc != 2) { | |
| 807 | Tcl_WrongNumArgs(interp, 2, objv, ""); | |
| 808 | return TCL_ERROR; | |
| 809 | } | |
|
20393
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
810 | Tcl_SetObjResult(interp, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
811 | purple_tcl_ref_new(PurpleTclRefHandle, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
812 | purple_conversations_get_handle())); |
| 6694 | 813 | break; |
| 814 | case CMD_CONV_LIST: | |
| 815 | list = Tcl_NewListObj(0, NULL); | |
| 15884 | 816 | for (cur = purple_get_conversations(); cur != NULL; cur = g_list_next(cur)) { |
| 817 | elem = purple_tcl_ref_new(PurpleTclRefConversation, cur->data); | |
| 6694 | 818 | Tcl_ListObjAppendElement(interp, list, elem); |
| 819 | } | |
| 820 | Tcl_SetObjResult(interp, list); | |
| 821 | break; | |
| 822 | case CMD_CONV_NEW: | |
| 823 | if (objc < 4) { | |
| 824 | Tcl_WrongNumArgs(interp, 2, objv, "?options? account name"); | |
| 825 | return TCL_ERROR; | |
| 826 | } | |
| 827 | argsused = 2; | |
| 15884 | 828 | type = PURPLE_CONV_TYPE_IM; |
| 6694 | 829 | while (argsused < objc) { |
| 830 | opt = Tcl_GetString(objv[argsused]); | |
| 831 | if (*opt == '-') { | |
| 832 | if ((error = Tcl_GetIndexFromObj(interp, objv[argsused], newopts, | |
| 833 | "option", 0, (int *)&newopt)) != TCL_OK) | |
| 834 | return error; | |
| 835 | argsused++; | |
| 836 | switch (newopt) { | |
| 837 | case CMD_CONV_NEW_CHAT: | |
| 15884 | 838 | type = PURPLE_CONV_TYPE_CHAT; |
| 6694 | 839 | break; |
| 840 | case CMD_CONV_NEW_IM: | |
| 15884 | 841 | type = PURPLE_CONV_TYPE_IM; |
| 6694 | 842 | break; |
| 843 | } | |
| 844 | } else { | |
| 845 | break; | |
| 846 | } | |
| 847 | } | |
| 848 | if (objc - argsused != 2) { | |
| 849 | Tcl_WrongNumArgs(interp, 2, objv, "?options? account name"); | |
| 850 | return TCL_ERROR; | |
| 851 | } | |
| 13812 | 852 | if ((account = tcl_validate_account(objv[argsused++], interp)) == NULL) |
| 6694 | 853 | return TCL_ERROR; |
| 15884 | 854 | convo = purple_conversation_new(type, account, Tcl_GetString(objv[argsused])); |
| 855 | Tcl_SetObjResult(interp, purple_tcl_ref_new(PurpleTclRefConversation, convo)); | |
| 6694 | 856 | break; |
| 857 | case CMD_CONV_WRITE: | |
| 858 | if (objc != 6) { | |
| 859 | Tcl_WrongNumArgs(interp, 2, objv, "conversation style from what"); | |
| 860 | return TCL_ERROR; | |
| 861 | } | |
| 13812 | 862 | if ((convo = tcl_validate_conversation(objv[2], interp)) == NULL) |
| 863 | return TCL_ERROR; | |
| 6694 | 864 | if ((error = Tcl_GetIndexFromObj(interp, objv[3], styles, "style", 0, (int *)&style)) != TCL_OK) |
| 865 | return error; | |
| 866 | from = Tcl_GetString(objv[4]); | |
| 867 | what = Tcl_GetString(objv[5]); | |
| 868 | ||
| 869 | switch (style) { | |
| 870 | case CMD_CONV_WRITE_SEND: | |
| 15884 | 871 | flags = PURPLE_MESSAGE_SEND; |
| 6694 | 872 | break; |
| 873 | case CMD_CONV_WRITE_RECV: | |
| 15884 | 874 | flags = PURPLE_MESSAGE_RECV; |
| 6694 | 875 | break; |
| 876 | case CMD_CONV_WRITE_SYSTEM: | |
| 15884 | 877 | flags = PURPLE_MESSAGE_SYSTEM; |
| 6694 | 878 | break; |
| 879 | } | |
| 15884 | 880 | if (purple_conversation_get_type(convo) == PURPLE_CONV_TYPE_CHAT) |
| 881 | purple_conv_chat_write(PURPLE_CONV_CHAT(convo), from, what, flags, time(NULL)); | |
| 6694 | 882 | else |
| 15884 | 883 | purple_conv_im_write(PURPLE_CONV_IM(convo), from, what, flags, time(NULL)); |
| 6694 | 884 | break; |
| 14357 | 885 | case CMD_CONV_NAME: |
| 886 | if (objc != 3) { | |
| 887 | Tcl_WrongNumArgs(interp, 2, objv, "conversation"); | |
| 888 | return TCL_ERROR; | |
| 889 | } | |
| 890 | ||
| 891 | if ((convo = tcl_validate_conversation(objv[2], interp)) == NULL) | |
| 892 | return TCL_ERROR; | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
893 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
894 | Tcl_NewStringObj((char *)purple_conversation_get_name(convo), -1)); |
| 14357 | 895 | break; |
| 896 | case CMD_CONV_TITLE: | |
| 897 | if (objc != 3) { | |
| 898 | Tcl_WrongNumArgs(interp, 2, objv, "conversation"); | |
| 899 | return TCL_ERROR; | |
| 900 | } | |
| 901 | ||
| 902 | if ((convo = tcl_validate_conversation(objv[2], interp)) == NULL) | |
| 903 | return TCL_ERROR; | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
904 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
905 | Tcl_NewStringObj((char *)purple_conversation_get_title(convo), -1)); |
| 14357 | 906 | break; |
| 14425 | 907 | case CMD_CONV_SEND: |
| 908 | if (objc != 4) { | |
| 909 | Tcl_WrongNumArgs(interp, 2, objv, "conversation message"); | |
| 910 | return TCL_ERROR; | |
| 911 | } | |
| 912 | if ((convo = tcl_validate_conversation(objv[2], interp)) == NULL) | |
| 913 | return TCL_ERROR; | |
| 914 | what = Tcl_GetString(objv[3]); | |
| 15884 | 915 | if (purple_conversation_get_type(convo) == PURPLE_CONV_TYPE_CHAT) |
| 916 | purple_conv_chat_send(PURPLE_CONV_CHAT(convo), what); | |
| 14425 | 917 | else |
| 15884 | 918 | purple_conv_im_send(PURPLE_CONV_IM(convo), what); |
| 14425 | 919 | break; |
| 6694 | 920 | } |
| 921 | ||
| 922 | return TCL_OK; | |
| 923 | } | |
| 924 | ||
| 925 | int tcl_cmd_core(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) | |
| 926 | { | |
|
10339
246feba79f04
[gaim-migrate @ 11548]
Mark Doliner <markdoliner@pidgin.im>
parents:
10246
diff
changeset
|
927 | const char *cmds[] = { "handle", "quit", NULL }; |
| 6694 | 928 | enum { CMD_CORE_HANDLE, CMD_CORE_QUIT } cmd; |
| 929 | int error; | |
| 930 | ||
| 931 | if (objc < 2) { | |
| 932 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 933 | return TCL_ERROR; | |
| 934 | } | |
| 935 | ||
| 936 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 937 | return error; | |
| 938 | ||
| 939 | switch (cmd) { | |
| 940 | case CMD_CORE_HANDLE: | |
| 941 | if (objc != 2) { | |
| 942 | Tcl_WrongNumArgs(interp, 2, objv, ""); | |
| 943 | return TCL_ERROR; | |
| 944 | } | |
|
20393
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
945 | Tcl_SetObjResult(interp, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
946 | purple_tcl_ref_new(PurpleTclRefHandle, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
947 | purple_get_core())); |
| 6694 | 948 | break; |
| 949 | case CMD_CORE_QUIT: | |
| 950 | if (objc != 2) { | |
| 951 | Tcl_WrongNumArgs(interp, 2, objv, ""); | |
| 952 | return TCL_ERROR; | |
| 953 | } | |
| 15884 | 954 | purple_core_quit(); |
| 6694 | 955 | break; |
| 956 | } | |
| 957 | ||
| 958 | return TCL_OK; | |
| 959 | } | |
| 960 | ||
| 961 | int tcl_cmd_debug(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) | |
| 962 | { | |
| 963 | char *category, *message; | |
| 964 | int lev; | |
|
10339
246feba79f04
[gaim-migrate @ 11548]
Mark Doliner <markdoliner@pidgin.im>
parents:
10246
diff
changeset
|
965 | const char *levels[] = { "-misc", "-info", "-warning", "-error", NULL }; |
| 15884 | 966 | PurpleDebugLevel levelind[] = { PURPLE_DEBUG_MISC, PURPLE_DEBUG_INFO, PURPLE_DEBUG_WARNING, PURPLE_DEBUG_ERROR }; |
| 6694 | 967 | int error; |
| 968 | ||
| 969 | if (objc != 4) { | |
| 970 | Tcl_WrongNumArgs(interp, 1, objv, "level category message"); | |
| 971 | return TCL_ERROR; | |
| 972 | } | |
| 973 | ||
| 974 | error = Tcl_GetIndexFromObj(interp, objv[1], levels, "debug level", 0, &lev); | |
| 975 | if (error != TCL_OK) | |
| 976 | return error; | |
| 977 | ||
| 978 | category = Tcl_GetString(objv[2]); | |
| 979 | message = Tcl_GetString(objv[3]); | |
| 980 | ||
| 15884 | 981 | purple_debug(levelind[lev], category, "%s\n", message); |
| 6694 | 982 | |
| 983 | return TCL_OK; | |
| 984 | } | |
| 985 | ||
| 986 | int tcl_cmd_notify(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) | |
| 987 | { | |
| 988 | int error, type; | |
|
10339
246feba79f04
[gaim-migrate @ 11548]
Mark Doliner <markdoliner@pidgin.im>
parents:
10246
diff
changeset
|
989 | const char *opts[] = { "-error", "-warning", "-info", NULL }; |
| 15884 | 990 | PurpleNotifyMsgType optind[] = { PURPLE_NOTIFY_MSG_ERROR, PURPLE_NOTIFY_MSG_WARNING, PURPLE_NOTIFY_MSG_INFO }; |
| 6694 | 991 | char *title, *msg1, *msg2; |
| 992 | ||
| 993 | if (objc < 4 || objc > 5) { | |
| 994 | Tcl_WrongNumArgs(interp, 1, objv, "?type? title primary secondary"); | |
| 995 | return TCL_ERROR; | |
| 996 | } | |
| 997 | ||
| 998 | if (objc == 4) { | |
| 13424 | 999 | type = 1; /* Default to warning */ |
| 6694 | 1000 | title = Tcl_GetString(objv[1]); |
| 1001 | msg1 = Tcl_GetString(objv[2]); | |
| 1002 | msg2 = Tcl_GetString(objv[3]); | |
| 1003 | } else { | |
| 1004 | error = Tcl_GetIndexFromObj(interp, objv[1], opts, "message type", 0, &type); | |
| 1005 | if (error != TCL_OK) | |
| 1006 | return error; | |
| 1007 | title = Tcl_GetString(objv[2]); | |
| 1008 | msg1 = Tcl_GetString(objv[3]); | |
| 1009 | msg2 = Tcl_GetString(objv[4]); | |
| 1010 | } | |
| 1011 | ||
| 15884 | 1012 | purple_notify_message(_tcl_plugin, optind[type], title, msg1, msg2, NULL, NULL); |
| 6694 | 1013 | |
| 1014 | return TCL_OK; | |
| 1015 | } | |
| 1016 | ||
|
15750
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1017 | int tcl_cmd_plugins(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1018 | { |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1019 | const char *cmds[] = { "handle", NULL }; |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1020 | enum { CMD_PLUGINS_HANDLE } cmd; |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1021 | int error; |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1022 | |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1023 | if (objc < 2) { |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1024 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1025 | return TCL_ERROR; |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1026 | } |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1027 | |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1028 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1029 | return error; |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1030 | |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1031 | switch (cmd) { |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1032 | case CMD_PLUGINS_HANDLE: |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1033 | if (objc != 2) { |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1034 | Tcl_WrongNumArgs(interp, 2, objv, ""); |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1035 | return TCL_ERROR; |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1036 | } |
|
20393
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
1037 | Tcl_SetObjResult(interp, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
1038 | purple_tcl_ref_new(PurpleTclRefHandle, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
1039 | purple_plugins_get_handle())); |
|
15750
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1040 | break; |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1041 | } |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1042 | |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1043 | return TCL_OK; |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1044 | } |
|
c238e0966eb1
gaim::plugin Tcl command, thanks to Dossy Shiobara
Ethan Blanton <elb@pidgin.im>
parents:
15435
diff
changeset
|
1045 | |
| 6694 | 1046 | int tcl_cmd_prefs(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) |
| 1047 | { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1048 | Tcl_Obj *list, *elem, **elems; |
|
10339
246feba79f04
[gaim-migrate @ 11548]
Mark Doliner <markdoliner@pidgin.im>
parents:
10246
diff
changeset
|
1049 | const char *cmds[] = { "get", "set", "type", NULL }; |
| 6694 | 1050 | enum { CMD_PREFS_GET, CMD_PREFS_SET, CMD_PREFS_TYPE } cmd; |
| 1051 | /* char *types[] = { "none", "boolean", "int", "string", "stringlist", NULL }; */ | |
| 1052 | /* enum { TCL_PREFS_NONE, TCL_PREFS_BOOL, TCL_PREFS_INT, TCL_PREFS_STRING, TCL_PREFS_STRINGLIST } type; */ | |
| 15884 | 1053 | PurplePrefType preftype; |
| 6694 | 1054 | GList *cur; |
| 1055 | int error, intval, nelem, i; | |
| 1056 | ||
| 1057 | if (objc < 2) { | |
| 1058 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 1059 | return TCL_ERROR; | |
| 1060 | } | |
| 1061 | ||
| 1062 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 1063 | return error; | |
| 1064 | ||
| 1065 | switch (cmd) { | |
| 1066 | case CMD_PREFS_GET: | |
| 1067 | if (objc != 3) { | |
| 1068 | Tcl_WrongNumArgs(interp, 1, objv, "path"); | |
| 1069 | return TCL_ERROR; | |
| 1070 | } | |
| 15884 | 1071 | preftype = purple_prefs_get_type(Tcl_GetString(objv[2])); |
| 6694 | 1072 | switch (preftype) { |
| 15884 | 1073 | case PURPLE_PREF_NONE: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1074 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1075 | Tcl_NewStringObj("pref type none", -1)); |
| 6694 | 1076 | return TCL_ERROR; |
| 1077 | break; | |
| 15884 | 1078 | case PURPLE_PREF_BOOLEAN: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1079 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1080 | Tcl_NewBooleanObj( |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1081 | purple_prefs_get_bool(Tcl_GetString(objv[2])))); |
| 6694 | 1082 | break; |
| 15884 | 1083 | case PURPLE_PREF_INT: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1084 | Tcl_SetObjResult(interp, Tcl_NewIntObj(purple_prefs_get_int(Tcl_GetString(objv[2])))); |
| 6694 | 1085 | break; |
| 15884 | 1086 | case PURPLE_PREF_STRING: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1087 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1088 | Tcl_NewStringObj((char *)purple_prefs_get_string(Tcl_GetString(objv[2])), -1)); |
| 6694 | 1089 | break; |
| 15884 | 1090 | case PURPLE_PREF_STRING_LIST: |
| 1091 | cur = purple_prefs_get_string_list(Tcl_GetString(objv[2])); | |
| 6694 | 1092 | list = Tcl_NewListObj(0, NULL); |
| 1093 | while (cur != NULL) { | |
| 1094 | elem = Tcl_NewStringObj((char *)cur->data, -1); | |
| 1095 | Tcl_ListObjAppendElement(interp, list, elem); | |
|
22240
3f3d4ff9f323
disapproval of revision 'b2c07c730315e96101dd0371133d170396333f4c'
Etan Reisner <deryni@pidgin.im>
parents:
22239
diff
changeset
|
1096 | cur = g_list_next(cur); |
| 6694 | 1097 | } |
| 1098 | Tcl_SetObjResult(interp, list); | |
| 1099 | break; | |
| 1100 | default: | |
| 15884 | 1101 | purple_debug(PURPLE_DEBUG_ERROR, "tcl", "tcl does not know about pref type %d\n", preftype); |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1102 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1103 | Tcl_NewStringObj("unknown pref type", -1)); |
| 6694 | 1104 | return TCL_ERROR; |
| 1105 | } | |
| 1106 | break; | |
| 1107 | case CMD_PREFS_SET: | |
| 1108 | if (objc != 4) { | |
| 1109 | Tcl_WrongNumArgs(interp, 1, objv, "path value"); | |
| 1110 | return TCL_ERROR; | |
| 1111 | } | |
| 15884 | 1112 | preftype = purple_prefs_get_type(Tcl_GetString(objv[2])); |
| 6694 | 1113 | switch (preftype) { |
| 15884 | 1114 | case PURPLE_PREF_NONE: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1115 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1116 | Tcl_NewStringObj("bad path or pref type none", -1)); |
| 6694 | 1117 | return TCL_ERROR; |
| 1118 | break; | |
| 15884 | 1119 | case PURPLE_PREF_BOOLEAN: |
| 6694 | 1120 | if ((error = Tcl_GetBooleanFromObj(interp, objv[3], &intval)) != TCL_OK) |
| 1121 | return error; | |
| 15884 | 1122 | purple_prefs_set_bool(Tcl_GetString(objv[2]), intval); |
| 6694 | 1123 | break; |
| 15884 | 1124 | case PURPLE_PREF_INT: |
| 6694 | 1125 | if ((error = Tcl_GetIntFromObj(interp, objv[3], &intval)) != TCL_OK) |
| 1126 | return error; | |
| 15884 | 1127 | purple_prefs_set_int(Tcl_GetString(objv[2]), intval); |
| 6694 | 1128 | break; |
| 15884 | 1129 | case PURPLE_PREF_STRING: |
| 1130 | purple_prefs_set_string(Tcl_GetString(objv[2]), Tcl_GetString(objv[3])); | |
| 6694 | 1131 | break; |
| 15884 | 1132 | case PURPLE_PREF_STRING_LIST: |
| 6694 | 1133 | if ((error = Tcl_ListObjGetElements(interp, objv[3], &nelem, &elems)) != TCL_OK) |
| 1134 | return error; | |
| 1135 | cur = NULL; | |
| 1136 | for (i = 0; i < nelem; i++) { | |
| 1137 | cur = g_list_append(cur, (gpointer)Tcl_GetString(elems[i])); | |
| 1138 | } | |
| 15884 | 1139 | purple_prefs_set_string_list(Tcl_GetString(objv[2]), cur); |
| 6694 | 1140 | g_list_free(cur); |
| 1141 | break; | |
| 1142 | default: | |
| 15884 | 1143 | purple_debug(PURPLE_DEBUG_ERROR, "tcl", "tcl does not know about pref type %d\n", preftype); |
| 6694 | 1144 | return TCL_ERROR; |
| 1145 | } | |
| 1146 | break; | |
| 1147 | case CMD_PREFS_TYPE: | |
| 1148 | if (objc != 3) { | |
| 1149 | Tcl_WrongNumArgs(interp, 1, objv, "path"); | |
| 1150 | return TCL_ERROR; | |
| 1151 | } | |
| 15884 | 1152 | preftype = purple_prefs_get_type(Tcl_GetString(objv[2])); |
| 6694 | 1153 | switch (preftype) { |
| 15884 | 1154 | case PURPLE_PREF_NONE: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1155 | Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); |
| 6694 | 1156 | break; |
| 15884 | 1157 | case PURPLE_PREF_BOOLEAN: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1158 | Tcl_SetObjResult(interp, Tcl_NewStringObj("boolean", -1)); |
| 6694 | 1159 | break; |
| 15884 | 1160 | case PURPLE_PREF_INT: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1161 | Tcl_SetObjResult(interp, Tcl_NewStringObj("int", -1)); |
| 6694 | 1162 | break; |
| 15884 | 1163 | case PURPLE_PREF_STRING: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1164 | Tcl_SetObjResult(interp, Tcl_NewStringObj("string", -1)); |
| 6694 | 1165 | break; |
| 15884 | 1166 | case PURPLE_PREF_STRING_LIST: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1167 | Tcl_SetObjResult(interp, Tcl_NewStringObj("stringlist", -1)); |
| 6694 | 1168 | break; |
| 1169 | default: | |
| 15884 | 1170 | purple_debug(PURPLE_DEBUG_ERROR, "tcl", "tcl does not know about pref type %d\n", preftype); |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1171 | Tcl_SetObjResult(interp, Tcl_NewStringObj("unknown", -1)); |
| 6694 | 1172 | } |
| 1173 | break; | |
| 1174 | } | |
| 1175 | ||
| 1176 | return TCL_OK; | |
| 1177 | } | |
| 1178 | ||
| 13823 | 1179 | int tcl_cmd_presence(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) |
| 1180 | { | |
| 1181 | const char *cmds[] = { "account", "active_status", "available", | |
| 1182 | "chat_user", "context", "conversation", "idle", | |
| 1183 | "login", "online", "status", "statuses", NULL }; | |
| 1184 | enum { CMD_PRESENCE_ACCOUNT, CMD_PRESENCE_ACTIVE_STATUS, | |
| 1185 | CMD_PRESENCE_AVAILABLE, CMD_PRESENCE_CHAT_USER, | |
| 1186 | CMD_PRESENCE_CONTEXT, CMD_PRESENCE_CONVERSATION, | |
| 1187 | CMD_PRESENCE_IDLE, CMD_PRESENCE_LOGIN, CMD_PRESENCE_ONLINE, | |
| 1188 | CMD_PRESENCE_STATUS, CMD_PRESENCE_STATUSES } cmd; | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1189 | Tcl_Obj *result; |
| 13823 | 1190 | Tcl_Obj *list, *elem; |
| 15884 | 1191 | PurplePresence *presence; |
|
18190
bcf28ef7e8ff
Re-fix the DBus list handling code by killing const GList* / const GSList*
Richard Laager <rlaager@pidgin.im>
parents:
18122
diff
changeset
|
1192 | GList *cur; |
| 13823 | 1193 | int error, idle, idle_time, login_time; |
| 1194 | ||
| 1195 | if (objc < 2) { | |
| 1196 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 1197 | return TCL_ERROR; | |
| 1198 | } | |
| 1199 | ||
| 1200 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 1201 | return error; | |
| 1202 | ||
| 1203 | switch (cmd) { | |
| 1204 | case CMD_PRESENCE_ACCOUNT: | |
| 1205 | if (objc != 3) { | |
| 1206 | Tcl_WrongNumArgs(interp, 2, objv, "presence"); | |
| 1207 | return TCL_ERROR; | |
| 1208 | } | |
| 15884 | 1209 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1210 | return TCL_ERROR; |
| 15884 | 1211 | Tcl_SetObjResult(interp, purple_tcl_ref_new(PurpleTclRefAccount, |
| 1212 | purple_presence_get_account(presence))); | |
| 13823 | 1213 | break; |
| 1214 | case CMD_PRESENCE_ACTIVE_STATUS: | |
| 1215 | if (objc != 3 && objc != 4 && objc != 5) { | |
| 1216 | Tcl_WrongNumArgs(interp, 2, objv, "presence [?status_id? | ?-primitive primitive?]"); | |
| 1217 | return TCL_ERROR; | |
| 1218 | } | |
| 15884 | 1219 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1220 | return TCL_ERROR; |
| 1221 | if (objc == 3) { | |
| 1222 | Tcl_SetObjResult(interp, | |
| 15884 | 1223 | purple_tcl_ref_new(PurpleTclRefStatus, |
| 1224 | purple_presence_get_active_status(presence))); | |
| 13823 | 1225 | } else if (objc == 4) { |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1226 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1227 | Tcl_NewBooleanObj( |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1228 | purple_presence_is_status_active(presence, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1229 | Tcl_GetString(objv[3])))); |
| 13823 | 1230 | } else { |
| 15884 | 1231 | PurpleStatusPrimitive primitive; |
| 13823 | 1232 | if (strcmp(Tcl_GetString(objv[3]), "-primitive")) { |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1233 | result = Tcl_NewStringObj("bad option \"", -1); |
| 13823 | 1234 | Tcl_AppendObjToObj(result, objv[3]); |
| 1235 | Tcl_AppendToObj(result, | |
| 1236 | "\": should be -primitive", -1); | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1237 | Tcl_SetObjResult(interp,result); |
| 13823 | 1238 | return TCL_ERROR; |
| 1239 | } | |
| 15884 | 1240 | primitive = purple_primitive_get_type_from_id(Tcl_GetString(objv[4])); |
| 1241 | if (primitive == PURPLE_STATUS_UNSET) { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1242 | result = Tcl_NewStringObj("invalid primitive ", -1); |
| 13823 | 1243 | Tcl_AppendObjToObj(result, objv[4]); |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1244 | Tcl_SetObjResult(interp,result); |
| 13823 | 1245 | return TCL_ERROR; |
| 1246 | } | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1247 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1248 | Tcl_NewBooleanObj( |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1249 | purple_presence_is_status_primitive_active(presence, primitive))); |
| 13823 | 1250 | break; |
| 1251 | } | |
| 1252 | break; | |
| 1253 | case CMD_PRESENCE_AVAILABLE: | |
| 1254 | if (objc != 3) { | |
| 1255 | Tcl_WrongNumArgs(interp, 2, objv, "presence"); | |
| 1256 | return TCL_ERROR; | |
| 1257 | } | |
| 15884 | 1258 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1259 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1260 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1261 | Tcl_NewBooleanObj(purple_presence_is_available(presence))); |
| 13823 | 1262 | break; |
| 1263 | case CMD_PRESENCE_CHAT_USER: | |
| 1264 | if (objc != 3) { | |
| 1265 | Tcl_WrongNumArgs(interp, 2, objv, "presence"); | |
| 1266 | return TCL_ERROR; | |
| 1267 | } | |
| 15884 | 1268 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1269 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1270 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1271 | Tcl_NewStringObj(purple_presence_get_chat_user(presence), -1)); |
| 13823 | 1272 | break; |
| 1273 | case CMD_PRESENCE_CONTEXT: | |
| 1274 | if (objc != 3) { | |
| 1275 | Tcl_WrongNumArgs(interp, 2, objv, "presence"); | |
| 1276 | return TCL_ERROR; | |
| 1277 | } | |
| 15884 | 1278 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1279 | return TCL_ERROR; |
| 15884 | 1280 | switch (purple_presence_get_context(presence)) { |
| 1281 | case PURPLE_PRESENCE_CONTEXT_UNSET: | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1282 | Tcl_SetObjResult(interp, Tcl_NewStringObj("unset", -1)); |
| 13823 | 1283 | break; |
| 15884 | 1284 | case PURPLE_PRESENCE_CONTEXT_ACCOUNT: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1285 | Tcl_SetObjResult(interp, Tcl_NewStringObj("account", -1)); |
| 13823 | 1286 | break; |
| 15884 | 1287 | case PURPLE_PRESENCE_CONTEXT_CONV: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1288 | Tcl_SetObjResult(interp, Tcl_NewStringObj("conversation", -1)); |
| 13823 | 1289 | break; |
| 15884 | 1290 | case PURPLE_PRESENCE_CONTEXT_BUDDY: |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1291 | Tcl_SetObjResult(interp, Tcl_NewStringObj("buddy", -1)); |
| 13823 | 1292 | break; |
| 1293 | } | |
| 1294 | break; | |
| 1295 | case CMD_PRESENCE_CONVERSATION: | |
| 1296 | if (objc != 3) { | |
| 1297 | Tcl_WrongNumArgs(interp, 2, objv, "presence"); | |
| 1298 | return TCL_ERROR; | |
| 1299 | } | |
| 15884 | 1300 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1301 | return TCL_ERROR; |
| 15884 | 1302 | Tcl_SetObjResult(interp, purple_tcl_ref_new(PurpleTclRefConversation, |
| 1303 | purple_presence_get_conversation(presence))); | |
| 13823 | 1304 | break; |
| 1305 | case CMD_PRESENCE_IDLE: | |
| 1306 | if (objc < 3 || objc > 5) { | |
| 1307 | Tcl_WrongNumArgs(interp, 2, objv, "presence ?idle? ?time?"); | |
| 1308 | return TCL_ERROR; | |
| 1309 | } | |
| 15884 | 1310 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1311 | return TCL_ERROR; |
| 1312 | if (objc == 3) { | |
| 15884 | 1313 | if (purple_presence_is_idle(presence)) { |
| 1314 | idle_time = purple_presence_get_idle_time (presence); | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1315 | Tcl_SetObjResult(interp, Tcl_NewIntObj(idle_time)); |
| 13823 | 1316 | } else { |
| 1317 | result = Tcl_NewListObj(0, NULL); | |
| 1318 | Tcl_SetObjResult(interp, result); | |
| 1319 | } | |
| 1320 | break; | |
| 1321 | } | |
| 1322 | if ((error = Tcl_GetBooleanFromObj(interp, objv[3], &idle)) != TCL_OK) | |
| 1323 | return TCL_ERROR; | |
| 1324 | if (objc == 4) { | |
| 15884 | 1325 | purple_presence_set_idle(presence, idle, time(NULL)); |
| 13823 | 1326 | } else if (objc == 5) { |
| 1327 | if ((error = Tcl_GetIntFromObj(interp, | |
| 1328 | objv[4], | |
| 1329 | &idle_time)) != TCL_OK) | |
| 1330 | return TCL_ERROR; | |
| 15884 | 1331 | purple_presence_set_idle(presence, idle, idle_time); |
| 13823 | 1332 | } |
| 1333 | break; | |
| 1334 | case CMD_PRESENCE_LOGIN: | |
| 1335 | if (objc != 3 && objc != 4) { | |
| 1336 | Tcl_WrongNumArgs(interp, 2, objv, "presence ?time?"); | |
| 1337 | return TCL_ERROR; | |
| 1338 | } | |
| 15884 | 1339 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1340 | return TCL_ERROR; |
| 1341 | if (objc == 3) { | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1342 | Tcl_SetObjResult(interp, Tcl_NewIntObj(purple_presence_get_login_time(presence))); |
| 13823 | 1343 | } else { |
| 1344 | if ((error == Tcl_GetIntFromObj(interp, | |
| 1345 | objv[3], | |
| 1346 | &login_time)) != TCL_OK) | |
| 1347 | return TCL_ERROR; | |
| 15884 | 1348 | purple_presence_set_login_time(presence, login_time); |
| 13823 | 1349 | } |
| 1350 | break; | |
| 1351 | case CMD_PRESENCE_ONLINE: | |
| 1352 | if (objc != 3) { | |
| 1353 | Tcl_WrongNumArgs(interp, 2, objv, "presence"); | |
| 1354 | return TCL_ERROR; | |
| 1355 | } | |
| 15884 | 1356 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1357 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1358 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1359 | Tcl_NewBooleanObj( |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1360 | purple_presence_is_online(presence))); |
| 13823 | 1361 | break; |
| 1362 | case CMD_PRESENCE_STATUS: | |
| 1363 | if (objc != 4) { | |
| 1364 | Tcl_WrongNumArgs(interp, 2, objv, "presence status_id"); | |
| 1365 | return TCL_ERROR; | |
| 1366 | } | |
| 15884 | 1367 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1368 | return TCL_ERROR; |
| 1369 | Tcl_SetObjResult(interp, | |
| 15884 | 1370 | purple_tcl_ref_new(PurpleTclRefStatus, |
| 1371 | purple_presence_get_status(presence, | |
| 13823 | 1372 | Tcl_GetString(objv[3])))); |
| 1373 | break; | |
| 1374 | case CMD_PRESENCE_STATUSES: | |
| 1375 | if (objc != 3) { | |
| 1376 | Tcl_WrongNumArgs(interp, 2, objv, "presence"); | |
| 1377 | return TCL_ERROR; | |
| 1378 | } | |
| 15884 | 1379 | if ((presence = purple_tcl_ref_get(interp, objv[2], PurpleTclRefPresence)) == NULL) |
| 13823 | 1380 | return TCL_ERROR; |
| 1381 | list = Tcl_NewListObj(0, NULL); | |
| 15884 | 1382 | for (cur = purple_presence_get_statuses(presence); cur != NULL; |
| 13823 | 1383 | cur = g_list_next(cur)) { |
| 15884 | 1384 | elem = purple_tcl_ref_new(PurpleTclRefStatus, cur->data); |
| 13823 | 1385 | Tcl_ListObjAppendElement(interp, list, elem); |
| 1386 | } | |
| 1387 | Tcl_SetObjResult(interp, list); | |
| 1388 | break; | |
| 1389 | } | |
| 1390 | ||
| 1391 | return TCL_OK; | |
| 1392 | } | |
| 1393 | ||
|
15758
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1394 | int tcl_cmd_savedstatus(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1395 | { |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1396 | Tcl_Obj *result; |
|
15758
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1397 | const char *cmds[] = { "current", "handle", NULL }; |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1398 | enum { CMD_SAVEDSTATUS_CURRENT, CMD_SAVEDSTATUS_HANDLE } cmd; |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1399 | int error; |
| 15884 | 1400 | PurpleSavedStatus *saved_status; |
|
15758
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1401 | |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1402 | if (objc < 2) { |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1403 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1404 | return TCL_ERROR; |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1405 | } |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1406 | |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1407 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1408 | return error; |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1409 | |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1410 | switch (cmd) { |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1411 | case CMD_SAVEDSTATUS_CURRENT: |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1412 | if (objc != 2) { |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1413 | Tcl_WrongNumArgs(interp, 2, objv, ""); |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1414 | return TCL_ERROR; |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1415 | } |
| 15884 | 1416 | if ((saved_status = purple_savedstatus_get_current()) == NULL) |
|
15758
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1417 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1418 | result = Tcl_NewListObj(0, NULL); |
| 15884 | 1419 | Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(purple_savedstatus_get_title(saved_status), -1)); |
| 1420 | Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(purple_savedstatus_get_type(saved_status))); | |
| 1421 | Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(purple_savedstatus_get_message(saved_status), -1)); | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1422 | Tcl_SetObjResult(interp,result); |
|
15758
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1423 | break; |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1424 | case CMD_SAVEDSTATUS_HANDLE: |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1425 | if (objc != 2) { |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1426 | Tcl_WrongNumArgs(interp, 2, objv, ""); |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1427 | return TCL_ERROR; |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1428 | } |
|
20393
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
1429 | Tcl_SetObjResult(interp, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
1430 | purple_tcl_ref_new(PurpleTclRefHandle, |
|
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
1431 | purple_savedstatuses_get_handle())); |
|
15758
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1432 | break; |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1433 | } |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1434 | |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1435 | return TCL_OK; |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1436 | } |
|
d31f3317c849
Tcl savedstatus command, again from Dossy Shiobara. Dossy is on fire.
Ethan Blanton <elb@pidgin.im>
parents:
15750
diff
changeset
|
1437 | |
| 6694 | 1438 | int tcl_cmd_send_im(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) |
| 1439 | { | |
| 15884 | 1440 | PurpleConnection *gc; |
| 6694 | 1441 | char *who, *text; |
| 1442 | ||
| 1443 | if (objc != 4) { | |
| 1444 | Tcl_WrongNumArgs(interp, 1, objv, "gc who text"); | |
| 1445 | return TCL_ERROR; | |
| 1446 | } | |
| 1447 | ||
| 13817 | 1448 | if ((gc = tcl_validate_gc(objv[1], interp)) == NULL) |
| 6694 | 1449 | return TCL_ERROR; |
| 1450 | ||
| 1451 | who = Tcl_GetString(objv[2]); | |
| 1452 | text = Tcl_GetString(objv[3]); | |
| 1453 | ||
|
6982
12f08de92674
[gaim-migrate @ 7538]
Mark Doliner <markdoliner@pidgin.im>
parents:
6864
diff
changeset
|
1454 | serv_send_im(gc, who, text, 0); |
| 6694 | 1455 | |
| 1456 | return TCL_OK; | |
| 1457 | } | |
| 1458 | ||
| 1459 | int tcl_cmd_signal(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) | |
| 1460 | { | |
|
10339
246feba79f04
[gaim-migrate @ 11548]
Mark Doliner <markdoliner@pidgin.im>
parents:
10246
diff
changeset
|
1461 | const char *cmds[] = { "connect", "disconnect", NULL }; |
| 6694 | 1462 | enum { CMD_SIGNAL_CONNECT, CMD_SIGNAL_DISCONNECT } cmd; |
| 1463 | struct tcl_signal_handler *handler; | |
| 1464 | void *instance; | |
| 10597 | 1465 | int error; |
| 6694 | 1466 | |
| 1467 | if (objc < 2) { | |
| 1468 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 1469 | return TCL_ERROR; | |
| 1470 | } | |
| 1471 | ||
| 1472 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 1473 | return error; | |
| 1474 | ||
| 1475 | switch (cmd) { | |
| 1476 | case CMD_SIGNAL_CONNECT: | |
| 1477 | if (objc != 6) { | |
| 1478 | Tcl_WrongNumArgs(interp, 2, objv, "instance signal args proc"); | |
| 1479 | return TCL_ERROR; | |
| 1480 | } | |
| 1481 | handler = g_new0(struct tcl_signal_handler, 1); | |
|
20393
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
1482 | if ((handler->instance = purple_tcl_ref_get(interp, objv[2],PurpleTclRefHandle)) == NULL) { |
| 6694 | 1483 | g_free(handler); |
| 1484 | return error; | |
| 1485 | } | |
| 10597 | 1486 | handler->signal = objv[3]; |
| 13812 | 1487 | Tcl_IncrRefCount(handler->signal); |
| 10597 | 1488 | handler->args = objv[4]; |
| 1489 | handler->proc = objv[5]; | |
| 6694 | 1490 | handler->interp = interp; |
| 1491 | if (!tcl_signal_connect(handler)) { | |
| 1492 | tcl_signal_handler_free(handler); | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1493 | Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); |
| 6694 | 1494 | } else { |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1495 | Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); |
| 6694 | 1496 | } |
| 1497 | break; | |
| 1498 | case CMD_SIGNAL_DISCONNECT: | |
| 1499 | if (objc != 4) { | |
| 13812 | 1500 | Tcl_WrongNumArgs(interp, 2, objv, "instance signal"); |
| 6694 | 1501 | return TCL_ERROR; |
| 1502 | } | |
|
20393
6280efb8c658
Another fabulous patch to our Tcl loader from venks on irc.freenode.net.
Ethan Blanton <elb@pidgin.im>
parents:
19859
diff
changeset
|
1503 | if ((instance = purple_tcl_ref_get(interp, objv[2],PurpleTclRefHandle)) == NULL) |
| 6694 | 1504 | return error; |
| 1505 | tcl_signal_disconnect(instance, Tcl_GetString(objv[3]), interp); | |
| 1506 | break; | |
| 1507 | } | |
| 1508 | ||
| 1509 | return TCL_OK; | |
| 1510 | } | |
| 1511 | ||
| 13812 | 1512 | int tcl_cmd_status(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) |
| 1513 | { | |
| 13828 | 1514 | const char *cmds[] = { "attr", "type", NULL }; |
| 13812 | 1515 | enum { CMD_STATUS_ATTR, CMD_STATUS_TYPE } cmd; |
| 15884 | 1516 | PurpleStatus *status; |
| 1517 | PurpleStatusType *status_type; | |
|
25913
3d5e1dfea10a
Fix compile errors from the merge. Untested protocols: msnp9, sametime,
Elliott Sales de Andrade <qulogic@pidgin.im>
parents:
24974
diff
changeset
|
1518 | int error; |
|
3d5e1dfea10a
Fix compile errors from the merge. Untested protocols: msnp9, sametime,
Elliott Sales de Andrade <qulogic@pidgin.im>
parents:
24974
diff
changeset
|
1519 | #if !(defined PURPLE_DISABLE_DEPRECATED) |
| 15884 | 1520 | PurpleValue *value; |
| 13826 | 1521 | const char *attr; |
|
25913
3d5e1dfea10a
Fix compile errors from the merge. Untested protocols: msnp9, sametime,
Elliott Sales de Andrade <qulogic@pidgin.im>
parents:
24974
diff
changeset
|
1522 | int v; |
|
3d5e1dfea10a
Fix compile errors from the merge. Untested protocols: msnp9, sametime,
Elliott Sales de Andrade <qulogic@pidgin.im>
parents:
24974
diff
changeset
|
1523 | #endif |
| 13812 | 1524 | |
| 1525 | if (objc < 2) { | |
| 1526 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 1527 | return TCL_ERROR; | |
| 1528 | } | |
| 1529 | ||
| 1530 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 1531 | return error; | |
| 1532 | ||
| 1533 | switch (cmd) { | |
| 1534 | case CMD_STATUS_ATTR: | |
|
25913
3d5e1dfea10a
Fix compile errors from the merge. Untested protocols: msnp9, sametime,
Elliott Sales de Andrade <qulogic@pidgin.im>
parents:
24974
diff
changeset
|
1535 | #if !(defined PURPLE_DISABLE_DEPRECATED) |
| 13826 | 1536 | if (objc != 4 && objc != 5) { |
| 1537 | Tcl_WrongNumArgs(interp, 2, objv, "status attr_id ?value?"); | |
| 13812 | 1538 | return TCL_ERROR; |
| 1539 | } | |
| 15884 | 1540 | if ((status = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatus)) == NULL) |
| 13812 | 1541 | return TCL_ERROR; |
| 13826 | 1542 | attr = Tcl_GetString(objv[3]); |
| 15884 | 1543 | value = purple_status_get_attr_value(status, attr); |
| 13812 | 1544 | if (value == NULL) { |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1545 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1546 | Tcl_NewStringObj("no such attribute", -1)); |
| 13812 | 1547 | return TCL_ERROR; |
| 1548 | } | |
| 15884 | 1549 | switch (purple_value_get_type(value)) { |
| 1550 | case PURPLE_TYPE_BOOLEAN: | |
| 13826 | 1551 | if (objc == 4) { |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1552 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1553 | Tcl_NewBooleanObj(purple_value_get_boolean(value))); |
| 13826 | 1554 | } else { |
| 1555 | if ((error = Tcl_GetBooleanFromObj(interp, objv[4], &v)) != TCL_OK) | |
| 1556 | return error; | |
| 15884 | 1557 | purple_status_set_attr_boolean(status, attr, v); |
| 13826 | 1558 | } |
| 13812 | 1559 | break; |
| 15884 | 1560 | case PURPLE_TYPE_INT: |
| 13826 | 1561 | if (objc == 4) { |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1562 | Tcl_SetObjResult(interp, Tcl_NewIntObj(purple_value_get_int(value))); |
| 13826 | 1563 | } else { |
| 1564 | if ((error = Tcl_GetIntFromObj(interp, objv[4], &v)) != TCL_OK) | |
| 1565 | return error; | |
| 15884 | 1566 | purple_status_set_attr_int(status, attr, v ); |
| 13826 | 1567 | } |
| 13812 | 1568 | break; |
| 15884 | 1569 | case PURPLE_TYPE_STRING: |
| 13826 | 1570 | if (objc == 4) |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1571 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1572 | Tcl_NewStringObj(purple_value_get_string(value), -1)); |
| 13826 | 1573 | else |
| 15884 | 1574 | purple_status_set_attr_string(status, attr, Tcl_GetString(objv[4])); |
| 13812 | 1575 | break; |
| 1576 | default: | |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1577 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1578 | Tcl_NewStringObj("attribute has unknown type", -1)); |
| 13812 | 1579 | return TCL_ERROR; |
| 1580 | } | |
|
25913
3d5e1dfea10a
Fix compile errors from the merge. Untested protocols: msnp9, sametime,
Elliott Sales de Andrade <qulogic@pidgin.im>
parents:
24974
diff
changeset
|
1581 | #endif |
| 13812 | 1582 | break; |
| 1583 | case CMD_STATUS_TYPE: | |
| 1584 | if (objc != 3) { | |
| 1585 | Tcl_WrongNumArgs(interp, 2, objv, "status"); | |
| 1586 | return TCL_ERROR; | |
| 1587 | } | |
| 15884 | 1588 | if ((status = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatus)) == NULL) |
| 13812 | 1589 | return TCL_ERROR; |
| 15884 | 1590 | status_type = purple_status_get_type(status); |
| 1591 | Tcl_SetObjResult(interp, purple_tcl_ref_new(PurpleTclRefStatusType, | |
| 13812 | 1592 | status_type)); |
| 1593 | break; | |
| 1594 | } | |
| 1595 | ||
| 1596 | return TCL_OK; | |
| 1597 | } | |
| 1598 | ||
| 1599 | int tcl_cmd_status_attr(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) | |
| 1600 | { | |
| 1601 | const char *cmds[] = { "id", "name", NULL }; | |
| 1602 | enum { CMD_STATUS_ATTR_ID, CMD_STATUS_ATTR_NAME } cmd; | |
| 15884 | 1603 | PurpleStatusAttr *attr; |
| 13812 | 1604 | int error; |
| 1605 | ||
| 1606 | if (objc < 2) { | |
| 1607 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 1608 | return TCL_ERROR; | |
| 1609 | } | |
| 1610 | ||
| 1611 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 1612 | return error; | |
| 1613 | ||
| 1614 | switch (cmd) { | |
| 1615 | case CMD_STATUS_ATTR_ID: | |
| 1616 | if (objc != 3) { | |
| 1617 | Tcl_WrongNumArgs(interp, 2, objv, "attr"); | |
| 1618 | return TCL_ERROR; | |
| 1619 | } | |
| 15884 | 1620 | if ((attr = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusAttr)) == NULL) |
| 13812 | 1621 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1622 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1623 | Tcl_NewStringObj(purple_status_attr_get_id(attr), -1)); |
| 13812 | 1624 | break; |
| 1625 | case CMD_STATUS_ATTR_NAME: | |
| 1626 | if (objc != 3) { | |
| 1627 | Tcl_WrongNumArgs(interp, 2, objv, "attr"); | |
| 1628 | return TCL_ERROR; | |
| 1629 | } | |
| 15884 | 1630 | if ((attr = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusAttr)) == NULL) |
| 13812 | 1631 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1632 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1633 | Tcl_NewStringObj(purple_status_attr_get_name(attr), -1)); |
| 13812 | 1634 | break; |
| 1635 | } | |
| 1636 | ||
| 1637 | return TCL_OK; | |
| 1638 | } | |
| 1639 | ||
| 1640 | int tcl_cmd_status_type(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) | |
| 1641 | { | |
| 1642 | const char *cmds[] = { "attr", "attrs", "available", "exclusive", "id", | |
| 1643 | "independent", "name", "primary_attr", | |
| 1644 | "primitive", "saveable", "user_settable", | |
| 1645 | NULL }; | |
| 1646 | enum { CMD_STATUS_TYPE_ATTR, CMD_STATUS_TYPE_ATTRS, | |
| 1647 | CMD_STATUS_TYPE_AVAILABLE, CMD_STATUS_TYPE_EXCLUSIVE, | |
| 1648 | CMD_STATUS_TYPE_ID, CMD_STATUS_TYPE_INDEPENDENT, | |
| 1649 | CMD_STATUS_TYPE_NAME, CMD_STATUS_TYPE_PRIMARY_ATTR, | |
| 1650 | CMD_STATUS_TYPE_PRIMITIVE, CMD_STATUS_TYPE_SAVEABLE, | |
| 1651 | CMD_STATUS_TYPE_USER_SETTABLE } cmd; | |
| 15884 | 1652 | PurpleStatusType *status_type; |
| 13812 | 1653 | Tcl_Obj *list, *elem; |
|
18190
bcf28ef7e8ff
Re-fix the DBus list handling code by killing const GList* / const GSList*
Richard Laager <rlaager@pidgin.im>
parents:
18122
diff
changeset
|
1654 | GList *cur; |
| 13812 | 1655 | int error; |
| 1656 | ||
| 1657 | if (objc < 2) { | |
| 1658 | Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); | |
| 1659 | return TCL_ERROR; | |
| 1660 | } | |
| 1661 | ||
| 1662 | if ((error = Tcl_GetIndexFromObj(interp, objv[1], cmds, "subcommand", 0, (int *)&cmd)) != TCL_OK) | |
| 1663 | return error; | |
| 1664 | ||
| 1665 | switch (cmd) { | |
| 1666 | case CMD_STATUS_TYPE_AVAILABLE: | |
| 1667 | if (objc != 3) { | |
| 1668 | Tcl_WrongNumArgs(interp, 2, objv, "statustype"); | |
| 1669 | return TCL_ERROR; | |
| 1670 | } | |
| 15884 | 1671 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1672 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1673 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1674 | Tcl_NewBooleanObj(purple_status_type_is_available(status_type))); |
| 13812 | 1675 | break; |
| 1676 | case CMD_STATUS_TYPE_ATTR: | |
| 1677 | if (objc != 4) { | |
| 1678 | Tcl_WrongNumArgs(interp, 2, objv, "statustype attr"); | |
| 1679 | return TCL_ERROR; | |
| 1680 | } | |
| 15884 | 1681 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1682 | return TCL_ERROR; |
| 1683 | Tcl_SetObjResult(interp, | |
| 15884 | 1684 | purple_tcl_ref_new(PurpleTclRefStatusAttr, |
| 1685 | purple_status_type_get_attr(status_type, | |
| 13812 | 1686 | Tcl_GetStringFromObj(objv[3], NULL)))); |
| 1687 | break; | |
| 1688 | case CMD_STATUS_TYPE_ATTRS: | |
| 1689 | if (objc != 3) { | |
| 1690 | Tcl_WrongNumArgs(interp, 2, objv, "statustype"); | |
| 1691 | return TCL_ERROR; | |
| 1692 | } | |
| 15884 | 1693 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1694 | return TCL_ERROR; |
| 1695 | list = Tcl_NewListObj(0, NULL); | |
| 15884 | 1696 | for (cur = purple_status_type_get_attrs(status_type); |
| 13812 | 1697 | cur != NULL; cur = g_list_next(cur)) { |
| 15884 | 1698 | elem = purple_tcl_ref_new(PurpleTclRefStatusAttr, cur->data); |
| 13812 | 1699 | Tcl_ListObjAppendElement(interp, list, elem); |
| 1700 | } | |
| 1701 | Tcl_SetObjResult(interp, list); | |
| 1702 | break; | |
| 1703 | case CMD_STATUS_TYPE_EXCLUSIVE: | |
| 1704 | if (objc != 3) { | |
| 1705 | Tcl_WrongNumArgs(interp, 2, objv, "statustype"); | |
| 1706 | return TCL_ERROR; | |
| 1707 | } | |
| 15884 | 1708 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1709 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1710 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1711 | Tcl_NewBooleanObj(purple_status_type_is_exclusive(status_type))); |
| 13812 | 1712 | break; |
| 1713 | case CMD_STATUS_TYPE_ID: | |
| 1714 | if (objc != 3) { | |
| 1715 | Tcl_WrongNumArgs(interp, 2, objv, "statustype"); | |
| 1716 | return TCL_ERROR; | |
| 1717 | } | |
| 15884 | 1718 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1719 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1720 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1721 | Tcl_NewStringObj(purple_status_type_get_id(status_type), -1)); |
| 13812 | 1722 | break; |
| 1723 | case CMD_STATUS_TYPE_INDEPENDENT: | |
| 1724 | if (objc != 3) { | |
| 1725 | Tcl_WrongNumArgs(interp, 2, objv, "statustype"); | |
| 1726 | return TCL_ERROR; | |
| 1727 | } | |
| 15884 | 1728 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1729 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1730 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1731 | Tcl_NewBooleanObj(purple_status_type_is_independent(status_type))); |
| 13812 | 1732 | break; |
| 1733 | case CMD_STATUS_TYPE_NAME: | |
| 1734 | if (objc != 3) { | |
| 1735 | Tcl_WrongNumArgs(interp, 2, objv, "statustype"); | |
| 1736 | return TCL_ERROR; | |
| 1737 | } | |
| 15884 | 1738 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1739 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1740 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1741 | Tcl_NewStringObj(purple_status_type_get_name(status_type), -1)); |
| 13812 | 1742 | break; |
| 1743 | case CMD_STATUS_TYPE_PRIMITIVE: | |
| 1744 | if (objc != 3) { | |
| 1745 | Tcl_WrongNumArgs(interp, 2, objv, "statustype"); | |
| 1746 | return TCL_ERROR; | |
| 1747 | } | |
| 15884 | 1748 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1749 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1750 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1751 | Tcl_NewStringObj(purple_primitive_get_id_from_type |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1752 | (purple_status_type_get_primitive(status_type)), -1)); |
| 13812 | 1753 | break; |
| 1754 | case CMD_STATUS_TYPE_PRIMARY_ATTR: | |
|
25913
3d5e1dfea10a
Fix compile errors from the merge. Untested protocols: msnp9, sametime,
Elliott Sales de Andrade <qulogic@pidgin.im>
parents:
24974
diff
changeset
|
1755 | #if !(defined PURPLE_DISABLE_DEPRECATED) |
| 13812 | 1756 | if (objc != 3) { |
| 1757 | Tcl_WrongNumArgs(interp, 2, objv, "statustype"); | |
| 1758 | return TCL_ERROR; | |
| 1759 | } | |
| 15884 | 1760 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1761 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1762 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1763 | Tcl_NewStringObj(purple_status_type_get_primary_attr(status_type), -1)); |
|
25913
3d5e1dfea10a
Fix compile errors from the merge. Untested protocols: msnp9, sametime,
Elliott Sales de Andrade <qulogic@pidgin.im>
parents:
24974
diff
changeset
|
1764 | #endif |
| 13812 | 1765 | break; |
| 1766 | case CMD_STATUS_TYPE_SAVEABLE: | |
| 1767 | if (objc != 3) { | |
| 1768 | Tcl_WrongNumArgs(interp, 2, objv, "statustype"); | |
| 1769 | return TCL_ERROR; | |
| 1770 | } | |
| 15884 | 1771 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1772 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1773 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1774 | Tcl_NewBooleanObj( |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1775 | purple_status_type_is_saveable(status_type))); |
| 13812 | 1776 | break; |
| 1777 | case CMD_STATUS_TYPE_USER_SETTABLE: | |
| 1778 | if (objc != 3) { | |
| 1779 | Tcl_WrongNumArgs(interp, 2, objv, "statustype"); | |
| 1780 | return TCL_ERROR; | |
| 1781 | } | |
| 15884 | 1782 | if ((status_type = purple_tcl_ref_get(interp, objv[2], PurpleTclRefStatusType)) == NULL) |
| 13812 | 1783 | return TCL_ERROR; |
|
20394
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1784 | Tcl_SetObjResult(interp, |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1785 | Tcl_NewBooleanObj( |
|
4088fda4a8e7
The second in a series of Tcl-fixing patches from venks on
Ethan Blanton <elb@pidgin.im>
parents:
20393
diff
changeset
|
1786 | purple_status_type_is_user_settable(status_type))); |
| 13812 | 1787 | break; |
| 1788 | } | |
| 1789 | ||
| 1790 | return TCL_OK; | |
| 1791 | } | |
| 1792 | ||
| 6694 | 1793 | static gboolean unload_self(gpointer data) |
| 1794 | { | |
| 15884 | 1795 | PurplePlugin *plugin = data; |
| 1796 | purple_plugin_unload(plugin); | |
| 6694 | 1797 | return FALSE; |
| 1798 | } | |
| 1799 | ||
| 1800 | int tcl_cmd_unload(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) | |
| 1801 | { | |
| 15884 | 1802 | PurplePlugin *plugin; |
| 6694 | 1803 | if (objc != 1) { |
| 1804 | Tcl_WrongNumArgs(interp, 1, objv, ""); | |
| 1805 | return TCL_ERROR; | |
| 1806 | } | |
| 1807 | ||
| 1808 | if ((plugin = tcl_interp_get_plugin(interp)) == NULL) { | |
| 1809 | /* This isn't exactly OK, but heh. What do you do? */ | |
| 1810 | return TCL_OK; | |
| 1811 | } | |
| 1812 | /* We can't unload immediately, but we can unload at the first | |
| 1813 | * known safe opportunity. */ | |
|
22353
daef90676a8f
One more g_idle_add call
Mark Doliner <markdoliner@pidgin.im>
parents:
22240
diff
changeset
|
1814 | purple_timeout_add(0, unload_self, (gpointer)plugin); |
| 6694 | 1815 | |
| 1816 | return TCL_OK; | |
| 1817 | } |