/**************************************************************************

This software is copyrighted by PHILIP SMOLEN.
The following terms apply to all files associated with the software unless 
explicitly disclaimed in individual files.

The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
that existing copyright notices are retained in all copies and that this
notice is included verbatim in any distributions. No written agreement,
license, or royalty fee is required for any of the authorized uses.
Modifications to this software may be copyrighted by their authors
and need not follow the licensing terms described here, provided that
the new terms are clearly indicated on the first page of each file where
they apply.

IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.

GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
in the software and related documentation as defined in the Federal 
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license. 

**************************************************************************/


// All code below was written by Philip Smolen.
// Contact info:  http://www.trade-ideas.com/home/phil/RBTree/


// Unix:
//   cc -fPIC tcl_rbtree.c rbtree.c -Wall -shared -o rbtree.so -O2
// MS WIN / MS VC++ 5.0:
//   cl tcl_rbtree.c rbtree.c  /I<tcl include dir> <tcl lib dir>\tcl81.lib /GD /LD -o rbtree.dll /O2 -DMS_VC /W3


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

#include "rbtree.h"

//--------------------------------------------------------------------------
// internal data structures
//--------------------------------------------------------------------------

typedef struct rbTreeType objTree;
typedef struct rbNodeType *objTreeIterator;

struct tclRBTree
{
  Tcl_Interp *interp;
  Tcl_Obj *compareCallback;
  int sortBy;
  objTree *tree;
};

static void freeTclNode(struct rbDataType *data)
{
  if (data->key)
    {
      Tcl_DecrRefCount((Tcl_Obj*)data->key);
    }
  if (data->value)
    {
      Tcl_DecrRefCount((Tcl_Obj*)data->value);
    }
}

static void dupTclNode(struct rbDataType *dest, const struct rbDataType *src)
{
  dest->key = src->key;
  if (dest->key)
    {
      Tcl_IncrRefCount((Tcl_Obj*)dest->key);
    }
  dest->value = src->value;
  if (dest->value)
    {
      Tcl_IncrRefCount((Tcl_Obj*)dest->value);
    }
}

static enum rbCompareType compareTclAscii(const rbKeyType a, 
					  const rbKeyType b, 
					  void *unused)
{
  int aLen, bLen;
  char *aData = Tcl_GetStringFromObj((Tcl_Obj *)a, &aLen);
  char *bData = Tcl_GetStringFromObj((Tcl_Obj *)b, &bLen);
  int len = (aLen<bLen)?aLen:bLen;
  int cmp = memcmp(aData, bData, len);
  if (cmp == 0)
    {
      cmp = aLen-bLen;
    }
  if (cmp < 0)
    {
      return RBC_LESS;
    }
  else if (cmp > 0)
    { 
      return RBC_MORE;
    }
  else
    {
      return RBC_EQUAL;
    }
  
}

static enum rbCompareType compareTclInteger(const rbKeyType a, 
					    const rbKeyType b, 
					    void *data)
{
  struct tclRBTree *tree = (struct tclRBTree *)data;
  int aAsInt, bAsInt;
  if ((Tcl_GetIntFromObj(tree->interp, (Tcl_Obj *)a, &aAsInt) != TCL_OK)
      || (Tcl_GetIntFromObj(tree->interp, (Tcl_Obj *)b, &bAsInt) != TCL_OK))
    {
      return RBC_ERROR;
    }
  if (aAsInt == bAsInt)
    {
      return RBC_EQUAL;
    }
  else if (aAsInt < bAsInt)
    {
      return RBC_LESS;
    }
  else
    {
      return RBC_MORE;
    }
}

static enum rbCompareType compareTclReal(const rbKeyType a, 
					 const rbKeyType b, 
					 void *data)
{
  struct tclRBTree *tree = (struct tclRBTree *)data;
  double aAsDouble, bAsDouble;
  if ((Tcl_GetDoubleFromObj(tree->interp, (Tcl_Obj *)a, &aAsDouble) != TCL_OK)
      || (Tcl_GetDoubleFromObj(tree->interp, 
			       (Tcl_Obj *)b, 
			       &bAsDouble) != TCL_OK))
    {
      return RBC_ERROR;
    }
  if (aAsDouble == bAsDouble)
    {
      return RBC_EQUAL;
    }
  else if (aAsDouble < bAsDouble)
    {
      return RBC_LESS;
    }
  else
    {
      return RBC_MORE;
    }
}

static Tcl_Obj *getKey(const struct rbDataType *node)
{
  return (Tcl_Obj*)node->key;
}

static Tcl_Obj *getValue(const struct rbDataType *node)
{
  return (Tcl_Obj*)node->value;
}

static void makeValueUnique(const struct rbDataType *src)
{
  if (Tcl_IsShared(getValue(src)))
    {
      Tcl_DecrRefCount(getValue(src));
      ((struct rbDataType *)src)->value = Tcl_DuplicateObj(getValue(src));
      Tcl_IncrRefCount(getValue(src));
    }
}

static Tcl_Obj *getKeyI(objTreeIterator i)
{
  return i?getKey(&i->data):NULL;
}

static Tcl_Obj *getValueI(objTreeIterator i)
{
  return i?getValue(&i->data):NULL;
}

static Tcl_Obj *contentsAsList(struct tclRBTree *tree)
{
  objTreeIterator i;
  Tcl_Obj *list = Tcl_NewObj();
  for (i = rbFirst(tree->tree); i; i = rbNext(tree->tree, i))
    {
      Tcl_ListObjAppendElement(NULL, list, getKeyI(i));
      Tcl_ListObjAppendElement(NULL, list, getValueI(i));
    }
  return list;
}

static enum rbResultType insertCmd(struct tclRBTree *tree, 
				   Tcl_Obj *key, 
				   Tcl_Obj *value) 
{
  struct rbDataType data;
  data.key = key;
  data.value = value;
  return rbAdd(tree->tree, &data, 1); 
}

static enum rbResultType previousCmd(struct tclRBTree *tree, 
				     Tcl_Obj *key, 
				     Tcl_Obj **result) 
{
  objTreeIterator i;
  enum rbResultType r = rbFind(tree->tree, key, RBD_AFTER, &i);
  switch (r)
    {
    case RBR_SUCCEED:
      i = rbPrev(tree->tree, i);
      break;
    case RBR_OTHER_FAIL:
      i = rbLast(tree->tree);
      break;
    default:
      *result = NULL;
      return RBR_COMPARE_FAIL;
    }
  *result = getKeyI(i);
  return (*result)?RBR_SUCCEED:RBR_OTHER_FAIL;
}

static enum rbResultType nextCmd(struct tclRBTree *tree, 
				 Tcl_Obj *key, 
				 Tcl_Obj **result) 
{
  objTreeIterator i;
  enum rbResultType r = rbFind(tree->tree, key, RBD_BEFORE, &i);
  switch (r)
    {
    case RBR_SUCCEED:
      i = rbNext(tree->tree, i);
      break;
    case RBR_OTHER_FAIL:
      i = rbFirst(tree->tree);
      break;
    default:
      *result = NULL;
      return RBR_COMPARE_FAIL;
    }
  *result = getKeyI(i);
  return (*result)?RBR_SUCCEED:RBR_OTHER_FAIL;
}

static enum rbResultType findCmd(struct tclRBTree *tree, 
				 Tcl_Obj *key, 
				 int after, 
				 Tcl_Obj **result)
{
  objTreeIterator i;
  enum rbResultType r = rbFind(tree->tree, 
			       key, 
			       after?RBD_AFTER:RBD_BEFORE, 
			       &i);
  *result = getKeyI(i);
  return r;
}

static Tcl_Obj *keysCmd(struct tclRBTree *tree)
{
  Tcl_Obj *result = Tcl_NewObj();
  objTreeIterator i;
  for (i = rbFirst(tree->tree); i; i = rbNext(tree->tree, i))
    {
      Tcl_ListObjAppendElement(NULL, result, getKeyI(i));
    }
  return result;
}

static enum rbResultType valueCmd(struct tclRBTree *tree, 
				  Tcl_Obj *key, 
				  Tcl_Obj **result)
{
  objTreeIterator i;
  enum rbResultType r = rbFind(tree->tree, key, RBD_EXACT, &i);
  *result = getValueI(i);
  return r;
}


//--------------------------------------------------------------------------
// tree data type
//--------------------------------------------------------------------------

static void FreeTreeInternalRep(Tcl_Obj *objPtr);
static void DupTreeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static int SetTreeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfTree(Tcl_Obj *objPtr);

static char const *sortTypes[] = { "ascii", "integer", "real", NULL };
static rbCompareProc compareProcs[] = { compareTclAscii, compareTclInteger, 
					compareTclReal };

static Tcl_ObjType treeType = {
  "rbtree",				/* name */
  FreeTreeInternalRep,                  /* freeIntRepProc */
  DupTreeInternalRep,		        /* dupIntRepProc */
  UpdateStringOfTree,			/* updateStringProc */
  SetTreeFromAny			/* setFromAnyProc */
};


static Tcl_Obj *newTreeObj(Tcl_Interp *interp, int sortBy) {
  Tcl_Obj *objPtr;
  
  struct tclRBTree *internal = 
    (struct tclRBTree *)malloc(sizeof(struct tclRBTree));
  internal->interp = interp;
  internal->compareCallback = NULL;
  internal->sortBy = sortBy;
  internal->tree = rbNewTree();
  internal->tree->freeData = freeTclNode;
  internal->tree->dupData = dupTclNode;
  internal->tree->compareKeys = compareProcs[sortBy];
  internal->tree->compareData = internal;

  objPtr = Tcl_NewObj();
  objPtr->bytes = NULL;
  objPtr->internalRep.otherValuePtr = internal;
  objPtr->typePtr = &treeType;
  return objPtr;
}

static void FreeTreeInternalRep(Tcl_Obj *objPtr)
{
  struct tclRBTree *internal 
    = (struct tclRBTree *)objPtr->internalRep.otherValuePtr;
  rbDeleteTree(internal->tree);
  free(internal);
  objPtr->typePtr = NULL;
}

static void DupTreeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
{
  struct tclRBTree *internal 
    = (struct tclRBTree *)malloc(sizeof(struct tclRBTree));
  *internal = *(struct tclRBTree *)srcPtr->internalRep.otherValuePtr;
  internal->tree = rbCopy(internal->tree);
  copyPtr->internalRep.otherValuePtr = internal;
  copyPtr->typePtr = &treeType;
}

static int SetTreeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr)
{
  Tcl_Obj *asList = Tcl_DuplicateObj(objPtr);
  Tcl_Obj *sortByObj = NULL;
  int sortByInt;
  struct tclRBTree *internal;
  int count;
  int i;
  
  Tcl_IncrRefCount(asList);
  if (Tcl_ListObjLength(interp, asList, &count) != TCL_OK)
    {
      Tcl_DecrRefCount(asList);
      return TCL_ERROR;
    }
  
  if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) 
    {
      objPtr->typePtr->freeIntRepProc(objPtr);
    }

  if (!(count % 2))
    { // Use the default sort info
      sortByInt = 0;  // ASCII is the default
    }
  else
    { // Grab the last object as the sort info.  Making it the first element
      // might make it a little easier for a human reader.  But making it the
      // last element made it a little easier/faster for the convert to string
      // routine.
      count--;
      Tcl_ListObjIndex(NULL, asList, count, &sortByObj);

      if (Tcl_GetIndexFromObj(interp, sortByObj, sortTypes, "sort by", 0,
			      &sortByInt) != TCL_OK) 
	{
	  Tcl_DecrRefCount(asList);
	  return TCL_ERROR;
	}
    }

  internal = (struct tclRBTree*)malloc(sizeof(struct tclRBTree));
  internal->interp = interp;
  internal->compareCallback = NULL;
  internal->sortBy = sortByInt;
  internal->tree = rbNewTree();
  internal->tree->freeData = freeTclNode;
  internal->tree->dupData = dupTclNode;
  internal->tree->compareKeys = compareProcs[sortByInt];
  internal->tree->compareData = internal;
  for (i = 0; i < count; i += 2)
    {
      struct rbDataType data;
      Tcl_ListObjIndex(NULL, asList, i, (Tcl_Obj **)&data.key);
      Tcl_ListObjIndex(NULL, asList, i+1, (Tcl_Obj **)&data.value);
      if (rbAdd(internal->tree, &data, 1) != RBR_SUCCEED)
	{
	  Tcl_DecrRefCount(asList);
	  rbDeleteTree(internal->tree);
	  free(internal);
	  objPtr->typePtr = NULL;
	  return TCL_ERROR;
	}
    }
  
  objPtr->internalRep.otherValuePtr = internal;
  objPtr->typePtr = &treeType;
  
  return TCL_OK;
}

static void UpdateStringOfTree(Tcl_Obj *objPtr)
{
  char *str;
  struct tclRBTree *internal 
    = (struct tclRBTree *)objPtr->internalRep.otherValuePtr;
  Tcl_Obj *list = contentsAsList(internal);
  if (internal->sortBy != 0)  // ASCII is the default
    {
      Tcl_ListObjAppendElement(NULL, 
			       list, 
			       Tcl_NewStringObj(sortTypes[internal->sortBy], 
						-1));
    }
  str = Tcl_GetStringFromObj(list, &objPtr->length);
  objPtr->bytes = Tcl_Alloc(objPtr->length+1);
  memcpy(objPtr->bytes, str, objPtr->length+1);
  Tcl_IncrRefCount(list);
  Tcl_DecrRefCount(list);
}


//--------------------------------------------------------------------------
// 
//--------------------------------------------------------------------------

static __thread Tcl_Obj *tclOne = NULL;
#define tclTrue (tclOne)
static __thread Tcl_Obj *tclFalse = NULL;

// Note that we do not hold onto a reference count.  This may become a
// problem when we allow callbacks for the compare command.  We don't
// want someone to delete the variable containing the only reference
// count to our data while we're still manipulating the data.
static struct tclRBTree *getTree(Tcl_Interp *interp, 
				 Tcl_Obj *varName, 
				 int forWrite)
{
  Tcl_Obj *treeObj = Tcl_ObjGetVar2(interp, varName, NULL,
				    TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
  if (!treeObj) 
    {
      return NULL;
    }
  if (forWrite && Tcl_IsShared(treeObj))
    { 
      Tcl_Obj *newTree = Tcl_DuplicateObj(treeObj);
      Tcl_IncrRefCount(newTree);
      treeObj = Tcl_ObjSetVar2(interp, varName, NULL, newTree,
			       TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
      Tcl_DecrRefCount(newTree);
      if (!treeObj)
	{
	  return NULL;
	}
    }
  if (Tcl_ConvertToType(interp, treeObj, &treeType) != TCL_OK)
    {
      return NULL;
    }
  if (forWrite)
    {
      Tcl_InvalidateStringRep(treeObj);
    }
  return (struct tclRBTree *)treeObj->internalRep.otherValuePtr;
}

static Tcl_Obj *getTreeObj(Tcl_Interp *interp, 
			   Tcl_Obj *varName, 
			   struct tclRBTree **commandData,
			   objTree **tree)
{
  Tcl_Obj *treeObj = Tcl_ObjGetVar2(interp, varName, NULL,
				    TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
  *commandData = NULL;
  *tree = NULL;
  if (!treeObj) 
    {
      return NULL;
    }
  if (Tcl_ConvertToType(interp, treeObj, &treeType) != TCL_OK)
    {
      return NULL;
    }
  *commandData = (struct tclRBTree *)treeObj->internalRep.otherValuePtr;
  *tree = (*commandData)->tree;
  return treeObj;
}

static Tcl_Obj *emptyAsNull(Tcl_Obj *obj) 
{
  int len;
  if (obj)
    {
      Tcl_GetStringFromObj(obj, &len);
      return len?obj:NULL;
    }
  else
    {
      return NULL;
    }
}

// This returns 1 on success, 0 on failure.  Failure is always due to a TCL
// error in which case the result will already be set properly, and the
// return values from this function will be undefined.
// fromObj and toObj are the requested, inclusive endpoints of the loop,
// NULL or the empty string if that limit is unspecified.  (So the empty
// string is not a valid starting or ending place?)
// tree is the tree we are trying to iterate over.
// first returns the initial iterator, NULL for do nothing.
// pastEnd returns the iterator after the last iterator, NULL to examine
// the entire tree.
static int foreachLimits(Tcl_Obj *fromObj, Tcl_Obj *toObj, 
			 objTree *tree,
			 objTreeIterator *first,
			 objTreeIterator *pastEnd)
{
  // Look for a {} for undefined.  Useful for a user to specify a start or
  // stop of the loop, but not both.
  fromObj = emptyAsNull(fromObj);
  toObj = emptyAsNull(toObj);

  // Try to choose endpoints as requested.
  if (fromObj)
    { // Find the "closest after" item for this.  That is to say
      // we start on the item if it exists, otherwise we start on
      // the first item past where that item would be.
      if (rbFind(tree, fromObj, RBD_AFTER, first) == RBR_COMPARE_FAIL)
	{
	  return 0;
	}
    }
  else
    { // Start at the beginning.
      *first = rbFirst(tree);
    }
  
  if (toObj)
    { // Find the "next" item for this.  That is to say we stop
      // on the first item after this item, if it exists, or after
      // where this item would be, if it does not exist.
      if (rbFind(tree, toObj, RBD_BEFORE, pastEnd) 
	  == RBR_COMPARE_FAIL)
	{
	  return 0;
	}
      if (*pastEnd) { *pastEnd = rbNext(tree, *pastEnd); }
    }
  else
    { // Stop at the end.
      *pastEnd = NULL;
    }
  
  // Look for conflicting enpoints.
  if (fromObj && toObj) 
    {   
      switch(tree->compareKeys(fromObj, toObj, tree))
	{
	case RBC_ERROR:
	  return 0;
	case RBC_MORE:
	  // The starting position is greater than the ending position
	  // so we don't do the loop at all.
	  *first = NULL;
	  *pastEnd = NULL;
	  break;
	case RBC_LESS:
	case RBC_EQUAL:
	  // No conflict.  Just go from the lower one to the higher
	  // one, inclusive of the endpoints.  (GCC complains if I
	  // leave this case out.)
	  break;
	}
    }
  // Success.
  return 1;
}


static int tree_create_cmd(ClientData unused, 
			   Tcl_Interp *interp,
			   int objc,
			   Tcl_Obj *CONST objv[]) 
{
  int sortBy;

  if (objc > 2)
    {
      Tcl_WrongNumArgs(interp, 1, objv, "?sort_by?");
      return TCL_ERROR;
    }

  if (objc < 2)
    {
      sortBy = 0;  // ASCII is the default 
    }
  else if (Tcl_GetIndexFromObj(interp, objv[1], sortTypes, "sort_by", 0,
			       &sortBy) != TCL_OK) 
    {
      return TCL_ERROR;
    }
  Tcl_SetObjResult(interp, newTreeObj(interp, sortBy));
  return TCL_OK;
}

/* OBSOLETE.  See tree_find_cmd. */
static int tree_previous_cmd(ClientData unused, 
			     Tcl_Interp *interp,
			     int objc,
			     Tcl_Obj *CONST objv[]) 
{
  struct tclRBTree *tree;
  Tcl_Obj *result;
  if ((objc < 3) || (objc > 4))
    {
      Tcl_WrongNumArgs(interp, 1, objv, "var key ?error_value?");
      return TCL_ERROR;
    }
  tree = getTree(interp, objv[1], 0);
  if (!tree) { return TCL_ERROR; }
  switch(previousCmd(tree, objv[2], &result))
    {
    case RBR_SUCCEED:
      Tcl_SetObjResult(interp, result);
      return TCL_OK;
    case RBR_OTHER_FAIL:
      if (objc == 4)
        {
	  Tcl_SetObjResult(interp, objv[3]);
	  return TCL_OK;
	}
      else 
	{
	  Tcl_AppendResult(interp, "No previous element in tree.", NULL);
	  return TCL_ERROR;
	}
    default:
      return TCL_ERROR;
    }
}

/* OBSOLETE.  See tree_find_cmd. */
static int tree_next_cmd(ClientData unused, 
			 Tcl_Interp *interp,
			 int objc,
			 Tcl_Obj *CONST objv[]) 
{
  struct tclRBTree *tree;
  Tcl_Obj *result;
  if ((objc < 3) || (objc > 4))
    {
      Tcl_WrongNumArgs(interp, 1, objv, "var key ?error_value?");
      return TCL_ERROR;
    }
  tree = getTree(interp, objv[1], 0);
  if (!tree) { return TCL_ERROR; }
  switch(nextCmd(tree, objv[2], &result))
    {
    case RBR_SUCCEED:
      Tcl_SetObjResult(interp, result);
      return TCL_OK;
    case RBR_OTHER_FAIL:
      if (objc == 4)
        {
	  Tcl_SetObjResult(interp, objv[3]);
	  return TCL_OK;
	}
      else 
	{
	  Tcl_AppendResult(interp, "No next element in tree.", NULL);
	  return TCL_ERROR;
	}
    default:
      return TCL_ERROR;
    }
}

/* OBSOLETE.  See tree_find_cmd. */
static int tree_closest_cmd(ClientData unused, 
			 Tcl_Interp *interp,
			 int objc,
			 Tcl_Obj *CONST objv[]) 
{
  static char const *positions[] = {"before", "after", NULL};
  int positionIndex;
  struct tclRBTree *tree;
  Tcl_Obj *result;
  if ((objc < 4) || (objc > 5))
    {
      Tcl_WrongNumArgs(interp, 1, objv, "var position key ?error_value?");
      return TCL_ERROR;
    }
  if (Tcl_GetIndexFromObj(interp, objv[2], positions, "position", 0,
			  &positionIndex) != TCL_OK) 
    {
      return TCL_ERROR;
    }
  tree = getTree(interp, objv[1], 0);
  if (!tree) { return TCL_ERROR; }
  switch (findCmd(tree, objv[3], positionIndex, &result))
    {
    case RBR_SUCCEED:
      Tcl_SetObjResult(interp, result);
      return TCL_OK;
    case RBR_OTHER_FAIL:
      if (objc == 5)
	{
	  Tcl_SetObjResult(interp, objv[4]);
	  return TCL_OK;
	}
      else 
	{
	  Tcl_AppendResult(interp, "No such element in tree.", NULL);
	  return TCL_ERROR;
	}
    default:
      return TCL_ERROR;
    }
}

static int tree_set_cmd(ClientData unused, 
			Tcl_Interp *interp,
			int objc,
			Tcl_Obj *CONST objv[]) 
{
  static char const *options[] = {
    "exists",   "insert",   "delete",   "foreach",   "keys",   "empty", 
    "count",   NULL
  };
  enum options 
  {
    SET_EXISTS, SET_INSERT, SET_DELETE, SET_FOREACH, SET_KEYS, SET_EMPTY, 
    SET_COUNT
  };	  
  int index;
  struct tclRBTree *tree;

  if (objc < 2) 
    {
      Tcl_WrongNumArgs(interp, 1, objv, "option var ?arg ...?");
      return TCL_ERROR;
    }

  if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
			  &index) != TCL_OK) {
    return TCL_ERROR;
  }

  switch (index)
    {
    case SET_EXISTS:
      {
	if (objc != 4)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 0);
	if (!tree) { return TCL_ERROR; }
	switch (rbExists(tree->tree, objv[3]))
	  {
	  case RBR_SUCCEED:
	    // Item Found!
	    Tcl_SetObjResult(interp, tclTrue);
	    return TCL_OK;
	  case RBR_OTHER_FAIL:
	    // Item not found!
	    Tcl_SetObjResult(interp, tclFalse);
	    return TCL_OK;
	  default:
	    // Error in search!  Bad data?  
	    // Assume result was set when error was found.
	    return TCL_ERROR;
	  }
      }
    case SET_INSERT:
      {
	if (objc != 4)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	return (insertCmd(tree, objv[3], objv[3]) == RBR_SUCCEED)
	  ?TCL_OK
	  :TCL_ERROR;
      }
    case SET_DELETE:
      {
	if (objc != 4)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	switch (rbRemove(tree->tree, objv[3]))
	  {
	  case RBR_SUCCEED:
	    // Item Found and deleted.
	    Tcl_SetObjResult(interp, tclTrue);
	    return TCL_OK;
	  case RBR_OTHER_FAIL:
	    // Item not found; tree not modified.
	    Tcl_SetObjResult(interp, tclFalse);
	    return TCL_OK;
	  default:
	    // Error in search!  Bad data?  
	    // Assume result was set when error was found.
	    return TCL_ERROR;
	  }
      }
    case SET_FOREACH:
      {
	Tcl_Obj *keyVarObj, *fromObj, *toObj, *bodyObj;
	Tcl_Obj *lockedObject = NULL;
	objTree *realTree;

	// first points to the first item in the tree that we plan to 
	// execute.  pastEnd points to the first item after the last item
	// we plan to execute.  If these are the same, we don't go through
	// the loop at all.  We never execute pastEnd, but we often execute
	// first.  i is the current item.
	objTreeIterator first;
	objTreeIterator pastEnd;
        objTreeIterator i;

	if ((objc != 5) && (objc != 7))
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, 
			     "var key_var ?from to? body");
	    return TCL_ERROR;
	  }

	keyVarObj = emptyAsNull(objv[3]);

	if (objc == 5)
	  {
	    fromObj = NULL;
	    toObj = NULL;
	    bodyObj = objv[4];
	  }
	else
	  { 
	    fromObj = objv[4];
	    toObj = objv[5];
	    bodyObj = objv[6];
	  }

	lockedObject = getTreeObj(interp, objv[2], &tree, &realTree);
	if (!lockedObject) { return TCL_ERROR; }
	Tcl_IncrRefCount(lockedObject);

	if (!foreachLimits(fromObj, toObj, realTree, &first, &pastEnd))
	  {
	    Tcl_DecrRefCount(lockedObject);
	    return TCL_ERROR;
	  }

	for (i = first; i != pastEnd; i = rbNext(realTree, i))
	  {
	    if (!i)
	      { // This could only be the result of a bad compare function.
		// We have hit the end of the list before hitting the expected
		// last element.
		break;
	      }
	    if (keyVarObj)
	      {
		if (!Tcl_ObjSetVar2(interp, keyVarObj, NULL, 
				    getKeyI(i),
				    TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1))
		  {
		    Tcl_DecrRefCount(lockedObject);
		    return TCL_ERROR;
		  }
	      }

	    {  // Do one step.
	      int result = Tcl_EvalObj(interp, bodyObj);
	      if (result == TCL_BREAK) { break; }
	      if ((result != TCL_OK) && (result != TCL_CONTINUE))
		{
		  Tcl_DecrRefCount(lockedObject);
		  return result;
		}
	    }
	  }

	Tcl_ResetResult(interp);
	Tcl_DecrRefCount(lockedObject);
	return TCL_OK;
      }
    case SET_KEYS:
      {
	if (objc != 3)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	Tcl_SetObjResult(interp, keysCmd(tree));
	return TCL_OK;
      }
    case SET_EMPTY:
      {
	if (objc != 3)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	Tcl_SetObjResult(interp, rbEmpty(tree->tree)?tclTrue:tclFalse);
	return TCL_OK;
      }
    case SET_COUNT:
      {
	if (objc != 3)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	Tcl_SetObjResult(interp, Tcl_NewIntObj(rbCount(tree->tree)));
	return TCL_OK;
      }
    }
  return TCL_OK;
}
  
static int tree_multiset_cmd(ClientData unused, 
			     Tcl_Interp *interp,
			     int objc,
			     Tcl_Obj *CONST objv[])
{
  static char const *options[] = 
  {
    "exists",    "insert",    "delete",    "foreach",    "keys",    
    "empty",    "count",    NULL
  };
  enum options 
  {
    MSET_EXISTS, MSET_INSERT, MSET_DELETE, MSET_FOREACH, MSET_KEYS, 
    MSET_EMPTY, MSET_COUNT
  };	  
  int index;
  struct tclRBTree *tree;

  if (objc < 2) {
    Tcl_WrongNumArgs(interp, 1, objv, "option var ?arg ...?");
    return TCL_ERROR;
  }

  if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
			  &index) != TCL_OK) {
    return TCL_ERROR;
  }

  switch (index)
    {
    case MSET_EXISTS:
      {
	Tcl_Obj *result;
	if (objc != 4)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 0);
	if (!tree) { return TCL_ERROR; }
	if (valueCmd(tree, objv[3], &result) == RBR_COMPARE_FAIL) 
	  { 
	    return TCL_ERROR;
	  }
	if (result)
	  { // Return the value.  This should be a count, which will be true
	    // unless the count is 0.
	    Tcl_SetObjResult(interp, result);
	  }
	else
	  { // No exact match was found.
	    Tcl_SetObjResult(interp, tclFalse);
	  }
	return TCL_OK;
      }
    case MSET_INSERT:
      {
	objTreeIterator i;
	if (objc != 4)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	switch (rbFind(tree->tree, objv[3], RBD_EXACT, &i))
	  {
	  case RBR_COMPARE_FAIL:
	    return TCL_ERROR;
	  case RBR_OTHER_FAIL:
	    // The element does not yet exist in the tree.
	    if (insertCmd(tree, objv[3], tclOne) != RBR_SUCCEED)
	      {
		return TCL_ERROR;
	      }
	    break;
	  case RBR_SUCCEED:
	    { // The element exists in the tree.  Increment it's count.
	      int previousCount;
	      makeValueUnique(&i->data);
	      if (Tcl_GetIntFromObj(interp, 
				    getValueI(i), 
				    &previousCount) != TCL_OK)
		{
		  return TCL_ERROR;
		}
	      Tcl_SetIntObj(getValueI(i), previousCount+1);
	    }
	  }
	return TCL_OK;
      }
    case MSET_DELETE:
      {
	objTreeIterator i;
	if (objc != 4)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	switch (rbFind(tree->tree, objv[3], RBD_EXACT, &i))
	  {
	  case RBR_COMPARE_FAIL:
	    return TCL_ERROR;
	  case RBR_OTHER_FAIL:
	    // The element does not exist in the tree.
	    Tcl_SetObjResult(interp, tclFalse);
	    break;
	  case RBR_SUCCEED:
	    { // The element exists in the tree.
	      int previousCount;
	      if (Tcl_GetIntFromObj(interp, 
				    getValueI(i), 
				    &previousCount) != TCL_OK)
		{
		  return TCL_ERROR;
		}
	      if (previousCount > 1)
		{ // At least one will be left, so decrement the counter.
		  makeValueUnique(&i->data);
		  Tcl_SetIntObj(getValueI(i), previousCount-1);
		  Tcl_SetObjResult(interp, tclTrue);
		}
	      else
		{ // None are left, so remove the entry from the tree 
		  // completely.
		  rbRemoveNode(tree->tree, i);
		  if (previousCount > 0)
		    { // There was one element, which we successfully deleted.
		      Tcl_SetObjResult(interp, tclTrue);
		    }
		  else
		    { // It's tempting not to even deal with this case.  This
		      // would only happen if someone other than TREE::MSET
		      // manipulated the tree.  If the element appears to have
		      // a count of 0 or less, the delete fails, but we still
		      // remove the entry.
		      Tcl_SetObjResult(interp, tclFalse);
		    }
		}
	    }
	  }
	return TCL_OK;
      }
    case MSET_FOREACH:
      {
	Tcl_Obj *keyVarObj, *fromObj, *toObj, *bodyObj;
	Tcl_Obj *lockedObject = NULL;
	objTree *realTree;

	// first points to the first item in the tree that we plan to 
	// execute.  pastEnd points to the first item after the last item
	// we plan to execute.  If these are the same, we don't go through
	// the loop at all.  We never execute pastEnd, but we often execute
	// first.  i is the current item.
	objTreeIterator first;
	objTreeIterator pastEnd;
        objTreeIterator i;

	if ((objc != 5) && (objc != 7))
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, 
			     "var key_var ?from to? body");
	    return TCL_ERROR;
	  }

	keyVarObj = emptyAsNull(objv[3]);

	if (objc == 5)
	  {
	    fromObj = NULL;
	    toObj = NULL;
	    bodyObj = objv[4];
	  }
	else
	  { 
	    fromObj = objv[4];
	    toObj = objv[5];
	    bodyObj = objv[6];
	  }

	lockedObject = getTreeObj(interp, objv[2], &tree, &realTree);
	if (!lockedObject) { return TCL_ERROR; }
	Tcl_IncrRefCount(lockedObject);

	if (!foreachLimits(fromObj, toObj, realTree, &first, &pastEnd))
	  {
	    Tcl_DecrRefCount(lockedObject);
	    return TCL_ERROR;
	  }

	for (i = first; i != pastEnd; i = rbNext(realTree, i))
	  {
	    int duplicates;

	    if (!i)
	      { // This could only be the result of a bad compare function.
		// We have hit the end of the list before hitting the expected
		// last element.
		break;
	      }

	    // Need to find the number of identical keys.
	    if (Tcl_GetIntFromObj(interp,
				  getValueI(i), 
				  &duplicates) != TCL_OK)
	      {
		Tcl_DecrRefCount(lockedObject);
		return TCL_ERROR;
	      }
	    
	    for (;duplicates > 0; duplicates--)
	      {
		int result;
		if (keyVarObj)
		  {
		    if (!Tcl_ObjSetVar2(interp, keyVarObj, NULL, 
					getKeyI(i),
					TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1))
		      {
			Tcl_DecrRefCount(lockedObject);
			return TCL_ERROR;
		      }
		  }
		result = Tcl_EvalObj(interp, bodyObj);
		if (result == TCL_BREAK) { goto break_from_effective_loop; }
		if ((result != TCL_OK) && (result != TCL_CONTINUE))
		  {
		    Tcl_DecrRefCount(lockedObject);
		    return result;
		  }
	      }
	  }
	// The two C++ for loops make one appearent foreach loop.  Break
	// jumps out of the foreach, and therefore out of both fors.
      break_from_effective_loop:

	Tcl_ResetResult(interp);
	Tcl_DecrRefCount(lockedObject);
	return TCL_OK;
      }
    case MSET_KEYS:
      {
	objTree *realTree;
	Tcl_Obj *result = NULL;
	objTreeIterator i;
	if (objc != 3)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 0);
	if (!tree) { return TCL_ERROR; }
	realTree = tree->tree;
	result = Tcl_NewObj();
	Tcl_IncrRefCount(result);
	for (i = rbFirst(realTree); i; i = rbNext(realTree, i))
	  {
	    // Need to find the key...
	    Tcl_Obj *key = getKeyI(i);

	    // ...and the number of identical keys.
	    int duplicates;
	    if (Tcl_GetIntFromObj(interp,
				  getValueI(i), 
				  &duplicates) != TCL_OK)
	      {
		Tcl_DecrRefCount(result);
		return TCL_ERROR;
	      }
	    
	    for (;duplicates > 0; duplicates--)
	      {
		Tcl_ListObjAppendElement(NULL, result, key);
	      }
	  }
	Tcl_SetObjResult(interp, result);
	Tcl_DecrRefCount(result);
	return TCL_OK;
      }
    case MSET_EMPTY:
      {
        if (objc != 3)
          {
            Tcl_WrongNumArgs(interp, 2, objv, "var");
            return TCL_ERROR;
          }
        tree = getTree(interp, objv[2], 1);
        if (!tree) { return TCL_ERROR; }
        Tcl_SetObjResult(interp, rbEmpty(tree->tree)?tclTrue:tclFalse);
        return TCL_OK;
      }
    case MSET_COUNT:
      {
        objTree *realTree;
        objTreeIterator i;
	long totalCount = 0;
	if (objc != 3)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	realTree = tree->tree;
        for (i = rbFirst(realTree); i; i = rbNext(realTree, i))
          {
	    Tcl_Obj *value = getValueI(i);
	    long itemCount;
	    if (Tcl_GetLongFromObj(interp, value, &itemCount) != TCL_OK)
	      {
		Tcl_Obj *key = getKeyI(i);
		int keyLength;
		char *keyValue = Tcl_GetStringFromObj(key, &keyLength);
		Tcl_AddErrorInfo(interp, "\n    while inspecting key\n\"");
		Tcl_AddObjErrorInfo(interp, keyValue, keyLength);
		Tcl_AddErrorInfo(interp, "\"");
		return TCL_ERROR;
	      }
	    totalCount += itemCount;
	  }
	Tcl_SetObjResult(interp, Tcl_NewLongObj(totalCount));
	return TCL_OK;
      }
    }
  return TCL_OK;
}
  
static int tree_map_cmd(ClientData unused, 
			Tcl_Interp *interp,
			int objc,
			Tcl_Obj *CONST objv[]) 
{
  static char const*options[] = 
  {
    "exists",   "insert",   "delete",   "foreach",   "keys",   "data", 
    "value",   "empty",   "count",   NULL
  };
  enum options 
  {
    MAP_EXISTS, MAP_INSERT, MAP_DELETE, MAP_FOREACH, MAP_KEYS, MAP_DATA, 
    MAP_VALUE, MAP_EMPTY, MAP_COUNT,
  };	  
  int index;

  struct tclRBTree *tree;

  if (objc < 2) {
    Tcl_WrongNumArgs(interp, 1, objv, "option var ?arg ...?");
    return TCL_ERROR;
  }
  
  if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
			  &index) != TCL_OK) {
    return TCL_ERROR;
  }

  switch (index)
    {
    case MAP_EXISTS:
      {
	if (objc != 4)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 0);
	if (!tree) { return TCL_ERROR; }
	switch (rbExists(tree->tree, objv[3]))
	  {
	  case RBR_SUCCEED:
	    // Item Found!
	    Tcl_SetObjResult(interp, tclTrue);
	    return TCL_OK;
	  case RBR_OTHER_FAIL:
	    // Item not found!
	    Tcl_SetObjResult(interp, tclFalse);
	    return TCL_OK;
	  default:
	    // Error in search!  Bad data?  Assume result was set when error
	    // was found.
	    return TCL_ERROR;
	  }
      }
    case MAP_INSERT:
      {
	if (objc != 5)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key data");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	return (insertCmd(tree, objv[3], objv[4]) == RBR_SUCCEED)
	  ?TCL_OK:TCL_ERROR;
      }
    case MAP_DELETE:
      {
	if (objc != 4)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	switch (rbRemove(tree->tree, objv[3]))
	  {
	  case RBR_SUCCEED:
	    // Item Found and deleted.
	    Tcl_SetObjResult(interp, tclTrue);
	    return TCL_OK;
	  case RBR_OTHER_FAIL:
	    // Item not found; tree not modified.
	    Tcl_SetObjResult(interp, tclFalse);
	    return TCL_OK;
	  default:
	    // Error in search!  Bad data?  Assume result was set when error
	    // was found.
	    return TCL_ERROR;
	  }
      }
    case MAP_FOREACH:
      {
	Tcl_Obj *keyVarObj, *dataVarObj, *fromObj, *toObj, *bodyObj;
	Tcl_Obj *lockedObject = NULL;
	objTree *realTree;

	// first points to the first item in the tree that we plan to 
	// execute.  pastEnd points to the first item after the last item
	// we plan to execute.  If these are the same, we don't go through
	// the loop at all.  We never execute pastEnd, but we often execute
	// first.  i is the current item.
	objTreeIterator first;
	objTreeIterator pastEnd;
        objTreeIterator i;

	if ((objc != 6) && (objc != 8))
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, 
			     "var key_var data_var ?from to? body");
	    return TCL_ERROR;
	  }

	keyVarObj = emptyAsNull(objv[3]);
	dataVarObj = emptyAsNull(objv[4]);

	if (objc == 6)
	  {
	    fromObj = NULL;
	    toObj = NULL;
	    bodyObj = objv[5];
	  }
	else
	  { 
	    fromObj = objv[5];
	    toObj = objv[6];
	    bodyObj = objv[7];
	  }

	lockedObject = getTreeObj(interp, objv[2], &tree, &realTree);
	if (!lockedObject) { return TCL_ERROR; }
	Tcl_IncrRefCount(lockedObject);

	if (!foreachLimits(fromObj, toObj, realTree, &first, &pastEnd))
	  {
	    Tcl_DecrRefCount(lockedObject);
	    return TCL_ERROR;
	  }

	for (i = first; i != pastEnd; i = rbNext(realTree, i))
	  {
	    if (!i)
	      { // This could only be the result of a bad compare function.
		// We have hit the end of the list before hitting the expected
		// last element.
		break;
	      }
	    if (keyVarObj)
	      {
		if (!Tcl_ObjSetVar2(interp, keyVarObj, NULL, 
				    getKeyI(i),
				    TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1))
		  {
		    Tcl_DecrRefCount(lockedObject);
		    return TCL_ERROR;
		  }
	      }
	    if (dataVarObj)
	      {
		if (!Tcl_ObjSetVar2(interp, dataVarObj, NULL, 
				    getValueI(i),
				    TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1))
		  {
		    Tcl_DecrRefCount(lockedObject);
		    return TCL_ERROR;
		  }
	      }

	    {  // Do one step.
	      int result = Tcl_EvalObj(interp, bodyObj);
	      if (result == TCL_BREAK) { break; }
	      if ((result != TCL_OK) && (result != TCL_CONTINUE))
		{
		  Tcl_DecrRefCount(lockedObject);
		  return result;
		}
	    }
	  }

	Tcl_ResetResult(interp);
	Tcl_DecrRefCount(lockedObject);
	return TCL_OK;
      }
    case MAP_KEYS:
      {
	if (objc != 3)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	Tcl_SetObjResult(interp, keysCmd(tree));
	return TCL_OK;
      }
    case MAP_DATA:
      {
	Tcl_Obj *result;
	objTreeIterator i;
	if (objc != 3)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	result = Tcl_NewObj();
	for (i = rbFirst(tree->tree); 
	     i; 
	     i = rbNext(tree->tree, i))
	  {
	    Tcl_ListObjAppendElement(NULL, result, getValueI(i));
	  }
	Tcl_SetObjResult(interp, result);
	return TCL_OK;
      }
    case MAP_VALUE:
      {
	Tcl_Obj *result;
	if ((objc < 4) || (objc > 5))
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key ?error_value?");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 0);
	if (!tree) { return TCL_ERROR; }
	if (valueCmd(tree, objv[3], &result) == RBR_COMPARE_FAIL) 
	  { 
	    return TCL_ERROR;
	  }
	if (result)
	  { // Found!
	    Tcl_SetObjResult(interp, result);
	    return TCL_OK;
	  }
	else
	  { // Not found in tree.
	    if (objc == 5)
	      { // Use default.
		Tcl_SetObjResult(interp, objv[4]);
		return TCL_OK;
	      }
	    else
	      { // Signal an error.
		Tcl_AppendResult(interp, "No such element in tree.", NULL);
		return TCL_ERROR;
	      }
	  }
      }
    case MAP_EMPTY:
      {
        if (objc != 3)
          {
            Tcl_WrongNumArgs(interp, 2, objv, "var");
            return TCL_ERROR;
          }
        tree = getTree(interp, objv[2], 1);
        if (!tree) { return TCL_ERROR; }
        Tcl_SetObjResult(interp, rbEmpty(tree->tree)?tclTrue:tclFalse);
        return TCL_OK;
      }
    case MAP_COUNT:
      {
        if (objc != 3)
          {
            Tcl_WrongNumArgs(interp, 2, objv, "var");
            return TCL_ERROR;
          }
        tree = getTree(interp, objv[2], 1);
        if (!tree) { return TCL_ERROR; }
        Tcl_SetObjResult(interp, Tcl_NewIntObj(rbCount(tree->tree)));
	return TCL_OK;
      }
    }
  return TCL_OK;
}

static int tree_multimap_cmd(ClientData unused, 
			     Tcl_Interp *interp,
			     int objc,
			     Tcl_Obj *CONST objv[])
{
  static char const *options[] = 
  {
    "exists",    "insert",    "delete",    "foreach",    "keys",    "data", 
    "value",    "empty",    "count",    NULL
  };
  enum options 
  {
    MMAP_EXISTS, MMAP_INSERT, MMAP_DELETE, MMAP_FOREACH, MMAP_KEYS, MMAP_DATA,
    MMAP_VALUE, MMAP_EMPTY, MMAP_COUNT
  };
  int index;
  struct tclRBTree *tree;

  if (objc < 2) {
    Tcl_WrongNumArgs(interp, 1, objv, "option var ?arg ...?");
    return TCL_ERROR;
  }

  if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
			  &index) != TCL_OK) {
    return TCL_ERROR;
  }

  switch (index)
    {
    case MMAP_EXISTS:
      {
	Tcl_Obj *value;
	if (objc != 4)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 0);
	if (!tree) { return TCL_ERROR; }
	if (valueCmd(tree, objv[3], &value) == RBR_COMPARE_FAIL)
	  {
	    return TCL_ERROR;
	  }
	if (value)
	  { // We found a list of things.  Return the number of things, which
	    // will be true unless the list is empty.
	    int count;
	    if (Tcl_ListObjLength(interp, value, &count) != TCL_OK)
	      { // It was not a valid list!
		return TCL_ERROR;
	      }
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(count));
	  }
	else
	  { // No match found.
	    Tcl_SetObjResult(interp, tclFalse);
	  }
	return TCL_OK;
      }
    case MMAP_INSERT:
      {
	objTreeIterator i;
	if (objc != 5)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key data");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	switch (rbFind(tree->tree, objv[3], RBD_EXACT, &i))
	  {
	  case RBR_COMPARE_FAIL:
	    return TCL_ERROR;
	  case RBR_OTHER_FAIL:
	    { // The key does not yet exist in the tree.
	      Tcl_Obj *newValue = Tcl_NewListObj(1, &objv[4]);
	      Tcl_IncrRefCount(newValue);
	      if (insertCmd(tree, objv[3], newValue) != RBR_SUCCEED)
		{
		  Tcl_DecrRefCount(newValue);
		  return TCL_ERROR;
		}
	      Tcl_DecrRefCount(newValue);
	      break;
	    }
	  case RBR_SUCCEED:
	    { // The key exists in the tree.  Add the new value.
	      makeValueUnique(&i->data);
	      if (Tcl_ListObjAppendElement(interp,
					   getValueI(i),
					   objv[4]) != TCL_OK)
		{
		  return TCL_ERROR;
		}
	    }
	  }
	return TCL_OK;
      }
    case MMAP_DELETE:
      {
	objTreeIterator i;
	if (objc != 4)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	switch (rbFind(tree->tree, objv[3], RBD_EXACT, &i))
	  {
	  case RBR_COMPARE_FAIL:
	    return TCL_ERROR;
	  case RBR_OTHER_FAIL:
	    // The element does not exist in the tree.
	    Tcl_SetObjResult(interp, tclFalse);
	    break;
	  case RBR_SUCCEED:
	    { // The element exists in the tree.
	      int previousLength;
	      if (Tcl_ListObjLength(interp, 
				    getValueI(i), 
				    &previousLength) != TCL_OK)
		{
		  return TCL_ERROR;
		}
	      if (previousLength > 1)
		{ // At least one will be left, so just remove the last one.
		  makeValueUnique(&i->data);
		  Tcl_ListObjReplace(NULL, getValueI(i), 
				     previousLength - 1, 
				     1, 0, NULL);
		  Tcl_SetObjResult(interp, tclTrue);
		}
	      else
		{ // None are left, so remove the entry completely.
		  rbRemoveNode(tree->tree, i);
		  if (previousLength > 0)
		    { // There was one element, which we successfully deleted.
		      Tcl_SetObjResult(interp, tclTrue);
		    }
		  else
		    { // It's tempting not to even deal with this case.  This
		      // would only happen if someone other than TREE::MMAP
		      // manipulated the tree.  If the element appears to map
		      // to an empty list, the delete fails, but we still
		      // remove the entry.
		      Tcl_SetObjResult(interp, tclFalse);
		    }
		}
	    }
	  }
	return TCL_OK;
      }
    case MMAP_FOREACH:
      {
	Tcl_Obj *keyVarObj, *valueVarObj, *fromObj, *toObj, *bodyObj;
	Tcl_Obj *lockedObject = NULL;
	objTree *realTree;

	// first points to the first item in the tree that we plan to 
	// execute.  pastEnd points to the first item after the last item
	// we plan to execute.  If these are the same, we don't go through
	// the loop at all.  We never execute pastEnd, but we often execute
	// first.  i is the current item.
	objTreeIterator first;
	objTreeIterator pastEnd;
        objTreeIterator i;

	if ((objc != 6) && (objc != 8))
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, 
			     "var key_var ?from to? body");
	    return TCL_ERROR;
	  }

	keyVarObj = emptyAsNull(objv[3]);
	valueVarObj = emptyAsNull(objv[4]);

	if (objc == 6)
	  {
	    fromObj = NULL;
	    toObj = NULL;
	    bodyObj = objv[5];
	  }
	else
	  { 
	    fromObj = objv[5];
	    toObj = objv[6];
	    bodyObj = objv[7];
	  }

	lockedObject = getTreeObj(interp, objv[2], &tree, &realTree);
	if (!lockedObject) { return TCL_ERROR; }
	Tcl_IncrRefCount(lockedObject);

	if (!foreachLimits(fromObj, toObj, realTree, &first, &pastEnd))
	  {
	    Tcl_DecrRefCount(lockedObject);
	    return TCL_ERROR;
	  }

	for (i = first; i != pastEnd; i = rbNext(realTree, i))
	  {
	    Tcl_Obj *key, *values;
	    int valueCount, j;

	    if (!i)
	      { // This could only be the result of a bad compare function.
		// We have hit the end of the list before hitting the expected
		// last element.
		break;
	      }

	    // Save the key and the list of values, just for clarity.  Assume
	    // we already have a locked copy of each, based on having a locked
	    // copy of the parent structure.
	    key = getKeyI(i);
	    values = getValueI(i);

	    // Need to find the number of data items associated with this key.
	    if (Tcl_ListObjLength(interp,
				  getValueI(i), 
				  &valueCount) != TCL_OK)
	      {
		Tcl_DecrRefCount(lockedObject);
		return TCL_ERROR;
	      }
	    
	    for (j = 0;j < valueCount; j++)
	      {
		int result;
		if (keyVarObj)
		  {
		    if (!Tcl_ObjSetVar2(interp, keyVarObj, NULL, key,
					TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1))
		      {
			Tcl_DecrRefCount(lockedObject);
			return TCL_ERROR;
		      }
		  }
		if (valueVarObj)
		  { // Do a Tcl_ListObjIndex each time, rather than a
		    // Tcl_ListObjGetElements once, because the internal form
		    // of the list can change, even though it is locked, each
		    // time we execute arbitrary code.  We should not be able
		    // to get an error here, since we had a valid list above,
		    // but once we've gone this far the assertion doesn't cost
		    // us much.
		    Tcl_Obj *nextValue;
		    if (Tcl_ListObjIndex(interp, values, j, &nextValue) 
			!= TCL_OK)
		      {
			Tcl_DecrRefCount(lockedObject);
			return TCL_ERROR;
		      }
		    if (!Tcl_ObjSetVar2(interp, valueVarObj, NULL, 
					nextValue,
					TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1))
		      {
			// nextValue has at least one reference count, from
			// the list of values, so we don't need to worry about 
			// garbage collection.  However, I wouldn't try to
			// it after the Tcl_EvalObj.
			Tcl_DecrRefCount(lockedObject);
			return TCL_ERROR;
		      }
		  }
		result = Tcl_EvalObj(interp, bodyObj);
		if (result == TCL_BREAK) { goto break_from_effective_loop; }
		if ((result != TCL_OK) && (result != TCL_CONTINUE))
		  {
		    Tcl_DecrRefCount(lockedObject);
		    return result;
		  }
	      }
	  }
	// The two C++ for loops make one appearent foreach loop.  Break
	// jumps out of the foreach, and therefore out of both fors.
      break_from_effective_loop:

	Tcl_ResetResult(interp);
	Tcl_DecrRefCount(lockedObject);
	return TCL_OK;
      }
    case MMAP_KEYS:
      {
	objTree *realTree;
	Tcl_Obj *result = NULL;
	objTreeIterator i;
	if (objc != 3)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 0);
	if (!tree) { return TCL_ERROR; }
	realTree = tree->tree;
	result = Tcl_NewObj();
	Tcl_IncrRefCount(result);
	for (i = rbFirst(realTree); i; i = rbNext(realTree, i))
	  {
	    // Need to find the key...
	    Tcl_Obj *key = getKeyI(i);

	    // ...and the number of identical keys.
	    int duplicates;
	    if (Tcl_ListObjLength(interp,
				  getValueI(i), 
				  &duplicates) != TCL_OK)
	      {
		Tcl_DecrRefCount(result);
		return TCL_ERROR;
	      }
	    
	    for (;duplicates > 0; duplicates--)
	      {
		Tcl_ListObjAppendElement(NULL, result, key);
	      }
	  }
	Tcl_SetObjResult(interp, result);
	Tcl_DecrRefCount(result);
	return TCL_OK;
      }
    case MMAP_DATA:
      {
	Tcl_Obj *result;
	objTreeIterator i;
	if (objc != 3)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	result = Tcl_NewObj();
	for (i = rbFirst(tree->tree); 
	     i; 
	     i = rbNext(tree->tree, i))
	  {
	    Tcl_ListObjAppendList(NULL, result, getValueI(i));
	  }
	Tcl_SetObjResult(interp, result);
	return TCL_OK;
      }
    case MMAP_VALUE:
      {
	Tcl_Obj *found;
	if ((objc < 4) || (objc > 5))
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var key ?error_value?");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 0);
	if (!tree) { return TCL_ERROR; }
	if (valueCmd(tree, objv[3], &found) == RBR_COMPARE_FAIL) 
	  { 
	    return TCL_ERROR;
	  }
	if (found)
	  { // Found!
	    int count;
	    if (Tcl_ListObjLength(interp, found, &count)
		!= TCL_OK) 
	      {
		return TCL_ERROR;
	      }
	    if (count)
	      { // This should always be the case, unless someone has modified
		// the tree by other means.  With this if we let a key mapping
		// to the empty list look like a non-existant key.
		Tcl_Obj *result;
		Tcl_ListObjIndex(NULL,  
				 found, 
				 count - 1,
				 &result);
		Tcl_SetObjResult(interp, result);
		return TCL_OK;
	      }
	  }
	// Not found in tree.
	if (objc == 5)
	  { // Use default.
	    Tcl_SetObjResult(interp, objv[4]);
	    return TCL_OK;
	  }
	else
	  { // Signal an error.
	    Tcl_AppendResult(interp, "No such element in tree.", NULL);
	    return TCL_ERROR;
	  }
      }    
    case MMAP_EMPTY:
      {
        if (objc != 3)
          {
            Tcl_WrongNumArgs(interp, 2, objv, "var");
            return TCL_ERROR;
          }
        tree = getTree(interp, objv[2], 1);
        if (!tree) { return TCL_ERROR; }
        Tcl_SetObjResult(interp, rbEmpty(tree->tree)?tclTrue:tclFalse);
        return TCL_OK;
      }
   case MMAP_COUNT:
      {
        objTree *realTree;
        objTreeIterator i;
	long totalCount = 0;
	if (objc != 3)
	  {
	    Tcl_WrongNumArgs(interp, 2, objv, "var");
	    return TCL_ERROR;
	  }
	tree = getTree(interp, objv[2], 1);
	if (!tree) { return TCL_ERROR; }
	realTree = tree->tree;
        for (i = rbFirst(realTree); i; i = rbNext(realTree, i))
          {
	    int itemCount;
            if (Tcl_ListObjLength(interp,
                                  getValueI(i),
                                  &itemCount) != TCL_OK)
	      {
		Tcl_Obj *key = getKeyI(i);
		int keyLength;
		char *keyValue = Tcl_GetStringFromObj(key, &keyLength);
		Tcl_AddErrorInfo(interp, "\n    while inspecting key\n\"");
		Tcl_AddObjErrorInfo(interp, keyValue, keyLength);
		Tcl_AddErrorInfo(interp, "\"");
		return TCL_ERROR;
	      }
	    totalCount += itemCount;
	  }
	Tcl_SetObjResult(interp, Tcl_NewLongObj(totalCount));
	return TCL_OK;
      }
    }
  return TCL_OK;
}

static int tree_find_cmd(ClientData unused, 
			 Tcl_Interp *interp,
			 int objc,
			 Tcl_Obj *CONST objv[]) 
{
  static char const *options[] = 
  {
    "-",	"<",	"<=",   "==",
    ">=",	">",	"+",	NULL
  };
  enum options 
  {
    FIND_MIN, FIND_LESS, FIND_AT_MOST, FIND_EXACT,
    FIND_AT_LEAST, FIND_GREATER, FIND_MAX
  };	  
  int index;
  struct tclRBTree *tree;
  objTreeIterator result = NULL;
  Tcl_Obj *errorValue = NULL;

  if (objc < 3) 
    {
      Tcl_WrongNumArgs(interp, 1, objv, "option var ?arg ...?");
      return TCL_ERROR;
    }

  if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
			  &index) != TCL_OK) {
    return TCL_ERROR;
  }

  tree = getTree(interp, objv[2], 0);
  if (!tree) { return TCL_ERROR; }

  if ((index == FIND_MIN) || (index == FIND_MAX))
    {
      if ((objc < 3) || (objc > 4))
	{
	  Tcl_WrongNumArgs(interp, 2, objv, "var ?error_value?");
	  return TCL_ERROR;
	}
      if (objc == 4) 
	{
	  errorValue = objv[3];
	}
      if (index == FIND_MIN)
	{
	  result = rbFirst(tree->tree);
	}
      else
	{
	  result = rbLast(tree->tree);
	}
    }
  else
    {
      enum rbDirectionType dir;

      if ((objc < 4) || (objc > 5))
	{
	  Tcl_WrongNumArgs(interp, 2, objv, "var key ?error_value?");
	  return TCL_ERROR;
	}

      switch (index)
	{
	case FIND_LESS:
	case FIND_AT_LEAST:
	  dir = RBD_AFTER;
	  break;
	case FIND_GREATER:
	case FIND_AT_MOST:
	  dir = RBD_BEFORE;
	  break;
	default:
	  dir = RBD_EXACT;
	  break;
	}
      if (rbFind(tree->tree, objv[3], dir, &result) == RBR_COMPARE_FAIL)
	{
	  return TCL_ERROR;
	}
      switch (index)
	{
	case FIND_LESS:
	  result = rbPrev(tree->tree, result);
	  break;
	case FIND_GREATER:
	  result = rbNext(tree->tree, result);
	  break;
	}

      if (objc == 5) 
	{
	  errorValue = objv[4];
	}
    }

  if (result)
    {
      Tcl_SetObjResult(interp, getKeyI(result));
    }
  else if (errorValue)
    {
      Tcl_SetObjResult(interp, errorValue);
    }
  else
    {
      Tcl_AppendResult(interp, "No such element in tree.", NULL);
      return TCL_ERROR;
    }

  return TCL_OK;
}

//--------------------------------------------------------------------------
// Initialization funciton.
//--------------------------------------------------------------------------


#ifdef MS_VC
#define DLL_EXPORT __declspec(dllexport)
#else
#define DLL_EXPORT
#endif 

DLL_EXPORT int Rbtree_Init(Tcl_Interp *interp)
{
#ifdef USE_TCL_STUBS 
  if (Tcl_InitStubs(interp, "8.1", 0) == NULL) 
    { 
      return TCL_ERROR; 
    } 
#endif

  Tcl_PkgProvide(interp, "RBTree", "1.2.0");

  if (!tclTrue)
    { // Do this once per thread.
      tclTrue = Tcl_NewIntObj(1);
      Tcl_IncrRefCount(tclTrue);
      tclFalse = Tcl_NewIntObj(0);
      Tcl_IncrRefCount(tclFalse);
    }

  Tcl_CreateObjCommand(interp, "tree::create", tree_create_cmd, NULL, NULL);
  Tcl_CreateObjCommand(interp, "tree::previous", 
		       tree_previous_cmd, NULL, NULL);
  Tcl_CreateObjCommand(interp, "tree::next", tree_next_cmd, NULL, NULL);
  Tcl_CreateObjCommand(interp, "tree::closest", tree_closest_cmd, NULL, NULL);
  Tcl_CreateObjCommand(interp, "tree::map", tree_map_cmd, NULL, NULL);
  Tcl_CreateObjCommand(interp, "tree::set", tree_set_cmd, NULL, NULL);
  Tcl_CreateObjCommand(interp, "tree::multiset",
		       tree_multiset_cmd, NULL, NULL);
  Tcl_CreateObjCommand(interp, "tree::multimap", 
		       tree_multimap_cmd, NULL, NULL);
  Tcl_CreateObjCommand(interp, "tree::find", 
		       tree_find_cmd, NULL, NULL);

  Tcl_RegisterObjType(&treeType);
  return TCL_OK;
}