![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tclparse.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tcl|
Return to tclparse.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tcl |
1.1 ! root 1: /* ! 2: * tclParse.c -- ! 3: * ! 4: * This file contains a collection of procedures that are used ! 5: * to parse Tcl commands or parts of commands (like quoted ! 6: * strings or nested sub-commands). ! 7: * ! 8: * Copyright 1991 Regents of the University of California. ! 9: * Permission to use, copy, modify, and distribute this ! 10: * software and its documentation for any purpose and without ! 11: * fee is hereby granted, provided that the above copyright ! 12: * notice appear in all copies. The University of California ! 13: * makes no representations about the suitability of this ! 14: * software for any purpose. It is provided "as is" without ! 15: * express or implied warranty. ! 16: */ ! 17: ! 18: #ifndef lint ! 19: static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclParse.c,v 1.21 92/06/08 09:32:37 ouster Exp $ SPRITE (Berkeley)"; ! 20: #endif ! 21: ! 22: #include "tclint.h" ! 23: ! 24: /* ! 25: * The following table assigns a type to each character. Only types ! 26: * meaningful to Tcl parsing are represented here. The table indexes ! 27: * all 256 characters, with the negative ones first, then the positive ! 28: * ones. ! 29: */ ! 30: ! 31: char tclTypeTable[] = { ! 32: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 33: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 34: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 35: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 36: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 37: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 38: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 39: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 40: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 41: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 42: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 43: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 44: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 45: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 46: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 47: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 48: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 49: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 50: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 51: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 52: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 53: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 54: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 55: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 56: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 57: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 58: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 59: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 60: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 61: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 62: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 63: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 64: TCL_COMMAND_END, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 65: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 66: TCL_NORMAL, TCL_SPACE, TCL_COMMAND_END, TCL_SPACE, ! 67: TCL_SPACE, TCL_SPACE, TCL_NORMAL, TCL_NORMAL, ! 68: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 69: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 70: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 71: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 72: TCL_SPACE, TCL_NORMAL, TCL_QUOTE, TCL_NORMAL, ! 73: TCL_DOLLAR, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 74: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 75: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 76: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 77: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 78: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_COMMAND_END, ! 79: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 80: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 81: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 82: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 83: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 84: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 85: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 86: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_OPEN_BRACKET, ! 87: TCL_BACKSLASH, TCL_COMMAND_END, TCL_NORMAL, TCL_NORMAL, ! 88: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 89: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 90: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 91: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 92: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 93: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, ! 94: TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_OPEN_BRACE, ! 95: TCL_NORMAL, TCL_CLOSE_BRACE, TCL_NORMAL, TCL_NORMAL, ! 96: }; ! 97: ! 98: /* ! 99: * Function prototypes for procedures local to this file: ! 100: */ ! 101: ! 102: static char * QuoteEnd _ANSI_ARGS_((char *string, int term)); ! 103: static char * VarNameEnd _ANSI_ARGS_((char *string)); ! 104: ! 105: /* ! 106: *---------------------------------------------------------------------- ! 107: * ! 108: * Tcl_Backslash -- ! 109: * ! 110: * Figure out how to handle a backslash sequence. ! 111: * ! 112: * Results: ! 113: * The return value is the character that should be substituted ! 114: * in place of the backslash sequence that starts at src, or 0 ! 115: * if the backslash sequence should be replace by nothing (e.g. ! 116: * backslash followed by newline). If readPtr isn't NULL then ! 117: * it is filled in with a count of the number of characters in ! 118: * the backslash sequence. Note: if the backslash isn't followed ! 119: * by characters that are understood here, then the backslash ! 120: * sequence is only considered to be one character long, and it ! 121: * is replaced by a backslash char. ! 122: * ! 123: * Side effects: ! 124: * None. ! 125: * ! 126: *---------------------------------------------------------------------- ! 127: */ ! 128: ! 129: char ! 130: Tcl_Backslash(src, readPtr) ! 131: char *src; /* Points to the backslash character of ! 132: * a backslash sequence. */ ! 133: int *readPtr; /* Fill in with number of characters read ! 134: * from src, unless NULL. */ ! 135: { ! 136: register char *p = src+1; ! 137: char result; ! 138: int count; ! 139: ! 140: count = 2; ! 141: ! 142: switch (*p) { ! 143: case 'b': ! 144: result = '\b'; ! 145: break; ! 146: case 'e': ! 147: result = 033; ! 148: break; ! 149: case 'f': ! 150: result = '\f'; ! 151: break; ! 152: case 'n': ! 153: result = '\n'; ! 154: break; ! 155: case 'r': ! 156: result = '\r'; ! 157: break; ! 158: case 't': ! 159: result = '\t'; ! 160: break; ! 161: case 'v': ! 162: result = '\v'; ! 163: break; ! 164: case 'C': ! 165: p++; ! 166: if (isspace(*p) || (*p == 0)) { ! 167: result = 'C'; ! 168: count = 1; ! 169: break; ! 170: } ! 171: count = 3; ! 172: if (*p == 'M') { ! 173: p++; ! 174: if (isspace(*p) || (*p == 0)) { ! 175: result = 'M' & 037; ! 176: break; ! 177: } ! 178: count = 4; ! 179: result = (*p & 037) | 0200; ! 180: break; ! 181: } ! 182: count = 3; ! 183: result = *p & 037; ! 184: break; ! 185: case 'M': ! 186: p++; ! 187: if (isspace(*p) || (*p == 0)) { ! 188: result = 'M'; ! 189: count = 1; ! 190: break; ! 191: } ! 192: count = 3; ! 193: result = *p + 0200; ! 194: break; ! 195: case '}': ! 196: case '{': ! 197: case ']': ! 198: case '[': ! 199: case '$': ! 200: case ' ': ! 201: case ';': ! 202: case '"': ! 203: case '\\': ! 204: result = *p; ! 205: break; ! 206: case '\n': ! 207: result = 0; ! 208: break; ! 209: default: ! 210: if (isdigit(*p)) { ! 211: result = *p - '0'; ! 212: p++; ! 213: if (!isdigit(*p)) { ! 214: break; ! 215: } ! 216: count = 3; ! 217: result = (result << 3) + (*p - '0'); ! 218: p++; ! 219: if (!isdigit(*p)) { ! 220: break; ! 221: } ! 222: count = 4; ! 223: result = (result << 3) + (*p - '0'); ! 224: break; ! 225: } ! 226: result = '\\'; ! 227: count = 1; ! 228: break; ! 229: } ! 230: ! 231: if (readPtr != NULL) { ! 232: *readPtr = count; ! 233: } ! 234: return result; ! 235: } ! 236: ! 237: /* ! 238: *-------------------------------------------------------------- ! 239: * ! 240: * TclParseQuotes -- ! 241: * ! 242: * This procedure parses a double-quoted string such as a ! 243: * quoted Tcl command argument or a quoted value in a Tcl ! 244: * expression. This procedure is also used to parse array ! 245: * element names within parentheses, or anything else that ! 246: * needs all the substitutions that happen in quotes. ! 247: * ! 248: * Results: ! 249: * The return value is a standard Tcl result, which is ! 250: * TCL_OK unless there was an error while parsing the ! 251: * quoted string. If an error occurs then interp->result ! 252: * contains a standard error message. *TermPtr is filled ! 253: * in with the address of the character just after the ! 254: * last one successfully processed; this is usually the ! 255: * character just after the matching close-quote. The ! 256: * fully-substituted contents of the quotes are stored in ! 257: * standard fashion in *pvPtr, null-terminated with ! 258: * pvPtr->next pointing to the terminating null character. ! 259: * ! 260: * Side effects: ! 261: * The buffer space in pvPtr may be enlarged by calling its ! 262: * expandProc. ! 263: * ! 264: *-------------------------------------------------------------- ! 265: */ ! 266: ! 267: int ! 268: TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr) ! 269: Tcl_Interp *interp; /* Interpreter to use for nested command ! 270: * evaluations and error messages. */ ! 271: char *string; /* Character just after opening double- ! 272: * quote. */ ! 273: int termChar; /* Character that terminates "quoted" string ! 274: * (usually double-quote, but sometimes ! 275: * right-paren or something else). */ ! 276: int flags; /* Flags to pass to nested Tcl_Eval calls. */ ! 277: char **termPtr; /* Store address of terminating character ! 278: * here. */ ! 279: ParseValue *pvPtr; /* Information about where to place ! 280: * fully-substituted result of parse. */ ! 281: { ! 282: register char *src, *dst, c; ! 283: ! 284: src = string; ! 285: dst = pvPtr->next; ! 286: ! 287: while (1) { ! 288: if (dst == pvPtr->end) { ! 289: /* ! 290: * Target buffer space is about to run out. Make more space. ! 291: */ ! 292: ! 293: pvPtr->next = dst; ! 294: (*pvPtr->expandProc)(pvPtr, 1); ! 295: dst = pvPtr->next; ! 296: } ! 297: ! 298: c = *src; ! 299: src++; ! 300: if (c == termChar) { ! 301: *dst = '\0'; ! 302: pvPtr->next = dst; ! 303: *termPtr = src; ! 304: return TCL_OK; ! 305: } else if (CHAR_TYPE(c) == TCL_NORMAL) { ! 306: copy: ! 307: *dst = c; ! 308: dst++; ! 309: continue; ! 310: } else if (c == '$') { ! 311: int length; ! 312: char *value; ! 313: ! 314: value = Tcl_ParseVar(interp, src-1, termPtr); ! 315: if (value == NULL) { ! 316: return TCL_ERROR; ! 317: } ! 318: src = *termPtr; ! 319: length = strlen(value); ! 320: if ((pvPtr->end - dst) <= length) { ! 321: pvPtr->next = dst; ! 322: (*pvPtr->expandProc)(pvPtr, length); ! 323: dst = pvPtr->next; ! 324: } ! 325: strcpy(dst, value); ! 326: dst += length; ! 327: continue; ! 328: } else if (c == '[') { ! 329: int result; ! 330: ! 331: pvPtr->next = dst; ! 332: result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr); ! 333: if (result != TCL_OK) { ! 334: return result; ! 335: } ! 336: src = *termPtr; ! 337: dst = pvPtr->next; ! 338: continue; ! 339: } else if (c == '\\') { ! 340: int numRead; ! 341: ! 342: src--; ! 343: *dst = Tcl_Backslash(src, &numRead); ! 344: if (*dst != 0) { ! 345: dst++; ! 346: } ! 347: src += numRead; ! 348: continue; ! 349: } else if (c == '\0') { ! 350: Tcl_ResetResult(interp); ! 351: sprintf(interp->result, "missing %c", termChar); ! 352: *termPtr = string-1; ! 353: return TCL_ERROR; ! 354: } else { ! 355: goto copy; ! 356: } ! 357: } ! 358: } ! 359: ! 360: /* ! 361: *-------------------------------------------------------------- ! 362: * ! 363: * TclParseNestedCmd -- ! 364: * ! 365: * This procedure parses a nested Tcl command between ! 366: * brackets, returning the result of the command. ! 367: * ! 368: * Results: ! 369: * The return value is a standard Tcl result, which is ! 370: * TCL_OK unless there was an error while executing the ! 371: * nested command. If an error occurs then interp->result ! 372: * contains a standard error message. *TermPtr is filled ! 373: * in with the address of the character just after the ! 374: * last one processed; this is usually the character just ! 375: * after the matching close-bracket, or the null character ! 376: * at the end of the string if the close-bracket was missing ! 377: * (a missing close bracket is an error). The result returned ! 378: * by the command is stored in standard fashion in *pvPtr, ! 379: * null-terminated, with pvPtr->next pointing to the null ! 380: * character. ! 381: * ! 382: * Side effects: ! 383: * The storage space at *pvPtr may be expanded. ! 384: * ! 385: *-------------------------------------------------------------- ! 386: */ ! 387: ! 388: int ! 389: TclParseNestedCmd(interp, string, flags, termPtr, pvPtr) ! 390: Tcl_Interp *interp; /* Interpreter to use for nested command ! 391: * evaluations and error messages. */ ! 392: char *string; /* Character just after opening bracket. */ ! 393: int flags; /* Flags to pass to nested Tcl_Eval. */ ! 394: char **termPtr; /* Store address of terminating character ! 395: * here. */ ! 396: register ParseValue *pvPtr; /* Information about where to place ! 397: * result of command. */ ! 398: { ! 399: int result, length, shortfall; ! 400: Interp *iPtr = (Interp *) interp; ! 401: ! 402: result = Tcl_Eval(interp, string, flags | TCL_BRACKET_TERM, termPtr); ! 403: if (result != TCL_OK) { ! 404: /* ! 405: * The increment below results in slightly cleaner message in ! 406: * the errorInfo variable (the close-bracket will appear). ! 407: */ ! 408: ! 409: if (**termPtr == ']') { ! 410: *termPtr += 1; ! 411: } ! 412: return result; ! 413: } ! 414: (*termPtr) += 1; ! 415: length = strlen(iPtr->result); ! 416: shortfall = length + 1 - (pvPtr->end - pvPtr->next); ! 417: if (shortfall > 0) { ! 418: (*pvPtr->expandProc)(pvPtr, shortfall); ! 419: } ! 420: strcpy(pvPtr->next, iPtr->result); ! 421: pvPtr->next += length; ! 422: Tcl_FreeResult(iPtr); ! 423: iPtr->result = iPtr->resultSpace; ! 424: iPtr->resultSpace[0] = '\0'; ! 425: return TCL_OK; ! 426: } ! 427: ! 428: /* ! 429: *-------------------------------------------------------------- ! 430: * ! 431: * TclParseBraces -- ! 432: * ! 433: * This procedure scans the information between matching ! 434: * curly braces. ! 435: * ! 436: * Results: ! 437: * The return value is a standard Tcl result, which is ! 438: * TCL_OK unless there was an error while parsing string. ! 439: * If an error occurs then interp->result contains a ! 440: * standard error message. *TermPtr is filled ! 441: * in with the address of the character just after the ! 442: * last one successfully processed; this is usually the ! 443: * character just after the matching close-brace. The ! 444: * information between curly braces is stored in standard ! 445: * fashion in *pvPtr, null-terminated with pvPtr->next ! 446: * pointing to the terminating null character. ! 447: * ! 448: * Side effects: ! 449: * The storage space at *pvPtr may be expanded. ! 450: * ! 451: *-------------------------------------------------------------- ! 452: */ ! 453: ! 454: int ! 455: TclParseBraces(interp, string, termPtr, pvPtr) ! 456: Tcl_Interp *interp; /* Interpreter to use for nested command ! 457: * evaluations and error messages. */ ! 458: char *string; /* Character just after opening bracket. */ ! 459: char **termPtr; /* Store address of terminating character ! 460: * here. */ ! 461: register ParseValue *pvPtr; /* Information about where to place ! 462: * result of command. */ ! 463: { ! 464: int level; ! 465: register char *src, *dst, *end; ! 466: register char c; ! 467: ! 468: src = string; ! 469: dst = pvPtr->next; ! 470: end = pvPtr->end; ! 471: level = 1; ! 472: ! 473: /* ! 474: * Copy the characters one at a time to the result area, stopping ! 475: * when the matching close-brace is found. ! 476: */ ! 477: ! 478: while (1) { ! 479: c = *src; ! 480: src++; ! 481: if (dst == end) { ! 482: pvPtr->next = dst; ! 483: (*pvPtr->expandProc)(pvPtr, 20); ! 484: dst = pvPtr->next; ! 485: end = pvPtr->end; ! 486: } ! 487: *dst = c; ! 488: dst++; ! 489: if (CHAR_TYPE(c) == TCL_NORMAL) { ! 490: continue; ! 491: } else if (c == '{') { ! 492: level++; ! 493: } else if (c == '}') { ! 494: level--; ! 495: if (level == 0) { ! 496: dst--; /* Don't copy the last close brace. */ ! 497: break; ! 498: } ! 499: } else if (c == '\\') { ! 500: int count; ! 501: ! 502: /* ! 503: * Must always squish out backslash-newlines, even when in ! 504: * braces. This is needed so that this sequence can appear ! 505: * anywhere in a command, such as the middle of an expression. ! 506: */ ! 507: ! 508: if (*src == '\n') { ! 509: dst--; ! 510: src++; ! 511: } else { ! 512: (void) Tcl_Backslash(src-1, &count); ! 513: while (count > 1) { ! 514: if (dst == end) { ! 515: pvPtr->next = dst; ! 516: (*pvPtr->expandProc)(pvPtr, 20); ! 517: dst = pvPtr->next; ! 518: end = pvPtr->end; ! 519: } ! 520: *dst = *src; ! 521: dst++; ! 522: src++; ! 523: count--; ! 524: } ! 525: } ! 526: } else if (c == '\0') { ! 527: Tcl_SetResult(interp, "missing close-brace", TCL_STATIC); ! 528: *termPtr = string-1; ! 529: return TCL_ERROR; ! 530: } ! 531: } ! 532: ! 533: *dst = '\0'; ! 534: pvPtr->next = dst; ! 535: *termPtr = src; ! 536: return TCL_OK; ! 537: } ! 538: ! 539: /* ! 540: *-------------------------------------------------------------- ! 541: * ! 542: * TclParseWords -- ! 543: * ! 544: * This procedure parses one or more words from a command ! 545: * string and creates argv-style pointers to fully-substituted ! 546: * copies of those words. ! 547: * ! 548: * Results: ! 549: * The return value is a standard Tcl result. ! 550: * ! 551: * *argcPtr is modified to hold a count of the number of words ! 552: * successfully parsed, which may be 0. At most maxWords words ! 553: * will be parsed. If 0 <= *argcPtr < maxWords then it ! 554: * means that a command separator was seen. If *argcPtr ! 555: * is maxWords then it means that a command separator was ! 556: * not seen yet. ! 557: * ! 558: * *TermPtr is filled in with the address of the character ! 559: * just after the last one successfully processed in the ! 560: * last word. This is either the command terminator (if ! 561: * *argcPtr < maxWords), the character just after the last ! 562: * one in a word (if *argcPtr is maxWords), or the vicinity ! 563: * of an error (if the result is not TCL_OK). ! 564: * ! 565: * The pointers at *argv are filled in with pointers to the ! 566: * fully-substituted words, and the actual contents of the ! 567: * words are copied to the buffer at pvPtr. ! 568: * ! 569: * If an error occurrs then an error message is left in ! 570: * interp->result and the information at *argv, *argcPtr, ! 571: * and *pvPtr may be incomplete. ! 572: * ! 573: * Side effects: ! 574: * The buffer space in pvPtr may be enlarged by calling its ! 575: * expandProc. ! 576: * ! 577: *-------------------------------------------------------------- ! 578: */ ! 579: ! 580: int ! 581: TclParseWords(interp, string, flags, maxWords, termPtr, argcPtr, argv, pvPtr) ! 582: Tcl_Interp *interp; /* Interpreter to use for nested command ! 583: * evaluations and error messages. */ ! 584: char *string; /* First character of word. */ ! 585: int flags; /* Flags to control parsing (same values as ! 586: * passed to Tcl_Eval). */ ! 587: int maxWords; /* Maximum number of words to parse. */ ! 588: char **termPtr; /* Store address of terminating character ! 589: * here. */ ! 590: int *argcPtr; /* Filled in with actual number of words ! 591: * parsed. */ ! 592: char **argv; /* Store addresses of individual words here. */ ! 593: register ParseValue *pvPtr; /* Information about where to place ! 594: * fully-substituted word. */ ! 595: { ! 596: register char *src, *dst; ! 597: register char c; ! 598: int type, result, argc; ! 599: char *oldBuffer; /* Used to detect when pvPtr's buffer gets ! 600: * reallocated, so we can adjust all of the ! 601: * argv pointers. */ ! 602: ! 603: src = string; ! 604: oldBuffer = pvPtr->buffer; ! 605: dst = pvPtr->next; ! 606: for (argc = 0; argc < maxWords; argc++) { ! 607: argv[argc] = dst; ! 608: ! 609: /* ! 610: * Skip leading space. ! 611: */ ! 612: ! 613: skipSpace: ! 614: c = *src; ! 615: type = CHAR_TYPE(c); ! 616: while (type == TCL_SPACE) { ! 617: src++; ! 618: c = *src; ! 619: type = CHAR_TYPE(c); ! 620: } ! 621: ! 622: /* ! 623: * Handle the normal case (i.e. no leading double-quote or brace). ! 624: */ ! 625: ! 626: if (type == TCL_NORMAL) { ! 627: normalArg: ! 628: while (1) { ! 629: if (dst == pvPtr->end) { ! 630: /* ! 631: * Target buffer space is about to run out. Make ! 632: * more space. ! 633: */ ! 634: ! 635: pvPtr->next = dst; ! 636: (*pvPtr->expandProc)(pvPtr, 1); ! 637: dst = pvPtr->next; ! 638: } ! 639: ! 640: if (type == TCL_NORMAL) { ! 641: copy: ! 642: *dst = c; ! 643: dst++; ! 644: src++; ! 645: } else if (type == TCL_SPACE) { ! 646: goto wordEnd; ! 647: } else if (type == TCL_DOLLAR) { ! 648: int length; ! 649: char *value; ! 650: ! 651: value = Tcl_ParseVar(interp, src, termPtr); ! 652: if (value == NULL) { ! 653: return TCL_ERROR; ! 654: } ! 655: src = *termPtr; ! 656: length = strlen(value); ! 657: if ((pvPtr->end - dst) <= length) { ! 658: pvPtr->next = dst; ! 659: (*pvPtr->expandProc)(pvPtr, length); ! 660: dst = pvPtr->next; ! 661: } ! 662: strcpy(dst, value); ! 663: dst += length; ! 664: } else if (type == TCL_COMMAND_END) { ! 665: if ((c == ']') && !(flags & TCL_BRACKET_TERM)) { ! 666: goto copy; ! 667: } ! 668: ! 669: /* ! 670: * End of command; simulate a word-end first, so ! 671: * that the end-of-command can be processed as the ! 672: * first thing in a new word. ! 673: */ ! 674: ! 675: goto wordEnd; ! 676: } else if (type == TCL_OPEN_BRACKET) { ! 677: pvPtr->next = dst; ! 678: result = TclParseNestedCmd(interp, src+1, flags, termPtr, ! 679: pvPtr); ! 680: if (result != TCL_OK) { ! 681: return result; ! 682: } ! 683: src = *termPtr; ! 684: dst = pvPtr->next; ! 685: } else if (type == TCL_BACKSLASH) { ! 686: int numRead; ! 687: ! 688: *dst = Tcl_Backslash(src, &numRead); ! 689: if (*dst != 0) { ! 690: dst++; ! 691: } ! 692: src += numRead; ! 693: } else { ! 694: goto copy; ! 695: } ! 696: c = *src; ! 697: type = CHAR_TYPE(c); ! 698: } ! 699: } else { ! 700: ! 701: /* ! 702: * Check for the end of the command. ! 703: */ ! 704: ! 705: if (type == TCL_COMMAND_END) { ! 706: if (flags & TCL_BRACKET_TERM) { ! 707: if (c == '\0') { ! 708: Tcl_SetResult(interp, "missing close-bracket", ! 709: TCL_STATIC); ! 710: return TCL_ERROR; ! 711: } ! 712: } else { ! 713: if (c == ']') { ! 714: goto normalArg; ! 715: } ! 716: } ! 717: goto done; ! 718: } ! 719: ! 720: /* ! 721: * Now handle the special cases: open braces, double-quotes, ! 722: * and backslash-newline. ! 723: */ ! 724: ! 725: pvPtr->next = dst; ! 726: if (type == TCL_QUOTE) { ! 727: result = TclParseQuotes(interp, src+1, '"', flags, ! 728: termPtr, pvPtr); ! 729: } else if (type == TCL_OPEN_BRACE) { ! 730: result = TclParseBraces(interp, src+1, termPtr, pvPtr); ! 731: } else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) { ! 732: src += 2; ! 733: goto skipSpace; ! 734: } else { ! 735: goto normalArg; ! 736: } ! 737: if (result != TCL_OK) { ! 738: return result; ! 739: } ! 740: ! 741: /* ! 742: * Back from quotes or braces; make sure that the terminating ! 743: * character was the end of the word. Have to be careful here ! 744: * to handle continuation lines (i.e. lines ending in backslash). ! 745: */ ! 746: ! 747: c = **termPtr; ! 748: if ((c == '\\') && ((*termPtr)[1] == '\n')) { ! 749: c = (*termPtr)[2]; ! 750: } ! 751: type = CHAR_TYPE(c); ! 752: if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) { ! 753: if (*src == '"') { ! 754: Tcl_SetResult(interp, "extra characters after close-quote", ! 755: TCL_STATIC); ! 756: } else { ! 757: Tcl_SetResult(interp, "extra characters after close-brace", ! 758: TCL_STATIC); ! 759: } ! 760: return TCL_ERROR; ! 761: } ! 762: src = *termPtr; ! 763: dst = pvPtr->next; ! 764: ! 765: } ! 766: ! 767: /* ! 768: * We're at the end of a word, so add a null terminator. Then ! 769: * see if the buffer was re-allocated during this word. If so, ! 770: * update all of the argv pointers. ! 771: */ ! 772: ! 773: wordEnd: ! 774: *dst = '\0'; ! 775: dst++; ! 776: if (oldBuffer != pvPtr->buffer) { ! 777: int i; ! 778: ! 779: for (i = 0; i <= argc; i++) { ! 780: argv[i] = pvPtr->buffer + (argv[i] - oldBuffer); ! 781: } ! 782: oldBuffer = pvPtr->buffer; ! 783: } ! 784: } ! 785: ! 786: done: ! 787: pvPtr->next = dst; ! 788: *termPtr = src; ! 789: *argcPtr = argc; ! 790: return TCL_OK; ! 791: } ! 792: ! 793: /* ! 794: *-------------------------------------------------------------- ! 795: * ! 796: * TclExpandParseValue -- ! 797: * ! 798: * This procedure is commonly used as the value of the ! 799: * expandProc in a ParseValue. It uses malloc to allocate ! 800: * more space for the result of a parse. ! 801: * ! 802: * Results: ! 803: * The buffer space in *pvPtr is reallocated to something ! 804: * larger, and if pvPtr->clientData is non-zero the old ! 805: * buffer is freed. Information is copied from the old ! 806: * buffer to the new one. ! 807: * ! 808: * Side effects: ! 809: * None. ! 810: * ! 811: *-------------------------------------------------------------- ! 812: */ ! 813: ! 814: void ! 815: TclExpandParseValue(pvPtr, needed) ! 816: register ParseValue *pvPtr; /* Information about buffer that ! 817: * must be expanded. If the clientData ! 818: * in the structure is non-zero, it ! 819: * means that the current buffer is ! 820: * dynamically allocated. */ ! 821: int needed; /* Minimum amount of additional space ! 822: * to allocate. */ ! 823: { ! 824: int newSpace; ! 825: char *new; ! 826: ! 827: /* ! 828: * Either double the size of the buffer or add enough new space ! 829: * to meet the demand, whichever produces a larger new buffer. ! 830: */ ! 831: ! 832: newSpace = (pvPtr->end - pvPtr->buffer) + 1; ! 833: if (newSpace < needed) { ! 834: newSpace += needed; ! 835: } else { ! 836: newSpace += newSpace; ! 837: } ! 838: new = (char *) ckalloc((unsigned) newSpace); ! 839: ! 840: /* ! 841: * Copy from old buffer to new, free old buffer if needed, and ! 842: * mark new buffer as malloc-ed. ! 843: */ ! 844: ! 845: memcpy((VOID *) new, (VOID *) pvPtr->buffer, pvPtr->next - pvPtr->buffer); ! 846: pvPtr->next = new + (pvPtr->next - pvPtr->buffer); ! 847: if (pvPtr->clientData != 0) { ! 848: ckfree(pvPtr->buffer); ! 849: } ! 850: pvPtr->buffer = new; ! 851: pvPtr->end = new + newSpace - 1; ! 852: pvPtr->clientData = (ClientData) 1; ! 853: } ! 854: ! 855: /* ! 856: *---------------------------------------------------------------------- ! 857: * ! 858: * TclWordEnd -- ! 859: * ! 860: * Given a pointer into a Tcl command, find the end of the next ! 861: * word of the command. ! 862: * ! 863: * Results: ! 864: * The return value is a pointer to the character just after the ! 865: * last one that's part of the word pointed to by "start". This ! 866: * may be the address of the NULL character at the end of the ! 867: * string. ! 868: * ! 869: * Side effects: ! 870: * None. ! 871: * ! 872: *---------------------------------------------------------------------- ! 873: */ ! 874: ! 875: char * ! 876: TclWordEnd(start, nested) ! 877: char *start; /* Beginning of a word of a Tcl command. */ ! 878: int nested; /* Zero means this is a top-level command. ! 879: * One means this is a nested command (close ! 880: * brace is a word terminator). */ ! 881: { ! 882: register char *p; ! 883: int count; ! 884: ! 885: p = start; ! 886: while (isspace(*p)) { ! 887: p++; ! 888: } ! 889: ! 890: /* ! 891: * Handle words beginning with a double-quote or a brace. ! 892: */ ! 893: ! 894: if (*p == '"') { ! 895: p = QuoteEnd(p+1, '"'); ! 896: } else if (*p == '{') { ! 897: int braces = 1; ! 898: while (braces != 0) { ! 899: p++; ! 900: while (*p == '\\') { ! 901: (void) Tcl_Backslash(p, &count); ! 902: p += count; ! 903: } ! 904: if (*p == '}') { ! 905: braces--; ! 906: } else if (*p == '{') { ! 907: braces++; ! 908: } else if (*p == 0) { ! 909: return p; ! 910: } ! 911: } ! 912: } ! 913: ! 914: /* ! 915: * Handle words that don't start with a brace or double-quote. ! 916: * This code is also invoked if the word starts with a brace or ! 917: * double-quote and there is garbage after the closing brace or ! 918: * quote. This is an error as far as Tcl_Eval is concerned, but ! 919: * for here the garbage is treated as part of the word. ! 920: */ ! 921: ! 922: while (*p != 0) { ! 923: if (*p == '[') { ! 924: p++; ! 925: while ((*p != ']') && (*p != 0)) { ! 926: p = TclWordEnd(p, 1); ! 927: } ! 928: if (*p == ']') { ! 929: p++; ! 930: } ! 931: } else if (*p == '\\') { ! 932: (void) Tcl_Backslash(p, &count); ! 933: p += count; ! 934: } else if (*p == '$') { ! 935: p = VarNameEnd(p); ! 936: } else if (*p == ';') { ! 937: /* ! 938: * Note: semi-colon terminates a word ! 939: * and also counts as a word by itself. ! 940: */ ! 941: ! 942: if (p == start) { ! 943: p++; ! 944: } ! 945: break; ! 946: } else if (isspace(*p)) { ! 947: break; ! 948: } else if ((*p == ']') && nested) { ! 949: break; ! 950: } else { ! 951: p++; ! 952: } ! 953: } ! 954: return p; ! 955: } ! 956: ! 957: /* ! 958: *---------------------------------------------------------------------- ! 959: * ! 960: * QuoteEnd -- ! 961: * ! 962: * Given a pointer to a string that obeys the parsing conventions ! 963: * for quoted things in Tcl, find the end of that quoted thing. ! 964: * The actual thing may be a quoted argument or a parenthesized ! 965: * index name. ! 966: * ! 967: * Results: ! 968: * The return value is a pointer to the character just after the ! 969: * last one that is part of the quoted string. ! 970: * ! 971: * Side effects: ! 972: * None. ! 973: * ! 974: *---------------------------------------------------------------------- ! 975: */ ! 976: ! 977: static char * ! 978: QuoteEnd(string, term) ! 979: char *string; /* Pointer to character just after opening ! 980: * "quote". */ ! 981: int term; /* This character will terminate the ! 982: * quoted string (e.g. '"' or ')'). */ ! 983: { ! 984: register char *p = string; ! 985: int count; ! 986: ! 987: while ((*p != 0) && (*p != term)) { ! 988: if (*p == '\\') { ! 989: (void) Tcl_Backslash(p, &count); ! 990: p += count; ! 991: } else if (*p == '[') { ! 992: p++; ! 993: while ((*p != ']') && (*p != 0)) { ! 994: p = TclWordEnd(p, 1); ! 995: } ! 996: if (*p == ']') { ! 997: p++; ! 998: } ! 999: } else if (*p == '$') { ! 1000: p = VarNameEnd(p); ! 1001: } else { ! 1002: p++; ! 1003: } ! 1004: } ! 1005: return p; ! 1006: } ! 1007: ! 1008: /* ! 1009: *---------------------------------------------------------------------- ! 1010: * ! 1011: * VarNameEnd -- ! 1012: * ! 1013: * Given a pointer to a variable reference using $-notation, find ! 1014: * the end of the variable name spec. ! 1015: * ! 1016: * Results: ! 1017: * The return value is a pointer to the character just after the ! 1018: * last one that is part of the variable name. ! 1019: * ! 1020: * Side effects: ! 1021: * None. ! 1022: * ! 1023: *---------------------------------------------------------------------- ! 1024: */ ! 1025: ! 1026: static char * ! 1027: VarNameEnd(string) ! 1028: char *string; /* Pointer to dollar-sign character. */ ! 1029: { ! 1030: register char *p = string+1; ! 1031: ! 1032: if (*p == '{') { ! 1033: do { ! 1034: p++; ! 1035: } while ((*p != '}') && (*p != 0)); ! 1036: } else { ! 1037: while (isalnum(*p) || (*p == '_')) { ! 1038: p++; ! 1039: } ! 1040: if ((*p == '(') && (p != string+1)) { ! 1041: p = QuoteEnd(p+1, ')'); ! 1042: } ! 1043: } ! 1044: return p; ! 1045: } ! 1046: ! 1047: /* ! 1048: *---------------------------------------------------------------------- ! 1049: * ! 1050: * Tcl_ParseVar -- ! 1051: * ! 1052: * Given a string starting with a $ sign, parse off a variable ! 1053: * name and return its value. ! 1054: * ! 1055: * Results: ! 1056: * The return value is the contents of the variable given by ! 1057: * the leading characters of string. If termPtr isn't NULL, ! 1058: * *termPtr gets filled in with the address of the character ! 1059: * just after the last one in the variable specifier. If the ! 1060: * variable doesn't exist, then the return value is NULL and ! 1061: * an error message will be left in interp->result. ! 1062: * ! 1063: * Side effects: ! 1064: * None. ! 1065: * ! 1066: *---------------------------------------------------------------------- ! 1067: */ ! 1068: ! 1069: char * ! 1070: Tcl_ParseVar(interp, string, termPtr) ! 1071: Tcl_Interp *interp; /* Context for looking up variable. */ ! 1072: register char *string; /* String containing variable name. ! 1073: * First character must be "$". */ ! 1074: char **termPtr; /* If non-NULL, points to word to fill ! 1075: * in with character just after last ! 1076: * one in the variable specifier. */ ! 1077: ! 1078: { ! 1079: char *name1, *name1End, c, *result; ! 1080: register char *name2; ! 1081: #define NUM_CHARS 200 ! 1082: char copyStorage[NUM_CHARS]; ! 1083: ParseValue pv; ! 1084: ! 1085: /* ! 1086: * There are three cases: ! 1087: * 1. The $ sign is followed by an open curly brace. Then the variable ! 1088: * name is everything up to the next close curly brace, and the ! 1089: * variable is a scalar variable. ! 1090: * 2. The $ sign is not followed by an open curly brace. Then the ! 1091: * variable name is everything up to the next character that isn't ! 1092: * a letter, digit, or underscore. If the following character is an ! 1093: * open parenthesis, then the information between parentheses is ! 1094: * the array element name, which can include any of the substitutions ! 1095: * permissible between quotes. ! 1096: * 3. The $ sign is followed by something that isn't a letter, digit, ! 1097: * or underscore: in this case, there is no variable name, and "$" ! 1098: * is returned. ! 1099: */ ! 1100: ! 1101: name2 = NULL; ! 1102: string++; ! 1103: if (*string == '{') { ! 1104: string++; ! 1105: name1 = string; ! 1106: while (*string != '}') { ! 1107: if (*string == 0) { ! 1108: Tcl_SetResult(interp, "missing close-brace for variable name", ! 1109: TCL_STATIC); ! 1110: if (termPtr != 0) { ! 1111: *termPtr = string; ! 1112: } ! 1113: return NULL; ! 1114: } ! 1115: string++; ! 1116: } ! 1117: name1End = string; ! 1118: string++; ! 1119: } else { ! 1120: name1 = string; ! 1121: while (isalnum(*string) || (*string == '_')) { ! 1122: string++; ! 1123: } ! 1124: if (string == name1) { ! 1125: if (termPtr != 0) { ! 1126: *termPtr = string; ! 1127: } ! 1128: return "$"; ! 1129: } ! 1130: name1End = string; ! 1131: if (*string == '(') { ! 1132: char *end; ! 1133: ! 1134: /* ! 1135: * Perform substitutions on the array element name, just as ! 1136: * is done for quotes. ! 1137: */ ! 1138: ! 1139: pv.buffer = pv.next = copyStorage; ! 1140: pv.end = copyStorage + NUM_CHARS - 1; ! 1141: pv.expandProc = TclExpandParseValue; ! 1142: pv.clientData = (ClientData) NULL; ! 1143: if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv) ! 1144: != TCL_OK) { ! 1145: char msg[100]; ! 1146: sprintf(msg, "\n (parsing index for array \"%.*s\")", ! 1147: string-name1, name1); ! 1148: Tcl_AddErrorInfo(interp, msg); ! 1149: result = NULL; ! 1150: name2 = pv.buffer; ! 1151: if (termPtr != 0) { ! 1152: *termPtr = end; ! 1153: } ! 1154: goto done; ! 1155: } ! 1156: string = end; ! 1157: name2 = pv.buffer; ! 1158: } ! 1159: } ! 1160: if (termPtr != 0) { ! 1161: *termPtr = string; ! 1162: } ! 1163: ! 1164: c = *name1End; ! 1165: *name1End = 0; ! 1166: result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG); ! 1167: *name1End = c; ! 1168: ! 1169: done: ! 1170: if ((name2 != NULL) && (pv.buffer != copyStorage)) { ! 1171: ckfree(pv.buffer); ! 1172: } ! 1173: return result; ! 1174: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.