1/*
2 * tclXkeylist.c --
3 *
4 *  Extended Tcl keyed list commands and interfaces.
5 *-----------------------------------------------------------------------------
6 * Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans.
7 *
8 * Permission to use, copy, modify, and distribute this software and its
9 * documentation for any purpose and without fee is hereby granted, provided
10 * that the above copyright notice appear in all copies.  Karl Lehenbauer and
11 * Mark Diekhans make no representations about the suitability of this
12 * software for any purpose.  It is provided "as is" without express or
13 * implied warranty.
14 *-----------------------------------------------------------------------------
15 * $Id: tclXkeylist.c,v 1.8 2005/11/21 18:54:13 hobbs Exp $
16 *-----------------------------------------------------------------------------
17 */
18
19#include "tclExtdInt.h"
20
21/*
22 * Keyed lists are stored as arrays recursively defined objects.  The data
23 * portion of a keyed list entry is a Tcl_Obj which may be a keyed list object
24 * or any other Tcl object.  Since determine the structure of a keyed list is
25 * lazy (you don't know if an element is data or another keyed list) until it
26 * is accessed, the object can be transformed into a keyed list from a Tcl
27 * string or list.
28 */
29
30/*
31 * Adding a hash table over the entries allows for much faster Find
32 * access to the keys (hash lookup instead of list search).  This adds
33 * a hash table to each keyed list object.  That uses more memory, but
34 * you can get an order of magnitude better performance with large
35 * keyed list sets.  Uncomment this line to not use the hash table.
36 */
37/* #define NO_KEYLIST_HASH_TABLE */
38
39/*
40 * An entry in a keyed list array.
41 *
42 * JH: There was the supposition that making the key an object would
43 * be faster, but I tried that and didn't find it to be true.  The
44 * use of the layered hash table is a big win though.
45 */
46typedef struct {
47    char *key;
48    int keyLen;
49    Tcl_Obj *valuePtr;
50} keylEntry_t;
51
52/*
53 * Internal representation of a keyed list object.
54 */
55typedef struct {
56    int		 arraySize;   /* Current slots available in the array.	*/
57    int		 numEntries;  /* Number of actual entries in the array. */
58    keylEntry_t *entries;     /* Array of keyed list entries.		*/
59#ifndef NO_KEYLIST_HASH_TABLE
60    Tcl_HashTable *hashTbl;   /* hash table mirror of the entries */
61                              /* to improve speed */
62#endif
63} keylIntObj_t;
64
65/*
66 * Amount to increment array size by when it needs to grow.
67 */
68#define KEYEDLIST_ARRAY_INCR_SIZE 16
69
70/*
71 * Macro to duplicate a child entry of a keyed list if it is share by more
72 * than the parent.
73 * NO_KEYLIST_HASH_TABLE: We don't duplicate the hash table, so ensure
74 * that consistency checks allow for portions where not all entries are
75 * in the hash table.
76 */
77#define DupSharedKeyListChild(keylIntPtr, idx) \
78    if (Tcl_IsShared(keylIntPtr->entries [idx].valuePtr)) { \
79	keylIntPtr->entries [idx].valuePtr = \
80	    Tcl_DuplicateObj (keylIntPtr->entries [idx].valuePtr); \
81	Tcl_IncrRefCount(keylIntPtr->entries [idx].valuePtr); \
82    }
83
84/*
85 * Macros to validate an keyed list object or internal representation
86 */
87#ifdef TCLX_DEBUG
88#   define KEYL_OBJ_ASSERT(keylAPtr) {\
89	TclX_Assert (keylAPtr->typePtr == &keyedListType); \
90	ValidateKeyedList (keylAIntPtr); \
91    }
92#   define KEYL_REP_ASSERT(keylAIntPtr) \
93	ValidateKeyedList (keylAIntPtr)
94#else
95#  define KEYL_REP_ASSERT(keylAIntPtr)
96#endif
97
98
99/*
100 * Prototypes of internal functions.
101 */
102#ifdef TCLX_DEBUG
103static void
104ValidateKeyedList _ANSI_ARGS_((keylIntObj_t *keylIntPtr));
105#endif
106static int
107ValidateKey _ANSI_ARGS_((Tcl_Interp *interp, char *key, int keyLen));
108
109static keylIntObj_t *
110AllocKeyedListIntRep _ANSI_ARGS_((void));
111
112static void
113FreeKeyedListData _ANSI_ARGS_((keylIntObj_t *keylIntPtr));
114
115static void
116EnsureKeyedListSpace _ANSI_ARGS_((keylIntObj_t *keylIntPtr,
117				  int		newNumEntries));
118
119static void
120DeleteKeyedListEntry _ANSI_ARGS_((keylIntObj_t *keylIntPtr,
121				  int		entryIdx));
122
123static int
124FindKeyedListEntry _ANSI_ARGS_((keylIntObj_t *keylIntPtr,
125				char	     *key,
126				int	     *keyLenPtr,
127				char	    **nextSubKeyPtr));
128
129static void
130DupKeyedListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
131				     Tcl_Obj *copyPtr));
132
133static void
134FreeKeyedListInternalRep _ANSI_ARGS_((Tcl_Obj *keylPtr));
135
136static int
137SetKeyedListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
138				 Tcl_Obj    *objPtr));
139
140static void
141UpdateStringOfKeyedList _ANSI_ARGS_((Tcl_Obj *keylPtr));
142
143static int
144TclX_KeylgetObjCmd _ANSI_ARGS_((ClientData   clientData,
145				Tcl_Interp  *interp,
146				int	     objc,
147				Tcl_Obj	    *CONST objv[]));
148
149static int
150TclX_KeylsetObjCmd _ANSI_ARGS_((ClientData   clientData,
151				Tcl_Interp  *interp,
152				int	     objc,
153				Tcl_Obj	    *CONST objv[]));
154
155static int
156TclX_KeyldelObjCmd _ANSI_ARGS_((ClientData   clientData,
157				Tcl_Interp  *interp,
158				int	     objc,
159				Tcl_Obj	    *CONST objv[]));
160
161static int
162TclX_KeylkeysObjCmd _ANSI_ARGS_((ClientData   clientData,
163				 Tcl_Interp  *interp,
164				 int	      objc,
165				 Tcl_Obj     *CONST objv[]));
166
167/*
168 * Type definition.
169 */
170static Tcl_ObjType keyedListType = {
171    "keyedList",	      /* name */
172    FreeKeyedListInternalRep, /* freeIntRepProc */
173    DupKeyedListInternalRep,  /* dupIntRepProc */
174    UpdateStringOfKeyedList,  /* updateStringProc */
175    SetKeyedListFromAny	      /* setFromAnyProc */
176};
177
178
179/*-----------------------------------------------------------------------------
180 * ValidateKeyedList --
181 *   Validate a keyed list (only when TCLX_DEBUG is enabled).
182 * Parameters:
183 *   o keylIntPtr - Keyed list internal representation.
184 *-----------------------------------------------------------------------------
185 */
186#ifdef TCLX_DEBUG
187static void
188ValidateKeyedList (keylIntPtr)
189    keylIntObj_t *keylIntPtr;
190{
191    int idx;
192
193    TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries);
194    TclX_Assert (keylIntPtr->arraySize >= 0);
195    TclX_Assert (keylIntPtr->numEntries >= 0);
196    TclX_Assert ((keylIntPtr->arraySize > 0) ?
197		 (keylIntPtr->entries != NULL) : TRUE);
198    TclX_Assert ((keylIntPtr->numEntries > 0) ?
199		 (keylIntPtr->entries != NULL) : TRUE);
200
201    for (idx = 0; idx < keylIntPtr->numEntries; idx++) {
202	keylEntry_t *entryPtr = &(keylIntPtr->entries [idx]);
203	TclX_Assert (entryPtr->key != NULL);
204	TclX_Assert (entryPtr->valuePtr->refCount >= 1);
205	if (entryPtr->valuePtr->typePtr == &keyedListType) {
206	    ValidateKeyedList (entryPtr->valuePtr->internalRep.otherValuePtr);
207	}
208    }
209}
210#endif
211
212/*-----------------------------------------------------------------------------
213 * ValidateKey --
214 *   Check that a key or keypath string is a valid value.
215 *
216 * Parameters:
217 *   o interp - Used to return error messages.
218 *   o key - Key string to check.
219 *   o keyLen - Length of the string, used to check for binary data.
220 * Returns:
221 *    TCL_OK or TCL_ERROR.
222 *-----------------------------------------------------------------------------
223 */
224static int
225ValidateKey (interp, key, keyLen)
226    Tcl_Interp *interp;
227    char *key;
228    int keyLen;
229{
230    if (strlen (key) != (size_t) keyLen) {
231	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
232		"keyed list key may not be a binary string", (char *) NULL);
233	return TCL_ERROR;
234    }
235    if (keyLen == 0) {
236	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
237		"keyed list key may not be an empty string", (char *) NULL);
238	return TCL_ERROR;
239    }
240    return TCL_OK;
241}
242
243
244/*-----------------------------------------------------------------------------
245 * AllocKeyedListIntRep --
246 *   Allocate an and initialize the keyed list internal representation.
247 *
248 * Returns:
249 *    A pointer to the keyed list internal structure.
250 *-----------------------------------------------------------------------------
251 */
252static keylIntObj_t *
253AllocKeyedListIntRep ()
254{
255    keylIntObj_t *keylIntPtr;
256
257    keylIntPtr = (keylIntObj_t *) ckalloc (sizeof (keylIntObj_t));
258    memset(keylIntPtr, 0, sizeof (keylIntObj_t));
259#ifndef NO_KEYLIST_HASH_TABLE
260    keylIntPtr->hashTbl = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
261    Tcl_InitHashTable(keylIntPtr->hashTbl, TCL_STRING_KEYS);
262#endif
263    return keylIntPtr;
264}
265
266/*-----------------------------------------------------------------------------
267 * FreeKeyedListData --
268 *   Free the internal representation of a keyed list.
269 *
270 * Parameters:
271 *   o keylIntPtr - Keyed list internal structure to free.
272 *-----------------------------------------------------------------------------
273 */
274static void
275FreeKeyedListData (keylIntPtr)
276    keylIntObj_t *keylIntPtr;
277{
278    int idx;
279
280    for (idx = 0; idx < keylIntPtr->numEntries ; idx++) {
281	ckfree (keylIntPtr->entries [idx].key);
282	Tcl_DecrRefCount(keylIntPtr->entries [idx].valuePtr);
283    }
284    if (keylIntPtr->entries != NULL)
285	ckfree ((VOID*) keylIntPtr->entries);
286#ifndef NO_KEYLIST_HASH_TABLE
287    if (keylIntPtr->hashTbl != NULL) {
288	Tcl_DeleteHashTable(keylIntPtr->hashTbl);
289	ckfree((char *) (keylIntPtr->hashTbl));
290    }
291#endif
292    ckfree ((VOID*) keylIntPtr);
293}
294
295/*-----------------------------------------------------------------------------
296 * EnsureKeyedListSpace --
297 *   Ensure there is enough room in a keyed list array for a certain number
298 * of entries, expanding if necessary.
299 *
300 * Parameters:
301 *   o keylIntPtr - Keyed list internal representation.
302 *   o newNumEntries - The number of entries that are going to be added to
303 *     the keyed list.
304 *-----------------------------------------------------------------------------
305 */
306static void
307EnsureKeyedListSpace (keylIntPtr, newNumEntries)
308    keylIntObj_t *keylIntPtr;
309    int		  newNumEntries;
310{
311    KEYL_REP_ASSERT (keylIntPtr);
312
313    if ((keylIntPtr->arraySize - keylIntPtr->numEntries) < newNumEntries) {
314	int newSize = keylIntPtr->arraySize + newNumEntries +
315	    KEYEDLIST_ARRAY_INCR_SIZE;
316	if (keylIntPtr->entries == NULL) {
317	    keylIntPtr->entries = (keylEntry_t *)
318		ckalloc (newSize * sizeof (keylEntry_t));
319	} else {
320	    keylIntPtr->entries = (keylEntry_t *)
321		ckrealloc ((VOID *) keylIntPtr->entries,
322			   newSize * sizeof (keylEntry_t));
323	}
324	keylIntPtr->arraySize = newSize;
325    }
326
327    KEYL_REP_ASSERT (keylIntPtr);
328}
329
330/*-----------------------------------------------------------------------------
331 * DeleteKeyedListEntry --
332 *   Delete an entry from a keyed list.
333 *
334 * Parameters:
335 *   o keylIntPtr - Keyed list internal representation.
336 *   o entryIdx - Index of entry to delete.
337 *-----------------------------------------------------------------------------
338 */
339static void
340DeleteKeyedListEntry (keylIntPtr, entryIdx)
341    keylIntObj_t *keylIntPtr;
342    int		  entryIdx;
343{
344    int idx;
345
346#ifndef NO_KEYLIST_HASH_TABLE
347    if (keylIntPtr->hashTbl != NULL) {
348	Tcl_HashEntry *entryPtr;
349	Tcl_HashSearch search;
350	int nidx;
351
352	entryPtr = Tcl_FindHashEntry(keylIntPtr->hashTbl,
353		keylIntPtr->entries [entryIdx].key);
354	if (entryPtr != NULL) {
355	    Tcl_DeleteHashEntry(entryPtr);
356	}
357
358	/*
359	 * In order to maintain consistency, we have to iterate over
360	 * the entire hash table to find and decr relevant idxs.
361	 * We have to do this even if the previous index was not found
362	 * in the hash table, as Dup'ing doesn't dup the hash tables.
363	 */
364	for (entryPtr = Tcl_FirstHashEntry(keylIntPtr->hashTbl, &search);
365	     entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
366	    nidx = (int) Tcl_GetHashValue(entryPtr);
367	    if (nidx > entryIdx) {
368		Tcl_SetHashValue(entryPtr, (ClientData) (nidx - 1));
369	    }
370	}
371    }
372#endif
373
374    ckfree (keylIntPtr->entries [entryIdx].key);
375    Tcl_DecrRefCount(keylIntPtr->entries [entryIdx].valuePtr);
376
377    for (idx = entryIdx; idx < keylIntPtr->numEntries - 1; idx++)
378	keylIntPtr->entries [idx] = keylIntPtr->entries [idx + 1];
379    keylIntPtr->numEntries--;
380
381    KEYL_REP_ASSERT (keylIntPtr);
382}
383
384/*-----------------------------------------------------------------------------
385 * FindKeyedListEntry --
386 *   Find an entry in keyed list.
387 *
388 * Parameters:
389 *   o keylIntPtr - Keyed list internal representation.
390 *   o key - Name of key to search for.
391 *   o keyLenPtr - In not NULL, the length of the key for this
392 *     level is returned here.	This excludes subkeys and the `.' delimiters.
393 *   o nextSubKeyPtr - If not NULL, the start of the name of the next
394 *     sub-key within key is returned.
395 * Returns:
396 *   Index of the entry or -1 if not found.
397 *-----------------------------------------------------------------------------
398 */
399static int
400FindKeyedListEntry (keylIntPtr, key, keyLenPtr, nextSubKeyPtr)
401    keylIntObj_t *keylIntPtr;
402    char	 *key;
403    int		 *keyLenPtr;
404    char	**nextSubKeyPtr;
405{
406    char *keySeparPtr;
407    int keyLen, findIdx = -1;
408
409    keySeparPtr = strchr (key, '.');
410    if (keySeparPtr != NULL) {
411	keyLen = keySeparPtr - key;
412    } else {
413	keyLen = strlen (key);
414    }
415
416#ifndef NO_KEYLIST_HASH_TABLE
417    if (keylIntPtr->hashTbl != NULL) {
418	Tcl_HashEntry *entryPtr;
419	char tmp = key[keyLen];
420	if (keySeparPtr != NULL) {
421	    /*
422	     * A few extra guards in setting this, as if we are passed
423	     * a const char, this can crash.
424	     */
425	    key[keyLen] = '\0';
426	}
427	entryPtr = Tcl_FindHashEntry(keylIntPtr->hashTbl, key);
428	if (entryPtr != NULL) {
429	    findIdx = (int) Tcl_GetHashValue(entryPtr);
430	}
431	if (keySeparPtr != NULL) {
432	    key[keyLen] = tmp;
433	}
434    }
435#endif
436
437    if (findIdx == -1) {
438	for (findIdx = 0; findIdx < keylIntPtr->numEntries; findIdx++) {
439	    if (keylIntPtr->entries [findIdx].keyLen == keyLen
440		    && STRNEQU(keylIntPtr->entries [findIdx].key, key, keyLen)) {
441		break;
442	    }
443	}
444    }
445
446    if (nextSubKeyPtr != NULL) {
447	if (keySeparPtr == NULL) {
448	    *nextSubKeyPtr = NULL;
449	} else {
450	    *nextSubKeyPtr = keySeparPtr + 1;
451	}
452    }
453    if (keyLenPtr != NULL) {
454	*keyLenPtr = keyLen;
455    }
456
457    if (findIdx >= keylIntPtr->numEntries) {
458	return -1;
459    }
460
461    return findIdx;
462}
463
464/*-----------------------------------------------------------------------------
465 * FreeKeyedListInternalRep --
466 *   Free the internal representation of a keyed list.
467 *
468 * Parameters:
469 *   o keylPtr - Keyed list object being deleted.
470 *-----------------------------------------------------------------------------
471 */
472static void
473FreeKeyedListInternalRep (keylPtr)
474    Tcl_Obj *keylPtr;
475{
476    FreeKeyedListData ((keylIntObj_t *) keylPtr->internalRep.otherValuePtr);
477}
478
479/*-----------------------------------------------------------------------------
480 * DupKeyedListInternalRep --
481 *   Duplicate the internal representation of a keyed list.
482 *
483 * Parameters:
484 *   o srcPtr - Keyed list object to copy.
485 *   o copyPtr - Target object to copy internal representation to.
486 *-----------------------------------------------------------------------------
487 */
488static void
489DupKeyedListInternalRep (srcPtr, copyPtr)
490    Tcl_Obj *srcPtr;
491    Tcl_Obj *copyPtr;
492{
493    keylIntObj_t *srcIntPtr =
494	(keylIntObj_t *) srcPtr->internalRep.otherValuePtr;
495    keylIntObj_t *copyIntPtr;
496    int idx;
497
498    KEYL_REP_ASSERT (srcIntPtr);
499
500    copyIntPtr = (keylIntObj_t *) ckalloc (sizeof (keylIntObj_t));
501    copyIntPtr->arraySize = srcIntPtr->arraySize;
502    copyIntPtr->numEntries = srcIntPtr->numEntries;
503    copyIntPtr->entries = (keylEntry_t *)
504	ckalloc (copyIntPtr->arraySize * sizeof (keylEntry_t));
505#ifndef NO_KEYLIST_HASH_TABLE
506#if 0
507    copyIntPtr->hashTbl = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
508    Tcl_InitHashTable(copyIntPtr->hashTbl, TCL_STRING_KEYS);
509#else
510    /*
511     * NO_KEYLIST_HASH_TABLE: We don't duplicate the hash table, so ensure
512     * that consistency checks allow for portions where not all entries are
513     * in the hash table.
514     */
515    copyIntPtr->hashTbl = NULL;
516#endif
517#endif
518
519    for (idx = 0; idx < srcIntPtr->numEntries ; idx++) {
520	copyIntPtr->entries [idx].key =
521	    ckstrdup (srcIntPtr->entries [idx].key);
522	copyIntPtr->entries [idx].keyLen = srcIntPtr->entries [idx].keyLen;
523	copyIntPtr->entries [idx].valuePtr =
524	    Tcl_DuplicateObj(srcIntPtr->entries [idx].valuePtr);
525	Tcl_IncrRefCount(copyIntPtr->entries [idx].valuePtr);
526#ifndef NO_KEYLIST_HASH_TABLE
527	/*
528	 * If we dup the hash table as well and do other better tracking
529	 * of all access, then we could remove the entries list.
530	 */
531#endif
532    }
533
534    copyPtr->internalRep.otherValuePtr = (VOID *) copyIntPtr;
535    copyPtr->typePtr = &keyedListType;
536
537    KEYL_REP_ASSERT (copyIntPtr);
538}
539
540/*-----------------------------------------------------------------------------
541 * SetKeyedListFromAny --
542 *   Convert an object to a keyed list from its string representation.	Only
543 * the first level is converted, as there is no way of knowing how far down
544 * the keyed list recurses until lower levels are accessed.
545 *
546 * Parameters:
547 *   o objPtr - Object to convert to a keyed list.
548 *-----------------------------------------------------------------------------
549 */
550static int
551SetKeyedListFromAny (interp, objPtr)
552    Tcl_Interp *interp;
553    Tcl_Obj    *objPtr;
554{
555    keylIntObj_t *keylIntPtr;
556    keylEntry_t *keyEntryPtr;
557    char *key;
558    int keyLen, idx, objc, subObjc;
559    Tcl_Obj **objv, **subObjv;
560#ifndef NO_KEYLIST_HASH_TABLE
561    int dummy;
562    Tcl_HashEntry *entryPtr;
563#endif
564
565    if (Tcl_ListObjGetElements (interp, objPtr, &objc, &objv) != TCL_OK) {
566	return TCL_ERROR;
567    }
568
569    keylIntPtr = AllocKeyedListIntRep();
570
571    EnsureKeyedListSpace(keylIntPtr, objc);
572
573    for (idx = 0; idx < objc; idx++) {
574	if ((Tcl_ListObjGetElements(interp, objv[idx],
575		     &subObjc, &subObjv) != TCL_OK)
576		|| (subObjc != 2)) {
577	    Tcl_ResetResult(interp);
578	    Tcl_AppendStringsToObj(Tcl_GetObjResult (interp),
579		    "keyed list entry must be a valid, 2 element list, got \"",
580		    Tcl_GetString(objv[idx]), "\"", (char *) NULL);
581	    FreeKeyedListData(keylIntPtr);
582	    return TCL_ERROR;
583	}
584
585	key = Tcl_GetStringFromObj(subObjv[0], &keyLen);
586	if (ValidateKey(interp, key, keyLen) == TCL_ERROR) {
587	    FreeKeyedListData (keylIntPtr);
588	    return TCL_ERROR;
589	}
590	/*
591	 * When setting from a random list/string, we cannot allow
592	 * keys to have embedded '.' path separators
593	 */
594	if ((strchr(key, '.') != NULL)) {
595	    Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
596		    "keyed list key may not contain a \".\"; ",
597		    "it is used as a separator in key paths",
598		    (char *) NULL);
599	    FreeKeyedListData (keylIntPtr);
600	    return TCL_ERROR;
601	}
602	keyEntryPtr = &(keylIntPtr->entries[idx]);
603
604	keyEntryPtr->key = ckstrdup(key);
605	keyEntryPtr->keyLen = keyLen;
606	keyEntryPtr->valuePtr = Tcl_DuplicateObj(subObjv[1]);
607	Tcl_IncrRefCount(keyEntryPtr->valuePtr);
608#ifndef NO_KEYLIST_HASH_TABLE
609	entryPtr = Tcl_CreateHashEntry(keylIntPtr->hashTbl,
610		keyEntryPtr->key, &dummy);
611	Tcl_SetHashValue(entryPtr, (ClientData) idx);
612#endif
613
614	keylIntPtr->numEntries++;
615    }
616
617    if ((objPtr->typePtr != NULL) &&
618	(objPtr->typePtr->freeIntRepProc != NULL)) {
619	(*objPtr->typePtr->freeIntRepProc) (objPtr);
620    }
621    objPtr->internalRep.otherValuePtr = (VOID *) keylIntPtr;
622    objPtr->typePtr = &keyedListType;
623
624    KEYL_REP_ASSERT (keylIntPtr);
625    return TCL_OK;
626}
627
628/*-----------------------------------------------------------------------------
629 * UpdateStringOfKeyedList --
630 *    Update the string representation of a keyed list.
631 *
632 * Parameters:
633 *   o objPtr - Object to convert to a keyed list.
634 *-----------------------------------------------------------------------------
635 */
636static void
637UpdateStringOfKeyedList (keylPtr)
638    Tcl_Obj  *keylPtr;
639{
640#define UPDATE_STATIC_SIZE 32
641    int idx, strLen;
642    Tcl_Obj **listObjv, *entryObjv [2], *tmpListObj;
643    Tcl_Obj *staticListObjv [UPDATE_STATIC_SIZE];
644    char *listStr;
645    keylIntObj_t *keylIntPtr =
646	(keylIntObj_t *) keylPtr->internalRep.otherValuePtr;
647
648    /*
649     * Conversion to strings is done via list objects to support binary data.
650     */
651    if (keylIntPtr->numEntries > UPDATE_STATIC_SIZE) {
652	listObjv =
653	    (Tcl_Obj **) ckalloc (keylIntPtr->numEntries * sizeof (Tcl_Obj *));
654    } else {
655	listObjv = staticListObjv;
656    }
657
658    /*
659     * Convert each keyed list entry to a two element list object.  No
660     * need to incr/decr ref counts, the list objects will take care of that.
661     * FIX: Keeping key as string object will speed this up.
662     */
663    for (idx = 0; idx < keylIntPtr->numEntries; idx++) {
664	entryObjv [0] =
665	    Tcl_NewStringObj (keylIntPtr->entries [idx].key,
666		    keylIntPtr->entries [idx].keyLen);
667	entryObjv [1] = keylIntPtr->entries [idx].valuePtr;
668	listObjv [idx] = Tcl_NewListObj (2, entryObjv);
669    }
670
671    tmpListObj = Tcl_NewListObj (keylIntPtr->numEntries, listObjv);
672    Tcl_IncrRefCount(tmpListObj);
673    listStr = Tcl_GetStringFromObj (tmpListObj, &strLen);
674    keylPtr->bytes = ckbinstrdup (listStr, strLen);
675    keylPtr->length = strLen;
676    Tcl_DecrRefCount(tmpListObj);
677
678    if (listObjv != staticListObjv)
679	ckfree ((VOID*) listObjv);
680}
681
682/*-----------------------------------------------------------------------------
683 * TclX_NewKeyedListObj --
684 *   Create and initialize a new keyed list object.
685 *
686 * Returns:
687 *    A pointer to the object.
688 *-----------------------------------------------------------------------------
689 */
690Tcl_Obj *
691TclX_NewKeyedListObj ()
692{
693    Tcl_Obj *keylPtr = Tcl_NewObj ();
694    keylIntObj_t *keylIntPtr = AllocKeyedListIntRep ();
695
696    keylPtr->internalRep.otherValuePtr = (VOID *) keylIntPtr;
697    keylPtr->typePtr = &keyedListType;
698    return keylPtr;
699}
700
701/*-----------------------------------------------------------------------------
702 * TclX_KeyedListGet --
703 *   Retrieve a key value from a keyed list.
704 *
705 * Parameters:
706 *   o interp - Error message will be return in result if there is an error.
707 *   o keylPtr - Keyed list object to get key from.
708 *   o key - The name of the key to extract.  Will recusively process sub-keys
709 *     seperated by `.'.
710 *   o valueObjPtrPtr - If the key is found, a pointer to the key object
711 *     is returned here.  NULL is returned if the key is not present.
712 * Returns:
713 *   o TCL_OK - If the key value was returned.
714 *   o TCL_BREAK - If the key was not found.
715 *   o TCL_ERROR - If an error occured.
716 *-----------------------------------------------------------------------------
717 */
718int
719TclX_KeyedListGet (interp, keylPtr, key, valuePtrPtr)
720    Tcl_Interp *interp;
721    Tcl_Obj    *keylPtr;
722    char       *key;
723    Tcl_Obj   **valuePtrPtr;
724{
725    keylIntObj_t *keylIntPtr;
726    char *nextSubKey;
727    int findIdx;
728
729    while (1) {
730	if (Tcl_ConvertToType (interp, keylPtr, &keyedListType) != TCL_OK)
731	    return TCL_ERROR;
732	keylIntPtr = (keylIntObj_t *) keylPtr->internalRep.otherValuePtr;
733	KEYL_REP_ASSERT (keylIntPtr);
734
735	findIdx = FindKeyedListEntry(keylIntPtr, key, NULL, &nextSubKey);
736
737	/*
738	 * If not found, return status.
739	 */
740	if (findIdx < 0) {
741	    *valuePtrPtr = NULL;
742	    return TCL_BREAK;
743	}
744
745	/*
746	 * If we are at the last subkey, return the entry, otherwise recurse
747	 * down looking for the entry.
748	 */
749	if (nextSubKey == NULL) {
750	    *valuePtrPtr = keylIntPtr->entries [findIdx].valuePtr;
751	    return TCL_OK;
752	} else {
753	    keylPtr = keylIntPtr->entries [findIdx].valuePtr;
754	    key = nextSubKey;
755	}
756    }
757}
758
759/*-----------------------------------------------------------------------------
760 * TclX_KeyedListSet --
761 *   Set a key value in keyed list object.
762 *
763 * Parameters:
764 *   o interp - Error message will be return in result object.
765 *   o keylPtr - Keyed list object to update.
766 *   o key - The name of the key to extract.  Will recursively process
767 *     sub-key seperated by `.'.
768 *   o valueObjPtr - The value to set for the key.
769 * Returns:
770 *   TCL_OK or TCL_ERROR.
771 *-----------------------------------------------------------------------------
772 */
773int
774TclX_KeyedListSet (interp, keylPtr, key, valuePtr)
775    Tcl_Interp *interp;
776    Tcl_Obj    *keylPtr;
777    char       *key;
778    Tcl_Obj    *valuePtr;
779{
780    keylIntObj_t *keylIntPtr;
781    keylEntry_t *keyEntryPtr;
782    char *nextSubKey;
783    int findIdx, keyLen, status = TCL_OK;
784    Tcl_Obj *newKeylPtr;
785
786    while (1) {
787	if (Tcl_ConvertToType (interp, keylPtr, &keyedListType) != TCL_OK)
788	    return TCL_ERROR;
789	keylIntPtr = (keylIntObj_t *) keylPtr->internalRep.otherValuePtr;
790	KEYL_REP_ASSERT (keylIntPtr);
791
792	findIdx = FindKeyedListEntry (keylIntPtr, key, &keyLen, &nextSubKey);
793
794	/*
795	 * If we are at the last subkey, either update or add an entry.
796	 */
797	if (nextSubKey == NULL) {
798#ifndef NO_KEYLIST_HASH_TABLE
799	    int dummy;
800	    Tcl_HashEntry *entryPtr;
801#endif
802	    if (findIdx < 0) {
803		EnsureKeyedListSpace (keylIntPtr, 1);
804		findIdx = keylIntPtr->numEntries++;
805	    } else {
806		ckfree (keylIntPtr->entries [findIdx].key);
807		Tcl_DecrRefCount(keylIntPtr->entries [findIdx].valuePtr);
808	    }
809	    keyEntryPtr = &(keylIntPtr->entries[findIdx]);
810	    keyEntryPtr->key = (char *) ckalloc (keyLen + 1);
811	    memcpy(keyEntryPtr->key, key, keyLen);
812	    keyEntryPtr->key[keyLen] = '\0';
813	    keyEntryPtr->keyLen      = keyLen;
814	    keyEntryPtr->valuePtr    = valuePtr;
815	    Tcl_IncrRefCount(valuePtr);
816#ifndef NO_KEYLIST_HASH_TABLE
817	    if (keylIntPtr->hashTbl == NULL) {
818		keylIntPtr->hashTbl =
819		    (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
820		Tcl_InitHashTable(keylIntPtr->hashTbl, TCL_STRING_KEYS);
821	    }
822	    entryPtr = Tcl_CreateHashEntry(keylIntPtr->hashTbl,
823		    keyEntryPtr->key, &dummy);
824	    Tcl_SetHashValue(entryPtr, (ClientData) findIdx);
825#endif
826	    Tcl_InvalidateStringRep (keylPtr);
827
828	    KEYL_REP_ASSERT (keylIntPtr);
829	    return TCL_OK;
830	}
831
832	/*
833	 * If we are not at the last subkey, recurse down, creating new
834	 * entries if neccessary.  If this level key was not found, it
835	 * means we must build new subtree. Don't insert the new tree until we
836	 * come back without error.
837	 */
838	if (findIdx >= 0) {
839	    DupSharedKeyListChild (keylIntPtr, findIdx);
840	    status = TclX_KeyedListSet (interp,
841		    keylIntPtr->entries [findIdx].valuePtr,
842		    nextSubKey, valuePtr);
843	    if (status == TCL_OK) {
844		Tcl_InvalidateStringRep (keylPtr);
845	    }
846	} else {
847#ifndef NO_KEYLIST_HASH_TABLE
848	    int dummy;
849	    Tcl_HashEntry *entryPtr;
850#endif
851	    newKeylPtr = TclX_NewKeyedListObj ();
852	    Tcl_IncrRefCount(newKeylPtr);
853	    if (TclX_KeyedListSet (interp, newKeylPtr,
854			nextSubKey, valuePtr) != TCL_OK) {
855		Tcl_DecrRefCount(newKeylPtr);
856		return TCL_ERROR;
857	    }
858	    EnsureKeyedListSpace (keylIntPtr, 1);
859	    findIdx = keylIntPtr->numEntries++;
860	    keyEntryPtr = &(keylIntPtr->entries[findIdx]);
861	    keyEntryPtr->key = (char *) ckalloc (keyLen + 1);
862	    memcpy(keyEntryPtr->key, key, keyLen);
863	    keyEntryPtr->key[keyLen] = '\0';
864	    keyEntryPtr->keyLen      = keyLen;
865	    keyEntryPtr->valuePtr    = newKeylPtr;
866#ifndef NO_KEYLIST_HASH_TABLE
867	    if (keylIntPtr->hashTbl == NULL) {
868		keylIntPtr->hashTbl =
869		    (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
870		Tcl_InitHashTable(keylIntPtr->hashTbl, TCL_STRING_KEYS);
871	    }
872	    entryPtr = Tcl_CreateHashEntry(keylIntPtr->hashTbl,
873		    keyEntryPtr->key, &dummy);
874	    Tcl_SetHashValue(entryPtr, (ClientData) findIdx);
875#endif
876	    Tcl_InvalidateStringRep (keylPtr);
877	}
878
879	KEYL_REP_ASSERT (keylIntPtr);
880	return status;
881    }
882}
883
884/*-----------------------------------------------------------------------------
885 * TclX_KeyedListDelete --
886 *   Delete a key value from keyed list.
887 *
888 * Parameters:
889 *   o interp - Error message will be return in result if there is an error.
890 *   o keylPtr - Keyed list object to update.
891 *   o key - The name of the key to extract.  Will recusively process
892 *     sub-key seperated by `.'.
893 * Returns:
894 *   o TCL_OK - If the key was deleted.
895 *   o TCL_BREAK - If the key was not found.
896 *   o TCL_ERROR - If an error occured.
897 *-----------------------------------------------------------------------------
898 */
899int
900TclX_KeyedListDelete (interp, keylPtr, key)
901    Tcl_Interp *interp;
902    Tcl_Obj    *keylPtr;
903    char       *key;
904{
905    keylIntObj_t *keylIntPtr, *subKeylIntPtr;
906    char *nextSubKey;
907    int findIdx, status;
908
909    if (Tcl_ConvertToType (interp, keylPtr, &keyedListType) != TCL_OK)
910	return TCL_ERROR;
911    keylIntPtr = (keylIntObj_t *) keylPtr->internalRep.otherValuePtr;
912
913    findIdx = FindKeyedListEntry (keylIntPtr, key, NULL, &nextSubKey);
914
915    /*
916     * If not found, return status.
917     */
918    if (findIdx < 0) {
919	KEYL_REP_ASSERT (keylIntPtr);
920	return TCL_BREAK;
921    }
922
923    /*
924     * If we are at the last subkey, delete the entry.
925     */
926    if (nextSubKey == NULL) {
927	DeleteKeyedListEntry (keylIntPtr, findIdx);
928	Tcl_InvalidateStringRep (keylPtr);
929
930	KEYL_REP_ASSERT (keylIntPtr);
931	return TCL_OK;
932    }
933
934    /*
935     * If we are not at the last subkey, recurse down.	If the entry is
936     * deleted and the sub-keyed list is empty, delete it as well.  Must
937     * invalidate string, as it caches all representations below it.
938     */
939    DupSharedKeyListChild (keylIntPtr, findIdx);
940
941    status = TclX_KeyedListDelete (interp,
942				   keylIntPtr->entries [findIdx].valuePtr,
943				   nextSubKey);
944    if (status == TCL_OK) {
945	subKeylIntPtr = (keylIntObj_t *)
946	    keylIntPtr->entries [findIdx].valuePtr->internalRep.otherValuePtr;
947	if (subKeylIntPtr->numEntries == 0) {
948	    DeleteKeyedListEntry (keylIntPtr, findIdx);
949	}
950	Tcl_InvalidateStringRep (keylPtr);
951    }
952
953    KEYL_REP_ASSERT (keylIntPtr);
954    return status;
955}
956
957/*-----------------------------------------------------------------------------
958 * TclX_KeyedListGetKeys --
959 *   Retrieve a list of keyed list keys.
960 *
961 * Parameters:
962 *   o interp - Error message will be return in result if there is an error.
963 *   o keylPtr - Keyed list object to get key from.
964 *   o key - The name of the key to get the sub keys for.  NULL or empty
965 *     to retrieve all top level keys.
966 *   o listObjPtrPtr - List object is returned here with key as values.
967 * Returns:
968 *   o TCL_OK - If the zero or more key where returned.
969 *   o TCL_BREAK - If the key was not found.
970 *   o TCL_ERROR - If an error occured.
971 *-----------------------------------------------------------------------------
972 */
973int
974TclX_KeyedListGetKeys (interp, keylPtr, key, listObjPtrPtr)
975    Tcl_Interp *interp;
976    Tcl_Obj    *keylPtr;
977    char       *key;
978    Tcl_Obj   **listObjPtrPtr;
979{
980    keylIntObj_t *keylIntPtr;
981    Tcl_Obj *listObjPtr;
982    char *nextSubKey;
983    int idx, findIdx;
984
985    if (Tcl_ConvertToType (interp, keylPtr, &keyedListType) != TCL_OK)
986	return TCL_ERROR;
987    keylIntPtr = (keylIntObj_t *) keylPtr->internalRep.otherValuePtr;
988
989    /*
990     * If key is not NULL or empty, then recurse down until we go past
991     * the end of all of the elements of the key.
992     */
993    if ((key != NULL) && (key [0] != '\0')) {
994	findIdx = FindKeyedListEntry (keylIntPtr, key, NULL, &nextSubKey);
995	if (findIdx < 0) {
996	    TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries);
997	    return TCL_BREAK;
998	}
999	TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries);
1000	return TclX_KeyedListGetKeys (interp,
1001				      keylIntPtr->entries [findIdx].valuePtr,
1002				      nextSubKey,
1003				      listObjPtrPtr);
1004    }
1005
1006    /*
1007     * Reached the end of the full key, return all keys at this level.
1008     */
1009    listObjPtr = Tcl_NewObj();
1010    for (idx = 0; idx < keylIntPtr->numEntries; idx++) {
1011	Tcl_ListObjAppendElement(interp, listObjPtr,
1012		Tcl_NewStringObj(keylIntPtr->entries[idx].key,
1013			keylIntPtr->entries[idx].keyLen));
1014    }
1015    *listObjPtrPtr = listObjPtr;
1016    TclX_Assert (keylIntPtr->arraySize >= keylIntPtr->numEntries);
1017    return TCL_OK;
1018}
1019
1020/*-----------------------------------------------------------------------------
1021 * Tcl_KeylgetObjCmd --
1022 *     Implements the TCL keylget command:
1023 *	   keylget listvar ?key? ?retvar | {}?
1024 *-----------------------------------------------------------------------------
1025 */
1026static int
1027TclX_KeylgetObjCmd (clientData, interp, objc, objv)
1028    ClientData	 clientData;
1029    Tcl_Interp	*interp;
1030    int		 objc;
1031    Tcl_Obj	*CONST objv[];
1032{
1033    Tcl_Obj *keylPtr, *valuePtr;
1034    char *key;
1035    int keyLen, status;
1036
1037    if ((objc < 2) || (objc > 4)) {
1038	return TclX_WrongArgs (interp, objv [0],
1039			       "listvar ?key? ?retvar | {}?");
1040    }
1041
1042    /*
1043     * Handle request for list of keys, use keylkeys command.
1044     */
1045    if (objc == 2)
1046	return TclX_KeylkeysObjCmd (clientData, interp, objc, objv);
1047
1048    keylPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
1049    if (keylPtr == NULL) {
1050	return TCL_ERROR;
1051    }
1052
1053    /*
1054     * Handle retrieving a value for a specified key.
1055     */
1056    key = Tcl_GetStringFromObj (objv [2], &keyLen);
1057    if (ValidateKey(interp, key, keyLen) == TCL_ERROR) {
1058	return TCL_ERROR;
1059    }
1060
1061    status = TclX_KeyedListGet (interp, keylPtr, key, &valuePtr);
1062    if (status == TCL_ERROR)
1063	return TCL_ERROR;
1064
1065    /*
1066     * Handle key not found.
1067     */
1068    if (status == TCL_BREAK) {
1069	if (objc == 3) {
1070	    TclX_AppendObjResult (interp, "key \"",  key,
1071		    "\" not found in keyed list", (char *) NULL);
1072	    return TCL_ERROR;
1073	} else {
1074	    Tcl_SetBooleanObj (Tcl_GetObjResult (interp), FALSE);
1075	    return TCL_OK;
1076	}
1077    }
1078
1079    /*
1080     * No variable specified, so return value in the result.
1081     */
1082    if (objc == 3) {
1083	Tcl_SetObjResult (interp, valuePtr);
1084	return TCL_OK;
1085    }
1086
1087    /*
1088     * Variable (or empty variable name) specified.
1089     */
1090    if (!TclX_IsNullObj(objv [3]) &&
1091	    (Tcl_ObjSetVar2(interp, objv [3], NULL, valuePtr,
1092		    TCL_LEAVE_ERR_MSG) == NULL)) {
1093	return TCL_ERROR;
1094    }
1095    Tcl_SetBooleanObj (Tcl_GetObjResult (interp), TRUE);
1096    return TCL_OK;
1097}
1098
1099/*-----------------------------------------------------------------------------
1100 * Tcl_KeylsetObjCmd --
1101 *     Implements the TCL keylset command:
1102 *	   keylset listvar key value ?key value...?
1103 *-----------------------------------------------------------------------------
1104 */
1105static int
1106TclX_KeylsetObjCmd (clientData, interp, objc, objv)
1107    ClientData	 clientData;
1108    Tcl_Interp	*interp;
1109    int		 objc;
1110    Tcl_Obj	*CONST objv[];
1111{
1112    Tcl_Obj *keylVarPtr, *newVarObj;
1113    char *key;
1114    int idx, keyLen, result = TCL_OK;
1115
1116    if ((objc < 4) || ((objc % 2) != 0)) {
1117	return TclX_WrongArgs (interp, objv [0],
1118			       "listvar key value ?key value...?");
1119    }
1120
1121    /*
1122     * Get the variable that we are going to update.  If the var doesn't exist,
1123     * create it.  If it is shared by more than being a variable, duplicated
1124     * it.
1125     */
1126    keylVarPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
1127    if (keylVarPtr == NULL) {
1128	newVarObj = keylVarPtr = TclX_NewKeyedListObj();
1129	Tcl_IncrRefCount(newVarObj);
1130    } else if (Tcl_IsShared(keylVarPtr)) {
1131	newVarObj = keylVarPtr = Tcl_DuplicateObj(keylVarPtr);
1132	Tcl_IncrRefCount(newVarObj);
1133    } else {
1134	newVarObj = NULL;
1135    }
1136
1137    for (idx = 2; idx < objc; idx += 2) {
1138	key = Tcl_GetStringFromObj (objv [idx], &keyLen);
1139	if ((ValidateKey(interp, key, keyLen) == TCL_ERROR)
1140		|| (TclX_KeyedListSet (interp, keylVarPtr, key, objv [idx+1])
1141			!= TCL_OK)) {
1142	    result = TCL_ERROR;
1143	    break;
1144	}
1145    }
1146
1147    if ((result == TCL_OK) &&
1148	    (Tcl_ObjSetVar2(interp, objv[1], NULL, keylVarPtr,
1149		    TCL_LEAVE_ERR_MSG) == NULL)) {
1150	result = TCL_ERROR;
1151    }
1152
1153    if (newVarObj != NULL) {
1154	Tcl_DecrRefCount(newVarObj);
1155    }
1156    return result;
1157}
1158
1159/*-----------------------------------------------------------------------------
1160 * Tcl_KeyldelObjCmd --
1161 *     Implements the TCL keyldel command:
1162 *	   keyldel listvar key ?key ...?
1163 *----------------------------------------------------------------------------
1164 */
1165static int
1166TclX_KeyldelObjCmd (clientData, interp, objc, objv)
1167    ClientData	 clientData;
1168    Tcl_Interp	*interp;
1169    int		 objc;
1170    Tcl_Obj	*CONST objv[];
1171{
1172    Tcl_Obj *keylVarPtr, *keylPtr;
1173    char *key;
1174    int idx, keyLen, status;
1175
1176    if (objc < 3) {
1177	return TclX_WrongArgs (interp, objv [0], "listvar key ?key ...?");
1178    }
1179
1180    /*
1181     * Get the variable that we are going to update.  If it is shared by more
1182     * than being a variable, duplicated it.
1183     */
1184    keylVarPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
1185    if (keylVarPtr == NULL) {
1186	return TCL_ERROR;
1187    }
1188    if (Tcl_IsShared (keylVarPtr)) {
1189	keylPtr = Tcl_DuplicateObj (keylVarPtr);
1190	keylVarPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, keylPtr,
1191				   TCL_LEAVE_ERR_MSG);
1192	if (keylVarPtr == NULL) {
1193	    Tcl_DecrRefCount(keylPtr);
1194	    return TCL_ERROR;
1195	}
1196	if (keylVarPtr != keylPtr)
1197	    Tcl_DecrRefCount(keylPtr);
1198    }
1199    keylPtr = keylVarPtr;
1200
1201    for (idx = 2; idx < objc; idx++) {
1202	key = Tcl_GetStringFromObj (objv [idx], &keyLen);
1203	if (ValidateKey(interp, key, keyLen) == TCL_ERROR) {
1204	    return TCL_ERROR;
1205	}
1206
1207	status = TclX_KeyedListDelete (interp, keylPtr, key);
1208	switch (status) {
1209	  case TCL_BREAK:
1210	    TclX_AppendObjResult (interp, "key not found: \"",
1211				  key, "\"", (char *) NULL);
1212	    return TCL_ERROR;
1213	  case TCL_ERROR:
1214	    return TCL_ERROR;
1215	}
1216    }
1217
1218    return TCL_OK;
1219}
1220
1221/*-----------------------------------------------------------------------------
1222 * Tcl_KeylkeysObjCmd --
1223 *     Implements the TCL keylkeys command:
1224 *	   keylkeys listvar ?key?
1225 *-----------------------------------------------------------------------------
1226 */
1227static int
1228TclX_KeylkeysObjCmd (clientData, interp, objc, objv)
1229    ClientData	 clientData;
1230    Tcl_Interp	*interp;
1231    int		 objc;
1232    Tcl_Obj	*CONST objv[];
1233{
1234    Tcl_Obj *keylPtr, *listObjPtr;
1235    char *key;
1236    int keyLen, status;
1237
1238    if ((objc < 2) || (objc > 3)) {
1239	return TclX_WrongArgs (interp, objv [0], "listvar ?key?");
1240    }
1241
1242    keylPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
1243    if (keylPtr == NULL) {
1244	return TCL_ERROR;
1245    }
1246
1247    /*
1248     * If key argument is not specified, then objv [2] is NULL or empty,
1249     * meaning get top level keys.
1250     */
1251    if (objc < 3) {
1252	key = NULL;
1253    } else {
1254	key = Tcl_GetStringFromObj (objv [2], &keyLen);
1255	if (ValidateKey(interp, key, keyLen) == TCL_ERROR) {
1256	    return TCL_ERROR;
1257	}
1258    }
1259
1260    status = TclX_KeyedListGetKeys (interp, keylPtr, key, &listObjPtr);
1261    switch (status) {
1262      case TCL_BREAK:
1263	TclX_AppendObjResult (interp, "key not found: \"", key, "\"",
1264			      (char *) NULL);
1265	return TCL_ERROR;
1266      case TCL_ERROR:
1267	return TCL_ERROR;
1268    }
1269
1270    Tcl_SetObjResult (interp, listObjPtr);
1271
1272    return TCL_OK;
1273}
1274
1275/*-----------------------------------------------------------------------------
1276 * TclX_KeyedListInit --
1277 *   Initialize the keyed list commands for this interpreter.
1278 *
1279 * Parameters:
1280 *   o interp - Interpreter to add commands to.
1281 *-----------------------------------------------------------------------------
1282 */
1283void
1284TclX_KeyedListInit (interp)
1285    Tcl_Interp *interp;
1286{
1287    Tcl_RegisterObjType (&keyedListType);
1288
1289    Tcl_CreateObjCommand (interp, "keylget", TclX_KeylgetObjCmd,
1290	    (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
1291
1292    Tcl_CreateObjCommand (interp, "keylset", TclX_KeylsetObjCmd,
1293	    (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
1294
1295    Tcl_CreateObjCommand (interp, "keyldel", TclX_KeyldelObjCmd,
1296	    (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
1297
1298    Tcl_CreateObjCommand (interp, "keylkeys", TclX_KeylkeysObjCmd,
1299	    (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
1300}
1301
1302
1303