Tcl Source Code

Check-in [de06484e63]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:* generic/regc_locale.c: * generic/regcustom.h: * generic/tcl.decls: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclInt.h: * generic/tclRegexp.c: * generic/tclScan.c: * generic/tclTest.c: * generic/tclUtf.c: * win/tclWinFCmd.c: * win/tclWinFile.c: Made various Unicode utility functions public. The following functions were made public and added to the stubs table: Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsDigit, Tcl_UniCharIsLower, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: de06484e63304cd6a50b7b6b2421114990a6f389
User & Date: stanton 1999-04-02 23:44:53
Context
1999-04-02
23:45
*** empty log message *** check-in: a2a5024790 user: stanton tags: core-8-1-branch-old
23:44
* generic/regc_locale.c: * generic/regcustom.h: * generic/tcl.decls: * generic/tclCmdIL.c: * generic... check-in: de06484e63 user: stanton tags: core-8-1-branch-old
23:44
* tests/expr.test: * tests/for-old.test: * tests/for.test: * tests/foreach.test: * tests/format.test... check-in: 92c423cb2e user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/regc_locale.c.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
...
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
 *	This file is #included by regcomp.c.
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: regc_locale.c,v 1.1.2.5 1998/12/10 00:49:44 stanton Exp $
 */

/* ASCII character-name table */

static struct cname {
	char *name;
	char code;
................................................................................
	if (len == 1)
		return *startp;

	NOTE(REG_ULOCALE);

	/* search table */
	Tcl_DStringInit(&ds);
	np = TclUniCharToUtfDString(startp, (int)len, &ds);
	for (cn = cnames; cn->name != NULL; cn++)
		if (strlen(cn->name) == len && strncmp(cn->name, np, len) == 0)
			break;		/* NOTE BREAK OUT */
	Tcl_DStringFree(&ds);
	if (cn->name != NULL)
		return CHR(cn->code);

................................................................................

    /*
     * Extract the class name
     */

    len = endp - startp;
    Tcl_DStringInit(&ds);
    np = TclUniCharToUtfDString(startp, (int)len, &ds);

    /*
     * Remap lower and upper to alpha if the match is case insensitive.
     */

    if (cases && len == 5 && (strncmp("lower", np, 5) == 0
	    || strncmp("upper", np, 5) == 0)) {






|







 







|







 







|







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
...
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
 *	This file is #included by regcomp.c.
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: regc_locale.c,v 1.1.2.6 1999/04/02 23:44:53 stanton Exp $
 */

/* ASCII character-name table */

static struct cname {
	char *name;
	char code;
................................................................................
	if (len == 1)
		return *startp;

	NOTE(REG_ULOCALE);

	/* search table */
	Tcl_DStringInit(&ds);
	np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
	for (cn = cnames; cn->name != NULL; cn++)
		if (strlen(cn->name) == len && strncmp(cn->name, np, len) == 0)
			break;		/* NOTE BREAK OUT */
	Tcl_DStringFree(&ds);
	if (cn->name != NULL)
		return CHR(cn->code);

................................................................................

    /*
     * Extract the class name
     */

    len = endp - startp;
    Tcl_DStringInit(&ds);
    np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);

    /*
     * Remap lower and upper to alpha if the match is case insensitive.
     */

    if (cases && len == 5 && (strncmp("lower", np, 5) == 0
	    || strncmp("upper", np, 5) == 0)) {

Changes to generic/regcustom.h.

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
#define	CHR(c)	(UCHAR(c))	/* turn char literal into chr literal */
#define	DIGITVAL(c)	((c)-'0')	/* turn chr digit into its value */
#define	CHRBITS	16		/* bits in a chr; must not use sizeof */
#define	CHR_MIN	0x0000		/* smallest and largest chr; the value */
#define	CHR_MAX	0xffff		/*  CHR_MAX-CHR_MIN+1 should fit in uchr */

/* functions operating on chr */
#define	iscalnum(x)	TclUniCharIsAlnum(x)
#define	iscalpha(x)	TclUniCharIsAlpha(x)
#define	iscdigit(x)	TclUniCharIsDigit(x)
#define	iscspace(x)	TclUniCharIsSpace(x)

/* name the external functions */
#define	compile		TclReComp
#define	exec		TclReExec

/* enable/disable debugging code (by whether REG_DEBUG is defined or not) */
#ifdef notdef
#define	REG_DEBUG	/* */
#endif

/* and pick up the standard header */
#include "regex.h"






|
|
|
|












63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
#define	CHR(c)	(UCHAR(c))	/* turn char literal into chr literal */
#define	DIGITVAL(c)	((c)-'0')	/* turn chr digit into its value */
#define	CHRBITS	16		/* bits in a chr; must not use sizeof */
#define	CHR_MIN	0x0000		/* smallest and largest chr; the value */
#define	CHR_MAX	0xffff		/*  CHR_MAX-CHR_MIN+1 should fit in uchr */

/* functions operating on chr */
#define	iscalnum(x)	Tcl_UniCharIsAlnum(x)
#define	iscalpha(x)	Tcl_UniCharIsAlpha(x)
#define	iscdigit(x)	Tcl_UniCharIsDigit(x)
#define	iscspace(x)	Tcl_UniCharIsSpace(x)

/* name the external functions */
#define	compile		TclReComp
#define	exec		TclReExec

/* enable/disable debugging code (by whether REG_DEBUG is defined or not) */
#ifdef notdef
#define	REG_DEBUG	/* */
#endif

/* and pick up the standard header */
#include "regex.h"

Changes to generic/tcl.decls.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
1170
1171
1172
1173
1174
1175
1176



































1177
1178
1179
1180
1181
1182
1183
#	tclStub.c, and tclPlatStub.c files.
#	
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tcl.decls,v 1.3.2.12 1999/04/01 21:58:17 stanton Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private
................................................................................
}
declare 343 generic {
    void Tcl_AlertNotifier(ClientData clientData)
}
declare 344 generic {
    void Tcl_ServiceModeHook(int mode)
}




































##############################################################################

# Define the platform specific public Tcl interface.  These functions are
# only available on the designated platform.

interface tclPlat






|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
#	tclStub.c, and tclPlatStub.c files.
#	
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tcl.decls,v 1.3.2.13 1999/04/02 23:44:53 stanton Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private
................................................................................
}
declare 343 generic {
    void Tcl_AlertNotifier(ClientData clientData)
}
declare 344 generic {
    void Tcl_ServiceModeHook(int mode)
}
declare 345 generic {
    int Tcl_UniCharIsAlnum(int ch)
}
declare 346 generic {
    int Tcl_UniCharIsAlpha(int ch)
}
declare 347 generic {
    int Tcl_UniCharIsDigit(int ch)
}
declare 348 generic {
    int Tcl_UniCharIsLower(int ch)
}
declare 349 generic {
    int Tcl_UniCharIsSpace(int ch)
}
declare 350 generic {
    int Tcl_UniCharIsUpper(int ch)
}
declare 351 generic {
    int Tcl_UniCharIsWordChar(int ch)
}
declare 352 generic {
    int Tcl_UniCharLen(Tcl_UniChar *str)
}
declare 353 generic {
    int Tcl_UniCharNcmp(const Tcl_UniChar *cs, const Tcl_UniChar *ct, size_t n)
}
declare 354 generic {
    char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *string, int numChars, \
 	    Tcl_DString *dsPtr)
}
declare 355 generic {
    Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *string, int length, \
	    Tcl_DString *dsPtr)
}

##############################################################################

# Define the platform specific public Tcl interface.  These functions are
# only available on the designated platform.

interface tclPlat

Changes to generic/tclCmdIL.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
....
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdIL.c,v 1.1.2.10 1999/03/26 22:39:52 rjohnson Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
#include "tclRegexp.h"

................................................................................
	} else {
	    diff = UCHAR(*left) - UCHAR(*right);
	    break;
	}

        diff = uniLeft - uniRight;
        if (diff) {
	    if (TclUniCharIsUpper(uniLeft) &&
		    TclUniCharIsLower(uniRight)) {
		diff = Tcl_UniCharToLower(uniLeft) - uniRight;
		if (diff) {
		    return diff;
                } else if (secondaryDiff == 0) {
		    secondaryDiff = -1;
                }
	    } else if (TclUniCharIsUpper(uniRight)
		    && TclUniCharIsLower(uniLeft)) {
                diff = uniLeft - Tcl_UniCharToLower(uniRight);
                if (diff) {
		    return diff;
                } else if (secondaryDiff == 0) {
		    secondaryDiff = 1;
                }
            } else {






|







 







|
|






|
|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
....
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdIL.c,v 1.1.2.11 1999/04/02 23:44:54 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
#include "tclRegexp.h"

................................................................................
	} else {
	    diff = UCHAR(*left) - UCHAR(*right);
	    break;
	}

        diff = uniLeft - uniRight;
        if (diff) {
	    if (Tcl_UniCharIsUpper(uniLeft) &&
		    Tcl_UniCharIsLower(uniRight)) {
		diff = Tcl_UniCharToLower(uniLeft) - uniRight;
		if (diff) {
		    return diff;
                } else if (secondaryDiff == 0) {
		    secondaryDiff = -1;
                }
	    } else if (Tcl_UniCharIsUpper(uniRight)
		    && Tcl_UniCharIsLower(uniLeft)) {
                diff = uniLeft - Tcl_UniCharToLower(uniRight);
                if (diff) {
		    return diff;
                } else if (secondaryDiff == 0) {
		    secondaryDiff = 1;
                }
            } else {

Changes to generic/tclCmdMZ.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
...
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
...
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
...
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
...
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
...
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
....
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
....
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdMZ.c,v 1.1.2.9 1999/02/01 21:29:50 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
#include "tclRegexp.h"

................................................................................

    result = TCL_OK;
    string = Tcl_GetStringFromObj(objv[1], &stringLength);

    Tcl_DStringInit(&valueBuffer);
    
    Tcl_DStringInit(&stringBuffer);
    wStart = TclUtfToUniCharDString(string, stringLength, &stringBuffer);
    wLen = Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);

    match = TclRegExpExecUniChar(interp, regExpr, wStart, wLen, objc-2, eflags);
    if (match < 0) {
	result = TCL_ERROR;
	goto done;
    }
................................................................................
	} else {
	    if (indices) {
		char info[TCL_INTEGER_SPACE * 2];
		
		sprintf(info, "%d %d", start, end - 1);
		value = Tcl_SetVar(interp, varName, info, 0);
	    } else {
		value = TclUniCharToUtfDString(wStart + start, end - start,
			&valueBuffer);
		value = Tcl_SetVar(interp, varName, value, 0);
		Tcl_DStringSetLength(&valueBuffer, 0);
	    }
	}
	if (value == NULL) {
	    Tcl_AppendResult(interp, "couldn't set variable \"",
................................................................................
     * The following loop is to handle multiple matches within the
     * same source string;  each iteration handles one match and its
     * corresponding substitution.  If "-all" hasn't been specified
     * then the loop body only gets executed once.
     */

    Tcl_DStringInit(&stringBuffer);
    wStart = TclUtfToUniCharDString(string, stringLength, &stringBuffer);
    wEnd = wStart + Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);

    numMatches = 0;
    for (w = wStart; w < wEnd; ) {
	int start, end, subStart, subEnd, match;
	char *src, *firstChar;
	char c;
................................................................................

	/*
	 * Copy the portion of the source string before the match to the
	 * result variable.
	 */

	TclRegExpRangeUniChar(regExpr, 0, &start, &end);
	TclUniCharToUtfDString(w, start, &resultBuffer);
    
	/*
	 * Append the subSpec argument to the variable, making appropriate
	 * substitutions.  This code is a bit hairy because of the backslash
	 * conventions and because the code saves up ranges of characters in
	 * subSpec to reduce the number of calls to Tcl_SetVar.
	 */
................................................................................
		continue;
	    }
	    if (firstChar != src) {
		Tcl_DStringAppend(&resultBuffer, firstChar, src - firstChar);
	    }
	    TclRegExpRangeUniChar(regExpr, index, &subStart, &subEnd);
	    if ((subStart >= 0) && (subEnd >= 0)) {
		TclUniCharToUtfDString(w + subStart, subEnd - subStart,
			&resultBuffer);
	    }
	    if (*src == '\\') {
		src++;
	    }
	    firstChar = src + 1;
	}
................................................................................
	}
	if (end == 0) {
	    /*
	     * Always consume at least one character of the input string
	     * in order to prevent infinite loops.
	     */

	    TclUniCharToUtfDString(w, 1, &resultBuffer);
	    w++;
	}
	w += end;
	if (!all) {
	    break;
	}
    }
................................................................................

    /*
     * Copy the portion of the source string after the last match to the
     * result variable.
     */

    if ((w < wEnd) || (numMatches == 0)) {
	TclUniCharToUtfDString(w, wEnd - w, &resultBuffer);
    }
    if (Tcl_SetVar(interp, varname, Tcl_DStringValue(&resultBuffer),
	    0) == NULL) {
	Tcl_AppendResult(interp, "couldn't set variable \"", varname, "\"",
		(char *) NULL);
	result = TCL_ERROR;
    } else {
................................................................................
	    }
	    numChars = Tcl_NumUtfChars(string1, length1);
	    if (index < numChars) {
		p = Tcl_UtfAtIndex(string1, index);
		end = string1+length1;
		for (cur = index; p < end; cur++) {
		    p += Tcl_UtfToUniChar(p, &ch);
		    if (!TclUniCharIsWordChar(ch)) {
			break;
		    }
		}
		if (cur == index) {
		    cur++;
		}
	    } else {
................................................................................
		index = numChars - 1;
	    }
	    cur = 0;
	    if (index > 0) {
		p = Tcl_UtfAtIndex(string1, index);
	        for (cur = index; cur >= 0; cur--) {
		    Tcl_UtfToUniChar(p, &ch);
		    if (!TclUniCharIsWordChar(ch)) {
			break;
		    }
		    p = Tcl_UtfPrev(p, string1);
		}
		if (cur != index) {
		    cur += 1;
		}






|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
...
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
...
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
...
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
...
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
...
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
....
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
....
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdMZ.c,v 1.1.2.10 1999/04/02 23:44:55 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
#include "tclRegexp.h"

................................................................................

    result = TCL_OK;
    string = Tcl_GetStringFromObj(objv[1], &stringLength);

    Tcl_DStringInit(&valueBuffer);
    
    Tcl_DStringInit(&stringBuffer);
    wStart = Tcl_UtfToUniCharDString(string, stringLength, &stringBuffer);
    wLen = Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);

    match = TclRegExpExecUniChar(interp, regExpr, wStart, wLen, objc-2, eflags);
    if (match < 0) {
	result = TCL_ERROR;
	goto done;
    }
................................................................................
	} else {
	    if (indices) {
		char info[TCL_INTEGER_SPACE * 2];
		
		sprintf(info, "%d %d", start, end - 1);
		value = Tcl_SetVar(interp, varName, info, 0);
	    } else {
		value = Tcl_UniCharToUtfDString(wStart + start, end - start,
			&valueBuffer);
		value = Tcl_SetVar(interp, varName, value, 0);
		Tcl_DStringSetLength(&valueBuffer, 0);
	    }
	}
	if (value == NULL) {
	    Tcl_AppendResult(interp, "couldn't set variable \"",
................................................................................
     * The following loop is to handle multiple matches within the
     * same source string;  each iteration handles one match and its
     * corresponding substitution.  If "-all" hasn't been specified
     * then the loop body only gets executed once.
     */

    Tcl_DStringInit(&stringBuffer);
    wStart = Tcl_UtfToUniCharDString(string, stringLength, &stringBuffer);
    wEnd = wStart + Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);

    numMatches = 0;
    for (w = wStart; w < wEnd; ) {
	int start, end, subStart, subEnd, match;
	char *src, *firstChar;
	char c;
................................................................................

	/*
	 * Copy the portion of the source string before the match to the
	 * result variable.
	 */

	TclRegExpRangeUniChar(regExpr, 0, &start, &end);
	Tcl_UniCharToUtfDString(w, start, &resultBuffer);
    
	/*
	 * Append the subSpec argument to the variable, making appropriate
	 * substitutions.  This code is a bit hairy because of the backslash
	 * conventions and because the code saves up ranges of characters in
	 * subSpec to reduce the number of calls to Tcl_SetVar.
	 */
................................................................................
		continue;
	    }
	    if (firstChar != src) {
		Tcl_DStringAppend(&resultBuffer, firstChar, src - firstChar);
	    }
	    TclRegExpRangeUniChar(regExpr, index, &subStart, &subEnd);
	    if ((subStart >= 0) && (subEnd >= 0)) {
		Tcl_UniCharToUtfDString(w + subStart, subEnd - subStart,
			&resultBuffer);
	    }
	    if (*src == '\\') {
		src++;
	    }
	    firstChar = src + 1;
	}
................................................................................
	}
	if (end == 0) {
	    /*
	     * Always consume at least one character of the input string
	     * in order to prevent infinite loops.
	     */

	    Tcl_UniCharToUtfDString(w, 1, &resultBuffer);
	    w++;
	}
	w += end;
	if (!all) {
	    break;
	}
    }
................................................................................

    /*
     * Copy the portion of the source string after the last match to the
     * result variable.
     */

    if ((w < wEnd) || (numMatches == 0)) {
	Tcl_UniCharToUtfDString(w, wEnd - w, &resultBuffer);
    }
    if (Tcl_SetVar(interp, varname, Tcl_DStringValue(&resultBuffer),
	    0) == NULL) {
	Tcl_AppendResult(interp, "couldn't set variable \"", varname, "\"",
		(char *) NULL);
	result = TCL_ERROR;
    } else {
................................................................................
	    }
	    numChars = Tcl_NumUtfChars(string1, length1);
	    if (index < numChars) {
		p = Tcl_UtfAtIndex(string1, index);
		end = string1+length1;
		for (cur = index; p < end; cur++) {
		    p += Tcl_UtfToUniChar(p, &ch);
		    if (!Tcl_UniCharIsWordChar(ch)) {
			break;
		    }
		}
		if (cur == index) {
		    cur++;
		}
	    } else {
................................................................................
		index = numChars - 1;
	    }
	    cur = 0;
	    if (index > 0) {
		p = Tcl_UtfAtIndex(string1, index);
	        for (cur = index; cur >= 0; cur--) {
		    Tcl_UtfToUniChar(p, &ch);
		    if (!Tcl_UniCharIsWordChar(ch)) {
			break;
		    }
		    p = Tcl_UtfPrev(p, string1);
		}
		if (cur != index) {
		    cur += 1;
		}

Changes to generic/tclDecls.h.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
1048
1049
1050
1051
1052
1053
1054



























1055
1056
1057
1058
1059
1060
1061
....
1428
1429
1430
1431
1432
1433
1434











1435
1436
1437
1438
1439
1440
1441
....
2806
2807
2808
2809
2810
2811
2812












































2813
2814
2815
2816
2817
2818
2819
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclDecls.h,v 1.3.2.13 1999/04/01 21:52:55 redman Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
................................................................................
EXTERN char *		Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
/* 342 */
EXTERN void		Tcl_SetDefaultEncodingDir _ANSI_ARGS_((char * path));
/* 343 */
EXTERN void		Tcl_AlertNotifier _ANSI_ARGS_((ClientData clientData));
/* 344 */
EXTERN void		Tcl_ServiceModeHook _ANSI_ARGS_((int mode));




























typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
    struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 338 */
    int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 339 */
    char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 340 */
    char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */
    void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((char * path)); /* 342 */
    void (*tcl_AlertNotifier) _ANSI_ARGS_((ClientData clientData)); /* 343 */
    void (*tcl_ServiceModeHook) _ANSI_ARGS_((int mode)); /* 344 */











} TclStubs;

extern TclStubs *tclStubsPtr;

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

/*
................................................................................
#define Tcl_AlertNotifier \
	(tclStubsPtr->tcl_AlertNotifier) /* 343 */
#endif
#ifndef Tcl_ServiceModeHook
#define Tcl_ServiceModeHook \
	(tclStubsPtr->tcl_ServiceModeHook) /* 344 */
#endif













































#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLDECLS */







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
....
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
....
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclDecls.h,v 1.3.2.14 1999/04/02 23:44:55 stanton Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
................................................................................
EXTERN char *		Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
/* 342 */
EXTERN void		Tcl_SetDefaultEncodingDir _ANSI_ARGS_((char * path));
/* 343 */
EXTERN void		Tcl_AlertNotifier _ANSI_ARGS_((ClientData clientData));
/* 344 */
EXTERN void		Tcl_ServiceModeHook _ANSI_ARGS_((int mode));
/* 345 */
EXTERN int		Tcl_UniCharIsAlnum _ANSI_ARGS_((int ch));
/* 346 */
EXTERN int		Tcl_UniCharIsAlpha _ANSI_ARGS_((int ch));
/* 347 */
EXTERN int		Tcl_UniCharIsDigit _ANSI_ARGS_((int ch));
/* 348 */
EXTERN int		Tcl_UniCharIsLower _ANSI_ARGS_((int ch));
/* 349 */
EXTERN int		Tcl_UniCharIsSpace _ANSI_ARGS_((int ch));
/* 350 */
EXTERN int		Tcl_UniCharIsUpper _ANSI_ARGS_((int ch));
/* 351 */
EXTERN int		Tcl_UniCharIsWordChar _ANSI_ARGS_((int ch));
/* 352 */
EXTERN int		Tcl_UniCharLen _ANSI_ARGS_((Tcl_UniChar * str));
/* 353 */
EXTERN int		Tcl_UniCharNcmp _ANSI_ARGS_((const Tcl_UniChar * cs, 
				const Tcl_UniChar * ct, size_t n));
/* 354 */
EXTERN char *		Tcl_UniCharToUtfDString _ANSI_ARGS_((
				CONST Tcl_UniChar * string, int numChars, 
				Tcl_DString * dsPtr));
/* 355 */
EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString _ANSI_ARGS_((
				CONST char * string, int length, 
				Tcl_DString * dsPtr));

typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
    struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 338 */
    int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 339 */
    char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 340 */
    char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */
    void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((char * path)); /* 342 */
    void (*tcl_AlertNotifier) _ANSI_ARGS_((ClientData clientData)); /* 343 */
    void (*tcl_ServiceModeHook) _ANSI_ARGS_((int mode)); /* 344 */
    int (*tcl_UniCharIsAlnum) _ANSI_ARGS_((int ch)); /* 345 */
    int (*tcl_UniCharIsAlpha) _ANSI_ARGS_((int ch)); /* 346 */
    int (*tcl_UniCharIsDigit) _ANSI_ARGS_((int ch)); /* 347 */
    int (*tcl_UniCharIsLower) _ANSI_ARGS_((int ch)); /* 348 */
    int (*tcl_UniCharIsSpace) _ANSI_ARGS_((int ch)); /* 349 */
    int (*tcl_UniCharIsUpper) _ANSI_ARGS_((int ch)); /* 350 */
    int (*tcl_UniCharIsWordChar) _ANSI_ARGS_((int ch)); /* 351 */
    int (*tcl_UniCharLen) _ANSI_ARGS_((Tcl_UniChar * str)); /* 352 */
    int (*tcl_UniCharNcmp) _ANSI_ARGS_((const Tcl_UniChar * cs, const Tcl_UniChar * ct, size_t n)); /* 353 */
    char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar * string, int numChars, Tcl_DString * dsPtr)); /* 354 */
    Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char * string, int length, Tcl_DString * dsPtr)); /* 355 */
} TclStubs;

extern TclStubs *tclStubsPtr;

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

/*
................................................................................
#define Tcl_AlertNotifier \
	(tclStubsPtr->tcl_AlertNotifier) /* 343 */
#endif
#ifndef Tcl_ServiceModeHook
#define Tcl_ServiceModeHook \
	(tclStubsPtr->tcl_ServiceModeHook) /* 344 */
#endif
#ifndef Tcl_UniCharIsAlnum
#define Tcl_UniCharIsAlnum \
	(tclStubsPtr->tcl_UniCharIsAlnum) /* 345 */
#endif
#ifndef Tcl_UniCharIsAlpha
#define Tcl_UniCharIsAlpha \
	(tclStubsPtr->tcl_UniCharIsAlpha) /* 346 */
#endif
#ifndef Tcl_UniCharIsDigit
#define Tcl_UniCharIsDigit \
	(tclStubsPtr->tcl_UniCharIsDigit) /* 347 */
#endif
#ifndef Tcl_UniCharIsLower
#define Tcl_UniCharIsLower \
	(tclStubsPtr->tcl_UniCharIsLower) /* 348 */
#endif
#ifndef Tcl_UniCharIsSpace
#define Tcl_UniCharIsSpace \
	(tclStubsPtr->tcl_UniCharIsSpace) /* 349 */
#endif
#ifndef Tcl_UniCharIsUpper
#define Tcl_UniCharIsUpper \
	(tclStubsPtr->tcl_UniCharIsUpper) /* 350 */
#endif
#ifndef Tcl_UniCharIsWordChar
#define Tcl_UniCharIsWordChar \
	(tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */
#endif
#ifndef Tcl_UniCharLen
#define Tcl_UniCharLen \
	(tclStubsPtr->tcl_UniCharLen) /* 352 */
#endif
#ifndef Tcl_UniCharNcmp
#define Tcl_UniCharNcmp \
	(tclStubsPtr->tcl_UniCharNcmp) /* 353 */
#endif
#ifndef Tcl_UniCharToUtfDString
#define Tcl_UniCharToUtfDString \
	(tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */
#endif
#ifndef Tcl_UtfToUniCharDString
#define Tcl_UtfToUniCharDString \
	(tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLDECLS */

Changes to generic/tclInt.h.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclInt.h,v 1.1.2.17 1999/04/01 21:58:17 stanton Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Common include files needed by most of the Tcl source files are
................................................................................
EXTERN int		TclTestChannelCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		TclTestChannelEventCmd _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    int argc, char **argv));
EXTERN void		TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp,
			    int result, Tcl_Interp *targetInterp));
EXTERN int		TclUniCharIsAlnum _ANSI_ARGS_((int ch));
EXTERN int		TclUniCharIsAlpha _ANSI_ARGS_((int ch));
EXTERN int		TclUniCharIsDigit _ANSI_ARGS_((int ch));
EXTERN int		TclUniCharIsLower _ANSI_ARGS_((int ch));
EXTERN int		TclUniCharIsSpace _ANSI_ARGS_((int ch));
EXTERN int		TclUniCharIsUpper _ANSI_ARGS_((int ch));
EXTERN int		TclUniCharIsWordChar _ANSI_ARGS_((int ch));
EXTERN int		TclUniCharLen _ANSI_ARGS_((Tcl_UniChar *str));
EXTERN int		TclUniCharNcmp _ANSI_ARGS_((const Tcl_UniChar *cs,
	const Tcl_UniChar *ct, size_t n));
EXTERN int		TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
char *			TclUniCharToUtfDString _ANSI_ARGS_((
			    CONST Tcl_UniChar *string, int numChars,
			    Tcl_DString *dsPtr));
Tcl_UniChar *		TclUtfToUniCharDString _ANSI_ARGS_((CONST char *string,
			    int length, Tcl_DString *dsPtr));

/*
 *----------------------------------------------------------------
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */







|







 







<
<
<
<
<
<
<
<
<
<

<
<
<
<
<







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
2006
2007
2008
2009
2010
2011
2012










2013





2014
2015
2016
2017
2018
2019
2020
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclInt.h,v 1.1.2.18 1999/04/02 23:44:56 stanton Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Common include files needed by most of the Tcl source files are
................................................................................
EXTERN int		TclTestChannelCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		TclTestChannelEventCmd _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    int argc, char **argv));
EXTERN void		TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp,
			    int result, Tcl_Interp *targetInterp));










EXTERN int		TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));






/*
 *----------------------------------------------------------------
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */

Changes to generic/tclRegexp.c.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
...
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclRegexp.c,v 1.1.2.6 1998/11/17 21:38:39 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

/*
................................................................................
     * Remember the UTF-8 string so Tcl_RegExpRange() can convert the
     * matches from character to byte offsets.
     */

    regexpPtr->string = string;

    Tcl_DStringInit(&stringBuffer);
    uniString = TclUtfToUniCharDString(string, -1, &stringBuffer);
    numChars = Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);

    /*
     * Perform the regexp match.
     */

    result = TclRegExpExecUniChar(interp, re, uniString, numChars, -1,
................................................................................
    regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));

    /*
     * Get the up-to-date string representation and map to unicode.
     */

    Tcl_DStringInit(&stringBuf);
    uniString = TclUtfToUniCharDString(string, length, &stringBuf);
    numChars = Tcl_DStringLength(&stringBuf) / sizeof(Tcl_UniChar);

    /*
     * Compile the string and check for errors.
     */

    regexpPtr->flags = flags;






|







 







|







 







|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
...
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclRegexp.c,v 1.1.2.7 1999/04/02 23:44:57 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

/*
................................................................................
     * Remember the UTF-8 string so Tcl_RegExpRange() can convert the
     * matches from character to byte offsets.
     */

    regexpPtr->string = string;

    Tcl_DStringInit(&stringBuffer);
    uniString = Tcl_UtfToUniCharDString(string, -1, &stringBuffer);
    numChars = Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);

    /*
     * Perform the regexp match.
     */

    result = TclRegExpExecUniChar(interp, re, uniString, numChars, -1,
................................................................................
    regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));

    /*
     * Get the up-to-date string representation and map to unicode.
     */

    Tcl_DStringInit(&stringBuf);
    uniString = Tcl_UtfToUniCharDString(string, length, &stringBuf);
    numChars = Tcl_DStringLength(&stringBuf) / sizeof(Tcl_UniChar);

    /*
     * Compile the string and check for errors.
     */

    regexpPtr->flags = flags;

Changes to generic/tclScan.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
...
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
...
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
 *	This file contains the implementation of the "scan" command.
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclScan.c,v 1.1.2.3 1999/02/10 23:31:19 stanton Exp $
 */

#include "tclInt.h"

/*
 * Flag values used by Tcl_ScanObjCmd.
 */
................................................................................

	flags = 0;

	/*
	 * If we see whitespace in the format, skip whitespace in the string.
	 */

	if (TclUniCharIsSpace(ch)) {
	    offset = Tcl_UtfToUniChar(string, &sch);
	    while (TclUniCharIsSpace(sch)) {
		if (*string == '\0') {
		    goto done;
		}
		string += offset;
		offset = Tcl_UtfToUniChar(string, &sch);
	    }
	    continue;
................................................................................
	 * Skip any leading whitespace at the beginning of a field unless
	 * the format suppresses this behavior.
	 */

	if (!(flags & SCAN_NOSKIP)) {
	    while (*string != '\0') {
		offset = Tcl_UtfToUniChar(string, &sch);
		if (!TclUniCharIsSpace(sch)) {
		    break;
		}
		string += offset;
	    }
	    if (*string == '\0') {
		underflow = 1;
		goto done;
................................................................................

		if (width == 0) {
		    width = (size_t) ~0;
		}
		end = string;
		while (*end != '\0') {
		    offset = Tcl_UtfToUniChar(end, &sch);
		    if (TclUniCharIsSpace(sch)) {
			break;
		    }
		    end += offset;
		    if (--width == 0) {
			break;
		    }
		}






|







 







|

|







 







|







 







|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
...
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
...
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
 *	This file contains the implementation of the "scan" command.
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclScan.c,v 1.1.2.4 1999/04/02 23:44:57 stanton Exp $
 */

#include "tclInt.h"

/*
 * Flag values used by Tcl_ScanObjCmd.
 */
................................................................................

	flags = 0;

	/*
	 * If we see whitespace in the format, skip whitespace in the string.
	 */

	if (Tcl_UniCharIsSpace(ch)) {
	    offset = Tcl_UtfToUniChar(string, &sch);
	    while (Tcl_UniCharIsSpace(sch)) {
		if (*string == '\0') {
		    goto done;
		}
		string += offset;
		offset = Tcl_UtfToUniChar(string, &sch);
	    }
	    continue;
................................................................................
	 * Skip any leading whitespace at the beginning of a field unless
	 * the format suppresses this behavior.
	 */

	if (!(flags & SCAN_NOSKIP)) {
	    while (*string != '\0') {
		offset = Tcl_UtfToUniChar(string, &sch);
		if (!Tcl_UniCharIsSpace(sch)) {
		    break;
		}
		string += offset;
	    }
	    if (*string == '\0') {
		underflow = 1;
		goto done;
................................................................................

		if (width == 0) {
		    width = (size_t) ~0;
		}
		end = string;
		while (*end != '\0') {
		    offset = Tcl_UtfToUniChar(end, &sch);
		    if (Tcl_UniCharIsSpace(sch)) {
			break;
		    }
		    end += offset;
		    if (--width == 0) {
			break;
		    }
		}

Changes to generic/tclStubInit.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
410
411
412
413
414
415
416











417
418
419
420
421
422
423
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.3.2.9 1999/04/01 21:58:19 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Remove macros that will interfere with the definitions below.
................................................................................
    Tcl_WriteChars, /* 338 */
    Tcl_WriteObj, /* 339 */
    Tcl_GetString, /* 340 */
    Tcl_GetDefaultEncodingDir, /* 341 */
    Tcl_SetDefaultEncodingDir, /* 342 */
    Tcl_AlertNotifier, /* 343 */
    Tcl_ServiceModeHook, /* 344 */











};

TclIntStubs tclIntStubs = {
    TCL_STUB_MAGIC,
    NULL,
    TclAccess, /* 0 */
    TclAccessDeleteProc, /* 1 */






|







 







>
>
>
>
>
>
>
>
>
>
>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.3.2.10 1999/04/02 23:44:57 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Remove macros that will interfere with the definitions below.
................................................................................
    Tcl_WriteChars, /* 338 */
    Tcl_WriteObj, /* 339 */
    Tcl_GetString, /* 340 */
    Tcl_GetDefaultEncodingDir, /* 341 */
    Tcl_SetDefaultEncodingDir, /* 342 */
    Tcl_AlertNotifier, /* 343 */
    Tcl_ServiceModeHook, /* 344 */
    Tcl_UniCharIsAlnum, /* 345 */
    Tcl_UniCharIsAlpha, /* 346 */
    Tcl_UniCharIsDigit, /* 347 */
    Tcl_UniCharIsLower, /* 348 */
    Tcl_UniCharIsSpace, /* 349 */
    Tcl_UniCharIsUpper, /* 350 */
    Tcl_UniCharIsWordChar, /* 351 */
    Tcl_UniCharLen, /* 352 */
    Tcl_UniCharNcmp, /* 353 */
    Tcl_UniCharToUtfDString, /* 354 */
    Tcl_UtfToUniCharDString, /* 355 */
};

TclIntStubs tclIntStubs = {
    TCL_STUB_MAGIC,
    NULL,
    TclAccess, /* 0 */
    TclAccessDeleteProc, /* 1 */

Changes to generic/tclTest.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
....
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
 *
 * Copyright (c) 1993-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTest.c,v 1.1.2.13 1999/03/10 06:49:23 stanton Exp $
 */

#define TCL_TEST

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"
................................................................................

    result = TCL_OK;
    string = Tcl_GetStringFromObj(objv[1], &stringLength);

    Tcl_DStringInit(&valueBuffer);
    
    Tcl_DStringInit(&stringBuffer);
    wStart = TclUtfToUniCharDString(string, stringLength, &stringBuffer);
    wLen = Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);

    match = TclRegExpExecUniChar(interp, regExpr, wStart, wLen, objc-2, eflags);
    if (match < 0) {
	result = TCL_ERROR;
	goto done;
    }
................................................................................
	} else {
	    if (indices) {
		char info[TCL_INTEGER_SPACE * 2];
		
		sprintf(info, "%d %d", start, end - 1);
		value = Tcl_SetVar(interp, varName, info, 0);
	    } else {
		value = TclUniCharToUtfDString(wStart + start, end - start,
			&valueBuffer);
		value = Tcl_SetVar(interp, varName, value, 0);
		Tcl_DStringSetLength(&valueBuffer, 0);
	    }
	}
	if (value == NULL) {
	    Tcl_AppendResult(interp, "couldn't set variable \"",






|







 







|







 







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
....
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
 *
 * Copyright (c) 1993-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTest.c,v 1.1.2.14 1999/04/02 23:44:58 stanton Exp $
 */

#define TCL_TEST

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"
................................................................................

    result = TCL_OK;
    string = Tcl_GetStringFromObj(objv[1], &stringLength);

    Tcl_DStringInit(&valueBuffer);
    
    Tcl_DStringInit(&stringBuffer);
    wStart = Tcl_UtfToUniCharDString(string, stringLength, &stringBuffer);
    wLen = Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);

    match = TclRegExpExecUniChar(interp, regExpr, wStart, wLen, objc-2, eflags);
    if (match < 0) {
	result = TCL_ERROR;
	goto done;
    }
................................................................................
	} else {
	    if (indices) {
		char info[TCL_INTEGER_SPACE * 2];
		
		sprintf(info, "%d %d", start, end - 1);
		value = Tcl_SetVar(interp, varName, info, 0);
	    } else {
		value = Tcl_UniCharToUtfDString(wStart + start, end - start,
			&valueBuffer);
		value = Tcl_SetVar(interp, varName, value, 0);
		Tcl_DStringSetLength(&valueBuffer, 0);
	    }
	}
	if (value == NULL) {
	    Tcl_AppendResult(interp, "couldn't set variable \"",

Changes to generic/tclUtf.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
...
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
...
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
....
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
....
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
....
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
....
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
....
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
....
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
....
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
 *	Routines for manipulating UTF-8 strings.
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUtf.c,v 1.1.2.5 1998/11/04 04:39:53 stanton Exp $
 */

#include "tclInt.h"

/*
 * Include the static character classification tables and macros.
 */
................................................................................
    ch = 0xFFFD;
    goto three;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclUniCharToUtfDString --
 *
 *	Convert the given Unicode string to UTF-8.
 *
 * Results:
 *	The return value is a pointer to the UTF-8 representation of the
 *	Unicode string.  Storage for the return value is appended to the
 *	end of dsPtr.
................................................................................
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
char *
TclUniCharToUtfDString(wString, numChars, dsPtr)
    CONST Tcl_UniChar *wString;	/* Unicode string to convert to UTF-8. */
    int numChars;		/* Length of Unicode string in Tcl_UniChars
				 * (must be >= 0). */
    Tcl_DString *dsPtr;		/* UTF-8 representation of string is
				 * appended to this previously initialized
				 * DString. */
{
................................................................................
    *chPtr = (Tcl_UniChar) byte;
    return 1;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclUtfToUniCharDString --
 *
 *	Convert the UTF-8 string to Unicode.
 *
 * Results:
 *	The return value is a pointer to the Unicode representation of the
 *	UTF-8 string.  Storage for the return value is appended to the
 *	end of dsPtr.  The Unicode string is terminated with a Unicode
................................................................................
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_UniChar *
TclUtfToUniCharDString(string, length, dsPtr)
    CONST char *string;		/* UTF-8 string to convert to Unicode. */
    int length;			/* Length of UTF-8 string in bytes, or -1
				 * for strlen(). */
    Tcl_DString *dsPtr;		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
................................................................................
	return ch;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclUniCharLen --
 *
 *	Find the length of a UniChar string.  The str input must be null
 *	terminated.
 *
 * Results:
 *	Returns the length of str in UniChars (not bytes).
 *
................................................................................
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharLen(str)
    Tcl_UniChar *str;		/* Unicode string to find length of. */
{
    int len = 0;
    
    while (*str != '\0') {
	len++;
	str++;
................................................................................
    }
    return len;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclUniCharNcmp --
 *
 *	Compare at most n unichars of string cs to string ct.  Both cs
 *	and ct are assumed to be at least n unichars long.
 *
 * Results:
 *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
 *
................................................................................
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharNcmp(cs, ct, n)
    CONST Tcl_UniChar *cs;		/* Unicode string to compare to ct. */
    CONST Tcl_UniChar *ct;		/* Unicode string cs is compared to. */
    size_t n;				/* Number of unichars to compare. */
{
    for ( ; n != 0; n--, cs++, ct++) {
	if (*cs != *ct) {
	    return *cs - *ct;
................................................................................
    }
    return 0;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclUniCharIsAlnum --
 *
 *	Test if a character is an alphanumeric Unicode character.
 *
 * Results:
 *	Returns 1 if character is alphanumeric.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharIsAlnum(ch)
    int ch;			/* Unicode character to test. */
{
    register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);

    return (((ALPHA_BITS | DIGIT_BITS) >> category) & 1);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclUniCharIsAlpha --
 *
 *	Test if a character is an alphabetic Unicode character.
 *
 * Results:
 *	Returns 1 if character is alphabetic.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharIsAlpha(ch)
    int ch;			/* Unicode character to test. */
{
    register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
    return ((ALPHA_BITS >> category) & 1);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclUniCharIsDigit --
 *
 *	Test if a character is a numeric Unicode character.
 *
 * Results:
 *	Returns non-zero if character is a digit.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharIsDigit(ch)
    int ch;			/* Unicode character to test. */
{
    return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK)
	    == DECIMAL_DIGIT_NUMBER);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclUniCharIsLower --
 *
 *	Test if a character is a lowercase Unicode character.
 *
 * Results:
 *	Returns non-zero if character is lowercase.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharIsLower(ch)
    int ch;			/* Unicode character to test. */
{
    return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == LOWERCASE_LETTER);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclUniCharIsSpace --
 *
 *	Test if a character is a whitespace Unicode character.
 *
 * Results:
 *	Returns non-zero if character is a space.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharIsSpace(ch)
    int ch;			/* Unicode character to test. */
{
    register int category;

    /*
     * If the character is within the first 127 characters, just use the
     * standard C function, otherwise consult the Unicode table.
................................................................................
	return ((SPACE_BITS >> category) & 1);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclUniCharIsUpper --
 *
 *	Test if a character is a uppercase Unicode character.
 *
 * Results:
 *	Returns non-zero if character is uppercase.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharIsUpper(ch)
    int ch;			/* Unicode character to test. */
{
    return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == UPPERCASE_LETTER);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclUniCharIsWordChar --
 *
 *	Test if a character is alphanumeric or a connector punctuation
 *	mark.
 *
 * Results:
 *	Returns 1 if character is a word character.
 *
................................................................................
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharIsWordChar(ch)
    int ch;			/* Unicode character to test. */
{
    register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);

    return (((ALPHA_BITS | DIGIT_BITS | CONNECTOR_BITS) >> category) & 1);
}






|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|













|










|













|









|













|









|













|








|













|







 







|













|








|







 







|






4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
...
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
...
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
....
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
....
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
....
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
....
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
....
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
....
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
....
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
 *	Routines for manipulating UTF-8 strings.
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUtf.c,v 1.1.2.6 1999/04/02 23:44:58 stanton Exp $
 */

#include "tclInt.h"

/*
 * Include the static character classification tables and macros.
 */
................................................................................
    ch = 0xFFFD;
    goto three;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharToUtfDString --
 *
 *	Convert the given Unicode string to UTF-8.
 *
 * Results:
 *	The return value is a pointer to the UTF-8 representation of the
 *	Unicode string.  Storage for the return value is appended to the
 *	end of dsPtr.
................................................................................
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
char *
Tcl_UniCharToUtfDString(wString, numChars, dsPtr)
    CONST Tcl_UniChar *wString;	/* Unicode string to convert to UTF-8. */
    int numChars;		/* Length of Unicode string in Tcl_UniChars
				 * (must be >= 0). */
    Tcl_DString *dsPtr;		/* UTF-8 representation of string is
				 * appended to this previously initialized
				 * DString. */
{
................................................................................
    *chPtr = (Tcl_UniChar) byte;
    return 1;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfToUniCharDString --
 *
 *	Convert the UTF-8 string to Unicode.
 *
 * Results:
 *	The return value is a pointer to the Unicode representation of the
 *	UTF-8 string.  Storage for the return value is appended to the
 *	end of dsPtr.  The Unicode string is terminated with a Unicode
................................................................................
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_UniChar *
Tcl_UtfToUniCharDString(string, length, dsPtr)
    CONST char *string;		/* UTF-8 string to convert to Unicode. */
    int length;			/* Length of UTF-8 string in bytes, or -1
				 * for strlen(). */
    Tcl_DString *dsPtr;		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
................................................................................
	return ch;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharLen --
 *
 *	Find the length of a UniChar string.  The str input must be null
 *	terminated.
 *
 * Results:
 *	Returns the length of str in UniChars (not bytes).
 *
................................................................................
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharLen(str)
    Tcl_UniChar *str;		/* Unicode string to find length of. */
{
    int len = 0;
    
    while (*str != '\0') {
	len++;
	str++;
................................................................................
    }
    return len;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharNcmp --
 *
 *	Compare at most n unichars of string cs to string ct.  Both cs
 *	and ct are assumed to be at least n unichars long.
 *
 * Results:
 *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
 *
................................................................................
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharNcmp(cs, ct, n)
    CONST Tcl_UniChar *cs;		/* Unicode string to compare to ct. */
    CONST Tcl_UniChar *ct;		/* Unicode string cs is compared to. */
    size_t n;				/* Number of unichars to compare. */
{
    for ( ; n != 0; n--, cs++, ct++) {
	if (*cs != *ct) {
	    return *cs - *ct;
................................................................................
    }
    return 0;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsAlnum --
 *
 *	Test if a character is an alphanumeric Unicode character.
 *
 * Results:
 *	Returns 1 if character is alphanumeric.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsAlnum(ch)
    int ch;			/* Unicode character to test. */
{
    register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);

    return (((ALPHA_BITS | DIGIT_BITS) >> category) & 1);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsAlpha --
 *
 *	Test if a character is an alphabetic Unicode character.
 *
 * Results:
 *	Returns 1 if character is alphabetic.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsAlpha(ch)
    int ch;			/* Unicode character to test. */
{
    register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
    return ((ALPHA_BITS >> category) & 1);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsDigit --
 *
 *	Test if a character is a numeric Unicode character.
 *
 * Results:
 *	Returns non-zero if character is a digit.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsDigit(ch)
    int ch;			/* Unicode character to test. */
{
    return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK)
	    == DECIMAL_DIGIT_NUMBER);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsLower --
 *
 *	Test if a character is a lowercase Unicode character.
 *
 * Results:
 *	Returns non-zero if character is lowercase.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsLower(ch)
    int ch;			/* Unicode character to test. */
{
    return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == LOWERCASE_LETTER);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsSpace --
 *
 *	Test if a character is a whitespace Unicode character.
 *
 * Results:
 *	Returns non-zero if character is a space.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsSpace(ch)
    int ch;			/* Unicode character to test. */
{
    register int category;

    /*
     * If the character is within the first 127 characters, just use the
     * standard C function, otherwise consult the Unicode table.
................................................................................
	return ((SPACE_BITS >> category) & 1);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsUpper --
 *
 *	Test if a character is a uppercase Unicode character.
 *
 * Results:
 *	Returns non-zero if character is uppercase.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsUpper(ch)
    int ch;			/* Unicode character to test. */
{
    return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == UPPERCASE_LETTER);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsWordChar --
 *
 *	Test if a character is alphanumeric or a connector punctuation
 *	mark.
 *
 * Results:
 *	Returns 1 if character is a word character.
 *
................................................................................
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsWordChar(ch)
    int ch;			/* Unicode character to test. */
{
    register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);

    return (((ALPHA_BITS | DIGIT_BITS | CONNECTOR_BITS) >> category) & 1);
}

Changes to win/tclWinFCmd.c.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
....
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
 *      subcommands of the "file" command. 
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinFCmd.c,v 1.1.2.2 1998/09/24 23:59:51 stanton Exp $
 */

#include "tclWinInt.h"

/*
 * The following constants specify the type of callback when
 * TraverseWinTree() calls the traverseProc()
................................................................................
		    wp++;
		}
		if (*wp == '\0') {
		    continue;
		}
	    }
	    nativeName = (TCHAR *) data.w.cFileName;
	    len = TclUniCharLen(data.w.cFileName) * sizeof(WCHAR);
	} else {
	    if ((strcmp(data.a.cFileName, ".") == 0) 
		    || (strcmp(data.a.cFileName, "..") == 0)) {
		continue;
	    }
	    nativeName = (TCHAR *) data.a.cFileName;
	    len = strlen(data.a.cFileName);






|







 







|







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
....
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
 *      subcommands of the "file" command. 
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinFCmd.c,v 1.1.2.3 1999/04/02 23:44:59 stanton Exp $
 */

#include "tclWinInt.h"

/*
 * The following constants specify the type of callback when
 * TraverseWinTree() calls the traverseProc()
................................................................................
		    wp++;
		}
		if (*wp == '\0') {
		    continue;
		}
	    }
	    nativeName = (TCHAR *) data.w.cFileName;
	    len = Tcl_UniCharLen(data.w.cFileName) * sizeof(WCHAR);
	} else {
	    if ((strcmp(data.a.cFileName, ".") == 0) 
		    || (strcmp(data.a.cFileName, "..") == 0)) {
		continue;
	    }
	    nativeName = (TCHAR *) data.a.cFileName;
	    len = strlen(data.a.cFileName);

Changes to win/tclWinFile.c.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
 *      interfaces.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinFile.c,v 1.1.2.5 1999/03/19 04:01:27 stanton Exp $
 */

#include "tclWinInt.h"
#include <sys/stat.h>
#include <shlobj.h>
#include <lmaccess.h>		/* For TclpGetUserHome(). */

................................................................................

	    badDomain = 0;
	    nameLen = -1;
	    wDomain = NULL;
	    domain = strchr(name, '@');
	    if (domain != NULL) {
		Tcl_DStringInit(&ds);
		wName = TclUtfToUniCharDString(domain + 1, -1, &ds);
		badDomain = (*netGetDCNameProc)(NULL, wName,
			(LPBYTE *) &wDomain);
		Tcl_DStringFree(&ds);
		nameLen = domain - name;
	    }
	    if (badDomain == 0) {
		Tcl_DStringInit(&ds);
		wName = TclUtfToUniCharDString(name, nameLen, &ds);
		if ((*netUserGetInfoProc)(wDomain, wName, 1, 
			(LPBYTE *) &uiPtr) == 0) {
		    wHomeDir = uiPtr->usri1_home_dir;
		    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
			TclUniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
				bufferPtr);
		    } else {
			/* 
			 * User exists but has no home dir.  Return
			 * "{Windows Drive}:/users/default".
			 */

			GetWindowsDirectoryW(buf, MAX_PATH);
			TclUniCharToUtfDString(buf, 2, bufferPtr);
			Tcl_DStringAppend(bufferPtr, "/users/default", -1);
		    }
		    result = Tcl_DStringValue(bufferPtr);
		    (*netApiBufferFreeProc)((void *) uiPtr);
		}
		Tcl_DStringFree(&ds);
	    }






|







 







|







|




|








|







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
 *      interfaces.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinFile.c,v 1.1.2.6 1999/04/02 23:45:00 stanton Exp $
 */

#include "tclWinInt.h"
#include <sys/stat.h>
#include <shlobj.h>
#include <lmaccess.h>		/* For TclpGetUserHome(). */

................................................................................

	    badDomain = 0;
	    nameLen = -1;
	    wDomain = NULL;
	    domain = strchr(name, '@');
	    if (domain != NULL) {
		Tcl_DStringInit(&ds);
		wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
		badDomain = (*netGetDCNameProc)(NULL, wName,
			(LPBYTE *) &wDomain);
		Tcl_DStringFree(&ds);
		nameLen = domain - name;
	    }
	    if (badDomain == 0) {
		Tcl_DStringInit(&ds);
		wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
		if ((*netUserGetInfoProc)(wDomain, wName, 1, 
			(LPBYTE *) &uiPtr) == 0) {
		    wHomeDir = uiPtr->usri1_home_dir;
		    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
			Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
				bufferPtr);
		    } else {
			/* 
			 * User exists but has no home dir.  Return
			 * "{Windows Drive}:/users/default".
			 */

			GetWindowsDirectoryW(buf, MAX_PATH);
			Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
			Tcl_DStringAppend(bufferPtr, "/users/default", -1);
		    }
		    result = Tcl_DStringValue(bufferPtr);
		    (*netApiBufferFreeProc)((void *) uiPtr);
		}
		Tcl_DStringFree(&ds);
	    }