// mk4tcl.cpp --
// $Id: mk4tcl.cpp,v 1.58 2004/01/26 09:54:45 jcw Exp $
// This is part of Metakit, see http://www.equi4.com/metakit/

#include "mk4tcl.h"
#include "mk4io.h"

#if MKSQL
#include "mksql.h"
#endif

#ifndef _WIN32_WCE
#include <errno.h>
#endif

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

#ifndef EINVAL
#define EINVAL 9
#endif

// stub interface code, removes the need to link with libtclstub*.a
#ifdef USE_TCL_STUBS
#include "stubtcl.h"
#else
#define MyInitStubs(x) 1
#endif

///////////////////////////////////////////////////////////////////////////////
// Defined in this file:

  class MkPath;
  class MkWorkspace;
  class Tcl;
    class MkTcl;

///////////////////////////////////////////////////////////////////////////////

    // inc'ed whenever a datafile is closed, forces relookup of all paths
  static int generation;
    
  TCL_DECLARE_MUTEX(mkMutex)  // use a single monolithic mutex for now

    // put code in this file as a mutex is static in Windows
  int Mk_EvalObj(Tcl_Interp* ip_, Tcl_Obj* cmd_)
  {
    Tcl_MutexUnlock(&mkMutex);
    int e = Tcl_EvalObj(ip_, cmd_);
    Tcl_MutexLock(&mkMutex);
    return e;
  }

  // moved out of member func scope to please HP-UX's aCC:
  
  static const char* getCmds [] =
  {
    "-size",
    0
  };

  static const char* viewCmds [] =
  {
    "layout",
    "delete",
    "size",
    "properties",
    "locate",
    "restrict",
    "open",
    "new",
    "info",
    0
  };

  static const char* cursorCmds [] =
  {
    "create",
    "position",
    "incr",
    0
  };
 
  static const char* channelCmds [] =
  {
    "read",
    "write",
    "append",
    0
  };

/////////////////////////////////////////////////////////////////////////////
// Utility code: return next token up to char < '0', and
// advance the string pointer past following character.

c4_String f4_GetToken(const char*& str_)
{
  d4_assert(str_);

  const char* p = str_;
  while (*p >= '0')
    ++p;

  c4_String result (str_, p - str_);

  if (*p)
    ++p;
  str_ = p;

  return result;
}

///////////////////////////////////////////////////////////////////////////////
// Utility code: true if value contains a word starting with the given prefix

bool MatchOneKeyword(const char* value_, const c4_String& crit_)
{
  int n = crit_.GetLength();
  if (n == 0)
    return true;

  char cu = (char) toupper(crit_[0]);
  char cl = (char) tolower(crit_[0]);

  while (*value_)
  {
    c4_String s (value_, n);
    if (s.CompareNoCase(crit_) == 0)
      return true;

    while (*++value_)
      if ((*value_ == cu || *value_ == cl) && !isalnum(value_[-1]))
        break;
  }

  return false;
}

///////////////////////////////////////////////////////////////////////////////
// A "storage in a storage" strategy class for Metakit
// Adapted from MkWrap, the Python interface

class SiasStrategy : public c4_Strategy
{
public:
  c4_Storage _storage;
  c4_View _view;
  c4_BytesProp _memo;
  int _row;
  t4_i32 _position;
  Tcl_Channel _chan;
  int _validMask;
  int _watchMask;
  Tcl_Interp* _interp;

  SiasStrategy (c4_Storage& storage_, 
          const c4_View& view_, const c4_BytesProp& memo_, int row_)
    : _storage (storage_), _view (view_), _memo (memo_), _row (row_),
      _position (0), _interp (0)
  {
      // set up mapping if the memo itself is mapped in its entirety
    c4_Strategy& strat = storage_.Strategy();
    if (strat._mapStart != 0) {
      c4_RowRef r = _view[_row];
      c4_Bytes data = _memo(r).Access(0);
      const t4_byte* ptr = data.Contents();
      if (data.Size() == _memo(r).GetSize() && strat._mapStart != 0 &&
        ptr >= strat._mapStart && ptr - strat._mapStart < strat._dataSize)
      {
        _mapStart = ptr;
        _dataSize = data.Size();
      }
    }
  }

  virtual ~SiasStrategy ()
  {
    _view = c4_View();
    _mapStart = 0;
    _dataSize = 0;

    if (_chan != 0)
      Tcl_UnregisterChannel(_interp, _chan);
  }

  virtual void DataSeek(t4_i32 position_)
  {
    _position = position_;
  }

  virtual int DataRead(t4_i32 pos_, void* buffer_, int length_)
  {
    if (pos_ != ~0)
      _position = pos_;

    int i = 0;

    while (i < length_)
    {
      c4_Bytes data = _memo(_view[_row]).Access(_position + i, length_ - i);
      int n = data.Size();
      if (n <= 0)
        break;
      memcpy((char*) buffer_ + i, data.Contents(), n);
      i += n;
    }

    _position += i;
    return i;
  }

  virtual void DataWrite(t4_i32 pos_, const void* buffer_, int length_)
  {
    if (pos_ != ~0)
      _position = pos_;

    c4_Bytes data (buffer_, length_);
    if (_memo(_view[_row]).Modify(data, _position))
      _position += length_;
    else
      ++_failure;
  }

  virtual void DataCommit(t4_i32 newSize_)
  {
    if (newSize_ > 0)
      _memo(_view[_row]).Modify(c4_Bytes (), newSize_);
  }

  virtual void ResetFileMapping()
  {
    _mapStart = 0; // never called, but just in case
  }
};

///////////////////////////////////////////////////////////////////////////////
// New in 1.2: channel interface to memo fields

typedef SiasStrategy MkChannel;

typedef struct {
  Tcl_Event header;
  MkChannel *chan;
} MkEvent;

static int
mkEventProc(Tcl_Event *evPtr, int flags)
{
  MkEvent *me = (MkEvent*)evPtr;

  if (!(flags & TCL_FILE_EVENTS))
    return 0;

  Tcl_NotifyChannel(me->chan->_chan, me->chan->_watchMask);
  return 1;
}

static void
mkCheckProc(ClientData instanceData, int flags)
{
  MkChannel* chan = (MkChannel*) instanceData;

  if (!(flags & TCL_FILE_EVENTS))
    return;

  MkEvent *evPtr = (MkEvent*)Tcl_Alloc(sizeof(MkEvent));
  evPtr->header.proc = mkEventProc;
  evPtr->chan = chan;

  Tcl_QueueEvent( (Tcl_Event*)evPtr, TCL_QUEUE_TAIL);
}

static void
mkSetupProc(ClientData instanceData, int flags)
{
  MkChannel* chan = (MkChannel*) instanceData;
  Tcl_Time blockTime = { 0, 0};

  if (!(flags & TCL_FILE_EVENTS))
    return;

  if (chan->_watchMask)
    Tcl_SetMaxBlockTime(&blockTime);
}

static int
mkEventFilter( Tcl_Event *evPtr, ClientData instanceData)
{
  MkEvent* me = (MkEvent*) evPtr;
  MkChannel* chan = (MkChannel*) instanceData;
  return evPtr->proc == mkEventProc && me->chan == chan;
}

static int
mkClose (ClientData instanceData, Tcl_Interp* interp)
{
  MkChannel* chan = (MkChannel*) instanceData;

//  Tcl_DeleteEventSource(mkSetupProc, mkCheckProc, (ClientData) chan);
  Tcl_DeleteEvents(mkEventFilter, (ClientData) chan);
  delete chan;

  return TCL_OK;
}

static int
mkInput (ClientData instanceData, char* buf, int toRead, int* errorCodePtr)
{
  MkChannel* chan = (MkChannel*) instanceData;
  return chan->DataRead(~0, buf, toRead);
}

static int
mkOutput (ClientData instanceData, const char* buf, int toWrite, int* errorCodePtr)
{
  MkChannel* chan = (MkChannel*) instanceData;
  chan->DataWrite(~0, buf, toWrite);
  if (chan->_failure == 0)
    return toWrite;

  *errorCodePtr = EINVAL; // hm, bad choice of error code
  return -1;
}

static int
mkSeek (ClientData instanceData, long offset, int seekMode, int* errorCodePtr)
{
  MkChannel* chan = (MkChannel*) instanceData;
  
  switch (seekMode)
  {
  default:  *errorCodePtr = EINVAL; // hm, bad choice of error code
        return -1;
  case 0:   break;
  case 1:   offset += chan->_position; break;
  case 2:   offset += chan->_memo (chan->_view[chan->_row]).GetSize(); break;
  }

  chan->DataSeek(offset);
  return offset;
}

static void
mkWatchChannel (ClientData instanceData, int mask)
{
  MkChannel* chan = (MkChannel*) instanceData;
  Tcl_Time blockTime = { 0, 0 };

  /*
   * Since the file is always ready for events, we set the block time
   * to zero so we will poll.
   */

  chan->_watchMask = mask & chan->_validMask;
  if (chan->_watchMask) {
    Tcl_SetMaxBlockTime(&blockTime);
  }
}

static int
mkGetFile (ClientData instanceData, int direction, ClientData* handlePtr)
{
  return TCL_ERROR;
}

static Tcl_ChannelType mkChannelType = {
  "mk",       /* Type name.                  */
  0,        /* Set blocking/nonblocking behaviour. NULL'able */
  mkClose,      /* Close channel, clean instance data      */
  mkInput,      /* Handle read request               */
  (Tcl_DriverOutputProc*) mkOutput,     /* Handle write request              */
  (Tcl_DriverSeekProc*) mkSeek,     /* Move location of access point.    NULL'able */
  0,        /* Set options.              NULL'able */
  0,        /* Get options.              NULL'able */
  (Tcl_DriverWatchProc*) mkWatchChannel, /* Initialize notifier               */
  mkGetFile     /* Get OS handle from the channel.         */
};

///////////////////////////////////////////////////////////////////////////////
// Utility code: get a Metakit item and convert it to a Tcl object

Tcl_Obj* GetAsObj(const c4_RowRef& row_, const c4_Property& prop_, Tcl_Obj* obj_)
{
  if (obj_ == 0)
    obj_ = Tcl_NewObj();

  switch (prop_.Type())
  {
    case 'S':
      {
        const char* p = ((c4_StringProp&) prop_) (row_);
        Tcl_SetStringObj(obj_, (char*) p, -1);
      }
      break;

    case 'B':
      {
        c4_Bytes temp;
        prop_ (row_).GetData(temp);
        Tcl_SetByteArrayObj(obj_, (t4_byte*) temp.Contents(), temp.Size());
      }
      break;

    case 'F':
      Tcl_SetDoubleObj(obj_, ((c4_FloatProp&) prop_) (row_));
      break;

    case 'D':
      Tcl_SetDoubleObj(obj_, ((c4_DoubleProp&) prop_) (row_));
      break;

#ifdef TCL_WIDE_INT_TYPE
    case 'L':
      Tcl_SetWideIntObj(obj_, ((c4_LongProp&) prop_) (row_));
      break;
#endif

    case 'I':
      Tcl_SetLongObj(obj_, ((c4_IntProp&) prop_) (row_));
      break;

    case 'V':
      {
        c4_View view = ((c4_ViewProp&) prop_) (row_);
        Tcl_SetIntObj(obj_, view.GetSize());
      }
      break;

    default:
      {
        KeepRef keeper (obj_); // a funny way to release the value
      }
      return 0;
  }

  return obj_;
}

///////////////////////////////////////////////////////////////////////////////
// Utility code: set a Metakit item and convert it from a Tcl object

int SetAsObj(Tcl_Interp* interp, const c4_RowRef& row_,
                  const c4_Property& prop_, Tcl_Obj* obj_)
{
  int e = TCL_OK;

  switch (prop_.Type())
  {
    case 'S':
      {
        int len;
        const char* ptr = Tcl_GetStringFromObj(obj_, &len);
        prop_ (row_).SetData(c4_Bytes (ptr, len + 1));
      }
      break;

    case 'B':
      {
        int len;
        const t4_byte* ptr = Tcl_GetByteArrayFromObj(obj_, &len);
        prop_ (row_).SetData(c4_Bytes (ptr, len));
      }
      break;

    case 'F':
      {
        double value = 0;
        e = Tcl_GetDoubleFromObj(interp, obj_, &value);
        if (e == TCL_OK)
          ((c4_FloatProp&) prop_) (row_) = (float) value;
      }
      break;

    case 'D':
      {
        double value = 0;
        e = Tcl_GetDoubleFromObj(interp, obj_, &value);
        if (e == TCL_OK)
          ((c4_DoubleProp&) prop_) (row_) = value;
      }
      break;

#ifdef TCL_WIDE_INT_TYPE
    case 'L':
      {
        Tcl_WideInt value = 0;
        e = Tcl_GetWideIntFromObj(interp, obj_, &value);
        if (e == TCL_OK)
          ((c4_LongProp&) prop_) (row_) = value;
      }
      break;
#endif

    case 'I':
      {
        long value = 0;
        e = Tcl_GetLongFromObj(interp, obj_, &value);
        if (e == TCL_OK)
          ((c4_IntProp&) prop_) (row_) = value;
      }
      break;

    default:
      Tcl_SetResult(interp, "unsupported property type", TCL_STATIC);
      e = TCL_ERROR;
  }

  return e;
}

///////////////////////////////////////////////////////////////////////////////
// In Tcl, streaming I/O uses the Tcl channel interface for loading/saving.

class c4_TclStream : public c4_Stream
{
  Tcl_Channel _stream;

public:
  c4_TclStream (Tcl_Channel stream_);
  virtual ~c4_TclStream ();

  virtual int Read(void* buffer_, int length_);
  virtual bool Write(const void* buffer_, int length_);
};

c4_TclStream::c4_TclStream (Tcl_Channel stream_)
  : _stream (stream_)
{
}

c4_TclStream::~c4_TclStream ()
{
}

int c4_TclStream::Read(void* buffer_, int length_)
{
  return Tcl_Read(_stream, (char*) buffer_, length_);
}

bool c4_TclStream::Write(const void* buffer_, int length_)
{
  return Tcl_Write(_stream, (char*) buffer_, length_) >= 0;
}

///////////////////////////////////////////////////////////////////////////////

MkPath::MkPath (MkWorkspace& ws_, const char*& path_, Tcl_Interp* interp)
  : _refs (1), _ws (&ws_), _path (path_), _currGen (generation)
{
    // if this view is not part of any storage, make a new temporary row
  if (_path.IsEmpty())
  {
    _path = ws_.AllocTempRow();

    AttachView(interp);
  }
  else
  {
    int n = AttachView(interp);
    path_ += n;   // move past all processed characters

      // but trim white space and unprocessed tail from stored path
    while (n > 0 && _path[n-1] < '0')
      --n;
    if (n < _path.GetLength())
      _path = _path.Left(n);
  }
}

MkPath::~MkPath ()
{
  if (_ws != 0)
    _ws->ForgetPath(this);
}

  static c4_View OpenMapped(c4_View v_, int col_, int row_)
  {
    if (col_ < 0)
      return c4_View ();

    const c4_Property& prop = v_.NthProperty(col_);
    d4_assert(prop.Type() == 'V');
    if (prop.Type() != 'V')
      return c4_View ();

    c4_View vw = ((c4_ViewProp&) prop) (v_[row_]);

    c4_String name = prop.Name();
    int h = v_.FindPropIndexByName(name + "_H1");
    if (h >= 0)
    {
      const c4_Property& proph = v_.NthProperty(h);
      if (proph.Type() == 'V')
      {
        c4_View vwh = ((c4_ViewProp&) proph) (v_[row_]);
        vw = vw.Hash(vwh,1);
      }
    }

    return vw;
  }

int MkPath::AttachView(Tcl_Interp* /*interp*/)
{
  const char* base = _path;
  const char* p = base;

    //  The format of a path description is:
    //
    //    storage '.' viewname [ '!' row# '.' viewprop ]*
    //  or
    //    storage '.' viewname [ '!' row# '.' viewprop ]* '!' row#
    //
    //  In the second case, the trailing row# is ignored.

  MkWorkspace::Item* ip = _ws != 0 ? _ws->Find(f4_GetToken(p)) : 0;
  if (ip != 0)
  {
    // 16-1-2003: allow path reference to root view (i.e. storage itself)
    if (*p == 0) 
    {
      _view = ip->_storage;
      return p - base;
    }
#if 0
    c4_View root = *ip->_storage;
    int col = root.FindPropIndexByName(f4_GetToken(p));
    _view = OpenMapped(root, col, 0);
#else
    _view = ip->_storage.View(f4_GetToken(p));
#endif
    while (*p)
    {
      if (!isdigit(*p))
      {
        _view = c4_View (); // bad stuff, bail out with an empty view
        break;
      }

      const char* q = p;

      int r = atoi(f4_GetToken(p));

      if (!*p)
        return q - base; // return partial number of chars processed

        //  A future version could parse derived view expressions here.
        //  Perhaps this could be done as Metakit property expressions.

      int n = _view.FindPropIndexByName(f4_GetToken(p));
      if (n < 0)
        return q - base; // make sure the property exists

      const c4_Property& prop = _view.NthProperty(n);
      if (prop.Type() != 'V')
        return q - base; // make sure it's a subview

#if 0
      _view = OpenMapped(_view, n, r);
#else
      _view = ((c4_ViewProp&) prop) (_view[r]);;
#endif
    }
  }
  else
    _view = c4_View ();

  return p - base; // return pointer to ending null byte
}

int MkPath::Refs(int diff_)
{
  d4_assert(-1 <= diff_ && diff_ <= +1);

  _refs += diff_;

  d4_assert(_refs >= 0);

  if (_refs == 0 && diff_ < 0)
  {
    delete this;
    return 0;
  }

  return _refs;
}

///////////////////////////////////////////////////////////////////////////////

  c4_PtrArray* MkWorkspace::Item::_shared = 0;

MkWorkspace::Item::Item (const char* name_, const char* fileName_, int mode_,
              c4_PtrArray& items_, int index_, bool share_)
  : _name (name_), _fileName (fileName_),
    _items (items_), _index (index_)
{
  ++generation; // make sure all cached paths refresh on next access
  
  if (*fileName_)
  {
    c4_Storage s (fileName_, mode_);
    if (!s.Strategy().IsValid())
      return;
    _storage = s;
  }

  if (_index >= _items.GetSize())
    _items.SetSize(_index + 1);

  _items.SetAt(_index, this);

  if (share_)
  {
    if (_shared == 0)
      _shared = new c4_PtrArray;
    _shared->Add(this);
  }
}

MkWorkspace::Item::~Item ()
{
//! ForceRefresh();
    // all views referring to this datafile are made invalid
  for (int i = 0; i < _paths.GetSize(); ++i)
  {
    MkPath* path = (MkPath*) _paths.GetAt(i);
    if (_index > 0)
      path->_view = c4_View ();
    path->_path = "?"; // make sure it never matches
    path->_currGen = -1; // make sure lookup is retried on next use
    // 24-01-2003: paths should not clean up workspaces once exiting
    path->_ws = 0;
    // TODO: get rid of generations, use a "_valid" flag instead
  }
  ++generation; // make sure all cached paths refresh on next access

  if (_index < _items.GetSize())
  {
    d4_assert(_items.GetAt(_index) == this || _items.GetAt(_index) == 0);
    _items.SetAt(_index, 0);
  }

  if (_shared != 0)
  {
    for (int i = 0; i < _shared->GetSize(); ++i)
      if (_shared->GetAt(i) == this)
      {
        _shared->RemoveAt(i);
        break;
      }

    if (_shared->GetSize() == 0)
    {
      delete _shared;
      _shared = 0;
    }
  }
}

void MkWorkspace::Item::ForceRefresh()
{
    // all views referring to this datafile are cleared
  for (int i = 0; i < _paths.GetSize(); ++i)
  {
    MkPath* path = (MkPath*) _paths.GetAt(i);
    path->_view = c4_View ();
  }

  ++generation; // make sure all cached paths refresh on next access
}

MkWorkspace::MkWorkspace (Tcl_Interp* ip_)
  : _interp (ip_)
{
  new Item ("", "", 0, _items, 0);
  
    // never uses entry zero (so atoi failure in ForgetPath is harmless)
  _usedRows = _usedBuffer.SetBufferClear(16); // no realloc for first 16 temp rows
}

MkWorkspace::~MkWorkspace ()
{
  CleanupCommands();

  for (int i = _items.GetSize(); --i >= 0; )
    delete Nth(i);

    // need this to prevent recursion in Tcl_DeleteAssocData in 8.2 (not 8.0!)
  Tcl_SetAssocData(_interp, "mk4tcl", 0, 0);
  Tcl_DeleteAssocData(_interp, "mk4tcl");
}

void MkWorkspace::DefCmd(MkTcl* cmd_)
{
  _commands.Add(cmd_);
}

MkWorkspace::Item* MkWorkspace::Define(const char* name_, const char* fileName_, 
                    int mode_, bool share_)
{
  Item *ip = Find(name_);

  if (ip == 0)
  {
    int n = -1;
    while (++n < _items.GetSize())
      if (Nth(n) == 0)
        break;

    ip = new Item (name_, fileName_, mode_, _items, n, share_);
    if (*fileName_ != 0 && !ip->_storage.Strategy().IsValid())
    {
      delete ip;
      return 0;
    }
  }

  return ip;
}

MkWorkspace::Item* MkWorkspace::Find(const char* name_) const
{
  for (int i = 0; i < _items.GetSize(); ++i)
  {
    Item* ip = Nth(i);
    if (ip && ip->_name.Compare(name_) == 0)
      return ip;
  }

  if (Item::_shared != 0) // look in the shared pool, if there is one
  {
    for (int j = 0; j < Item::_shared->GetSize(); ++j)
    {
      Item* ip = (Item*) Item::_shared->GetAt(j);
      if (ip && ip->_name == name_)
        return ip;
    }
  }

  return 0;
}

int MkWorkspace::NumItems() const
{
  return _items.GetSize();
}

MkWorkspace::Item* MkWorkspace::Nth(int index_) const
{
  return (Item*) _items.GetAt(index_);
}

MkPath* MkWorkspace::AddPath(const char*& name_, Tcl_Interp* interp)
{
  const char* p = name_;

  Item* ip = Find(f4_GetToken(p));
  if (ip == 0)
  {
    ip = Nth(0);
    d4_assert(ip != 0);
    name_ = "";  // no such tag, assign a temporary one instead
  }
  else
    for (int i = 0; i < ip->_paths.GetSize(); ++i)
    {
      MkPath* path = (MkPath*) ip->_paths.GetAt(i);
      d4_assert(path != 0);

      if (path->_path.CompareNoCase(name_) == 0 && path->_currGen == generation)
      {
        path->Refs(+1);
        return path;
      }
    }

  MkPath* newPath = new MkPath (*this, name_, interp);
  ip->_paths.Add(newPath);

  return newPath;
}

c4_String MkWorkspace::AllocTempRow()
{
  int i;
  
    // find an unused row
  for (i = 1; i < _usedBuffer.Size(); ++i)
    if (_usedRows[i] == 0)
      break;

    // allocate new vec if old one is too small, doubling it in size
  if (i >= _usedBuffer.Size())
  {
    c4_Bytes temp;
    t4_byte* tempPtr = temp.SetBufferClear(2*i+1);
    memcpy(tempPtr, _usedRows, _usedBuffer.Size());

    _usedBuffer.Swap(temp);
    _usedRows = tempPtr;

    c4_View v = Nth(0)->_storage.View("");
    v.SetSize(_usedBuffer.Size());
  }

    // flag it as being in use
  _usedRows[i] = 1;

    // temporary rows have special names
  char buf[20];
  sprintf(buf, "._!%d._", i);

  return buf;
}

void MkWorkspace::ForgetPath(const MkPath* path_)
{
  const char* p = path_->_path;

  Item* ip = Find(f4_GetToken(p));
  if (ip != 0)
  {
    for (int j = 0; j < ip->_paths.GetSize(); ++j)
      if ((MkPath*) ip->_paths.GetAt(j) == path_)
      {
        ip->_paths.RemoveAt(j);
        break;
      }

      // last ref to a temporary row determines when to release it
    if (ip == Nth(0))
    {
      int n = atoi(((const char*) path_->_path) + 3);
      d4_assert(_usedRows[n] != 0);
      _usedRows[n] = 0;
    }
  }
}

void MkWorkspace::Invalidate(const MkPath& path_)
{
  const char* p = path_._path;

  c4_String prefix = path_._path + "!";
  int n = prefix.GetLength();

  Item* ip = Find(f4_GetToken(p));
  if (ip != 0)
  {
    for (int j = 0; j < ip->_paths.GetSize(); ++j)
    {
      MkPath* entry = (MkPath*) ip->_paths.GetAt(j);
      if (strncmp(entry->_path, prefix, n) == 0)
        entry->_currGen = -1; // the next use will reattach
    }
  }
}

///////////////////////////////////////////////////////////////////////////////
// Translate between the Metakit and Tcl-style datafile structure descriptions

static c4_String KitToTclDesc(const char* desc_)
{
  c4_Bytes temp;
  char* p = (char*) temp.SetBuffer(3 * strlen(desc_) + 100);

  while (*desc_)
  {
    char* q = p;

      // assume normal property
    while (isalnum(*desc_) || *desc_ == '_' || *desc_ == ':')
      *p++ = *desc_++;

      // strip a trailing ':S'
    if (p[-2] == ':' && p[-1] == 'S')
      p -= 2;

      // at end of property, process commas and brackets
    switch (*desc_++)
    {
        // defensive coding, this cannot happen
      case 0: --desc_; break;

        // opening bracket "xxx[" --> "{xxx {"
      case '[':
        {
          c4_String name (q, p - q);
          *q++ = '{';
          strcpy(q, name);
          ++p;

          *p++ = ' ';
          *p++ = '{';
        }
        break;

        // opening bracket "]" --> "}}"
      case ']':
        {
          *p++ = '}';
          *p++ = '}';
        }
        break;

        // comma separator "," --> " "
      case ',':
        *p++ = ' ';
    }
  }

  *p++ = 0;
  return (const char*) temp.Contents();
}

///////////////////////////////////////////////////////////////////////////////
//
//  Interface to Tcl 8.0 type mechanism, defines a new "mkProperty" datatype
//
//  Since properties are immutable, we don't need most of the calls.

  static void FreePropertyInternalRep(Tcl_Obj* propPtr);

static void
DupPropertyInternalRep(Tcl_Obj*, Tcl_Obj*)
{
  d4_assert(false);
}

static void
UpdateStringOfProperty(Tcl_Obj*)
{
  d4_assert(false);
}

static int
SetPropertyFromAny(Tcl_Interp*, Tcl_Obj*) 
{
  d4_assert(false);
  return TCL_OK;
}

static Tcl_ObjType mkPropertyType =
{
  "mkProperty",       // name
  FreePropertyInternalRep,  // freeIntRepProc
  DupPropertyInternalRep,   // dupIntRepProc
  UpdateStringOfProperty,   // updateStringProc
  SetPropertyFromAny      // setFromAnyProc
};

///////////////////////////////////////////////////////////////////////////////

const c4_Property& AsProperty(Tcl_Obj* objPtr, const c4_View& view_)
{
  if (objPtr->typePtr != &mkPropertyType)
  {
    Tcl_ObjType* oldTypePtr = objPtr->typePtr;

    char type = 'S';

    int length;
    char* string = Tcl_GetStringFromObj(objPtr, &length);

    if (length > 2 && string[length-2] == ':')
    {
      type = string[length-1];
      length -= 2;
    }
    else // look int the view to try to determine the type
    {
      int n = view_.FindPropIndexByName(string);
      if (n >= 0)
        type = view_.NthProperty(n).Type();
    }

    c4_Property* prop = new c4_Property (type, c4_String (string, length));

    if (oldTypePtr && oldTypePtr->freeIntRepProc)
      oldTypePtr->freeIntRepProc(objPtr);
  
    objPtr->typePtr = &mkPropertyType;
      // use a (char*), because the Mac wants it, others use (void*)
    objPtr->internalRep.otherValuePtr = (char*) prop;
  }

  return *(c4_Property*) objPtr->internalRep.otherValuePtr;
}

static void 
FreePropertyInternalRep(Tcl_Obj* propPtr)
{
  delete (c4_Property*) propPtr->internalRep.otherValuePtr;
}

///////////////////////////////////////////////////////////////////////////////
//
//  Interface to Tcl 8.0 type mechanism, defines a new "mkCursor" datatype

  static void FreeCursorInternalRep(Tcl_Obj* propPtr);
  static void DupCursorInternalRep(Tcl_Obj* srcPtr, Tcl_Obj* copyPtr);
  //static int SetCursorFromAny(Tcl_Interp* interp, Tcl_Obj* objPtr);
  static void UpdateStringOfCursor(Tcl_Obj* propPtr);

static Tcl_ObjType mkCursorType =
{
  "mkCursor",         // name
  FreeCursorInternalRep,    // freeIntRepProc
  DupCursorInternalRep,   // dupIntRepProc
  UpdateStringOfCursor,   // updateStringProc
  SetCursorFromAny      // setFromAnyProc
};

///////////////////////////////////////////////////////////////////////////////
//
//  Cursors in Tcl are implemented as a pointer to an MkPath plus an index.

MkPath& AsPath(Tcl_Obj* obj_)
{
  d4_assert(obj_->typePtr == &mkCursorType);
  d4_assert(obj_->internalRep.twoPtrValue.ptr2 != 0);

  return *(MkPath*) obj_->internalRep.twoPtrValue.ptr2;
}

int& AsIndex(Tcl_Obj* obj_)
{
  d4_assert(obj_->typePtr == &mkCursorType);
  d4_assert(obj_->internalRep.twoPtrValue.ptr2 != 0);

  return (int&) obj_->internalRep.twoPtrValue.ptr1;
}

static void 
FreeCursorInternalRep(Tcl_Obj* cursorPtr)
{
  AsPath(cursorPtr).Refs(-1);
}

static void
DupCursorInternalRep(Tcl_Obj* srcPtr, Tcl_Obj* copyPtr)
{
  AsPath(srcPtr).Refs(+1);

  copyPtr->internalRep = srcPtr->internalRep;
  copyPtr->typePtr = &mkCursorType;
}

int
SetCursorFromAny(Tcl_Interp* interp, Tcl_Obj* objPtr) 
{
    // force a relookup if the this object is of the wrong generation
  if (objPtr->typePtr == &mkCursorType && AsPath(objPtr)._currGen != generation)
  {
      // make sure we have a string representation around
    if (objPtr->bytes == 0)
      UpdateStringOfCursor(objPtr);

      // get rid of the object form
    FreeCursorInternalRep(objPtr);
    objPtr->typePtr = 0;
  }

  if (objPtr->typePtr != &mkCursorType)
  {
    Tcl_ObjType* oldTypePtr = objPtr->typePtr;

    const char* string = Tcl_GetStringFromObj(objPtr, 0);
    
    if (oldTypePtr && oldTypePtr->freeIntRepProc)
      oldTypePtr->freeIntRepProc(objPtr);

      // dig up the workspace used in this interpreter
    MkWorkspace* work = (MkWorkspace*) Tcl_GetAssocData(interp, "mk4tcl", 0);

    objPtr->typePtr = &mkCursorType;
    objPtr->internalRep.twoPtrValue.ptr2 = // cast required for Mac
        (char*) (void*) work->AddPath(string, interp);
    AsIndex(objPtr) = isdigit(*string) ? atoi(string) : -1;
  }

  return TCL_OK;
}

static void
UpdateStringOfCursor(Tcl_Obj* cursorPtr)
{
  c4_String s = AsPath(cursorPtr)._path;

  int index = AsIndex(cursorPtr);
  if (index >= 0)
  {
    char buf [20];
    sprintf(buf, "%s%d", s.IsEmpty() ? "" : "!", index);
    s += buf;
  }

  cursorPtr->length = s.GetLength();
  cursorPtr->bytes = strcpy(Tcl_Alloc(cursorPtr->length + 1), s);
}

static Tcl_Obj*
AllocateNewTempRow(MkWorkspace& work_)
{
  Tcl_Obj* result = Tcl_NewObj();

  const char* empty = "";
  MkPath* path = work_.AddPath(empty, 0);
//  path->_view.SetSize(1);

  result->typePtr = &mkCursorType;
  result->internalRep.twoPtrValue.ptr2 = (char*) (void*) path;
  AsIndex(result) = 0;

  Tcl_InvalidateStringRep(result);

  return result;
}

///////////////////////////////////////////////////////////////////////////////
// Helper class for the mk::select command, stores params and performs select

TclSelector::TclSelector (Tcl_Interp* interp_, const c4_View& view_)
  : _interp (interp_), _view (view_), _temp (0), _first (0), _count (-1)
{
}

TclSelector::~TclSelector ()
{
  for (int i = 0; i < _conditions.GetSize(); ++i)
    delete (Condition*) _conditions.GetAt(i);
}

  // convert a property (or list of properties) to an empty view
c4_View TclSelector::GetAsProps( Tcl_Obj* obj_)
{
  c4_View result;

  Tcl_Obj* o;

  for (int i = 0; Tcl_ListObjIndex(_interp, obj_, i, &o) == TCL_OK && o != 0; ++i)
    result.AddProperty(AsProperty(o, _view));

  return result;
}

int TclSelector::AddCondition(int id_, Tcl_Obj* props_, Tcl_Obj* value_)
{
  c4_View props = GetAsProps(props_);
  if (props.NumProperties() > 0)
    _conditions.Add(new Condition (id_, props, Tcl_GetStringFromObj(value_, 0)));

  return TCL_OK;
}

bool TclSelector::MatchOneString(int id_, const char* value_, const c4_String& crit_)
{
  switch (id_)
  {
    case 2:   // -exact prop value : exact case-sensitive match
      return value_ == crit_;

    case 3:   // -glob prop pattern : match "glob" expression wildcard
      return Tcl_StringMatch((char*) value_, (char*) (const char*) crit_) > 0;

    case 4:   // -regexp prop pattern : match specified regular expression
      return Tcl_RegExpMatch(_interp, (char*) value_,
                      (char*) (const char*) crit_) > 0;

    case 5:   // -keyword prop prefix : match keyword in given property
      return MatchOneKeyword(value_, crit_);

    case 10:  // -globnc prop pattern : match "glob", but not case sensitive
      return Tcl_StringCaseMatch(value_, crit_, 1) > 0;
  }

  return false;
}

bool TclSelector::Match(const c4_RowRef& row_)
{
    // go through each condition and make sure they all match
  for (int i = 0; i < _conditions.GetSize(); ++i)
  {
    const Condition& cond = *(const Condition*) _conditions.GetAt(i);

    bool matched = false;

      // go through each property until one matches
    for (int j = 0; j < cond._view.NumProperties(); ++j)
    {
      const c4_Property& prop = cond._view.NthProperty(j);

      if (cond._id < 2) // use typed comparison as defined by Metakit
      {
          // set up a Tcl object, using the criterium string value
        Tcl_SetStringObj(_temp, (char*) (const char*) cond._crit, -1);
        
        c4_Row data; // this is *very* slow in Metakit 1.8
        if (SetAsObj(_interp, data, prop, _temp) != TCL_OK)
          return false;
        
          // data is now a row with the criterium as single property
        matched = cond._id < 0 && data == row_ ||
              cond._id == 0 && data <= row_ ||
              cond._id > 0 && data >= row_;
      }
      else // use item value as a string
      {
        GetAsObj(row_, prop, _temp);
        const char* value = Tcl_GetStringFromObj(_temp, 0);

        matched = MatchOneString(cond._id, value, cond._crit);
        if (matched)
          break;
      }
    }

    if (!matched)
      return false;
  }

  return true;
}

  // pick out criteria which specify an exact match
void TclSelector::ExactKeyProps(const c4_RowRef& row_)
{
  for (int i = 0; i < _conditions.GetSize(); ++i)
  {
    const Condition& cond = *(const Condition*) _conditions.GetAt(i);
    if (cond._id == -1 || cond._id == 2)
    {
      for (int j = 0; j < cond._view.NumProperties(); ++j)
      {
        const c4_Property& prop = cond._view.NthProperty(j);
        // 2001-05-30: inc/decref to clean up the string object
        KeepRef o = Tcl_NewStringObj(cond._crit, -1);
        SetAsObj(_interp, row_, prop, o);
      }
    }
  }
}

int TclSelector::DoSelect(Tcl_Obj* list_, c4_View* result_)
{
  c4_IntProp pIndex ("index");

    // normalize _first and _count to be in allowable range
  int n = _view.GetSize();
  if (_first < 0)
    _first = 0;
  if (_first > n)
    _first = n;
  if (_count < 0)
    _count = n;
  if (_first + _count > n)
    _count = n - _first;

  c4_View result;
  result.SetSize(_count); // upper bound

    // keep a temporary around during the comparison loop
  _temp = Tcl_NewObj();
  KeepRef keeper (_temp);

    // try to take advantage of key lookup structures
  c4_Row exact;
  ExactKeyProps(exact);
  if (exact.Container().NumProperties() > 0)
    _view.RestrictSearch(exact, _first, _count);

    // the matching loop where all the hard work is done
  for (n = 0; _first < _view.GetSize() && n < _count; ++_first)
    if (Match(_view [_first]))
      pIndex (result[n++]) = _first;

  result.SetSize(n);

    // set up sorting, this references/loads a lot of extra Metakit code
  const bool sorted = n > 0 && _sortProps.NumProperties() > 0;

  c4_View mapView;
  c4_View sortResult;
  if (sorted)
  {
    mapView = _view.RemapWith(result);
    sortResult = mapView.SortOnReverse(_sortProps, _sortRevProps);
  }

    // convert result to a Tcl list of ints
  if (list_ != 0)
    for (int i = 0; i < n; ++i) {
	// sorting means we have to lookup the index of the original again
      int pos = i;
      if (sorted)
	pos = mapView.GetIndexOf(sortResult [i]);

      // set up a Tcl integer which holds the selected row index
      KeepRef o = Tcl_NewIntObj(pIndex (result[pos]));

      if (Tcl_ListObjAppendElement(_interp, list_, o) != TCL_OK)
	return TCL_ERROR;
    }

    // added 2003/02/14: return intermediate view, if requested
  if (result_ != 0)
    *result_ = sorted ? sortResult : result;

  return TCL_OK;
}

///////////////////////////////////////////////////////////////////////////////
// The Tcl class is a generic interface to Tcl, providing some C++ wrapping

Tcl::Tcl (Tcl_Interp* ip_)
  : interp (ip_)
{
}

int Tcl::Fail(const char* msg_, int err_)
{
  if (!_error)
  {
    if (msg_)
      Tcl_SetResult(interp, (char*) msg_, TCL_VOLATILE);
    _error = err_;
  }

  return _error;
}

Tcl_Obj* Tcl::tcl_GetObjResult()
{
  return Tcl_GetObjResult(interp);
}

int Tcl::tcl_SetObjResult(Tcl_Obj* obj_)
{
  Tcl_SetObjResult(interp, obj_);
  return _error;
}

int Tcl::tcl_ListObjLength(Tcl_Obj* obj_)
{
  int result;
  _error = Tcl_ListObjLength(interp, obj_, &result);
  return _error ? -1 : result;
}

void Tcl::tcl_ListObjAppendElement(Tcl_Obj* obj_, Tcl_Obj* value_)
{
  if (!_error)
    if (value_ == 0)
      Fail();
    else
      _error = Tcl_ListObjAppendElement(interp, obj_, value_);
}

bool Tcl::tcl_GetBooleanFromObj(Tcl_Obj* obj_)
{
  int value = 0;
  if (!_error)
    _error = Tcl_GetBooleanFromObj(interp, obj_, &value);
  return value != 0;
}

int Tcl::tcl_GetIntFromObj(Tcl_Obj* obj_)
{
  int value = 0;
  if (!_error)
    _error = Tcl_GetIntFromObj(interp, obj_, &value);
  return value;
}

long Tcl::tcl_GetLongFromObj(Tcl_Obj* obj_)
{
  long value = 0;
  if (!_error)
    _error = Tcl_GetLongFromObj(interp, obj_, &value);
  return value;
}

double Tcl::tcl_GetDoubleFromObj(Tcl_Obj* obj_)
{
  double value = 0;
  if (!_error)
    _error = Tcl_GetDoubleFromObj(interp, obj_, &value);
  return value;
}

int Tcl::tcl_GetIndexFromObj(Tcl_Obj *obj_, const char **table_, char *msg_)
{
  int index = -1;
  if (!_error)
    _error = Tcl_GetIndexFromObj(interp, obj_, (CONST84 char**) table_,
							msg_, 0, &index);
  return _error == TCL_OK ? index : -1;
}

long Tcl::tcl_ExprLongObj(Tcl_Obj *obj_)
{
  long result = 0;
  if (!_error)
    _error = Tcl_ExprLongObj(interp, obj_, &result);
  return result;
}

Tcl_Obj* Tcl::GetValue(const c4_RowRef& row_, const c4_Property& prop_, Tcl_Obj* obj_)
{
  obj_ = GetAsObj(row_, prop_, obj_);

  if (!obj_)
    Fail("unsupported property type");

  return obj_;
}

Tcl_Obj* Tcl::tcl_NewStringObj(const char* str_, int len_)
{
  return Tcl_NewStringObj((char*) str_, len_);
}

void Tcl::list2desc(Tcl_Obj* in_, Tcl_Obj* out_)
{
  Tcl_Obj *o, **ov;
  int oc;
  if (Tcl_ListObjGetElements(0, in_, &oc, &ov) == TCL_OK && oc > 0) {
    char sep = '[';
    for (int i = 0; i < oc; ++i) {
      Tcl_AppendToObj(out_, &sep, 1);
      sep = ',';
      Tcl_ListObjIndex(0, ov[i], 0, &o);
      if (o != 0)
	Tcl_AppendObjToObj(out_, o);
      Tcl_ListObjIndex(0, ov[i], 1, &o);
      if (o != 0)
	list2desc(o, out_);
    }
    Tcl_AppendToObj(out_, "]", 1);
  }
}

///////////////////////////////////////////////////////////////////////////////
// The MkTcl class adds Metakit-specific utilities and all the command procs.

int MkTcl::Dispatcher(ClientData cd, Tcl_Interp* ip, int oc, Tcl_Obj* const* ov)
{
  MkTcl* self = (MkTcl*) cd;

  if (self == 0 || self->interp != ip)
  {
    Tcl_SetResult(ip, "Initialization error in dispatcher", TCL_STATIC);
    return TCL_ERROR;
  }

  return self->Execute(oc, ov);
}

MkTcl::MkTcl (MkWorkspace* ws_, Tcl_Interp* ip_, int id_, const char* cmd_)
    : Tcl (ip_), id (id_), work (*ws_)
{
  Tcl_CreateObjCommand(ip_, (char*) cmd_, Dispatcher, this, 0);
}

MkTcl::~MkTcl ()
{
}

c4_View MkTcl::asView(Tcl_Obj* obj_)
{
  SetCursorFromAny(interp, obj_);
  return AsPath(obj_)._view;
}

int& MkTcl::changeIndex(Tcl_Obj* obj_)
{
  SetCursorFromAny(interp, obj_);
  Tcl_InvalidateStringRep(obj_);
  return AsIndex(obj_);
}

c4_RowRef MkTcl::asRowRef(Tcl_Obj* obj_, int type_)
{
  c4_View view = asView(obj_);
  int index = AsIndex(obj_);
  int size = view.GetSize();

  switch (type_)
  {
    case kExtendRow:  if (index >= size)
                view.SetSize(size = index + 1);
    case kLimitRow:   if (index > size)
                Fail("view index is too large");
              else if (index < 0)
                Fail("view index is negative");
              break;

    case kExistingRow:  if (index < 0 || index >= size)
              {
                Fail("view index is out of range");
                break;
              }
    case kAnyRow:   ;
  }

  return view[index];
}

int MkTcl::GetCmd()
{
  c4_RowRef row = asRowRef(objv[1], kExistingRow);

  if (!_error)
  {
    const bool returnSize = objc > 2 && // fixed 1999-11-19
                  tcl_GetIndexFromObj(objv[2], getCmds) >= 0;
    if (returnSize)
    {
      --objc;
      ++objv;
    }
    else
    {
      _error = TCL_OK; // ignore missing option
      KeepRef o = Tcl_NewObj();
      tcl_SetObjResult(o);
    }

    Tcl_Obj* result = tcl_GetObjResult();

    if (objc < 3)
    {
      c4_View view = row.Container();
      for (int i = 0; i < view.NumProperties() && !_error; ++i)
      {
        const c4_Property& prop = view.NthProperty(i);
        if (prop.Type() == 'V')
          continue; // omit subviews

        tcl_ListObjAppendElement(result, tcl_NewStringObj(prop.Name()));
        tcl_ListObjAppendElement(result, returnSize ?
                      Tcl_NewIntObj(prop(row).GetSize()) :
                      GetValue(row, prop));
      }
    }
    else if (objc == 3)
    {
      const c4_Property& prop = AsProperty(objv[2], row.Container());
      if (returnSize)
        Tcl_SetIntObj(result, prop(row).GetSize());
      else
        GetValue(row, prop, result);
    }
    else
    {
      for (int i = 2; i < objc && !_error; ++i)
      {
        const c4_Property& prop = AsProperty(objv[i], row.Container());
        tcl_ListObjAppendElement(result, returnSize ?
                      Tcl_NewIntObj(prop(row).GetSize()) :
                      GetValue(row, prop));
      }
    }
  }

  return _error;
}

int MkTcl::SetValues(const c4_RowRef& row_, int objc, Tcl_Obj* const* objv)
{
  while (objc >= 2 && !_error)
  {
    _error = SetAsObj(interp, row_,
              AsProperty(objv[0], row_.Container()), objv[1]);

    objc -= 2;
    objv += 2;
  }

  return _error;
}

int MkTcl::SetCmd()
{
  if (objc < 4)
    return GetCmd();

  int size = asView(objv[1]).GetSize();
  c4_RowRef row = asRowRef(objv[1], kExtendRow);

  int e = SetValues(row, objc - 2, objv + 2);
  if (e != TCL_OK)
    asView(objv[1]).SetSize(size); // 1.1: restore old size on errors

  if (_error)
    return _error;

  return tcl_SetObjResult(objv[1]);
}

int MkTcl::RowCmd()
{
  static const char* cmds [] =
  {
    "create",
    "append",
    "delete",
    "insert",
    "replace",
    0
  };

    // "create" is optional if there are no further args
  int id = objc <= 1 ? 0 : tcl_GetIndexFromObj(objv[1], cmds);
  if (id < 0)
    return _error;

  switch (id)
  {
    case 0:
      {
        Tcl_Obj* var = AllocateNewTempRow(work);
        KeepRef keeper (var);

        SetValues(asRowRef(var, kExtendRow), objc - 2, objv + 2);
        return tcl_SetObjResult(var); // different result
      }

    case 1:
      {
        Tcl_Obj* var = Tcl_DuplicateObj(objv[2]);
        tcl_SetObjResult(var);
        
          // used to be a single stmt, avoids bug in gcc 2.7.2 on Linux?
        int size = asView(var).GetSize();
        changeIndex(var) = size;

	int oc = objc - 3;
	Tcl_Obj** ov = (Tcl_Obj**) objv + 3;

	  // 2003-03-16, allow giving all pairs as list
	if (oc == 1 &&
	    Tcl_ListObjGetElements(interp, objv[3], &oc, &ov) != TCL_OK)
	  return TCL_ERROR;

          // 2000-06-15: this will not work with custom viewers which
          // take over ordering or uniqueness, because such views can
          // not be resized to create emtpy rows, which get filled in
        int e = SetValues(asRowRef(var, kExtendRow), oc, ov);
        if (e != TCL_OK)
          asView(var).SetSize(size); // 1.1: restore old size on errors
        
        return e;
      }

    case 2:
      {
        c4_RowRef row = asRowRef(objv[2]);
        if (_error)
          return _error;

        c4_View view = row.Container();
        int index = AsIndex(objv[2]);

        int count = objc > 3 ? tcl_GetIntFromObj(objv[3]) : 1;
        if (count > view.GetSize() - index)
          count = view.GetSize() - index;

        if (count >= 1)
        {
          view.RemoveAt(index, count);
          work.Invalidate(AsPath(objv[2]));
        }
      }
      break;

    case 3:
      {
        c4_RowRef toRow = asRowRef(objv[2], kLimitRow);
        if (_error)
          return _error;

        c4_View view = toRow.Container();
        int n = AsIndex(objv[2]);

        int count = objc > 3 ? tcl_GetIntFromObj(objv[3]) : 1;
        if (count >= 1)
        {
          c4_Row temp;
          view.InsertAt(n, temp, count);

          if (objc > 4)
          {
            c4_RowRef fromRow = asRowRef(objv[4]);
            if (_error)
              return _error;

            while (--count >= 0)
              view[n++] = fromRow;
          }
          work.Invalidate(AsPath(objv[2]));
        }
      }
      break;

    case 4:
      {
        c4_RowRef row = asRowRef(objv[2]);
        if (_error)
          return _error;

        if (objc > 3)
          row = asRowRef(objv[3]);
        else
          row = c4_Row ();
      }
      break;
  }

  if (_error)
    return _error;

  return tcl_SetObjResult(objv[2]);
}

int MkTcl::FileCmd()
{
  static const char* cmds [] =
  {
    "open", "end", "close", "commit", "rollback",
    "load", "save", "views", "aside", "autocommit",
    "space",
    0
  };

  int id = tcl_GetIndexFromObj(objv[1], cmds);
  if (id < 0)
    return _error;

  if (id == 0 && objc == 2)   // new in 1.1: return list of db's
  {
    Tcl_Obj* result = tcl_GetObjResult();

      // skip first entry, which is for temp rows
    for (int i = 1; i < work.NumItems() && !_error; ++i)
    {
      MkWorkspace::Item* ip = work.Nth(i);

      if (ip != 0)
      {
        tcl_ListObjAppendElement(result,
              tcl_NewStringObj(ip->_name));
        tcl_ListObjAppendElement(result,
              tcl_NewStringObj(ip->_fileName));
      }
    }

    return _error;
  }

  const char* string = Tcl_GetStringFromObj(objv[2], 0);

  MkWorkspace::Item* np = work.Find(f4_GetToken(string));
  if (np == 0 && id > 1)
    return Fail("no storage with this name");

  switch (id)
  {
    case 0: // open
      {
        if (np != 0)
          return Fail("file already open");

        int mode = 1;
        bool nocommit = false, shared = false;
        static const char* options [] = {
          "-readonly", "-extend", "-nocommit", "-shared", 0
        };

        while (objc > 2 && *Tcl_GetStringFromObj(objv[objc-1], 0) == '-')
          switch (tcl_GetIndexFromObj(objv[--objc], options)) {
            case 0:   mode = 0; break;
            case 1:   mode = 2; break;
            case 2:   nocommit = true; break;
            case 3:   shared = true; break;
            default:  return _error;
          }

        const char* name = Tcl_GetStringFromObj(objv[2], 0);
        int len = 0;
        const char* file = objc < 4 ? ""
                      : Tcl_GetStringFromObj(objv[3], &len);

        Tcl_DString ds;
        const char *native = Tcl_UtfToExternalDString(NULL, file, len, &ds);
        np = work.Define(name, native, mode, shared);
        Tcl_DStringFree(&ds);

        if (np == 0)
          return Fail("file open failed");

        if (*file && mode != 0 && !nocommit)
          np->_storage.AutoCommit();
      }
      break;
    
    case 1: // end
      {
        int len;
        const char* name = Tcl_GetStringFromObj(objv[2], &len);
        Tcl_DString ds;
        const char *native = Tcl_UtfToExternalDString(NULL, name, len, &ds);

        c4_FileStrategy strat;
        int err = strat.DataOpen(native, false);
        Tcl_DStringFree(&ds);
                
        if (!err || !strat.IsValid())
          return Fail("no such file");
        t4_i32 end = strat.EndOfData();
        if (end < 0)
          return Fail("not a Metakit datafile");

        Tcl_SetIntObj(tcl_GetObjResult(), end);
        return _error;
      }
      break;
    
    case 2: // close
      {
        delete np;
      }
      break;
    
    case 3: // commit
      {
        if (!np->_storage.Strategy().IsValid())
          return Fail("cannot commit temporary dataset");

        np->ForceRefresh(); // detach first

          // 1-Mar-1999: check commit success
        bool full = objc > 3 && strcmp(Tcl_GetStringFromObj(objv[3], 0), "-full") == 0;
        if (!np->_storage.Commit(full))
          return Fail("I/O error during commit");
      }
      break;

    case 4: // rollback
      {
        if (!np->_storage.Strategy().IsValid())
          return Fail("cannot rollback temporary dataset");

        np->ForceRefresh(); // detach first

        bool full = objc > 3 && strcmp(Tcl_GetStringFromObj(objv[3], 0), "-full") == 0;
        np->_storage.Rollback(full);
      }
      break;

    case 5: // load
      {
        char* channel = Tcl_GetStringFromObj(objv[3], 0);

        int mode;
        Tcl_Channel cp = Tcl_GetChannel(interp, channel, &mode);
        if (cp == 0 || !(mode & TCL_READABLE))
          return Fail("load from channel failed");

        if (Tcl_SetChannelOption(interp, cp, "-translation", "binary"))
          return Fail();

        np->ForceRefresh(); // detach first

        c4_TclStream stream (cp);
        if (!np->_storage.LoadFrom(stream))
          return Fail("load error");
      }
      break;
    
    case 6: // save
      {
        char* channel = Tcl_GetStringFromObj(objv[3], 0);

        int mode;
        Tcl_Channel cp = Tcl_GetChannel(interp, channel, &mode);
        if (cp == 0 || !(mode & TCL_WRITABLE))
          return Fail("save to channel failed");

        if (Tcl_SetChannelOption(interp, cp, "-translation", "binary"))
          return Fail();

        c4_TclStream stream (cp);
        np->_storage.SaveTo(stream);
      }
      break;

    case 7: // views
      {
        c4_View view = np->_storage;
        Tcl_Obj* result = tcl_GetObjResult();

        for (int i = 0; i < view.NumProperties() && !_error; ++i)
        {
          const c4_Property& prop = view.NthProperty(i);
          tcl_ListObjAppendElement(result, tcl_NewStringObj(prop.Name()));
        }

        return _error; // different result
      }

    case 8: // aside
      {
        if (objc != 4)
          return Fail("mk::file aside: needs 2 storage args");
        
        const char* as = Tcl_GetStringFromObj(objv[3], 0);
        MkWorkspace::Item* np2 = work.Find(f4_GetToken(as));
        if (np2 == 0)
          return Fail("no storage with this name");

        np->_storage.SetAside(np2->_storage);
      }
      break;

    case 9: // autocommit
      {
        if (objc != 3)
          return Fail("mk::file autocommit: too many args");
        
        np->_storage.AutoCommit();
      }
      break;

    case 10: // space, new on 30-11-2001:  returns allocator used space pairs
      {
	  // nasty hack to obtain the storage's sequence pointer
        c4_View v = np->_storage;
	c4_Cursor c = &v[0];
	c4_Sequence* s = c._seq;

	  // even more horrible (i.e. brittle) hack to get the space vector
	c4_Persist* p = s->Persist();
	c4_PtrArray* a = p != 0 ? *(c4_PtrArray**) p : 0; // first field
	if (a == 0)
	  return Fail("storage is not persistent");
	
	  // now return the values as a list
	Tcl_Obj* r = tcl_GetObjResult();
	for (int i = 1; i < a->GetSize() - 1 && !_error; ++i)
	  tcl_ListObjAppendElement(r, Tcl_NewLongObj((long) a->GetAt(i)));
 	return _error;
      }
  }

  if (_error)
    return _error;

  return tcl_SetObjResult(objv[2]);
}

int MkTcl::ViewCmd()
{
  int id = tcl_GetIndexFromObj(objv[1], viewCmds);
  if (id < 0)
    return _error;

  switch (id)
  {
    case 0: // layout
      if (objc == 3)
      {
        const char* string = Tcl_GetStringFromObj(objv[2], 0);

        MkWorkspace::Item* np = work.Find(f4_GetToken(string));
        if (np == 0)
          return Fail("no storage with this name");

        c4_Storage& s = np->_storage;

        const char* p = s.Description(f4_GetToken(string));
	if (p == 0)
          return Fail("no view with this name");

        c4_String desc = KitToTclDesc(p);
        KeepRef o = tcl_NewStringObj(desc);
        return tcl_SetObjResult(o); // different result
      }
        // else fall through
    case 1: // delete
      {
        const char* string = Tcl_GetStringFromObj(objv[2], 0);

        MkWorkspace::Item* np = work.Find(f4_GetToken(string));
        if (np == 0 && id != 4)
          return Fail("no storage with this name");

        c4_String s = f4_GetToken(string);
        if (s.IsEmpty() || *string != 0)
          return Fail("unrecognized view name");

        if (id == 0)
        {
	  KeepRef o = tcl_NewStringObj(s);
	  list2desc(objv[3], o);
          const char* desc = Tcl_GetStringFromObj(o, 0);
          if (desc && *desc)
	    np->_storage.GetAs(desc);
        }
        else
        {
          c4_View v = np->_storage;
          if (v.FindPropIndexByName(s) < 0)
            return Fail("no view with this name");
          
          np->_storage.GetAs(s);
        }

        np->ForceRefresh(); // make sure views are re-attached
      }
      break;

    case 2: // size
      {
        c4_View view = asView(objv[2]);

        if (objc > 3) {
          int i = tcl_GetIntFromObj(objv[3]);
	  if (_error)
	    return _error;
          view.SetSize(i);
	}

        Tcl_SetIntObj(tcl_GetObjResult(), view.GetSize());
        return _error; // different result
      }
      break;

    case 3: // properties
    case 8: // info (will be deprecated)
      {
        c4_View view = asView(objv[2]);
        Tcl_Obj* result = tcl_GetObjResult();

        for (int i = 0; i < view.NumProperties() && !_error; ++i)
        {
          const c4_Property& prop = view.NthProperty(i);

          c4_String s = prop.Name();
          if (prop.Type() != 'S')
          {
            s += ":";
            s += prop.Type();
          }

          tcl_ListObjAppendElement(result, tcl_NewStringObj(s));
        }

        return _error;
      }

    case 4: // locate
      {
        c4_View view = asView(objv[2]);

        bool force = strcmp(Tcl_GetStringFromObj(objv[3], 0), "-force") == 0;
        int k = force ? 4 : 3; 

        if (k >= objc)
          return Fail("no key specified");

        c4_Row key;

        for (int i = 0; k + i < objc; ++i)
        {
          const c4_Property& prop = view.NthProperty(i);
          _error = SetAsObj(interp, key, prop, objv[k+i]);
          if (_error)
            return _error;
        }

        int pos;
        if (view.Locate(key, &pos) == 0)
          if (force)
            view.InsertAt(pos, key);
          else
            return Fail("key not found");

        Tcl_SetIntObj(tcl_GetObjResult(), pos);
        return _error;
      }

    case 5: // restrict
      {
        if (objc <= 5)
          return Fail("too few args");

        c4_View view = asView(objv[2]);
        c4_View hview = asView(objv[3]);
        int nkeys = tcl_GetIntFromObj(objv[4]);
        view = view.Hash(hview, nkeys);

        c4_Row key;

        for (int i = 0; i+5 < objc; ++i)
        {
          const c4_Property& prop = view.NthProperty(i);
          _error = SetAsObj(interp, key, prop, objv[i+5]);
          if (_error)
            return _error;
        }

        int pos = 0;
        int count = view.GetSize();
        int result = view.RestrictSearch(key, pos, count);

        Tcl_Obj* r = tcl_GetObjResult();
        tcl_ListObjAppendElement(r, Tcl_NewIntObj(result));
        tcl_ListObjAppendElement(r, Tcl_NewIntObj(pos));
        tcl_ListObjAppendElement(r, Tcl_NewIntObj(count));
        return _error;
      }

    case 6: // open
      {
        if (objc < 3 || objc > 4)
          return Fail("wrong number of args");

        c4_View view = asView(objv[2]);
        const char* name = objc > 3 ? Tcl_GetStringFromObj(objv[3], 0)
                      : "";

        MkView* cmd = new MkView (interp, view, name);
        Tcl_SetStringObj(tcl_GetObjResult(),
                  (char*) (const char*) cmd->CmdName(), -1);
        return _error;
      }

    case 7: // new ?name?
      {
        if (objc < 2 || objc > 3)
          return Fail("wrong number of args");

        c4_View view;
        const char* name = objc > 3 ? Tcl_GetStringFromObj(objv[2], 0)
                      : "";

        MkView* cmd = new MkView (interp, view, name);
        Tcl_SetStringObj(tcl_GetObjResult(),
                  (char*) (const char*) cmd->CmdName(), -1);
        return _error;
      }
  }

  if (_error)
    return _error;

  return tcl_SetObjResult(objv[2]);
}

int MkTcl::LoopCmd()
{
  Tcl_Obj* value = objc >= 4 ? Tcl_ObjSetVar2(interp, objv [1], 0, objv [2],
                  				TCL_LEAVE_ERR_MSG)
    			     : Tcl_ObjGetVar2(interp, objv[1], 0,
			       			TCL_LEAVE_ERR_MSG);
  if (value == 0)
    return Fail(); // has to exist, can't be valid otherwise

  long first = objc >= 5 ? tcl_ExprLongObj (objv [3]) : 0;
  long limit = objc >= 6 ? tcl_ExprLongObj (objv [4]) : asView(value).GetSize();
  long incr = objc >= 7 ? tcl_ExprLongObj (objv [5]) : 1;

  if (incr == 0)
    Fail("increment must be nonzero");

  if (_error)
    return _error;
    
  Tcl_Obj* var = objv[1];
  Tcl_Obj* cmd = objv[objc-1];

  for (int i = first; ; i += incr)
  {
    if (Tcl_IsShared(value))
      value = Tcl_DuplicateObj(value);

    changeIndex(value) = i;

    if (Tcl_ObjSetVar2(interp, var, 0, value, TCL_LEAVE_ERR_MSG) == 0)
      return Fail();

    if (!(i < limit && incr > 0 || i > limit && incr < 0)) break;

    Tcl_MutexUnlock(&mkMutex);
    _error = Tcl_EvalObj(interp, cmd);
    Tcl_MutexLock(&mkMutex);

    if (_error == TCL_CONTINUE)
      _error = TCL_OK;

    if (_error) {
      if (_error == TCL_BREAK)
	_error = TCL_OK;
      else if (_error == TCL_ERROR) {
	char msg[100];
	sprintf(msg, "\n  (\"mk::loop\" body line %d)",
	  interp->errorLine);
	Tcl_AddObjErrorInfo(interp, msg, -1);
      }
      break;
    }
  }

  if (_error == TCL_OK)
    Tcl_ResetResult(interp);

  return _error;
}

int MkTcl::CursorCmd()
{
  int id = tcl_GetIndexFromObj(objv[1], cursorCmds);
  if (id < 0)
    return _error;

  Tcl_Obj* name = objv[2];

  Tcl_Obj* var = 0;

  if (id == 0)
  {
    var = objc < 4 ? AllocateNewTempRow(work)
             : objv[3];  // create expects a path

    --objc;   // shift so the index will be picked up if present
    ++objv;
  }
  else  // alter an existing cursor
  { 
    var = Tcl_ObjGetVar2(interp, name, 0, TCL_LEAVE_ERR_MSG);
    if (var == 0)
      return Fail(); // has to exist, can't be valid otherwise
  }

    // about to modify, so make sure we are sole owners
  Tcl_Obj* original = 0;
  if (Tcl_IsShared(var))
  {
    original = var;
    var = Tcl_DuplicateObj(var);
  }

  KeepRef keeper (var);

  c4_View view = asView(var);

  int value;
  if (objc <= 3)
  {
    if (id == 1) // position without value returns current value
    {
      Tcl_SetIntObj(tcl_GetObjResult(), AsIndex(var));
      return _error;
    }

    value = id == 0 ? 0 : 1; // create defaults to 0, incr defaults to 1
  }
  else if (Tcl_GetIntFromObj(interp, objv[3], &value) != TCL_OK)
  {
    const char* step = Tcl_GetStringFromObj(objv[3], 0);
    if (strcmp(step, "end") == 0)
      value = view.GetSize() - 1;
    else
    {
      if (original)
        Tcl_DecrRefCount(original);
      return Fail();
    }
  }

  if (id < 2)
    changeIndex(var) = value;
  else
    changeIndex(var) += value;

  Tcl_Obj* result = Tcl_ObjSetVar2(interp, name, 0, var, TCL_LEAVE_ERR_MSG);
  if (result == 0)
    return Fail();

  return tcl_SetObjResult(result);
}

int MkTcl::SelectCmd()
{
  TclSelector sel (interp, asView(objv[1]));

  static const char* opts [] =
  {
    "-min",   // 0
    "-max",   // 1
    "-exact", // 2
    "-glob",  // 3
    "-regexp",  // 4
    "-keyword", // 5
    "-first", // 6
    "-count", // 7
    "-sort",  // 8
    "-rsort", // 9
    "-globnc",  // 10
    0
  };

  while (objc >= 4)
  {
    objc -= 2;    // gobble next two arguments
    objv += 2;

      // at this point, *objv is the next option, and objc >= 2

    int id = -1;

    const char* p = Tcl_GetStringFromObj(*objv, 0);
    if (p && *p == '-')
    {
      id = tcl_GetIndexFromObj(*objv, opts);
      if (id < 0)
        return _error;
    }

    switch (id)
    {
      case -1:  // prop value : case-insensitive match
        {
          _error = sel.AddCondition(-1, objv[0], objv[1]);
        }
        break;

      case 0:   // -min prop value : property must be greater or equal to value
      case 1:   // -max prop value : property must be less or equal to value
      case 2:   // -exact prop value : exact case-sensitive match
      case 3:   // -glob prop pattern : match "glob" expression wildcard
      case 4:   // -regexp prop pattern : match specified regular expression
      case 5:   // -keyword prop prefix : match keyword in given property
      case 10:  // -globnc prop pattern : match "glob", but ignore case
        {
          if (objc < 3)
            return Fail("not enough arguments");

          _error = sel.AddCondition(id, objv[1], objv[2]);

          --objc;   // gobble a third argument
          ++objv;
        }
        break;

      case 6:   // -first pos : searching starts at specified row index
      case 7:   // -count num : return no more than this many results
        {
          int n = tcl_GetIntFromObj(objv[1]);
          if (_error)
            return _error;

          if (id == 6)
            sel._first = n;
          else
            sel._count = n;
        }
        break;

      case 8:   // -sort prop : sort on one or more properties, ascending
      case 9:   // -rsort prop : sort on one or more properties, descending
        {
          c4_View props = sel.GetAsProps(objv[1]);
          for (int i = 0; i < props.NumProperties(); ++i)
          {
            const c4_Property& prop = props.NthProperty(i);
            
            sel._sortProps.AddProperty(prop);
            if (id == 9)
              sel._sortRevProps.AddProperty(prop);
          }
        }
        break;
    }
  }

  if (_error)
    return _error;

  return sel.DoSelect(tcl_GetObjResult());
}

int MkTcl::ChannelCmd()
{
  c4_RowRef row = asRowRef(objv[1]);
  MkPath& path = AsPath(objv[1]);
  int index = AsIndex(objv[1]);

  if (_error)
    return _error;

  const c4_BytesProp& memo = (const c4_BytesProp&) AsProperty(objv[2], path._view);

  int id = objc < 4 ? 0 : tcl_GetIndexFromObj(objv[3], channelCmds);
  if (id < 0)
    return _error;

  const char* p = path._path;
  MkWorkspace::Item* ip = work.Find(f4_GetToken(p));
  if (ip == 0)
    return Fail("no storage with this name");

  if (id == 1)
    memo (row).SetData(c4_Bytes()); // truncate the existing contents

  int mode = id == 0 ? TCL_READABLE :
         id == 1 ? TCL_WRITABLE :
             TCL_READABLE | TCL_WRITABLE;

  MkChannel* mkChan = new MkChannel (ip->_storage, path._view, memo, index);
  d4_assert(mkChan != 0);

  static int mkChanSeq = 0;
  char buffer [10];
  sprintf(buffer, "mk%d", ++mkChanSeq);

  mkChan->_watchMask = 0;
  mkChan->_validMask = mode;
  mkChan->_interp = interp;
  mkChan->_chan = Tcl_CreateChannel(&mkChannelType, buffer, 
                      (ClientData) mkChan, mode);

  if (id == 2)
    Tcl_Seek(mkChan->_chan, 0, SEEK_END);

//  Tcl_CreateEventSource(mkSetupProc, mkCheckProc, (ClientData)mkChan);

  Tcl_RegisterChannel(interp, mkChan->_chan);

  if (_error)
    return _error;

  KeepRef o = tcl_NewStringObj(buffer);
  return tcl_SetObjResult(o);
}

#if MKSQL

  class TclSQL : public MkSQL
  {
  public:

    TclSQL (Tcl_Interp* ip_, const c4_Storage& sp_) 
      : _interp (ip_)
    {
      Connect(sp_);
    }
    
    int ExecCmd(int objc_, Tcl_Obj* const* objv_)
    {
      if (objc_ != 2)
        return TCL_ERROR;

      const char* statement = Tcl_GetStringFromObj(objv_[1], 0);
      c4_View v = Execute(statement);
      if (_error)
      {
        Tcl_SetResult(_interp, "execute failed",
                      TCL_STATIC);
        return TCL_ERROR;
      }

      Tcl_Obj* list = Tcl_GetObjResult(_interp);
      
      for (int n = 0; n < v.GetSize(); ++n)
      {
        c4_RowRef row = v[n];

        Tcl_Obj* result = Tcl_NewObj();

        for (int i = 0; i < v.NumProperties(); ++i)
        {
          const c4_Property& prop = v.NthProperty(i);
          c4_String name = prop.Name();

          if (prop.Type() == 'V')
            continue; // omit subviews

          Tcl_ListObjAppendElement(_interp, result, GetAsObj(row, prop));
        }

        Tcl_ListObjAppendElement(_interp, list, result);
      }

      return TCL_OK;
    }

    static int DoCmd(ClientData cd_, Tcl_Interp* ip_,
                int oc_, Tcl_Obj* const* ov_)
    {
      TclSQL* sql = (TclSQL*) cd_;

      return sql->ExecCmd(oc_, ov_);
    }

    static void DelCmd(ClientData cd_)
    {
      delete (TclSQL*) cd_;
    }

    Tcl_Interp* _interp;
  };

int MkTcl::SqlAuxCmd()
{
  const char* dbName = Tcl_GetStringFromObj(objv[1], 0);
  const char* cmdName = Tcl_GetStringFromObj(objv[2], 0);

  MkWorkspace::Item* np = work.Find(dbName);
  if (np == 0)
    return Fail("no storage with this name");

  TclSQL* sql = new TclSQL (interp, np->_storage);
  if (sql == 0 || sql->_error)
    return Fail("connect failed");

  Tcl_CreateObjCommand(interp, (char*) cmdName, TclSQL::DoCmd, sql, TclSQL::DelCmd);

  if (_error)
    return _error;

  KeepRef o = tcl_NewStringObj("abc");
  return tcl_SetObjResult(o);
}
#endif

int MkTcl::Execute(int oc, Tcl_Obj* const* ov)
{
  struct CmdDef
  {
    int (MkTcl::*proc)();
    int min;
    int max;
    const char* desc;
  };

  static CmdDef defTab [] =
  {
  // the "&MkTcl::" stuff is required for Mac cwpro2
    { &MkTcl::GetCmd,     2, 0, "get cursor ?prop ...?" },
    { &MkTcl::SetCmd,     3, 0, "set cursor prop ?value prop value ...?" },
    { &MkTcl::CursorCmd,  3, 5, "cursor option cursorname ?...?" },
    { &MkTcl::RowCmd,     2, 0, "row option ?cursor ...?" },
    { &MkTcl::ViewCmd,    2, 0, "view option view ?arg?" },
    { &MkTcl::FileCmd,    2, 6, "file option ?tag ...?" },
    { &MkTcl::LoopCmd,    3, 7, "loop cursor ?path first limit incr? {cmds}" },
    { &MkTcl::SelectCmd,  2, 0, "select path ?...?" },
    { &MkTcl::ChannelCmd, 3, 4, "channel path prop ?mode?" },
#if MKSQL
    { &MkTcl::SqlAuxCmd,  3, 3, "cmd db" },
#endif
    { 0,          0,  0,  0 },
  };

  _error = TCL_OK;

  CmdDef& cd = defTab[id];

  objc = oc;
  objv = ov;

  if (oc < cd.min || (cd.max > 0 && oc > cd.max))
  {
    msg = "wrong # args: should be \"mk::";
    msg += cd.desc;
    msg += "\"";

    return Fail(msg);
  }

  Tcl_MutexLock(&mkMutex);
  int result = (this->*cd.proc)();
  Tcl_MutexUnlock(&mkMutex);
  return result;
}

///////////////////////////////////////////////////////////////////////////////

void MkWorkspace::CleanupCommands()
{
  for (int i = 0; i < _commands.GetSize(); ++i)
    delete (MkTcl*) _commands.GetAt(i);
  _commands.SetSize(0);
}

static void ExitProc(ClientData cd_)
{
  delete (MkWorkspace*) cd_;
}

static void DelProc(ClientData cd_, Tcl_Interp* ip_)
{
    // got here through assoc's delproc, don't trigger again on exit
  Tcl_DeleteExitHandler(ExitProc, cd_);
  ExitProc(cd_);
}

static int
Mktcl_Cmds(Tcl_Interp* interp, bool /*safe*/)
{
  if (!MyInitStubs(interp)) return TCL_ERROR;

    // Create workspace if not present.
  MkWorkspace* ws = (MkWorkspace*) Tcl_GetAssocData(interp, "mk4tcl", 0);
  if (ws == 0)
  {
    Tcl_RegisterObjType (&mkPropertyType);
    Tcl_RegisterObjType (&mkCursorType);

    ws = new MkWorkspace (interp);
      // add an association with delproc to catch "interp delete",
      // since that does not seem to trigger exitproc handling (!)
    Tcl_SetAssocData(interp, "mk4tcl", DelProc, ws);
    Tcl_CreateExitHandler(ExitProc, ws);
  }

    // this list must match the "CmdDef defTab []" above.
  static const char* cmds [] =
  {
    "get",
    "set",
    "cursor",
    "row",
    "view",
    "file",
    "loop",
    "select",
    "channel",
#if MKSQL
    "Q",
#endif
    0
  };

  c4_String prefix = "mk::";

  for (int i = 0; cmds[i]; ++i)
    ws->DefCmd(new MkTcl (ws, interp, i, prefix + cmds[i]));

  return Tcl_PkgProvide(interp, "Mk4tcl", "2.4.9.3");
}

///////////////////////////////////////////////////////////////////////////////
// The proper way to load this extension is with "load mk4tcl.{so,dll} mk4tcl",
// but 8.0.2 load guesses module "mk" instead of "mk4tcl" (it stops at digits)
// when the third argument is omitted, allow that too: "load mk4tcl.{so,dll}".

#if defined (__MWERKS__)
#pragma export on
#endif

extern "C" DLLEXPORT int Mk4tcl_Init(Tcl_Interp* interp)
{
  return Mktcl_Cmds(interp, false);
}

extern "C" DLLEXPORT int Mk_Init(Tcl_Interp* interp)
{
  return Mktcl_Cmds(interp, false);
}

extern "C" DLLEXPORT int Mk4tcl_SafeInit(Tcl_Interp* interp)
{
  return Mktcl_Cmds(interp, true);
}

extern "C" DLLEXPORT int Mk_SafeInit(Tcl_Interp* interp)
{
  return Mktcl_Cmds(interp, true);
}

///////////////////////////////////////////////////////////////////////////////

