/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclutil.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclutil.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (show annotations) (download)
Sat Nov 5 11:07:06 2016 UTC (8 years, 1 month ago) by dashley
File MIME type: text/plain
File size: 64986 byte(s)
Set EOL properties appropriately to facilitate simultaneous Linux and Windows development.
1 /* $Header$ */
2 /*
3 * tclUtil.c --
4 *
5 * This file contains utility procedures that are used by many Tcl
6 * commands.
7 *
8 * Copyright (c) 1987-1993 The Regents of the University of California.
9 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
10 *
11 * See the file "license.terms" for information on usage and redistribution
12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 * RCS: @(#) $Id: tclutil.c,v 1.1.1.1 2001/06/13 04:47:21 dtashley Exp $
15 */
16
17 #include "tclInt.h"
18 #include "tclPort.h"
19
20 /*
21 * The following variable holds the full path name of the binary
22 * from which this application was executed, or NULL if it isn't
23 * know. The value of the variable is set by the procedure
24 * Tcl_FindExecutable. The storage space is dynamically allocated.
25 */
26
27 char *tclExecutableName = NULL;
28 char *tclNativeExecutableName = NULL;
29
30 /*
31 * The following values are used in the flags returned by Tcl_ScanElement
32 * and used by Tcl_ConvertElement. The value TCL_DONT_USE_BRACES is also
33 * defined in tcl.h; make sure its value doesn't overlap with any of the
34 * values below.
35 *
36 * TCL_DONT_USE_BRACES - 1 means the string mustn't be enclosed in
37 * braces (e.g. it contains unmatched braces,
38 * or ends in a backslash character, or user
39 * just doesn't want braces); handle all
40 * special characters by adding backslashes.
41 * USE_BRACES - 1 means the string contains a special
42 * character that can be handled simply by
43 * enclosing the entire argument in braces.
44 * BRACES_UNMATCHED - 1 means that braces aren't properly matched
45 * in the argument.
46 */
47
48 #define USE_BRACES 2
49 #define BRACES_UNMATCHED 4
50
51 /*
52 * The following values determine the precision used when converting
53 * floating-point values to strings. This information is linked to all
54 * of the tcl_precision variables in all interpreters via the procedure
55 * TclPrecTraceProc.
56 */
57
58 static char precisionString[10] = "12";
59 /* The string value of all the tcl_precision
60 * variables. */
61 static char precisionFormat[10] = "%.12g";
62 /* The format string actually used in calls
63 * to sprintf. */
64 TCL_DECLARE_MUTEX(precisionMutex)
65
66
67 /*
68 *----------------------------------------------------------------------
69 *
70 * TclFindElement --
71 *
72 * Given a pointer into a Tcl list, locate the first (or next)
73 * element in the list.
74 *
75 * Results:
76 * The return value is normally TCL_OK, which means that the
77 * element was successfully located. If TCL_ERROR is returned
78 * it means that list didn't have proper list structure;
79 * the interp's result contains a more detailed error message.
80 *
81 * If TCL_OK is returned, then *elementPtr will be set to point to the
82 * first element of list, and *nextPtr will be set to point to the
83 * character just after any white space following the last character
84 * that's part of the element. If this is the last argument in the
85 * list, then *nextPtr will point just after the last character in the
86 * list (i.e., at the character at list+listLength). If sizePtr is
87 * non-NULL, *sizePtr is filled in with the number of characters in the
88 * element. If the element is in braces, then *elementPtr will point
89 * to the character after the opening brace and *sizePtr will not
90 * include either of the braces. If there isn't an element in the list,
91 * *sizePtr will be zero, and both *elementPtr and *termPtr will point
92 * just after the last character in the list. Note: this procedure does
93 * NOT collapse backslash sequences.
94 *
95 * Side effects:
96 * None.
97 *
98 *----------------------------------------------------------------------
99 */
100
101 int
102 TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
103 bracePtr)
104 Tcl_Interp *interp; /* Interpreter to use for error reporting.
105 * If NULL, then no error message is left
106 * after errors. */
107 CONST char *list; /* Points to the first byte of a string
108 * containing a Tcl list with zero or more
109 * elements (possibly in braces). */
110 int listLength; /* Number of bytes in the list's string. */
111 CONST char **elementPtr; /* Where to put address of first significant
112 * character in first element of list. */
113 CONST char **nextPtr; /* Fill in with location of character just
114 * after all white space following end of
115 * argument (next arg or end of list). */
116 int *sizePtr; /* If non-zero, fill in with size of
117 * element. */
118 int *bracePtr; /* If non-zero, fill in with non-zero/zero
119 * to indicate that arg was/wasn't
120 * in braces. */
121 {
122 CONST char *p = list;
123 CONST char *elemStart; /* Points to first byte of first element. */
124 CONST char *limit; /* Points just after list's last byte. */
125 int openBraces = 0; /* Brace nesting level during parse. */
126 int inQuotes = 0;
127 int size = 0; /* lint. */
128 int numChars;
129 CONST char *p2;
130
131 /*
132 * Skim off leading white space and check for an opening brace or
133 * quote. We treat embedded NULLs in the list as bytes belonging to
134 * a list element.
135 */
136
137 limit = (list + listLength);
138 while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
139 p++;
140 }
141 if (p == limit) { /* no element found */
142 elemStart = limit;
143 goto done;
144 }
145
146 if (*p == '{') {
147 openBraces = 1;
148 p++;
149 } else if (*p == '"') {
150 inQuotes = 1;
151 p++;
152 }
153 elemStart = p;
154 if (bracePtr != 0) {
155 *bracePtr = openBraces;
156 }
157
158 /*
159 * Find element's end (a space, close brace, or the end of the string).
160 */
161
162 while (p < limit) {
163 switch (*p) {
164
165 /*
166 * Open brace: don't treat specially unless the element is in
167 * braces. In this case, keep a nesting count.
168 */
169
170 case '{':
171 if (openBraces != 0) {
172 openBraces++;
173 }
174 break;
175
176 /*
177 * Close brace: if element is in braces, keep nesting count and
178 * quit when the last close brace is seen.
179 */
180
181 case '}':
182 if (openBraces > 1) {
183 openBraces--;
184 } else if (openBraces == 1) {
185 size = (p - elemStart);
186 p++;
187 if ((p >= limit)
188 || isspace(UCHAR(*p))) { /* INTL: ISO space. */
189 goto done;
190 }
191
192 /*
193 * Garbage after the closing brace; return an error.
194 */
195
196 if (interp != NULL) {
197 char buf[100];
198
199 p2 = p;
200 while ((p2 < limit)
201 && (!isspace(UCHAR(*p2))) /* INTL: ISO space. */
202 && (p2 < p+20)) {
203 p2++;
204 }
205 sprintf(buf,
206 "list element in braces followed by \"%.*s\" instead of space",
207 (int) (p2-p), p);
208 Tcl_SetResult(interp, buf, TCL_VOLATILE);
209 }
210 return TCL_ERROR;
211 }
212 break;
213
214 /*
215 * Backslash: skip over everything up to the end of the
216 * backslash sequence.
217 */
218
219 case '\\': {
220 Tcl_UtfBackslash(p, &numChars, NULL);
221 p += (numChars - 1);
222 break;
223 }
224
225 /*
226 * Space: ignore if element is in braces or quotes; otherwise
227 * terminate element.
228 */
229
230 case ' ':
231 case '\f':
232 case '\n':
233 case '\r':
234 case '\t':
235 case '\v':
236 if ((openBraces == 0) && !inQuotes) {
237 size = (p - elemStart);
238 goto done;
239 }
240 break;
241
242 /*
243 * Double-quote: if element is in quotes then terminate it.
244 */
245
246 case '"':
247 if (inQuotes) {
248 size = (p - elemStart);
249 p++;
250 if ((p >= limit)
251 || isspace(UCHAR(*p))) { /* INTL: ISO space */
252 goto done;
253 }
254
255 /*
256 * Garbage after the closing quote; return an error.
257 */
258
259 if (interp != NULL) {
260 char buf[100];
261
262 p2 = p;
263 while ((p2 < limit)
264 && (!isspace(UCHAR(*p2))) /* INTL: ISO space */
265 && (p2 < p+20)) {
266 p2++;
267 }
268 sprintf(buf,
269 "list element in quotes followed by \"%.*s\" %s",
270 (int) (p2-p), p, "instead of space");
271 Tcl_SetResult(interp, buf, TCL_VOLATILE);
272 }
273 return TCL_ERROR;
274 }
275 break;
276 }
277 p++;
278 }
279
280
281 /*
282 * End of list: terminate element.
283 */
284
285 if (p == limit) {
286 if (openBraces != 0) {
287 if (interp != NULL) {
288 Tcl_SetResult(interp, "unmatched open brace in list",
289 TCL_STATIC);
290 }
291 return TCL_ERROR;
292 } else if (inQuotes) {
293 if (interp != NULL) {
294 Tcl_SetResult(interp, "unmatched open quote in list",
295 TCL_STATIC);
296 }
297 return TCL_ERROR;
298 }
299 size = (p - elemStart);
300 }
301
302 done:
303 while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
304 p++;
305 }
306 *elementPtr = elemStart;
307 *nextPtr = p;
308 if (sizePtr != 0) {
309 *sizePtr = size;
310 }
311 return TCL_OK;
312 }
313
314 /*
315 *----------------------------------------------------------------------
316 *
317 * TclCopyAndCollapse --
318 *
319 * Copy a string and eliminate any backslashes that aren't in braces.
320 *
321 * Results:
322 * There is no return value. Count characters get copied from src to
323 * dst. Along the way, if backslash sequences are found outside braces,
324 * the backslashes are eliminated in the copy. After scanning count
325 * chars from source, a null character is placed at the end of dst.
326 * Returns the number of characters that got copied.
327 *
328 * Side effects:
329 * None.
330 *
331 *----------------------------------------------------------------------
332 */
333
334 int
335 TclCopyAndCollapse(count, src, dst)
336 int count; /* Number of characters to copy from src. */
337 CONST char *src; /* Copy from here... */
338 char *dst; /* ... to here. */
339 {
340 register char c;
341 int numRead;
342 int newCount = 0;
343 int backslashCount;
344
345 for (c = *src; count > 0; src++, c = *src, count--) {
346 if (c == '\\') {
347 backslashCount = Tcl_UtfBackslash(src, &numRead, dst);
348 dst += backslashCount;
349 newCount += backslashCount;
350 src += numRead-1;
351 count -= numRead-1;
352 } else {
353 *dst = c;
354 dst++;
355 newCount++;
356 }
357 }
358 *dst = 0;
359 return newCount;
360 }
361
362 /*
363 *----------------------------------------------------------------------
364 *
365 * Tcl_SplitList --
366 *
367 * Splits a list up into its constituent fields.
368 *
369 * Results
370 * The return value is normally TCL_OK, which means that
371 * the list was successfully split up. If TCL_ERROR is
372 * returned, it means that "list" didn't have proper list
373 * structure; the interp's result will contain a more detailed
374 * error message.
375 *
376 * *argvPtr will be filled in with the address of an array
377 * whose elements point to the elements of list, in order.
378 * *argcPtr will get filled in with the number of valid elements
379 * in the array. A single block of memory is dynamically allocated
380 * to hold both the argv array and a copy of the list (with
381 * backslashes and braces removed in the standard way).
382 * The caller must eventually free this memory by calling free()
383 * on *argvPtr. Note: *argvPtr and *argcPtr are only modified
384 * if the procedure returns normally.
385 *
386 * Side effects:
387 * Memory is allocated.
388 *
389 *----------------------------------------------------------------------
390 */
391
392 int
393 Tcl_SplitList(interp, list, argcPtr, argvPtr)
394 Tcl_Interp *interp; /* Interpreter to use for error reporting.
395 * If NULL, no error message is left. */
396 CONST char *list; /* Pointer to string with list structure. */
397 int *argcPtr; /* Pointer to location to fill in with
398 * the number of elements in the list. */
399 char ***argvPtr; /* Pointer to place to store pointer to
400 * array of pointers to list elements. */
401 {
402 char **argv;
403 CONST char *l;
404 char *p;
405 int length, size, i, result, elSize, brace;
406 CONST char *element;
407
408 /*
409 * Figure out how much space to allocate. There must be enough
410 * space for both the array of pointers and also for a copy of
411 * the list. To estimate the number of pointers needed, count
412 * the number of space characters in the list.
413 */
414
415 for (size = 1, l = list; *l != 0; l++) {
416 if (isspace(UCHAR(*l))) { /* INTL: ISO space. */
417 size++;
418 }
419 }
420 size++; /* Leave space for final NULL pointer. */
421 argv = (char **) ckalloc((unsigned)
422 ((size * sizeof(char *)) + (l - list) + 1));
423 length = strlen(list);
424 for (i = 0, p = ((char *) argv) + size*sizeof(char *);
425 *list != 0; i++) {
426 CONST char *prevList = list;
427
428 result = TclFindElement(interp, list, length, &element,
429 &list, &elSize, &brace);
430 length -= (list - prevList);
431 if (result != TCL_OK) {
432 ckfree((char *) argv);
433 return result;
434 }
435 if (*element == 0) {
436 break;
437 }
438 if (i >= size) {
439 ckfree((char *) argv);
440 if (interp != NULL) {
441 Tcl_SetResult(interp, "internal error in Tcl_SplitList",
442 TCL_STATIC);
443 }
444 return TCL_ERROR;
445 }
446 argv[i] = p;
447 if (brace) {
448 memcpy((VOID *) p, (VOID *) element, (size_t) elSize);
449 p += elSize;
450 *p = 0;
451 p++;
452 } else {
453 TclCopyAndCollapse(elSize, element, p);
454 p += elSize+1;
455 }
456 }
457
458 argv[i] = NULL;
459 *argvPtr = argv;
460 *argcPtr = i;
461 return TCL_OK;
462 }
463
464 /*
465 *----------------------------------------------------------------------
466 *
467 * Tcl_ScanElement --
468 *
469 * This procedure is a companion procedure to Tcl_ConvertElement.
470 * It scans a string to see what needs to be done to it (e.g. add
471 * backslashes or enclosing braces) to make the string into a
472 * valid Tcl list element.
473 *
474 * Results:
475 * The return value is an overestimate of the number of characters
476 * that will be needed by Tcl_ConvertElement to produce a valid
477 * list element from string. The word at *flagPtr is filled in
478 * with a value needed by Tcl_ConvertElement when doing the actual
479 * conversion.
480 *
481 * Side effects:
482 * None.
483 *
484 *----------------------------------------------------------------------
485 */
486
487 int
488 Tcl_ScanElement(string, flagPtr)
489 register CONST char *string; /* String to convert to list element. */
490 register int *flagPtr; /* Where to store information to guide
491 * Tcl_ConvertCountedElement. */
492 {
493 return Tcl_ScanCountedElement(string, -1, flagPtr);
494 }
495
496 /*
497 *----------------------------------------------------------------------
498 *
499 * Tcl_ScanCountedElement --
500 *
501 * This procedure is a companion procedure to
502 * Tcl_ConvertCountedElement. It scans a string to see what
503 * needs to be done to it (e.g. add backslashes or enclosing
504 * braces) to make the string into a valid Tcl list element.
505 * If length is -1, then the string is scanned up to the first
506 * null byte.
507 *
508 * Results:
509 * The return value is an overestimate of the number of characters
510 * that will be needed by Tcl_ConvertCountedElement to produce a
511 * valid list element from string. The word at *flagPtr is
512 * filled in with a value needed by Tcl_ConvertCountedElement
513 * when doing the actual conversion.
514 *
515 * Side effects:
516 * None.
517 *
518 *----------------------------------------------------------------------
519 */
520
521 int
522 Tcl_ScanCountedElement(string, length, flagPtr)
523 CONST char *string; /* String to convert to Tcl list element. */
524 int length; /* Number of bytes in string, or -1. */
525 int *flagPtr; /* Where to store information to guide
526 * Tcl_ConvertElement. */
527 {
528 int flags, nestingLevel;
529 register CONST char *p, *lastChar;
530
531 /*
532 * This procedure and Tcl_ConvertElement together do two things:
533 *
534 * 1. They produce a proper list, one that will yield back the
535 * argument strings when evaluated or when disassembled with
536 * Tcl_SplitList. This is the most important thing.
537 *
538 * 2. They try to produce legible output, which means minimizing the
539 * use of backslashes (using braces instead). However, there are
540 * some situations where backslashes must be used (e.g. an element
541 * like "{abc": the leading brace will have to be backslashed.
542 * For each element, one of three things must be done:
543 *
544 * (a) Use the element as-is (it doesn't contain any special
545 * characters). This is the most desirable option.
546 *
547 * (b) Enclose the element in braces, but leave the contents alone.
548 * This happens if the element contains embedded space, or if it
549 * contains characters with special interpretation ($, [, ;, or \),
550 * or if it starts with a brace or double-quote, or if there are
551 * no characters in the element.
552 *
553 * (c) Don't enclose the element in braces, but add backslashes to
554 * prevent special interpretation of special characters. This is a
555 * last resort used when the argument would normally fall under case
556 * (b) but contains unmatched braces. It also occurs if the last
557 * character of the argument is a backslash or if the element contains
558 * a backslash followed by newline.
559 *
560 * The procedure figures out how many bytes will be needed to store
561 * the result (actually, it overestimates). It also collects information
562 * about the element in the form of a flags word.
563 *
564 * Note: list elements produced by this procedure and
565 * Tcl_ConvertCountedElement must have the property that they can be
566 * enclosing in curly braces to make sub-lists. This means, for
567 * example, that we must not leave unmatched curly braces in the
568 * resulting list element. This property is necessary in order for
569 * procedures like Tcl_DStringStartSublist to work.
570 */
571
572 nestingLevel = 0;
573 flags = 0;
574 if (string == NULL) {
575 string = "";
576 }
577 if (length == -1) {
578 length = strlen(string);
579 }
580 lastChar = string + length;
581 p = string;
582 if ((p == lastChar) || (*p == '{') || (*p == '"')) {
583 flags |= USE_BRACES;
584 }
585 for ( ; p < lastChar; p++) {
586 switch (*p) {
587 case '{':
588 nestingLevel++;
589 break;
590 case '}':
591 nestingLevel--;
592 if (nestingLevel < 0) {
593 flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
594 }
595 break;
596 case '[':
597 case '$':
598 case ';':
599 case ' ':
600 case '\f':
601 case '\n':
602 case '\r':
603 case '\t':
604 case '\v':
605 flags |= USE_BRACES;
606 break;
607 case '\\':
608 if ((p+1 == lastChar) || (p[1] == '\n')) {
609 flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
610 } else {
611 int size;
612
613 Tcl_UtfBackslash(p, &size, NULL);
614 p += size-1;
615 flags |= USE_BRACES;
616 }
617 break;
618 }
619 }
620 if (nestingLevel != 0) {
621 flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
622 }
623 *flagPtr = flags;
624
625 /*
626 * Allow enough space to backslash every character plus leave
627 * two spaces for braces.
628 */
629
630 return 2*(p-string) + 2;
631 }
632
633 /*
634 *----------------------------------------------------------------------
635 *
636 * Tcl_ConvertElement --
637 *
638 * This is a companion procedure to Tcl_ScanElement. Given
639 * the information produced by Tcl_ScanElement, this procedure
640 * converts a string to a list element equal to that string.
641 *
642 * Results:
643 * Information is copied to *dst in the form of a list element
644 * identical to src (i.e. if Tcl_SplitList is applied to dst it
645 * will produce a string identical to src). The return value is
646 * a count of the number of characters copied (not including the
647 * terminating NULL character).
648 *
649 * Side effects:
650 * None.
651 *
652 *----------------------------------------------------------------------
653 */
654
655 int
656 Tcl_ConvertElement(src, dst, flags)
657 register CONST char *src; /* Source information for list element. */
658 register char *dst; /* Place to put list-ified element. */
659 register int flags; /* Flags produced by Tcl_ScanElement. */
660 {
661 return Tcl_ConvertCountedElement(src, -1, dst, flags);
662 }
663
664 /*
665 *----------------------------------------------------------------------
666 *
667 * Tcl_ConvertCountedElement --
668 *
669 * This is a companion procedure to Tcl_ScanCountedElement. Given
670 * the information produced by Tcl_ScanCountedElement, this
671 * procedure converts a string to a list element equal to that
672 * string.
673 *
674 * Results:
675 * Information is copied to *dst in the form of a list element
676 * identical to src (i.e. if Tcl_SplitList is applied to dst it
677 * will produce a string identical to src). The return value is
678 * a count of the number of characters copied (not including the
679 * terminating NULL character).
680 *
681 * Side effects:
682 * None.
683 *
684 *----------------------------------------------------------------------
685 */
686
687 int
688 Tcl_ConvertCountedElement(src, length, dst, flags)
689 register CONST char *src; /* Source information for list element. */
690 int length; /* Number of bytes in src, or -1. */
691 char *dst; /* Place to put list-ified element. */
692 int flags; /* Flags produced by Tcl_ScanElement. */
693 {
694 register char *p = dst;
695 register CONST char *lastChar;
696
697 /*
698 * See the comment block at the beginning of the Tcl_ScanElement
699 * code for details of how this works.
700 */
701
702 if (src && length == -1) {
703 length = strlen(src);
704 }
705 if ((src == NULL) || (length == 0)) {
706 p[0] = '{';
707 p[1] = '}';
708 p[2] = 0;
709 return 2;
710 }
711 lastChar = src + length;
712 if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
713 *p = '{';
714 p++;
715 for ( ; src != lastChar; src++, p++) {
716 *p = *src;
717 }
718 *p = '}';
719 p++;
720 } else {
721 if (*src == '{') {
722 /*
723 * Can't have a leading brace unless the whole element is
724 * enclosed in braces. Add a backslash before the brace.
725 * Furthermore, this may destroy the balance between open
726 * and close braces, so set BRACES_UNMATCHED.
727 */
728
729 p[0] = '\\';
730 p[1] = '{';
731 p += 2;
732 src++;
733 flags |= BRACES_UNMATCHED;
734 }
735 for (; src != lastChar; src++) {
736 switch (*src) {
737 case ']':
738 case '[':
739 case '$':
740 case ';':
741 case ' ':
742 case '\\':
743 case '"':
744 *p = '\\';
745 p++;
746 break;
747 case '{':
748 case '}':
749 /*
750 * It may not seem necessary to backslash braces, but
751 * it is. The reason for this is that the resulting
752 * list element may actually be an element of a sub-list
753 * enclosed in braces (e.g. if Tcl_DStringStartSublist
754 * has been invoked), so there may be a brace mismatch
755 * if the braces aren't backslashed.
756 */
757
758 if (flags & BRACES_UNMATCHED) {
759 *p = '\\';
760 p++;
761 }
762 break;
763 case '\f':
764 *p = '\\';
765 p++;
766 *p = 'f';
767 p++;
768 continue;
769 case '\n':
770 *p = '\\';
771 p++;
772 *p = 'n';
773 p++;
774 continue;
775 case '\r':
776 *p = '\\';
777 p++;
778 *p = 'r';
779 p++;
780 continue;
781 case '\t':
782 *p = '\\';
783 p++;
784 *p = 't';
785 p++;
786 continue;
787 case '\v':
788 *p = '\\';
789 p++;
790 *p = 'v';
791 p++;
792 continue;
793 }
794 *p = *src;
795 p++;
796 }
797 }
798 *p = '\0';
799 return p-dst;
800 }
801
802 /*
803 *----------------------------------------------------------------------
804 *
805 * Tcl_Merge --
806 *
807 * Given a collection of strings, merge them together into a
808 * single string that has proper Tcl list structured (i.e.
809 * Tcl_SplitList may be used to retrieve strings equal to the
810 * original elements, and Tcl_Eval will parse the string back
811 * into its original elements).
812 *
813 * Results:
814 * The return value is the address of a dynamically-allocated
815 * string containing the merged list.
816 *
817 * Side effects:
818 * None.
819 *
820 *----------------------------------------------------------------------
821 */
822
823 char *
824 Tcl_Merge(argc, argv)
825 int argc; /* How many strings to merge. */
826 char **argv; /* Array of string values. */
827 {
828 # define LOCAL_SIZE 20
829 int localFlags[LOCAL_SIZE], *flagPtr;
830 int numChars;
831 char *result;
832 char *dst;
833 int i;
834
835 /*
836 * Pass 1: estimate space, gather flags.
837 */
838
839 if (argc <= LOCAL_SIZE) {
840 flagPtr = localFlags;
841 } else {
842 flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
843 }
844 numChars = 1;
845 for (i = 0; i < argc; i++) {
846 numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
847 }
848
849 /*
850 * Pass two: copy into the result area.
851 */
852
853 result = (char *) ckalloc((unsigned) numChars);
854 dst = result;
855 for (i = 0; i < argc; i++) {
856 numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);
857 dst += numChars;
858 *dst = ' ';
859 dst++;
860 }
861 if (dst == result) {
862 *dst = 0;
863 } else {
864 dst[-1] = 0;
865 }
866
867 if (flagPtr != localFlags) {
868 ckfree((char *) flagPtr);
869 }
870 return result;
871 }
872
873 /*
874 *----------------------------------------------------------------------
875 *
876 * Tcl_Backslash --
877 *
878 * Figure out how to handle a backslash sequence.
879 *
880 * Results:
881 * The return value is the character that should be substituted
882 * in place of the backslash sequence that starts at src. If
883 * readPtr isn't NULL then it is filled in with a count of the
884 * number of characters in the backslash sequence.
885 *
886 * Side effects:
887 * None.
888 *
889 *----------------------------------------------------------------------
890 */
891
892 char
893 Tcl_Backslash(src, readPtr)
894 CONST char *src; /* Points to the backslash character of
895 * a backslash sequence. */
896 int *readPtr; /* Fill in with number of characters read
897 * from src, unless NULL. */
898 {
899 char buf[TCL_UTF_MAX];
900 Tcl_UniChar ch;
901
902 Tcl_UtfBackslash(src, readPtr, buf);
903 Tcl_UtfToUniChar(buf, &ch);
904 return (char) ch;
905 }
906
907 /*
908 *----------------------------------------------------------------------
909 *
910 * Tcl_Concat --
911 *
912 * Concatenate a set of strings into a single large string.
913 *
914 * Results:
915 * The return value is dynamically-allocated string containing
916 * a concatenation of all the strings in argv, with spaces between
917 * the original argv elements.
918 *
919 * Side effects:
920 * Memory is allocated for the result; the caller is responsible
921 * for freeing the memory.
922 *
923 *----------------------------------------------------------------------
924 */
925
926 char *
927 Tcl_Concat(argc, argv)
928 int argc; /* Number of strings to concatenate. */
929 char **argv; /* Array of strings to concatenate. */
930 {
931 int totalSize, i;
932 char *p;
933 char *result;
934
935 for (totalSize = 1, i = 0; i < argc; i++) {
936 totalSize += strlen(argv[i]) + 1;
937 }
938 result = (char *) ckalloc((unsigned) totalSize);
939 if (argc == 0) {
940 *result = '\0';
941 return result;
942 }
943 for (p = result, i = 0; i < argc; i++) {
944 char *element;
945 int length;
946
947 /*
948 * Clip white space off the front and back of the string
949 * to generate a neater result, and ignore any empty
950 * elements.
951 */
952
953 element = argv[i];
954 while (isspace(UCHAR(*element))) { /* INTL: ISO space. */
955 element++;
956 }
957 for (length = strlen(element);
958 (length > 0)
959 && (isspace(UCHAR(element[length-1]))) /* INTL: ISO space. */
960 && ((length < 2) || (element[length-2] != '\\'));
961 length--) {
962 /* Null loop body. */
963 }
964 if (length == 0) {
965 continue;
966 }
967 memcpy((VOID *) p, (VOID *) element, (size_t) length);
968 p += length;
969 *p = ' ';
970 p++;
971 }
972 if (p != result) {
973 p[-1] = 0;
974 } else {
975 *p = 0;
976 }
977 return result;
978 }
979
980 /*
981 *----------------------------------------------------------------------
982 *
983 * Tcl_ConcatObj --
984 *
985 * Concatenate the strings from a set of objects into a single string
986 * object with spaces between the original strings.
987 *
988 * Results:
989 * The return value is a new string object containing a concatenation
990 * of the strings in objv. Its ref count is zero.
991 *
992 * Side effects:
993 * A new object is created.
994 *
995 *----------------------------------------------------------------------
996 */
997
998 Tcl_Obj *
999 Tcl_ConcatObj(objc, objv)
1000 int objc; /* Number of objects to concatenate. */
1001 Tcl_Obj *CONST objv[]; /* Array of objects to concatenate. */
1002 {
1003 int allocSize, finalSize, length, elemLength, i;
1004 char *p;
1005 char *element;
1006 char *concatStr;
1007 Tcl_Obj *objPtr;
1008
1009 /*
1010 * Check first to see if all the items are of list type. If so,
1011 * we will concat them together as lists, and return a list object.
1012 * This is only valid when the lists have no current string
1013 * representation, since we don't know what the original type was.
1014 * An original string rep may have lost some whitespace info when
1015 * converted which could be important.
1016 */
1017 for (i = 0; i < objc; i++) {
1018 objPtr = objv[i];
1019 if ((objPtr->typePtr != &tclListType) || (objPtr->bytes != NULL)) {
1020 break;
1021 }
1022 }
1023 if (i == objc) {
1024 Tcl_Obj **listv;
1025 int listc;
1026
1027 objPtr = Tcl_NewListObj(0, NULL);
1028 for (i = 0; i < objc; i++) {
1029 /*
1030 * Tcl_ListObjAppendList could be used here, but this saves
1031 * us a bit of type checking (since we've already done it)
1032 * Use of INT_MAX tells us to always put the new stuff on
1033 * the end. It will be set right in Tcl_ListObjReplace.
1034 */
1035 Tcl_ListObjGetElements(NULL, objv[i], &listc, &listv);
1036 Tcl_ListObjReplace(NULL, objPtr, INT_MAX, 0, listc, listv);
1037 }
1038 return objPtr;
1039 }
1040
1041 allocSize = 0;
1042 for (i = 0; i < objc; i++) {
1043 objPtr = objv[i];
1044 element = Tcl_GetStringFromObj(objPtr, &length);
1045 if ((element != NULL) && (length > 0)) {
1046 allocSize += (length + 1);
1047 }
1048 }
1049 if (allocSize == 0) {
1050 allocSize = 1; /* enough for the NULL byte at end */
1051 }
1052
1053 /*
1054 * Allocate storage for the concatenated result. Note that allocSize
1055 * is one more than the total number of characters, and so includes
1056 * room for the terminating NULL byte.
1057 */
1058
1059 concatStr = (char *) ckalloc((unsigned) allocSize);
1060
1061 /*
1062 * Now concatenate the elements. Clip white space off the front and back
1063 * to generate a neater result, and ignore any empty elements. Also put
1064 * a null byte at the end.
1065 */
1066
1067 finalSize = 0;
1068 if (objc == 0) {
1069 *concatStr = '\0';
1070 } else {
1071 p = concatStr;
1072 for (i = 0; i < objc; i++) {
1073 objPtr = objv[i];
1074 element = Tcl_GetStringFromObj(objPtr, &elemLength);
1075 while ((elemLength > 0)
1076 && (isspace(UCHAR(*element)))) { /* INTL: ISO space. */
1077 element++;
1078 elemLength--;
1079 }
1080
1081 /*
1082 * Trim trailing white space. But, be careful not to trim
1083 * a space character if it is preceded by a backslash: in
1084 * this case it could be significant.
1085 */
1086
1087 while ((elemLength > 0)
1088 && isspace(UCHAR(element[elemLength-1])) /* INTL: ISO space. */
1089 && ((elemLength < 2) || (element[elemLength-2] != '\\'))) {
1090 elemLength--;
1091 }
1092 if (elemLength == 0) {
1093 continue; /* nothing left of this element */
1094 }
1095 memcpy((VOID *) p, (VOID *) element, (size_t) elemLength);
1096 p += elemLength;
1097 *p = ' ';
1098 p++;
1099 finalSize += (elemLength + 1);
1100 }
1101 if (p != concatStr) {
1102 p[-1] = 0;
1103 finalSize -= 1; /* we overwrote the final ' ' */
1104 } else {
1105 *p = 0;
1106 }
1107 }
1108
1109 TclNewObj(objPtr);
1110 objPtr->bytes = concatStr;
1111 objPtr->length = finalSize;
1112 return objPtr;
1113 }
1114
1115 /*
1116 *----------------------------------------------------------------------
1117 *
1118 * Tcl_StringMatch --
1119 *
1120 * See if a particular string matches a particular pattern.
1121 *
1122 * Results:
1123 * The return value is 1 if string matches pattern, and
1124 * 0 otherwise. The matching operation permits the following
1125 * special characters in the pattern: *?\[] (see the manual
1126 * entry for details on what these mean).
1127 *
1128 * Side effects:
1129 * None.
1130 *
1131 *----------------------------------------------------------------------
1132 */
1133
1134 int
1135 Tcl_StringMatch(string, pattern)
1136 CONST char *string; /* String. */
1137 CONST char *pattern; /* Pattern, which may contain special
1138 * characters. */
1139 {
1140 int p, s;
1141 CONST char *pstart = pattern;
1142
1143 while (1) {
1144 p = *pattern;
1145 s = *string;
1146
1147 /*
1148 * See if we're at the end of both the pattern and the string. If
1149 * so, we succeeded. If we're at the end of the pattern but not at
1150 * the end of the string, we failed.
1151 */
1152
1153 if (p == '\0') {
1154 if (s == '\0') {
1155 return 1;
1156 } else {
1157 return 0;
1158 }
1159 }
1160 if ((s == '\0') && (p != '*')) {
1161 return 0;
1162 }
1163
1164 /* Check for a "*" as the next pattern character. It matches
1165 * any substring. We handle this by calling ourselves
1166 * recursively for each postfix of string, until either we
1167 * match or we reach the end of the string.
1168 */
1169
1170 if (p == '*') {
1171 pattern++;
1172 if (*pattern == '\0') {
1173 return 1;
1174 }
1175 while (1) {
1176 if (Tcl_StringMatch(string, pattern)) {
1177 return 1;
1178 }
1179 if (*string == '\0') {
1180 return 0;
1181 }
1182 string++;
1183 }
1184 }
1185
1186 /* Check for a "?" as the next pattern character. It matches
1187 * any single character.
1188 */
1189
1190 if (p == '?') {
1191 Tcl_UniChar ch;
1192
1193 pattern++;
1194 string += Tcl_UtfToUniChar(string, &ch);
1195 continue;
1196 }
1197
1198 /* Check for a "[" as the next pattern character. It is followed
1199 * by a list of characters that are acceptable, or by a range
1200 * (two characters separated by "-").
1201 */
1202
1203 if (p == '[') {
1204 Tcl_UniChar ch, startChar, endChar;
1205
1206 pattern++;
1207 string += Tcl_UtfToUniChar(string, &ch);
1208
1209 while (1) {
1210 if ((*pattern == ']') || (*pattern == '\0')) {
1211 return 0;
1212 }
1213 pattern += Tcl_UtfToUniChar(pattern, &startChar);
1214 if (*pattern == '-') {
1215 pattern++;
1216 if (*pattern == '\0') {
1217 return 0;
1218 }
1219 pattern += Tcl_UtfToUniChar(pattern, &endChar);
1220 if (((startChar <= ch) && (ch <= endChar))
1221 || ((endChar <= ch) && (ch <= startChar))) {
1222 /*
1223 * Matches ranges of form [a-z] or [z-a].
1224 */
1225
1226 break;
1227 }
1228 } else if (startChar == ch) {
1229 break;
1230 }
1231 }
1232 while (*pattern != ']') {
1233 if (*pattern == '\0') {
1234 pattern = Tcl_UtfPrev(pattern, pstart);
1235 break;
1236 }
1237 pattern++;
1238 }
1239 pattern++;
1240 continue;
1241 }
1242
1243 /* If the next pattern character is '\', just strip off the '\'
1244 * so we do exact matching on the character that follows.
1245 */
1246
1247 if (p == '\\') {
1248 pattern++;
1249 p = *pattern;
1250 if (p == '\0') {
1251 return 0;
1252 }
1253 }
1254
1255 /* There's no special character. Just make sure that the next
1256 * bytes of each string match.
1257 */
1258
1259 if (s != p) {
1260 return 0;
1261 }
1262 pattern++;
1263 string++;
1264 }
1265 }
1266
1267 /*
1268 *----------------------------------------------------------------------
1269 *
1270 * Tcl_StringCaseMatch --
1271 *
1272 * See if a particular string matches a particular pattern.
1273 * Allows case insensitivity.
1274 *
1275 * Results:
1276 * The return value is 1 if string matches pattern, and
1277 * 0 otherwise. The matching operation permits the following
1278 * special characters in the pattern: *?\[] (see the manual
1279 * entry for details on what these mean).
1280 *
1281 * Side effects:
1282 * None.
1283 *
1284 *----------------------------------------------------------------------
1285 */
1286
1287 int
1288 Tcl_StringCaseMatch(string, pattern, nocase)
1289 CONST char *string; /* String. */
1290 CONST char *pattern; /* Pattern, which may contain special
1291 * characters. */
1292 int nocase; /* 0 for case sensitive, 1 for insensitive */
1293 {
1294 int p, s;
1295 CONST char *pstart = pattern;
1296 Tcl_UniChar ch1, ch2;
1297
1298 while (1) {
1299 p = *pattern;
1300 s = *string;
1301
1302 /*
1303 * See if we're at the end of both the pattern and the string. If
1304 * so, we succeeded. If we're at the end of the pattern but not at
1305 * the end of the string, we failed.
1306 */
1307
1308 if (p == '\0') {
1309 return (s == '\0');
1310 }
1311 if ((s == '\0') && (p != '*')) {
1312 return 0;
1313 }
1314
1315 /* Check for a "*" as the next pattern character. It matches
1316 * any substring. We handle this by calling ourselves
1317 * recursively for each postfix of string, until either we
1318 * match or we reach the end of the string.
1319 */
1320
1321 if (p == '*') {
1322 pattern++;
1323 if (*pattern == '\0') {
1324 return 1;
1325 }
1326 while (1) {
1327 if (Tcl_StringCaseMatch(string, pattern, nocase)) {
1328 return 1;
1329 }
1330 if (*string == '\0') {
1331 return 0;
1332 }
1333 string++;
1334 }
1335 }
1336
1337 /* Check for a "?" as the next pattern character. It matches
1338 * any single character.
1339 */
1340
1341 if (p == '?') {
1342 pattern++;
1343 string += Tcl_UtfToUniChar(string, &ch1);
1344 continue;
1345 }
1346
1347 /* Check for a "[" as the next pattern character. It is followed
1348 * by a list of characters that are acceptable, or by a range
1349 * (two characters separated by "-").
1350 */
1351
1352 if (p == '[') {
1353 Tcl_UniChar startChar, endChar;
1354
1355 pattern++;
1356 string += Tcl_UtfToUniChar(string, &ch1);
1357 if (nocase) {
1358 ch1 = Tcl_UniCharToLower(ch1);
1359 }
1360 while (1) {
1361 if ((*pattern == ']') || (*pattern == '\0')) {
1362 return 0;
1363 }
1364 pattern += Tcl_UtfToUniChar(pattern, &startChar);
1365 if (nocase) {
1366 startChar = Tcl_UniCharToLower(startChar);
1367 }
1368 if (*pattern == '-') {
1369 pattern++;
1370 if (*pattern == '\0') {
1371 return 0;
1372 }
1373 pattern += Tcl_UtfToUniChar(pattern, &endChar);
1374 if (nocase) {
1375 endChar = Tcl_UniCharToLower(endChar);
1376 }
1377 if (((startChar <= ch1) && (ch1 <= endChar))
1378 || ((endChar <= ch1) && (ch1 <= startChar))) {
1379 /*
1380 * Matches ranges of form [a-z] or [z-a].
1381 */
1382
1383 break;
1384 }
1385 } else if (startChar == ch1) {
1386 break;
1387 }
1388 }
1389 while (*pattern != ']') {
1390 if (*pattern == '\0') {
1391 pattern = Tcl_UtfPrev(pattern, pstart);
1392 break;
1393 }
1394 pattern++;
1395 }
1396 pattern++;
1397 continue;
1398 }
1399
1400 /* If the next pattern character is '\', just strip off the '\'
1401 * so we do exact matching on the character that follows.
1402 */
1403
1404 if (p == '\\') {
1405 pattern++;
1406 p = *pattern;
1407 if (p == '\0') {
1408 return 0;
1409 }
1410 }
1411
1412 /* There's no special character. Just make sure that the next
1413 * bytes of each string match.
1414 */
1415
1416 string += Tcl_UtfToUniChar(string, &ch1);
1417 pattern += Tcl_UtfToUniChar(pattern, &ch2);
1418 if (nocase) {
1419 if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
1420 return 0;
1421 }
1422 } else if (ch1 != ch2) {
1423 return 0;
1424 }
1425 }
1426 }
1427
1428 /*
1429 *----------------------------------------------------------------------
1430 *
1431 * Tcl_DStringInit --
1432 *
1433 * Initializes a dynamic string, discarding any previous contents
1434 * of the string (Tcl_DStringFree should have been called already
1435 * if the dynamic string was previously in use).
1436 *
1437 * Results:
1438 * None.
1439 *
1440 * Side effects:
1441 * The dynamic string is initialized to be empty.
1442 *
1443 *----------------------------------------------------------------------
1444 */
1445
1446 void
1447 Tcl_DStringInit(dsPtr)
1448 Tcl_DString *dsPtr; /* Pointer to structure for dynamic string. */
1449 {
1450 dsPtr->string = dsPtr->staticSpace;
1451 dsPtr->length = 0;
1452 dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1453 dsPtr->staticSpace[0] = '\0';
1454 }
1455
1456 /*
1457 *----------------------------------------------------------------------
1458 *
1459 * Tcl_DStringAppend --
1460 *
1461 * Append more characters to the current value of a dynamic string.
1462 *
1463 * Results:
1464 * The return value is a pointer to the dynamic string's new value.
1465 *
1466 * Side effects:
1467 * Length bytes from string (or all of string if length is less
1468 * than zero) are added to the current value of the string. Memory
1469 * gets reallocated if needed to accomodate the string's new size.
1470 *
1471 *----------------------------------------------------------------------
1472 */
1473
1474 char *
1475 Tcl_DStringAppend(dsPtr, string, length)
1476 Tcl_DString *dsPtr; /* Structure describing dynamic string. */
1477 CONST char *string; /* String to append. If length is -1 then
1478 * this must be null-terminated. */
1479 int length; /* Number of characters from string to
1480 * append. If < 0, then append all of string,
1481 * up to null at end. */
1482 {
1483 int newSize;
1484 char *dst;
1485 CONST char *end;
1486
1487 if (length < 0) {
1488 length = strlen(string);
1489 }
1490 newSize = length + dsPtr->length;
1491
1492 /*
1493 * Allocate a larger buffer for the string if the current one isn't
1494 * large enough. Allocate extra space in the new buffer so that there
1495 * will be room to grow before we have to allocate again.
1496 */
1497
1498 if (newSize >= dsPtr->spaceAvl) {
1499 dsPtr->spaceAvl = newSize * 2;
1500 if (dsPtr->string == dsPtr->staticSpace) {
1501 char *newString;
1502
1503 newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
1504 memcpy((VOID *) newString, (VOID *) dsPtr->string,
1505 (size_t) dsPtr->length);
1506 dsPtr->string = newString;
1507 } else {
1508 dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
1509 (size_t) dsPtr->spaceAvl);
1510 }
1511 }
1512
1513 /*
1514 * Copy the new string into the buffer at the end of the old
1515 * one.
1516 */
1517
1518 for (dst = dsPtr->string + dsPtr->length, end = string+length;
1519 string < end; string++, dst++) {
1520 *dst = *string;
1521 }
1522 *dst = '\0';
1523 dsPtr->length += length;
1524 return dsPtr->string;
1525 }
1526
1527 /*
1528 *----------------------------------------------------------------------
1529 *
1530 * Tcl_DStringAppendElement --
1531 *
1532 * Append a list element to the current value of a dynamic string.
1533 *
1534 * Results:
1535 * The return value is a pointer to the dynamic string's new value.
1536 *
1537 * Side effects:
1538 * String is reformatted as a list element and added to the current
1539 * value of the string. Memory gets reallocated if needed to
1540 * accomodate the string's new size.
1541 *
1542 *----------------------------------------------------------------------
1543 */
1544
1545 char *
1546 Tcl_DStringAppendElement(dsPtr, string)
1547 Tcl_DString *dsPtr; /* Structure describing dynamic string. */
1548 CONST char *string; /* String to append. Must be
1549 * null-terminated. */
1550 {
1551 int newSize, flags;
1552 char *dst;
1553
1554 newSize = Tcl_ScanElement(string, &flags) + dsPtr->length + 1;
1555
1556 /*
1557 * Allocate a larger buffer for the string if the current one isn't
1558 * large enough. Allocate extra space in the new buffer so that there
1559 * will be room to grow before we have to allocate again.
1560 * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
1561 * to a larger buffer, since there may be embedded NULLs in the
1562 * string in some cases.
1563 */
1564
1565 if (newSize >= dsPtr->spaceAvl) {
1566 dsPtr->spaceAvl = newSize * 2;
1567 if (dsPtr->string == dsPtr->staticSpace) {
1568 char *newString;
1569
1570 newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
1571 memcpy((VOID *) newString, (VOID *) dsPtr->string,
1572 (size_t) dsPtr->length);
1573 dsPtr->string = newString;
1574 } else {
1575 dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
1576 (size_t) dsPtr->spaceAvl);
1577 }
1578 }
1579
1580 /*
1581 * Convert the new string to a list element and copy it into the
1582 * buffer at the end, with a space, if needed.
1583 */
1584
1585 dst = dsPtr->string + dsPtr->length;
1586 if (TclNeedSpace(dsPtr->string, dst)) {
1587 *dst = ' ';
1588 dst++;
1589 dsPtr->length++;
1590 }
1591 dsPtr->length += Tcl_ConvertElement(string, dst, flags);
1592 return dsPtr->string;
1593 }
1594
1595 /*
1596 *----------------------------------------------------------------------
1597 *
1598 * Tcl_DStringSetLength --
1599 *
1600 * Change the length of a dynamic string. This can cause the
1601 * string to either grow or shrink, depending on the value of
1602 * length.
1603 *
1604 * Results:
1605 * None.
1606 *
1607 * Side effects:
1608 * The length of dsPtr is changed to length and a null byte is
1609 * stored at that position in the string. If length is larger
1610 * than the space allocated for dsPtr, then a panic occurs.
1611 *
1612 *----------------------------------------------------------------------
1613 */
1614
1615 void
1616 Tcl_DStringSetLength(dsPtr, length)
1617 Tcl_DString *dsPtr; /* Structure describing dynamic string. */
1618 int length; /* New length for dynamic string. */
1619 {
1620 int newsize;
1621
1622 if (length < 0) {
1623 length = 0;
1624 }
1625 if (length >= dsPtr->spaceAvl) {
1626 /*
1627 * There are two interesting cases here. In the first case, the user
1628 * may be trying to allocate a large buffer of a specific size. It
1629 * would be wasteful to overallocate that buffer, so we just allocate
1630 * enough for the requested size plus the trailing null byte. In the
1631 * second case, we are growing the buffer incrementally, so we need
1632 * behavior similar to Tcl_DStringAppend. The requested length will
1633 * usually be a small delta above the current spaceAvl, so we'll end up
1634 * doubling the old size. This won't grow the buffer quite as quickly,
1635 * but it should be close enough.
1636 */
1637
1638 newsize = dsPtr->spaceAvl * 2;
1639 if (length < newsize) {
1640 dsPtr->spaceAvl = newsize;
1641 } else {
1642 dsPtr->spaceAvl = length + 1;
1643 }
1644 if (dsPtr->string == dsPtr->staticSpace) {
1645 char *newString;
1646
1647 newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
1648 memcpy((VOID *) newString, (VOID *) dsPtr->string,
1649 (size_t) dsPtr->length);
1650 dsPtr->string = newString;
1651 } else {
1652 dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
1653 (size_t) dsPtr->spaceAvl);
1654 }
1655 }
1656 dsPtr->length = length;
1657 dsPtr->string[length] = 0;
1658 }
1659
1660 /*
1661 *----------------------------------------------------------------------
1662 *
1663 * Tcl_DStringFree --
1664 *
1665 * Frees up any memory allocated for the dynamic string and
1666 * reinitializes the string to an empty state.
1667 *
1668 * Results:
1669 * None.
1670 *
1671 * Side effects:
1672 * The previous contents of the dynamic string are lost, and
1673 * the new value is an empty string.
1674 *
1675 *---------------------------------------------------------------------- */
1676
1677 void
1678 Tcl_DStringFree(dsPtr)
1679 Tcl_DString *dsPtr; /* Structure describing dynamic string. */
1680 {
1681 if (dsPtr->string != dsPtr->staticSpace) {
1682 ckfree(dsPtr->string);
1683 }
1684 dsPtr->string = dsPtr->staticSpace;
1685 dsPtr->length = 0;
1686 dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1687 dsPtr->staticSpace[0] = '\0';
1688 }
1689
1690 /*
1691 *----------------------------------------------------------------------
1692 *
1693 * Tcl_DStringResult --
1694 *
1695 * This procedure moves the value of a dynamic string into an
1696 * interpreter as its string result. Afterwards, the dynamic string
1697 * is reset to an empty string.
1698 *
1699 * Results:
1700 * None.
1701 *
1702 * Side effects:
1703 * The string is "moved" to interp's result, and any existing
1704 * string result for interp is freed. dsPtr is reinitialized to
1705 * an empty string.
1706 *
1707 *----------------------------------------------------------------------
1708 */
1709
1710 void
1711 Tcl_DStringResult(interp, dsPtr)
1712 Tcl_Interp *interp; /* Interpreter whose result is to be reset. */
1713 Tcl_DString *dsPtr; /* Dynamic string that is to become the
1714 * result of interp. */
1715 {
1716 Tcl_ResetResult(interp);
1717
1718 if (dsPtr->string != dsPtr->staticSpace) {
1719 interp->result = dsPtr->string;
1720 interp->freeProc = TCL_DYNAMIC;
1721 } else if (dsPtr->length < TCL_RESULT_SIZE) {
1722 interp->result = ((Interp *) interp)->resultSpace;
1723 strcpy(interp->result, dsPtr->string);
1724 } else {
1725 Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
1726 }
1727
1728 dsPtr->string = dsPtr->staticSpace;
1729 dsPtr->length = 0;
1730 dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1731 dsPtr->staticSpace[0] = '\0';
1732 }
1733
1734 /*
1735 *----------------------------------------------------------------------
1736 *
1737 * Tcl_DStringGetResult --
1738 *
1739 * This procedure moves an interpreter's result into a dynamic string.
1740 *
1741 * Results:
1742 * None.
1743 *
1744 * Side effects:
1745 * The interpreter's string result is cleared, and the previous
1746 * contents of dsPtr are freed.
1747 *
1748 * If the string result is empty, the object result is moved to the
1749 * string result, then the object result is reset.
1750 *
1751 *----------------------------------------------------------------------
1752 */
1753
1754 void
1755 Tcl_DStringGetResult(interp, dsPtr)
1756 Tcl_Interp *interp; /* Interpreter whose result is to be reset. */
1757 Tcl_DString *dsPtr; /* Dynamic string that is to become the
1758 * result of interp. */
1759 {
1760 Interp *iPtr = (Interp *) interp;
1761
1762 if (dsPtr->string != dsPtr->staticSpace) {
1763 ckfree(dsPtr->string);
1764 }
1765
1766 /*
1767 * If the string result is empty, move the object result to the
1768 * string result, then reset the object result.
1769 */
1770
1771 if (*(iPtr->result) == 0) {
1772 Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
1773 TCL_VOLATILE);
1774 }
1775
1776 dsPtr->length = strlen(iPtr->result);
1777 if (iPtr->freeProc != NULL) {
1778 if ((iPtr->freeProc == TCL_DYNAMIC)
1779 || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
1780 dsPtr->string = iPtr->result;
1781 dsPtr->spaceAvl = dsPtr->length+1;
1782 } else {
1783 dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
1784 strcpy(dsPtr->string, iPtr->result);
1785 (*iPtr->freeProc)(iPtr->result);
1786 }
1787 dsPtr->spaceAvl = dsPtr->length+1;
1788 iPtr->freeProc = NULL;
1789 } else {
1790 if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
1791 dsPtr->string = dsPtr->staticSpace;
1792 dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1793 } else {
1794 dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));
1795 dsPtr->spaceAvl = dsPtr->length + 1;
1796 }
1797 strcpy(dsPtr->string, iPtr->result);
1798 }
1799
1800 iPtr->result = iPtr->resultSpace;
1801 iPtr->resultSpace[0] = 0;
1802 }
1803
1804 /*
1805 *----------------------------------------------------------------------
1806 *
1807 * Tcl_DStringStartSublist --
1808 *
1809 * This procedure adds the necessary information to a dynamic
1810 * string (e.g. " {" to start a sublist. Future element
1811 * appends will be in the sublist rather than the main list.
1812 *
1813 * Results:
1814 * None.
1815 *
1816 * Side effects:
1817 * Characters get added to the dynamic string.
1818 *
1819 *----------------------------------------------------------------------
1820 */
1821
1822 void
1823 Tcl_DStringStartSublist(dsPtr)
1824 Tcl_DString *dsPtr; /* Dynamic string. */
1825 {
1826 if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
1827 Tcl_DStringAppend(dsPtr, " {", -1);
1828 } else {
1829 Tcl_DStringAppend(dsPtr, "{", -1);
1830 }
1831 }
1832
1833 /*
1834 *----------------------------------------------------------------------
1835 *
1836 * Tcl_DStringEndSublist --
1837 *
1838 * This procedure adds the necessary characters to a dynamic
1839 * string to end a sublist (e.g. "}"). Future element appends
1840 * will be in the enclosing (sub)list rather than the current
1841 * sublist.
1842 *
1843 * Results:
1844 * None.
1845 *
1846 * Side effects:
1847 * None.
1848 *
1849 *----------------------------------------------------------------------
1850 */
1851
1852 void
1853 Tcl_DStringEndSublist(dsPtr)
1854 Tcl_DString *dsPtr; /* Dynamic string. */
1855 {
1856 Tcl_DStringAppend(dsPtr, "}", -1);
1857 }
1858
1859 /*
1860 *----------------------------------------------------------------------
1861 *
1862 * Tcl_PrintDouble --
1863 *
1864 * Given a floating-point value, this procedure converts it to
1865 * an ASCII string using.
1866 *
1867 * Results:
1868 * The ASCII equivalent of "value" is written at "dst". It is
1869 * written using the current precision, and it is guaranteed to
1870 * contain a decimal point or exponent, so that it looks like
1871 * a floating-point value and not an integer.
1872 *
1873 * Side effects:
1874 * None.
1875 *
1876 *----------------------------------------------------------------------
1877 */
1878
1879 void
1880 Tcl_PrintDouble(interp, value, dst)
1881 Tcl_Interp *interp; /* Interpreter whose tcl_precision
1882 * variable used to be used to control
1883 * printing. It's ignored now. */
1884 double value; /* Value to print as string. */
1885 char *dst; /* Where to store converted value;
1886 * must have at least TCL_DOUBLE_SPACE
1887 * characters. */
1888 {
1889 char *p, c;
1890 Tcl_UniChar ch;
1891
1892 Tcl_MutexLock(&precisionMutex);
1893 sprintf(dst, precisionFormat, value);
1894 Tcl_MutexUnlock(&precisionMutex);
1895
1896 /*
1897 * If the ASCII result looks like an integer, add ".0" so that it
1898 * doesn't look like an integer anymore. This prevents floating-point
1899 * values from being converted to integers unintentionally.
1900 */
1901
1902 for (p = dst; *p != 0; ) {
1903 p += Tcl_UtfToUniChar(p, &ch);
1904 c = UCHAR(ch);
1905 if ((c == '.') || isalpha(UCHAR(c))) { /* INTL: ISO only. */
1906 return;
1907 }
1908 }
1909 p[0] = '.';
1910 p[1] = '0';
1911 p[2] = 0;
1912 }
1913
1914 /*
1915 *----------------------------------------------------------------------
1916 *
1917 * TclPrecTraceProc --
1918 *
1919 * This procedure is invoked whenever the variable "tcl_precision"
1920 * is written.
1921 *
1922 * Results:
1923 * Returns NULL if all went well, or an error message if the
1924 * new value for the variable doesn't make sense.
1925 *
1926 * Side effects:
1927 * If the new value doesn't make sense then this procedure
1928 * undoes the effect of the variable modification. Otherwise
1929 * it modifies the format string that's used by Tcl_PrintDouble.
1930 *
1931 *----------------------------------------------------------------------
1932 */
1933
1934 /* ARGSUSED */
1935 char *
1936 TclPrecTraceProc(clientData, interp, name1, name2, flags)
1937 ClientData clientData; /* Not used. */
1938 Tcl_Interp *interp; /* Interpreter containing variable. */
1939 char *name1; /* Name of variable. */
1940 char *name2; /* Second part of variable name. */
1941 int flags; /* Information about what happened. */
1942 {
1943 char *value, *end;
1944 int prec;
1945
1946 /*
1947 * If the variable is unset, then recreate the trace.
1948 */
1949
1950 if (flags & TCL_TRACE_UNSETS) {
1951 if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
1952 Tcl_TraceVar2(interp, name1, name2,
1953 TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
1954 |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);
1955 }
1956 return (char *) NULL;
1957 }
1958
1959 /*
1960 * When the variable is read, reset its value from our shared
1961 * value. This is needed in case the variable was modified in
1962 * some other interpreter so that this interpreter's value is
1963 * out of date.
1964 */
1965
1966 Tcl_MutexLock(&precisionMutex);
1967
1968 if (flags & TCL_TRACE_READS) {
1969 Tcl_SetVar2(interp, name1, name2, precisionString,
1970 flags & TCL_GLOBAL_ONLY);
1971 Tcl_MutexUnlock(&precisionMutex);
1972 return (char *) NULL;
1973 }
1974
1975 /*
1976 * The variable is being written. Check the new value and disallow
1977 * it if it isn't reasonable or if this is a safe interpreter (we
1978 * don't want safe interpreters messing up the precision of other
1979 * interpreters).
1980 */
1981
1982 if (Tcl_IsSafe(interp)) {
1983 Tcl_SetVar2(interp, name1, name2, precisionString,
1984 flags & TCL_GLOBAL_ONLY);
1985 Tcl_MutexUnlock(&precisionMutex);
1986 return "can't modify precision from a safe interpreter";
1987 }
1988 value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
1989 if (value == NULL) {
1990 value = "";
1991 }
1992 prec = strtoul(value, &end, 10);
1993 if ((prec <= 0) || (prec > TCL_MAX_PREC) || (prec > 100) ||
1994 (end == value) || (*end != 0)) {
1995 Tcl_SetVar2(interp, name1, name2, precisionString,
1996 flags & TCL_GLOBAL_ONLY);
1997 Tcl_MutexUnlock(&precisionMutex);
1998 return "improper value for precision";
1999 }
2000 TclFormatInt(precisionString, prec);
2001 sprintf(precisionFormat, "%%.%dg", prec);
2002 Tcl_MutexUnlock(&precisionMutex);
2003 return (char *) NULL;
2004 }
2005
2006 /*
2007 *----------------------------------------------------------------------
2008 *
2009 * TclNeedSpace --
2010 *
2011 * This procedure checks to see whether it is appropriate to
2012 * add a space before appending a new list element to an
2013 * existing string.
2014 *
2015 * Results:
2016 * The return value is 1 if a space is appropriate, 0 otherwise.
2017 *
2018 * Side effects:
2019 * None.
2020 *
2021 *----------------------------------------------------------------------
2022 */
2023
2024 int
2025 TclNeedSpace(start, end)
2026 char *start; /* First character in string. */
2027 char *end; /* End of string (place where space will
2028 * be added, if appropriate). */
2029 {
2030 /*
2031 * A space is needed unless either
2032 * (a) we're at the start of the string, or
2033 * (b) the trailing characters of the string consist of one or more
2034 * open curly braces preceded by a space or extending back to
2035 * the beginning of the string.
2036 * (c) the trailing characters of the string consist of a space
2037 * preceded by a character other than backslash.
2038 */
2039
2040 if (end == start) {
2041 return 0;
2042 }
2043 end--;
2044 if (*end != '{') {
2045 if (isspace(UCHAR(*end)) /* INTL: ISO space. */
2046 && ((end == start) || (end[-1] != '\\'))) {
2047 return 0;
2048 }
2049 return 1;
2050 }
2051 do {
2052 if (end == start) {
2053 return 0;
2054 }
2055 end--;
2056 } while (*end == '{');
2057 if (isspace(UCHAR(*end))) { /* INTL: ISO space. */
2058 return 0;
2059 }
2060 return 1;
2061 }
2062
2063 /*
2064 *----------------------------------------------------------------------
2065 *
2066 * TclFormatInt --
2067 *
2068 * This procedure formats an integer into a sequence of decimal digit
2069 * characters in a buffer. If the integer is negative, a minus sign is
2070 * inserted at the start of the buffer. A null character is inserted at
2071 * the end of the formatted characters. It is the caller's
2072 * responsibility to ensure that enough storage is available. This
2073 * procedure has the effect of sprintf(buffer, "%d", n) but is faster.
2074 *
2075 * Results:
2076 * An integer representing the number of characters formatted, not
2077 * including the terminating \0.
2078 *
2079 * Side effects:
2080 * The formatted characters are written into the storage pointer to
2081 * by the "buffer" argument.
2082 *
2083 *----------------------------------------------------------------------
2084 */
2085
2086 int
2087 TclFormatInt(buffer, n)
2088 char *buffer; /* Points to the storage into which the
2089 * formatted characters are written. */
2090 long n; /* The integer to format. */
2091 {
2092 long intVal;
2093 int i;
2094 int numFormatted, j;
2095 char *digits = "0123456789";
2096
2097 /*
2098 * Check first whether "n" is zero.
2099 */
2100
2101 if (n == 0) {
2102 buffer[0] = '0';
2103 buffer[1] = 0;
2104 return 1;
2105 }
2106
2107 /*
2108 * Check whether "n" is the maximum negative value. This is
2109 * -2^(m-1) for an m-bit word, and has no positive equivalent;
2110 * negating it produces the same value.
2111 */
2112
2113 if (n == -n) {
2114 sprintf(buffer, "%ld", n);
2115 return strlen(buffer);
2116 }
2117
2118 /*
2119 * Generate the characters of the result backwards in the buffer.
2120 */
2121
2122 intVal = (n < 0? -n : n);
2123 i = 0;
2124 buffer[0] = '\0';
2125 do {
2126 i++;
2127 buffer[i] = digits[intVal % 10];
2128 intVal = intVal/10;
2129 } while (intVal > 0);
2130 if (n < 0) {
2131 i++;
2132 buffer[i] = '-';
2133 }
2134 numFormatted = i;
2135
2136 /*
2137 * Now reverse the characters.
2138 */
2139
2140 for (j = 0; j < i; j++, i--) {
2141 char tmp = buffer[i];
2142 buffer[i] = buffer[j];
2143 buffer[j] = tmp;
2144 }
2145 return numFormatted;
2146 }
2147
2148 /*
2149 *----------------------------------------------------------------------
2150 *
2151 * TclLooksLikeInt --
2152 *
2153 * This procedure decides whether the leading characters of a
2154 * string look like an integer or something else (such as a
2155 * floating-point number or string).
2156 *
2157 * Results:
2158 * The return value is 1 if the leading characters of p look
2159 * like a valid Tcl integer. If they look like a floating-point
2160 * number (e.g. "e01" or "2.4"), or if they don't look like a
2161 * number at all, then 0 is returned.
2162 *
2163 * Side effects:
2164 * None.
2165 *
2166 *----------------------------------------------------------------------
2167 */
2168
2169 int
2170 TclLooksLikeInt(bytes, length)
2171 register char *bytes; /* Points to first byte of the string. */
2172 int length; /* Number of bytes in the string. If < 0
2173 * bytes up to the first null byte are
2174 * considered (if they may appear in an
2175 * integer). */
2176 {
2177 register char *p, *end;
2178
2179 if (length < 0) {
2180 length = (bytes? strlen(bytes) : 0);
2181 }
2182 end = (bytes + length);
2183
2184 p = bytes;
2185 while ((p < end) && isspace(UCHAR(*p))) { /* INTL: ISO space. */
2186 p++;
2187 }
2188 if (p == end) {
2189 return 0;
2190 }
2191
2192 if ((*p == '+') || (*p == '-')) {
2193 p++;
2194 }
2195 if ((p == end) || !isdigit(UCHAR(*p))) { /* INTL: digit */
2196 return 0;
2197 }
2198 p++;
2199 while ((p < end) && isdigit(UCHAR(*p))) { /* INTL: digit */
2200 p++;
2201 }
2202 if (p == end) {
2203 return 1;
2204 }
2205 if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
2206 return 1;
2207 }
2208 return 0;
2209 }
2210
2211 /*
2212 *----------------------------------------------------------------------
2213 *
2214 * TclGetIntForIndex --
2215 *
2216 * This procedure returns an integer corresponding to the list index
2217 * held in a Tcl object. The Tcl object's value is expected to be
2218 * either an integer or a string of the form "end([+-]integer)?".
2219 *
2220 * Results:
2221 * The return value is normally TCL_OK, which means that the index was
2222 * successfully stored into the location referenced by "indexPtr". If
2223 * the Tcl object referenced by "objPtr" has the value "end", the
2224 * value stored is "endValue". If "objPtr"s values is not of the form
2225 * "end([+-]integer)?" and
2226 * can not be converted to an integer, TCL_ERROR is returned and, if
2227 * "interp" is non-NULL, an error message is left in the interpreter's
2228 * result object.
2229 *
2230 * Side effects:
2231 * The object referenced by "objPtr" might be converted to an
2232 * integer object.
2233 *
2234 *----------------------------------------------------------------------
2235 */
2236
2237 int
2238 TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
2239 Tcl_Interp *interp; /* Interpreter to use for error reporting.
2240 * If NULL, then no error message is left
2241 * after errors. */
2242 Tcl_Obj *objPtr; /* Points to an object containing either
2243 * "end" or an integer. */
2244 int endValue; /* The value to be stored at "indexPtr" if
2245 * "objPtr" holds "end". */
2246 int *indexPtr; /* Location filled in with an integer
2247 * representing an index. */
2248 {
2249 char *bytes;
2250 int length, offset;
2251
2252 if (objPtr->typePtr == &tclIntType) {
2253 *indexPtr = (int)objPtr->internalRep.longValue;
2254 return TCL_OK;
2255 }
2256
2257 bytes = Tcl_GetStringFromObj(objPtr, &length);
2258
2259 if ((*bytes != 'e') || (strncmp(bytes, "end",
2260 (size_t)((length > 3) ? 3 : length)) != 0)) {
2261 if (Tcl_GetIntFromObj(NULL, objPtr, &offset) != TCL_OK) {
2262 goto intforindex_error;
2263 }
2264 *indexPtr = offset;
2265 return TCL_OK;
2266 }
2267
2268 if (length <= 3) {
2269 *indexPtr = endValue;
2270 } else if (bytes[3] == '-') {
2271 /*
2272 * This is our limited string expression evaluator
2273 */
2274 if (Tcl_GetInt(interp, bytes+3, &offset) != TCL_OK) {
2275 return TCL_ERROR;
2276 }
2277 *indexPtr = endValue + offset;
2278 } else {
2279 intforindex_error:
2280 if ((Interp *)interp != NULL) {
2281 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2282 "bad index \"", bytes,
2283 "\": must be integer or end?-integer?", (char *) NULL);
2284 TclCheckBadOctal(interp, bytes);
2285 }
2286 return TCL_ERROR;
2287 }
2288 return TCL_OK;
2289 }
2290
2291 /*
2292 *----------------------------------------------------------------------
2293 *
2294 * TclCheckBadOctal --
2295 *
2296 * This procedure checks for a bad octal value and appends a
2297 * meaningful error to the interp's result.
2298 *
2299 * Results:
2300 * 1 if the argument was a bad octal, else 0.
2301 *
2302 * Side effects:
2303 * The interpreter's result is modified.
2304 *
2305 *----------------------------------------------------------------------
2306 */
2307
2308 int
2309 TclCheckBadOctal(interp, value)
2310 Tcl_Interp *interp; /* Interpreter to use for error reporting.
2311 * If NULL, then no error message is left
2312 * after errors. */
2313 char *value; /* String to check. */
2314 {
2315 register char *p = value;
2316
2317 /*
2318 * A frequent mistake is invalid octal values due to an unwanted
2319 * leading zero. Try to generate a meaningful error message.
2320 */
2321
2322 while (isspace(UCHAR(*p))) { /* INTL: ISO space. */
2323 p++;
2324 }
2325 if (*p == '+' || *p == '-') {
2326 p++;
2327 }
2328 if (*p == '0') {
2329 while (isdigit(UCHAR(*p))) { /* INTL: digit. */
2330 p++;
2331 }
2332 while (isspace(UCHAR(*p))) { /* INTL: ISO space. */
2333 p++;
2334 }
2335 if (*p == '\0') {
2336 /* Reached end of string */
2337 if (interp != NULL) {
2338 Tcl_AppendResult(interp, " (looks like invalid octal number)",
2339 (char *) NULL);
2340 }
2341 return 1;
2342 }
2343 }
2344 return 0;
2345 }
2346
2347 /*
2348 *----------------------------------------------------------------------
2349 *
2350 * Tcl_GetNameOfExecutable --
2351 *
2352 * This procedure simply returns a pointer to the internal full
2353 * path name of the executable file as computed by
2354 * Tcl_FindExecutable. This procedure call is the C API
2355 * equivalent to the "info nameofexecutable" command.
2356 *
2357 * Results:
2358 * A pointer to the internal string or NULL if the internal full
2359 * path name has not been computed or unknown.
2360 *
2361 * Side effects:
2362 * The object referenced by "objPtr" might be converted to an
2363 * integer object.
2364 *
2365 *----------------------------------------------------------------------
2366 */
2367
2368 CONST char *
2369 Tcl_GetNameOfExecutable()
2370 {
2371 return (tclExecutableName);
2372 }
2373
2374 /*
2375 *----------------------------------------------------------------------
2376 *
2377 * Tcl_GetCwd --
2378 *
2379 * This function replaces the library version of getcwd().
2380 *
2381 * Results:
2382 * The result is a pointer to a string specifying the current
2383 * directory, or NULL if the current directory could not be
2384 * determined. If NULL is returned, an error message is left in the
2385 * interp's result. Storage for the result string is allocated in
2386 * bufferPtr; the caller must call Tcl_DStringFree() when the result
2387 * is no longer needed.
2388 *
2389 * Side effects:
2390 * None.
2391 *
2392 *----------------------------------------------------------------------
2393 */
2394
2395 char *
2396 Tcl_GetCwd(interp, cwdPtr)
2397 Tcl_Interp *interp;
2398 Tcl_DString *cwdPtr;
2399 {
2400 return TclpGetCwd(interp, cwdPtr);
2401 }
2402
2403 /*
2404 *----------------------------------------------------------------------
2405 *
2406 * Tcl_Chdir --
2407 *
2408 * This function replaces the library version of chdir().
2409 *
2410 * Results:
2411 * See chdir() documentation.
2412 *
2413 * Side effects:
2414 * See chdir() documentation.
2415 *
2416 *----------------------------------------------------------------------
2417 */
2418
2419 int
2420 Tcl_Chdir(dirName)
2421 CONST char *dirName;
2422 {
2423 return TclpChdir(dirName);
2424 }
2425
2426 /*
2427 *----------------------------------------------------------------------
2428 *
2429 * Tcl_Access --
2430 *
2431 * This function replaces the library version of access().
2432 *
2433 * Results:
2434 * See access() documentation.
2435 *
2436 * Side effects:
2437 * See access() documentation.
2438 *
2439 *----------------------------------------------------------------------
2440 */
2441
2442 int
2443 Tcl_Access(path, mode)
2444 CONST char *path; /* Path of file to access (UTF-8). */
2445 int mode; /* Permission setting. */
2446 {
2447 return TclAccess(path, mode);
2448 }
2449
2450 /*
2451 *----------------------------------------------------------------------
2452 *
2453 * Tcl_Stat --
2454 *
2455 * This function replaces the library version of stat().
2456 *
2457 * Results:
2458 * See stat() documentation.
2459 *
2460 * Side effects:
2461 * See stat() documentation.
2462 *
2463 *----------------------------------------------------------------------
2464 */
2465
2466 int
2467 Tcl_Stat(path, bufPtr)
2468 CONST char *path; /* Path of file to stat (in UTF-8). */
2469 struct stat *bufPtr; /* Filled with results of stat call. */
2470 {
2471 return TclStat(path, bufPtr);
2472 }
2473
2474 /* End of tclutil.c */

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25