Attachment "lreverse.c" to
ticket [1545151fff]
added by
fridolin
2006-08-23 16:25:25.
/* #define USE_TCL_STUBS */
#include <tcl.h>
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
/*
*----------------------------------------------------------------
*
* Tcl_ListObjReverse
*
* This function reverses a list referenced by listPtr.
*
*/
int
Tcl_ListObjReverse(Tcl_Interp * interp, /* Used for error reportinh if not NULL. */
Tcl_Obj * listPtr, /* List object to reverse */
Tcl_Obj ** resultPtr)
{
int elemCount;
Tcl_Obj **elemPtrs, **resObjv;
int result, i;
result = Tcl_ListObjGetElements( interp , listPtr, &elemCount, &elemPtrs);
if( result != TCL_OK )
return result;
resObjv = (Tcl_Obj**) ckalloc( sizeof(Tcl_Obj*) * elemCount );
for( i = 0; i < elemCount; i++ ) {
resObjv[i] = elemPtrs[elemCount-1-i];
Tcl_IncrRefCount(resObjv[i]);
}
*resultPtr = Tcl_NewListObj( elemCount, resObjv );
ckfree( (void*) resObjv );
return TCL_OK;
}
/*
*/
int
Tcl_LreverseObjCmd(ClientData dummy, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])
{
Tcl_Obj * listPtr, *resultList;
int result;
if( objc != 2 ) {
Tcl_WrongNumArgs(interp, 1, objv, "lreverse");
return TCL_ERROR;
}
listPtr = objv[1];
result = Tcl_ListObjReverse(interp, listPtr, &resultList);
if( result != TCL_OK ) {
return result;
}
Tcl_SetObjResult(interp, resultList);
return TCL_OK;
}
int Lreverse_Init(Tcl_Interp* interp)
{
#if defined(USE_TCL_STUBS)
if( Tcl_InitStubs( interp, TCL_VERSION, 0 ) == NULL )
return TCL_ERROR;
#endif
Tcl_CreateObjCommand(interp, "lreverse", Tcl_LreverseObjCmd, NULL, NULL);
return TCL_OK;
}