#include <varargs.h>
#include <tcl.h>

/*----------------------------------------------------------------------
 *
 * Tcl_Invoke -- Directly invoke a Tcl command or procedure
 *
 *	Call Tcl_Invoke somewhat like Tcl_VarEval:
 *
 *	result = Tcl_Invoke(interp, cmdName, arg1, arg2, ..., NULL);
 *
 *	Each arg becomes one argument to the command, with no further
 *	substitutions or parsing.
 *
 *	Based on Example 41-9 from the book "Practical Programming in
 *	Tcl and Tk" by Brent B. Welch, Second Edition, 1997, Prentice
 *	Hall.  The original code has been rearranged to be better
 *	readable, to call ckalloc/free instead of Tcl_Alloc/Free, to
 *	use an initial stack based argument string vector and to allow
 *	usage in Tcl versions prior to 8.0.
 *
 * Result:
 *	The code returned by the invoked command, either TCL_OK or
 *	TCL_ERROR.  The result of the invoked command is returned in
 *	interp->result.  If the command cmdName does not exist,
 *	TCL_ERROR is returned with string "unknown command "cmdName""
 *	left in interp->result.
 *	Use one of the procedures Tcl_GetObjResult() or Tcl_GetStringResult()
 *	to read the result.
 *
 * Side Effects:
 *	Like Tcl_VarArg.  The value of the arguments may be overwritten
 *	by the invoked command.
 *
 *----------------------------------------------------------------------
 */

PUBLIC int
Tcl_Invoke(va_alist)
	va_dcl			/* Variable number of arguments */
{
	Tcl_Interp *interp;
	char *cmd;		/* Command name */
	char *arg;		/* Command argument */
	char **argv;		/* String vector for arguments */
	int argc, i, max;	/* Number of arguments */
	Tcl_CmdInfo info;	/* Info about command procedures */
	va_list pvar;		/* varargs stuff */
	int result;		/* TCL_OK or TCL_ERROR */
#define NUM_ARGS 20		/* Initial argument vector length */
	char *(argv_arr[NUM_ARGS]);/* Initial argument vector */

	va_start(pvar);
	interp = va_arg(pvar, Tcl_Interp *);

	/*
	 * Map from the command name to a C procedure
	 */
	cmd = va_arg(pvar, char *);
	if (! Tcl_GetCommandInfo(interp, cmd, &info)) {
		Tcl_AppendResult(interp, "unknown command \"", cmd, "\"", NULL);
		va_end(pvar);
		return TCL_ERROR;
	}

	Tcl_ResetResult(interp);
	max = NUM_ARGS;

#if TCL_MAJOR_VERSION > 7
	/*
	 * Check whether the object interface is preferred for this command
	 */
	if (info.isNativeObjectProc) {
		Tcl_Obj **objv;		/* Object vector for arguments */
		Tcl_Obj *resultPtr;	/* The result object */
		int objc;

		objv = (Tcl_Obj **) ckalloc(max * sizeof(Tcl_Obj *));
		objv[0] = Tcl_NewStringObj(cmd, strlen(cmd));
		Tcl_IncrRefCount(objv[0]); /* ref count is one now */
		objc = 1;

		/*
		 * Build a vector out of the rest of the arguments
		 */
		while (1) {
			arg = va_arg(pvar, char *);
			if (arg == (char *)NULL) {
				objv[objc] = (Tcl_Obj *)NULL;
				break;
			}
			objv[objc] = Tcl_NewStringObj(arg, strlen(arg));
			Tcl_IncrRefCount(objv[objc]);
			objc++;
			if (objc >= max) {
				/* allocate a bigger vector and copy old one */
				Tcl_Obj **oldv = objv;
				max *= 2;
				objv = (Tcl_Obj **) ckalloc(max * sizeof(Tcl_Obj *));
				for (i = 0 ; i < objc ; i++) {
					objv[i] = oldv[i];
				}
				ckfree((char *)oldv);
			}
		}
		va_end(pvar);

		/*
		 * Invoke the C procedure
		 */
		result = (*info.objproc)(info.objClientData, interp, objc, objv);

		/*
		 * Make sure the string value of the result is valid
		 * and release our references to the arguments
		 */
		(void) Tcl_GetStringResult(interp);
		for (i = 0 ; i < objc ; i++) {
			Tcl_DecrRefCount(objv[i]);
		}
		ckfree((char *)objv);

		return result;
	}
#endif
	argv = argv_arr;
	argv[0] = cmd;
	argc = 1;

	/*
	 * Build a vector out of the rest of the arguments
	 */
	while (1) {
		arg = va_arg(pvar, char *);
		argv[argc] = arg;
		if (arg == (char *)NULL) {
			break;
		}
		argc++;
		if (argc >= max) {
			/* allocate a bigger vector and copy old one */
			char **oldv = argv;
			max *= 2;
			argv = (char **) ckalloc(max * sizeof(char *));
			for (i = 0 ; i < argc ; i++) {
				argv[i] = oldv[i];
			}
			if (oldv != argv_arr) {
				ckfree((char *) oldv);
			}
		}
	}
	va_end(pvar);

	/*
	 * Invoke the C procedure
	 */
	result = (*info.proc)(info.clientData, interp, argc, argv);

	/*
	 * Release the arguments iff allocated dynamically
	 */
	if (argv != argv_arr) {
		ckfree((char *) argv);
	}
	return result;

#undef NUM_ARGS
}