summaryrefslogtreecommitdiffstats
path: root/tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.c
diff options
context:
space:
mode:
Diffstat (limited to 'tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.c')
-rw-r--r--tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.c1481
1 files changed, 0 insertions, 1481 deletions
diff --git a/tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.c b/tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.c
deleted file mode 100644
index 8a557f7..0000000
--- a/tcl8.6/pkgs/thread2.8.4/generic/tclXkeylist.c
+++ /dev/null
@@ -1,1481 +0,0 @@
-/*
- * tclXkeylist.c --
- *
- * Extended Tcl keyed list commands and interfaces.
- *-----------------------------------------------------------------------------
- * Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans.
- *
- * Permission to use, copy, modify, and distribute this software and its
- * documentation for any purpose and without fee is hereby granted, provided
- * that the above copyright notice appear in all copies. Karl Lehenbauer and
- * Mark Diekhans make no representations about the suitability of this
- * software for any purpose. It is provided "as is" without express or
- * implied warranty.
- *
- *-----------------------------------------------------------------------------
- *
- * This file was synthetized from the TclX distribution and made
- * self-containing in order to encapsulate the keyed list datatype
- * for the inclusion in the Tcl threading extension. I have made
- * some minor changes to it in order to get internal object handling
- * thread-safe and allow for this datatype to be used from within
- * the thread shared variables implementation.
- *
- * For any questions, contant Zoran Vasiljevic (zoran@archiware.com)
- *-----------------------------------------------------------------------------
- */
-
-#include "tclThreadInt.h"
-#include "threadSvCmd.h"
-#include "tclXkeylist.h"
-#include <stdarg.h>
-
-#ifdef STATIC_BUILD
-#if TCL_MAJOR_VERSION >= 9
-/*
- * Static build, Tcl >= 9, compile-time decision to disable T_ROT calls.
- */
-#undef Tcl_RegisterObjType
-#define Tcl_RegisterObjType(typePtr) (typePtr)->setFromAnyProc = NULL
-#else
-/*
- * Static build, Tcl <= 9 --> T_ROT is directly linked, no stubs
- * Nothing needs to be done
- */
-#endif
-#else /* !STATIC_BUILD */
-/*
- * Dynamic build. Assume building with stubs (xx) and make a run-time
- * decision regarding T_ROT.
- * (Ad xx): Should be checked. Without stubs we have to go like static.
- */
-#undef Tcl_RegisterObjType
-#define Tcl_RegisterObjType(typePtr) if (threadTclVersion<90) { \
- ((void (*)(const Tcl_ObjType *))((&(tclStubsPtr->tcl_PkgProvideEx))[211]))(typePtr); \
-} else { \
- (typePtr)->setFromAnyProc = NULL; \
-}
-#endif /* eof STATIC_BUILD */
-
-/*---------------------------------------------------------------------------*/
-/*---------------------------------------------------------------------------*/
-/* Stuff copied verbatim from the rest of TclX to avoid dependencies */
-/*---------------------------------------------------------------------------*/
-/*---------------------------------------------------------------------------*/
-
-/*
- * Assert macro for use in TclX. Some GCCs libraries are missing a function
- * used by their macro, so we define out own.
- */
-
-#ifdef TCLX_DEBUG
-# define TclX_Assert(expr) ((expr) ? (void)0 : \
- panic("TclX assertion failure: %s:%d \"%s\"\n",\
- __FILE__, __LINE__, "expr"))
-#else
-# define TclX_Assert(expr)
-#endif
-
-/*
- * Macro that behaves like strdup, only uses ckalloc. Also macro that does the
- * same with a string that might contain zero bytes,
- */
-
-#define ckstrdup(sourceStr) \
- (strcpy (ckalloc (strlen (sourceStr) + 1), sourceStr))
-
-#define ckbinstrdup(sourceStr, length) \
- ((char *) memcpy (ckalloc (length + 1), sourceStr, length + 1))
-
-/*
- * Used to return argument messages by most commands.
- */
-static const char *tclXWrongArgs = "wrong # args: ";
-
-static const Tcl_ObjType *listType;
-
-/*-----------------------------------------------------------------------------
- * TclX_IsNullObj --
- *
- * Check if an object is {}, either in list or zero-lemngth string form, with
- * out forcing a conversion.
- *
- * Parameters:
- * o objPtr - Object to check.
- * Returns:
- * 1 if NULL, 0 if not.
- *-----------------------------------------------------------------------------
- */
-static int
-TclX_IsNullObj (objPtr)
- Tcl_Obj *objPtr;
-{
- if (objPtr->typePtr == NULL) {
- return (objPtr->length == 0);
- } else if (objPtr->typePtr == listType) {
- int length;
- Tcl_ListObjLength(NULL, objPtr, &length);
- return (length == 0);
- }
- (void)Tcl_GetString(objPtr);
- return (objPtr->length == 0);
-}
-
-/*-----------------------------------------------------------------------------
- * TclX_AppendObjResult --
- *
- * Append a variable number of strings onto the object result already
- * present for an interpreter. If the object is shared, the current contents
- * are discarded.
- *
- * Parameters:
- * o interp - Interpreter to set the result in.
- * o args - Strings to append, terminated by a NULL.
- *-----------------------------------------------------------------------------
- */
-static void
-TclX_AppendObjResult(Tcl_Interp *interp, ...)
-{
- Tcl_Obj *resultPtr;
- va_list argList;
- char *string;
-
- va_start(argList, interp);
- resultPtr = Tcl_GetObjResult (interp);
-
- if (Tcl_IsShared(resultPtr)) {
- resultPtr = Tcl_NewStringObj((char *)NULL, 0);
- Tcl_SetObjResult(interp, resultPtr);
- }
-
- while (1) {
- string = va_arg(argList, char *);
- if (string == NULL) {
- break;
- }
- Tcl_AppendToObj (resultPtr, string, -1);
- }
- va_end(argList);
-}
-
-/*-----------------------------------------------------------------------------
- * TclX_WrongArgs --
- *
- * Easily create "wrong # args" error messages.
- *
- * Parameters:
- * o commandNameObj - Object containing name of command (objv[0])
- * o string - Text message to append.
- * Returns:
- * TCL_ERROR
- *-----------------------------------------------------------------------------
- */
-static int
-TclX_WrongArgs (interp, commandNameObj, string)
- Tcl_Interp *interp;
- Tcl_Obj *commandNameObj;
- char *string;
-{
- const char *commandName = Tcl_GetString(commandNameObj);
- Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
-
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj (resultPtr,
- tclXWrongArgs,
- commandName,
- (char *)NULL);
-
- if (*string != '\0') {
- Tcl_AppendStringsToObj (resultPtr, " ", string, (char *)NULL);
- }
- return TCL_ERROR;
-}
-
-/*---------------------------------------------------------------------------*/
-/*---------------------------------------------------------------------------*/
-/* Here is where the original file begins */
-/*---------------------------------------------------------------------------*/
-/*---------------------------------------------------------------------------*/
-
-/*
- * Keyed lists are stored as arrays recursively defined objects. The data
- * portion of a keyed list entry is a Tcl_Obj which may be a keyed list object
- * or any other Tcl object. Since determine the structure of a keyed list is
- * lazy (you don't know if an element is data or another keyed list) until it
- * is accessed, the object can be transformed into a keyed list from a Tcl
- * string or list.
- */
-
-/*
- * An entry in a keyed list array. (FIX: Should key be object?)
- */
-typedef struct {
- char *key;
- Tcl_Obj *valuePtr;
-} keylEntry_t;
-
-/*
- * Internal representation of a keyed list object.
- */
-typedef struct {
- int arraySize; /* Current slots available in the array. */
- int numEntries; /* Number of actual entries in the array. */
- keylEntry_t *entries; /* Array of keyed list entries. */
-} keylIntObj_t;
-
-/*
- * Amount to increment array size by when it needs to grow.
- */
-#define KEYEDLIST_ARRAY_INCR_SIZE 16
-
-/*
- * Macro to duplicate a child entry of a keyed list if it is share by more
- * than the parent.
- */
-#define DupSharedKeyListChild(keylIntPtr, idx) \
- if (Tcl_IsShared (keylIntPtr->entries [idx].valuePtr)) { \
- keylIntPtr->entries [idx].valuePtr = \
- Tcl_DuplicateObj (keylIntPtr->entries [idx].valuePtr); \
- Tcl_IncrRefCount (keylIntPtr->entries [idx].valuePtr); \
- }
-
-/*
- * Macros to validate an keyed list object or internal representation
- */
-#ifdef TCLX_DEBUG
-# define KEYL_OBJ_ASSERT(keylAPtr) {\
- TclX_Assert (keylAPtr->typePtr == &keyedListType); \
- ValidateKeyedList (keylAIntPtr); \
- }
-# define KEYL_REP_ASSERT(keylAIntPtr) \
- ValidateKeyedList (keylAIntPtr)
-#else
-# define KEYL_REP_ASSERT(keylAIntPtr)
-#endif
-
-
-/*
- * Prototypes of internal functions.
- */
-#ifdef TCLX_DEBUG
-static void
-ValidateKeyedList(keylIntObj_t *keylIntPtr);
-#endif
-
-static int
-ValidateKey(Tcl_Interp *interp,
- const char *key,
- size_t keyLen,
- int isPath);
-
-static keylIntObj_t *
-AllocKeyedListIntRep(void);
-
-static void
-FreeKeyedListData(keylIntObj_t *keylIntPtr);
-
-static void
-EnsureKeyedListSpace(keylIntObj_t *keylIntPtr,
- int newNumEntries);
-
-static void
-DeleteKeyedListEntry(keylIntObj_t *keylIntPtr,
- int entryIdx);
-
-static int
-FindKeyedListEntry(keylIntObj_t *keylIntPtr,
- const char *key,
- int *keyLenPtr,
- const char **nextSubKeyPtr);
-
-static int
-ObjToKeyedListEntry(Tcl_Interp *interp,
- Tcl_Obj *objPtr,
- keylEntry_t *entryPtr);
-
-static void
-DupKeyedListInternalRep(Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr);
-
-static void
-FreeKeyedListInternalRep(Tcl_Obj *keylPtr);
-
-static int
-SetKeyedListFromAny(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
-
-static void
-UpdateStringOfKeyedList(Tcl_Obj *keylPtr);
-
-static int
-Tcl_KeylgetObjCmd(ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[]);
-
-static int
-Tcl_KeylsetObjCmd(ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[]);
-
-static int
-Tcl_KeyldelObjCmd(ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[]);
-
-static int
-Tcl_KeylkeysObjCmd(ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[]);
-
-/*
- * Type definition.
- */
-Tcl_ObjType keyedListType = {
- "keyedList", /* name */
- FreeKeyedListInternalRep, /* freeIntRepProc */
- DupKeyedListInternalRep, /* dupIntRepProc */
- UpdateStringOfKeyedList, /* updateStringProc */
- SetKeyedListFromAny /* setFromAnyProc */
-};
-
-
-/*-----------------------------------------------------------------------------
- * ValidateKeyedList --
- * Validate a keyed list (only when TCLX_DEBUG is enabled).
- * Parameters:
- * o keylIntPtr - Keyed list internal representation.
- *-----------------------------------------------------------------------------
- */
-#ifdef TCLX_DEBUG
-static void
-ValidateKeyedList (keylIntPtr)
- keylIntObj_t *keylIntPtr;
-{
- int idx;
-
- TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries);
- TclX_Assert (keylIntPtr->arraySize >= 0);
- TclX_Assert (keylIntPtr->numEntries >= 0);
- TclX_Assert ((keylIntPtr->arraySize > 0) ?
- (keylIntPtr->entries != NULL) : 1);
- TclX_Assert ((keylIntPtr->numEntries > 0) ?
- (keylIntPtr->entries != NULL) : 1);
-
- for (idx = 0; idx < keylIntPtr->numEntries; idx++) {
- keylEntry_t *entryPtr = &(keylIntPtr->entries [idx]);
- TclX_Assert (entryPtr->key != NULL);
- TclX_Assert (entryPtr->valuePtr->refCount >= 1);
- if (entryPtr->valuePtr->typePtr == &keyedListType) {
- ValidateKeyedList (entryPtr->valuePtr->internalRep.twoPtrValue.ptr1);
- }
- }
-}
-#endif
-
-/*-----------------------------------------------------------------------------
- * ValidateKey --
- * Check that a key or keypath string is a valid value.
- *
- * Parameters:
- * o interp - Used to return error messages.
- * o key - Key string to check.
- * o keyLen - Length of the string, used to check for binary data.
- * o isPath - 1 if this is a key path, 0 if its a simple key and
- * thus "." is illegal.
- * Returns:
- * TCL_OK or TCL_ERROR.
- *-----------------------------------------------------------------------------
- */
-static int
-ValidateKey(interp, key, keyLen, isPath)
- Tcl_Interp *interp;
- const char *key;
- size_t keyLen;
- int isPath;
-{
- const char *keyp;
-
- if (strlen(key) != keyLen) {
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "keyed list key may not be a ",
- "binary string", (char *) NULL);
- return TCL_ERROR;
- }
- if (key[0] == '\0') {
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "keyed list key may not be an ",
- "empty string", (char *) NULL);
- return TCL_ERROR;
- }
- for (keyp = key; *keyp != '\0'; keyp++) {
- if ((!isPath) && (*keyp == '.')) {
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "keyed list key may not contain a \".\"; ",
- "it is used as a separator in key paths",
- (char *) NULL);
- return TCL_ERROR;
- }
- }
- return TCL_OK;
-}
-
-
-/*-----------------------------------------------------------------------------
- * AllocKeyedListIntRep --
- * Allocate an and initialize the keyed list internal representation.
- *
- * Returns:
- * A pointer to the keyed list internal structure.
- *-----------------------------------------------------------------------------
- */
-static keylIntObj_t *
-AllocKeyedListIntRep ()
-{
- keylIntObj_t *keylIntPtr;
-
- keylIntPtr = (keylIntObj_t *) ckalloc (sizeof (keylIntObj_t));
-
- keylIntPtr->arraySize = 0;
- keylIntPtr->numEntries = 0;
- keylIntPtr->entries = NULL;
-
- return keylIntPtr;
-}
-
-/*-----------------------------------------------------------------------------
- * FreeKeyedListData --
- * Free the internal representation of a keyed list.
- *
- * Parameters:
- * o keylIntPtr - Keyed list internal structure to free.
- *-----------------------------------------------------------------------------
- */
-static void
-FreeKeyedListData (keylIntPtr)
- keylIntObj_t *keylIntPtr;
-{
- int idx;
-
- for (idx = 0; idx < keylIntPtr->numEntries ; idx++) {
- ckfree (keylIntPtr->entries [idx].key);
- Tcl_DecrRefCount (keylIntPtr->entries [idx].valuePtr);
- }
- if (keylIntPtr->entries != NULL)
- ckfree ((char *) keylIntPtr->entries);
- ckfree ((char *) keylIntPtr);
-}
-
-/*-----------------------------------------------------------------------------
- * EnsureKeyedListSpace --
- * Ensure there is enough room in a keyed list array for a certain number
- * of entries, expanding if necessary.
- *
- * Parameters:
- * o keylIntPtr - Keyed list internal representation.
- * o newNumEntries - The number of entries that are going to be added to
- * the keyed list.
- *-----------------------------------------------------------------------------
- */
-static void
-EnsureKeyedListSpace (keylIntPtr, newNumEntries)
- keylIntObj_t *keylIntPtr;
- int newNumEntries;
-{
- KEYL_REP_ASSERT (keylIntPtr);
-
- if ((keylIntPtr->arraySize - keylIntPtr->numEntries) < newNumEntries) {
- int newSize = keylIntPtr->arraySize + newNumEntries +
- KEYEDLIST_ARRAY_INCR_SIZE;
- if (keylIntPtr->entries == NULL) {
- keylIntPtr->entries = (keylEntry_t *)
- ckalloc (newSize * sizeof (keylEntry_t));
- } else {
- keylIntPtr->entries = (keylEntry_t *)
- ckrealloc ((void *) keylIntPtr->entries,
- newSize * sizeof (keylEntry_t));
- }
- keylIntPtr->arraySize = newSize;
- }
-
- KEYL_REP_ASSERT (keylIntPtr);
-}
-
-/*-----------------------------------------------------------------------------
- * DeleteKeyedListEntry --
- * Delete an entry from a keyed list.
- *
- * Parameters:
- * o keylIntPtr - Keyed list internal representation.
- * o entryIdx - Index of entry to delete.
- *-----------------------------------------------------------------------------
- */
-static void
-DeleteKeyedListEntry (keylIntPtr, entryIdx)
- keylIntObj_t *keylIntPtr;
- int entryIdx;
-{
- int idx;
-
- ckfree (keylIntPtr->entries [entryIdx].key);
- Tcl_DecrRefCount (keylIntPtr->entries [entryIdx].valuePtr);
-
- for (idx = entryIdx; idx < keylIntPtr->numEntries - 1; idx++)
- keylIntPtr->entries [idx] = keylIntPtr->entries [idx + 1];
- keylIntPtr->numEntries--;
-
- KEYL_REP_ASSERT (keylIntPtr);
-}
-
-/*-----------------------------------------------------------------------------
- * FindKeyedListEntry --
- * Find an entry in keyed list.
- *
- * Parameters:
- * o keylIntPtr - Keyed list internal representation.
- * o key - Name of key to search for.
- * o keyLenPtr - In not NULL, the length of the key for this
- * level is returned here. This excludes subkeys and the `.' delimiters.
- * o nextSubKeyPtr - If not NULL, the start of the name of the next
- * sub-key within key is returned.
- * Returns:
- * Index of the entry or -1 if not found.
- *-----------------------------------------------------------------------------
- */
-static int
-FindKeyedListEntry (keylIntPtr, key, keyLenPtr, nextSubKeyPtr)
- keylIntObj_t *keylIntPtr;
- const char *key;
- int *keyLenPtr;
- const char **nextSubKeyPtr;
-{
- char *keySeparPtr;
- int keyLen, findIdx;
-
- keySeparPtr = strchr (key, '.');
- if (keySeparPtr != NULL) {
- keyLen = keySeparPtr - key;
- } else {
- keyLen = strlen (key);
- }
-
- for (findIdx = 0; findIdx < keylIntPtr->numEntries; findIdx++) {
- if ((strncmp (keylIntPtr->entries [findIdx].key, key, keyLen) == 0) &&
- (keylIntPtr->entries [findIdx].key [keyLen] == '\0'))
- break;
- }
-
- if (nextSubKeyPtr != NULL) {
- if (keySeparPtr == NULL) {
- *nextSubKeyPtr = NULL;
- } else {
- *nextSubKeyPtr = keySeparPtr + 1;
- }
- }
- if (keyLenPtr != NULL) {
- *keyLenPtr = keyLen;
- }
-
- if (findIdx >= keylIntPtr->numEntries) {
- return -1;
- }
-
- return findIdx;
-}
-
-/*-----------------------------------------------------------------------------
- * ObjToKeyedListEntry --
- * Convert an object to a keyed list entry. (Keyword/value pair).
- *
- * Parameters:
- * o interp - Used to return error messages, if not NULL.
- * o objPtr - Object to convert. Each entry must be a two element list,
- * with the first element being the key and the second being the
- * value.
- * o entryPtr - The keyed list entry to initialize from the object.
- * Returns:
- * TCL_OK or TCL_ERROR.
- *-----------------------------------------------------------------------------
- */
-static int
-ObjToKeyedListEntry (interp, objPtr, entryPtr)
- Tcl_Interp *interp;
- Tcl_Obj *objPtr;
- keylEntry_t *entryPtr;
-{
- int objc;
- Tcl_Obj **objv;
- const char *key;
-
- if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
- Tcl_ResetResult (interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult (interp),
- "keyed list entry not a valid list, ",
- "found \"",
- Tcl_GetString(objPtr),
- "\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (objc != 2) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult (interp),
- "keyed list entry must be a two ",
- "element list, found \"",
- Tcl_GetString(objPtr),
- "\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- key = Tcl_GetString(objv[0]);
- if (ValidateKey(interp, key, objv[0]->length, 0) == TCL_ERROR) {
- return TCL_ERROR;
- }
-
- entryPtr->key = ckstrdup(key);
- entryPtr->valuePtr = Tcl_DuplicateObj(objv [1]);
- Tcl_IncrRefCount(entryPtr->valuePtr);
-
- return TCL_OK;
-}
-
-/*-----------------------------------------------------------------------------
- * FreeKeyedListInternalRep --
- * Free the internal representation of a keyed list.
- *
- * Parameters:
- * o keylPtr - Keyed list object being deleted.
- *-----------------------------------------------------------------------------
- */
-static void
-FreeKeyedListInternalRep (keylPtr)
- Tcl_Obj *keylPtr;
-{
- FreeKeyedListData(keylPtr->internalRep.twoPtrValue.ptr1);
-}
-
-/*-----------------------------------------------------------------------------
- * DupKeyedListInternalRep --
- * Duplicate the internal representation of a keyed list.
- *
- * Parameters:
- * o srcPtr - Keyed list object to copy.
- * o copyPtr - Target object to copy internal representation to.
- *-----------------------------------------------------------------------------
- */
-static void
-DupKeyedListInternalRep (srcPtr, copyPtr)
- Tcl_Obj *srcPtr;
- Tcl_Obj *copyPtr;
-{
- keylIntObj_t *srcIntPtr =
- srcPtr->internalRep.twoPtrValue.ptr1;
- keylIntObj_t *copyIntPtr;
- int idx;
-
- KEYL_REP_ASSERT (srcIntPtr);
-
- copyIntPtr = (keylIntObj_t *) ckalloc (sizeof (keylIntObj_t));
- copyIntPtr->arraySize = srcIntPtr->arraySize;
- copyIntPtr->numEntries = srcIntPtr->numEntries;
- copyIntPtr->entries = (keylEntry_t *)
- ckalloc (copyIntPtr->arraySize * sizeof (keylEntry_t));
-
- for (idx = 0; idx < srcIntPtr->numEntries ; idx++) {
- copyIntPtr->entries [idx].key =
- ckstrdup (srcIntPtr->entries [idx].key);
- copyIntPtr->entries [idx].valuePtr = srcIntPtr->entries [idx].valuePtr;
- Tcl_IncrRefCount (copyIntPtr->entries [idx].valuePtr);
- }
-
- copyPtr->internalRep.twoPtrValue.ptr1 = copyIntPtr;
- copyPtr->typePtr = &keyedListType;
-
- KEYL_REP_ASSERT (copyIntPtr);
-}
-
-/*-----------------------------------------------------------------------------
- * DupKeyedListInternalRepShared --
- * Same as DupKeyedListInternalRepbut does not reference objects
- * from the srcPtr list. It duplicates them and stores the copy
- * in the list-copy object.
- *
- * Parameters:
- * o srcPtr - Keyed list object to copy.
- * o copyPtr - Target object to copy internal representation to.
- *-----------------------------------------------------------------------------
- */
-void
-DupKeyedListInternalRepShared (srcPtr, copyPtr)
- Tcl_Obj *srcPtr;
- Tcl_Obj *copyPtr;
-{
- keylIntObj_t *srcIntPtr =
- srcPtr->internalRep.twoPtrValue.ptr1;
- keylIntObj_t *copyIntPtr;
- int idx;
-
- KEYL_REP_ASSERT (srcIntPtr);
-
- copyIntPtr = (keylIntObj_t *) ckalloc (sizeof (keylIntObj_t));
- copyIntPtr->arraySize = srcIntPtr->arraySize;
- copyIntPtr->numEntries = srcIntPtr->numEntries;
- copyIntPtr->entries = (keylEntry_t *)
- ckalloc (copyIntPtr->arraySize * sizeof (keylEntry_t));
-
- for (idx = 0; idx < srcIntPtr->numEntries ; idx++) {
- copyIntPtr->entries [idx].key =
- ckstrdup (srcIntPtr->entries [idx].key);
- copyIntPtr->entries [idx].valuePtr =
- Sv_DuplicateObj (srcIntPtr->entries [idx].valuePtr);
- Tcl_IncrRefCount(copyIntPtr->entries [idx].valuePtr);
- }
-
- copyPtr->internalRep.twoPtrValue.ptr1 = copyIntPtr;
- copyPtr->typePtr = &keyedListType;
-
- KEYL_REP_ASSERT (copyIntPtr);
-}
-
-/*-----------------------------------------------------------------------------
- * SetKeyedListFromAny --
- * Convert an object to a keyed list from its string representation. Only
- * the first level is converted, as there is no way of knowing how far down
- * the keyed list recurses until lower levels are accessed.
- *
- * Parameters:
- * o objPtr - Object to convert to a keyed list.
- *-----------------------------------------------------------------------------
- */
-static int
-SetKeyedListFromAny (interp, objPtr)
- Tcl_Interp *interp;
- Tcl_Obj *objPtr;
-{
- keylIntObj_t *keylIntPtr;
- int idx, objc;
- Tcl_Obj **objv;
-
- if (Tcl_ListObjGetElements (interp, objPtr, &objc, &objv) != TCL_OK)
- return TCL_ERROR;
-
- keylIntPtr = AllocKeyedListIntRep ();
-
- EnsureKeyedListSpace (keylIntPtr, objc);
-
- for (idx = 0; idx < objc; idx++) {
- if (ObjToKeyedListEntry (interp, objv [idx],
- &(keylIntPtr->entries [keylIntPtr->numEntries])) != TCL_OK)
- goto errorExit;
- keylIntPtr->numEntries++;
- }
-
- if ((objPtr->typePtr != NULL) &&
- (objPtr->typePtr->freeIntRepProc != NULL)) {
- (*objPtr->typePtr->freeIntRepProc) (objPtr);
- }
- objPtr->internalRep.twoPtrValue.ptr1 = keylIntPtr;
- objPtr->typePtr = &keyedListType;
-
- KEYL_REP_ASSERT (keylIntPtr);
- return TCL_OK;
-
- errorExit:
- FreeKeyedListData (keylIntPtr);
- return TCL_ERROR;
-}
-
-/*-----------------------------------------------------------------------------
- * UpdateStringOfKeyedList --
- * Update the string representation of a keyed list.
- *
- * Parameters:
- * o objPtr - Object to convert to a keyed list.
- *-----------------------------------------------------------------------------
- */
-static void
-UpdateStringOfKeyedList (keylPtr)
- Tcl_Obj *keylPtr;
-{
-#define UPDATE_STATIC_SIZE 32
- int idx;
- Tcl_Obj **listObjv, *entryObjv [2], *tmpListObj;
- Tcl_Obj *staticListObjv [UPDATE_STATIC_SIZE];
- char *listStr;
- keylIntObj_t *keylIntPtr =
- keylPtr->internalRep.twoPtrValue.ptr1;
-
- /*
- * Conversion to strings is done via list objects to support binary data.
- */
- if (keylIntPtr->numEntries > UPDATE_STATIC_SIZE) {
- listObjv =
- (Tcl_Obj **) ckalloc (keylIntPtr->numEntries * sizeof (Tcl_Obj *));
- } else {
- listObjv = staticListObjv;
- }
-
- /*
- * Convert each keyed list entry to a two element list object. No
- * need to incr/decr ref counts, the list objects will take care of that.
- * FIX: Keeping key as string object will speed this up.
- */
- for (idx = 0; idx < keylIntPtr->numEntries; idx++) {
- entryObjv [0] =
- Tcl_NewStringObj(keylIntPtr->entries [idx].key,
- strlen (keylIntPtr->entries [idx].key));
- entryObjv [1] = keylIntPtr->entries [idx].valuePtr;
- listObjv [idx] = Tcl_NewListObj (2, entryObjv);
- }
-
- tmpListObj = Tcl_NewListObj (keylIntPtr->numEntries, listObjv);
- listStr = Tcl_GetString(tmpListObj);
- keylPtr->bytes = ckbinstrdup(listStr, tmpListObj->length);
- keylPtr->length = tmpListObj->length;
-
- Tcl_DecrRefCount (tmpListObj);
- if (listObjv != staticListObjv)
- ckfree ((void*) listObjv);
-}
-
-/*-----------------------------------------------------------------------------
- * TclX_NewKeyedListObj --
- * Create and initialize a new keyed list object.
- *
- * Returns:
- * A pointer to the object.
- *-----------------------------------------------------------------------------
- */
-Tcl_Obj *
-TclX_NewKeyedListObj ()
-{
- Tcl_Obj *keylPtr = Tcl_NewObj ();
- keylIntObj_t *keylIntPtr = AllocKeyedListIntRep ();
-
- keylPtr->internalRep.twoPtrValue.ptr1 = keylIntPtr;
- keylPtr->typePtr = &keyedListType;
- return keylPtr;
-}
-
-/*-----------------------------------------------------------------------------
- * TclX_KeyedListGet --
- * Retrieve a key value from a keyed list.
- *
- * Parameters:
- * o interp - Error message will be return in result if there is an error.
- * o keylPtr - Keyed list object to get key from.
- * o key - The name of the key to extract. Will recusively process sub-keys
- * seperated by `.'.
- * o valueObjPtrPtr - If the key is found, a pointer to the key object
- * is returned here. NULL is returned if the key is not present.
- * Returns:
- * o TCL_OK - If the key value was returned.
- * o TCL_BREAK - If the key was not found.
- * o TCL_ERROR - If an error occured.
- *-----------------------------------------------------------------------------
- */
-int
-TclX_KeyedListGet (interp, keylPtr, key, valuePtrPtr)
- Tcl_Interp *interp;
- Tcl_Obj *keylPtr;
- const char *key;
- Tcl_Obj **valuePtrPtr;
-{
- keylIntObj_t *keylIntPtr;
- const char *nextSubKey;
- int findIdx;
-
- if (keylPtr->typePtr != &keyedListType) {
- if (SetKeyedListFromAny(interp, keylPtr) != TCL_OK) {
- return TCL_ERROR;
- }
- }
- keylIntPtr = keylPtr->internalRep.twoPtrValue.ptr1;
- KEYL_REP_ASSERT (keylIntPtr);
-
- findIdx = FindKeyedListEntry (keylIntPtr, key, NULL, &nextSubKey);
-
- /*
- * If not found, return status.
- */
- if (findIdx < 0) {
- *valuePtrPtr = NULL;
- return TCL_BREAK;
- }
-
- /*
- * If we are at the last subkey, return the entry, otherwise recurse
- * down looking for the entry.
- */
- if (nextSubKey == NULL) {
- *valuePtrPtr = keylIntPtr->entries [findIdx].valuePtr;
- return TCL_OK;
- } else {
- return TclX_KeyedListGet (interp,
- keylIntPtr->entries [findIdx].valuePtr,
- nextSubKey,
- valuePtrPtr);
- }
-}
-
-/*-----------------------------------------------------------------------------
- * TclX_KeyedListSet --
- * Set a key value in keyed list object.
- *
- * Parameters:
- * o interp - Error message will be return in result object.
- * o keylPtr - Keyed list object to update.
- * o key - The name of the key to extract. Will recusively process
- * sub-key seperated by `.'.
- * o valueObjPtr - The value to set for the key.
- * Returns:
- * TCL_OK or TCL_ERROR.
- *-----------------------------------------------------------------------------
- */
-int
-TclX_KeyedListSet (interp, keylPtr, key, valuePtr)
- Tcl_Interp *interp;
- Tcl_Obj *keylPtr;
- const char *key;
- Tcl_Obj *valuePtr;
-{
- keylIntObj_t *keylIntPtr;
- const char *nextSubKey;
- int findIdx, keyLen, status;
- Tcl_Obj *newKeylPtr;
-
- if (keylPtr->typePtr != &keyedListType) {
- if (SetKeyedListFromAny(interp, keylPtr) != TCL_OK) {
- return TCL_ERROR;
- }
- }
- keylIntPtr = keylPtr->internalRep.twoPtrValue.ptr1;
- KEYL_REP_ASSERT (keylIntPtr);
-
- findIdx = FindKeyedListEntry (keylIntPtr, key,
- &keyLen, &nextSubKey);
-
- /*
- * If we are at the last subkey, either update or add an entry.
- */
- if (nextSubKey == NULL) {
- if (findIdx < 0) {
- EnsureKeyedListSpace (keylIntPtr, 1);
- findIdx = keylIntPtr->numEntries;
- keylIntPtr->numEntries++;
- } else {
- ckfree (keylIntPtr->entries [findIdx].key);
- Tcl_DecrRefCount (keylIntPtr->entries [findIdx].valuePtr);
- }
- keylIntPtr->entries [findIdx].key =
- (char *) ckalloc (keyLen + 1);
- strncpy (keylIntPtr->entries [findIdx].key, key, keyLen);
- keylIntPtr->entries [findIdx].key [keyLen] = '\0';
- keylIntPtr->entries [findIdx].valuePtr = valuePtr;
- Tcl_IncrRefCount (valuePtr);
- Tcl_InvalidateStringRep (keylPtr);
-
- KEYL_REP_ASSERT (keylIntPtr);
- return TCL_OK;
- }
-
- /*
- * If we are not at the last subkey, recurse down, creating new
- * entries if neccessary. If this level key was not found, it
- * means we must build new subtree. Don't insert the new tree until we
- * come back without error.
- */
- if (findIdx >= 0) {
- DupSharedKeyListChild (keylIntPtr, findIdx);
- status =
- TclX_KeyedListSet (interp,
- keylIntPtr->entries [findIdx].valuePtr,
- nextSubKey, valuePtr);
- if (status == TCL_OK) {
- Tcl_InvalidateStringRep (keylPtr);
- }
-
- KEYL_REP_ASSERT (keylIntPtr);
- return status;
- } else {
- newKeylPtr = TclX_NewKeyedListObj ();
- if (TclX_KeyedListSet (interp, newKeylPtr,
- nextSubKey, valuePtr) != TCL_OK) {
- Tcl_DecrRefCount (newKeylPtr);
- return TCL_ERROR;
- }
- EnsureKeyedListSpace (keylIntPtr, 1);
- findIdx = keylIntPtr->numEntries++;
- keylIntPtr->entries [findIdx].key =
- (char *) ckalloc (keyLen + 1);
- strncpy (keylIntPtr->entries [findIdx].key, key, keyLen);
- keylIntPtr->entries [findIdx].key [keyLen] = '\0';
- keylIntPtr->entries [findIdx].valuePtr = newKeylPtr;
- Tcl_IncrRefCount (newKeylPtr);
- Tcl_InvalidateStringRep (keylPtr);
-
- KEYL_REP_ASSERT (keylIntPtr);
- return TCL_OK;
- }
-}
-
-/*-----------------------------------------------------------------------------
- * TclX_KeyedListDelete --
- * Delete a key value from keyed list.
- *
- * Parameters:
- * o interp - Error message will be return in result if there is an error.
- * o keylPtr - Keyed list object to update.
- * o key - The name of the key to extract. Will recusively process
- * sub-key seperated by `.'.
- * Returns:
- * o TCL_OK - If the key was deleted.
- * o TCL_BREAK - If the key was not found.
- * o TCL_ERROR - If an error occured.
- *-----------------------------------------------------------------------------
- */
-int
-TclX_KeyedListDelete (interp, keylPtr, key)
- Tcl_Interp *interp;
- Tcl_Obj *keylPtr;
- const char *key;
-{
- keylIntObj_t *keylIntPtr, *subKeylIntPtr;
- const char *nextSubKey;
- int findIdx, status;
-
- if (keylPtr->typePtr != &keyedListType) {
- if (SetKeyedListFromAny(interp, keylPtr) != TCL_OK) {
- return TCL_ERROR;
- }
- }
- keylIntPtr = keylPtr->internalRep.twoPtrValue.ptr1;
-
- findIdx = FindKeyedListEntry (keylIntPtr, key, NULL, &nextSubKey);
-
- /*
- * If not found, return status.
- */
- if (findIdx < 0) {
- KEYL_REP_ASSERT (keylIntPtr);
- return TCL_BREAK;
- }
-
- /*
- * If we are at the last subkey, delete the entry.
- */
- if (nextSubKey == NULL) {
- DeleteKeyedListEntry (keylIntPtr, findIdx);
- Tcl_InvalidateStringRep (keylPtr);
-
- KEYL_REP_ASSERT (keylIntPtr);
- return TCL_OK;
- }
-
- /*
- * If we are not at the last subkey, recurse down. If the entry is
- * deleted and the sub-keyed list is empty, delete it as well. Must
- * invalidate string, as it caches all representations below it.
- */
- DupSharedKeyListChild (keylIntPtr, findIdx);
-
- status = TclX_KeyedListDelete (interp,
- keylIntPtr->entries [findIdx].valuePtr,
- nextSubKey);
- if (status == TCL_OK) {
- subKeylIntPtr =
- keylIntPtr->entries [findIdx].valuePtr->internalRep.twoPtrValue.ptr1;
- if (subKeylIntPtr->numEntries == 0) {
- DeleteKeyedListEntry (keylIntPtr, findIdx);
- }
- Tcl_InvalidateStringRep (keylPtr);
- }
-
- KEYL_REP_ASSERT (keylIntPtr);
- return status;
-}
-
-/*-----------------------------------------------------------------------------
- * TclX_KeyedListGetKeys --
- * Retrieve a list of keyed list keys.
- *
- * Parameters:
- * o interp - Error message will be return in result if there is an error.
- * o keylPtr - Keyed list object to get key from.
- * o key - The name of the key to get the sub keys for. NULL or empty
- * to retrieve all top level keys.
- * o listObjPtrPtr - List object is returned here with key as values.
- * Returns:
- * o TCL_OK - If the zero or more key where returned.
- * o TCL_BREAK - If the key was not found.
- * o TCL_ERROR - If an error occured.
- *-----------------------------------------------------------------------------
- */
-int
-TclX_KeyedListGetKeys (interp, keylPtr, key, listObjPtrPtr)
- Tcl_Interp *interp;
- Tcl_Obj *keylPtr;
- const char *key;
- Tcl_Obj **listObjPtrPtr;
-{
- keylIntObj_t *keylIntPtr;
- Tcl_Obj *nameObjPtr, *listObjPtr;
- const char *nextSubKey;
- int idx, findIdx;
-
- if (keylPtr->typePtr != &keyedListType) {
- if (SetKeyedListFromAny(interp, keylPtr) != TCL_OK) {
- return TCL_ERROR;
- }
- }
- keylIntPtr = keylPtr->internalRep.twoPtrValue.ptr1;
-
- /*
- * If key is not NULL or empty, then recurse down until we go past
- * the end of all of the elements of the key.
- */
- if ((key != NULL) && (key [0] != '\0')) {
- findIdx = FindKeyedListEntry (keylIntPtr, key, NULL, &nextSubKey);
- if (findIdx < 0) {
- TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries);
- return TCL_BREAK;
- }
- TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries);
- return TclX_KeyedListGetKeys (interp,
- keylIntPtr->entries [findIdx].valuePtr,
- nextSubKey,
- listObjPtrPtr);
- }
-
- /*
- * Reached the end of the full key, return all keys at this level.
- */
- listObjPtr = Tcl_NewListObj (0, NULL);
- for (idx = 0; idx < keylIntPtr->numEntries; idx++) {
- nameObjPtr = Tcl_NewStringObj (keylIntPtr->entries [idx].key,
- -1);
- if (Tcl_ListObjAppendElement (interp, listObjPtr,
- nameObjPtr) != TCL_OK) {
- Tcl_DecrRefCount (nameObjPtr);
- Tcl_DecrRefCount (listObjPtr);
- return TCL_ERROR;
- }
- }
- *listObjPtrPtr = listObjPtr;
- TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries);
- return TCL_OK;
-}
-
-/*-----------------------------------------------------------------------------
- * Tcl_KeylgetObjCmd --
- * Implements the TCL keylget command:
- * keylget listvar ?key? ?retvar | {}?
- *-----------------------------------------------------------------------------
- */
-static int
-Tcl_KeylgetObjCmd (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *const objv[];
-{
- Tcl_Obj *keylPtr, *valuePtr;
- const char *key;
- int status;
-
- if ((objc < 2) || (objc > 4)) {
- return TclX_WrongArgs (interp, objv [0],
- "listvar ?key? ?retvar | {}?");
- }
- /*
- * Handle request for list of keys, use keylkeys command.
- */
- if (objc == 2)
- return Tcl_KeylkeysObjCmd (clientData, interp, objc, objv);
-
- keylPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
- if (keylPtr == NULL) {
- return TCL_ERROR;
- }
-
- /*
- * Handle retrieving a value for a specified key.
- */
- key = Tcl_GetString(objv[2]);
- if (ValidateKey(interp, key, objv[2]->length, 1) == TCL_ERROR) {
- return TCL_ERROR;
- }
-
- status = TclX_KeyedListGet (interp, keylPtr, key, &valuePtr);
- if (status == TCL_ERROR)
- return TCL_ERROR;
-
- /*
- * Handle key not found.
- */
- if (status == TCL_BREAK) {
- if (objc == 3) {
- TclX_AppendObjResult (interp, "key \"", key,
- "\" not found in keyed list",
- (char *) NULL);
- return TCL_ERROR;
- } else {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult (interp), 0);
- return TCL_OK;
- }
- }
-
- /*
- * No variable specified, so return value in the result.
- */
- if (objc == 3) {
- Tcl_SetObjResult (interp, valuePtr);
- return TCL_OK;
- }
-
- /*
- * Variable (or empty variable name) specified.
- */
- if (!TclX_IsNullObj(objv [3])) {
- if (Tcl_ObjSetVar2(interp, objv[3], NULL,
- valuePtr, TCL_LEAVE_ERR_MSG) == NULL)
- return TCL_ERROR;
- }
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult (interp), 1);
- return TCL_OK;
-}
-
-/*-----------------------------------------------------------------------------
- * Tcl_KeylsetObjCmd --
- * Implements the TCL keylset command:
- * keylset listvar key value ?key value...?
- *-----------------------------------------------------------------------------
- */
-static int
-Tcl_KeylsetObjCmd (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *const objv[];
-{
- Tcl_Obj *keylVarPtr, *newVarObj;
- const char *key;
- int idx;
-
- if ((objc < 4) || ((objc % 2) != 0)) {
- return TclX_WrongArgs (interp, objv [0],
- "listvar key value ?key value...?");
- }
-
- /*
- * Get the variable that we are going to update. If the var doesn't exist,
- * create it. If it is shared by more than being a variable, duplicated
- * it.
- */
- keylVarPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
- if ((keylVarPtr == NULL) || (Tcl_IsShared (keylVarPtr))) {
- if (keylVarPtr == NULL) {
- keylVarPtr = TclX_NewKeyedListObj ();
- } else {
- keylVarPtr = Tcl_DuplicateObj (keylVarPtr);
- }
- newVarObj = keylVarPtr;
- } else {
- newVarObj = NULL;
- }
-
- for (idx = 2; idx < objc; idx += 2) {
- key = Tcl_GetString(objv[idx]);
- if (ValidateKey(interp, key, objv[idx]->length, 1) == TCL_ERROR) {
- goto errorExit;
- }
- if (TclX_KeyedListSet (interp, keylVarPtr, key, objv [idx+1]) != TCL_OK) {
- goto errorExit;
- }
- }
-
- if (Tcl_ObjSetVar2(interp, objv[1], NULL, keylVarPtr,
- TCL_LEAVE_ERR_MSG) == NULL) {
- goto errorExit;
- }
-
- return TCL_OK;
-
- errorExit:
- if (newVarObj != NULL) {
- Tcl_DecrRefCount (newVarObj);
- }
- return TCL_ERROR;
-}
-
-/*-----------------------------------------------------------------------------
- * Tcl_KeyldelObjCmd --
- * Implements the TCL keyldel command:
- * keyldel listvar key ?key ...?
- *----------------------------------------------------------------------------
- */
-static int
-Tcl_KeyldelObjCmd (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *const objv[];
-{
- Tcl_Obj *keylVarPtr, *keylPtr;
- const char *key;
- int idx, status;
-
- if (objc < 3) {
- return TclX_WrongArgs (interp, objv [0], "listvar key ?key ...?");
- }
-
- /*
- * Get the variable that we are going to update. If it is shared by more
- * than being a variable, duplicated it.
- */
- keylVarPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
- if (keylVarPtr == NULL) {
- return TCL_ERROR;
- }
- if (Tcl_IsShared (keylVarPtr)) {
- keylPtr = Tcl_DuplicateObj (keylVarPtr);
- keylVarPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, keylPtr, TCL_LEAVE_ERR_MSG);
- if (keylVarPtr == NULL) {
- Tcl_DecrRefCount (keylPtr);
- return TCL_ERROR;
- }
- if (keylVarPtr != keylPtr) {
- Tcl_DecrRefCount (keylPtr);
- }
- }
- keylPtr = keylVarPtr;
-
- for (idx = 2; idx < objc; idx++) {
- key = Tcl_GetString(objv[idx]);
- if (ValidateKey(interp, key, objv[idx]->length, 1) == TCL_ERROR) {
- return TCL_ERROR;
- }
-
- status = TclX_KeyedListDelete (interp, keylPtr, key);
- switch (status) {
- case TCL_BREAK:
- TclX_AppendObjResult (interp, "key not found: \"",
- key, "\"", (char *) NULL);
- return TCL_ERROR;
- case TCL_ERROR:
- return TCL_ERROR;
- }
- }
-
- return TCL_OK;
-}
-
-/*-----------------------------------------------------------------------------
- * Tcl_KeylkeysObjCmd --
- * Implements the TCL keylkeys command:
- * keylkeys listvar ?key?
- *-----------------------------------------------------------------------------
- */
-static int
-Tcl_KeylkeysObjCmd (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *const objv[];
-{
- Tcl_Obj *keylPtr, *listObjPtr;
- const char *key;
- int status;
-
- if ((objc < 2) || (objc > 3)) {
- return TclX_WrongArgs(interp, objv [0], "listvar ?key?");
- }
-
- keylPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
- if (keylPtr == NULL) {
- return TCL_ERROR;
- }
-
- /*
- * If key argument is not specified, then objv [2] is NULL or empty,
- * meaning get top level keys.
- */
- if (objc < 3) {
- key = NULL;
- } else {
- key = Tcl_GetString(objv[2]);
- if (ValidateKey(interp, key, objv[2]->length, 1) == TCL_ERROR) {
- return TCL_ERROR;
- }
- }
-
- status = TclX_KeyedListGetKeys (interp, keylPtr, key, &listObjPtr);
- switch (status) {
- case TCL_BREAK:
- TclX_AppendObjResult (interp, "key not found: \"", key, "\"",
- (char *) NULL);
- return TCL_ERROR;
- case TCL_ERROR:
- return TCL_ERROR;
- }
-
- Tcl_SetObjResult (interp, listObjPtr);
-
- return TCL_OK;
-}
-
-/*-----------------------------------------------------------------------------
- * TclX_KeyedListInit --
- * Initialize the keyed list commands for this interpreter.
- *
- * Parameters:
- * o interp - Interpreter to add commands to.
- *-----------------------------------------------------------------------------
- */
-void
-TclX_KeyedListInit (interp)
- Tcl_Interp *interp;
-{
- Tcl_Obj *listobj;
- Tcl_RegisterObjType(&keyedListType);
-
- listobj = Tcl_NewObj();
- listobj = Tcl_NewListObj(1, &listobj);
- listType = listobj->typePtr;
- Tcl_DecrRefCount(listobj);
-
- if (0) {
- Tcl_CreateObjCommand (interp,
- "keylget",
- Tcl_KeylgetObjCmd,
- (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
-
- Tcl_CreateObjCommand (interp,
- "keylset",
- Tcl_KeylsetObjCmd,
- (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
-
- Tcl_CreateObjCommand (interp,
- "keyldel",
- Tcl_KeyldelObjCmd,
- (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
-
- Tcl_CreateObjCommand (interp,
- "keylkeys",
- Tcl_KeylkeysObjCmd,
- (ClientData) NULL,
- (Tcl_CmdDeleteProc*) NULL);
- }
-}
-
-