changeset 19563:3715a9411806

Patch from Dossy Shiobara which improves Tcl support for purple commands, by adding purple::cmd {do,help,list}. Fixes: #2873

--- a/libpurple/plugins/tcl/tcl_cmds.c	Sat Sep 01 02:36:51 2007 +0000
+++ b/libpurple/plugins/tcl/tcl_cmds.c	Sat Sep 01 02:37:52 2007 +0000
@@ -544,12 +544,16 @@
 
 int tcl_cmd_cmd(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
 {
-	const char *cmds[] = { "register", "unregister", NULL };
-	enum { CMD_CMD_REGISTER, CMD_CMD_UNREGISTER } cmd;
+	const char *cmds[] = { "do", "help", "list", "register", "unregister", NULL };
+	enum { CMD_CMD_DO, CMD_CMD_HELP, CMD_CMD_LIST, CMD_CMD_REGISTER, CMD_CMD_UNREGISTER } cmd;
 	struct tcl_cmd_handler *handler;
-	Tcl_Obj *result = Tcl_GetObjResult(interp);
+	Tcl_Obj *list, *elem, *result = Tcl_GetObjResult(interp);
+	PurpleConversation *convo;
 	PurpleCmdId id;
+	PurpleCmdStatus status;
 	int error;
+	GList *l, *cur;
+	gchar *escaped, *errstr = NULL;
 
 	if (objc < 2) {
 		Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
@@ -560,6 +564,57 @@
 		return error;
 
 	switch (cmd) {
+	case CMD_CMD_DO:
+		if (objc != 4) {
+			Tcl_WrongNumArgs(interp, 2, objv, "conversation command");
+			return TCL_ERROR;
+		}
+		if ((convo = tcl_validate_conversation(objv[2], interp)) == NULL)
+			return TCL_ERROR;
+		escaped = g_markup_escape_text(Tcl_GetString(objv[3]), -1);
+		status = purple_cmd_do_command(convo, Tcl_GetString(objv[3]),
+				escaped, &errstr);
+		g_free(escaped);
+		Tcl_SetStringObj(result, errstr ? (char *)errstr : "", -1);
+		g_free(errstr);
+		if (status != PURPLE_CMD_STATUS_OK) {
+			return TCL_ERROR;
+		}
+		break;
+	case CMD_CMD_HELP:
+		if (objc != 4) {
+			Tcl_WrongNumArgs(interp, 2, objv, "conversation name");
+			return TCL_ERROR;
+		}
+		if ((convo = tcl_validate_conversation(objv[2], interp)) == NULL)
+			return TCL_ERROR;
+		l = cur = purple_cmd_help(convo, Tcl_GetString(objv[3]));
+		list = Tcl_NewListObj(0, NULL);
+		while (cur != NULL) {
+			elem = Tcl_NewStringObj((char *)cur->data, -1);
+			Tcl_ListObjAppendElement(interp, list, elem);
+			cur = g_list_next(cur);
+		}
+		g_list_free(l);
+		Tcl_SetObjResult(interp, list);
+		break;
+	case CMD_CMD_LIST:
+		if (objc != 3) {
+			Tcl_WrongNumArgs(interp, 2, objv, "conversation");
+			return TCL_ERROR;
+		}
+		if ((convo = tcl_validate_conversation(objv[2], interp)) == NULL)
+			return TCL_ERROR;
+		l = cur = purple_cmd_list(convo);
+		list = Tcl_NewListObj(0, NULL);
+		while (cur != NULL) {
+			elem = Tcl_NewStringObj((char *)cur->data, -1);
+			Tcl_ListObjAppendElement(interp, list, elem);
+			cur = g_list_next(cur);
+		}
+		g_list_free(l);
+		Tcl_SetObjResult(interp, list);
+		break;
 	case CMD_CMD_REGISTER:
 		if (objc != 9) {
 			Tcl_WrongNumArgs(interp, 2, objv, "cmd arglist priority flags prpl_id proc helpstr");