/*
 * lisp debug version 0.8 a source level debugger for lisp
 * Copyright (C) 1998 Marc Mertens
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 * 
 * You can reach me at : mmertens@akam.be
 */


#include <varargs.h>
#include <tcl.h>
/*
* Tcl_Invoke --
* Call this somewhat like Tcl_VarEval:
* Tcl_Invoke(interp, cmdName, arg1, arg2, ..., NULL);
* Each arg becomes one argument to the command,
* with no substitutions or parsing.
*/
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 */
	Tcl_Obj **objv;						/* Object vector for arguments */
	Tcl_Obj *resultPtr;						/* The result object */
	int argc, i, max;						/* Count of arguments */
	Tcl_CmdInfo info;						/* Info about command procedures */
	va_list pvar;						/* varargs stuff */
	int result;						/* TCL_OK or TCL_ERROR */
	int object;

	va_start(pvar);
	interp = va_arg(pvar, Tcl_Interp *);
	cmd = va_arg(pvar, char *);
	/*
	 * Map from the command name to a C procedure.
	 */
	if (! Tcl_GetCommandInfo(interp, cmd, &info)) {
		Tcl_AppendResult(interp, "Unknown command \"",
			cmd, "\"", NULL);
		va_end(pvar);
		return TCL_ERROR;
	}
	max = 10;
	argc = 1;
	object = info.isNativeObjectProc;
	if (object) {
		/*
		 * The object interface is preferred for this command.
		 */
		objv = (Tcl_Obj **)Tcl_Alloc(max * sizeof(Tcl_Obj *));
		objv[0] = Tcl_NewStringObj(cmd, strlen(cmd));
		Tcl_ResetResult(interp);
	} else {
		argv = (char **)Tcl_Alloc(max * sizeof(char *));
		argv[0] = cmd;
		Tcl_ResetResult(interp);
	}
	/*
	 * Build a vector out of the rest of the arguments.
	 */
	while (1) {
		arg = va_arg(pvar, char *);
		if (object) {
			if (arg == (char *)NULL) {
				objv[argc] = (Tcl_Obj *)NULL;
			} else {
				objv[argc] = Tcl_NewStringObj(arg, strlen(arg));
				/* Ref count is one */
			}
		} else {
			argv[argc] = arg;
		}
		if (arg == (char *)NULL) {
			break;
		}
		argc++;
		if (argc >= max) {
			/*
			 * Allocate a bigger vector and copy old values in.
			 */
			if (object) {
				Tcl_Obj **old = objv;
				objv = (Tcl_Obj **)Tcl_Alloc(2*max * 
							sizeof(Tcl_Obj *));
				for (i=0 ; i<max ; i++) {
					objv[i] = old[i];
				}
				free((char *)old);
			} else {
				char **old = argv;
				argv = (char **)Tcl_Alloc(2*max * sizeof(char *));
				for (i=0 ; i<max ; i++) {
					argv[i] = old[i];
				}
				free((char *)old);
			}
			max = 2*max;
		}
	}
	va_end(pvar);
	/*
	 * Invoke the C procedure.
	 */
	if (object) {
		int dummy;
		result = (*info.objProc)(info.objClientData, interp,
				argc, objv);
		/*
		 * Get the string value from the result object.
		 */
		resultPtr = Tcl_GetObjResult(interp);
		Tcl_SetResult(interp, Tcl_GetStringFromObj(resultPtr, &dummy),
			TCL_VOLATILE);
	} else {
		result = (*info.proc)(info.clientData, interp,
				argc, argv);
	}
	/*
	 * Release our references to the arguments. 
	 */
	if (object) {
		for (i=0 ; i<argc ; i++) {
			Tcl_DecrRefCount(objv[i]);
		}
		Tcl_Free((char *)objv);
	} else {
		Tcl_Free((char *)argv);
	}
	return result;
}



