]>
Commit | Line | Data |
---|---|---|
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 | } |