]>
cvs.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxklst.c
4 * Extended Tcl keyed list commands and interfaces.
5 *-----------------------------------------------------------------------------
6 * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
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
14 *-----------------------------------------------------------------------------
15 * $Id: tclXkeylist.c,v 2.0 1992/10/16 04:50:53 markd Rel $
16 *-----------------------------------------------------------------------------
22 * Type used to return information about a field that was found in a keyed
25 typedef struct fieldInfo_t
{
34 * Prototypes of internal functions.
37 CompareKeyListField
_ANSI_ARGS_((Tcl_Interp
*interp
,
38 CONST
char *fieldName
,
44 SplitAndFindField
_ANSI_ARGS_((Tcl_Interp
*interp
,
45 CONST
char *fieldName
,
46 CONST
char *keyedList
,
47 fieldInfo_t
*fieldInfoPtr
));
51 *-----------------------------------------------------------------------------
53 * CompareKeyListField --
54 * Compare a field name to a field (keyword/value pair) to determine if
55 * the field names match.
58 * o interp (I/O) - Error message will be return in result if there is an
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
64 * o valueSizePtr (O) - If the field names match, the length of the value
65 * part is returned here.
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 *-----------------------------------------------------------------------------
73 CompareKeyListField (interp
, fieldName
, field
, valuePtr
, valueSizePtr
)
75 CONST
char *fieldName
;
80 char *elementPtr
, *nextPtr
;
81 int fieldNameSize
, elementSize
;
83 if (field
[0] == '\0') {
85 "invalid keyed list format: list contains an empty field entry";
88 if (TclFindElement (interp
, (char *) field
, &elementPtr
, &nextPtr
,
89 &elementSize
, NULL
) != TCL_OK
)
91 if (elementSize
== 0) {
93 "invalid keyed list format: list contains an empty field name";
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
);
103 fieldNameSize
= strlen ((char *) fieldName
);
104 if (!((elementSize
== fieldNameSize
) &&
105 STRNEQU (elementPtr
, ((char *) fieldName
), fieldNameSize
)))
106 return TCL_BREAK
; /* Names do not match */
109 * Extract the value from the list.
111 if (TclFindElement (interp
, nextPtr
, &elementPtr
, &nextPtr
, &elementSize
,
114 if (nextPtr
[0] != '\0') {
115 Tcl_AppendResult (interp
, "invalid keyed list format: ",
116 "trailing data following value in field: \"",
117 elementPtr
, "\"", (char *) NULL
);
120 *valuePtr
= elementPtr
;
121 *valueSizePtr
= elementSize
;
126 *-----------------------------------------------------------------------------
128 * SplitAndFindField --
129 * Split a keyed list into an argv and locate a field (key/value pair)
133 * o interp (I/O) - Error message will be return in result if there is an
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
146 * o valueSize - The size of the value part.
148 * Standard Tcl result.
149 *-----------------------------------------------------------------------------
152 SplitAndFindField (interp
, fieldName
, keyedList
, fieldInfoPtr
)
154 CONST
char *fieldName
;
155 CONST
char *keyedList
;
156 fieldInfo_t
*fieldInfoPtr
;
160 if (fieldName
== '\0') {
161 interp
->result
= "null key not allowed";
165 fieldInfoPtr
->argv
= NULL
;
167 if (Tcl_SplitList (interp
, (char *) keyedList
, &fieldInfoPtr
->argc
,
168 &fieldInfoPtr
->argv
) != TCL_OK
)
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. */
180 if (result
== TCL_ERROR
)
183 if (result
== TCL_BREAK
) {
184 fieldInfoPtr
->foundIdx
= -1; /* Not found */
185 fieldInfoPtr
->valuePtr
= NULL
;
187 fieldInfoPtr
->foundIdx
= idx
;
192 if (fieldInfoPtr
->argv
!= NULL
)
193 ckfree (fieldInfoPtr
->argv
);
194 fieldInfoPtr
->argv
= NULL
;
199 *-----------------------------------------------------------------------------
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.
206 * o interp (I/O) - Error message will be return in result if there is an
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
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.
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 *-----------------------------------------------------------------------------
224 Tcl_GetKeyedListKeys (interp
, subFieldName
, keyedList
, keyesArgcPtr
,
227 CONST
char *subFieldName
;
228 CONST
char *keyedList
;
230 char ***keyesArgvPtr
;
232 char *scanPtr
, *subFieldList
;
233 int result
, keyCount
, totalKeySize
, idx
;
234 char *fieldPtr
, *keyPtr
, *nextByte
, *dummyPtr
;
235 int fieldSize
, keySize
;
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.
243 if ((subFieldName
!= NULL
) && (subFieldName
[0] != '\0')) {
244 result
= Tcl_GetKeyedListField (interp
, subFieldName
, keyedList
,
246 if (result
!= TCL_OK
)
248 keyedList
= subFieldList
;
252 * Walk the list count the number of field names and their length.
256 scanPtr
= (char *) keyedList
;
258 while (*scanPtr
!= '\0') {
259 result
= TclFindElement (interp
, scanPtr
, &fieldPtr
, &scanPtr
,
261 if (result
!= TCL_OK
)
263 result
= TclFindElement (interp
, fieldPtr
, &keyPtr
, &dummyPtr
,
265 if (result
!= TCL_OK
)
269 totalKeySize
+= keySize
+ 1;
273 * Allocate a structure to hold both the argv and strings.
275 keyArgv
= (char **) ckalloc (((keyCount
+ 1) * sizeof (char *)) +
277 keyArgv
[keyCount
] = NULL
;
278 nextByte
= ((char *) keyArgv
) + ((keyCount
+ 1) * sizeof (char *));
281 * Walk the list once more, copying in the strings and building up the
284 scanPtr
= (char *) keyedList
;
287 while (*scanPtr
!= '\0') {
288 TclFindElement (interp
, scanPtr
, &fieldPtr
, &scanPtr
, &fieldSize
,
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;
296 *keyesArgcPtr
= keyCount
;
297 *keyesArgvPtr
= keyArgv
;
299 if (subFieldList
!= NULL
)
300 ckfree (subFieldList
);
304 if (subFieldList
!= NULL
)
305 ckfree (subFieldList
);
310 *-----------------------------------------------------------------------------
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.
318 * o interp (I/O) - Error message will be return in result if there is an
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.
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 *-----------------------------------------------------------------------------
334 Tcl_GetKeyedListField (interp
, fieldName
, keyedList
, fieldValuePtr
)
336 CONST
char *fieldName
;
337 CONST
char *keyedList
;
338 char **fieldValuePtr
;
340 char *nameSeparPtr
, *scanPtr
, *valuePtr
;
341 int valueSize
, result
;
343 if (fieldName
== '\0') {
344 interp
->result
= "null key not allowed";
349 * Check for sub-names, temporarly delimit the top name with a '\0'.
351 nameSeparPtr
= strchr ((char *) fieldName
, '.');
352 if (nameSeparPtr
!= NULL
)
353 *nameSeparPtr
= '\0';
356 * Walk the list looking for a field name that matches.
358 scanPtr
= (char *) keyedList
;
359 result
= TCL_BREAK
; /* Assume not found */
361 while (*scanPtr
!= '\0') {
366 result
= TclFindElement (interp
, scanPtr
, &fieldPtr
, &scanPtr
,
368 if (result
!= TCL_OK
)
371 saveChar
= fieldPtr
[fieldSize
];
372 fieldPtr
[fieldSize
] = '\0';
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 */
381 if (result
!= TCL_OK
)
382 goto exitPoint
; /* Not found or an error */
385 * If a subfield is requested, recurse to get the value otherwise allocate
386 * a buffer to hold the value.
388 if (nameSeparPtr
!= NULL
) {
391 saveChar
= valuePtr
[valueSize
];
392 valuePtr
[valueSize
] = '\0';
393 result
= Tcl_GetKeyedListField (interp
, nameSeparPtr
+1, valuePtr
,
395 valuePtr
[valueSize
] = saveChar
;
397 if (fieldValuePtr
!= NULL
) {
400 fieldValue
= ckalloc (valueSize
+ 1);
401 strncpy (fieldValue
, valuePtr
, valueSize
);
402 fieldValue
[valueSize
] = '\0';
403 *fieldValuePtr
= fieldValue
;
407 if (nameSeparPtr
!= NULL
)
413 *-----------------------------------------------------------------------------
415 * Tcl_SetKeyedListField --
416 * Set a field value in keyed list.
419 * o interp (I/O) - Error message will be return in result if there is an
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.
427 * A pointer to a dynamically allocated string, or NULL if an error
429 *-----------------------------------------------------------------------------
432 Tcl_SetKeyedListField (interp
, fieldName
, fieldValue
, keyedList
)
434 CONST
char *fieldName
;
435 CONST
char *fieldValue
;
436 CONST
char *keyedList
;
439 char *newField
= NULL
, *newList
;
440 fieldInfo_t fieldInfo
;
443 if (keyedList
== NULL
)
447 * Check for sub-names, temporarly delimit the top name with a '\0'.
449 nameSeparPtr
= strchr ((char *) fieldName
, '.');
450 if (nameSeparPtr
!= NULL
)
451 *nameSeparPtr
= '\0';
453 if (SplitAndFindField (interp
, fieldName
, keyedList
, &fieldInfo
) != TCL_OK
)
457 * Either recursively retrieve build the field value or just use the
460 elemArgv
[0] = (char *) fieldName
;
461 if (nameSeparPtr
!= NULL
) {
464 if (fieldInfo
.valuePtr
!= NULL
) {
465 saveChar
= fieldInfo
.valuePtr
[fieldInfo
.valueSize
];
466 fieldInfo
.valuePtr
[fieldInfo
.valueSize
] = '\0';
468 elemArgv
[1] = Tcl_SetKeyedListField (interp
, nameSeparPtr
+1,
469 fieldValue
, fieldInfo
.valuePtr
);
471 if (fieldInfo
.valuePtr
!= NULL
)
472 fieldInfo
.valuePtr
[fieldInfo
.valueSize
] = saveChar
;
473 if (elemArgv
[1] == NULL
)
475 newField
= Tcl_Merge (2, elemArgv
);
476 ckfree (elemArgv
[1]);
478 elemArgv
[1] = (char *) fieldValue
;
479 newField
= Tcl_Merge (2, elemArgv
);
483 * If the field does not current exist in the keyed list, append it,
484 * otherwise replace it.
486 if (fieldInfo
.foundIdx
== -1) {
487 fieldInfo
.foundIdx
= fieldInfo
.argc
;
491 fieldInfo
.argv
[fieldInfo
.foundIdx
] = newField
;
492 newList
= Tcl_Merge (fieldInfo
.argc
, fieldInfo
.argv
);
494 if (nameSeparPtr
!= NULL
)
496 ckfree ((char *) newField
);
497 ckfree ((char *) fieldInfo
.argv
);
501 if (nameSeparPtr
!= NULL
)
503 if (newField
!= NULL
)
504 ckfree ((char *) newField
);
505 if (fieldInfo
.argv
!= NULL
)
506 ckfree ((char *) fieldInfo
.argv
);
511 *-----------------------------------------------------------------------------
513 * Tcl_DeleteKeyedListField --
514 * Delete a field value in keyed list.
517 * o interp (I/O) - Error message will be return in result if there is an
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.
524 * A pointer to a dynamically allocated string containing the new list, or
525 * NULL if an error occured.
526 *-----------------------------------------------------------------------------
529 Tcl_DeleteKeyedListField (interp
, fieldName
, keyedList
)
531 CONST
char *fieldName
;
532 CONST
char *keyedList
;
537 fieldInfo_t fieldInfo
;
541 * Check for sub-names, temporarly delimit the top name with a '\0'.
543 nameSeparPtr
= strchr ((char *) fieldName
, '.');
544 if (nameSeparPtr
!= NULL
)
545 *nameSeparPtr
= '\0';
547 if (SplitAndFindField (interp
, fieldName
, keyedList
, &fieldInfo
) != TCL_OK
)
550 if (fieldInfo
.foundIdx
== -1) {
551 Tcl_AppendResult (interp
, "field name not found: \"", fieldName
,
552 "\"", (char *) NULL
);
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
561 elemArgv
[0] = (char *) fieldName
;
562 if (nameSeparPtr
!= NULL
) {
565 if (fieldInfo
.valuePtr
!= NULL
) {
566 saveChar
= fieldInfo
.valuePtr
[fieldInfo
.valueSize
];
567 fieldInfo
.valuePtr
[fieldInfo
.valueSize
] = '\0';
569 elemArgv
[1] = Tcl_DeleteKeyedListField (interp
, nameSeparPtr
+1,
571 if (fieldInfo
.valuePtr
!= NULL
)
572 fieldInfo
.valuePtr
[fieldInfo
.valueSize
] = saveChar
;
573 if (elemArgv
[1] == NULL
)
575 if (elemArgv
[1][0] == '\0')
578 newElement
= Tcl_Merge (2, elemArgv
);
579 ckfree (elemArgv
[1]);
583 if (newElement
== NULL
) {
584 for (idx
= fieldInfo
.foundIdx
; idx
< fieldInfo
.argc
; idx
++)
585 fieldInfo
.argv
[idx
] = fieldInfo
.argv
[idx
+ 1];
588 fieldInfo
.argv
[fieldInfo
.foundIdx
] = newElement
;
590 newList
= Tcl_Merge (fieldInfo
.argc
, fieldInfo
.argv
);
592 if (nameSeparPtr
!= NULL
)
594 if (newElement
!= NULL
)
596 ckfree ((char *) fieldInfo
.argv
);
600 if (nameSeparPtr
!= NULL
)
602 if (fieldInfo
.argv
!= NULL
)
603 ckfree ((char *) fieldInfo
.argv
);
608 *-----------------------------------------------------------------------------
611 * Implements the TCL keyldel command:
612 * keyldel listvar key
615 * Standard TCL results.
617 *----------------------------------------------------------------------------
620 Tcl_KeyldelCmd (clientData
, interp
, argc
, argv
)
621 ClientData clientData
;
626 char *keyedList
, *newList
;
627 int listArgc
, fieldIdx
, idx
;
632 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0],
633 " listvar key", (char *) NULL
);
637 keyedList
= Tcl_GetVar (interp
, argv
[1], TCL_LEAVE_ERR_MSG
);
638 if (keyedList
== NULL
)
641 newList
= Tcl_DeleteKeyedListField (interp
, argv
[2], keyedList
);
645 varPtr
= Tcl_SetVar (interp
, argv
[1], newList
, TCL_LEAVE_ERR_MSG
);
646 ckfree ((char *) newList
);
648 return (varPtr
== NULL
) ? TCL_ERROR
: TCL_OK
;
652 *-----------------------------------------------------------------------------
655 * Implements the TCL keylget command:
656 * keylget listvar [key] [retvar | {}]
659 * Standard TCL results.
661 *-----------------------------------------------------------------------------
664 Tcl_KeylgetCmd (clientData
, interp
, argc
, argv
)
665 ClientData clientData
;
672 char **fieldValuePtr
;
675 if ((argc
< 2) || (argc
> 4)) {
676 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0],
677 " listvar [key] [retvar | {}]", (char *) NULL
);
680 keyedList
= Tcl_GetVar (interp
, argv
[1], TCL_LEAVE_ERR_MSG
);
681 if (keyedList
== NULL
)
685 * Handle request for list of keys, use keylkeys command.
688 return Tcl_KeylkeysCmd (clientData
, interp
, argc
, argv
);
691 * Handle retrieving a value for a specified key.
693 if (argv
[2] == '\0') {
694 interp
->result
= "null key not allowed";
697 if ((argc
== 4) && (argv
[3][0] == '\0'))
698 fieldValuePtr
= NULL
;
700 fieldValuePtr
= &fieldValue
;
702 result
= Tcl_GetKeyedListField (interp
, argv
[2], keyedList
,
704 if (result
== TCL_ERROR
)
708 * Handle field name not found.
710 if (result
== TCL_BREAK
) {
712 Tcl_AppendResult (interp
, "key \"", argv
[2],
713 "\" not found in keyed list", (char *) NULL
);
716 interp
->result
= "0";
722 * Handle field name found and return in the result.
725 Tcl_SetResult (interp
, fieldValue
, TCL_DYNAMIC
);
730 * Handle null return variable specified and key was found.
732 if (argv
[3][0] == '\0') {
733 interp
->result
= "1";
738 * Handle returning the value to the variable.
740 if (Tcl_SetVar (interp
, argv
[3], fieldValue
, TCL_LEAVE_ERR_MSG
) == NULL
)
745 interp
->result
= "1";
750 *-----------------------------------------------------------------------------
753 * Implements the TCL keylkeys command:
754 * keylkeys listvar [key]
757 * Standard TCL results.
759 *-----------------------------------------------------------------------------
762 Tcl_KeylkeysCmd (clientData
, interp
, argc
, argv
)
763 ClientData clientData
;
768 char *keyedList
, **keyesArgv
;
769 int result
, keyesArgc
;
771 if ((argc
< 2) || (argc
> 3)) {
772 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0],
773 " listvar [key]", (char *) NULL
);
776 keyedList
= Tcl_GetVar (interp
, argv
[1], TCL_LEAVE_ERR_MSG
);
777 if (keyedList
== NULL
)
781 * If key argument is not specified, then argv [2] is NULL, meaning get
784 result
= Tcl_GetKeyedListKeys (interp
, argv
[2], keyedList
, &keyesArgc
,
786 if (result
== TCL_ERROR
)
788 if (result
== TCL_BREAK
) {
789 Tcl_AppendResult (interp
, "field name not found: \"", argv
[2],
790 "\"", (char *) NULL
);
794 Tcl_SetResult (interp
, Tcl_Merge (keyesArgc
, keyesArgv
), TCL_DYNAMIC
);
800 *-----------------------------------------------------------------------------
803 * Implements the TCL keylset command:
804 * keylset listvar key value [key value...]
807 * Standard TCL results.
809 *-----------------------------------------------------------------------------
812 Tcl_KeylsetCmd (clientData
, interp
, argc
, argv
)
813 ClientData clientData
;
818 char *keyedList
, *newList
, *prevList
;
822 if ((argc
< 4) || ((argc
% 2) != 0)) {
823 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0],
824 " listvar key value [key value...]", (char *) NULL
);
828 keyedList
= Tcl_GetVar (interp
, argv
[1], 0);
831 for (idx
= 2; idx
< argc
; idx
+= 2) {
833 newList
= Tcl_SetKeyedListField (interp
, argv
[idx
], argv
[idx
+ 1],
835 if (prevList
!= keyedList
)
840 varPtr
= Tcl_SetVar (interp
, argv
[1], newList
, TCL_LEAVE_ERR_MSG
);
841 ckfree ((char *) newList
);
843 return (varPtr
== NULL
) ? TCL_ERROR
: TCL_OK
;