git.zerfleddert.de Git - micropolis/blob

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 *

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 */

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

22 #include "tclint.h"

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 */

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 };

98 /*

99 * Function prototypes for procedures local to this file:

100 */

101

 static char *   QuoteEnd _ANSI_ARGS_((char *string, int term));

 static char *   VarNameEnd _ANSI_ARGS_((char *string));

104 \f

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 (

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;

138 char result;

139 int count;

140

141 count = 2;

142

143 switch (*p) {

144 case 'b':

             result = '\b';

146 break;

147 case 'e':

148 result = 033;

149 break;

150 case 'f':

             result = '\f';

152 break;

153 case 'n':

             result = '\n';

155 break;

156 case 'r':

             result = '\r';

158 break;

159 case 't':

             result = '\t';

161 break;

162 case 'v':

             result = '\v';

164 break;

165 case 'C':

166 p++;

             if (isspace(*p) || (*p == 0)) {

168 result = 'C';

169 count = 1;

170 break;

171 }

172 count = 3;

             if (*p == 'M') {

174 p++;

                 if (isspace(*p) || (*p == 0)) {

                     result = 'M' & 037;

177 break;

178 }

179 count = 4;

                 result = (*p & 037) | 0200;

181 break;

182 }

183 count = 3;

184 result = *p & 037;

185 break;

186 case 'M':

187 p++;

             if (isspace(*p) || (*p == 0)) {

189 result = 'M';

190 count = 1;

191 break;

192 }

193 count = 3;

194 result = *p + 0200;

195 break;

196 case '}':

197 case '{':

198 case ']':

199 case '[':

200 case '$':

201 case ' ':

202 case ';':

203 case '"':

         case '\\':

205 result = *p;

206 break;

         case '\n':

208 result = 0;

209 break;

210 default:

             if (isdigit(*p)) {

212 result = *p - '0';

213 p++;

                 if (!isdigit(*p)) {

215 break;

216 }

217 count = 3;

                 result = (result << 3) + (*p - '0');

219 p++;

                 if (!isdigit(*p)) {

221 break;

222 }

223 count = 4;

                 result = (result << 3) + (*p - '0');

225 break;

226 }

             result = '\\';

228 count = 1;

229 break;

230 }

231

232 if (readPtr != NULL) {

233 *readPtr = count;

234 }

235 return result;

236 }

237 \f

238 /*

239 *--------------------------------------------------------------

240 *

241 * TclParseQuotes --

242 *

243 * This procedure parses a double-quoted string such as a

244 * quoted Tcl command argument or a quoted value in a Tcl

245 * expression. This procedure is also used to parse array

246 * element names within parentheses, or anything else that

247 * needs all the substitutions that happen in quotes.

248 *

249 * Results:

250 * The return value is a standard Tcl result, which is

251 * TCL_OK unless there was an error while parsing the

252 * quoted string. If an error occurs then interp->result

253 * contains a standard error message. *TermPtr is filled

254 * in with the address of the character just after the

255 * last one successfully processed; this is usually the

256 * character just after the matching close-quote. The

257 * fully-substituted contents of the quotes are stored in

258 * standard fashion in *pvPtr, null-terminated with

259 * pvPtr->next pointing to the terminating null character.

260 *

261 * Side effects:

262 * The buffer space in pvPtr may be enlarged by calling its

263 * expandProc.

264 *

265 *--------------------------------------------------------------

266 */

267

268 int

269 TclParseQuotes (

270 Tcl_Interp *interp, /* Interpreter to use for nested command

271 * evaluations and error messages. */

272 char *string, /* Character just after opening double-

273 * quote. */

274 int termChar, /* Character that terminates "quoted" string

275 * (usually double-quote, but sometimes

276 * right-paren or something else). */

277 int flags, /* Flags to pass to nested Tcl_Eval calls. */

278 char **termPtr, /* Store address of terminating character

279 * here. */

280 ParseValue *pvPtr /* Information about where to place

281 * fully-substituted result of parse. */

282 )

283 {

     register char *src, *dst, c;

285

286 src = string;

287 dst = pvPtr->next;

288

289 while (1) {

         if (dst == pvPtr->end) {

291 /*

292 * Target buffer space is about to run out. Make more space.

293 */

294

295 pvPtr->next = dst;

             (*pvPtr->expandProc)(pvPtr, 1);

297 dst = pvPtr->next;

298 }

299

300 c = *src;

301 src++;

302 if (c == termChar) {

303 *dst = '\0';

304 pvPtr->next = dst;

305 *termPtr = src;

306 return TCL_OK;

         } else if (CHAR_TYPE(c) == TCL_NORMAL) {

308 copy:

309 *dst = c;

310 dst++;

311 continue;

         } else if (c == '$') {

313 int length;

314 char *value;

315

             value = Tcl_ParseVar(interp, src-1, termPtr);

317 if (value == NULL) {

318 return TCL_ERROR;

319 }

320 src = *termPtr;

321 length = strlen(value);

             if ((pvPtr->end - dst) <= length) {

323 pvPtr->next = dst;

                 (*pvPtr->expandProc)(pvPtr, length);

325 dst = pvPtr->next;

326 }

327 strcpy(dst, value);

328 dst += length;

329 continue;

         } else if (c == '[') {

331 int result;

332

333 pvPtr->next = dst;

             result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);

335 if (result != TCL_OK) {

336 return result;

337 }

338 src = *termPtr;

339 dst = pvPtr->next;

340 continue;

         } else if (c == '\\') {

342 int numRead;

343

344 src--;

             *dst = Tcl_Backslash(src, &numRead);

             if (*dst != 0) {

347 dst++;

348 }

349 src += numRead;

350 continue;

         } else if (c == '\0') {

352 Tcl_ResetResult(interp);

             sprintf(interp->result, "missing %c", termChar);

             *termPtr = string-1;

355 return TCL_ERROR;

356 } else {

357 goto copy;

358 }

359 }

360 }

361 \f

362 /*

363 *--------------------------------------------------------------

364 *

365 * TclParseNestedCmd --

366 *

367 * This procedure parses a nested Tcl command between

368 * brackets, returning the result of the command.

369 *

370 * Results:

371 * The return value is a standard Tcl result, which is

372 * TCL_OK unless there was an error while executing the

373 * nested command. If an error occurs then interp->result

374 * contains a standard error message. *TermPtr is filled

375 * in with the address of the character just after the

376 * last one processed; this is usually the character just

377 * after the matching close-bracket, or the null character

378 * at the end of the string if the close-bracket was missing

379 * (a missing close bracket is an error). The result returned

380 * by the command is stored in standard fashion in *pvPtr,

381 * null-terminated, with pvPtr->next pointing to the null

382 * character.

383 *

384 * Side effects:

385 * The storage space at *pvPtr may be expanded.

386 *

387 *--------------------------------------------------------------

388 */

389

390 int

391 TclParseNestedCmd (

392 Tcl_Interp *interp, /* Interpreter to use for nested command

393 * evaluations and error messages. */

394 char *string, /* Character just after opening bracket. */

395 int flags, /* Flags to pass to nested Tcl_Eval. */

396 char **termPtr, /* Store address of terminating character

397 * here. */

398 register ParseValue *pvPtr /* Information about where to place

399 * result of command. */

400 )

401 {

402 int result, length, shortfall;

403 Interp *iPtr = (Interp *) interp;

404

     result = Tcl_Eval(interp, string, flags | TCL_BRACKET_TERM, termPtr);

406 if (result != TCL_OK) {

407 /*

408 * The increment below results in slightly cleaner message in

409 * the errorInfo variable (the close-bracket will appear).

410 */

411

         if (**termPtr == ']') {

413 *termPtr += 1;

414 }

415 return result;

416 }

417 (*termPtr) += 1;

     length = strlen(iPtr->result);

     shortfall = length + 1 - (pvPtr->end - pvPtr->next);

     if (shortfall > 0) {

         (*pvPtr->expandProc)(pvPtr, shortfall);

422 }

     strcpy(pvPtr->next, iPtr->result);

424 pvPtr->next += length;

425 Tcl_FreeResult(iPtr);

426 iPtr->result = iPtr->resultSpace;

     iPtr->resultSpace[0] = '\0';

428 return TCL_OK;

429 }

430 \f

431 /*

432 *--------------------------------------------------------------

433 *

434 * TclParseBraces --

435 *

436 * This procedure scans the information between matching

437 * curly braces.

438 *

439 * Results:

440 * The return value is a standard Tcl result, which is

441 * TCL_OK unless there was an error while parsing string.

442 * If an error occurs then interp->result contains a

443 * standard error message. *TermPtr is filled

444 * in with the address of the character just after the

445 * last one successfully processed; this is usually the

446 * character just after the matching close-brace. The

447 * information between curly braces is stored in standard

448 * fashion in *pvPtr, null-terminated with pvPtr->next

449 * pointing to the terminating null character.

450 *

451 * Side effects:

452 * The storage space at *pvPtr may be expanded.

453 *

454 *--------------------------------------------------------------

455 */

456

457 int

458 TclParseBraces (

459 Tcl_Interp *interp, /* Interpreter to use for nested command

460 * evaluations and error messages. */

461 char *string, /* Character just after opening bracket. */

462 char **termPtr, /* Store address of terminating character

463 * here. */

464 register ParseValue *pvPtr /* Information about where to place

465 * result of command. */

466 )

467 {

468 int level;

     register char *src, *dst, *end;

470 register char c;

471

472 src = string;

473 dst = pvPtr->next;

474 end = pvPtr->end;

475 level = 1;

476

477 /*

478 * Copy the characters one at a time to the result area, stopping

479 * when the matching close-brace is found.

480 */

481

482 while (1) {

483 c = *src;

484 src++;

485 if (dst == end) {

486 pvPtr->next = dst;

             (*pvPtr->expandProc)(pvPtr, 20);

488 dst = pvPtr->next;

489 end = pvPtr->end;

490 }

491 *dst = c;

492 dst++;

         if (CHAR_TYPE(c) == TCL_NORMAL) {

494 continue;

         } else if (c == '{') {

496 level++;

         } else if (c == '}') {

498 level--;

             if (level == 0) {

500 dst--; /* Don't copy the last close brace. */

501 break;

502 }

         } else if (c == '\\') {

504 int count;

505

506 /*

507 * Must always squish out backslash-newlines, even when in

508 * braces. This is needed so that this sequence can appear

509 * anywhere in a command, such as the middle of an expression.

510 */

511

             if (*src == '\n') {

513 dst--;

514 src++;

515 } else {

                 (void) Tcl_Backslash(src-1, &count);

                 while (count > 1) {

518 if (dst == end) {

519 pvPtr->next = dst;

                         (*pvPtr->expandProc)(pvPtr, 20);

521 dst = pvPtr->next;

522 end = pvPtr->end;

523 }

524 *dst = *src;

525 dst++;

526 src++;

527 count--;

528 }

529 }

         } else if (c == '\0') {

             Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);

             *termPtr = string-1;

533 return TCL_ERROR;

534 }

535 }

536

537 *dst = '\0';

538 pvPtr->next = dst;

539 *termPtr = src;

540 return TCL_OK;

541 }

542 \f

543 /*

544 *--------------------------------------------------------------

545 *

546 * TclParseWords --

547 *

548 * This procedure parses one or more words from a command

549 * string and creates argv-style pointers to fully-substituted

550 * copies of those words.

551 *

552 * Results:

553 * The return value is a standard Tcl result.

554 *

555 * *argcPtr is modified to hold a count of the number of words

556 * successfully parsed, which may be 0. At most maxWords words

557 * will be parsed. If 0 <= *argcPtr < maxWords then it

558 * means that a command separator was seen. If *argcPtr

559 * is maxWords then it means that a command separator was

560 * not seen yet.

561 *

562 * *TermPtr is filled in with the address of the character

563 * just after the last one successfully processed in the

564 * last word. This is either the command terminator (if

565 * *argcPtr < maxWords), the character just after the last

566 * one in a word (if *argcPtr is maxWords), or the vicinity

567 * of an error (if the result is not TCL_OK).

568 *

569 * The pointers at *argv are filled in with pointers to the

570 * fully-substituted words, and the actual contents of the

571 * words are copied to the buffer at pvPtr.

572 *

573 * If an error occurrs then an error message is left in

574 * interp->result and the information at *argv, *argcPtr,

575 * and *pvPtr may be incomplete.

576 *

577 * Side effects:

578 * The buffer space in pvPtr may be enlarged by calling its

579 * expandProc.

580 *

581 *--------------------------------------------------------------

582 */

583

584 int

585 TclParseWords (

586 Tcl_Interp *interp, /* Interpreter to use for nested command

587 * evaluations and error messages. */

588 char *string, /* First character of word. */

589 int flags, /* Flags to control parsing (same values as

590 * passed to Tcl_Eval). */

591 int maxWords, /* Maximum number of words to parse. */

592 char **termPtr, /* Store address of terminating character

593 * here. */

594 int *argcPtr, /* Filled in with actual number of words

595 * parsed. */

596 char **argv, /* Store addresses of individual words here. */

597 register ParseValue *pvPtr /* Information about where to place

598 * fully-substituted word. */

599 )

600 {

     register char *src, *dst;

602 register char c;

603 int type, result, argc;

604 char *oldBuffer; /* Used to detect when pvPtr's buffer gets

605 * reallocated, so we can adjust all of the

606 * argv pointers. */

607

608 src = string;

609 oldBuffer = pvPtr->buffer;

610 dst = pvPtr->next;

     for (argc = 0; argc < maxWords; argc++) {

612 argv[argc] = dst;

613

614 /*

615 * Skip leading space.

616 */

617

618 skipSpace:

619 c = *src;

620 type = CHAR_TYPE(c);

621 while (type == TCL_SPACE) {

622 src++;

623 c = *src;

624 type = CHAR_TYPE(c);

625 }

626

627 /*

628 * Handle the normal case (i.e. no leading double-quote or brace).

629 */

630

631 if (type == TCL_NORMAL) {

632 normalArg:

633 while (1) {

                 if (dst == pvPtr->end) {

635 /*

636 * Target buffer space is about to run out. Make

637 * more space.

638 */

639

640 pvPtr->next = dst;

                     (*pvPtr->expandProc)(pvPtr, 1);

642 dst = pvPtr->next;

643 }

644

645 if (type == TCL_NORMAL) {

646 copy:

647 *dst = c;

648 dst++;

649 src++;

                 } else if (type == TCL_SPACE) {

651 goto wordEnd;

                 } else if (type == TCL_DOLLAR) {

653 int length;

654 char *value;

655

                     value = Tcl_ParseVar(interp, src, termPtr);

657 if (value == NULL) {

658 return TCL_ERROR;

659 }

660 src = *termPtr;

661 length = strlen(value);

                     if ((pvPtr->end - dst) <= length) {

663 pvPtr->next = dst;

                         (*pvPtr->expandProc)(pvPtr, length);

665 dst = pvPtr->next;

666 }

667 strcpy(dst, value);

668 dst += length;

                 } else if (type == TCL_COMMAND_END) {

                     if ((c == ']') && !(flags & TCL_BRACKET_TERM)) {

671 goto copy;

672 }

673

674 /*

675 * End of command; simulate a word-end first, so

676 * that the end-of-command can be processed as the

677 * first thing in a new word.

678 */

679

680 goto wordEnd;

                 } else if (type == TCL_OPEN_BRACKET) {

682 pvPtr->next = dst;

                     result = TclParseNestedCmd(interp, src+1, flags, termPtr,

684 pvPtr);

685 if (result != TCL_OK) {

686 return result;

687 }

688 src = *termPtr;

689 dst = pvPtr->next;

                 } else if (type == TCL_BACKSLASH) {

691 int numRead;

692

                     *dst = Tcl_Backslash(src, &numRead);

                     if (*dst != 0) {

695 dst++;

696 }

697 src += numRead;

698 } else {

699 goto copy;

700 }

701 c = *src;

702 type = CHAR_TYPE(c);

703 }

704 } else {

705

706 /*

707 * Check for the end of the command.

708 */

709

710 if (type == TCL_COMMAND_END) {

711 if (flags & TCL_BRACKET_TERM) {

                     if (c == '\0') {

                         Tcl_SetResult(interp, "missing close-bracket",

714 TCL_STATIC);

715 return TCL_ERROR;

716 }

717 } else {

                     if (c == ']') {

719 goto normalArg;

720 }

721 }

722 goto done;

723 }

724

725 /*

726 * Now handle the special cases: open braces, double-quotes,

727 * and backslash-newline.

728 */

729

730 pvPtr->next = dst;

731 if (type == TCL_QUOTE) {

                 result = TclParseQuotes(interp, src+1, '"', flags,

733 termPtr, pvPtr);

             } else if (type == TCL_OPEN_BRACE) {

                 result = TclParseBraces(interp, src+1, termPtr, pvPtr);

             } else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) {

737 src += 2;

738 goto skipSpace;

739 } else {

740 goto normalArg;

741 }

742 if (result != TCL_OK) {

743 return result;

744 }

745

746 /*

747 * Back from quotes or braces; make sure that the terminating

748 * character was the end of the word. Have to be careful here

749 * to handle continuation lines (i.e. lines ending in backslash).

750 */

751

752 c = **termPtr;

             if ((c == '\\') && ((*termPtr)[1] == '\n')) {

754 c = (*termPtr)[2];

755 }

756 type = CHAR_TYPE(c);

             if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {

                 if (*src == '"') {

                     Tcl_SetResult(interp, "extra characters after close-quote",

760 TCL_STATIC);

761 } else {

                     Tcl_SetResult(interp, "extra characters after close-brace",

763 TCL_STATIC);

764 }

765 return TCL_ERROR;

766 }

767 src = *termPtr;

768 dst = pvPtr->next;

769

770 }

771

772 /*

773 * We're at the end of a word, so add a null terminator. Then

774 * see if the buffer was re-allocated during this word. If so,

775 * update all of the argv pointers.

776 */

777

778 wordEnd:

779 *dst = '\0';

780 dst++;

         if (oldBuffer != pvPtr->buffer) {

782 int i;

783

             for (i = 0; i <= argc; i++) {

                 argv[i] = pvPtr->buffer + (argv[i] - oldBuffer);

786 }

787 oldBuffer = pvPtr->buffer;

788 }

789 }

790

791 done:

792 pvPtr->next = dst;

793 *termPtr = src;

794 *argcPtr = argc;

795 return TCL_OK;

796 }

797 \f

798 /*

799 *--------------------------------------------------------------

800 *

801 * TclExpandParseValue --

802 *

803 * This procedure is commonly used as the value of the

804 * expandProc in a ParseValue. It uses malloc to allocate

805 * more space for the result of a parse.

806 *

807 * Results:

808 * The buffer space in *pvPtr is reallocated to something

809 * larger, and if pvPtr->clientData is non-zero the old

810 * buffer is freed. Information is copied from the old

811 * buffer to the new one.

812 *

813 * Side effects:

814 * None.

815 *

816 *--------------------------------------------------------------

817 */

818

819 void

820 TclExpandParseValue (

821 register ParseValue *pvPtr, /* Information about buffer that

822 * must be expanded. If the clientData

823 * in the structure is non-zero, it

824 * means that the current buffer is

825 * dynamically allocated. */

826 int needed /* Minimum amount of additional space

827 * to allocate. */

828 )

829 {

830 int newSpace;

831 char *new;

832

833 /*

834 * Either double the size of the buffer or add enough new space

835 * to meet the demand, whichever produces a larger new buffer.

836 */

837

     newSpace = (pvPtr->end - pvPtr->buffer) + 1;

839 if (newSpace < needed) {

840 newSpace += needed;

841 } else {

842 newSpace += newSpace;

843 }

     new = (char *) ckalloc((unsigned) newSpace);

845

846 /*

847 * Copy from old buffer to new, free old buffer if needed, and

848 * mark new buffer as malloc-ed.

849 */

850

     memcpy((VOID *) new, (VOID *) pvPtr->buffer, pvPtr->next - pvPtr->buffer);

     pvPtr->next = new + (pvPtr->next - pvPtr->buffer);

     if (pvPtr->clientData != 0) {

854 ckfree(pvPtr->buffer);

855 }

856 pvPtr->buffer = new;

     pvPtr->end = new + newSpace - 1;

     pvPtr->clientData = (ClientData) 1;

859 }

860 \f

861 /*

862 *----------------------------------------------------------------------

863 *

864 * TclWordEnd --

865 *

866 * Given a pointer into a Tcl command, find the end of the next

867 * word of the command.

868 *

869 * Results:

870 * The return value is a pointer to the character just after the

871 * last one that's part of the word pointed to by "start". This

872 * may be the address of the NULL character at the end of the

873 * string.

874 *

875 * Side effects:

876 * None.

877 *

878 *----------------------------------------------------------------------

879 */

880

881 char *

882 TclWordEnd (

883 char *start, /* Beginning of a word of a Tcl command. */

884 int nested /* Zero means this is a top-level command.

885 * One means this is a nested command (close

886 * brace is a word terminator). */

887 )

888 {

889 register char *p;

890 int count;

891

892 p = start;

     while (isspace(*p)) {

894 p++;

895 }

896

897 /*

898 * Handle words beginning with a double-quote or a brace.

899 */

900

     if (*p == '"') {

         p = QuoteEnd(p+1, '"');

     } else if (*p == '{') {

904 int braces = 1;

         while (braces != 0) {

906 p++;

             while (*p == '\\') {

                 (void) Tcl_Backslash(p, &count);

909 p += count;

910 }

             if (*p == '}') {

912 braces--;

             } else if (*p == '{') {

914 braces++;

             } else if (*p == 0) {

916 return p;

917 }

918 }

919 }

920

921 /*

922 * Handle words that don't start with a brace or double-quote.

923 * This code is also invoked if the word starts with a brace or

924 * double-quote and there is garbage after the closing brace or

925 * quote. This is an error as far as Tcl_Eval is concerned, but

926 * for here the garbage is treated as part of the word.

927 */

928

     while (*p != 0) {

         if (*p == '[') {

931 p++;

             while ((*p != ']') && (*p != 0)) {

                 p = TclWordEnd(p, 1);

934 }

             if (*p == ']') {

936 p++;

937 }

         } else if (*p == '\\') {

             (void) Tcl_Backslash(p, &count);

940 p += count;

         } else if (*p == '$') {

942 p = VarNameEnd(p);

         } else if (*p == ';') {

944 /*

945 * Note: semi-colon terminates a word

946 * and also counts as a word by itself.

947 */

948

949 if (p == start) {

950 p++;

951 }

952 break;

         } else if (isspace(*p)) {

954 break;

         } else if ((*p == ']') && nested) {

956 break;

957 } else {

958 p++;

959 }

960 }

961 return p;

962 }

963 \f

964 /*

965 *----------------------------------------------------------------------

966 *

967 * QuoteEnd --

968 *

969 * Given a pointer to a string that obeys the parsing conventions

970 * for quoted things in Tcl, find the end of that quoted thing.

971 * The actual thing may be a quoted argument or a parenthesized

972 * index name.

973 *

974 * Results:

975 * The return value is a pointer to the character just after the

976 * last one that is part of the quoted string.

977 *

978 * Side effects:

979 * None.

980 *

981 *----------------------------------------------------------------------

982 */

983

984 static char *

985 QuoteEnd (

986 char *string, /* Pointer to character just after opening

987 * "quote". */

988 int term /* This character will terminate the

989 * quoted string (e.g. '"' or ')'). */

990 )

991 {

     register char *p = string;

993 int count;

994

     while ((*p != 0) && (*p != term)) {

         if (*p == '\\') {

             (void) Tcl_Backslash(p, &count);

998 p += count;

         } else if (*p == '[') {

1000 p++;

             while ((*p != ']') && (*p != 0)) {

                 p = TclWordEnd(p, 1);

1003 }

             if (*p == ']') {

1005 p++;

1006 }

         } else if (*p == '$') {

1008 p = VarNameEnd(p);

1009 } else {

1010 p++;

1011 }

1012 }

1013 return p;

1014 }

1015 \f

1016 /*

1017 *----------------------------------------------------------------------

1018 *

1019 * VarNameEnd --

1020 *

1021 * Given a pointer to a variable reference using $-notation, find

1022 * the end of the variable name spec.

1023 *

1024 * Results:

1025 * The return value is a pointer to the character just after the

1026 * last one that is part of the variable name.

1027 *

1028 * Side effects:

1029 * None.

1030 *

1031 *----------------------------------------------------------------------

1032 */

1033

1034 static char *

1035 VarNameEnd (

1036 char *string /* Pointer to dollar-sign character. */

1037 )

1038 {

     register char *p = string+1;

1040

     if (*p == '{') {

1042 do {

1043 p++;

         } while ((*p != '}') && (*p != 0));

1045 } else {

         while (isalnum(*p) || (*p == '_')) {

1047 p++;

1048 }

         if ((*p == '(') && (p != string+1)) {

             p = QuoteEnd(p+1, ')');

1051 }

1052 }

1053 return p;

1054 }

1055 \f

1056 /*

1057 *----------------------------------------------------------------------

1058 *

1059 * Tcl_ParseVar --

1060 *

1061 * Given a string starting with a $ sign, parse off a variable

1062 * name and return its value.

1063 *

1064 * Results:

1065 * The return value is the contents of the variable given by

1066 * the leading characters of string. If termPtr isn't NULL,

1067 * *termPtr gets filled in with the address of the character

1068 * just after the last one in the variable specifier. If the

1069 * variable doesn't exist, then the return value is NULL and

1070 * an error message will be left in interp->result.

1071 *

1072 * Side effects:

1073 * None.

1074 *

1075 *----------------------------------------------------------------------

1076 */

1077

1078 char *

1079 Tcl_ParseVar (

1080 Tcl_Interp *interp, /* Context for looking up variable. */

     register char *string,              /* String containing variable name.

1082 * First character must be "$". */

1083 char **termPtr /* If non-NULL, points to word to fill

1084 * in with character just after last

1085 * one in the variable specifier. */

1086 )

1087

1088 {

     char *name1, *name1End, c, *result;

1090 register char *name2;

1091 #define NUM_CHARS 200

1092 char copyStorage[NUM_CHARS];

1093 ParseValue pv;

1094

1095 /*

1096 * There are three cases:

1097 * 1. The $ sign is followed by an open curly brace. Then the variable

1098 * name is everything up to the next close curly brace, and the

1099 * variable is a scalar variable.

1100 * 2. The $ sign is not followed by an open curly brace. Then the

1101 * variable name is everything up to the next character that isn't

1102 * a letter, digit, or underscore. If the following character is an

1103 * open parenthesis, then the information between parentheses is

1104 * the array element name, which can include any of the substitutions

1105 * permissible between quotes.

1106 * 3. The $ sign is followed by something that isn't a letter, digit,

1107 * or underscore: in this case, there is no variable name, and "$"

1108 * is returned.

1109 */

1110

1111 name2 = NULL;

1112 string++;

     if (*string == '{') {

1114 string++;

1115 name1 = string;

         while (*string != '}') {

             if (*string == 0) {

                 Tcl_SetResult(interp, "missing close-brace for variable name",

1119 TCL_STATIC);

                 if (termPtr != 0) {

1121 *termPtr = string;

1122 }

1123 return NULL;

1124 }

1125 string++;

1126 }

1127 name1End = string;

1128 string++;

1129 } else {

1130 name1 = string;

         while (isalnum(*string) || (*string == '_')) {

1132 string++;

1133 }

1134 if (string == name1) {

             if (termPtr != 0) {

1136 *termPtr = string;

1137 }

1138 return "$";

1139 }

1140 name1End = string;

         if (*string == '(') {

1142 char *end;

1143

1144 /*

1145 * Perform substitutions on the array element name, just as

1146 * is done for quotes.

1147 */

1148

             pv.buffer = pv.next = copyStorage;

             pv.end = copyStorage + NUM_CHARS - 1;

1151 pv.expandProc = TclExpandParseValue;

1152 pv.clientData = (ClientData) NULL;

             if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)

1154 != TCL_OK) {

1155 char msg[100];

                 sprintf(msg, "\n    (parsing index for array \"%.*s\")",

1157 string-name1, name1);

1158 Tcl_AddErrorInfo(interp, msg);

1159 result = NULL;

1160 name2 = pv.buffer;

                 if (termPtr != 0) {

1162 *termPtr = end;

1163 }

1164 goto done;

1165 }

1166 string = end;

1167 name2 = pv.buffer;

1168 }

1169 }

     if (termPtr != 0) {

1171 *termPtr = string;

1172 }

1173

1174 c = *name1End;

1175 *name1End = 0;

     result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);

1177 *name1End = c;

1178

1179 done:

     if ((name2 != NULL) && (pv.buffer != copyStorage)) {

1181 ckfree(pv.buffer);

1182 }

1183 return result;

1184 }