//
// tcl++.cc
//
//---------------------------------------------------------------------------
// Copyright 1991 Karl Lehenbauer and Mark Diekhans.
//
// Permission to use, copy, modify, and distribute this software and its
// documentation for any purpose and without fee is hereby granted, provided
// that the above copyright notice appear in all copies.  Karl Lehenbauer and
// Mark Diekhans make no representations about the suitability of this
// software for any purpose.  It is provided "as is" without express or
// implied warranty.
//---------------------------------------------------------------------------
// Based on Tcl C++ classes developed by Parag Patel.
//
// Modified by Open Systems Solutions, Inc.
// Copyright 1992 Open Systems Solutions, Inc.
//

#include "tcl++.hpp"
#include "patchlevel.h"

//
// 
TclInterp_cl::TclInterp_cl ()
{
    interp = Tcl_CreateExtendedInterp ();
    /*
     * Set values to return from the infox command.
     */
    tclxVersion = ckalloc (strlen (TCL_VERSION) + 
                           strlen (TCL_EXTD_VERSION_SUFFIX) + 1);
    strcpy (tclxVersion, TCL_VERSION);
    strcat (tclxVersion, TCL_EXTD_VERSION_SUFFIX);
    tclxPatchlevel = PATCHLEVEL;
}

TclInterp_cl::~TclInterp_cl ()
{ 
    Tcl_DeleteInterp (interp);
}

char *
TclInterp_cl::CatVarArgs (va_list argPtr)
{
    int      len = 0;
    char    *parmPtr, *ptr;
    va_list  nextArgPtr = argPtr;

    while (1) {
        parmPtr = va_arg (nextArgPtr, char *);
        if (parmPtr == NULL)
            break;
        len += strlen (parmPtr);
    }
    ptr = ckalloc (len + 1);
    ptr [0] = '\0';
    nextArgPtr = argPtr;
    while (1) {
        parmPtr = va_arg (nextArgPtr, char *);
        if (parmPtr == NULL)
            break;
        strcat (ptr, parmPtr);
    }
    return ptr;
}        

/*
 *----------------------------------------------------------------------
 *
 * TclInterp_cl::AppendResult --
 *
 *    Class interface to Tcl_AppendResult (see Tcl documentation for
 * details).  Not inlined since varargs and inline don't work on some C++
 * compilers.
 *----------------------------------------------------------------------
 */
void
TclInterp_cl::AppendResult (const char *p, ...)
{
    va_list  argPtr;
    char    *strPtr;

    va_start (argPtr, p);
    strPtr = CatVarArgs (argPtr);
    Tcl_AppendResult (interp, p, strPtr, (char *) NULL);
    ckfree (strPtr)
    va_end (argPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInterp_cl::SetErrorCode --
 *
 *    Class interface to Tcl_SetErrorCode (see Tcl documentation for
 * details).  Not inlined since varargs and inline don't work on some C++
 * compilers.
 *----------------------------------------------------------------------
 */
void
TclInterp_cl::SetErrorCode (char *p, ...)
{
    va_list  argPtr;
    char    *strPtr;

    va_start (argPtr, p);
    strPtr = CatVarArgs (argPtr);
    Tcl_SetErrorCode (interp, p, strPtr, (char *) NULL);
    ckfree (strPtr)
    va_end (argPtr);
}
/*
 *----------------------------------------------------------------------
 *
 * TclInterp_cl::VarEval --
 *
 *    Class interface to Tcl_VarEval (see Tcl documentation for details).
 *  Not inlined since varargs and inline don't work on some C++ compilers.
 *----------------------------------------------------------------------
 */
int
TclInterp_cl::VarEval (const char *p, ...)
{
    int      intResult;
    va_list  argPtr;
    char    *strPtr;

    va_start (argPtr, p);
    strPtr = CatVarArgs (argPtr);
    intResult = Tcl_VarEval (interp, (char *) p, strPtr, (char *) NULL);
    ckfree (strPtr);
    va_end (argPtr);
    return intResult;
}
//
//
TclTrace_cl::TclTrace_cl(TclInterp_cl     &interpCl, 
			 int               level, 
			 Tcl_CmdTraceProc *proc, 
			 ClientData        data):
interp(interpCl)
{
    trace = Tcl_CreateTrace (interp.GetInterp(), level, proc, data);
}

//
//
TclHandleTbl_cl::TclHandleTbl_cl(const char *handleBase, int entrySize,
				 int initEntries)
{
        headerPtr = Tcl_HandleTblInit (handleBase, entrySize, initEntries);
}