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