![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tclUtil.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / worm / scsi / tcl|
Return to tclUtil.c CVS log | Up to [Research Unix] / researchv10dc / cmd / worm / scsi / tcl |
1.1 ! root 1: /* ! 2: * tclUtil.c -- ! 3: * ! 4: * This file contains utility procedures that are used by many Tcl ! 5: * commands. ! 6: * ! 7: * Copyright 1987, 1989 Regents of the University of California ! 8: * Permission to use, copy, modify, and distribute this ! 9: * software and its documentation for any purpose and without ! 10: * fee is hereby granted, provided that the above copyright ! 11: * notice appear in all copies. The University of California ! 12: * makes no representations about the suitability of this ! 13: * software for any purpose. It is provided "as is" without ! 14: * express or implied warranty. ! 15: */ ! 16: ! 17: #ifndef lint ! 18: static char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclUtil.c,v 1.30 90/03/25 11:04:25 ouster Exp $ SPRITE (Berkeley)"; ! 19: #pragma ref rcsid ! 20: #endif not lint ! 21: ! 22: #define _POSIX_SOURCE ! 23: ! 24: #include <ctype.h> ! 25: #include <stdio.h> ! 26: #include <stdlib.h> ! 27: #include <string.h> ! 28: #include "tcl.h" ! 29: #include "tclInt.h" ! 30: ! 31: /* ! 32: *---------------------------------------------------------------------- ! 33: * ! 34: * TclFindElement -- ! 35: * ! 36: * Given a pointer into a Tcl list, locate the first (or next) ! 37: * element in the list. ! 38: * ! 39: * Results: ! 40: * The return value is normally TCL_OK, which means that the ! 41: * element was successfully located. If TCL_ERROR is returned ! 42: * it means that list didn't have proper list structure; ! 43: * interp->result contains a more detailed error message. ! 44: * ! 45: * If TCL_OK is returned, then *elementPtr will be set to point ! 46: * to the first element of list, and *nextPtr will be set to point ! 47: * to the character just after any white space following the last ! 48: * character that's part of the element. If this is the last argument ! 49: * in the list, then *nextPtr will point to the NULL character at the ! 50: * end of list. If sizePtr is non-NULL, *sizePtr is filled in with ! 51: * the number of characters in the element. If the element is in ! 52: * braces, then *elementPtr will point to the character after the ! 53: * opening brace and *sizePtr will not include either of the braces. ! 54: * If there isn't an element in the list, *sizePtr will be zero, and ! 55: * both *elementPtr and *termPtr will refer to the null character at ! 56: * the end of list. Note: this procedure does NOT collapse backslash ! 57: * sequences. ! 58: * ! 59: * Side effects: ! 60: * None. ! 61: * ! 62: *---------------------------------------------------------------------- ! 63: */ ! 64: ! 65: int ! 66: TclFindElement(interp, list, elementPtr, nextPtr, sizePtr, bracePtr) ! 67: Tcl_Interp *interp; /* Interpreter to use for error reporting. */ ! 68: register char *list; /* String containing Tcl list with zero ! 69: * or more elements (possibly in braces). */ ! 70: char **elementPtr; /* Fill in with location of first significant ! 71: * character in first element of list. */ ! 72: char **nextPtr; /* Fill in with location of character just ! 73: * after all white space following end of ! 74: * argument (i.e. next argument or end of ! 75: * list). */ ! 76: int *sizePtr; /* If non-zero, fill in with size of ! 77: * element. */ ! 78: int *bracePtr; /* If non-zero fill in with non-zero/zero ! 79: * to indicate that arg was/wasn't ! 80: * in braces. */ ! 81: { ! 82: register char *p; ! 83: int openBraces = 0; ! 84: int size; ! 85: ! 86: /* ! 87: * Skim off leading white space and check for an opening brace. ! 88: */ ! 89: ! 90: while (isspace(*list)) { ! 91: list++; ! 92: } ! 93: if (*list == '{') { ! 94: openBraces = 1; ! 95: list++; ! 96: } ! 97: if (bracePtr != 0) { ! 98: *bracePtr = openBraces; ! 99: } ! 100: p = list; ! 101: ! 102: /* ! 103: * Find the end of the element (either a space or a close brace or ! 104: * the end of the string). ! 105: */ ! 106: ! 107: while (1) { ! 108: switch (*p) { ! 109: ! 110: /* ! 111: * Open brace: don't treat specially unless the element is ! 112: * in braces. In this case, keep a nesting count. ! 113: */ ! 114: ! 115: case '{': ! 116: if (openBraces != 0) { ! 117: openBraces++; ! 118: } ! 119: break; ! 120: ! 121: /* ! 122: * Close brace: if element is in braces, keep nesting ! 123: * count and quit when the last close brace is seen. ! 124: */ ! 125: ! 126: case '}': ! 127: if (openBraces == 1) { ! 128: char *p2; ! 129: ! 130: size = p - list; ! 131: p++; ! 132: if (isspace(*p) || (*p == 0)) { ! 133: goto done; ! 134: } ! 135: for (p2 = p; (*p2 != 0) && (!isspace(*p2)) && (p2 < p+20); ! 136: p2++) { ! 137: /* null body */ ! 138: } ! 139: Tcl_Return(interp, (char *) NULL, TCL_STATIC); ! 140: sprintf(interp->result, ! 141: "list element in braces followed by \"%.*s\" instead of space", ! 142: p2-p, p); ! 143: return TCL_ERROR; ! 144: } else if (openBraces != 0) { ! 145: openBraces--; ! 146: } ! 147: break; ! 148: ! 149: /* ! 150: * Backslash: skip over everything up to the end of the ! 151: * backslash sequence. ! 152: */ ! 153: ! 154: case '\\': { ! 155: int size; ! 156: ! 157: (void) Tcl_Backslash(p, &size); ! 158: p += size - 1; ! 159: break; ! 160: } ! 161: ! 162: /* ! 163: * Space: ignore if element is in braces; otherwise ! 164: * terminate element. ! 165: */ ! 166: ! 167: case ' ': ! 168: case '\t': ! 169: case '\n': ! 170: if (openBraces == 0) { ! 171: size = p - list; ! 172: goto done; ! 173: } ! 174: break; ! 175: ! 176: /* ! 177: * End of list: terminate element. ! 178: */ ! 179: ! 180: case 0: ! 181: if (openBraces != 0) { ! 182: Tcl_Return(interp, "unmatched open brace in list", ! 183: TCL_STATIC); ! 184: return TCL_ERROR; ! 185: } ! 186: size = p - list; ! 187: goto done; ! 188: ! 189: } ! 190: p++; ! 191: } ! 192: ! 193: done: ! 194: while (isspace(*p)) { ! 195: p++; ! 196: } ! 197: *elementPtr = list; ! 198: *nextPtr = p; ! 199: if (sizePtr != 0) { ! 200: *sizePtr = size; ! 201: } ! 202: return TCL_OK; ! 203: } ! 204: ! 205: /* ! 206: *---------------------------------------------------------------------- ! 207: * ! 208: * TclCopyAndCollapse -- ! 209: * ! 210: * Copy a string and eliminate any backslashes that aren't in braces. ! 211: * ! 212: * Results: ! 213: * There is no return value. Count chars. get copied from src ! 214: * to dst. Along the way, if backslash sequences are found outside ! 215: * braces, the backslashes are eliminated in the copy. ! 216: * After scanning count chars. from source, a null character is ! 217: * placed at the end of dst. ! 218: * ! 219: * Side effects: ! 220: * None. ! 221: * ! 222: *---------------------------------------------------------------------- ! 223: */ ! 224: ! 225: void ! 226: TclCopyAndCollapse(count, src, dst) ! 227: register char *src; /* Copy from here... */ ! 228: register char *dst; /* ... to here. */ ! 229: { ! 230: register char c; ! 231: int numRead; ! 232: ! 233: for (c = *src; count > 0; dst++, src++, c = *src, count--) { ! 234: if (c == '\\') { ! 235: *dst = Tcl_Backslash(src, &numRead); ! 236: src += numRead-1; ! 237: count -= numRead-1; ! 238: } else { ! 239: *dst = c; ! 240: } ! 241: } ! 242: *dst = 0; ! 243: } ! 244: ! 245: /* ! 246: *---------------------------------------------------------------------- ! 247: * ! 248: * Tcl_Merge -- ! 249: * ! 250: * Given a collection of strings, merge them together into a ! 251: * single string that has proper Tcl list structured (i.e. ! 252: * TclFindElement and TclCopyAndCollapse may be used to retrieve ! 253: * strings equal to the original elements, and Tcl_Eval will ! 254: * parse the string back into its original elements). ! 255: * ! 256: * Results: ! 257: * The return value is the address of a dynamically-allocated ! 258: * string containing the merged list. ! 259: * ! 260: * Side effects: ! 261: * None. ! 262: * ! 263: *---------------------------------------------------------------------- ! 264: */ ! 265: ! 266: char * ! 267: Tcl_Merge(argc, argv) ! 268: int argc; /* How many strings to merge. */ ! 269: char **argv; /* Array of string values. */ ! 270: { ! 271: /* ! 272: * This procedure operates in two passes. In the first pass it figures ! 273: * out how many bytes will be needed to store the result (actually, ! 274: * it overestimates slightly). The first pass also collects information ! 275: * about each element in the form of a flags word. If there are only ! 276: * a few elements, local storage gets used for the flags; if there are ! 277: * a lot of elements, a new array is dynamically allocated. ! 278: * ! 279: * In the second pass this procedure copies the arguments into the ! 280: * result string. The special cases to worry about are: ! 281: * ! 282: * 1. Argument contains embedded spaces, or starts with a brace: must ! 283: * add another level of braces when copying to the result. ! 284: * ! 285: * 2. Argument contains unbalanced braces: backslash all of the ! 286: * braces when copying to the result. In this case, don't add another ! 287: * level of braces (they would prevent the backslash from ! 288: * being removed when the argument is extracted from the list later). ! 289: * ! 290: * 3. Argument contains backslashed brace/bracket: if possible, ! 291: * group the argument in braces: then no special action needs to be taken ! 292: * with the backslashes. If the argument can't be put in braces, then ! 293: * add another backslash in front of the sequence, so that upon ! 294: * extraction the original sequence will be restored. ! 295: * ! 296: * These potential problems are the reasons why particular information ! 297: * is gathered during pass 1. ! 298: */ ! 299: # define WANT_PARENS 1 ! 300: # define PARENS_UNBALANCED 2 ! 301: # define PARENTHESIZED 4 ! 302: # define CANT_PARENTHESIZE 8 ! 303: ! 304: # define LOCAL_SIZE 20 ! 305: int localFlags[LOCAL_SIZE]; ! 306: int *flagPtr; ! 307: int numChars; ! 308: char *result; ! 309: register char *src, *dst; ! 310: register int curFlags; ! 311: int i; ! 312: ! 313: /* ! 314: * Pass 1: estimate space, gather information. ! 315: */ ! 316: ! 317: if (argc <= LOCAL_SIZE) { ! 318: flagPtr = localFlags; ! 319: } else { ! 320: flagPtr = (int *) malloc((unsigned) argc*sizeof(int)); ! 321: } ! 322: numChars = 0; ! 323: for (i = 0; i < argc; i++) { ! 324: int braceCount, nestingLevel, nestedBS, whiteSpace, brackets, dollars; ! 325: ! 326: curFlags = braceCount = nestingLevel = nestedBS = whiteSpace = 0; ! 327: brackets = dollars = 0; ! 328: src = argv[i]; ! 329: if (*src == '{') { ! 330: curFlags |= PARENTHESIZED|WANT_PARENS; ! 331: } ! 332: if (*src == 0) { ! 333: curFlags |= WANT_PARENS; ! 334: } else { ! 335: for (; ; src++) { ! 336: switch (*src) { ! 337: case '{': ! 338: braceCount++; ! 339: nestingLevel++; ! 340: break; ! 341: case '}': ! 342: braceCount++; ! 343: nestingLevel--; ! 344: break; ! 345: case ']': ! 346: case '[': ! 347: curFlags |= WANT_PARENS; ! 348: brackets++; ! 349: break; ! 350: case '$': ! 351: curFlags |= WANT_PARENS; ! 352: dollars++; ! 353: break; ! 354: case ' ': ! 355: case '\n': ! 356: case '\t': ! 357: curFlags |= WANT_PARENS; ! 358: whiteSpace++; ! 359: break; ! 360: case '\\': ! 361: src++; ! 362: if (*src == 0) { ! 363: goto elementDone; ! 364: } else if ((*src == '{') || (*src == '}') ! 365: || (*src == '[') || (*src == ']')) { ! 366: curFlags |= WANT_PARENS; ! 367: nestedBS++; ! 368: } ! 369: break; ! 370: case 0: ! 371: goto elementDone; ! 372: } ! 373: } ! 374: } ! 375: elementDone: ! 376: numChars += src - argv[i]; ! 377: if (nestingLevel != 0) { ! 378: numChars += braceCount + nestedBS + whiteSpace ! 379: + brackets + dollars; ! 380: curFlags = CANT_PARENTHESIZE; ! 381: } ! 382: if (curFlags & WANT_PARENS) { ! 383: numChars += 2; ! 384: } ! 385: numChars++; /* Space to separate arguments. */ ! 386: flagPtr[i] = curFlags; ! 387: } ! 388: ! 389: /* ! 390: * Pass two: copy into the result area. ! 391: */ ! 392: ! 393: result = (char *) malloc((unsigned) numChars + 1); ! 394: dst = result; ! 395: for (i = 0; i < argc; i++) { ! 396: curFlags = flagPtr[i]; ! 397: if (curFlags & WANT_PARENS) { ! 398: *dst = '{'; ! 399: dst++; ! 400: } ! 401: for (src = argv[i]; *src != 0 ; src++) { ! 402: if (curFlags & CANT_PARENTHESIZE) { ! 403: switch (*src) { ! 404: case '{': ! 405: case '}': ! 406: case ']': ! 407: case '[': ! 408: case '$': ! 409: case ' ': ! 410: *dst = '\\'; ! 411: dst++; ! 412: break; ! 413: case '\n': ! 414: *dst = '\\'; ! 415: dst++; ! 416: *dst = 'n'; ! 417: goto loopBottom; ! 418: case '\t': ! 419: *dst = '\\'; ! 420: dst++; ! 421: *dst = 't'; ! 422: goto loopBottom; ! 423: case '\\': ! 424: *dst = '\\'; ! 425: dst++; ! 426: src++; ! 427: if ((*src == '{') || (*src == '}') || (*src == '[') ! 428: || (*src == ']')) { ! 429: *dst = '\\'; ! 430: dst++; ! 431: } else if (*src == 0) { ! 432: goto pass2ElementDone; ! 433: } ! 434: break; ! 435: } ! 436: } ! 437: *dst = *src; ! 438: loopBottom: ! 439: dst++; ! 440: } ! 441: pass2ElementDone: ! 442: if (curFlags & WANT_PARENS) { ! 443: *dst = '}'; ! 444: dst++; ! 445: } ! 446: *dst = ' '; ! 447: dst++; ! 448: } ! 449: if (dst == result) { ! 450: *dst = 0; ! 451: } else { ! 452: dst[-1] = 0; ! 453: } ! 454: ! 455: if (flagPtr != localFlags) { ! 456: free((char *) flagPtr); ! 457: } ! 458: return result; ! 459: } ! 460: ! 461: /* ! 462: *---------------------------------------------------------------------- ! 463: * ! 464: * Tcl_Concat -- ! 465: * ! 466: * Concatenate a set of strings into a single large string. ! 467: * ! 468: * Results: ! 469: * The return value is dynamically-allocated string containing ! 470: * a concatenation of all the strings in argv, with spaces between ! 471: * the original argv elements. ! 472: * ! 473: * Side effects: ! 474: * Memory is allocated for the result; the caller is responsible ! 475: * for freeing the memory. ! 476: * ! 477: *---------------------------------------------------------------------- ! 478: */ ! 479: ! 480: char * ! 481: Tcl_Concat(argc, argv) ! 482: int argc; /* Number of strings to concatenate. */ ! 483: char **argv; /* Array of strings to concatenate. */ ! 484: { ! 485: int totalSize, i; ! 486: register char *p; ! 487: char *result; ! 488: ! 489: for (totalSize = 1, i = 0; i < argc; i++) { ! 490: totalSize += strlen(argv[i]) + 1; ! 491: } ! 492: result = malloc((unsigned) totalSize); ! 493: for (p = result, i = 0; i < argc; i++) { ! 494: (void) strcpy(p, argv[i]); ! 495: p += strlen(argv[i]); ! 496: *p = ' '; ! 497: p++; ! 498: } ! 499: p[-1] = 0; ! 500: return result; ! 501: } ! 502: ! 503: /* ! 504: *---------------------------------------------------------------------- ! 505: * ! 506: * Tcl_Return -- ! 507: * ! 508: * Arrange for "string" to be the Tcl return value. ! 509: * ! 510: * Results: ! 511: * None. ! 512: * ! 513: * Side effects: ! 514: * interp->result is left pointing either to "string" (if "copy" is 0) ! 515: * or to a copy of string. ! 516: * ! 517: *---------------------------------------------------------------------- ! 518: */ ! 519: ! 520: void ! 521: Tcl_Return(interp, string, status) ! 522: Tcl_Interp *interp; /* Interpreter with which to associate the ! 523: * return value. */ ! 524: char *string; /* Value to be returned. If NULL, ! 525: * the result is set to an empty string. */ ! 526: int status; /* Gives information about the string: ! 527: * TCL_STATIC, TCL_DYNAMIC, TCL_VOLATILE. ! 528: * Ignored if string is NULL. */ ! 529: { ! 530: register Interp *iPtr = (Interp *) interp; ! 531: int length; ! 532: int wasDynamic = iPtr->dynamic; ! 533: char *oldResult = iPtr->result; ! 534: ! 535: if (string == NULL) { ! 536: iPtr->resultSpace[0] = 0; ! 537: iPtr->result = iPtr->resultSpace; ! 538: iPtr->dynamic = 0; ! 539: } else if (status == TCL_STATIC) { ! 540: iPtr->result = string; ! 541: iPtr->dynamic = 0; ! 542: } else if (status == TCL_DYNAMIC) { ! 543: iPtr->result = string; ! 544: iPtr->dynamic = 1; ! 545: } else { ! 546: length = strlen(string); ! 547: if (length > TCL_RESULT_SIZE) { ! 548: iPtr->result = (char *) malloc((unsigned) length+1); ! 549: iPtr->dynamic = 1; ! 550: } else { ! 551: iPtr->result = iPtr->resultSpace; ! 552: iPtr->dynamic = 0; ! 553: } ! 554: strcpy(iPtr->result, string); ! 555: } ! 556: ! 557: /* ! 558: * If the old result was dynamically-allocated, free it up. Do it ! 559: * here, rather than at the beginning, in case the new result value ! 560: * was part of the old result value. ! 561: */ ! 562: ! 563: if (wasDynamic) { ! 564: free(oldResult); ! 565: } ! 566: } ! 567: ! 568: /* ! 569: *---------------------------------------------------------------------- ! 570: * ! 571: * Tcl_Backslash -- ! 572: * ! 573: * Figure out how to handle a backslash sequence. ! 574: * ! 575: * Results: ! 576: * The return value is the character that should be substituted ! 577: * in place of the backslash sequence that starts at src. If ! 578: * readPtr isn't NULL then it is filled in with a count of the ! 579: * number of characters in the backslash sequence. Note: if ! 580: * the backslash isn't followed by characters that are understood ! 581: * here, then the backslash sequence is only considered to be ! 582: * one character long, and it is replaced by a backslash char. ! 583: * ! 584: * Side effects: ! 585: * None. ! 586: * ! 587: *---------------------------------------------------------------------- ! 588: */ ! 589: ! 590: char ! 591: Tcl_Backslash(src, readPtr) ! 592: char *src; /* Points to the backslash character of ! 593: * a backslash sequence. */ ! 594: int *readPtr; /* Fill in with number of characters read ! 595: * from src, unless NULL. */ ! 596: { ! 597: register char *p = src+1; ! 598: char result; ! 599: int count; ! 600: ! 601: count = 2; ! 602: ! 603: switch (*p) { ! 604: case 'b': ! 605: result = '\b'; ! 606: break; ! 607: case 'e': ! 608: result = 033; ! 609: break; ! 610: case 'n': ! 611: result = '\n'; ! 612: break; ! 613: case 'r': ! 614: result = '\r'; ! 615: break; ! 616: case 't': ! 617: result = '\t'; ! 618: break; ! 619: case 'C': ! 620: p++; ! 621: if (isspace(*p) || (*p == 0)) { ! 622: result = 'C'; ! 623: count = 1; ! 624: break; ! 625: } ! 626: count = 3; ! 627: if (*p == 'M') { ! 628: p++; ! 629: if (isspace(*p) || (*p == 0)) { ! 630: result = 'M' & 037; ! 631: break; ! 632: } ! 633: count = 4; ! 634: result = (*p & 037) | 0200; ! 635: break; ! 636: } ! 637: count = 3; ! 638: result = *p & 037; ! 639: break; ! 640: case 'M': ! 641: p++; ! 642: if (isspace(*p) || (*p == 0)) { ! 643: result = 'M'; ! 644: count = 1; ! 645: break; ! 646: } ! 647: count = 3; ! 648: result = *p + 0200; ! 649: break; ! 650: case '}': ! 651: case '{': ! 652: case ']': ! 653: case '[': ! 654: case '$': ! 655: case ' ': ! 656: case ';': ! 657: case '"': ! 658: case '\\': ! 659: result = *p; ! 660: break; ! 661: default: ! 662: if (isdigit(*p)) { ! 663: result = *p - '0'; ! 664: p++; ! 665: if (!isdigit(*p)) { ! 666: break; ! 667: } ! 668: count = 3; ! 669: result = (result << 3) + (*p - '0'); ! 670: p++; ! 671: if (!isdigit(*p)) { ! 672: break; ! 673: } ! 674: count = 4; ! 675: result = (result << 3) + (*p - '0'); ! 676: break; ! 677: } ! 678: result = '\\'; ! 679: count = 1; ! 680: break; ! 681: } ! 682: ! 683: if (readPtr != NULL) { ! 684: *readPtr = count; ! 685: } ! 686: return result; ! 687: } ! 688: ! 689: /* ! 690: *---------------------------------------------------------------------- ! 691: * ! 692: * Tcl_SplitList -- ! 693: * ! 694: * Splits a list up into its constituent fields. ! 695: * ! 696: * Results ! 697: * The return value is normally TCL_OK, which means that ! 698: * the list was successfully split up. If TCL_ERROR is ! 699: * returned, it means that "list" didn't have proper list ! 700: * structure; interp->result will contain a more detailed ! 701: * error message. ! 702: * ! 703: * *argvPtr will be filled in with the address of an array ! 704: * whose elements point to the elements of list, in order. ! 705: * *argcPtr will get filled in with the number of valid elements ! 706: * in the array. A single block of memory is dynamically allocated ! 707: * to hold both the argv array and a copy of the list (with ! 708: * backslashes and braces removed in the standard way). ! 709: * The caller must eventually free this memory by calling free() ! 710: * on *argvPtr. Note: *argvPtr and *argcPtr are only modified ! 711: * if the procedure returns normally. ! 712: * ! 713: * Side effects: ! 714: * Memory is allocated. ! 715: * ! 716: *---------------------------------------------------------------------- ! 717: */ ! 718: ! 719: int ! 720: Tcl_SplitList(interp, list, argcPtr, argvPtr) ! 721: Tcl_Interp *interp; /* Interpreter to use for error reporting. */ ! 722: char *list; /* Pointer to string with list structure. */ ! 723: int *argcPtr; /* Pointer to location to fill in with ! 724: * the number of elements in the list. */ ! 725: char ***argvPtr; /* Pointer to place to store pointer to array ! 726: * of pointers to list elements. */ ! 727: { ! 728: char **argv; ! 729: register char *p; ! 730: int size, i, result, elSize, brace; ! 731: char *element; ! 732: ! 733: /* ! 734: * Figure out how much space to allocate. There must be enough ! 735: * space for both the array of pointers and also for a copy of ! 736: * the list. To estimate the number of pointers needed, count ! 737: * the number of space characters in the list. ! 738: */ ! 739: ! 740: for (size = 1, p = list; *p != 0; p++) { ! 741: if (isspace(*p)) { ! 742: size++; ! 743: } ! 744: } ! 745: argv = (char **) malloc((unsigned) ! 746: ((size * sizeof(char *)) + (p - list) + 1)); ! 747: for (i = 0, p = ((char *) argv) + size*sizeof(char *); ! 748: *list != 0; i++) { ! 749: result = TclFindElement(interp, list, &element, &list, &elSize, &brace); ! 750: if (result != TCL_OK) { ! 751: free((char *) argv); ! 752: return result; ! 753: } ! 754: if (*element == 0) { ! 755: break; ! 756: } ! 757: if (i >= size) { ! 758: Tcl_Return(interp, "internal error in Tcl_SplitList", TCL_STATIC); ! 759: return TCL_ERROR; ! 760: } ! 761: argv[i] = p; ! 762: if (brace) { ! 763: strncpy(p, element, elSize); ! 764: p += elSize; ! 765: *p = 0; ! 766: p++; ! 767: } else { ! 768: TclCopyAndCollapse(elSize, element, p); ! 769: p += elSize+1; ! 770: } ! 771: } ! 772: ! 773: *argvPtr = argv; ! 774: *argcPtr = i; ! 775: return TCL_OK; ! 776: } ! 777: ! 778: /* ! 779: *---------------------------------------------------------------------- ! 780: * ! 781: * Tcl_StringMatch -- ! 782: * ! 783: * See if a particular string matches a particular pattern. ! 784: * ! 785: * Results: ! 786: * The return value is 1 if string matches pattern, and ! 787: * 0 otherwise. The matching operation permits the following ! 788: * special characters in the pattern: *?\[] (see the manual ! 789: * entry for details on what these mean). ! 790: * ! 791: * Side effects: ! 792: * None. ! 793: * ! 794: *---------------------------------------------------------------------- ! 795: */ ! 796: ! 797: int ! 798: Tcl_StringMatch(string, pattern) ! 799: register char *string; /* String. */ ! 800: register char *pattern; /* Pattern, which may contain ! 801: * special characters. */ ! 802: { ! 803: char c2; ! 804: ! 805: while (1) { ! 806: /* See if we're at the end of both the pattern and the string. ! 807: * If so, we succeeded. If we're at the end of the pattern ! 808: * but not at the end of the string, we failed. ! 809: */ ! 810: ! 811: if (*pattern == 0) { ! 812: if (*string == 0) { ! 813: return 1; ! 814: } else { ! 815: return 0; ! 816: } ! 817: } ! 818: if ((*string == 0) && (*pattern != '*')) { ! 819: return 0; ! 820: } ! 821: ! 822: /* Check for a "*" as the next pattern character. It matches ! 823: * any substring. We handle this by calling ourselves ! 824: * recursively for each postfix of string, until either we ! 825: * match or we reach the end of the string. ! 826: */ ! 827: ! 828: if (*pattern == '*') { ! 829: pattern += 1; ! 830: if (*pattern == 0) { ! 831: return 1; ! 832: } ! 833: while (*string != 0) { ! 834: if (Tcl_StringMatch(string, pattern)) { ! 835: return 1; ! 836: } ! 837: string += 1; ! 838: } ! 839: return 0; ! 840: } ! 841: ! 842: /* Check for a "?" as the next pattern character. It matches ! 843: * any single character. ! 844: */ ! 845: ! 846: if (*pattern == '?') { ! 847: goto thisCharOK; ! 848: } ! 849: ! 850: /* Check for a "[" as the next pattern character. It is followed ! 851: * by a list of characters that are acceptable, or by a range ! 852: * (two characters separated by "-"). ! 853: */ ! 854: ! 855: if (*pattern == '[') { ! 856: pattern += 1; ! 857: while (1) { ! 858: if ((*pattern == ']') || (*pattern == 0)) { ! 859: return 0; ! 860: } ! 861: if (*pattern == *string) { ! 862: break; ! 863: } ! 864: if (pattern[1] == '-') { ! 865: c2 = pattern[2]; ! 866: if (c2 == 0) { ! 867: return 0; ! 868: } ! 869: if ((*pattern <= *string) && (c2 >= *string)) { ! 870: break; ! 871: } ! 872: if ((*pattern >= *string) && (c2 <= *string)) { ! 873: break; ! 874: } ! 875: pattern += 2; ! 876: } ! 877: pattern += 1; ! 878: } ! 879: while ((*pattern != ']') && (*pattern != 0)) { ! 880: pattern += 1; ! 881: } ! 882: goto thisCharOK; ! 883: } ! 884: ! 885: /* If the next pattern character is '/', just strip off the '/' ! 886: * so we do exact matching on the character that follows. ! 887: */ ! 888: ! 889: if (*pattern == '\\') { ! 890: pattern += 1; ! 891: if (*pattern == 0) { ! 892: return 0; ! 893: } ! 894: } ! 895: ! 896: /* There's no special character. Just make sure that the next ! 897: * characters of each string match. ! 898: */ ! 899: ! 900: if (*pattern != *string) { ! 901: return 0; ! 902: } ! 903: ! 904: thisCharOK: pattern += 1; ! 905: string += 1; ! 906: } ! 907: } ! 908: ! 909: /* ! 910: *---------------------------------------------------------------------- ! 911: * ! 912: * TclWordEnd -- ! 913: * ! 914: * Given a pointer into a Tcl command, find the end of the next ! 915: * word of the command. ! 916: * ! 917: * Results: ! 918: * The return value is a pointer to the character just after the ! 919: * last one that's part of the word pointed to by "start". This ! 920: * may be the address of the NULL character at the end of the ! 921: * string. ! 922: * ! 923: * Side effects: ! 924: * None. ! 925: * ! 926: *---------------------------------------------------------------------- ! 927: */ ! 928: ! 929: char * ! 930: TclWordEnd(start, nested) ! 931: char *start; /* Beginning of a word of a Tcl command. */ ! 932: int nested; /* Zero means this is a top-level command. ! 933: * One means this is a nested command (close ! 934: * brace is a word terminator). */ ! 935: { ! 936: register char *p; ! 937: int count; ! 938: ! 939: p = start; ! 940: while (isspace(*p)) { ! 941: p++; ! 942: } ! 943: ! 944: /* ! 945: * Handle words beginning with a double-quote or a brace. ! 946: */ ! 947: ! 948: if (*p == '"') { ! 949: while (1) { ! 950: p++; ! 951: while (*p == '\\') { ! 952: (void) Tcl_Backslash(p, &count); ! 953: p += count; ! 954: } ! 955: if (*p == '"') { ! 956: break; ! 957: } ! 958: } ! 959: } else if (*p == '{') { ! 960: int braces = 1; ! 961: while (braces != 0) { ! 962: p++; ! 963: while (*p == '\\') { ! 964: (void) Tcl_Backslash(p, &count); ! 965: p += count; ! 966: } ! 967: if (*p == '}') { ! 968: braces--; ! 969: } else if (*p == '{') { ! 970: braces++; ! 971: } else if (*p == 0) { ! 972: return p; ! 973: } ! 974: } ! 975: } ! 976: ! 977: /* ! 978: * Handle words that don't start with a brace or double-quote. ! 979: * This code is also invoked if the word starts with a brace or ! 980: * double-quote and there is garbage after the closing brace or ! 981: * quote. This is an error as far as Tcl_Eval is concerned, but ! 982: * for here the garbage is treated as part of the word. ! 983: */ ! 984: ! 985: while (1) { ! 986: ! 987: /* ! 988: * Handle nested commands. ! 989: */ ! 990: ! 991: while (*p == '[') { ! 992: p++; ! 993: while ((*p != ']') && (*p != 0)) { ! 994: p = TclWordEnd(p, 1); ! 995: if (*p == ';') { ! 996: p++; ! 997: } ! 998: } ! 999: if (*p == ']') { ! 1000: p++; ! 1001: } ! 1002: } ! 1003: ! 1004: /* ! 1005: * Handle backslash sequences. Backslash-newline isn't handled ! 1006: * by Tcl_Backslash, so it must be checked for explicitly. ! 1007: */ ! 1008: ! 1009: while (*p == '\\') { ! 1010: if (p[1] == '\n') { ! 1011: p += 2; ! 1012: } else { ! 1013: (void) Tcl_Backslash(p, &count); ! 1014: p += count; ! 1015: } ! 1016: } ! 1017: ! 1018: /* ! 1019: * Check for end of word. Note: semi-colon terminates a word ! 1020: * and also counts as a word by itself. ! 1021: */ ! 1022: ! 1023: if (*p == ';') { ! 1024: if (p == start) { ! 1025: p++; ! 1026: } ! 1027: break; ! 1028: } ! 1029: if (isspace(*p) || (*p == 0)) { ! 1030: break; ! 1031: } ! 1032: if ((*p == ']') && nested) { ! 1033: break; ! 1034: } ! 1035: ! 1036: p++; ! 1037: } ! 1038: return p; ! 1039: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.