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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25