Tcl Source Code

/* #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;
}