/*
 * mkTables 1.0
 * ------------
 *
 * Please see the web pages for releases and documentation.
 *
 * Author: Michael Kraus 
 *         mailto:mmg_kraus@csi.com
 *         http://ourworld.compuserve.com/homepages/mmg_kraus
 * 
 * Permission to use, copy, modify, and distribute this software and its
 * documentation for any purpose and without fee is hereby granted.
 * The author makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without express
 * or implied warranty.  By use of this software the user agrees to
 * indemnify and hold harmless the author from any claims or
 * liability for loss arising out of such use.
 *
 */

/* required to built a dll using stubs. should be a compiler option */
/* #define USE_TCL_STUBS */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <limits.h>
#include <tcl.h> 

#ifndef TRUE
#  define TRUE  1
#  define FALSE 0
#endif

/* copied from sun's example.c */
#ifdef __WIN32__
#if defined(__WIN32__)
#   define WIN32_LEAN_AND_MEAN
#   include <windows.h>
#   undef WIN32_LEAN_AND_MEAN
#   if defined(_MSC_VER)
#       define EXPORT(a,b) __declspec(dllexport) a b
#       define DllEntryPoint DllMain
#   else
#       if defined(__BORLANDC__)
#           define EXPORT(a,b) a _export b
#       else
#           define EXPORT(a,b) a b
#       endif
#   endif
#else
#   define EXPORT(a,b) a b
#endif

EXTERN EXPORT(int,Mktables_Init) _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN EXPORT(int,Mktables_SafeInit) _ANSI_ARGS_((Tcl_Interp *interp));
BOOL APIENTRY DllEntryPoint(HINSTANCE hInst, DWORD reason, LPVOID reserved)
{
    return TRUE;
}
#endif

/* mkTables version number */
#define _VERSION           "1.0"

/* some acronyms for popular Tcl_xxx functions */
#define _NSO(pcText)       Tcl_NewStringObj( pcText, -1 )
#define _SSO(pO,pcText)    Tcl_SetStringObj( pO, pcText, -1 )
#define _GSO(pO)           Tcl_GetStringFromObj( pO, NULL )

#define _NIO(iVal)         Tcl_NewIntObj( iVal )
#define _SIO(pO,iVal)      Tcl_SetIntObj( pO, iVal )
#define _GIO(pO,piVal)     Tcl_GetIntFromObj( pI, pO, piVal )

#define _NBO(bVal)         Tcl_NewBooleanObj( bVal )
#define _SBO(pO,bVal)      Tcl_SetBooleanObj( pO, bVal )
#define _GBO(pO,pbVal)     Tcl_GetBooleanFromObj( pI, pO, pbVal )

#define _NDO(fVal)         Tcl_NewDoubleObj( fVal )
#define _SDO(pO,fVal)      Tcl_SetDoubleObj( pO, fVal )
#define _GDO(pO,pfVal)     Tcl_GetDoubleFromObj( pI, pO, pfVal )

#define _NLO(iC,ppO)       Tcl_NewListObj( iC, ppO )

#define _LOAL(pO,pNewO)    Tcl_ListObjAppendList( pI, pO, pNewO )
#define _LOAE(pO,pNewO)    Tcl_ListObjAppendElement( pI, pO, pNewO )
#define _LOGL(pO,piLen)    Tcl_ListObjLength( pI, pO, piLen )
#define _LOGI(pO,iI,poE)   Tcl_ListObjIndex( pI, pO, iI, poE )
#define _LOGE(pO,piC,ppV)  Tcl_ListObjGetElements( pI, pO, piC, ppV )
#define _LORE(pO,iPos,poE) Tcl_ListObjReplace( pI, pO, iPos, 1, 1, poE )
#define _LODE(pO,iPos)     Tcl_ListObjReplace( pI, pO, iPos, 1, 0, NULL )
#define _LODR(pO,iP1,iP2)  Tcl_ListObjReplace( pI, pO, iP1, (iP2)-(iP1)+1, 0, NULL )
#define _LOIE(pO,iPos,poE) Tcl_ListObjReplace( pI, pO, iPos, 0, 1, poE )
#define _LOIR(pO,iPos,iC,poE) Tcl_ListObjReplace( pI, pO, iPos, 0, iC, poE )
#define _LORR(pO,iP1,iP2,iC,ppV)  Tcl_ListObjReplace( pI, pO, iP1, (iP2)-(iP1)+1, iC, ppV )

#define _NOB               Tcl_NewObj()
#define _DOB               Tcl_DuplicateObj
#define _SOB(pO)           Tcl_IsShared( pO )? Tcl_DuplicateObj( pO ):pO
#define _ASO               Tcl_AppendStringsToObj

#define _DRC               Tcl_DecrRefCount
#define _IRC               Tcl_IncrRefCount

#define _GOR               Tcl_GetObjResult( pI )
#define _SOR(pO)           Tcl_SetObjResult( pI, pO )
#define _ROR               Tcl_ResetResult( pI )

#define _GIFO(pO,pA,pcTxt,piRes) Tcl_GetIndexFromObj( pI, pO, pA, pcTxt, 0, piRes )
#define _WNA(objc,pcText)        ( Tcl_WrongNumArgs( pI, objc, objv, pcText ), TCL_ERROR )

#define try( Expr, Excep ) { if( Expr != TCL_OK ) throw Excep; }
#define throw              goto
#define catch

/* token struct for indexes (e.g. 2, end-2) */
typedef struct _MktIndex {
  int iIndex;
  int bEnd;
} _MktIndex;

/* function prototypes. */
int Mktables_Init( Tcl_Interp * );
int Mktables_SafeInit( Tcl_Interp * );

int Mkt_TlengthCmd ( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );
int Mkt_TlistCmd   ( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );
int Mkt_TindexCmd  ( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );
int Mkt_TselectCmd ( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );
int Mkt_TrangeCmd  ( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );
int Mkt_TdeleteCmd ( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );
int Mkt_TinsertCmd ( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );
int Mkt_TreplaceCmd( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );
int Mkt_TinvertCmd ( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );
int Mkt_TmirrorCmd ( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );
int Mkt_TpadCmd    ( ClientData, Tcl_Interp *, int, Tcl_Obj *CONST[] );

/* _MktWidth
   the number of elements in each row of a table can differ. this
   tool function calculates the least and greatest amount of elements
   (i.e. columns) in a table. the values are returned in the pointers
    piMin and piMax if they are not NULL.
*/
int _MktWidth( Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[], int *piMin, int *piMax )
{
  int i, iMin, iMax, iLen;

  if( objc )
  {
    iMin = INT_MAX;
    iMax = 0;
  
    for( i = 0; i < objc; i++ )
    {
      try( _LOGL( objv[i], &iLen ), eError );
      iMin = ( iLen < iMin )? iLen : iMin;
      iMax = ( iLen > iMax )? iLen : iMax;
    }
  } else {
    iMin = iMax = 0;
  }

  if( piMin != NULL ) *piMin = iMin;
  if( piMax != NULL ) *piMax = iMax;

  return TCL_OK;

  catch eError:
    return TCL_ERROR;
}

/* _MktParseIndex
   tcl functions like lreplace allow for index in the form of and int
   or "end-"integer. The latter one has to be parsed
   first and then processed with the actual length of a given list.
   this function prevents parsing inside loops. the struct psIndex
   can be seen as a token and used later on in _MktCalcIndex. poObj
   must contain an index (e.g. 2 or end-2).
*/
int _MktParseIndex( Tcl_Interp *pI, Tcl_Obj *poObj, _MktIndex *psIndex )
{
  int iIndex, bEnd;

  if( _GIO( poObj, &iIndex ) == TCL_OK )
    bEnd = FALSE;  
  else if( ! strcmp( _GSO( poObj ), "end" ) || ! strcmp( _GSO( poObj ), "end-0" ) )
  {
    iIndex = 0;
    bEnd = TRUE;
  }
  else if( ! strncmp( _GSO( poObj ), "end-", 4 ) && ( iIndex = atoi( _GSO( poObj ) + 4 ) ) != 0 )
    bEnd = TRUE;
  else
    throw eBadIndex;

  psIndex->iIndex = iIndex;
  psIndex->bEnd = bEnd;

  _ROR;
  return TCL_OK;

  catch eBadIndex:
    _SSO( _GOR, "bad index: must be integer or end?-integer?" );
    return TCL_ERROR;
}

/* _MktCalcIndex
   calculates the absolute index from a previously parsed index given
   by psIndex. the length of a list to calculate the index for must be
   passed in iLength (however, this only applies to indexes like "end-2").
   the result is stored in piIndex. if bPlusOne is true and the index
   was specified with end?-integer? then the returned numeric index refers
   to the end of the list rather then the last element of the list
   (analog to the difference of "linsert ... end" and "lreplace ... end")
*/
int _MktCalcIndex( Tcl_Interp *pI, int iLength, _MktIndex *psIndex, int *piIndex, int bPlusOne )
{
  if( ! psIndex->bEnd )
    *piIndex = psIndex->iIndex;
  else if( bPlusOne )
    *piIndex = iLength - psIndex->iIndex;
  else
    *piIndex = iLength - psIndex->iIndex - 1;

  return TCL_OK;
}

/* Mkt_TlengthCmd
   implements the tlength command which returns the minimum and maximum
   number of elements in all rows of a table as a two-element list.
   Uses _MktWidth to calculate these values.
*/
int Mkt_TlengthCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int       iMax, iMin, iRowc;
  Tcl_Obj **ppoRowv;

  if( objc != 2 )
    return _WNA( 1, "table" );

  try( _LOGE( objv[1], &iRowc, &ppoRowv ), eError );
  try( _MktWidth( pI, iRowc, ppoRowv, &iMin, &iMax ), eError );

  _SOR( _NIO( iMin ) );
  try( _LOAE( _GOR, _NIO( iMax ) ), eError );

  return TCL_OK;

  catch eError:
    return TCL_ERROR;
}

/* Mkt_TlistCmd
   implements the tlist and tconcat commands. the length of the longest
   table is determined for the loop end value. inside the loop the first
   row of all tables is joined to a new list and appended to the result.
   then all second rows are joined and so on. depending on pC the rows
   of the tables are appended either as an element or as a list.
*/
int Mkt_TlistCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int      i, j, iObjc, iMax, bConcat;
  Tcl_Obj *poRow, **ppoObjv;

  bConcat = (int)pC;

  try( _MktWidth( pI, objc-1, objv+1, NULL, &iMax ), eError );

  for( i = 0; i < iMax; i++ )
  {
    poRow = _NOB;

    for( j = 1; j < objc; j++ )
    {
      try( _LOGE( objv[j], &iObjc, &ppoObjv ), eRowError );

      if( i < iObjc )
      {
        if( bConcat )
        {
          try( _LOAL( poRow, ppoObjv[i] ), eRowError );
        }
        else
        {
          try( _LOAE( poRow, ppoObjv[i] ), eRowError );
        }
      }
    }

    try( _LOAE( _GOR, poRow ), eRowError );
  }
  
  return TCL_OK;

  catch eError:
    return TCL_ERROR;

  catch eRowError:
    _DRC( poRow );
    return TCL_ERROR;
}

/* Mkt_TindexCmd
   implements the tindex command. for each row of the given table the element
   specified by sIndex is appended to the result (if it exists). thus, the 
   result represents exactly one column of the table.
*/
int Mkt_TindexCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int        i, iRowc, iColc, iIndex;
  Tcl_Obj  **ppoRowv, *poObj;
  _MktIndex  sIndex;

  if( objc != 3 )
    return _WNA( 1, "table index" );

  try( _LOGE( objv[1], &iRowc, &ppoRowv ), eError );
  try( _MktParseIndex( pI, objv[2], &sIndex ), eError );

  for( i = 0; i < iRowc; i++ )
  {
    try( _LOGL( ppoRowv[i], &iColc ), eError );
    try( _MktCalcIndex( pI, iColc, &sIndex, &iIndex, FALSE ), eError );
    try( _LOGI( ppoRowv[i], iIndex, &poObj ), eError );

    if( poObj != NULL )
      try( _LOAE( _GOR, poObj ), eError );
  }
  
  return TCL_OK;

  catch eError:
    return TCL_ERROR;
}

/* Mkt_TselectCmd
   implements the tselect command. for each row of the table the elements
   specified by the various indexes are appended to a new list which is then
   appended to the result. Thus, the result is a new table, containing the
   columns specified by the indexes (i.e., tindex ... 2 is different from
   tcut ... 2). since all indexes are parsed outside of the two loops, a
   dynamic pointer array to sIndex structs is created and freed up later.
*/
int Mkt_TselectCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int        i, j, iRowc, iColc, iIndex, iLen;
  Tcl_Obj   *poRow, **ppoRowv, **ppoColv;
  _MktIndex *psIndex;

  if( objc < 3 )
    return _WNA( 1, "table index ?index ...?" );

  psIndex = (_MktIndex*)ckalloc( objc-2 * sizeof( _MktIndex ) );

  for( i = 2; i < objc; i++ )
    try( _MktParseIndex( pI, objv[i], psIndex+i-2 ), eError );

  try( _LOGE( objv[1], &iRowc, &ppoRowv ), eError );

  for( i = 0; i < iRowc; i++ )
  {
    try( _LOGE( ppoRowv[i], &iColc, &ppoColv ), eError );

    for( poRow = _NOB, j = 2; j < objc; j++ )
    {
      try( _MktCalcIndex( pI, iColc, psIndex+j-2, &iIndex, FALSE ), eError );

      if( iIndex >= 0 && iIndex < iColc )
        try( _LOAE( poRow, ppoColv[iIndex] ), eRowError );
    }

    try( _LOGL( poRow, &iLen ), eRowError );

    if( ! iLen )
    {
      _DRC( poRow );
    }
    else
    {
      try( _LOAE( _GOR, poRow ), eRowError ); 
    }
  }

  ckfree( (char*)psIndex );

  return TCL_OK;

  catch eError:
    ckfree( (char*)psIndex );
    return TCL_ERROR;

  catch eRowError:
    _DRC( poRow );
    ckfree( (char*)psIndex );
    return TCL_ERROR;
}

/* Mkt_TrangeCmd
   implements the trange command. for each row in the given table
   the elements between first and last are appended to the result, thus
   forming a new table. as with tcut, trange ... 2 2 is different from
   tindex ... 2 but identical to tcut ... 2.
*/
int Mkt_TrangeCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int        i, iRowc, iColc, iFirst, iLast;
  Tcl_Obj  **ppoRowv, **ppoColv;
  _MktIndex  sFirst, sLast;

  if( objc != 4 )
    return _WNA( 1, "table first last" );

  try( _LOGE( objv[1], &iRowc, &ppoRowv ), eError );
  try( _MktParseIndex( pI, objv[2], &sFirst ), eError );
  try( _MktParseIndex( pI, objv[3], &sLast ), eError );

  for( i = 0; i < iRowc; i++ )
  {
    try( _LOGE( ppoRowv[i], &iColc, &ppoColv ), eError );
    try( _MktCalcIndex( pI, iColc, &sFirst, &iFirst, FALSE ), eError );
    try( _MktCalcIndex( pI, iColc, &sLast,  &iLast , FALSE ), eError );

    if( iLast < iFirst || iLast < 0 || iFirst >= iColc ) continue;

    iFirst = (iFirst < 0)? 0 : iFirst;
    iLast  = (iLast >= iColc)? iColc-1 : iLast;

    try( _LOAE( _GOR, _NLO( iLast-iFirst+1, ppoColv+iFirst ) ), eError );
  }
  
  return TCL_OK;

  catch eError:
    return TCL_ERROR;
}


/* Mkt_TdeleteCmd
   implements the tdelete command. All elements between the indexes
   sFirst and sLast are deleted for each row. the so shortened row
   is appended to the result list.
*/
int Mkt_TdeleteCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int        i, iRowc, iColc, iFirst, iLast;
  Tcl_Obj  **ppoRowv, *poRow;
  _MktIndex  sFirst, sLast;

  if( objc < 3 || objc > 4 )
    return _WNA( 1, "table first ?last?" );

  try( _LOGE( objv[1], &iRowc, &ppoRowv ), eError );
  try( _MktParseIndex( pI, objv[2], &sFirst ), eError );

  if( objc < 4 )
    sLast = sFirst;
  else
    try( _MktParseIndex( pI, objv[3], &sLast ), eError );

  for( i = 0; i < iRowc; i++ )
  {
    try( _LOGL( ppoRowv[i], &iColc ), eError );
    try( _MktCalcIndex( pI, iColc, &sFirst, &iFirst, FALSE ), eError );
    try( _MktCalcIndex( pI, iColc, &sLast,  &iLast , FALSE ), eError );

    if( ( iFirst < 0 && iLast < 0 ) || 
        ( iFirst >= iColc && iLast >= iColc ) || 
        iLast < iFirst )
    {
      try( _LOAE( _GOR, ppoRowv[i] ), eError );
    }
    else 
    {
      iFirst = (iFirst < 0)? 0 : iFirst;
      iLast  = (iLast >= iColc)? iColc-1 : iLast;

      poRow = _SOB( ppoRowv[i] );
      try( _LODR( poRow, iFirst, iLast ), eError );
      try( _LOAE( _GOR, poRow ), eError );
    }
  }
  
  return TCL_OK;

  catch eError:
    return TCL_ERROR;
}

/* Mkt_TinsertCmd
   implements the tinsert command. the two tables are split and the number of
   rows for each is put in iMinc and iMaxc. Only the first iMinc rows must be 
   processed, the remaining rows are simply appended. For each row of the first
   table that is less than iMinc, the corresponding row of the second table
   is inserted. If -embed wasn't specified, this row is treated as a single
   column and inserted as one element. If -embed was specified, the row's
   elements are inserted.
*/
int Mkt_TinsertCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int       i, iRowc, iObjc, iColc, iIndex, iNewc, bEmbed, iMinc, iMaxc;
  Tcl_Obj  *poRow, **ppoRowv, **ppoObjv, **ppoNewv, *poIndex;
  _MktIndex sIndex;

  if( objc < 4 || objc > 5 )
    return _WNA( 1, "?-embed? table index table" );

  bEmbed  = ( ! strcmp( _GSO( objv[1] ), "-embed" ) );
  try( _LOGE( objv[bEmbed?2:1], &iRowc, &ppoRowv ), eError );
  try( _LOGE( objv[bEmbed?4:3], &iObjc, &ppoObjv ), eError );

  poIndex = ( bEmbed )? objv[3] : objv[2];
  try( _MktParseIndex( pI, poIndex, &sIndex ), eError );

  iMinc = ( iRowc < iObjc )? iRowc : iObjc;
  iMaxc = ( iRowc > iObjc )? iRowc : iObjc;

  for( i = 0; i < iMinc; i++ )
  {
    poRow = _SOB( ppoRowv[i] );

    try( _LOGL( poRow, &iColc ), eError );
    try( _MktCalcIndex( pI, iColc, &sIndex, &iIndex, TRUE ), eError );

    if( bEmbed )
    {
      try( _LOGE( ppoObjv[i], &iNewc, &ppoNewv ), eError );
      if( iNewc )
        try( _LOIR( poRow, iIndex, iNewc, ppoNewv ), eError );
    }
    else 
    {
      try( _LOIE( poRow, iIndex, &(ppoObjv[i]) ), eError );
    }

    try( _LOAE( _GOR, poRow ), eError );
  }

  if( i < iRowc )
    for( i = iMinc; i < iMaxc; i++ )
      try( _LOAE( _GOR, ppoRowv[i] ), eError );

  if( i < iObjc )
    for( i = iMinc; i < iMaxc; i++ )
      if( bEmbed )
      {
        try( _LOAE( _GOR, ppoObjv[i] ), eError );
      }
      else
      {
        try( _LOAE( _GOR, _NLO( 1, &(ppoObjv[i]) ) ), eError );
      }

  return TCL_OK;

  catch eError:
    return TCL_ERROR;
}

/* Mkt_TreplaceCmd
   implements the treplace command. the two tables are split and the number of
   rows for each is put in iMinc and iMaxc. Only the first iMinc rows must be 
   processed, the remaining rows are simply appended. For each row of the first
   table that is less than iMinc, the corresponding row of the second table
   replaces the elements specified by sFirst to sLast. If -embed wasn't 
   specified, this row is treated as a single column and inserted as one
   element. If -embed was specified, the row's elements are inserted.
*/
int Mkt_TreplaceCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int        i, iObjc, iRowc, iColc, iNewc, iFirst, iLast, iMinc, iMaxc, bEmbed;
  Tcl_Obj  **ppoObjv, **ppoRowv, **ppoNewv, *poRow, *poFirst, *poLast;
  _MktIndex  sFirst, sLast;

  if( objc < 5 || objc > 6 )
    return _WNA( 1, "?-embed? table first last table" );

  bEmbed  = ( ! strcmp( _GSO( objv[1] ), "-embed" ) );
  try( _LOGE( objv[bEmbed?2:1], &iRowc, &ppoRowv ), eError );
  try( _LOGE( objv[bEmbed?5:4], &iObjc, &ppoObjv ), eError );

  poFirst = ( bEmbed )? objv[3] : objv[2];
  poLast  = ( bEmbed )? objv[4] : objv[3];
  try( _MktParseIndex( pI, poFirst, &sFirst ), eError );
  try( _MktParseIndex( pI, poLast , &sLast  ), eError );

  iMinc = ( iRowc < iObjc )? iRowc : iObjc;
  iMaxc = ( iRowc > iObjc )? iRowc : iObjc;

  for( i = 0; i < iMinc; i++ )
  {
    try( _LOGL( ppoRowv[i], &iColc ), eError );
    try( _MktCalcIndex( pI, iColc, &sFirst, &iFirst, FALSE ), eError );
    try( _MktCalcIndex( pI, iColc, &sLast,  &iLast , FALSE ), eError );

    poRow = _SOB( ppoRowv[i] );

    if( ! ( ( iFirst < 0 && iLast < 0 ) || ( iFirst >= iColc && iLast >= iColc ) )
        && iLast >= iFirst )
    {
      iFirst = (iFirst < 0)? 0 : iFirst;
      iLast  = (iLast >= iColc)? iColc-1 : iLast;

      if( bEmbed )
      {
        try( _LOGE( ppoObjv[i], &iNewc, &ppoNewv ), eError );
        try( _LORR( poRow, iFirst, iLast, iNewc, ppoNewv ), eError );
      }
      else
      {
        try( _LORR( poRow, iFirst, iLast, 1, &(ppoObjv[i]) ), eError );
      }
    }

    try( _LOAE( _GOR, poRow ), eError );
  }
  
  if( i < iRowc )
    for( i = iMinc; i < iMaxc; i++ )
      try( _LOAE( _GOR, ppoRowv[i] ), eError );

  if( i < iObjc )
    for( i = iMinc; i < iMaxc; i++ )
      if( bEmbed )
      {
        try( _LOAE( _GOR, ppoObjv[i] ), eError );
      }
      else
      {
        try( _LOAE( _GOR, _NLO( 1, &(ppoObjv[i]) ) ), eError );
      }

  return TCL_OK;

  catch eError:
    return TCL_ERROR;
}

/* Mkt_TmirrorCmd
   implements the tmirror command. For each row the elements are read
   from the last to the first and appended to a new list. This list
   is appended to the result.
*/
int Mkt_TmirrorCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int      i, j, iRowc, iColc;
  Tcl_Obj *poRow, **ppoRowv, **ppoColv;

  if( objc != 2 )
    return _WNA( 1, "table" );

  try( _LOGE( objv[1], &iRowc, &ppoRowv ), eError );

  for( i = 0; i < iRowc; i++ )
  {
    try( _LOGE( ppoRowv[i], &iColc, &ppoColv ), eError );

    for( poRow = _NOB, j = iColc - 1; j >= 0; j-- )
      try( _LOAE( poRow, ppoColv[j] ), eRowError );

    try( _LOAE( _GOR, poRow ), eRowError );
  }

  return TCL_OK;

  catch eError:
    return TCL_ERROR;

  catch eRowError:
    _DRC( poRow );
    return TCL_ERROR;
}

/* Mkt_TinvertCmd
   implements the tinvert command which mirrors the table diagonally, turning
   rows into columns and vice versa. the longest row is determined with
   _MktWidth. The first elements of all rows are formed to a new list which
   is appended to the result, then the second elements of all rows and so on.
*/
int Mkt_TinvertCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int      i, j, iMax, iRowc, iColc;
  Tcl_Obj *poRow, **ppoRowv, **ppoColv;

  if( objc != 2 )
    return _WNA( 1, "table" );

  try( _LOGE( objv[1], &iRowc, &ppoRowv ), eError );
  try( _MktWidth( pI, iRowc, ppoRowv, NULL, &iMax ), eError );

  for( i = 0; i < iMax; i++ )
  {
    for( poRow = _NOB, j = 0; j < iRowc; j++ )
    {
      try( _LOGE( ppoRowv[j], &iColc, &ppoColv ), eRowError );

      if( i < iColc )
        try( _LOAE( poRow, ppoColv[i] ), eRowError );
    }

    try( _LOAE( _GOR, poRow ), eRowError );
  }

  return TCL_OK;

  catch eError:
    return TCL_ERROR;

  catch eRowError:
    _DRC( poRow );
    return TCL_ERROR;
}

/* Mkt_TpadCmd
   implements the tpadl and tpadr commands which bring a table into a 
   rectangular shape. _MktWidth is used to get the number of elements 
   in the longest row. all other rows are then filled up with elements,
   which are either empty strings or, if value is specified, with a 
   given value. Nothing is done if the table is already rectangular.
*/
int Mkt_TpadCmd( ClientData pC, Tcl_Interp *pI, int objc, Tcl_Obj *CONST objv[] )
{
  int       i, j, iMin, iMax, iRowc, iColc, bRight;
  Tcl_Obj  *poRow, *poNew, **ppoRowv;

  if( objc < 2 || objc > 3 )
    return _WNA( 1, "table ?value?" );

  bRight = (int)pC;

  try( _LOGE( objv[1], &iRowc, &ppoRowv ), eError );
  try( _MktWidth( pI, iRowc, ppoRowv, &iMin, &iMax ), eError );

  if( iMin == iMax )
  {
    _SOR( objv[1] );
  } 
  else
  {
    for( i = 0; i < iRowc; i++ )
    {
      poRow = _SOB( ppoRowv[i] );
      try( _LOGL( poRow, &iColc ), eError );

      for( j = iColc; j < iMax; j++ )
      {
        poNew = ( objc==3 ) ? objv[2] : _NOB;

        if( bRight )
        {
          try( _LOAE( poRow, poNew ), eError );
        }
        else
        {
          try( _LOIE( poRow, 0, &poNew ), eError );
        }
      }

      try( _LOAE( _GOR, poRow ), eError );
    }
  }

  return TCL_OK;

  catch eError:
    return TCL_ERROR;
}

/* Mktables_Init, Mktables_SafeInit
   package initialization. creates all new commands and math functions
   and registers the package.
*/
int Mktables_Init( Tcl_Interp *pI )
{
#ifdef USE_TCL_STUBS
  if( Tcl_InitStubs( pI, "8.2", 0) == NULL )
    throw eError;
#endif

  if( TCL_MAJOR_VERSION < 8 )
    throw eWrongVersion;

  Tcl_CreateObjCommand( pI, "tlength" , Mkt_TlengthCmd , NULL, NULL );
  Tcl_CreateObjCommand( pI, "tlist"   , Mkt_TlistCmd   , (ClientData)0, NULL );
  Tcl_CreateObjCommand( pI, "tconcat" , Mkt_TlistCmd   , (ClientData)1, NULL );
  Tcl_CreateObjCommand( pI, "tindex"  , Mkt_TindexCmd  , NULL, NULL );
  Tcl_CreateObjCommand( pI, "tselect" , Mkt_TselectCmd , NULL, NULL );
  Tcl_CreateObjCommand( pI, "trange"  , Mkt_TrangeCmd  , NULL, NULL );
  Tcl_CreateObjCommand( pI, "tdelete" , Mkt_TdeleteCmd , NULL, NULL );
  Tcl_CreateObjCommand( pI, "tinsert" , Mkt_TinsertCmd , NULL, NULL );
  Tcl_CreateObjCommand( pI, "treplace", Mkt_TreplaceCmd, NULL, NULL );
  Tcl_CreateObjCommand( pI, "tmirror" , Mkt_TmirrorCmd , NULL, NULL );
  Tcl_CreateObjCommand( pI, "tinvert" , Mkt_TinvertCmd , NULL, NULL );
  Tcl_CreateObjCommand( pI, "tpadl"   , Mkt_TpadCmd    , (ClientData)0, NULL );
  Tcl_CreateObjCommand( pI, "tpadr"   , Mkt_TpadCmd    , (ClientData)1, NULL );

  try( Tcl_PkgProvide( pI, "mkTables", _VERSION ), eError );

  return TCL_OK;

  catch eError:
    return TCL_ERROR;

  catch eWrongVersion:
    _SSO( _GOR, "Package mkTables requires Tcl Version 8" );
    return TCL_ERROR;
}

int Mktables_SafeInit( Tcl_Interp *pI )
{
  return Mktables_Init( pI );
}

/* static linking. uncomment the following two functions if you want
   to create a stand-alone shell instead of a dynamic library. */

#ifndef USE_TCL_STUBS
int main( int argc, char *argv[] )
{
  Tcl_Main( argc, argv, Tcl_AppInit );
  return 0;
}

int Tcl_AppInit( Tcl_Interp *pI )
{
  try( Tcl_Init( pI ), eError );
  try( Mktables_Init( pI ), eError );

  return TCL_OK;

  catch eError:
    return TCL_ERROR;
}
#endif

/*
 * mkTables 1.0
 * -------------
 */