cvs.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxklst.c

   1 /*
   2  * tclXkeylist.c --
   3  *
   4  *  Extended Tcl keyed list commands and interfaces.
   5  *-----------------------------------------------------------------------------
   6  * Copyright 1992 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 2.0 1992/10/16 04:50:53 markd Rel $
  16  *-----------------------------------------------------------------------------
  17  */
  18
  19 #include "tclxint.h"
  20
  21 /*
  22  * Type used to return information about a field that was found in a keyed
  23  * list.
  24  */
  25 typedef struct fieldInfo_t {
  26         int    argc;
  27         char **argv;
  28         int    foundIdx;
  29         char  *valuePtr;
  30         int    valueSize;
  31         } fieldInfo_t;
  32
  33 /*
  34  * Prototypes of internal functions.
  35  */
  36 static int
  37 CompareKeyListField _ANSI_ARGS_((Tcl_Interp   *interp,
  38                                  CONST char   *fieldName,
  39                                  CONST char   *field,
  40                                  char        **valuePtr,
  41                                  int          *valueSizePtr));
  42
  43 static int
  44 SplitAndFindField _ANSI_ARGS_((Tcl_Interp  *interp,
  45                                CONST char  *fieldName,
  46                                CONST char  *keyedList,
  47                                fieldInfo_t *fieldInfoPtr));
  48
  49 \f
  50 /*
  51  *-----------------------------------------------------------------------------
  52  *
  53  * CompareKeyListField --
  54  *   Compare a field name to a field (keyword/value pair) to determine if
  55  * the field names match.
  56  *
  57  * Parameters:
  58  *   o interp (I/O) - Error message will be return in result if there is an
  59  *     error.
  60  *   o fieldName (I) - Field name to compare against field.
  61  *   o field (I) - Field to see if its name matches.
  62  *   o valuePtr (O) - If the field names match, a pointer to value part is
  63  *     returned.
  64  *   o valueSizePtr (O) - If the field names match, the length of the value
  65  *     part is returned here.
  66  * Returns:
  67  *    TCL_OK - If the field names match.
  68  *    TCL_BREAK - If the fields names don't match.
  69  *    TCL_ERROR -  If the list has an invalid format.
  70  *-----------------------------------------------------------------------------
  71  */
  72 static int
  73 CompareKeyListField (interp, fieldName, field, valuePtr, valueSizePtr)
  74     Tcl_Interp   *interp;
  75     CONST char   *fieldName;
  76     CONST char   *field;
  77     char        **valuePtr;
  78     int          *valueSizePtr;
  79 {
  80     char *elementPtr, *nextPtr;
  81     int   fieldNameSize, elementSize;
  82
  83     if (field [0] == '\0') {
  84         interp->result =
  85             "invalid keyed list format: list contains an empty field entry";
  86         return TCL_ERROR;
  87     }
  88     if (TclFindElement (interp, (char *) field, &elementPtr, &nextPtr,
  89                         &elementSize, NULL) != TCL_OK)
  90         return TCL_ERROR;
  91     if (elementSize == 0) {
  92         interp->result =
  93             "invalid keyed list format: list contains an empty field name";
  94         return TCL_ERROR;
  95     }
  96     if (nextPtr[0] == '\0') {
  97         Tcl_AppendResult (interp, "invalid keyed list format or inconsistent ",
  98                           "field name scoping: no value associated with ",
  99                           "field \"", elementPtr, "\"", (char *) NULL);
 100         return TCL_ERROR;
 101     }
 102
 103     fieldNameSize = strlen ((char *) fieldName);
 104     if (!((elementSize == fieldNameSize) &&
 105             STRNEQU (elementPtr, ((char *) fieldName), fieldNameSize)))
 106         return TCL_BREAK;   /* Names do not match */
 107
 108     /*
 109      * Extract the value from the list.
 110      */
 111     if (TclFindElement (interp, nextPtr, &elementPtr, &nextPtr, &elementSize,
 112                         NULL) != TCL_OK)
 113         return TCL_ERROR;
 114     if (nextPtr[0] != '\0') {
 115         Tcl_AppendResult (interp, "invalid keyed list format: ",
 116                           "trailing data following value in field: \"",
 117                           elementPtr, "\"", (char *) NULL);
 118         return TCL_ERROR;
 119     }
 120     *valuePtr = elementPtr;
 121     *valueSizePtr = elementSize;
 122     return TCL_OK;
 123 }
 124 \f
 125 /*
 126  *-----------------------------------------------------------------------------
 127  *
 128  * SplitAndFindField --
 129  *   Split a keyed list into an argv and locate a field (key/value pair)
 130  * in the list.
 131  *
 132  * Parameters:
 133  *   o interp (I/O) - Error message will be return in result if there is an
 134  *     error.
 135  *   o fieldName (I) - The name of the field to find.  Will validate that the
 136  *     name is not empty.  If the name has a sub-name (seperated by "."),
 137  *     search for the top level name.
 138  *   o fieldInfoPtr (O) - The following fields are filled in:
 139  *       o argc - The number of elements in the keyed list.
 140  *       o argv - The keyed list argv is returned here, even if the key was
 141  *         not found.  Client must free.  Will be NULL is an error occurs.
 142  *       o foundIdx - The argv index containing the list entry that matches
 143  *         the field name, or -1 if the key was not found.
 144  *       o valuePtr - Pointer to the value part of the found element. NULL
 145  *         in not found.
 146  *       o valueSize - The size of the value part.
 147  * Returns:
 148  *   Standard Tcl result.
 149  *-----------------------------------------------------------------------------
 150  */
 151 static int
 152 SplitAndFindField (interp, fieldName, keyedList, fieldInfoPtr)
 153     Tcl_Interp  *interp;
 154     CONST char  *fieldName;
 155     CONST char  *keyedList;
 156     fieldInfo_t *fieldInfoPtr;
 157 {
 158     int  idx, result;
 159
 160     if (fieldName == '\0') {
 161         interp->result = "null key not allowed";
 162         return TCL_ERROR;
 163     }
 164
 165     fieldInfoPtr->argv = NULL;
 166
 167     if (Tcl_SplitList (interp, (char *) keyedList, &fieldInfoPtr->argc,
 168                        &fieldInfoPtr->argv) != TCL_OK)
 169         goto errorExit;
 170
 171     result = TCL_BREAK;
 172     for (idx = 0; idx < fieldInfoPtr->argc; idx++) {
 173         result = CompareKeyListField (interp, fieldName,
 174                                       fieldInfoPtr->argv [idx],
 175                                       &fieldInfoPtr->valuePtr,
 176                                       &fieldInfoPtr->valueSize);
 177         if (result != TCL_BREAK)
 178             break;  /* Found or error, exit before idx is incremented. */
 179     }
 180     if (result == TCL_ERROR)
 181         goto errorExit;
 182
 183     if (result == TCL_BREAK) {
 184         fieldInfoPtr->foundIdx = -1;  /* Not found */
 185         fieldInfoPtr->valuePtr = NULL;
 186     } else {
 187         fieldInfoPtr->foundIdx = idx;
 188     }
 189     return TCL_OK;
 190
 191 errorExit:
 192     if (fieldInfoPtr->argv != NULL)
 193         ckfree (fieldInfoPtr->argv);
 194     fieldInfoPtr->argv = NULL;
 195     return TCL_ERROR;
 196 }
 197 \f
 198 /*
 199  *-----------------------------------------------------------------------------
 200  *
 201  * Tcl_GetKeyedListKeys --
 202  *   Retrieve a list of keyes from a keyed list.  The list is walked rather
 203  * than converted to a argv for increased performance.
 204  *
 205  * Parameters:
 206  *   o interp (I/O) - Error message will be return in result if there is an
 207  *     error.
 208  *   o subFieldName (I) - If "" or NULL, then the keys are retreved for
 209  *     the top level of the list.  If specified, it is name of the field who's
 210  *     subfield keys are to be retrieve.
 211  *   o keyedList (I) - The list to search for the field.
 212  *   o keyesArgcPtr (O) - The number of keys in the keyed list is returned
 213  *     here.
 214  *   o keyesArgvPtr (O) - An argv containing the key names.  It is dynamically
 215  *     allocated, containing both the array and the strings. A single call
 216  *     to ckfree will release it.
 217  * Returns:
 218  *   TCL_OK - If the field was found.
 219  *   TCL_BREAK - If the field was not found.
 220  *   TCL_ERROR - If an error occured.
 221  *-----------------------------------------------------------------------------
 222  */
 223 int
 224 Tcl_GetKeyedListKeys (interp, subFieldName, keyedList, keyesArgcPtr,
 225                       keyesArgvPtr)
 226     Tcl_Interp  *interp;
 227     CONST char  *subFieldName;
 228     CONST char  *keyedList;
 229     int         *keyesArgcPtr;
 230     char      ***keyesArgvPtr;
 231 {
 232     char  *scanPtr, *subFieldList;
 233     int    result, keyCount, totalKeySize, idx;
 234     char  *fieldPtr, *keyPtr, *nextByte, *dummyPtr;
 235     int    fieldSize,  keySize;
 236     char **keyArgv;
 237
 238     /*
 239      * If the keys of a subfield are requested, the dig out that field's
 240      * list and then rummage through in getting the keys.
 241      */
 242     subFieldList = NULL;
 243     if ((subFieldName != NULL) && (subFieldName [0] != '\0')) {
 244         result = Tcl_GetKeyedListField (interp, subFieldName, keyedList,
 245                                         &subFieldList);
 246         if (result != TCL_OK)
 247             return result;
 248         keyedList = subFieldList;
 249     }
 250
 251     /*
 252      * Walk the list count the number of field names and their length.
 253      */
 254     keyCount = 0;
 255     totalKeySize = 0;
 256     scanPtr = (char *) keyedList;
 257
 258     while (*scanPtr != '\0') {
 259         result = TclFindElement (interp, scanPtr, &fieldPtr, &scanPtr,
 260                                  &fieldSize, NULL);
 261         if (result != TCL_OK)
 262             goto errorExit;
 263         result = TclFindElement (interp, fieldPtr, &keyPtr, &dummyPtr,
 264                                  &keySize, NULL);
 265         if (result != TCL_OK)
 266             goto errorExit;
 267
 268         keyCount++;
 269         totalKeySize += keySize + 1;
 270     }
 271
 272     /*
 273      * Allocate a structure to hold both the argv and strings.
 274      */
 275     keyArgv = (char **) ckalloc (((keyCount + 1) * sizeof (char *)) +
 276                                  totalKeySize);
 277     keyArgv [keyCount] = NULL;
 278     nextByte = ((char *) keyArgv) + ((keyCount + 1) * sizeof (char *));
 279
 280     /*
 281      * Walk the list once more, copying in the strings and building up the
 282      * argv.
 283      */
 284     scanPtr = (char *) keyedList;
 285     idx = 0;
 286
 287     while (*scanPtr != '\0') {
 288         TclFindElement (interp, scanPtr, &fieldPtr, &scanPtr, &fieldSize,
 289                         NULL);
 290         TclFindElement (interp, fieldPtr, &keyPtr, &dummyPtr, &keySize, NULL);
 291         keyArgv [idx++] = nextByte;
 292         strncpy (nextByte, keyPtr, keySize);
 293         nextByte [keySize] = '\0';
 294         nextByte += keySize + 1;
 295     }
 296     *keyesArgcPtr = keyCount;
 297     *keyesArgvPtr = keyArgv;
 298
 299     if (subFieldList != NULL)
 300         ckfree (subFieldList);
 301     return TCL_OK;
 302
 303   errorExit:
 304     if (subFieldList != NULL)
 305         ckfree (subFieldList);
 306     return TCL_ERROR;
 307 }
 308 \f
 309 /*
 310  *-----------------------------------------------------------------------------
 311  *
 312  * Tcl_GetKeyedListField --
 313  *   Retrieve a field value from a keyed list.  The list is walked rather than
 314  * converted to a argv for increased performance.  This if the name contains
 315  * sub-fields, this function recursive.
 316  *
 317  * Parameters:
 318  *   o interp (I/O) - Error message will be return in result if there is an
 319  *     error.
 320  *   o fieldName (I) - The name of the field to extract.  Will recusively
 321  *     process sub-field names seperated by `.'.
 322  *   o keyedList (I) - The list to search for the field.
 323  *   o fieldValuePtr (O) - If the field is found, a pointer to a dynamicly
 324  *     allocated string containing the value is returned here.  If NULL is
 325  *     specified, then only the presence of the field is validated, the
 326  *     value is not returned.
 327  * Returns:
 328  *   TCL_OK - If the field was found.
 329  *   TCL_BREAK - If the field was not found.
 330  *   TCL_ERROR - If an error occured.
 331  *-----------------------------------------------------------------------------
 332  */
 333 int
 334 Tcl_GetKeyedListField (interp, fieldName, keyedList, fieldValuePtr)
 335     Tcl_Interp  *interp;
 336     CONST char  *fieldName;
 337     CONST char  *keyedList;
 338     char       **fieldValuePtr;
 339 {
 340     char *nameSeparPtr, *scanPtr, *valuePtr;
 341     int   valueSize, result;
 342
 343     if (fieldName == '\0') {
 344         interp->result = "null key not allowed";
 345         return TCL_ERROR;
 346     }
 347
 348     /*
 349      * Check for sub-names, temporarly delimit the top name with a '\0'.
 350      */
 351     nameSeparPtr = strchr ((char *) fieldName, '.');
 352     if (nameSeparPtr != NULL)
 353         *nameSeparPtr = '\0';
 354
 355     /*
 356      * Walk the list looking for a field name that matches.
 357      */
 358     scanPtr = (char *) keyedList;
 359     result = TCL_BREAK;   /* Assume not found */
 360
 361     while (*scanPtr != '\0') {
 362         char *fieldPtr;
 363         int   fieldSize;
 364         char  saveChar;
 365
 366         result = TclFindElement (interp, scanPtr, &fieldPtr, &scanPtr,
 367                                  &fieldSize, NULL);
 368         if (result != TCL_OK)
 369             break;
 370
 371         saveChar = fieldPtr [fieldSize];
 372         fieldPtr [fieldSize] = '\0';
 373
 374         result = CompareKeyListField (interp, (char *) fieldName, fieldPtr,
 375                                       &valuePtr, &valueSize);
 376         fieldPtr [fieldSize] = saveChar;
 377         if (result != TCL_BREAK)
 378             break;  /* Found or an error */
 379     }
 380
 381     if (result != TCL_OK)
 382         goto exitPoint;   /* Not found or an error */
 383
 384     /*
 385      * If a subfield is requested, recurse to get the value otherwise allocate
 386      * a buffer to hold the value.
 387      */
 388     if (nameSeparPtr != NULL) {
 389         char  saveChar;
 390
 391         saveChar = valuePtr [valueSize];
 392         valuePtr [valueSize] = '\0';
 393         result = Tcl_GetKeyedListField (interp, nameSeparPtr+1, valuePtr,
 394                                         fieldValuePtr);
 395         valuePtr [valueSize] = saveChar;
 396     } else {
 397         if (fieldValuePtr != NULL) {
 398             char *fieldValue;
 399
 400             fieldValue = ckalloc (valueSize + 1);
 401             strncpy (fieldValue, valuePtr, valueSize);
 402             fieldValue [valueSize] = '\0';
 403             *fieldValuePtr = fieldValue;
 404         }
 405     }
 406 exitPoint:
 407     if (nameSeparPtr != NULL)
 408          *nameSeparPtr = '.';
 409     return result;
 410 }
 411 \f
 412 /*
 413  *-----------------------------------------------------------------------------
 414  *
 415  * Tcl_SetKeyedListField --
 416  *   Set a field value in keyed list.
 417  *
 418  * Parameters:
 419  *   o interp (I/O) - Error message will be return in result if there is an
 420  *     error.
 421  *   o fieldName (I) - The name of the field to extract.  Will recusively
 422  *     process sub-field names seperated by `.'.
 423  *   o fieldValue (I) - The value to set for the field.
 424  *   o keyedList (I) - The keyed list to set a field value in, may be an
 425  *     NULL or an empty list to create a new keyed list.
 426  * Returns:
 427  *   A pointer to a dynamically allocated string, or NULL if an error
 428  *   occured.
 429  *-----------------------------------------------------------------------------
 430  */
 431 char *
 432 Tcl_SetKeyedListField (interp, fieldName, fieldValue, keyedList)
 433     Tcl_Interp  *interp;
 434     CONST char  *fieldName;
 435     CONST char  *fieldValue;
 436     CONST char  *keyedList;
 437 {
 438     char        *nameSeparPtr;
 439     char        *newField = NULL, *newList;
 440     fieldInfo_t  fieldInfo;
 441     char        *elemArgv [2];
 442
 443     if (keyedList == NULL)
 444         keyedList = "";
 445
 446     /*
 447      * Check for sub-names, temporarly delimit the top name with a '\0'.
 448      */
 449     nameSeparPtr = strchr ((char *) fieldName, '.');
 450     if (nameSeparPtr != NULL)
 451         *nameSeparPtr = '\0';
 452
 453     if (SplitAndFindField (interp, fieldName, keyedList, &fieldInfo) != TCL_OK)
 454         goto errorExit;
 455
 456     /*
 457      * Either recursively retrieve build the field value or just use the
 458      * supplied value.
 459      */
 460     elemArgv [0] = (char *) fieldName;
 461     if (nameSeparPtr != NULL) {
 462         char saveChar;
 463
 464         if (fieldInfo.valuePtr != NULL) {
 465             saveChar = fieldInfo.valuePtr [fieldInfo.valueSize];
 466             fieldInfo.valuePtr [fieldInfo.valueSize] = '\0';
 467         }
 468         elemArgv [1] = Tcl_SetKeyedListField (interp, nameSeparPtr+1,
 469                                               fieldValue, fieldInfo.valuePtr);
 470
 471         if (fieldInfo.valuePtr != NULL)
 472             fieldInfo.valuePtr [fieldInfo.valueSize] = saveChar;
 473         if (elemArgv [1] == NULL)
 474             goto errorExit;
 475         newField = Tcl_Merge (2, elemArgv);
 476         ckfree (elemArgv [1]);
 477     } else {
 478         elemArgv [1] = (char *) fieldValue;
 479         newField = Tcl_Merge (2, elemArgv);
 480     }
 481
 482     /*
 483      * If the field does not current exist in the keyed list, append it,
 484      * otherwise replace it.
 485      */
 486     if (fieldInfo.foundIdx == -1) {
 487         fieldInfo.foundIdx = fieldInfo.argc;
 488         fieldInfo.argc++;
 489     }
 490
 491     fieldInfo.argv [fieldInfo.foundIdx] = newField;
 492     newList = Tcl_Merge (fieldInfo.argc, fieldInfo.argv);
 493
 494     if (nameSeparPtr != NULL)
 495          *nameSeparPtr = '.';
 496     ckfree ((char *) newField);
 497     ckfree ((char *) fieldInfo.argv);
 498     return newList;
 499
 500 errorExit:
 501     if (nameSeparPtr != NULL)
 502          *nameSeparPtr = '.';
 503     if (newField != NULL)
 504         ckfree ((char *) newField);
 505     if (fieldInfo.argv != NULL)
 506         ckfree ((char *) fieldInfo.argv);
 507     return NULL;
 508 }
 509 \f
 510 /*
 511  *-----------------------------------------------------------------------------
 512  *
 513  * Tcl_DeleteKeyedListField --
 514  *   Delete a field value in keyed list.
 515  *
 516  * Parameters:
 517  *   o interp (I/O) - Error message will be return in result if there is an
 518  *     error.
 519  *   o fieldName (I) - The name of the field to extract.  Will recusively
 520  *     process sub-field names seperated by `.'.
 521  *   o fieldValue (I) - The value to set for the field.
 522  *   o keyedList (I) - The keyed list to delete the field from.
 523  * Returns:
 524  *   A pointer to a dynamically allocated string containing the new list, or
 525  *   NULL if an error occured.
 526  *-----------------------------------------------------------------------------
 527  */
 528 char *
 529 Tcl_DeleteKeyedListField (interp, fieldName, keyedList)
 530     Tcl_Interp  *interp;
 531     CONST char  *fieldName;
 532     CONST char  *keyedList;
 533 {
 534     char        *nameSeparPtr;
 535     char        *newList;
 536     int          idx;
 537     fieldInfo_t  fieldInfo;
 538     char        *elemArgv [2];
 539     char        *newElement;
 540     /*
 541      * Check for sub-names, temporarly delimit the top name with a '\0'.
 542      */
 543     nameSeparPtr = strchr ((char *) fieldName, '.');
 544     if (nameSeparPtr != NULL)
 545         *nameSeparPtr = '\0';
 546
 547     if (SplitAndFindField (interp, fieldName, keyedList, &fieldInfo) != TCL_OK)
 548         goto errorExit;
 549
 550     if (fieldInfo.foundIdx == -1) {
 551         Tcl_AppendResult (interp, "field name not found: \"",  fieldName,
 552                           "\"", (char *) NULL);
 553         goto errorExit;
 554     }
 555
 556     /*
 557      * If sub-field, recurse down to find the field to delete. If empty field
 558      * returned or no sub-field, delete the found entry by moving everything
 559      * up in the argv.
 560      */
 561     elemArgv [0] = (char *) fieldName;
 562     if (nameSeparPtr != NULL) {
 563         char saveChar;
 564
 565         if (fieldInfo.valuePtr != NULL) {
 566             saveChar = fieldInfo.valuePtr [fieldInfo.valueSize];
 567             fieldInfo.valuePtr [fieldInfo.valueSize] = '\0';
 568         }
 569         elemArgv [1] = Tcl_DeleteKeyedListField (interp, nameSeparPtr+1,
 570                                                  fieldInfo.valuePtr);
 571         if (fieldInfo.valuePtr != NULL)
 572             fieldInfo.valuePtr [fieldInfo.valueSize] = saveChar;
 573         if (elemArgv [1] == NULL)
 574             goto errorExit;
 575         if (elemArgv [1][0] == '\0')
 576             newElement = NULL;
 577         else
 578             newElement = Tcl_Merge (2, elemArgv);
 579         ckfree (elemArgv [1]);
 580     } else
 581         newElement = NULL;
 582
 583     if (newElement == NULL) {
 584         for (idx = fieldInfo.foundIdx; idx < fieldInfo.argc; idx++)
 585              fieldInfo.argv [idx] = fieldInfo.argv [idx + 1];
 586         fieldInfo.argc--;
 587     } else
 588         fieldInfo.argv [fieldInfo.foundIdx] = newElement;
 589
 590     newList = Tcl_Merge (fieldInfo.argc, fieldInfo.argv);
 591
 592     if (nameSeparPtr != NULL)
 593          *nameSeparPtr = '.';
 594     if (newElement != NULL)
 595         ckfree (newElement);
 596     ckfree ((char *) fieldInfo.argv);
 597     return newList;
 598
 599 errorExit:
 600     if (nameSeparPtr != NULL)
 601          *nameSeparPtr = '.';
 602     if (fieldInfo.argv != NULL)
 603          ckfree ((char *) fieldInfo.argv);
 604     return NULL;
 605 }
 606 \f
 607 /*
 608  *-----------------------------------------------------------------------------
 609  *
 610  * Tcl_KeyldelCmd --
 611  *     Implements the TCL keyldel command:
 612  *         keyldel listvar key
 613  *
 614  * Results:
 615  *    Standard TCL results.
 616  *
 617  *----------------------------------------------------------------------------
 618  */
 619 int
 620 Tcl_KeyldelCmd (clientData, interp, argc, argv)
 621     ClientData  clientData;
 622     Tcl_Interp *interp;
 623     int         argc;
 624     char      **argv;
 625 {
 626     char  *keyedList, *newList;
 627     int    listArgc, fieldIdx, idx;
 628     char **listArgv;
 629     char  *varPtr;
 630
 631     if (argc != 3) {
 632         Tcl_AppendResult (interp, tclXWrongArgs, argv [0],
 633                           " listvar key", (char *) NULL);
 634         return TCL_ERROR;
 635     }
 636
 637     keyedList = Tcl_GetVar (interp, argv[1], TCL_LEAVE_ERR_MSG);
 638     if (keyedList == NULL)
 639         return TCL_ERROR;
 640
 641     newList = Tcl_DeleteKeyedListField (interp, argv [2], keyedList);
 642     if (newList == NULL)
 643         return TCL_ERROR;
 644
 645     varPtr = Tcl_SetVar (interp, argv [1], newList, TCL_LEAVE_ERR_MSG);
 646     ckfree ((char *) newList);
 647
 648     return (varPtr == NULL) ? TCL_ERROR : TCL_OK;
 649 }
 650 \f
 651 /*
 652  *-----------------------------------------------------------------------------
 653  *
 654  * Tcl_KeylgetCmd --
 655  *     Implements the TCL keylget command:
 656  *         keylget listvar [key] [retvar | {}]
 657  *
 658  * Results:
 659  *    Standard TCL results.
 660  *
 661  *-----------------------------------------------------------------------------
 662  */
 663 int
 664 Tcl_KeylgetCmd (clientData, interp, argc, argv)
 665     ClientData  clientData;
 666     Tcl_Interp *interp;
 667     int         argc;
 668     char      **argv;
 669 {
 670     char   *keyedList;
 671     char   *fieldValue;
 672     char  **fieldValuePtr;
 673     int     result;
 674
 675     if ((argc < 2) || (argc > 4)) {
 676         Tcl_AppendResult (interp, tclXWrongArgs, argv [0],
 677                           " listvar [key] [retvar | {}]", (char *) NULL);
 678         return TCL_ERROR;
 679     }
 680     keyedList = Tcl_GetVar (interp, argv[1], TCL_LEAVE_ERR_MSG);
 681     if (keyedList == NULL)
 682         return TCL_ERROR;
 683
 684     /*
 685      * Handle request for list of keys, use keylkeys command.
 686      */
 687     if (argc == 2)
 688         return Tcl_KeylkeysCmd (clientData, interp, argc, argv);
 689
 690     /*
 691      * Handle retrieving a value for a specified key.
 692      */
 693     if (argv [2] == '\0') {
 694         interp->result = "null key not allowed";
 695         return TCL_ERROR;
 696     }
 697     if ((argc == 4) && (argv [3][0] == '\0'))
 698         fieldValuePtr = NULL;
 699     else
 700         fieldValuePtr = &fieldValue;
 701
 702     result = Tcl_GetKeyedListField (interp, argv [2], keyedList,
 703                                     fieldValuePtr);
 704     if (result == TCL_ERROR)
 705         return TCL_ERROR;
 706
 707     /*
 708      * Handle field name not found.
 709      */
 710     if (result == TCL_BREAK) {
 711         if (argc == 3) {
 712             Tcl_AppendResult (interp, "key \"", argv [2],
 713                               "\" not found in keyed list", (char *) NULL);
 714             return TCL_ERROR;
 715         } else {
 716             interp->result = "0";
 717             return TCL_OK;
 718         }
 719     }
 720
 721     /*
 722      * Handle field name found and return in the result.
 723      */
 724     if (argc == 3) {
 725         Tcl_SetResult (interp, fieldValue, TCL_DYNAMIC);
 726         return TCL_OK;
 727     }
 728
 729     /*
 730      * Handle null return variable specified and key was found.
 731      */
 732     if (argv [3][0] == '\0') {
 733         interp->result = "1";
 734         return TCL_OK;
 735     }
 736
 737     /*
 738      * Handle returning the value to the variable.
 739      */
 740     if (Tcl_SetVar (interp, argv [3], fieldValue, TCL_LEAVE_ERR_MSG) == NULL)
 741         result = TCL_ERROR;
 742     else
 743         result = TCL_OK;
 744     ckfree (fieldValue);
 745     interp->result = "1";
 746     return result;
 747 }
 748 \f
 749 /*
 750  *-----------------------------------------------------------------------------
 751  *
 752  * Tcl_KeylkeysCmd --
 753  *     Implements the TCL keylkeys command:
 754  *         keylkeys listvar [key]
 755  *
 756  * Results:
 757  *    Standard TCL results.
 758  *
 759  *-----------------------------------------------------------------------------
 760  */
 761 int
 762 Tcl_KeylkeysCmd (clientData, interp, argc, argv)
 763     ClientData  clientData;
 764     Tcl_Interp *interp;
 765     int         argc;
 766     char      **argv;
 767 {
 768     char   *keyedList, **keyesArgv;
 769     int    result, keyesArgc;
 770
 771     if ((argc < 2) || (argc > 3)) {
 772         Tcl_AppendResult (interp, tclXWrongArgs, argv [0],
 773                           " listvar [key]", (char *) NULL);
 774         return TCL_ERROR;
 775     }
 776     keyedList = Tcl_GetVar (interp, argv[1], TCL_LEAVE_ERR_MSG);
 777     if (keyedList == NULL)
 778         return TCL_ERROR;
 779
 780     /*
 781      * If key argument is not specified, then argv [2] is NULL, meaning get
 782      * top level keys.
 783      */
 784     result = Tcl_GetKeyedListKeys (interp, argv [2], keyedList, &keyesArgc,
 785                                    &keyesArgv);
 786     if (result == TCL_ERROR)
 787         return TCL_ERROR;
 788     if (result  == TCL_BREAK) {
 789         Tcl_AppendResult (interp, "field name not found: \"",  argv [2],
 790                           "\"", (char *) NULL);
 791         return TCL_ERROR;
 792     }
 793
 794     Tcl_SetResult (interp, Tcl_Merge (keyesArgc, keyesArgv), TCL_DYNAMIC);
 795     ckfree (keyesArgv);
 796     return TCL_OK;
 797 }
 798 \f
 799 /*
 800  *-----------------------------------------------------------------------------
 801  *
 802  * Tcl_KeylsetCmd --
 803  *     Implements the TCL keylset command:
 804  *         keylset listvar key value [key value...]
 805  *
 806  * Results:
 807  *    Standard TCL results.
 808  *
 809  *-----------------------------------------------------------------------------
 810  */
 811 int
 812 Tcl_KeylsetCmd (clientData, interp, argc, argv)
 813     ClientData  clientData;
 814     Tcl_Interp *interp;
 815     int         argc;
 816     char      **argv;
 817 {
 818     char *keyedList, *newList, *prevList;
 819     char *varPtr;
 820     int   idx;
 821
 822     if ((argc < 4) || ((argc % 2) != 0)) {
 823         Tcl_AppendResult (interp, tclXWrongArgs, argv [0],
 824                           " listvar key value [key value...]", (char *) NULL);
 825         return TCL_ERROR;
 826     }
 827
 828     keyedList = Tcl_GetVar (interp, argv[1], 0);
 829
 830     newList = keyedList;
 831     for (idx = 2; idx < argc; idx += 2) {
 832         prevList = newList;
 833         newList = Tcl_SetKeyedListField (interp, argv [idx], argv [idx + 1],
 834                                          prevList);
 835         if (prevList != keyedList)
 836             ckfree (prevList);
 837         if (newList == NULL)
 838            return TCL_ERROR;
 839     }
 840     varPtr = Tcl_SetVar (interp, argv [1], newList, TCL_LEAVE_ERR_MSG);
 841     ckfree ((char *) newList);
 842
 843     return (varPtr == NULL) ? TCL_ERROR : TCL_OK;
 844 }