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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 67 - (hide annotations) (download)
Mon Oct 31 00:57:34 2016 UTC (7 years, 4 months ago) by dashley
File MIME type: text/plain
File size: 67460 byte(s)
Header and footer cleanup.
1 dashley 64 /* $Header$ */
2 dashley 25 /*
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 dashley 67 /* End of tclutil.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25