/[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 44 - (hide annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (7 years, 7 months ago) by dashley
File MIME type: text/plain
File size: 67786 byte(s)
Rename for reorganization.
1 dashley 25 /* $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