Tcl Source Code

Check-in [777950336d]
Login

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | tip-402
Files: files | file ages | folders
SHA1: 777950336d0f45be59bfe03d8c7cd3ea78c4a9b1
User & Date: jan.nijtmans 2012-07-16 11:24:21.260
Context
2012-08-02
12:54
merge trunk check-in: 15da7fc903 user: jan.nijtmans tags: tip-402
2012-07-16
11:24
merge trunk check-in: 777950336d user: jan.nijtmans tags: tip-402
08:09
Make registry 1.3 package dynamically loadable when ::tcl::pkgconfig is available check-in: a65bf226ec user: jan.nijtmans tags: trunk
2012-06-27
15:12
Experimental support for UNC paths (through VFS) on UNIX/Mac check-in: c91c7cef8f user: jan.nijtmans tags: tip-402
Changes
Unified Diff Ignore Whitespace Patch
Changes to ChangeLog.




























































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19




























































2012-06-26  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:       Let Cygwin shared build link with
	* unix/configure.in: zlib1.dll, not cygz.dll (two less
	* unix/configure:    dependencies on cygwin-specific dll's)
	* unix/Makefile.in:

2012-06-26  Reinhard Max  <[email protected]>

	* generic/tclIOSock.c: Use EAI_SYSTEM only if it exists.
	* unix/tclUnixSock.c:
	
2012-06-25  Don Porter  <[email protected]>

	* generic/tclFileSystem.h:	[Bug 3024359] Make sure that the
	* generic/tclIOUtil.c:	per-thread cache of the list of file systems
	* generic/tclPathObj.c:	currently registered is only updated at times
	when no active loops are traversing it.  Also reduce the amount of
	epoch storing and checking to where it can make a difference.
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
2012-07-16  Jan Nijtmans  <[email protected]>

	* library/reg/pkgIndex.tcl:  Make registry 1.3 package dynamically
	loadable in Tcl 8.4.20.

2012-07-11  Jan Nijtmans  <[email protected]>

	* win/tclWinReg.c: [Bug #3362446]: registry keys command fails
	with 8.5/8.6. Follow Microsofts example better in order to prevent
	problems when using HKEY_PERFORMANCE_DATA.

2012-07-10  Jan Nijtmans  <[email protected]>

	* unix/tclUnixNotfy.c: [Bug 3541646] Don't panic on triggerPipe overrun

2012-07-10  Donal K. Fellows  <[email protected]>

	* win/tclWinSock.c (InitializeHostName): Corrected logic that
	extracted the name of the computer from the gethostname call so that
	it would use the name on success, not failure. Also ensured that the
	buffer size is exactly that recommended by Microsoft.

2012-07-08  Reinhard Max  <[email protected]>

	* library/http/http.tcl: Add fix and test for URLs that contain
	* tests/http.test: 	 literal IPv6 addresses. [Bug 3531209]

2012-07-05  Don Porter  <[email protected]>

	* unix/tclUnixPipe.c:	[Bug 1189293] Make "<<" binary safe.
	* win/tclWinPipe.c:

2012-07-03  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (TclDStringAppendObj, TclDStringAppendDString):
	* generic/tclInt.h (TclDStringAppendLiteral, TclDStringClear):
	* generic/tclCompile.h (TclDStringAppendToken): Added wrappers to make
	common cases of appending to Tcl_DStrings simpler to write. Prompted
	by looking at [FRQ 1357401] (these are an _internal_ implementation of
	that FRQ).

2012-06-29  Jan Nijtmans  <[email protected]>

	* library/msgcat/msgcat.tcl:   Add tn, ro_MO and ru_MO to msgcat.

2012-06-29  Harald Oehlmann <[email protected]>

	* library/msgcat/msgcat.tcl:	[Bug 3536888] Locale guessing of msgcat
	* library/msgcat/pkgIndex.tcl:  fails on (some) Windows 7.  Bump to 1.4.5
	* unix/Makefile.in
	* win/Makefile.in

2012-06-29  Donal K. Fellows  <[email protected]>

	* doc/GetIndex.3: Reinforced the description of the requirement for
	the tables of names to index over to be static, following posting to
	tcl-core by Brian Griffin about a bug caused by Tktreectrl not obeying
	this rule correctly. This does not represent a functionality change,
	merely a clearer documentation of a long-standing constraint.

2012-06-26  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:       Let Cygwin shared build link with
	* unix/configure.in: zlib1.dll, not cygz.dll (two less
	* unix/configure:    dependencies on cygwin-specific dll's)
	* unix/Makefile.in:

2012-06-26  Reinhard Max  <[email protected]>

	* generic/tclIOSock.c: Use EAI_SYSTEM only if it exists.
	* unix/tclUnixSock.c:

2012-06-25  Don Porter  <[email protected]>

	* generic/tclFileSystem.h:	[Bug 3024359] Make sure that the
	* generic/tclIOUtil.c:	per-thread cache of the list of file systems
	* generic/tclPathObj.c:	currently registered is only updated at times
	when no active loops are traversing it.  Also reduce the amount of
	epoch storing and checking to where it can make a difference.
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815

	* tools/uniParse.tcl:    [Bug 3444754]: string tolower \u01c5 is wrong
	* generic/tclUniData.c:
	* tests/utf.test:

2011-11-30  Jan Nijtmans  <[email protected]>

	* library/tcltest/tcltest.tcl: [Bug 967195]: Make tcltest work when
	tclsh is compiled without using the setargv() function on mingw (No
	need to incr the version, since 2.2.10 is never released).

2011-11-29  Jan Nijtmans  <[email protected]>

	* win/Makefile.in: don't install tommath_(super)?class.h
	* unix/Makefile.in: don't install directories like 8.2 and 8.3
	* generic/tclTomMath.h: [Bug 2991415]: move include tclInt.h from
	* generic/tclTomMathInt.h: tclTomMath.h to tclTomMathInt.h







|
|
<







859
860
861
862
863
864
865
866
867

868
869
870
871
872
873
874

	* tools/uniParse.tcl:    [Bug 3444754]: string tolower \u01c5 is wrong
	* generic/tclUniData.c:
	* tests/utf.test:

2011-11-30  Jan Nijtmans  <[email protected]>

	* library/tcltest/tcltest.tcl: [Bug 967195]: Make tcltest work
	when tclsh is compiled without using the setargv() function on mingw.


2011-11-29  Jan Nijtmans  <[email protected]>

	* win/Makefile.in: don't install tommath_(super)?class.h
	* unix/Makefile.in: don't install directories like 8.2 and 8.3
	* generic/tclTomMath.h: [Bug 2991415]: move include tclInt.h from
	* generic/tclTomMathInt.h: tclTomMath.h to tclTomMathInt.h
Changes to changes.
7972
7973
7974
7975
7976
7977
7978


7979
7980
7981
7982
7983
7984
7985

7986

7987
7988
7989


































































7990
7991












































7992

2011-08-30 (bug fix)[3398794] panic in interp limit setting (gavlian,fellows)

2011-09-08 (bug fix)[3401704] revised expr parser to permit function names
like "nano()" instead of parsing as "nan o()" with missing op (duquette,porter)
	*** POTENTIAL INCOMPATIBILITY ***



2011-09-13 (bug fix)[3390638] solaris studio cc workaround (kechel,porter)

2011-09-13 (bug fix)[3405652] DTrace workaround (michelson,porter)

2011-09-16 (bug fix)[3391977] -headers overrides -type (ziegenhagen,fellows)
=> http 2.7.7


2011-09-16 (bug fix)[3400658] wrong num args msg with TclOO (rsooltan,fellows)


2011-10-11 (bug fix)[2935503] [file stat] returns bad mode (nadkarni,nijtmans)



































































2011-10-15 tzdata updated to Olson's tzdata2011l (iyer)













































--- Released 8.6b3, November 20, 2011 --- See ChangeLog for details ---







>
>





|

>
|
>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
7972
7973
7974
7975
7976
7977
7978
7979
7980
7981
7982
7983
7984
7985
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
7997
7998
7999
8000
8001
8002
8003
8004
8005
8006
8007
8008
8009
8010
8011
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
8023
8024
8025
8026
8027
8028
8029
8030
8031
8032
8033
8034
8035
8036
8037
8038
8039
8040
8041
8042
8043
8044
8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070
8071
8072
8073
8074
8075
8076
8077
8078
8079
8080
8081
8082
8083
8084
8085
8086
8087
8088
8089
8090
8091
8092
8093
8094
8095
8096
8097
8098
8099
8100
8101
8102
8103
8104
8105
8106

2011-08-30 (bug fix)[3398794] panic in interp limit setting (gavlian,fellows)

2011-09-08 (bug fix)[3401704] revised expr parser to permit function names
like "nano()" instead of parsing as "nan o()" with missing op (duquette,porter)
	*** POTENTIAL INCOMPATIBILITY ***

2011-09-10 (bug fix)[3400658] wrong num args msg with TclOO (rsooltan,fellows)

2011-09-13 (bug fix)[3390638] solaris studio cc workaround (kechel,porter)

2011-09-13 (bug fix)[3405652] DTrace workaround (michelson,porter)

2011-09-16 (bug fix)[3391977] -headers overrides -type (ziegenhagen,fellows)
=> http 2.8.3

2011-09-16 (TIP 388) New \Uhhhhhhhh syntax (nijtmans)

2011-10-06 (enhancement) bytecode compile [dict with] (fellows)

2011-10-11 (bug fix)[2935503] [file stat] returns bad mode (nadkarni,nijtmans)

2011-10-20 (bug fix)[3418547] cmd lits and custom resolvers (soberning,fellows)

2011-10-31 (bug fix)[3414754] EIAS violation in fs paths (porter)

2011-11-22 (bug fix)[2935503] Win: [file mtime] sets wrong time (nijtmans)

2011-11-30 (bug fix)[967195] Simply args passed to child processes (nijtmans)
=> tcltest 2.3.4

2011-12-07 (bug fix)[3444754] fix [string tolower \u01C5] (nijtmans)

2011-12-11 (update)[3457031] Update [[:print:]] to Unicode 6.0 (nijtmans)

2011-12-24 (bug fix)[3464428] fix [string is graph \u0120] (nijtmans)

2012-01-08 (bug fix)[3470928] zoneinfo trouble with Windhoek data file (kenny)

2012-01-13 (bug fix)[3472316] fix retrieval of socket error (fellows)

2012-01-21 (bug fix)[3475667] [regexp] buffer read overflow (sebres)

2012-01-22 (bug fix)[3475264] [dict exists] return 0, not error (fellows)

2012-01-25 (bug fix)[3474460] [oo::copy] var resolution list (fellows)

2012-01-26 (bug fix)[3475569,3479689] mem corrupt in fs path (sebres,porter)

2012-01-30 (enhancement) improve bytecode compile of [catch] (fellows)

2012-02-02 (bug fix)[2974459,2879351,1951574,1852572,1661378,1613456] Fix
problems where [file *able] would return false results on Win/Samba (porter)

2012-02-02 (update)[3464401] Support Unicode 6.1 (nijtmans)

2012-02-06 (bug fix)[3484621] bump bytecode epoch on exec traces (kuhn,sofer)

2012-02-15 (bug fix)[3487626] crash compiling [dict for] (fellows)

2012-02-15 (enhancement) bytecode compile [lrange],[lreplace] (fellows)

2012-02-17 (bug fix)[2233954] compile problem on AIX & Android (nijtmans)

2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans)

2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries)

2012-03-26 (TIP 380) New builtin class [oo::Slot] (fellows)
	*** POTENTIAL INCOMPATIBILITY ***

2012-03-27 (TIP 397) <cloned> method to extend [oo::copy] (fellows)
	*** POTENTIAL INCOMPATIBILITY ***

2012-03-27 (TIP 395) New subcommand [string is entier] (fellows)

2012-04-02 (TIP 396) New command [yieldto] (fellows)

2012-04-04 (bug fix)[3514761] crash combining objects and ensembles (fellows)

2012-04-09 (bug fix)[2712377] [info vars] and oo variables (fellows)

2012-04-09 (bug fix)[3396896] no dups in oo var lists (fellows)

2012-04-11 (bug fix)[3448512] [clock scan 1958-01-01] fail on Win (nijtmans)

2012-04-15 (bug fix)[3517696] fix flush of zlib chan xform (fellows)

2012-04-18 tzdata updated to Olson's tzdata2012c (kenny)

2012-04-28 (TIP 398) exit non-blocking chan without flush (ferrieux)
	*** POTENTIAL INCOMPATIBILITY ***

2012-05-02 (enhancement) Better use of Intel cpuid instruction (nijtmans)

2012-05-03 (bug fix)[3428753] Unbreak synchronous [socket -async] (porter)

2012-05-10 (bug fix)[2812981] force consistent config of Tcl+pkgs (ferrieux)

2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans)

2012-05-17 (bug fix)[3445787] fix [file] ensemble in Safe Base (fellows)

2012-05-17 (bug fix)[2964715] fix [glob] in Safe Base (fellows)

2012-05-17 (bug fix)[3106532] proper [switch -indexvar] values (fellows)
	*** POTENTIAL INCOMPATIBILITY ***

2012-05-21 (TIP 106) New -binary option to [dde execute|poke] (oehlmann)
=> dde 1.4.0

2012-05-23 (bug fix)[3525907] [zlib push decompress] & [chan event]
(fellows,ferrieux,kupries)

2012-05-28 (bug fix)[3529949] Protect ~ paths in Safe Base (fellows)

2012-06-21 (bug fix)[3362446] [registry keys] failure (nijtmans)
=> registry 1.3.0

2012-06-25 (bug fix)[3537605] [encoding dirs a b] error message (fellows)

2012-06-25 (bug fix)[3024359] crash when multi-thread concurrent [file system]
and Tcl_FSMountsChanged(). (porter)

2012-06-29 (bug fix)[3536888] fix locale guessing (oehlmann,nijtmans)
=> msgcat 1.4.5

2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter)

2012-07-08 (bug fix)[3531209] accept IPv6 URLs (max)
=> http 2.8.4

Many revisions to better support a Cygwin environment (nijtmans)

--- Released 8.6b3, July 30, 2012 --- See ChangeLog for details ---
Changes to doc/GetIndex.3.
28
29
30
31
32
33
34



35
36
37
38



39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
.AP Tcl_Obj *objPtr in/out
The string value of this object is used to search through \fItablePtr\fR.
The internal representation is modified to hold the index of the matching
table entry.
.AP "const char *const" *tablePtr in
An array of null-terminated strings.  The end of the array is marked
by a NULL string pointer.



.AP "const void" *structTablePtr in
An array of arbitrary type, typically some \fBstruct\fR type.
The first member of the structure must be a null-terminated string.
The size of the structure is given by \fIoffset\fR.



.AP int offset in
The offset to add to structTablePtr to get to the next entry.
The end of the array is marked by a NULL string pointer.
.AP "const char" *msg in
Null-terminated string describing what is being looked up, such as
\fBoption\fR.  This string is included in error messages.
.AP int flags in
OR-ed combination of bits providing additional information for
operation.  The only bit that is currently defined is \fBTCL_EXACT\fR.
.AP int *indexPtr out
The index of the string in \fItablePtr\fR that matches the value of
\fIobjPtr\fR is returned here.
.BE
.SH DESCRIPTION
.PP
This procedure provides an efficient way for looking up keywords,
switch names, option names, and similar things where the value of
an object must be one of a predefined set of values.
\fIObjPtr\fR is compared against each of
the strings in \fItablePtr\fR to find a match.  A match occurs if
\fIobjPtr\fR's string value is identical to one of the strings in
\fItablePtr\fR, or if it is a non-empty unique abbreviation
for exactly one of the strings in \fItablePtr\fR and the
\fBTCL_EXACT\fR flag was not specified; in either case
the index of the matching entry is stored at \fI*indexPtr\fR
and \fBTCL_OK\fR is returned.







>
>
>




>
>
>















|


|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
.AP Tcl_Obj *objPtr in/out
The string value of this object is used to search through \fItablePtr\fR.
The internal representation is modified to hold the index of the matching
table entry.
.AP "const char *const" *tablePtr in
An array of null-terminated strings.  The end of the array is marked
by a NULL string pointer.
Note that references to the \fItablePtr\fR may be retained in the
internal representation of \fIobjPtr\fR, so this should represent the
address of a statically-allocated array.
.AP "const void" *structTablePtr in
An array of arbitrary type, typically some \fBstruct\fR type.
The first member of the structure must be a null-terminated string.
The size of the structure is given by \fIoffset\fR.
Note that references to the \fIstructTablePtr\fR may be retained in the
internal representation of \fIobjPtr\fR, so this should represent the
address of a statically-allocated array of structures.
.AP int offset in
The offset to add to structTablePtr to get to the next entry.
The end of the array is marked by a NULL string pointer.
.AP "const char" *msg in
Null-terminated string describing what is being looked up, such as
\fBoption\fR.  This string is included in error messages.
.AP int flags in
OR-ed combination of bits providing additional information for
operation.  The only bit that is currently defined is \fBTCL_EXACT\fR.
.AP int *indexPtr out
The index of the string in \fItablePtr\fR that matches the value of
\fIobjPtr\fR is returned here.
.BE
.SH DESCRIPTION
.PP
These procedures provide an efficient way for looking up keywords,
switch names, option names, and similar things where the value of
an object must be one of a predefined set of values.
\fBTcl_GetIndexFromObj\fR compares \fIobjPtr\fR against each of
the strings in \fItablePtr\fR to find a match.  A match occurs if
\fIobjPtr\fR's string value is identical to one of the strings in
\fItablePtr\fR, or if it is a non-empty unique abbreviation
for exactly one of the strings in \fItablePtr\fR and the
\fBTCL_EXACT\fR flag was not specified; in either case
the index of the matching entry is stored at \fI*indexPtr\fR
and \fBTCL_OK\fR is returned.
Changes to doc/msgcat.n.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.5\fR
.sp
\fBpackage require msgcat 1.4.2\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.5\fR
.sp
\fBpackage require msgcat 1.4.5\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp
171
172
173
174
175
176
177
178
179




180
181
182
183
184
185
186
187
188
189
to extract its parts.  The initial locale is then set by calling
\fB::msgcat::mclocale\fR with the argument 
.PP
.CS
language[_country][_modifier]
.CE
.PP
On Windows, if none of those environment variables is set, msgcat will
attempt to extract locale information from the




registry.  If all these attempts to discover an initial locale
from the user's environment fail, msgcat defaults to an initial
locale of
.QW C .
.PP
When a locale is specified by the user, a
.QW "best match"
search is performed during string translation.  For example, if a user
specifies
en_GB_Funky, the locales







|
|
>
>
>
>
|
|
<







171
172
173
174
175
176
177
178
179
180
181
182
183
184
185

186
187
188
189
190
191
192
to extract its parts.  The initial locale is then set by calling
\fB::msgcat::mclocale\fR with the argument 
.PP
.CS
language[_country][_modifier]
.CE
.PP
On Windows and Cygwin, if none of those environment variables is set,
msgcat will attempt to extract locale information from the registry.
From Windows Vista on, the RFC4747 locale name "lang-script-country-options"
is transformed to the locale as "lang_country_script" (Example:
sr-Latn-CS -> sr_cs_latin). For Windows XP, the language id is
transformed analoguously (Example: 0c1a -> sr_yu_cyrillic).
If all these attempts to discover an initial locale from the user's
environment fail, msgcat defaults to an initial locale of

.QW C .
.PP
When a locale is specified by the user, a
.QW "best match"
search is performed during string translation.  For example, if a user
specifies
en_GB_Funky, the locales
Changes to generic/tclAssembly.c.
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
static int		CheckOneByte(Tcl_Interp*, int);
static int		CheckSignedOneByte(Tcl_Interp*, int);
static int		CheckStack(AssemblyEnv*);
static int		CheckStrictlyPositive(Tcl_Interp*, int);
static ByteCode *	CompileAssembleObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
			    TalInstDesc*);
static int		DefineLabel(AssemblyEnv* envPtr, const char* label);
static void		DeleteMirrorJumpTable(JumptableInfo* jtPtr);
static void		DupAssembleCodeInternalRep(Tcl_Obj* src,
			    Tcl_Obj* dest);
static void		FillInJumpOffsets(AssemblyEnv*);
static int		CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
			    Tcl_Obj* jumpTable);







|







261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
static int		CheckOneByte(Tcl_Interp*, int);
static int		CheckSignedOneByte(Tcl_Interp*, int);
static int		CheckStack(AssemblyEnv*);
static int		CheckStrictlyPositive(Tcl_Interp*, int);
static ByteCode *	CompileAssembleObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
			    const TalInstDesc*);
static int		DefineLabel(AssemblyEnv* envPtr, const char* label);
static void		DeleteMirrorJumpTable(JumptableInfo* jtPtr);
static void		DupAssembleCodeInternalRep(Tcl_Obj* src,
			    Tcl_Obj* dest);
static void		FillInJumpOffsets(AssemblyEnv*);
static int		CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
			    Tcl_Obj* jumpTable);
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360

#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */

/*
 * Source instructions recognized in the Tcl Assembly Language (TAL)
 */

TalInstDesc TalInstructionTable[] = {
    /* PUSH must be first, see the code near the end of TclAssembleCode */
    {"push",		ASSEM_PUSH,	(INST_PUSH1<<8
					 | INST_PUSH4),		0,	1},

    {"add",		ASSEM_1BYTE,	INST_ADD,		2,	1},
    {"append",		ASSEM_LVT,	(INST_APPEND_SCALAR1<<8
					 | INST_APPEND_SCALAR4),1,	1},







|







346
347
348
349
350
351
352
353
354
355
356
357
358
359
360

#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */

/*
 * Source instructions recognized in the Tcl Assembly Language (TAL)
 */

static const TalInstDesc TalInstructionTable[] = {
    /* PUSH must be first, see the code near the end of TclAssembleCode */
    {"push",		ASSEM_PUSH,	(INST_PUSH1<<8
					 | INST_PUSH4),		0,	1},

    {"add",		ASSEM_1BYTE,	INST_ADD,		2,	1},
    {"append",		ASSEM_LVT,	(INST_APPEND_SCALAR1<<8
					 | INST_APPEND_SCALAR4),1,	1},
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
 *-----------------------------------------------------------------------------
 */

static void
CompileEmbeddedScript(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Token* tokenPtr,	/* Tcl_Token containing the script */
    TalInstDesc* instPtr)	/* Instruction that determines whether
				 * the script is 'expr' or 'eval' */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */








|







1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
 *-----------------------------------------------------------------------------
 */

static void
CompileEmbeddedScript(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Token* tokenPtr,	/* Tcl_Token containing the script */
    const TalInstDesc* instPtr)	/* Instruction that determines whether
				 * the script is 'expr' or 'eval' */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */

Changes to generic/tclBasic.c.
130
131
132
133
134
135
136


137
138
139
140
141
142
143
static Tcl_Obj *	GetCommandSource(Interp *iPtr, int objc,
			    Tcl_Obj *const objv[], int lookup);
static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
			    int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc	NRCoroutineActivateCallback;
static Tcl_NRPostProc	NRCoroutineCallerCallback;
static Tcl_NRPostProc	NRCoroutineExitCallback;


static Tcl_NRPostProc	NRRunObjProc;
static Tcl_NRPostProc	NRTailcallEval;
static Tcl_ObjCmdProc	OldMathFuncProc;
static void		OldMathFuncDeleteProc(ClientData clientData);
static void		ProcessUnexpectedResult(Tcl_Interp *interp,
			    int returnCode);
static int		RewindCoroutine(CoroutineData *corPtr, int result);







>
>







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
static Tcl_Obj *	GetCommandSource(Interp *iPtr, int objc,
			    Tcl_Obj *const objv[], int lookup);
static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
			    int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc	NRCoroutineActivateCallback;
static Tcl_NRPostProc	NRCoroutineCallerCallback;
static Tcl_NRPostProc	NRCoroutineExitCallback;
static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);

static Tcl_NRPostProc	NRRunObjProc;
static Tcl_NRPostProc	NRTailcallEval;
static Tcl_ObjCmdProc	OldMathFuncProc;
static void		OldMathFuncDeleteProc(ClientData clientData);
static void		ProcessUnexpectedResult(Tcl_Interp *interp,
			    int returnCode);
static int		RewindCoroutine(CoroutineData *corPtr, int result);
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
     * function to get the namespace from which the old command is being
     * renamed!
     */

    Tcl_DStringInit(&newFullName);
    Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
    if (newNsPtr != iPtr->globalNsPtr) {
	Tcl_DStringAppend(&newFullName, "::", 2);
    }
    Tcl_DStringAppend(&newFullName, newTail, -1);
    cmdPtr->refCount++;
    CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
	    Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
    Tcl_DStringFree(&newFullName);








|







2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
     * function to get the namespace from which the old command is being
     * renamed!
     */

    Tcl_DStringInit(&newFullName);
    Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
    if (newNsPtr != iPtr->globalNsPtr) {
	TclDStringAppendLiteral(&newFullName, "::");
    }
    Tcl_DStringAppend(&newFullName, newTail, -1);
    cmdPtr->refCount++;
    CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
	    Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
    Tcl_DStringFree(&newFullName);

3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
    data->proc = proc;
    data->numArgs = numArgs;
    data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType));
    memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
    data->clientData = clientData;

    Tcl_DStringInit(&bigName);
    Tcl_DStringAppend(&bigName, "::tcl::mathfunc::", -1);
    Tcl_DStringAppend(&bigName, name, -1);

    Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
	    OldMathFuncProc, data, OldMathFuncDeleteProc);
    Tcl_DStringFree(&bigName);
}








|







3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
    data->proc = proc;
    data->numArgs = numArgs;
    data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType));
    memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
    data->clientData = clientData;

    Tcl_DStringInit(&bigName);
    TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
    Tcl_DStringAppend(&bigName, name, -1);

    Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
	    OldMathFuncProc, data, OldMathFuncDeleteProc);
    Tcl_DStringFree(&bigName);
}

4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
	TOP_CB(interp) = callbackPtr->nextPtr;
	result = procPtr(callbackPtr->data, interp, result);
	TCLNR_FREE(interp, callbackPtr);
    }
    return result;
}

int
NRCommand(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = data[0];







|







4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
	TOP_CB(interp) = callbackPtr->nextPtr;
	result = procPtr(callbackPtr->data, interp, result);
	TCLNR_FREE(interp, callbackPtr);
    }
    return result;
}

static int
NRCommand(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = data[0];
8589
8590
8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
    NRE_ASSERT(corPtr->eePtr != NULL);
    NRE_ASSERT(corPtr->eePtr != iPtr->execEnvPtr);

    corPtr->eePtr->rewind = 1;
    TclNRAddCallback(interp, RewindCoroutineCallback, state,
	    NULL, NULL, NULL);
    return NRInterpCoroutine(corPtr, interp, 0, NULL);
}

static void
DeleteCoroutine(
    ClientData clientData)
{
    CoroutineData *corPtr = clientData;







|







8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
8604
8605
    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
    NRE_ASSERT(corPtr->eePtr != NULL);
    NRE_ASSERT(corPtr->eePtr != iPtr->execEnvPtr);

    corPtr->eePtr->rewind = 1;
    TclNRAddCallback(interp, RewindCoroutineCallback, state,
	    NULL, NULL, NULL);
    return TclNRInterpCoroutine(corPtr, interp, 0, NULL);
}

static void
DeleteCoroutine(
    ClientData clientData)
{
    CoroutineData *corPtr = clientData;
8816
8817
8818
8819
8820
8821
8822
8823
8824
8825
8826
8827
8828
8829
8830

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
    if ((!cmdPtr) || (cmdPtr->nreProc != NRInterpCoroutine)) {
        Tcl_AppendResult(interp, "can only inject a command into a coroutine",
                NULL);
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objv[1]), NULL);
        return TCL_ERROR;
    }








|







8818
8819
8820
8821
8822
8823
8824
8825
8826
8827
8828
8829
8830
8831
8832

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
    if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
        Tcl_AppendResult(interp, "can only inject a command into a coroutine",
                NULL);
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objv[1]), NULL);
        return TCL_ERROR;
    }

8845
8846
8847
8848
8849
8850
8851
8852
8853
8854
8855
8856
8857
8858
8859
    TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN);
    iPtr->execEnvPtr = savedEEPtr;

    return TCL_OK;
}

int
NRInterpCoroutine(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = clientData;








|







8847
8848
8849
8850
8851
8852
8853
8854
8855
8856
8857
8858
8859
8860
8861
    TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN);
    iPtr->execEnvPtr = savedEEPtr;

    return TCL_OK;
}

int
TclNRInterpCoroutine(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = clientData;

8967
8968
8969
8970
8971
8972
8973
8974
8975
8976
8977
8978
8979
8980
8981
8982
8983
8984
8985
8986
     */

    corPtr = ckalloc(sizeof(CoroutineData));

    Tcl_DStringInit(&ds);
    if (nsPtr != iPtr->globalNsPtr) {
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	Tcl_DStringAppend(&ds, "::", 2);
    }
    Tcl_DStringAppend(&ds, procName, -1);

    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
	    /*objProc*/ NULL, NRInterpCoroutine, corPtr, DeleteCoroutine);
    Tcl_DStringFree(&ds);

    corPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;

    /*
     * #280.







|




|







8969
8970
8971
8972
8973
8974
8975
8976
8977
8978
8979
8980
8981
8982
8983
8984
8985
8986
8987
8988
     */

    corPtr = ckalloc(sizeof(CoroutineData));

    Tcl_DStringInit(&ds);
    if (nsPtr != iPtr->globalNsPtr) {
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	TclDStringAppendLiteral(&ds, "::");
    }
    Tcl_DStringAppend(&ds, procName, -1);

    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
	    /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine);
    Tcl_DStringFree(&ds);

    corPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;

    /*
     * #280.
Changes to generic/tclCmdAH.c.
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
	{"writable",	 1},
	{NULL, 0}
    };
    int i;
    Tcl_DString oldBuf, newBuf;

    Tcl_DStringInit(&oldBuf);
    Tcl_DStringAppend(&oldBuf, "::tcl::file::", -1);
    Tcl_DStringInit(&newBuf);
    Tcl_DStringAppend(&newBuf, "tcl:file:", -1);
    for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
	if (unsafeInfo[i].unsafe) {
	    const char *oldName, *newName;

	    Tcl_DStringSetLength(&oldBuf, 13);
	    oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
	    Tcl_DStringSetLength(&newBuf, 9);







|

|







1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
	{"writable",	 1},
	{NULL, 0}
    };
    int i;
    Tcl_DString oldBuf, newBuf;

    Tcl_DStringInit(&oldBuf);
    TclDStringAppendLiteral(&oldBuf, "::tcl::file::");
    Tcl_DStringInit(&newBuf);
    TclDStringAppendLiteral(&newBuf, "tcl:file:");
    for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
	if (unsafeInfo[i].unsafe) {
	    const char *oldName, *newName;

	    Tcl_DStringSetLength(&oldBuf, 13);
	    oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
	    Tcl_DStringSetLength(&newBuf, 9);
Changes to generic/tclCompCmds.c.
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830

    /*
     * Check we've got a pair of variables and that they are local variables.
     * Then extract their indices in the LVT.
     */

    Tcl_DStringInit(&buffer);
    Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, varsTokenPtr[1].size);
    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
	    &argv) != TCL_OK) {
	Tcl_DStringFree(&buffer);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&buffer);
    if (numVars != 2) {







|







816
817
818
819
820
821
822
823
824
825
826
827
828
829
830

    /*
     * Check we've got a pair of variables and that they are local variables.
     * Then extract their indices in the LVT.
     */

    Tcl_DStringInit(&buffer);
    TclDStringAppendToken(&buffer, &varsTokenPtr[1]);
    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
	    &argv) != TCL_OK) {
	Tcl_DStringFree(&buffer);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&buffer);
    if (numVars != 2) {
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971

	/*
	 * Lots of copying going on here. Need a ListObj wizard to show a
	 * better way.
	 */

	Tcl_DStringInit(&varList);
	Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size);
	code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
		&varcList[loopIndex], &varvList[loopIndex]);
	Tcl_DStringFree(&varList);
	if (code != TCL_OK) {
	    code = TCL_ERROR;
	    goto done;
	}







|







1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971

	/*
	 * Lots of copying going on here. Need a ListObj wizard to show a
	 * better way.
	 */

	Tcl_DStringInit(&varList);
	TclDStringAppendToken(&varList, &tokenPtr[1]);
	code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
		&varcList[loopIndex], &varvList[loopIndex]);
	Tcl_DStringFree(&varList);
	if (code != TCL_OK) {
	    code = TCL_ERROR;
	    goto done;
	}
Changes to generic/tclCompCmdsSZ.c.
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
	     * a target in the jump table (assuming it isn't already there,
	     * which would indicate that this clause is probably masked by an
	     * earlier one). Note that we use a Tcl_DString here simply
	     * because the hash API does not let us specify the string length.
	     */

	    Tcl_DStringInit(&buffer);
	    Tcl_DStringAppend(&buffer, bodyToken[i]->start,
		    bodyToken[i]->size);
	    hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable,
		    Tcl_DStringValue(&buffer), &isNew);
	    if (isNew) {
		/*
		 * First time we've encountered this match clause, so it must
		 * point to here.
		 */







|
<







1554
1555
1556
1557
1558
1559
1560
1561

1562
1563
1564
1565
1566
1567
1568
	     * a target in the jump table (assuming it isn't already there,
	     * which would indicate that this clause is probably masked by an
	     * earlier one). Note that we use a Tcl_DString here simply
	     * because the hash API does not let us specify the string length.
	     */

	    Tcl_DStringInit(&buffer);
	    TclDStringAppendToken(&buffer, bodyToken[i]);

	    hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable,
		    Tcl_DStringValue(&buffer), &isNew);
	    if (isNew) {
		/*
		 * First time we've encountered this match clause, so it must
		 * point to here.
		 */
Changes to generic/tclCompExpr.c.
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
	    switch (nodePtr->lexeme) {
	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		int length;

		Tcl_DStringInit(&cmdName);
		Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
		p = TclGetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterNewCmdLiteral(envPtr,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName)), envPtr);
		Tcl_DStringFree(&cmdName);







|







2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
	    switch (nodePtr->lexeme) {
	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		int length;

		Tcl_DStringInit(&cmdName);
		TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
		p = TclGetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterNewCmdLiteral(envPtr,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName)), envPtr);
		Tcl_DStringFree(&cmdName);
Changes to generic/tclCompile.c.
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
		    /*
		     * We copy the string before trying to find the command by
		     * name. We used to modify the string in place, but this
		     * is not safe because the name resolution handlers could
		     * have side effects that rely on the unmodified string.
		     */

		    Tcl_DStringSetLength(&ds, 0);
		    Tcl_DStringAppend(&ds, tokenPtr[1].start,tokenPtr[1].size);

		    cmdPtr = (Command *) Tcl_FindCommand(interp,
			    Tcl_DStringValue(&ds),
			    (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);

		    if ((cmdPtr != NULL)
			    && (cmdPtr->compileProc != NULL)







|
|







1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
		    /*
		     * We copy the string before trying to find the command by
		     * name. We used to modify the string in place, but this
		     * is not safe because the name resolution handlers could
		     * have side effects that rely on the unmodified string.
		     */

		    TclDStringClear(&ds);
		    TclDStringAppendToken(&ds, &tokenPtr[1]);

		    cmdPtr = (Command *) Tcl_FindCommand(interp,
			    Tcl_DStringValue(&ds),
			    (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);

		    if ((cmdPtr != NULL)
			    && (cmdPtr->compileProc != NULL)
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
    }

    Tcl_DStringInit(&textBuffer);
    numObjsToConcat = 0;
    for ( ;  count > 0;  count--, tokenPtr++) {
	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size);
	    TclAdvanceLines(&envPtr->line, tokenPtr->start,
		    tokenPtr->start + tokenPtr->size);
	    break;

	case TCL_TOKEN_BS:
	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
		    NULL, buffer);







|







2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
    }

    Tcl_DStringInit(&textBuffer);
    numObjsToConcat = 0;
    for ( ;  count > 0;  count--, tokenPtr++) {
	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    TclDStringAppendToken(&textBuffer, tokenPtr);
	    TclAdvanceLines(&envPtr->line, tokenPtr->start,
		    tokenPtr->start + tokenPtr->size);
	    break;

	case TCL_TOKEN_BS:
	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
		    NULL, buffer);
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103

	case TCL_TOKEN_COMMAND:
	    /*
	     * Push any accumulated chars appearing before the command.
	     */

	    if (Tcl_DStringLength(&textBuffer) > 0) {
		int literal = TclRegisterNewLiteral(envPtr,
			Tcl_DStringValue(&textBuffer),
			Tcl_DStringLength(&textBuffer));

		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);

		if (numCL) {
		    TclContinuationsEnter(







|
<
<







2087
2088
2089
2090
2091
2092
2093
2094


2095
2096
2097
2098
2099
2100
2101

	case TCL_TOKEN_COMMAND:
	    /*
	     * Push any accumulated chars appearing before the command.
	     */

	    if (Tcl_DStringLength(&textBuffer) > 0) {
		int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);



		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);

		if (numCL) {
		    TclContinuationsEnter(
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
	    /*
	     * Push any accumulated chars appearing before the $<var>.
	     */

	    if (Tcl_DStringLength(&textBuffer) > 0) {
		int literal;

		literal = TclRegisterNewLiteral(envPtr,
			Tcl_DStringValue(&textBuffer),
			Tcl_DStringLength(&textBuffer));
		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);
	    }

	    TclCompileVarSubst(interp, tokenPtr, envPtr);
	    numObjsToConcat++;







|
<
<







2114
2115
2116
2117
2118
2119
2120
2121


2122
2123
2124
2125
2126
2127
2128
	    /*
	     * Push any accumulated chars appearing before the $<var>.
	     */

	    if (Tcl_DStringLength(&textBuffer) > 0) {
		int literal;

		literal = TclRegisterDStringLiteral(envPtr, &textBuffer);


		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);
	    }

	    TclCompileVarSubst(interp, tokenPtr, envPtr);
	    numObjsToConcat++;
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
    }

    /*
     * Push any accumulated characters appearing at the end.
     */

    if (Tcl_DStringLength(&textBuffer) > 0) {
	int literal;

	literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer),
		Tcl_DStringLength(&textBuffer));
	TclEmitPush(literal, envPtr);
	numObjsToConcat++;

	if (numCL) {
	    TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
		    numCL, clPosition);
	}
	numCL = 0;
    }








|

<
<


<







2137
2138
2139
2140
2141
2142
2143
2144
2145


2146
2147

2148
2149
2150
2151
2152
2153
2154
    }

    /*
     * Push any accumulated characters appearing at the end.
     */

    if (Tcl_DStringLength(&textBuffer) > 0) {
	int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);



	TclEmitPush(literal, envPtr);
	numObjsToConcat++;

	if (numCL) {
	    TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
		    numCL, clPosition);
	}
	numCL = 0;
    }

Changes to generic/tclCompile.h.
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877

/*
 *----------------------------------------------------------------
 * Procedures exported by tclBasic.c to be used within the engine.
 *----------------------------------------------------------------
 */

MODULE_SCOPE Tcl_NRPostProc	NRCommand;
MODULE_SCOPE Tcl_ObjCmdProc	NRInterpCoroutine;

/*
 *----------------------------------------------------------------
 * Procedures exported by the engine to be used by tclBasic.c
 *----------------------------------------------------------------
 */








<
|







862
863
864
865
866
867
868

869
870
871
872
873
874
875
876

/*
 *----------------------------------------------------------------
 * Procedures exported by tclBasic.c to be used within the engine.
 *----------------------------------------------------------------
 */


MODULE_SCOPE Tcl_ObjCmdProc	TclNRInterpCoroutine;

/*
 *----------------------------------------------------------------
 * Procedures exported by the engine to be used by tclBasic.c
 *----------------------------------------------------------------
 */

1360
1361
1362
1363
1364
1365
1366










1367
1368
1369
1370
1371
1372
1373
/*
 * Check if there is an LVT for compiled locals
 */

#define EnvHasLVT(envPtr) \
    (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)











/*
 * DTrace probe macros (NOPs if DTrace support is not enabled).
 */

/*
 * Define the following macros to enable debug logging of the DTrace proc,
 * cmd, and inst probes. Note that this does _not_ require a platform with







>
>
>
>
>
>
>
>
>
>







1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
/*
 * Check if there is an LVT for compiled locals
 */

#define EnvHasLVT(envPtr) \
    (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)

/*
 * Macros for making it easier to deal with tokens and DStrings.
 */

#define TclDStringAppendToken(dsPtr, tokenPtr) \
    Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size)
#define TclRegisterDStringLiteral(envPtr, dsPtr) \
    TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \
	    Tcl_DStringLength(dsPtr), /*flags*/ 0)

/*
 * DTrace probe macros (NOPs if DTrace support is not enabled).
 */

/*
 * Define the following macros to enable debug logging of the DTrace proc,
 * cmd, and inst probes. Note that this does _not_ require a platform with
Changes to generic/tclConfig.c.
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183

    /*
     * Now create the interface command for retrieval of the package
     * information.
     */

    Tcl_DStringInit(&cmdName);
    Tcl_DStringAppend(&cmdName, "::", -1);
    Tcl_DStringAppend(&cmdName, pkgName, -1);

    /*
     * The incomplete command name is the name of the namespace to place it
     * in.
     */

    if (Tcl_FindNamespace(interp, Tcl_DStringValue(&cmdName), NULL,
	    TCL_GLOBAL_ONLY) == NULL) {
	if (Tcl_CreateNamespace(interp, Tcl_DStringValue(&cmdName),
		NULL, NULL) == NULL) {
	    Tcl_Panic("%s.\n%s: %s",
		    Tcl_GetStringResult(interp), "Tcl_RegisterConfig",
		    "Unable to create namespace for package configuration.");
	}
    }

    Tcl_DStringAppend(&cmdName, "::pkgconfig", -1);

    if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName),
	    QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) {
	Tcl_Panic("%s: %s", "Tcl_RegisterConfig",
		"Unable to create query command for package configuration");
    }








|

















|







151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183

    /*
     * Now create the interface command for retrieval of the package
     * information.
     */

    Tcl_DStringInit(&cmdName);
    TclDStringAppendLiteral(&cmdName, "::");
    Tcl_DStringAppend(&cmdName, pkgName, -1);

    /*
     * The incomplete command name is the name of the namespace to place it
     * in.
     */

    if (Tcl_FindNamespace(interp, Tcl_DStringValue(&cmdName), NULL,
	    TCL_GLOBAL_ONLY) == NULL) {
	if (Tcl_CreateNamespace(interp, Tcl_DStringValue(&cmdName),
		NULL, NULL) == NULL) {
	    Tcl_Panic("%s.\n%s: %s",
		    Tcl_GetStringResult(interp), "Tcl_RegisterConfig",
		    "Unable to create namespace for package configuration.");
	}
    }

    TclDStringAppendLiteral(&cmdName, "::pkgconfig");

    if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName),
	    QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) {
	Tcl_Panic("%s: %s", "Tcl_RegisterConfig",
		"Unable to create query command for package configuration");
    }

Changes to generic/tclEncoding.c.
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
	goto doneParse;
    }

    /*
     * Read lines from the encoding until EOF.
     */

    for (Tcl_DStringSetLength(&lineString, 0);
	    (len = Tcl_Gets(chan, &lineString)) >= 0;
	    Tcl_DStringSetLength(&lineString, 0)) {
	const unsigned char *p;
	int to, from;

	/*
	 * Skip short lines.
	 */








|

|







1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
	goto doneParse;
    }

    /*
     * Read lines from the encoding until EOF.
     */

    for (TclDStringClear(&lineString);
	    (len = Tcl_Gets(chan, &lineString)) >= 0;
	    TclDStringClear(&lineString)) {
	const unsigned char *p;
	int to, from;

	/*
	 * Skip short lines.
	 */

Changes to generic/tclEnsemble.c.
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460

    /*
     * Construct the path for the ensemble namespace and create it.
     */

    Tcl_DStringInit(&buf);
    Tcl_DStringInit(&hiddenBuf);
    Tcl_DStringAppend(&hiddenBuf, "tcl:", -1);
    Tcl_DStringAppend(&hiddenBuf, name, -1);
    Tcl_DStringAppend(&hiddenBuf, ":", -1);
    hiddenLen = Tcl_DStringLength(&hiddenBuf);
    if (name[0] == ':' && name[1] == ':') {
	/*
	 * An absolute name, so use it directly.
	 */

	cmdName = name;
	Tcl_DStringAppend(&buf, name, -1);
	ensembleFlags = TCL_ENSEMBLE_PREFIX;
    } else {
	/*
	 * Not an absolute name, so do munging of it. Note that this treats a
	 * multi-word list differently to a single word.
	 */

	Tcl_DStringAppend(&buf, "::tcl", -1);

	if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) {
	    Tcl_Panic("invalid ensemble name '%s'", name);
	}

	for (i = 0; i < nameCount; ++i) {
	    Tcl_DStringAppend(&buf, "::", 2);
	    Tcl_DStringAppend(&buf, nameParts[i], -1);
	}
    }

    ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
	    TCL_CREATE_NS_IF_UNKNOWN);
    if (!ns) {







|

|















|






|







1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460

    /*
     * Construct the path for the ensemble namespace and create it.
     */

    Tcl_DStringInit(&buf);
    Tcl_DStringInit(&hiddenBuf);
    TclDStringAppendLiteral(&hiddenBuf, "tcl:");
    Tcl_DStringAppend(&hiddenBuf, name, -1);
    TclDStringAppendLiteral(&hiddenBuf, ":");
    hiddenLen = Tcl_DStringLength(&hiddenBuf);
    if (name[0] == ':' && name[1] == ':') {
	/*
	 * An absolute name, so use it directly.
	 */

	cmdName = name;
	Tcl_DStringAppend(&buf, name, -1);
	ensembleFlags = TCL_ENSEMBLE_PREFIX;
    } else {
	/*
	 * Not an absolute name, so do munging of it. Note that this treats a
	 * multi-word list differently to a single word.
	 */

	TclDStringAppendLiteral(&buf, "::tcl");

	if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) {
	    Tcl_Panic("invalid ensemble name '%s'", name);
	}

	for (i = 0; i < nameCount; ++i) {
	    TclDStringAppendLiteral(&buf, "::");
	    Tcl_DStringAppend(&buf, nameParts[i], -1);
	}
    }

    ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
	    TCL_CREATE_NS_IF_UNKNOWN);
    if (!ns) {
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
     * Create the ensemble mapping dictionary and the ensemble command procs.
     */

    if (ensemble != NULL) {
	Tcl_Obj *mapDict, *fromObj, *toObj;
	Command *cmdPtr;

	Tcl_DStringAppend(&buf, "::", 2);
	TclNewObj(mapDict);
	for (i=0 ; map[i].name != NULL ; i++) {
	    fromObj = Tcl_NewStringObj(map[i].name, -1);
	    TclNewStringObj(toObj, Tcl_DStringValue(&buf),
		    Tcl_DStringLength(&buf));
	    Tcl_AppendToObj(toObj, map[i].name, -1);
	    Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);







|







1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
     * Create the ensemble mapping dictionary and the ensemble command procs.
     */

    if (ensemble != NULL) {
	Tcl_Obj *mapDict, *fromObj, *toObj;
	Command *cmdPtr;

	TclDStringAppendLiteral(&buf, "::");
	TclNewObj(mapDict);
	for (i=0 ; map[i].name != NULL ; i++) {
	    fromObj = Tcl_NewStringObj(map[i].name, -1);
	    TclNewStringObj(toObj, Tcl_DStringValue(&buf),
		    Tcl_DStringLength(&buf));
	    Tcl_AppendToObj(toObj, map[i].name, -1);
	    Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
	if (ensemblePtr->parameterList == NULL) {
	    len = 0;
	} else if (TclListObjGetElements(NULL, ensemblePtr->parameterList,
		&len, &elemPtrs) != TCL_OK) {
	    Tcl_Panic("List of ensemble parameters is not a list");
	}
	for (; len>0; len--,elemPtrs++) {
	    Tcl_DStringAppend(&buf, Tcl_GetString(*elemPtrs), -1);
	    Tcl_DStringAppend(&buf, " ", -1);
	}
	Tcl_DStringAppend(&buf, "subcommand ?arg ...?", -1);
	Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
	Tcl_DStringFree(&buf);

	return TCL_ERROR;
    }

    if (ensemblePtr->nsPtr->flags & NS_DYING) {







|
|

|







1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
	if (ensemblePtr->parameterList == NULL) {
	    len = 0;
	} else if (TclListObjGetElements(NULL, ensemblePtr->parameterList,
		&len, &elemPtrs) != TCL_OK) {
	    Tcl_Panic("List of ensemble parameters is not a list");
	}
	for (; len>0; len--,elemPtrs++) {
	    TclDStringAppendObj(&buf, *elemPtrs);
	    TclDStringAppendLiteral(&buf, " ");
	}
	TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
	Tcl_DStringFree(&buf);

	return TCL_ERROR;
    }

    if (ensemblePtr->nsPtr->flags & NS_DYING) {
Changes to generic/tclFileName.c.
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
SetResultLength(
    Tcl_DString *resultPtr,
    int offset,
    int extended)
{
    Tcl_DStringSetLength(resultPtr, offset);
    if (extended == 2) {
	Tcl_DStringAppend(resultPtr, "//?/UNC/", 8);
    } else if (extended == 1) {
	Tcl_DStringAppend(resultPtr, "//?/", 4);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ExtractWinRoot --







|

|







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
SetResultLength(
    Tcl_DString *resultPtr,
    int offset,
    int extended)
{
    Tcl_DStringSetLength(resultPtr, offset);
    if (extended == 2) {
	TclDStringAppendLiteral(resultPtr, "//?/UNC/");
    } else if (extended == 1) {
	TclDStringAppendLiteral(resultPtr, "//?/");
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ExtractWinRoot --
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141

	const char *host, *share, *tail;
	int hlen, slen;

	if (path[1] != '/' && path[1] != '\\') {
	    SetResultLength(resultPtr, offset, extended);
	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
	    Tcl_DStringAppend(resultPtr, "/", 1);
	    return &path[1];
	}
	host = &path[2];

	/*
	 * Skip separators.
	 */







|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141

	const char *host, *share, *tail;
	int hlen, slen;

	if (path[1] != '/' && path[1] != '\\') {
	    SetResultLength(resultPtr, offset, extended);
	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
	    TclDStringAppendLiteral(resultPtr, "/");
	    return &path[1];
	}
	host = &path[2];

	/*
	 * Skip separators.
	 */
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
	     * page). If there are more than one, we are simply assuming they
	     * are superfluous and we trim them away. (An alternative
	     * interpretation would be that it is a host name, but we have
	     * been documented that that is not the case).
	     */

	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
	    Tcl_DStringAppend(resultPtr, "/", 1);
	    return &path[2];
	}
	SetResultLength(resultPtr, offset, extended);
	share = &host[hlen];

	/*
	 * Skip separators.
	 */

	while (share[0] == '/' || share[0] == '\\') {
	    share++;
	}

	for (slen=0; share[slen]; slen++) {
	    if (share[slen] == '/' || share[slen] == '\\') {
		break;
	    }
	}
	Tcl_DStringAppend(resultPtr, "//", 2);
	Tcl_DStringAppend(resultPtr, host, hlen);
	Tcl_DStringAppend(resultPtr, "/", 1);
	Tcl_DStringAppend(resultPtr, share, slen);

	tail = &share[slen];

	/*
	 * Skip separators.
	 */







|


















|

|







157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
	     * page). If there are more than one, we are simply assuming they
	     * are superfluous and we trim them away. (An alternative
	     * interpretation would be that it is a host name, but we have
	     * been documented that that is not the case).
	     */

	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
	    TclDStringAppendLiteral(resultPtr, "/");
	    return &path[2];
	}
	SetResultLength(resultPtr, offset, extended);
	share = &host[hlen];

	/*
	 * Skip separators.
	 */

	while (share[0] == '/' || share[0] == '\\') {
	    share++;
	}

	for (slen=0; share[slen]; slen++) {
	    if (share[slen] == '/' || share[slen] == '\\') {
		break;
	    }
	}
	TclDStringAppendLiteral(resultPtr, "//");
	Tcl_DStringAppend(resultPtr, host, hlen);
	TclDStringAppendLiteral(resultPtr, "/");
	Tcl_DStringAppend(resultPtr, share, slen);

	tail = &share[slen];

	/*
	 * Skip separators.
	 */
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231

	    while (*tail && (tail[0] == '/' || tail[0] == '\\')) {
		tail++;
	    }

	    *typePtr = TCL_PATH_ABSOLUTE;
	    Tcl_DStringAppend(resultPtr, path, 2);
	    Tcl_DStringAppend(resultPtr, "/", 1);

	    return tail;
	}
    } else {
	int abs = 0;

	/*







|







217
218
219
220
221
222
223
224
225
226
227
228
229
230
231

	    while (*tail && (tail[0] == '/' || tail[0] == '\\')) {
		tail++;
	    }

	    *typePtr = TCL_PATH_ABSOLUTE;
	    Tcl_DStringAppend(resultPtr, path, 2);
	    TclDStringAppendLiteral(resultPtr, "/");

	    return tail;
	}
    } else {
	int abs = 0;

	/*
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
    transPtr = Tcl_FSGetTranslatedPath(interp, path);
    if (transPtr == NULL) {
	Tcl_DecrRefCount(path);
	return NULL;
    }

    Tcl_DStringInit(bufferPtr);
    Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
    Tcl_DecrRefCount(path);
    Tcl_DecrRefCount(transPtr);

    /*
     * Convert forward slashes to backslashes in Windows paths because some
     * system interfaces don't accept forward slashes.
     */







|







1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
    transPtr = Tcl_FSGetTranslatedPath(interp, path);
    if (transPtr == NULL) {
	Tcl_DecrRefCount(path);
	return NULL;
    }

    Tcl_DStringInit(bufferPtr);
    TclDStringAppendObj(bufferPtr, transPtr);
    Tcl_DecrRefCount(path);
    Tcl_DecrRefCount(transPtr);

    /*
     * Convert forward slashes to backslashes in Windows paths because some
     * system interfaces don't accept forward slashes.
     */
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
	     * Need to quote 'prefix'.
	     */

	    Tcl_DStringInit(&prefix);
	    search = Tcl_DStringValue(&pref);
	    while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
		Tcl_DStringAppend(&prefix, search, find-search);
		Tcl_DStringAppend(&prefix, "\\", 1);
		Tcl_DStringAppend(&prefix, find, 1);
		search = find+1;
		if (*search == '\0') {
		    break;
		}
	    }
	    if (*search != '\0') {







|







1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
	     * Need to quote 'prefix'.
	     */

	    Tcl_DStringInit(&prefix);
	    search = Tcl_DStringValue(&pref);
	    while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
		Tcl_DStringAppend(&prefix, search, find-search);
		TclDStringAppendLiteral(&prefix, "\\");
		Tcl_DStringAppend(&prefix, find, 1);
		search = find+1;
		if (*search == '\0') {
		    break;
		}
	    }
	    if (*search != '\0') {
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
    result = TCL_OK;

    if (join) {
	if (dir != PATH_GENERAL) {
	    Tcl_DStringInit(&prefix);
	}
	for (i = 0; i < objc; i++) {
	    string = Tcl_GetStringFromObj(objv[i], &length);
	    Tcl_DStringAppend(&prefix, string, length);
	    if (i != objc -1) {
		Tcl_DStringAppend(&prefix, separators, 1);
	    }
	}
	if (TclGlob(interp, Tcl_DStringValue(&prefix), pathOrDir, globFlags,
		globTypes) != TCL_OK) {
	    result = TCL_ERROR;
	    goto endOfGlob;
	}
    } else if (dir == PATH_GENERAL) {
	Tcl_DString str;

	for (i = 0; i < objc; i++) {
	    Tcl_DStringInit(&str);
	    if (dir == PATH_GENERAL) {
		Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
			Tcl_DStringLength(&prefix));
	    }
	    string = Tcl_GetStringFromObj(objv[i], &length);
	    Tcl_DStringAppend(&str, string, length);
	    if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags,
		    globTypes) != TCL_OK) {
		result = TCL_ERROR;
		Tcl_DStringFree(&str);
		goto endOfGlob;
	    }
	}







<
|















|
<

<
|







1567
1568
1569
1570
1571
1572
1573

1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590

1591

1592
1593
1594
1595
1596
1597
1598
1599
    result = TCL_OK;

    if (join) {
	if (dir != PATH_GENERAL) {
	    Tcl_DStringInit(&prefix);
	}
	for (i = 0; i < objc; i++) {

	    TclDStringAppendObj(&prefix, objv[i]);
	    if (i != objc -1) {
		Tcl_DStringAppend(&prefix, separators, 1);
	    }
	}
	if (TclGlob(interp, Tcl_DStringValue(&prefix), pathOrDir, globFlags,
		globTypes) != TCL_OK) {
	    result = TCL_ERROR;
	    goto endOfGlob;
	}
    } else if (dir == PATH_GENERAL) {
	Tcl_DString str;

	for (i = 0; i < objc; i++) {
	    Tcl_DStringInit(&str);
	    if (dir == PATH_GENERAL) {
		TclDStringAppendDString(&str, &prefix);

	    }

	    TclDStringAppendObj(&str, objv[i]);
	    if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags,
		    globTypes) != TCL_OK) {
		result = TCL_ERROR;
		Tcl_DStringFree(&str);
		goto endOfGlob;
	    }
	}
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
	}

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
		if (((*name == '\\') && (name[1] == '/' ||
			name[1] == '\\')) || (*name == '/')) {
		    Tcl_DStringAppend(&append, "/", 1);
		} else {
		    Tcl_DStringAppend(&append, ".", 1);
		}
	    }

	    break;

	case TCL_PLATFORM_UNIX:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
		    Tcl_DStringAppend(&append, "/", 1);
		} else {
		    Tcl_DStringAppend(&append, ".", 1);
		}
	    }
	    break;
	}

	/*
	 * Common for all platforms.







|

|








|

|







2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
	}

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
		if (((*name == '\\') && (name[1] == '/' ||
			name[1] == '\\')) || (*name == '/')) {
		    TclDStringAppendLiteral(&append, "/");
		} else {
		    TclDStringAppendLiteral(&append, ".");
		}
	    }

	    break;

	case TCL_PLATFORM_UNIX:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
		    TclDStringAppendLiteral(&append, "/");
		} else {
		    TclDStringAppendLiteral(&append, ".");
		}
	    }
	    break;
	}

	/*
	 * Common for all platforms.
Changes to generic/tclFileSystem.h.
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
84
85
86
87
88
89
90
 */

#ifndef _TCLFILESYSTEM
#define _TCLFILESYSTEM

#include "tcl.h"

/*
 * struct FilesystemRecord --
 *
 * A filesystem record is used to keep track of each filesystem currently
 * registered with the core, in a linked list. Pointers to these structures
 * are also kept by each "path" Tcl_Obj, and we must retain a refCount on the
 * number of such references.
 */

typedef struct FilesystemRecord {
    ClientData clientData;	/* Client specific data for the new filesystem
				 * (can be NULL) */
    const Tcl_Filesystem *fsPtr;	/* Pointer to filesystem dispatch table. */
    struct FilesystemRecord *nextPtr;
				/* The next filesystem registered to Tcl, or
				 * NULL if no more. */
    struct FilesystemRecord *prevPtr;
				/* The previous filesystem registered to Tcl,
				 * or NULL if no more. */
} FilesystemRecord;

/*
 * This structure holds per-thread private copy of the current directory
 * maintained by the global cwdPathPtr. This structure holds per-thread
 * private copies of some global data. This way we avoid most of the
 * synchronization calls which boosts performance, at cost of having to update
 * this information each time the corresponding epoch counter changes.
 */

typedef struct ThreadSpecificData {
    int initialized;
    int cwdPathEpoch;
    int filesystemEpoch;
    Tcl_Obj *cwdPathPtr;
    ClientData cwdClientData;
    FilesystemRecord *filesystemList;
    int claims;
} ThreadSpecificData;

/*
 * The internal TclFS API provides routines for handling and manipulating
 * paths efficiently, taking direct advantage of the "path" Tcl_Obj type.
 *
 * These functions are not exported at all at present.
 */

MODULE_SCOPE int	TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr);
MODULE_SCOPE int	TclFSMakePathFromNormalized(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclFSNormalizeToUniquePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int startAt);
MODULE_SCOPE Tcl_Obj *	TclFSMakePathRelative(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
MODULE_SCOPE int	TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **fsPtrPtr);
MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem *fsPtr, ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);


/*
 * Private shared variables for use by tclIOUtil.c and tclPathObj.c
 */

MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem;
MODULE_SCOPE Tcl_ThreadDataKey tclFsDataKey;

/*
 * Private shared functions for use by tclIOUtil.c, tclPathObj.c and
 * tclFileName.c, and any platform-specific filesystem code.
 */

MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr,







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








<
<










>






<







11
12
13
14
15
16
17







































18
19
20
21
22
23
24
25


26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
 */

#ifndef _TCLFILESYSTEM
#define _TCLFILESYSTEM

#include "tcl.h"








































/*
 * The internal TclFS API provides routines for handling and manipulating
 * paths efficiently, taking direct advantage of the "path" Tcl_Obj type.
 *
 * These functions are not exported at all at present.
 */

MODULE_SCOPE int	TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr);


MODULE_SCOPE int	TclFSNormalizeToUniquePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int startAt);
MODULE_SCOPE Tcl_Obj *	TclFSMakePathRelative(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
MODULE_SCOPE int	TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **fsPtrPtr);
MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem *fsPtr, ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclFSEpoch(void);

/*
 * Private shared variables for use by tclIOUtil.c and tclPathObj.c
 */

MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem;


/*
 * Private shared functions for use by tclIOUtil.c, tclPathObj.c and
 * tclFileName.c, and any platform-specific filesystem code.
 */

MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr,
Changes to generic/tclIO.c.
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_DString *lineRead)	/* The line read will be appended to this
				 * DString as UTF-8 characters. The caller
				 * must have initialized it and is responsible
				 * for managing the storage. */
{
    Tcl_Obj *objPtr;
    int charsStored, length;
    const char *string;

    TclNewObj(objPtr);
    charsStored = Tcl_GetsObj(chan, objPtr);
    if (charsStored > 0) {
	string = TclGetStringFromObj(objPtr, &length);
	Tcl_DStringAppend(lineRead, string, length);
    }
    TclDecrRefCount(objPtr);
    return charsStored;
}

/*
 *---------------------------------------------------------------------------







|
<




<
|







4427
4428
4429
4430
4431
4432
4433
4434

4435
4436
4437
4438

4439
4440
4441
4442
4443
4444
4445
4446
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_DString *lineRead)	/* The line read will be appended to this
				 * DString as UTF-8 characters. The caller
				 * must have initialized it and is responsible
				 * for managing the storage. */
{
    Tcl_Obj *objPtr;
    int charsStored;


    TclNewObj(objPtr);
    charsStored = Tcl_GetsObj(chan, objPtr);
    if (charsStored > 0) {

	TclDStringAppendObj(lineRead, objPtr);
    }
    TclDecrRefCount(objPtr);
    return charsStored;
}

/*
 *---------------------------------------------------------------------------
7546
7547
7548
7549
7550
7551
7552
7553
7554
7555
7556
7557
7558
7559
7560
	const char **argv;
	int argc, i;
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, genericopt, -1);
	if (optionList && (*optionList)) {
	    Tcl_DStringAppend(&ds, " ", 1);
	    Tcl_DStringAppend(&ds, optionList, -1);
	}
	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
		&argc, &argv) != TCL_OK) {
	    Tcl_Panic("malformed option list in channel driver");
	}
	Tcl_ResetResult(interp);







|







7544
7545
7546
7547
7548
7549
7550
7551
7552
7553
7554
7555
7556
7557
7558
	const char **argv;
	int argc, i;
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, genericopt, -1);
	if (optionList && (*optionList)) {
	    TclDStringAppendLiteral(&ds, " ");
	    Tcl_DStringAppend(&ds, optionList, -1);
	}
	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
		&argc, &argv) != TCL_OK) {
	    Tcl_Panic("malformed option list in channel driver");
	}
	Tcl_ResetResult(interp);
Changes to generic/tclIORChan.c.
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957

    /*
     * The result has to go into the 'dsPtr' for propagation to the caller of
     * the driver.
     */

    if (optionObj != NULL) {
	Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1);
        goto ok;
    }

    /*
     * Extract the list and append each item as element.
     */








|







1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957

    /*
     * The result has to go into the 'dsPtr' for propagation to the caller of
     * the driver.
     */

    if (optionObj != NULL) {
	TclDStringAppendObj(dsPtr, resObj);
        goto ok;
    }

    /*
     * Extract the list and append each item as element.
     */

1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
		(listc == 1 ? "" : "s")));
        goto error;
    } else {
	int len;
	const char *str = Tcl_GetStringFromObj(resObj, &len);

	if (len) {
	    Tcl_DStringAppend(dsPtr, " ", 1);
	    Tcl_DStringAppend(dsPtr, str, len);
	}
        goto ok;
    }

 ok:
    result = TCL_OK;







|







1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
		(listc == 1 ? "" : "s")));
        goto error;
    } else {
	int len;
	const char *str = Tcl_GetStringFromObj(resObj, &len);

	if (len) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    Tcl_DStringAppend(dsPtr, str, len);
	}
        goto ok;
    }

 ok:
    result = TCL_OK;
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
        Tcl_IncrRefCount(optionObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    Tcl_DStringAppend(paramPtr->getOpt.value,
                              TclGetString(resObj), -1);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(optionObj);
	break;
    }

    case ForwardedGetOptAll:







|
<







3203
3204
3205
3206
3207
3208
3209
3210

3211
3212
3213
3214
3215
3216
3217
	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
        Tcl_IncrRefCount(optionObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    TclDStringAppendObj(paramPtr->getOpt.value, resObj);

	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(optionObj);
	break;
    }

    case ForwardedGetOptAll:
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
	     * NOTE (4) as well.
	     */

	    int listc;
	    Tcl_Obj **listv;

	    if (Tcl_ListObjGetElements(interp, resObj, &listc,
                                       &listv) != TCL_OK) {
		Tcl_DecrRefCount(resObj);
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
	    } else if ((listc % 2) == 1) {
		/*
		 * Odd number of elements is wrong. [x].
		 */

		char *buf = ckalloc(200);
		sprintf(buf,
			"{Expected list with even number of elements, got %d %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		int len;
		const char *str = Tcl_GetStringFromObj(resObj, &len);

		if (len) {
		    Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1);
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }
	}
        Tcl_Release(rcPtr);
	break;








|



















|







3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
	     * NOTE (4) as well.
	     */

	    int listc;
	    Tcl_Obj **listv;

	    if (Tcl_ListObjGetElements(interp, resObj, &listc,
                    &listv) != TCL_OK) {
		Tcl_DecrRefCount(resObj);
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
	    } else if ((listc % 2) == 1) {
		/*
		 * Odd number of elements is wrong. [x].
		 */

		char *buf = ckalloc(200);
		sprintf(buf,
			"{Expected list with even number of elements, got %d %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		int len;
		const char *str = Tcl_GetStringFromObj(resObj, &len);

		if (len) {
		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }
	}
        Tcl_Release(rcPtr);
	break;

Changes to generic/tclIOUtil.c.
23
24
25
26
27
28
29





































30
31
32
33
34
35
36
#endif
#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"






































/*
 * Prototypes for functions defined later in this file.
 */

static int		EvalFileCallback(ClientData data[],
			    Tcl_Interp *interp, int result);
static FilesystemRecord*FsGetFirstFilesystem(void);







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







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
#endif
#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"

/*
 * struct FilesystemRecord --
 *
 * A filesystem record is used to keep track of each filesystem currently
 * registered with the core, in a linked list.
 */

typedef struct FilesystemRecord {
    ClientData clientData;	/* Client specific data for the new filesystem
				 * (can be NULL) */
    const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */
    struct FilesystemRecord *nextPtr;
				/* The next filesystem registered to Tcl, or
				 * NULL if no more. */
    struct FilesystemRecord *prevPtr;
				/* The previous filesystem registered to Tcl,
				 * or NULL if no more. */
} FilesystemRecord;

/*
 * This structure holds per-thread private copy of the current directory
 * maintained by the global cwdPathPtr. This structure holds per-thread
 * private copies of some global data. This way we avoid most of the
 * synchronization calls which boosts performance, at cost of having to update
 * this information each time the corresponding epoch counter changes.
 */

typedef struct ThreadSpecificData {
    int initialized;
    int cwdPathEpoch;
    int filesystemEpoch;
    Tcl_Obj *cwdPathPtr;
    ClientData cwdClientData;
    FilesystemRecord *filesystemList;
    int claims;
} ThreadSpecificData;

/*
 * Prototypes for functions defined later in this file.
 */

static int		EvalFileCallback(ClientData data[],
			    Tcl_Interp *interp, int result);
static FilesystemRecord*FsGetFirstFilesystem(void);
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
 */

static Tcl_Obj *cwdPathPtr = NULL;
static int cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)

Tcl_ThreadDataKey tclFsDataKey;

/*
 * One of these structures is used each time we successfully load a file from
 * a file system by way of making a temporary copy of the file on the native
 * filesystem. We need to store both the actual unloadProc/clientData
 * combination which was used, and the original and modified filenames, so
 * that we can correctly undo the entire operation when we want to unload the







|







228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
 */

static Tcl_Obj *cwdPathPtr = NULL;
static int cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)

static Tcl_ThreadDataKey fsDataKey;

/*
 * One of these structures is used each time we successfully load a file from
 * a file system by way of making a temporary copy of the file on the native
 * filesystem. We need to store both the actual unloadProc/clientData
 * combination which was used, and the original and modified filenames, so
 * that we can correctly undo the entire operation when we want to unload the
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
{
    Tcl_Obj *cwd = Tcl_FSGetCwd(interp);

    if (cwd == NULL) {
	return NULL;
    }
    Tcl_DStringInit(cwdPtr);
    Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
    Tcl_DecrRefCount(cwd);
    return Tcl_DStringValue(cwdPtr);
}

/* Obsolete */
int
Tcl_EvalFile(







|







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
{
    Tcl_Obj *cwd = Tcl_FSGetCwd(interp);

    if (cwd == NULL) {
	return NULL;
    }
    Tcl_DStringInit(cwdPtr);
    TclDStringAppendObj(cwdPtr, cwd);
    Tcl_DecrRefCount(cwd);
    return Tcl_DStringValue(cwdPtr);
}

/* Obsolete */
int
Tcl_EvalFile(
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
    }
    tsdPtr->initialized = 0;
}

int
TclFSCwdIsNative(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (tsdPtr->cwdClientData != NULL) {
	return 1;
    } else {
	return 0;
    }
}







|







462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
    }
    tsdPtr->initialized = 0;
}

int
TclFSCwdIsNative(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (tsdPtr->cwdClientData != NULL) {
	return 1;
    } else {
	return 0;
    }
}
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
 *----------------------------------------------------------------------
 */

int
TclFSCwdPointerEquals(
    Tcl_Obj **pathPtrPtr)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    Tcl_MutexLock(&cwdMutex);
    if (tsdPtr->cwdPathPtr == NULL
	    || tsdPtr->cwdPathEpoch != cwdPathEpoch) {
	if (tsdPtr->cwdPathPtr != NULL) {
	    Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
	}







|







496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
 *----------------------------------------------------------------------
 */

int
TclFSCwdPointerEquals(
    Tcl_Obj **pathPtrPtr)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    Tcl_MutexLock(&cwdMutex);
    if (tsdPtr->cwdPathPtr == NULL
	    || tsdPtr->cwdPathEpoch != cwdPathEpoch) {
	if (tsdPtr->cwdPathPtr != NULL) {
	    Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
	}
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
	}
    }
}

static void
FsRecacheFilesystemList(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list;

    /*
     * Trash the current cache.
     */

    fsRecPtr = tsdPtr->filesystemList;







|







558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
	}
    }
}

static void
FsRecacheFilesystemList(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
    FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list;

    /*
     * Trash the current cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
	tsdPtr->initialized = 1;
    }
}

static FilesystemRecord *
FsGetFirstFilesystem(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0)
	    && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) {
	FsRecacheFilesystemList();
    }
    return tsdPtr->filesystemList;
}








|







622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
	tsdPtr->initialized = 1;
    }
}

static FilesystemRecord *
FsGetFirstFilesystem(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
    if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0)
	    && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) {
	FsRecacheFilesystemList();
    }
    return tsdPtr->filesystemList;
}

608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624








625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
{
    return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
}

static void
Claim()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    tsdPtr->claims++;
}

static void
Disclaim()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    tsdPtr->claims--;
}









/*
 * If non-NULL, clientData is owned by us and must be freed later.
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,
    ClientData clientData)
{
    int len;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (cwdObj != NULL) {
	str = Tcl_GetStringFromObj(cwdObj, &len);
    }

    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr != NULL) {







|






|


>
>
>
>
>
>
>
>












|







645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
{
    return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
}

static void
Claim()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
    tsdPtr->claims++;
}

static void
Disclaim()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
    tsdPtr->claims--;
}

int
TclFSEpoch()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
    return tsdPtr->filesystemEpoch;
}


/*
 * If non-NULL, clientData is owned by us and must be freed later.
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,
    ClientData clientData)
{
    int len;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = Tcl_GetStringFromObj(cwdObj, &len);
    }

    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr != NULL) {
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSGetCwd(
    Tcl_Interp *interp)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (TclFSCwdPointerEquals(NULL)) {
	FilesystemRecord *fsRecPtr;
	Tcl_Obj *retVal = NULL;

	/*
	 * We've never been called before, try to find a cwd. Call each of the







|







2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSGetCwd(
    Tcl_Interp *interp)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (TclFSCwdPointerEquals(NULL)) {
	FilesystemRecord *fsRecPtr;
	Tcl_Obj *retVal = NULL;

	/*
	 * We've never been called before, try to find a cwd. Call each of the
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
	     * again here. On Unix it might actually be true that we always
	     * have the correct form in the native rep in which case we could
	     * simply use:
	     *		cd = Tcl_FSGetNativePath(pathPtr);
	     * instead. This should be examined by someone on Unix.
	     */

	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
	    ClientData cd;
	    ClientData oldcd = tsdPtr->cwdClientData;

	    /*
	     * Assumption we are using a filesystem version 2.
	     */








|







2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
	     * again here. On Unix it might actually be true that we always
	     * have the correct form in the native rep in which case we could
	     * simply use:
	     *		cd = Tcl_FSGetNativePath(pathPtr);
	     * instead. This should be examined by someone on Unix.
	     */

	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
	    ClientData cd;
	    ClientData oldcd = tsdPtr->cwdClientData;

	    /*
	     * Assumption we are using a filesystem version 2.
	     */

Changes to generic/tclIndexObj.c.
298
299
300
301
302
303
304




305
306
307
308
309
310
311
     *  - Several abbreviations (never allowed, but overridden by exact match)
     */

    for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL;
	    entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) {
	for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
	    if (*p1 == '\0') {




		index = idx;
		goto done;
	    }
	}
	if (*p1 == '\0') {
	    /*
	     * The value is an abbreviation for this entry. Continue checking







>
>
>
>







298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
     *  - Several abbreviations (never allowed, but overridden by exact match)
     */

    for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL;
	    entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) {
	for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
	    if (*p1 == '\0') {
		if (p1 == key) {
		    /* empty keys never match */
		    continue;
		}
		index = idx;
		goto done;
	    }
	}
	if (*p1 == '\0') {
	    /*
	     * The value is an abbreviation for this entry. Continue checking
352
353
354
355
356
357
358
359
360
361




362
363
364
365
366
367
368
369
370
371
372

373
374
375
376
377

378

379
380
381
382
383
384
385

  error:
    if (interp != NULL) {
	/*
	 * Produce a fancy error message.
	 */

	int count;

	TclNewObj(resultPtr);




	Tcl_AppendStringsToObj(resultPtr,
		(numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "),
		msg, " \"", key, NULL);
	if (STRING_AT(tablePtr, offset, 0) == NULL) {
	    Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL);
	} else {
	    Tcl_AppendStringsToObj(resultPtr, "\": must be ",
		    STRING_AT(tablePtr, offset, 0), NULL);
	    for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0;
		    *entryPtr != NULL;
		    entryPtr = NEXT_ENTRY(entryPtr, offset), count++) {

		if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
		    Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""),
			    " or ", *entryPtr, NULL);
		} else {
		    Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);

		}

	    }
	}
	Tcl_SetObjResult(interp, resultPtr);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
    }
    return TCL_ERROR;
}







|


>
>
>
>



|



<
<
|
|
>



|

>

>







356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376


377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

  error:
    if (interp != NULL) {
	/*
	 * Produce a fancy error message.
	 */

	int count = 0;

	TclNewObj(resultPtr);
	entryPtr = tablePtr;
	while ((*entryPtr != NULL) && !**entryPtr) {
	    entryPtr = NEXT_ENTRY(entryPtr, offset);
	}
	Tcl_AppendStringsToObj(resultPtr,
		(numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "),
		msg, " \"", key, NULL);
	if (*entryPtr == NULL) {
	    Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL);
	} else {
	    Tcl_AppendStringsToObj(resultPtr, "\": must be ",


		    *entryPtr, NULL);
	    entryPtr = NEXT_ENTRY(entryPtr, offset);
	    while (*entryPtr != NULL) {
		if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
		    Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""),
			    " or ", *entryPtr, NULL);
		} else if (**entryPtr) {
		    Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);
		    count++;
		}
		entryPtr = NEXT_ENTRY(entryPtr, offset);
	    }
	}
	Tcl_SetObjResult(interp, resultPtr);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
    }
    return TCL_ERROR;
}
Changes to generic/tclInt.decls.
1091
1092
1093
1094
1095
1096
1097





1098
1099
1100
1101
1102
1103
1104
# Signature changed in 8.1:
#  declare 16 win {
#      TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr)
#  }
#  declare 17 win {
#      char *TclpGetTZName(void)
#  }





declare 18 win {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 19 win {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {







>
>
>
>
>







1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
# Signature changed in 8.1:
#  declare 16 win {
#      TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr)
#  }
#  declare 17 win {
#      char *TclpGetTZName(void)
#  }
# new for 8.5.12+ Cygwin only
declare 17 win {
    int TclUnixCopyFile(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
}
declare 18 win {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 19 win {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
Changes to generic/tclInt.h.
2916
2917
2918
2919
2920
2921
2922




2923
2924
2925
2926
2927
2928
2929
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);




MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
MODULE_SCOPE void	TclFinalizeEnvironment(void);
MODULE_SCOPE void	TclFinalizeEvaluation(void);







>
>
>
>







2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
			    Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
MODULE_SCOPE void	TclFinalizeEnvironment(void);
MODULE_SCOPE void	TclFinalizeEvaluation(void);
4446
4447
4448
4449
4450
4451
4452















4453
4454
4455
4456
4457
4458
4459
/*
 * The sLiteral argument *must* be a string literal; the incantation with
 * sizeof(sLiteral "") will fail to compile otherwise.
 */
#define TclNewLiteralStringObj(objPtr, sLiteral) \
    TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
















/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to test for some special double values.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE int	TclIsInfinite(double d);
 * MODULE_SCOPE int	TclIsNaN(double d);







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







4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
/*
 * The sLiteral argument *must* be a string literal; the incantation with
 * sizeof(sLiteral "") will fail to compile otherwise.
 */
#define TclNewLiteralStringObj(objPtr, sLiteral) \
    TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))

/*
 *----------------------------------------------------------------
 * Convenience macros for DStrings.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr,
 *			const char *sLiteral);
 * MODULE_SCOPE void   TclDStringClear(Tcl_DString *dsPtr);
 */

#define TclDStringAppendLiteral(dsPtr, sLiteral) \
    Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
#define TclDStringClear(dsPtr) \
    Tcl_DStringSetLength((dsPtr), 0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to test for some special double values.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE int	TclIsInfinite(double d);
 * MODULE_SCOPE int	TclIsNaN(double d);
Changes to generic/tclIntPlatDecls.h.
136
137
138
139
140
141
142
143



144
145
146
147
148
149
150
/* 15 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 16 */
EXTERN int		TclpIsAtty(int fd);
/* Slot 17 is reserved */



/* 18 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void		TclWinAddProcess(HANDLE hProcess, DWORD id);
/* 21 */







|
>
>
>







136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
/* 15 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 16 */
EXTERN int		TclpIsAtty(int fd);
/* 17 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 18 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void		TclWinAddProcess(HANDLE hProcess, DWORD id);
/* 21 */
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    int (*tclpIsAtty) (int fd); /* 16 */
    void (*reserved17)(void);
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
    void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
    char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */







|







288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    int (*tclpIsAtty) (int fd); /* 16 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
    void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
    char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
429
430
431
432
433
434
435
436

437
438
439
440
441
442
443
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
/* Slot 17 is reserved */

#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
#define TclpInetNtoa \







|
>







432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
#define TclpInetNtoa \
Changes to generic/tclLoad.c.
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
    Tcl_MutexLock(&packageMutex);

    defaultPtr = NULL;
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
	if (packageName == NULL) {
	    namesMatch = 0;
	} else {
	    Tcl_DStringSetLength(&pkgName, 0);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    Tcl_DStringSetLength(&tmp, 0);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	Tcl_DStringSetLength(&pkgName, 0);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	    break;
	}
	if (namesMatch && (fullFileName[0] == 0)) {
	    defaultPtr = pkgPtr;







|

|










|







194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
    Tcl_MutexLock(&packageMutex);

    defaultPtr = NULL;
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
	if (packageName == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pkgName);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	TclDStringClear(&pkgName);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	    break;
	}
	if (namesMatch && (fullFileName[0] == 0)) {
	    defaultPtr = pkgPtr;
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
			    "couldn't figure out package name for ",
			    fullFileName, NULL);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
			    "WHATPACKAGE", NULL);
		    code = TCL_ERROR;
		    goto done;
		}
		Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess));
		Tcl_DecrRefCount(splitPtr);
	    }
	}

	/*
	 * Fix the capitalization in the package name so that the first
	 * character is in caps (or title case) but the others are all
	 * lower-case.
	 */

	Tcl_DStringSetLength(&pkgName,
		Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));

	/*
	 * Compute the names of the two initialization functions, based on the
	 * package name.
	 */

	Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1);
	Tcl_DStringAppend(&initName, "_Init", 5);
	Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1);
	Tcl_DStringAppend(&safeInitName, "_SafeInit", 9);
	Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1);
	Tcl_DStringAppend(&unloadName, "_Unload", 7);
	Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1);
	Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11);

	/*
	 * Call platform-specific code to load the package and find the two
	 * initialization functions.
	 */

	symbols[0] = Tcl_DStringValue(&initName);







|


















|
|
|
|
|
|
|
|







325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
			    "couldn't figure out package name for ",
			    fullFileName, NULL);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
			    "WHATPACKAGE", NULL);
		    code = TCL_ERROR;
		    goto done;
		}
		Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
		Tcl_DecrRefCount(splitPtr);
	    }
	}

	/*
	 * Fix the capitalization in the package name so that the first
	 * character is in caps (or title case) but the others are all
	 * lower-case.
	 */

	Tcl_DStringSetLength(&pkgName,
		Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));

	/*
	 * Compute the names of the two initialization functions, based on the
	 * package name.
	 */

	TclDStringAppendDString(&initName, &pkgName);
	TclDStringAppendLiteral(&initName, "_Init");
	TclDStringAppendDString(&safeInitName, &pkgName);
	TclDStringAppendLiteral(&safeInitName, "_SafeInit");
	TclDStringAppendDString(&unloadName, &pkgName);
	TclDStringAppendLiteral(&unloadName, "_Unload");
	TclDStringAppendDString(&safeUnloadName, &pkgName);
	TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");

	/*
	 * Call platform-specific code to load the package and find the two
	 * initialization functions.
	 */

	symbols[0] = Tcl_DStringValue(&initName);
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
    defaultPtr = NULL;
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
	int namesMatch, filesMatch;

	if (packageName == NULL) {
	    namesMatch = 0;
	} else {
	    Tcl_DStringSetLength(&pkgName, 0);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    Tcl_DStringSetLength(&tmp, 0);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	Tcl_DStringSetLength(&pkgName, 0);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	    break;
	}
	if (namesMatch && (fullFileName[0] == 0)) {
	    defaultPtr = pkgPtr;







|

|










|







619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
    defaultPtr = NULL;
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
	int namesMatch, filesMatch;

	if (packageName == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pkgName);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	TclDStringClear(&pkgName);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	    break;
	}
	if (namesMatch && (fullFileName[0] == 0)) {
	    defaultPtr = pkgPtr;
Changes to generic/tclNamesp.c.
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 *   [email protected]
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h" /* for NRCommand; and TclLogCommandInfo visibility */

/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.
 */

typedef struct ThreadSpecificData {







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 *   [email protected]
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h" /* for TclLogCommandInfo visibility */

/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.
 */

typedef struct ThreadSpecificData {
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
    namePtr = &buffer1;
    buffPtr = &buffer2;
    for (ancestorPtr = nsPtr; ancestorPtr != NULL;
	    ancestorPtr = ancestorPtr->parentPtr) {
	if (ancestorPtr != globalNsPtr) {
	    register Tcl_DString *tempPtr = namePtr;

	    Tcl_DStringAppend(buffPtr, "::", 2);
	    Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
	    Tcl_DStringAppend(buffPtr, Tcl_DStringValue(namePtr),
		    Tcl_DStringLength(namePtr));

	    /*
	     * Clear the unwanted buffer or we end up appending to previous
	     * results, making the namespace fullNames of nested namespaces
	     * very wrong (and strange).
	     */

	    Tcl_DStringSetLength(namePtr, 0);

	    /*
	     * Now swap the buffer pointers so that we build in the other
	     * buffer. This is faster than repeated copying back and forth
	     * between buffers.
	     */








|

|
<







|







799
800
801
802
803
804
805
806
807
808

809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
    namePtr = &buffer1;
    buffPtr = &buffer2;
    for (ancestorPtr = nsPtr; ancestorPtr != NULL;
	    ancestorPtr = ancestorPtr->parentPtr) {
	if (ancestorPtr != globalNsPtr) {
	    register Tcl_DString *tempPtr = namePtr;

	    TclDStringAppendLiteral(buffPtr, "::");
	    Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
	    TclDStringAppendDString(buffPtr, namePtr);


	    /*
	     * Clear the unwanted buffer or we end up appending to previous
	     * results, making the namespace fullNames of nested namespaces
	     * very wrong (and strange).
	     */

	    TclDStringClear(namePtr);

	    /*
	     * Now swap the buffer pointers so that we build in the other
	     * buffer. This is faster than repeated copying back and forth
	     * between buffers.
	     */

912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
     * NOTE: we could avoid traversing the ns's command list by keeping a
     * separate list of coros.
     */

    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	    entryPtr != NULL;) {
	cmdPtr = Tcl_GetHashValue(entryPtr);
	if (cmdPtr->nreProc == NRInterpCoroutine) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
		    (Tcl_Command) cmdPtr);
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	} else {
	    entryPtr = Tcl_NextHashEntry(&search);
	}
    }







|







911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
     * NOTE: we could avoid traversing the ns's command list by keeping a
     * separate list of coros.
     */

    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	    entryPtr != NULL;) {
	cmdPtr = Tcl_GetHashValue(entryPtr);
	if (cmdPtr->nreProc == TclNRInterpCoroutine) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
		    (Tcl_Command) cmdPtr);
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	} else {
	    entryPtr = Tcl_NextHashEntry(&search);
	}
    }
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
	ImportedCmdData *dataPtr;
	Command *cmdPtr;
	ImportRef *refPtr;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	if (nsPtr != ((Interp *) interp)->globalNsPtr) {
	    Tcl_DStringAppend(&ds, "::", 2);
	}
	Tcl_DStringAppend(&ds, cmdName, -1);

	/*
	 * Check whether creating the new imported command in the current
	 * namespace would create a cycle of imported command references.
	 */







|







1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
	ImportedCmdData *dataPtr;
	Command *cmdPtr;
	ImportRef *refPtr;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	if (nsPtr != ((Interp *) interp)->globalNsPtr) {
	    TclDStringAppendLiteral(&ds, "::");
	}
	Tcl_DStringAppend(&ds, cmdName, -1);

	/*
	 * Check whether creating the new imported command in the current
	 * namespace would create a cycle of imported command references.
	 */
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
	     * start points to the beginning of a namespace qualifier ending
	     * in "::". end points to the start of a name in that namespace
	     * that might be empty. Copy the namespace qualifier to a buffer
	     * so it can be null terminated. We can't modify the incoming
	     * qualName since it may be a string constant.
	     */

	    Tcl_DStringSetLength(&buffer, 0);
	    Tcl_DStringAppend(&buffer, start, len);
	    nsName = Tcl_DStringValue(&buffer);
	}

	/*
	 * Look up the namespace qualifier nsName in the current namespace
	 * context. If it isn't found but TCL_CREATE_NS_IF_UNKNOWN is set,







|







2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
	     * start points to the beginning of a namespace qualifier ending
	     * in "::". end points to the start of a name in that namespace
	     * that might be empty. Copy the namespace qualifier to a buffer
	     * so it can be null terminated. We can't modify the incoming
	     * qualName since it may be a string constant.
	     */

	    TclDStringClear(&buffer);
	    Tcl_DStringAppend(&buffer, start, len);
	    nsName = Tcl_DStringValue(&buffer);
	}

	/*
	 * Look up the namespace qualifier nsName in the current namespace
	 * context. If it isn't found but TCL_CREATE_NS_IF_UNKNOWN is set,
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
	const char *name = TclGetString(objv[2]);

	if ((*name == ':') && (*(name+1) == ':')) {
	    pattern = name;
	} else {
	    Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
	    if (nsPtr != globalNsPtr) {
		Tcl_DStringAppend(&buffer, "::", 2);
	    }
	    Tcl_DStringAppend(&buffer, name, -1);
	    pattern = Tcl_DStringValue(&buffer);
	}
    }

    /*







|







2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
	const char *name = TclGetString(objv[2]);

	if ((*name == ':') && (*(name+1) == ':')) {
	    pattern = name;
	} else {
	    Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
	    if (nsPtr != globalNsPtr) {
		TclDStringAppendLiteral(&buffer, "::");
	    }
	    Tcl_DStringAppend(&buffer, name, -1);
	    pattern = Tcl_DStringValue(&buffer);
	}
    }

    /*
Changes to generic/tclOO.c.
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373

    /*
     * Create the subcommands in the oo::define and oo::objdefine spaces.
     */

    Tcl_DStringInit(&buffer);
    for (i=0 ; defineCmds[i].name ; i++) {
	Tcl_DStringAppend(&buffer, "::oo::define::", 14);
	Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }
    for (i=0 ; objdefCmds[i].name ; i++) {
	Tcl_DStringAppend(&buffer, "::oo::objdefine::", 17);
	Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }

    Tcl_CallWhenDeleted(interp, KillFoundation, NULL);







|






|







352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373

    /*
     * Create the subcommands in the oo::define and oo::objdefine spaces.
     */

    Tcl_DStringInit(&buffer);
    for (i=0 ; defineCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::define::");
	Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }
    for (i=0 ; objdefCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
	Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }

    Tcl_CallWhenDeleted(interp, KillFoundation, NULL);
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
		PublicObjectCmd, oPtr, NULL);
    } else {
	Tcl_DString buffer;

	Tcl_DStringInit(&buffer);
	Tcl_DStringAppend(&buffer,
		Tcl_GetCurrentNamespace(interp)->fullName, -1);
	Tcl_DStringAppend(&buffer, "::", 2);
	Tcl_DStringAppend(&buffer, nameStr, -1);
	oPtr->command = Tcl_CreateObjCommand(interp,
		Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL);
	Tcl_DStringFree(&buffer);
    }

    /*







|







653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
		PublicObjectCmd, oPtr, NULL);
    } else {
	Tcl_DString buffer;

	Tcl_DStringInit(&buffer);
	Tcl_DStringAppend(&buffer,
		Tcl_GetCurrentNamespace(interp)->fullName, -1);
	TclDStringAppendLiteral(&buffer, "::");
	Tcl_DStringAppend(&buffer, nameStr, -1);
	oPtr->command = Tcl_CreateObjCommand(interp,
		Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL);
	Tcl_DStringFree(&buffer);
    }

    /*
Changes to generic/tclOOBasic.c.
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
	if (name[0]!=':' || name[1]!=':') {
	    Interp *iPtr = (Interp *) interp;

	    if (iPtr->varFramePtr != NULL) {
		Tcl_DStringAppend(&buffer,
			iPtr->varFramePtr->nsPtr->fullName, -1);
	    }
	    Tcl_DStringAppend(&buffer, "::", 2);
	    Tcl_DStringAppend(&buffer, name, -1);
	    name = Tcl_DStringValue(&buffer);
	}
	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, NULL);
	Tcl_DStringFree(&buffer);
    }








|







1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
	if (name[0]!=':' || name[1]!=':') {
	    Interp *iPtr = (Interp *) interp;

	    if (iPtr->varFramePtr != NULL) {
		Tcl_DStringAppend(&buffer,
			iPtr->varFramePtr->nsPtr->fullName, -1);
	    }
	    TclDStringAppendLiteral(&buffer, "::");
	    Tcl_DStringAppend(&buffer, name, -1);
	    name = Tcl_DStringValue(&buffer);
	}
	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, NULL);
	Tcl_DStringFree(&buffer);
    }

Changes to generic/tclPathObj.c.
23
24
25
26
27
28
29


30
31
32
33
34
35
36
			    Tcl_Obj *copyPtr);
static void		FreeFsPathInternalRep(Tcl_Obj *pathPtr);
static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static int		FindSplitPos(const char *path, int separator);
static int		IsSeparatorOrNull(int ch);
static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);



/*
 * Define the 'path' object type, which Tcl uses to represent file paths
 * internally.
 */

static const Tcl_ObjType tclFsPathType = {







>
>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
			    Tcl_Obj *copyPtr);
static void		FreeFsPathInternalRep(Tcl_Obj *pathPtr);
static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static int		FindSplitPos(const char *path, int separator);
static int		IsSeparatorOrNull(int ch);
static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
static int		MakePathFromNormalized(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);

/*
 * Define the 'path' object type, which Tcl uses to represent file paths
 * internally.
 */

static const Tcl_ObjType tclFsPathType = {
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
    TclFSNormalizeToUniquePath(interp, retVal, 0);

    /*
     * Since we know it is a normalized path, we can actually convert this
     * object into an FsPath for greater efficiency
     */

    TclFSMakePathFromNormalized(interp, retVal);

    /*
     * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs.
     */

    return retVal;
}







|







430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
    TclFSNormalizeToUniquePath(interp, retVal, 0);

    /*
     * Since we know it is a normalized path, we can actually convert this
     * object into an FsPath for greater efficiency
     */

    MakePathFromNormalized(interp, retVal);

    /*
     * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs.
     */

    return retVal;
}
1453
1454
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
1480
1481
1482
1483
1484
1485
1486
1487

    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSMakePathFromNormalized --
 *
 *	Like SetFsPathFromAny, but assumes the given object is an absolute
 *	normalized path. Only for internal use.
 *
 * Results:
 *	Standard Tcl error code.
 *
 * Side effects:
 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

int
TclFSMakePathFromNormalized(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    FsPath *fsPathPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }

    /*
     * Free old representation







|













|
|




<







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
1480
1481

1482
1483
1484
1485
1486
1487
1488

    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}

/*
 *---------------------------------------------------------------------------
 *
 * MakePathFromNormalized --
 *
 *	Like SetFsPathFromAny, but assumes the given object is an absolute
 *	normalized path. Only for internal use.
 *
 * Results:
 *	Standard Tcl error code.
 *
 * Side effects:
 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

static int
MakePathFromNormalized(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    FsPath *fsPathPtr;


    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }

    /*
     * Free old representation
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
     */

    fsPathPtr->normPathPtr = pathPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;
    /* Remember the epoch under which we decided pathPtr was normalized */
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return TCL_OK;
}







|







1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
     */

    fsPathPtr->normPathPtr = pathPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;
    /* Remember the epoch under which we decided pathPtr was normalized */
    fsPathPtr->filesystemEpoch = TclFSEpoch();

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return TCL_OK;
}
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
Tcl_FSNewNativePath(
    const Tcl_Filesystem *fromFilesystem,
    ClientData clientData)
{
    Tcl_Obj *pathPtr = NULL;
    FsPath *fsPathPtr;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (fromFilesystem->internalToNormalizedProc != NULL) {
	pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData);
    }
    if (pathPtr == NULL) {
	return NULL;
    }







<







1560
1561
1562
1563
1564
1565
1566

1567
1568
1569
1570
1571
1572
1573
Tcl_FSNewNativePath(
    const Tcl_Filesystem *fromFilesystem,
    ClientData clientData)
{
    Tcl_Obj *pathPtr = NULL;
    FsPath *fsPathPtr;



    if (fromFilesystem->internalToNormalizedProc != NULL) {
	pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData);
    }
    if (pathPtr == NULL) {
	return NULL;
    }
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
     * Circular reference, by design.
     */

    fsPathPtr->normPathPtr = pathPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = clientData;
    fsPathPtr->fsPtr = fromFilesystem;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return pathPtr;
}







|







1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
     * Circular reference, by design.
     */

    fsPathPtr->normPathPtr = pathPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = clientData;
    fsPathPtr->fsPtr = fromFilesystem;
    fsPathPtr->filesystemEpoch = TclFSEpoch();

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return pathPtr;
}
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232

void
TclFSSetPathDetails(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr,
    ClientData clientData)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FsPath *srcFsPathPtr;

    /*
     * Make sure pathPtr is of the correct type.
     */

    if (pathPtr->typePtr != &tclFsPathType) {
	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
	    return;
	}
    }

    srcFsPathPtr = PATHOBJ(pathPtr);
    srcFsPathPtr->fsPtr = fsPtr;
    srcFsPathPtr->nativePathPtr = clientData;
    srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSEqualPaths --
 *







<















|







2202
2203
2204
2205
2206
2207
2208

2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231

void
TclFSSetPathDetails(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr,
    ClientData clientData)
{

    FsPath *srcFsPathPtr;

    /*
     * Make sure pathPtr is of the correct type.
     */

    if (pathPtr->typePtr != &tclFsPathType) {
	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
	    return;
	}
    }

    srcFsPathPtr = PATHOBJ(pathPtr);
    srcFsPathPtr->fsPtr = fsPtr;
    srcFsPathPtr->nativePathPtr = clientData;
    srcFsPathPtr->filesystemEpoch = TclFSEpoch();
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSEqualPaths --
 *
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    char *name;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }

    /*
     * First step is to translate the filename. This is similar to







<







2306
2307
2308
2309
2310
2311
2312

2313
2314
2315
2316
2317
2318
2319
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    char *name;


    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }

    /*
     * First step is to translate the filename. This is similar to
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476

    fsPathPtr = ckalloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = transPtr;
    if (transPtr != pathPtr) {
	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
	/* Redo translation when $env(HOME) changes */
	fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
    } else {
	fsPathPtr->filesystemEpoch = 0;
    }
    fsPathPtr->normPathPtr = NULL;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;







|







2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474

    fsPathPtr = ckalloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = transPtr;
    if (transPtr != pathPtr) {
	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
	/* Redo translation when $env(HOME) changes */
	fsPathPtr->filesystemEpoch = TclFSEpoch();
    } else {
	fsPathPtr->filesystemEpoch = 0;
    }
    fsPathPtr->normPathPtr = NULL;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;
Changes to generic/tclPkg.c.
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
				 * available. */
{
    if (reqc > 0) {
	int i;

	for (i = 0; i < reqc; i++) {
	    Tcl_DStringAppend(dsPtr, " ", 1);
	    Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1);
	}
    } else {
	Tcl_DStringAppend(dsPtr, " 0-", -1);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SomeRequirementSatisfied --







|
|


|







1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
				 * available. */
{
    if (reqc > 0) {
	int i;

	for (i = 0; i < reqc; i++) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    TclDStringAppendObj(dsPtr, reqv[i]);
	}
    } else {
	TclDStringAppendLiteral(dsPtr, " 0-");
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SomeRequirementSatisfied --
Changes to generic/tclProc.c.
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
     * qualifiers. To create the new command in the right namespace, we
     * generate a fully qualified name for it.
     */

    Tcl_DStringInit(&ds);
    if (nsPtr != iPtr->globalNsPtr) {
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	Tcl_DStringAppend(&ds, "::", 2);
    }
    Tcl_DStringAppend(&ds, procName, -1);

    cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
	    TclNRInterpProc, procPtr, TclProcDeleteProc);
    Tcl_DStringFree(&ds);








|







190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
     * qualifiers. To create the new command in the right namespace, we
     * generate a fully qualified name for it.
     */

    Tcl_DStringInit(&ds);
    if (nsPtr != iPtr->globalNsPtr) {
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	TclDStringAppendLiteral(&ds, "::");
    }
    Tcl_DStringAppend(&ds, procName, -1);

    cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
	    TclNRInterpProc, procPtr, TclProcDeleteProc);
    Tcl_DStringFree(&ds);

Changes to generic/tclStubInit.c.
51
52
53
54
55
56
57

58
59
60
61
62
63
64
{
    return TclSockMinimumBuffers(INT2PTR(sock), size);
}
#endif

#ifdef __WIN32__
#   define TclUnixWaitForFile 0

#   define TclpReaddir 0
#   define TclpIsAtty 0
#elif defined(__CYGWIN__)
#   define TclpIsAtty TclPlatIsAtty
#   define TclWinSetInterfaces (void (*) (int)) doNothing
#   define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
#   define TclWinFlushDirtyChannels doNothing







>







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
{
    return TclSockMinimumBuffers(INT2PTR(sock), size);
}
#endif

#ifdef __WIN32__
#   define TclUnixWaitForFile 0
#   define TclUnixCopyFile 0
#   define TclpReaddir 0
#   define TclpIsAtty 0
#elif defined(__CYGWIN__)
#   define TclpIsAtty TclPlatIsAtty
#   define TclWinSetInterfaces (void (*) (int)) doNothing
#   define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
#   define TclWinFlushDirtyChannels doNothing
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
    TclpReaddir, /* 10 */
    TclGetAndDetachPids, /* 11 */
    TclpCloseFile, /* 12 */
    TclpCreateCommandChannel, /* 13 */
    TclpCreatePipe, /* 14 */
    TclpCreateProcess, /* 15 */
    TclpIsAtty, /* 16 */
    0, /* 17 */
    TclpMakeFile, /* 18 */
    TclpOpenFile, /* 19 */
    TclWinAddProcess, /* 20 */
    TclpInetNtoa, /* 21 */
    TclpCreateTempFile, /* 22 */
    0, /* 23 */
    TclWinNoBackslash, /* 24 */







|







495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
    TclpReaddir, /* 10 */
    TclGetAndDetachPids, /* 11 */
    TclpCloseFile, /* 12 */
    TclpCreateCommandChannel, /* 13 */
    TclpCreatePipe, /* 14 */
    TclpCreateProcess, /* 15 */
    TclpIsAtty, /* 16 */
    TclUnixCopyFile, /* 17 */
    TclpMakeFile, /* 18 */
    TclpOpenFile, /* 19 */
    TclWinAddProcess, /* 20 */
    TclpInetNtoa, /* 21 */
    TclpCreateTempFile, /* 22 */
    0, /* 23 */
    TclWinNoBackslash, /* 24 */
Changes to generic/tclTrace.c.
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
	 */

	Tcl_DStringInit(&cmd);
	Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length);
	Tcl_DStringAppendElement(&cmd, oldName);
	Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
	if (flags & TCL_TRACE_RENAME) {
	    Tcl_DStringAppend(&cmd, " rename", 7);
	} else if (flags & TCL_TRACE_DELETE) {
	    Tcl_DStringAppend(&cmd, " delete", 7);
	}

	/*
	 * Execute the command. We discard any object result the command
	 * returns.
	 *
	 * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to other







|

|







1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
	 */

	Tcl_DStringInit(&cmd);
	Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length);
	Tcl_DStringAppendElement(&cmd, oldName);
	Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
	if (flags & TCL_TRACE_RENAME) {
	    TclDStringAppendLiteral(&cmd, " rename");
	} else if (flags & TCL_TRACE_DELETE) {
	    TclDStringAppendLiteral(&cmd, " delete");
	}

	/*
	 * Execute the command. We discard any object result the command
	 * returns.
	 *
	 * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to other
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
	    Tcl_DStringAppendElement(&cmd, name1);
	    Tcl_DStringAppendElement(&cmd, (name2 ? name2 : ""));
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
		if (flags & TCL_TRACE_ARRAY) {
		    Tcl_DStringAppend(&cmd, " a", 2);
		} else if (flags & TCL_TRACE_READS) {
		    Tcl_DStringAppend(&cmd, " r", 2);
		} else if (flags & TCL_TRACE_WRITES) {
		    Tcl_DStringAppend(&cmd, " w", 2);
		} else if (flags & TCL_TRACE_UNSETS) {
		    Tcl_DStringAppend(&cmd, " u", 2);
		}
	    } else {
#endif
		if (flags & TCL_TRACE_ARRAY) {
		    Tcl_DStringAppend(&cmd, " array", 6);
		} else if (flags & TCL_TRACE_READS) {
		    Tcl_DStringAppend(&cmd, " read", 5);
		} else if (flags & TCL_TRACE_WRITES) {
		    Tcl_DStringAppend(&cmd, " write", 6);
		} else if (flags & TCL_TRACE_UNSETS) {
		    Tcl_DStringAppend(&cmd, " unset", 6);
		}
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    }
#endif

	    /*
	     * Execute the command. We discard any object result the command







|

|

|

|




|

|

|

|







1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
	    Tcl_DStringAppendElement(&cmd, name1);
	    Tcl_DStringAppendElement(&cmd, (name2 ? name2 : ""));
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
		if (flags & TCL_TRACE_ARRAY) {
		    TclDStringAppendLiteral(&cmd, " a");
		} else if (flags & TCL_TRACE_READS) {
		    TclDStringAppendLiteral(&cmd, " r");
		} else if (flags & TCL_TRACE_WRITES) {
		    TclDStringAppendLiteral(&cmd, " w");
		} else if (flags & TCL_TRACE_UNSETS) {
		    TclDStringAppendLiteral(&cmd, " u");
		}
	    } else {
#endif
		if (flags & TCL_TRACE_ARRAY) {
		    TclDStringAppendLiteral(&cmd, " array");
		} else if (flags & TCL_TRACE_READS) {
		    TclDStringAppendLiteral(&cmd, " read");
		} else if (flags & TCL_TRACE_WRITES) {
		    TclDStringAppendLiteral(&cmd, " write");
		} else if (flags & TCL_TRACE_UNSETS) {
		    TclDStringAppendLiteral(&cmd, " unset");
		}
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    }
#endif

	    /*
	     * Execute the command. We discard any object result the command
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
		} while (*p != '\0');
		p--;
		if (*p == ')') {
		    int offset = (openParen - part1);
		    char *newPart1;

		    Tcl_DStringInit(&nameCopy);
		    Tcl_DStringAppend(&nameCopy, part1, (p-part1));
		    newPart1 = Tcl_DStringValue(&nameCopy);
		    newPart1[offset] = 0;
		    part1 = newPart1;
		    part2 = newPart1 + offset + 1;
		    copiedName = 1;
		}
		break;







|







2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
		} while (*p != '\0');
		p--;
		if (*p == ')') {
		    int offset = (openParen - part1);
		    char *newPart1;

		    Tcl_DStringInit(&nameCopy);
		    Tcl_DStringAppend(&nameCopy, part1, p-part1);
		    newPart1 = Tcl_DStringValue(&nameCopy);
		    newPart1[offset] = 0;
		    part1 = newPart1;
		    part2 = newPart1 + offset + 1;
		    copiedName = 1;
		}
		break;
Changes to generic/tclUtil.c.
2434
2435
2436
2437
2438
2439
2440































2441
2442
2443
2444
2445
2446
2447
    dsPtr->string[dsPtr->length] = '\0';
    return dsPtr->string;
}

/*
 *----------------------------------------------------------------------
 *































 * Tcl_DStringAppendElement --
 *
 *	Append a list element to the current value of a dynamic string.
 *
 * Results:
 *	The return value is a pointer to the dynamic string's new value.
 *







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







2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
    dsPtr->string[dsPtr->length] = '\0';
    return dsPtr->string;
}

/*
 *----------------------------------------------------------------------
 *
 * TclDStringAppendObj, TclDStringAppendDString --
 *
 *	Simple wrappers round Tcl_DStringAppend that make it easier to append
 *	from particular sources of strings.
 *
 *----------------------------------------------------------------------
 */

char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    int length;
    char *bytes = Tcl_GetStringFromObj(objPtr, &length);

    return Tcl_DStringAppend(dsPtr, bytes, length);
}

char *
TclDStringAppendDString(
    Tcl_DString *dsPtr,
    Tcl_DString *toAppendPtr)
{
    return Tcl_DStringAppend(dsPtr, Tcl_DStringValue(toAppendPtr),
	    Tcl_DStringLength(toAppendPtr));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringAppendElement --
 *
 *	Append a list element to the current value of a dynamic string.
 *
 * Results:
 *	The return value is a pointer to the dynamic string's new value.
 *
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
 */

void
Tcl_DStringStartSublist(
    Tcl_DString *dsPtr)		/* Dynamic string. */
{
    if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
	Tcl_DStringAppend(dsPtr, " {", -1);
    } else {
	Tcl_DStringAppend(dsPtr, "{", -1);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringEndSublist --







|

|







2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
 */

void
Tcl_DStringStartSublist(
    Tcl_DString *dsPtr)		/* Dynamic string. */
{
    if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
	TclDStringAppendLiteral(dsPtr, " {");
    } else {
	TclDStringAppendLiteral(dsPtr, "{");
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringEndSublist --
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
 *----------------------------------------------------------------------
 */

void
Tcl_DStringEndSublist(
    Tcl_DString *dsPtr)		/* Dynamic string. */
{
    Tcl_DStringAppend(dsPtr, "}", -1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PrintDouble --
 *







|







2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
 *----------------------------------------------------------------------
 */

void
Tcl_DStringEndSublist(
    Tcl_DString *dsPtr)		/* Dynamic string. */
{
    TclDStringAppendLiteral(dsPtr, "}");
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PrintDouble --
 *
Changes to generic/tclZlib.c.
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
     */

    if (interp != NULL) {
	if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) {
	    goto error;
	}
	Tcl_DStringInit(&cmdname);
	Tcl_DStringAppend(&cmdname, "::tcl::zlib::streamcmd_", -1);
	Tcl_DStringAppend(&cmdname, Tcl_GetString(Tcl_GetObjResult(interp)),
		-1);
	if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname),
		&cmdinfo) == 1) {
	    Tcl_SetResult(interp,
		    "BUG: Stream command name already exists", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL);
	    Tcl_DStringFree(&cmdname);
	    goto error;







|
|
<







569
570
571
572
573
574
575
576
577

578
579
580
581
582
583
584
     */

    if (interp != NULL) {
	if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) {
	    goto error;
	}
	Tcl_DStringInit(&cmdname);
	TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_");
	TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp));

	if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname),
		&cmdinfo) == 1) {
	    Tcl_SetResult(interp,
		    "BUG: Stream command name already exists", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL);
	    Tcl_DStringFree(&cmdname);
	    goto error;
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708

	ExtractHeader(&cd->inHeader.header, tmpObj);
	if (optionName == NULL) {
	    Tcl_DStringAppendElement(dsPtr, "-header");
	    Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj));
	    Tcl_DecrRefCount(tmpObj);
	} else {
	    int len;
	    const char *str = Tcl_GetStringFromObj(tmpObj, &len);

	    Tcl_DStringAppend(dsPtr, str, len);
	    Tcl_DecrRefCount(tmpObj);
	    return TCL_OK;
	}
    }

    /*
     * Now we do the standard processing of the stream we wrapped.







<
<
<
|







2690
2691
2692
2693
2694
2695
2696



2697
2698
2699
2700
2701
2702
2703
2704

	ExtractHeader(&cd->inHeader.header, tmpObj);
	if (optionName == NULL) {
	    Tcl_DStringAppendElement(dsPtr, "-header");
	    Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj));
	    Tcl_DecrRefCount(tmpObj);
	} else {



	    TclDStringAppendObj(dsPtr, tmpObj);
	    Tcl_DecrRefCount(tmpObj);
	    return TCL_OK;
	}
    }

    /*
     * Now we do the standard processing of the stream we wrapped.
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
    } else /* have <= toRead */ {
	/*
	 * There is just or not enough in the buffer to fully satisfy the
	 * caller, so take everything as best effort.
	 */

	memcpy(buf, Tcl_DStringValue(&cd->decompressed), have);
	Tcl_DStringSetLength(&cd->decompressed, 0);
	return have;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
    } else /* have <= toRead */ {
	/*
	 * There is just or not enough in the buffer to fully satisfy the
	 * caller, so take everything as best effort.
	 */

	memcpy(buf, Tcl_DStringValue(&cd->decompressed), have);
	TclDStringClear(&cd->decompressed);
	return have;
    }
}

/*
 *----------------------------------------------------------------------
 *
Changes to library/dde/pkgIndex.tcl.
1
2
3
4
5
6
7
if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] ne ".dll"} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
} else {
    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
}



|

|

1
2
3
4
5
6
7
if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] ne ".dll"} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded dde 1.4.0b1 [list load [file join $dir tcldde14g.dll] dde]
} else {
    package ifneeded dde 1.4.0b1 [list load [file join $dir tcldde14.dll] dde]
}
Changes to library/http/http.tcl.
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
449
450

451
452
453
454
455
456
457
    # The "http" is the protocol, the user is "jschmoe", the password is
    # "xyzzy", the host is "www.bogus.net", the port is "8000", the path is
    # "/foo/bar.tml", the query is "q=foo", and the fragment is "changes".
    #
    # Note that the RE actually combines the user and password parts, as
    # recommended in RFC 3986. Indeed, that RFC states that putting passwords
    # in URLs is a Really Bad Idea, something with which I would agree utterly.
    # Also note that we do not currently support IPv6 addresses.
    #
    # From a validation perspective, we need to ensure that the parts of the
    # URL that are going to the server are correctly encoded.  This is only
    # done if $state(-strict) is true (inherited from $::http::strict).

    set URLmatcher {(?x)		# this is _expanded_ syntax
	^
	(?: (\w+) : ) ?			# <protocol scheme>
	(?: //
	    (?:
		(
		    [^@/\#?]+		# <userinfo part of authority>
		) @
	    )?
	    ( [^/:\#?]+ )		# <host part of authority>



	    (?: : (\d+) )?		# <port part of authority>
	)?
	( / [^\#]*)?			# <path> (including query)
	(?: \# (.*) )?			# <fragment>
	$
    }

    # Phase one: parse
    if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} {
	unset $token
	return -code error "Unsupported URL: $url"
    }
    # Phase two: validate

    if {$host eq ""} {
	# Caller has to provide a host name; we do not have a "default host"
	# that would enable us to handle relative URLs.
	unset $token
	return -code error "Missing host part: $url"
	# Note that we don't check the hostname for validity here; if it's
	# invalid, we'll simply fail to resolve it later on.







<














|
>
>
>













>







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
449
450
451
452
453
454
455
456
457
458
459
460
    # The "http" is the protocol, the user is "jschmoe", the password is
    # "xyzzy", the host is "www.bogus.net", the port is "8000", the path is
    # "/foo/bar.tml", the query is "q=foo", and the fragment is "changes".
    #
    # Note that the RE actually combines the user and password parts, as
    # recommended in RFC 3986. Indeed, that RFC states that putting passwords
    # in URLs is a Really Bad Idea, something with which I would agree utterly.

    #
    # From a validation perspective, we need to ensure that the parts of the
    # URL that are going to the server are correctly encoded.  This is only
    # done if $state(-strict) is true (inherited from $::http::strict).

    set URLmatcher {(?x)		# this is _expanded_ syntax
	^
	(?: (\w+) : ) ?			# <protocol scheme>
	(?: //
	    (?:
		(
		    [^@/\#?]+		# <userinfo part of authority>
		) @
	    )?
	    (				# <host part of authority>
		[^/:\#?]+ |		# host name or IPv4 address
		\[ [^/\#?]+ \]		# IPv6 address in square brackets
	    )
	    (?: : (\d+) )?		# <port part of authority>
	)?
	( / [^\#]*)?			# <path> (including query)
	(?: \# (.*) )?			# <fragment>
	$
    }

    # Phase one: parse
    if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} {
	unset $token
	return -code error "Unsupported URL: $url"
    }
    # Phase two: validate
    set host [string trim $host {[]}]; # strip square brackets from IPv6 address
    if {$host eq ""} {
	# Caller has to provide a host name; we do not have a "default host"
	# that would enable us to handle relative URLs.
	unset $token
	return -code error "Missing host part: $url"
	# Note that we don't check the hostname for validity here; if it's
	# invalid, we'll simply fail to resolve it later on.
Changes to library/msgcat/msgcat.tcl.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.5
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
package provide msgcat 1.4.4

namespace eval msgcat {
    namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
	    mcunknown

    # Records the current locale as passed to mclocale
    variable Locale ""

    # Records the list of locales to search
    variable Loclist {}

    # Records the mapping between source strings and translated strings.  The
    # dict key is of the form "<locale> <namespace> <src>", where locale and
    # namespace should be themselves dict values and the value is
    # the translated string.
    variable Msgs [dict create]

    # Map of language codes used in Windows registry to those of ISO-639
    if { $::tcl_platform(platform) eq "windows" } {
	variable WinRegToISO639 [dict create  {*}{
	    01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ
		  1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY
		  2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH
		  4001 ar_QA
	    02 bg 0402 bg_BG
	    03 ca 0403 ca_ES







|


















|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.5
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
package provide msgcat 1.4.5

namespace eval msgcat {
    namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
	    mcunknown

    # Records the current locale as passed to mclocale
    variable Locale ""

    # Records the list of locales to search
    variable Loclist {}

    # Records the mapping between source strings and translated strings.  The
    # dict key is of the form "<locale> <namespace> <src>", where locale and
    # namespace should be themselves dict values and the value is
    # the translated string.
    variable Msgs [dict create]

    # Map of language codes used in Windows registry to those of ISO-639
    if {[info sharedlibextension] eq ".dll"} {
	variable WinRegToISO639 [dict create  {*}{
	    01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ
		  1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY
		  2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH
		  4001 ar_QA
	    02 bg 0402 bg_BG
	    03 ca 0403 ca_ES
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
	    11 ja 0411 ja_JP
	    12 ko 0412 ko_KR
	    13 nl 0413 nl_NL 0813 nl_BE
	    14 no 0414 no_NO 0814 nn_NO
	    15 pl 0415 pl_PL
	    16 pt 0416 pt_BR 0816 pt_PT
	    17 rm 0417 rm_CH
	    18 ro 0418 ro_RO
	    19 ru
	    1a hr 041a hr_HR 081a sr_YU 0c1a sr_YU@cyrillic
	    1b sk 041b sk_SK
	    1c sq 041c sq_AL
	    1d sv 041d sv_SE 081d sv_FI
	    1e th 041e th_TH
	    1f tr 041f tr_TR
	    20 ur 0420 ur_PK 0820 ur_IN







|
|







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
	    11 ja 0411 ja_JP
	    12 ko 0412 ko_KR
	    13 nl 0413 nl_NL 0813 nl_BE
	    14 no 0414 no_NO 0814 nn_NO
	    15 pl 0415 pl_PL
	    16 pt 0416 pt_BR 0816 pt_PT
	    17 rm 0417 rm_CH
	    18 ro 0418 ro_RO 0818 ro_MO
	    19 ru 0819 ru_MO
	    1a hr 041a hr_HR 081a sr_YU 0c1a sr_YU@cyrillic
	    1b sk 041b sk_SK
	    1c sq 041c sq_AL
	    1d sv 041d sv_SE 081d sv_FI
	    1e th 041e th_TH
	    1f tr 041f tr_TR
	    20 ur 0420 ur_PK 0820 ur_IN
88
89
90
91
92
93
94

95
96
97
98
99
100
101
	    2b hy 042b hy_AM
	    2c az 042c az_AZ@latin 082c az_AZ@cyrillic
	    2d eu
	    2e wen 042e wen_DE
	    2f mk 042f mk_MK
	    30 bnt 0430 bnt_TZ
	    31 ts 0431 ts_ZA

	    33 ven 0433 ven_ZA
	    34 xh 0434 xh_ZA
	    35 zu 0435 zu_ZA
	    36 af 0436 af_ZA
	    37 ka 0437 ka_GE
	    38 fo 0438 fo_FO
	    39 hi 0439 hi_IN







>







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
	    2b hy 042b hy_AM
	    2c az 042c az_AZ@latin 082c az_AZ@cyrillic
	    2d eu
	    2e wen 042e wen_DE
	    2f mk 042f mk_MK
	    30 bnt 0430 bnt_TZ
	    31 ts 0431 ts_ZA
	    32 tn
	    33 ven 0433 ven_ZA
	    34 xh 0434 xh_ZA
	    35 zu 0435 zu_ZA
	    36 af 0436 af_ZA
	    37 ka 0437 ka_GE
	    38 fo 0438 fo_FO
	    39 hi 0439 hi_IN
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
		 should be \"[lindex [info level 0] 0] locale {src dest ...}\""
    }

    set locale [string tolower $locale]
    set ns [uplevel 1 [list ::namespace current]]

    foreach {src dest} $pairs {
        dict set Msgs $locale $ns $src $dest
    }

    return $length
}

# msgcat::mcunknown --
#







|







338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
		 should be \"[lindex [info level 0] 0] locale {src dest ...}\""
    }

    set locale [string tolower $locale]
    set ns [uplevel 1 [list ::namespace current]]

    foreach {src dest} $pairs {
	dict set Msgs $locale $ns $src $dest
    }

    return $length
}

# msgcat::mcunknown --
#
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
# Results:
#	Returns the length of the longest translated string.

proc msgcat::mcmax {args} {
    set max 0
    foreach string $args {
	set translated [uplevel 1 [list [namespace origin mc] $string]]
        set len [string length $translated]
        if {$len>$max} {
	    set max $len
        }
    }
    return $max
}

# Convert the locale values stored in environment variables to a form
# suitable for passing to [mclocale]
proc msgcat::ConvertLocale {value} {







|
|

|







384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
# Results:
#	Returns the length of the longest translated string.

proc msgcat::mcmax {args} {
    set max 0
    foreach string $args {
	set translated [uplevel 1 [list [namespace origin mc] $string]]
	set len [string length $translated]
	if {$len>$max} {
	    set max $len
	}
    }
    return $max
}

# Convert the locale values stored in environment variables to a form
# suitable for passing to [mclocale]
proc msgcat::ConvertLocale {value} {
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
	append ret _$modifier
    }
    return $ret
}

# Initialize the default locale
proc msgcat::Init {} {
    global env tcl_platform

    #
    # set default locale, try to get from environment
    #
    foreach varName {LC_ALL LC_MESSAGES LANG} {
	if {[info exists env($varName)] && ("" ne $env($varName))} {
	    if {![catch {







|







423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
	append ret _$modifier
    }
    return $ret
}

# Initialize the default locale
proc msgcat::Init {} {
    global env

    #
    # set default locale, try to get from environment
    #
    foreach varName {LC_ALL LC_MESSAGES LANG} {
	if {[info exists env($varName)] && ("" ne $env($varName))} {
	    if {![catch {
447
448
449
450
451
452
453
454
455
456
457

458
459
460
461
462
463
464
465
466








467




















468
469
470
471
472
473
474
475
476
477
	if {![catch {
	    mclocale [ConvertLocale $::tcl::mac::locale]
	}]} {
	    return
	}
    }
    #
    # The rest of this routine is special processing for Windows;
    # all other platforms, get out now.
    #
    if {$tcl_platform(platform) ne "windows"} {

	mclocale C
	return
    }
    #
    # On Windows, try to set locale depending on registry settings,
    # or fall back on locale of "C".
    #
    if {[catch {
	package require registry








	set key {HKEY_CURRENT_USER\Control Panel\International}




















	set locale [registry get $key "locale"]
    }]} {
        mclocale C
	return
    }
    #
    # Keep trying to match against smaller and smaller suffixes
    # of the registry value, since the latter hexadigits appear
    # to determine general language and earlier hexadigits determine
    # more precise information, such as territory.  For example,







|
|

|
>




|
|

|
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


|







448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
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
502
503
504
505
506
507
	if {![catch {
	    mclocale [ConvertLocale $::tcl::mac::locale]
	}]} {
	    return
	}
    }
    #
    # The rest of this routine is special processing for Windows or
    # Cygwin. All other platforms, get out now.
    #
    if {([info sharedlibextension] ne ".dll")
	    || [catch {package require registry}]} {
	mclocale C
	return
    }
    #
    # On Windows or Cygwin, try to set locale depending on registry
    # settings, or fall back on locale of "C".
    #

    # First check registry value LocalName present from Windows Vista
    # which contains the local string as RFC5646, composed of:
    # [a-z]{2,3} : language
    # -[a-z]{4}  : script (optional, translated by table Latn->latin)
    # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used)
    # (-.*)* : variant, extension, private use (optional, not used)
    # Those are translated to local strings.
    # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs@latin, es-419 -> es
    #
    set key {HKEY_CURRENT_USER\Control Panel\International}
    if {([registry values $key "LocaleName"] ne "")
	    && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\
	    [string tolower [registry get $key "LocaleName"]] match locale\
	    script territory]} {
	if {"" ne $territory} {
	    append locale _ $territory
	}
	set modifierDict [dict create latn latin cyrl cyrillic]
	if {[dict exists $modifierDict $script]} {
	    append locale @ [dict get $modifierDict $script]
	}
	if {![catch {
	    mclocale [ConvertLocale $locale]
	}]} {
	    return
	}
    }

    # then check key locale which contains a numerical language ID
    if {[catch {
	set locale [registry get $key "locale"]
    }]} {
	mclocale C
	return
    }
    #
    # Keep trying to match against smaller and smaller suffixes
    # of the registry value, since the latter hexadigits appear
    # to determine general language and earlier hexadigits determine
    # more precise information, such as territory.  For example,
Changes to library/msgcat/pkgIndex.tcl.
1
2
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded msgcat 1.4.4 [list source [file join $dir msgcat.tcl]]

|
1
2
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded msgcat 1.4.5 [list source [file join $dir msgcat.tcl]]
Changes to library/reg/pkgIndex.tcl.
1
2
3
4
5
6
7
8
9
if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] ne ".dll"} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded registry 1.3.0 \
            [list load [file join $dir tclreg13g.dll] registry]
} else {
    package ifneeded registry 1.3.0 \
            [list load [file join $dir tclreg13.dll] registry]
}
|
|







1
2
3
4
5
6
7
8
9
if {([info commands ::tcl::pkgconfig] eq "")
	|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded registry 1.3.0 \
            [list load [file join $dir tclreg13g.dll] registry]
} else {
    package ifneeded registry 1.3.0 \
            [list load [file join $dir tclreg13.dll] registry]
}
Changes to tests/http.test.
131
132
133
134
135
136
137

138
139
140
141
142
143
144
</body></html>"
set tail /a/b/c
set url //[info hostname]:$port/a/b/c
set fullurl http://user:pass@[info hostname]:$port/a/b/c
set binurl //[info hostname]:$port/binary
set posturl //[info hostname]:$port/post
set badposturl //[info hostname]:$port/droppost

test http-3.4 {http::geturl} -body {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>







>







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
</body></html>"
set tail /a/b/c
set url //[info hostname]:$port/a/b/c
set fullurl http://user:pass@[info hostname]:$port/a/b/c
set binurl //[info hostname]:$port/binary
set posturl //[info hostname]:$port/post
set badposturl //[info hostname]:$port/droppost
set ipv6url http://\[::1\]:$port/
test http-3.4 {http::geturl} -body {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
386
387
388
389
390
391
392






393
394
395
396
397
398
399
} -match regexp -result {(?n)Accept \*/\*
Host .*
User-Agent .*
Connection close
Content-Type {text/plain;charset=utf-8}
Accept-Encoding .*
Content-Length 5}







test http-4.1 {http::Event} -body {
    set token [http::geturl $url -keepalive 0]
    upvar #0 $token data
    array set meta $data(meta)
    expr {($data(totalsize) == $meta(Content-Length))}
} -cleanup {







>
>
>
>
>
>







387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
} -match regexp -result {(?n)Accept \*/\*
Host .*
User-Agent .*
Connection close
Content-Type {text/plain;charset=utf-8}
Accept-Encoding .*
Content-Length 5}
test http-3.29 "http::geturl $ipv6url" -body {
    set token [http::geturl $ipv6url -validate 1]
    http::code $token
} -cleanup {
    http::cleanup $token
} -result "HTTP/1.0 200 OK"

test http-4.1 {http::Event} -body {
    set token [http::geturl $url -keepalive 0]
    upvar #0 $token data
    array set meta $data(meta)
    expr {($data(totalsize) == $meta(Content-Length))}
} -cleanup {
Changes to tests/msgcat.test.
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# message catalogs for locales foo, foo_BAR, and foo_BAR_baz.

package require Tcl 8.2
if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}
if {[catch {package require msgcat 1.4.4}]} {
    puts stderr "Skipping tests in [info script].  No msgcat 1.4.4 found to test."
    return
}

namespace eval ::msgcat::test {
    namespace import ::msgcat::*
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests







|
|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# message catalogs for locales foo, foo_BAR, and foo_BAR_baz.

package require Tcl 8.2
if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}
if {[catch {package require msgcat 1.4.5}]} {
    puts stderr "Skipping tests in [info script].  No msgcat 1.4.5 found to test."
    return
}

namespace eval ::msgcat::test {
    namespace import ::msgcat::*
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests
Changes to unix/Makefile.in.
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
	@echo "Installing package http 2.8.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.4.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.4.tm;
	@echo "Installing package tcltest 2.3.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.4.tm;

	@echo "Installing package platform 1.0.10 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.10.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;







|
|







842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
	@echo "Installing package http 2.8.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.4.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.5 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.5.tm;
	@echo "Installing package tcltest 2.3.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.4.tm;

	@echo "Installing package platform 1.0.10 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.10.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;
Changes to unix/configure.
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
   { (exit 1); exit 1; }; }
	    fi
	    if test "x${TCL_THREADS}" = "x0"; then
		{ { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5
echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;}
   { (exit 1); exit 1; }; }
	    fi
	    if test ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
		{ { echo "$as_me:$LINENO: error: Please configure and make the ../win directory first." >&5
echo "$as_me: error: Please configure and make the ../win directory first." >&2;}
   { (exit 1); exit 1; }; }
	    fi
	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"







|







7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
   { (exit 1); exit 1; }; }
	    fi
	    if test "x${TCL_THREADS}" = "x0"; then
		{ { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5
echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;}
   { (exit 1); exit 1; }; }
	    fi
	    if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
		{ { echo "$as_me:$LINENO: error: Please configure and make the ../win directory first." >&5
echo "$as_me: error: Please configure and make the ../win directory first." >&2;}
   { (exit 1); exit 1; }; }
	    fi
	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"
14396
14397
14398
14399
14400
14401
14402

14403

14404
14405
14406
14407
14408
14409
14410
#--------------------------------------------------------------------
#	Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But
#	we might be able to use fstatfs instead. Some systems (OpenBSD?) also
#	lack blkcnt_t.
#--------------------------------------------------------------------

if test "$ac_cv_cygwin" = "yes"; then

    TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib"

else
    echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6
if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF







>
|
>







14396
14397
14398
14399
14400
14401
14402
14403
14404
14405
14406
14407
14408
14409
14410
14411
14412
#--------------------------------------------------------------------
#	Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But
#	we might be able to use fstatfs instead. Some systems (OpenBSD?) also
#	lack blkcnt_t.
#--------------------------------------------------------------------

if test "$ac_cv_cygwin" = "yes"; then
    if test "x${SHARED_BUILD}" = "x1"; then
	TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib"
    fi
else
    echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6
if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
Changes to unix/configure.in.
299
300
301
302
303
304
305

306

307
308
309
310
311
312
313
#--------------------------------------------------------------------
#	Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But
#	we might be able to use fstatfs instead. Some systems (OpenBSD?) also
#	lack blkcnt_t.
#--------------------------------------------------------------------

if test "$ac_cv_cygwin" = "yes"; then

    TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib"

else
    AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
fi
AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])

#--------------------------------------------------------------------







>
|
>







299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
#--------------------------------------------------------------------
#	Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But
#	we might be able to use fstatfs instead. Some systems (OpenBSD?) also
#	lack blkcnt_t.
#--------------------------------------------------------------------

if test "$ac_cv_cygwin" = "yes"; then
    if test "x${SHARED_BUILD}" = "x1"; then
	TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib"
    fi
else
    AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
fi
AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])

#--------------------------------------------------------------------
Changes to unix/tcl.m4.
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
	    )
	    if test "$ac_cv_cygwin" = "no"; then
		AC_MSG_ERROR([${CC} is not a cygwin compiler.])
	    fi
	    if test "x${TCL_THREADS}" = "x0"; then
		AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads])
	    fi
	    if test ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
		AC_MSG_ERROR([Please configure and make the ../win directory first.])
	    fi
	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""







|







1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
	    )
	    if test "$ac_cv_cygwin" = "no"; then
		AC_MSG_ERROR([${CC} is not a cygwin compiler.])
	    fi
	    if test "x${TCL_THREADS}" = "x0"; then
		AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads])
	    fi
	    if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
		AC_MSG_ERROR([Please configure and make the ../win directory first.])
	    fi
	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""
Changes to unix/tclConfig.sh.in.
1
2
3
4
5
6
7
8
9
# tclConfig.sh --
# 
# This shell script (for sh) is generated automatically by Tcl's
# configure script.  It will create shell variables for most of
# the configuration options discovered by the configure script.
# This script is intended to be included by the configure scripts
# for Tcl extensions so that they don't have to figure this all
# out for themselves.
#

|







1
2
3
4
5
6
7
8
9
# tclConfig.sh --
#
# This shell script (for sh) is generated automatically by Tcl's
# configure script.  It will create shell variables for most of
# the configuration options discovered by the configure script.
# This script is intended to be included by the configure scripts
# for Tcl extensions so that they don't have to figure this all
# out for themselves.
#
Changes to unix/tclLoadDl.c.
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
     * the underscore.
     */

    native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
    proc = dlsym(handle, native);	/* INTL: Native. */
    if (proc == NULL) {
	Tcl_DStringInit(&newName);
	Tcl_DStringAppend(&newName, "_", 1);
	native = Tcl_DStringAppend(&newName, native, -1);
	proc = dlsym(handle, native);	/* INTL: Native. */
	Tcl_DStringFree(&newName);
    }
    Tcl_DStringFree(&ds);
    if (proc == NULL && interp != NULL) {
	Tcl_ResetResult(interp);







|







164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
     * the underscore.
     */

    native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
    proc = dlsym(handle, native);	/* INTL: Native. */
    if (proc == NULL) {
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "_");
	native = Tcl_DStringAppend(&newName, native, -1);
	proc = dlsym(handle, native);	/* INTL: Native. */
	Tcl_DStringFree(&newName);
    }
    Tcl_DStringFree(&ds);
    if (proc == NULL && interp != NULL) {
	Tcl_ResetResult(interp);
Changes to unix/tclLoadDyld.c.
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
	Tcl_DString newName;

	/*
	 * dyld adds an underscore to the beginning of symbol names.
	 */

	Tcl_DStringInit(&newName);
	Tcl_DStringAppend(&newName, "_", 1);
	native = Tcl_DStringAppend(&newName, native, -1);
	if (dyldLoadHandle->dyldLibHeader) {
	    nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader,
		    native, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW |
		    NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR);
	    if (nsSymbol) {
		TclLoadDbgMsg("NSLookupSymbolInImage() successful");







|







389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
	Tcl_DString newName;

	/*
	 * dyld adds an underscore to the beginning of symbol names.
	 */

	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "_");
	native = Tcl_DStringAppend(&newName, native, -1);
	if (dyldLoadHandle->dyldLibHeader) {
	    nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader,
		    native, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW |
		    NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR);
	    if (nsSymbol) {
		TclLoadDbgMsg("NSLookupSymbolInImage() successful");
Changes to unix/tclLoadShl.c.
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
     * Some versions of the HP system software still use "_" at the beginning
     * of exported symbols while others don't; try both forms of each name.
     */

    if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE,
	    (void *) &proc) != 0) {
	Tcl_DStringInit(&newName);
	Tcl_DStringAppend(&newName, "_", 1);
	Tcl_DStringAppend(&newName, symbol, -1);
	if (shl_findsym(&handle, Tcl_DStringValue(&newName),
		(short) TYPE_PROCEDURE, (void *) &proc) != 0) {
	    proc = NULL;
	}
	Tcl_DStringFree(&newName);
    }
    if (proc == NULL && interp != NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "cannot find symbol\"", symbol, 
			 "\": ", Tcl_PosixError(interp), NULL);
    }
    return proc;
}

/*
 *----------------------------------------------------------------------
 *







|









|
|







142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
     * Some versions of the HP system software still use "_" at the beginning
     * of exported symbols while others don't; try both forms of each name.
     */

    if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE,
	    (void *) &proc) != 0) {
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "_");
	Tcl_DStringAppend(&newName, symbol, -1);
	if (shl_findsym(&handle, Tcl_DStringValue(&newName),
		(short) TYPE_PROCEDURE, (void *) &proc) != 0) {
	    proc = NULL;
	}
	Tcl_DStringFree(&newName);
    }
    if (proc == NULL && interp != NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "cannot find symbol\"", symbol, "\": ",
		Tcl_PosixError(interp), NULL);
    }
    return proc;
}

/*
 *----------------------------------------------------------------------
 *
Changes to unix/tclUnixChan.c.
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
	    return TCL_ERROR;
	}

	GETIOSTATE(fsPtr->fd, &iostate);

	Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds);
	iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds);
	Tcl_DStringSetLength(&ds, 0);

	Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds);
	iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds);
	Tcl_DStringFree(&ds);
	ckfree(argv);

	SETIOSTATE(fsPtr->fd, &iostate);







|







729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
	    return TCL_ERROR;
	}

	GETIOSTATE(fsPtr->fd, &iostate);

	Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds);
	iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds);
	TclDStringClear(&ds);

	Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds);
	iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds);
	Tcl_DStringFree(&ds);
	ckfree(argv);

	SETIOSTATE(fsPtr->fd, &iostate);
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926

	valid = 1;
	GETIOSTATE(fsPtr->fd, &iostate);
	Tcl_DStringInit(&ds);

	Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	Tcl_DStringSetLength(&ds, 0);

	Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
    }
    if (len == 0) {
	Tcl_DStringEndSublist(dsPtr);







|







912
913
914
915
916
917
918
919
920
921
922
923
924
925
926

	valid = 1;
	GETIOSTATE(fsPtr->fd, &iostate);
	Tcl_DStringInit(&ds);

	Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	TclDStringClear(&ds);

	Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
    }
    if (len == 0) {
	Tcl_DStringEndSublist(dsPtr);
Changes to unix/tclUnixFCmd.c.
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
    result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_PRED,
	    errorPtr);
    if (result != TCL_OK) {
	closedir(dirPtr);
	return result;
    }

    Tcl_DStringAppend(sourcePtr, "/", 1);
    sourceLen = Tcl_DStringLength(sourcePtr);

    if (targetPtr != NULL) {
	Tcl_DStringAppend(targetPtr, "/", 1);
	targetLen = Tcl_DStringLength(targetPtr);
    }

    while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */
	if ((dirEntPtr->d_name[0] == '.')
		&& ((dirEntPtr->d_name[1] == '\0')
			|| (strcmp(dirEntPtr->d_name, "..") == 0))) {







|



|







963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
    result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_PRED,
	    errorPtr);
    if (result != TCL_OK) {
	closedir(dirPtr);
	return result;
    }

    TclDStringAppendLiteral(sourcePtr, "/");
    sourceLen = Tcl_DStringLength(sourcePtr);

    if (targetPtr != NULL) {
	TclDStringAppendLiteral(targetPtr, "/");
	targetLen = Tcl_DStringLength(targetPtr);
    }

    while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */
	if ((dirEntPtr->d_name[0] == '.')
		&& ((dirEntPtr->d_name[1] == '\0')
			|| (strcmp(dirEntPtr->d_name, "..") == 0))) {
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
	string = Tcl_GetStringFromObj(dirObj, &len);
	Tcl_UtfToExternalDString(NULL, string, len, &template);
    } else {
	Tcl_DStringInit(&template);
	Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
    }

    Tcl_DStringAppend(&template, "/", -1);

    if (basenameObj) {
	string = Tcl_GetStringFromObj(basenameObj, &len);
	Tcl_UtfToExternalDString(NULL, string, len, &tmp);
	Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1);
	Tcl_DStringFree(&tmp);
    } else {
	Tcl_DStringAppend(&template, "tcl", -1);
    }

    Tcl_DStringAppend(&template, "_XXXXXX", -1);

#ifdef HAVE_MKSTEMPS
    if (extensionObj) {
	string = Tcl_GetStringFromObj(extensionObj, &len);
	Tcl_UtfToExternalDString(NULL, string, len, &tmp);
	Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1);
	fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else
#endif
    {
	fd = mkstemp(Tcl_DStringValue(&template));
    }







|




|


|


|





|







2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
	string = Tcl_GetStringFromObj(dirObj, &len);
	Tcl_UtfToExternalDString(NULL, string, len, &template);
    } else {
	Tcl_DStringInit(&template);
	Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
    }

    TclDStringAppendLiteral(&template, "/");

    if (basenameObj) {
	string = Tcl_GetStringFromObj(basenameObj, &len);
	Tcl_UtfToExternalDString(NULL, string, len, &tmp);
	TclDStringAppendDString(&template, &tmp);
	Tcl_DStringFree(&tmp);
    } else {
	TclDStringAppendLiteral(&template, "tcl");
    }

    TclDStringAppendLiteral(&template, "_XXXXXX");

#ifdef HAVE_MKSTEMPS
    if (extensionObj) {
	string = Tcl_GetStringFromObj(extensionObj, &len);
	Tcl_UtfToExternalDString(NULL, string, len, &tmp);
	TclDStringAppendDString(&template, &tmp);
	fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else
#endif
    {
	fd = mkstemp(Tcl_DStringValue(&template));
    }
Changes to unix/tclUnixFile.c.
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
    GetModuleFileNameW(NULL, buf, PATH_MAX);
    cygwin_conv_path(3, buf, name, PATH_MAX);
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
	/* Strip '.exe' part. */
	length -= 4;
    }
	encoding = Tcl_GetEncoding(NULL, NULL);
	TclSetObjNameOfExecutable(
		Tcl_NewStringObj(name, length), encoding);
#else
    const char *name, *p;
    Tcl_StatBuf statBuf;
    Tcl_DString buffer, nameString, cwd, utfName;

    if (argv0 == NULL) {
	return;







|
|
|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
    GetModuleFileNameW(NULL, buf, PATH_MAX);
    cygwin_conv_path(3, buf, name, PATH_MAX);
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
	/* Strip '.exe' part. */
	length -= 4;
    }
    encoding = Tcl_GetEncoding(NULL, NULL);
    TclSetObjNameOfExecutable(
	    Tcl_NewStringObj(name, length), encoding);
#else
    const char *name, *p;
    Tcl_StatBuf statBuf;
    Tcl_DString buffer, nameString, cwd, utfName;

    if (argv0 == NULL) {
	return;
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
	while (TclIsSpaceProc(*p)) {
	    p++;
	}
	name = p;
	while ((*p != ':') && (*p != 0)) {
	    p++;
	}
	Tcl_DStringSetLength(&buffer, 0);
	if (p != name) {
	    Tcl_DStringAppend(&buffer, name, p - name);
	    if (p[-1] != '/') {
		Tcl_DStringAppend(&buffer, "/", 1);
	    }
	}
	name = Tcl_DStringAppend(&buffer, argv0, -1);

	/*
	 * INTL: The following calls to access() and stat() should not be
	 * converted to Tclp routines because they need to operate on native







|



|







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
	while (TclIsSpaceProc(*p)) {
	    p++;
	}
	name = p;
	while ((*p != ':') && (*p != 0)) {
	    p++;
	}
	TclDStringClear(&buffer);
	if (p != name) {
	    Tcl_DStringAppend(&buffer, name, p - name);
	    if (p[-1] != '/') {
		TclDStringAppendLiteral(&buffer, "/");
	    }
	}
	name = Tcl_DStringAppend(&buffer, argv0, -1);

	/*
	 * INTL: The following calls to access() and stat() should not be
	 * converted to Tclp routines because they need to operate on native
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

    TclpGetCwd(NULL, &cwd);

    Tcl_DStringFree(&buffer);
    Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
	    Tcl_DStringLength(&cwd), &buffer);
    if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
	Tcl_DStringAppend(&buffer, "/", 1);
    }
    Tcl_DStringFree(&cwd);
    Tcl_DStringAppend(&buffer, Tcl_DStringValue(&nameString),
	    Tcl_DStringLength(&nameString));
    Tcl_DStringFree(&nameString);

    encoding = Tcl_GetEncoding(NULL, NULL);
    Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1,
	    &utfName);
    TclSetObjNameOfExecutable(
	    Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding);







|


|
<







170
171
172
173
174
175
176
177
178
179
180

181
182
183
184
185
186
187

    TclpGetCwd(NULL, &cwd);

    Tcl_DStringFree(&buffer);
    Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
	    Tcl_DStringLength(&cwd), &buffer);
    if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
	TclDStringAppendLiteral(&buffer, "/");
    }
    Tcl_DStringFree(&cwd);
    TclDStringAppendDString(&buffer, &nameString);

    Tcl_DStringFree(&nameString);

    encoding = Tcl_GetEncoding(NULL, NULL);
    Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1,
	    &utfName);
    TclSetObjNameOfExecutable(
	    Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding);
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
	    dirName = Tcl_DStringValue(&dsOrig);

	    /*
	     * Make sure we have a trailing directory delimiter.
	     */

	    if (dirName[dirLength-1] != '/') {
		dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
		dirLength++;
	    }
	}

	/*
	 * Now open the directory for reading and iterate over the contents.
	 */







|







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
	    dirName = Tcl_DStringValue(&dsOrig);

	    /*
	     * Make sure we have a trailing directory delimiter.
	     */

	    if (dirName[dirLength-1] != '/') {
		dirName = TclDStringAppendLiteral(&dsOrig, "/");
		dirLength++;
	    }
	}

	/*
	 * Now open the directory for reading and iterate over the contents.
	 */
Changes to unix/tclUnixNotfy.c.
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
	    if (waitingListPtr) {
		waitingListPtr->prevPtr = tsdPtr;
	    }
	    tsdPtr->prevPtr = 0;
	    waitingListPtr = tsdPtr;
	    tsdPtr->onList = 1;

	    if (write(triggerPipe, "", 1) != 1) {
		Tcl_Panic("Tcl_WaitForEvent: %s",
			"unable to write to triggerPipe");
	    }
	}

	FD_ZERO(&tsdPtr->readyMasks.readable);
	FD_ZERO(&tsdPtr->readyMasks.writable);







|







891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
	    if (waitingListPtr) {
		waitingListPtr->prevPtr = tsdPtr;
	    }
	    tsdPtr->prevPtr = 0;
	    waitingListPtr = tsdPtr;
	    tsdPtr->onList = 1;

	    if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
		Tcl_Panic("Tcl_WaitForEvent: %s",
			"unable to write to triggerPipe");
	    }
	}

	FD_ZERO(&tsdPtr->readyMasks.readable);
	FD_ZERO(&tsdPtr->readyMasks.writable);
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
		waitingListPtr = tsdPtr->nextPtr;
	    }
	    if (tsdPtr->nextPtr) {
		tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
	    }
	    tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
	    tsdPtr->onList = 0;
	    if (write(triggerPipe, "", 1) != 1) {
		Tcl_Panic("Tcl_WaitForEvent: %s",
			"unable to write to triggerPipe");
	    }
	}

#else
	tsdPtr->readyMasks = tsdPtr->checkMasks;







|







954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
		waitingListPtr = tsdPtr->nextPtr;
	    }
	    if (tsdPtr->nextPtr) {
		tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
	    }
	    tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
	    tsdPtr->onList = 0;
	    if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
		Tcl_Panic("Tcl_WaitForEvent: %s",
			"unable to write to triggerPipe");
	    }
	}

#else
	tsdPtr->readyMasks = tsdPtr->checkMasks;
Changes to unix/tclUnixPipe.c.
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
	return NULL;
    }
    fcntl(fd, F_SETFD, FD_CLOEXEC);
    unlink(fileName);					/* INTL: Native. */

    if (contents != NULL) {
	native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
	if (write(fd, native, strlen(native)) == -1) {
	    close(fd);
	    Tcl_DStringFree(&dstring);
	    return NULL;
	}
	Tcl_DStringFree(&dstring);
	TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_SET);
    }







|







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
	return NULL;
    }
    fcntl(fd, F_SETFD, FD_CLOEXEC);
    unlink(fileName);					/* INTL: Native. */

    if (contents != NULL) {
	native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
	if (write(fd, native, Tcl_DStringLength(&dstring)) == -1) {
	    close(fd);
	    Tcl_DStringFree(&dstring);
	    return NULL;
	}
	Tcl_DStringFree(&dstring);
	TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_SET);
    }
Changes to win/Makefile.in.
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
	@echo "Installing package http 2.8.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.4.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.4.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm;
	@echo "Installing package tcltest 2.3.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.4.tm;
	@echo "Installing package platform 1.0.10 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.10.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";







|
|







665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
	@echo "Installing package http 2.8.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.4.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.4.5 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.5.tm;
	@echo "Installing package tcltest 2.3.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.4.tm;
	@echo "Installing package platform 1.0.10 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.10.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";
Changes to win/tclWinDde.c.
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
 */

static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance;	/* The application instance handle given to us
				 * by DdeInitialize. */
static int ddeIsServer = 0;

#define TCL_DDE_VERSION		"1.4.0"
#define TCL_DDE_PACKAGE_NAME	"dde"
#define TCL_DDE_SERVICE_NAME	TEXT("TclEval")
#define TCL_DDE_EXECUTE_RESULT	TEXT("$TCLEVAL$EXECUTE$RESULT")

#define DDE_FLAG_ASYNC 1
#define DDE_FLAG_BINARY 2
#define DDE_FLAG_FORCE 4







|







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
 */

static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance;	/* The application instance handle given to us
				 * by DdeInitialize. */
static int ddeIsServer = 0;

#define TCL_DDE_VERSION		"1.4.0b1"
#define TCL_DDE_PACKAGE_NAME	"dde"
#define TCL_DDE_SERVICE_NAME	TEXT("TclEval")
#define TCL_DDE_EXECUTE_RESULT	TEXT("$TCLEVAL$EXECUTE$RESULT")

#define DDE_FLAG_ASYNC 1
#define DDE_FLAG_BINARY 2
#define DDE_FLAG_FORCE 4
Changes to win/tclWinFCmd.c.
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137

		path = (const char *) nativePath;

		Tcl_DStringInit(&buffer);
		len = strlen(path);
		find = Tcl_DStringAppend(&buffer, path, len);
		if ((len > 0) && (find[len - 1] != '\\')) {
		    Tcl_DStringAppend(&buffer, "\\", 1);
		}
		find = Tcl_DStringAppend(&buffer, "*.*", 3);
		handle = FindFirstFileA(find, &data);
		if (handle != INVALID_HANDLE_VALUE) {
		    while (1) {
			if ((strcmp(data.cFileName, ".") != 0)
				&& (strcmp(data.cFileName, "..") != 0)) {
			    /*
			     * Found something in this directory.







|

|







1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137

		path = (const char *) nativePath;

		Tcl_DStringInit(&buffer);
		len = strlen(path);
		find = Tcl_DStringAppend(&buffer, path, len);
		if ((len > 0) && (find[len - 1] != '\\')) {
		    TclDStringAppendLiteral(&buffer, "\\");
		}
		find = TclDStringAppendLiteral(&buffer, "*.*");
		handle = FindFirstFileA(find, &data);
		if (handle != INVALID_HANDLE_VALUE) {
		    while (1) {
			if ((strcmp(data.cFileName, ".") != 0)
				&& (strcmp(data.cFileName, "..") != 0)) {
			    /*
			     * Found something in this directory.
Changes to win/tclWinFile.c.
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026

	Tcl_DStringInit(&dsOrig);
	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

	lastChar = dirName[dirLength -1];
	if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
	    Tcl_DStringAppend(&dsOrig, "/", 1);
	    dirLength++;
	}
	dirName = Tcl_DStringValue(&dsOrig);

	/*
	 * We need to check all files in the directory, so we append '*.*' to
	 * the path, unless the pattern we've been given is rather simple,
	 * when we can use that instead.
	 */

	if (strpbrk(pattern, "[]\\") == NULL) {
	    /*
	     * The pattern is a simple one containing just '*' and/or '?'.
	     * This means we can get the OS to help us, by passing it the
	     * pattern.
	     */

	    dirName = Tcl_DStringAppend(&dsOrig, pattern, -1);
	} else {
	    dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3);
	}

	native = Tcl_WinUtfToTChar(dirName, -1, &ds);
	if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) {
	    handle = FindFirstFile(native, &data);
	} else {
	    /*







|



















|







992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026

	Tcl_DStringInit(&dsOrig);
	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

	lastChar = dirName[dirLength -1];
	if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
	    TclDStringAppendLiteral(&dsOrig, "/");
	    dirLength++;
	}
	dirName = Tcl_DStringValue(&dsOrig);

	/*
	 * We need to check all files in the directory, so we append '*.*' to
	 * the path, unless the pattern we've been given is rather simple,
	 * when we can use that instead.
	 */

	if (strpbrk(pattern, "[]\\") == NULL) {
	    /*
	     * The pattern is a simple one containing just '*' and/or '?'.
	     * This means we can get the OS to help us, by passing it the
	     * pattern.
	     */

	    dirName = Tcl_DStringAppend(&dsOrig, pattern, -1);
	} else {
	    dirName = TclDStringAppendLiteral(&dsOrig, "*.*");
	}

	native = Tcl_WinUtfToTChar(dirName, -1, &ds);
	if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) {
	    handle = FindFirstFile(native, &data);
	} else {
	    /*
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
		/*
		 * 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);
	    NetApiBufferFree((void *) uiPtr);
	}
	Tcl_DStringFree(&ds);
    }
    if (wDomain != NULL) {







|







1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
		/*
		 * User exists but has no home dir. Return
		 * "{Windows Drive}:/users/default".
		 */

		GetWindowsDirectoryW(buf, MAX_PATH);
		Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
		TclDStringAppendLiteral(bufferPtr, "/users/default");
	    }
	    result = Tcl_DStringValue(bufferPtr);
	    NetApiBufferFree((void *) uiPtr);
	}
	Tcl_DStringFree(&ds);
    }
    if (wDomain != NULL) {
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
	p = strchr(p + 1, '\\');
	if (p == NULL) {
	    /*
	     * Add terminating backslash to fullpath or GetVolumeInformation()
	     * won't work.
	     */

	    fullPath = Tcl_DStringAppend(&ds, "\\", 1);
	    p = fullPath + Tcl_DStringLength(&ds);
	} else {
	    p++;
	}
	nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
	dw = (DWORD) -1;
	GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0);







|







2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
	p = strchr(p + 1, '\\');
	if (p == NULL) {
	    /*
	     * Add terminating backslash to fullpath or GetVolumeInformation()
	     * won't work.
	     */

	    fullPath = TclDStringAppendLiteral(&ds, "\\");
	    p = fullPath + Tcl_DStringLength(&ds);
	} else {
	    p++;
	}
	nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
	dw = (DWORD) -1;
	GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0);
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
			    }

			    /*
			     * This is usually the '/' in 'c:/' at end of
			     * string.
			     */

			    Tcl_DStringAppend(&dsNorm,"/", 1);
			} else {
			    char *nativeName;

			    if (fData.cFileName[0] != '\0') {
				nativeName = fData.cFileName;
			    } else {
				nativeName = fData.cAlternateFileName;
			    }
			    FindClose(handle);
			    Tcl_DStringAppend(&dsNorm,"/", 1);
			    Tcl_DStringAppend(&dsNorm,nativeName,-1);
			}
		    }
		}
		Tcl_DStringFree(&ds);
		lastValidPathEnd = currentPathEndPosition;
		if (cur == 0) {
		    break;







|









|
|







2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
			    }

			    /*
			     * This is usually the '/' in 'c:/' at end of
			     * string.
			     */

			    TclDStringAppendLiteral(&dsNorm, "/");
			} else {
			    char *nativeName;

			    if (fData.cFileName[0] != '\0') {
				nativeName = fData.cFileName;
			    } else {
				nativeName = fData.cAlternateFileName;
			    }
			    FindClose(handle);
			    TclDStringAppendLiteral(&dsNorm, "/");
			    Tcl_DStringAppend(&dsNorm, nativeName, -1);
			}
		    }
		}
		Tcl_DStringFree(&ds);
		lastValidPathEnd = currentPathEndPosition;
		if (cur == 0) {
		    break;
Changes to win/tclWinInt.h.
22
23
24
25
26
27
28






29
30
31
32
33
34
35

#ifndef VER_PLATFORM_WIN32_WINDOWS
#define VER_PLATFORM_WIN32_WINDOWS 1
#endif
#ifndef VER_PLATFORM_WIN32_CE
#define VER_PLATFORM_WIN32_CE 3
#endif







#ifdef _WIN64
#         define TCL_I_MODIFIER        "I"
#else
#         define TCL_I_MODIFIER        ""
#endif








>
>
>
>
>
>







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

#ifndef VER_PLATFORM_WIN32_WINDOWS
#define VER_PLATFORM_WIN32_WINDOWS 1
#endif
#ifndef VER_PLATFORM_WIN32_CE
#define VER_PLATFORM_WIN32_CE 3
#endif

#ifdef _WIN64
#         define TCL_I_MODIFIER        "I"
#else
#         define TCL_I_MODIFIER        ""
#endif

#ifdef _WIN64
#         define TCL_I_MODIFIER        "I"
#else
#         define TCL_I_MODIFIER        ""
#endif

Changes to win/tclWinLoad.c.
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194

    proc = (void *) GetProcAddress(hInstance, symbol);
    if (proc == NULL) {
	Tcl_DString ds;
	const char *sym2;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "_", 1);
	sym2 = Tcl_DStringAppend(&ds, symbol, -1);
	proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
	Tcl_DStringFree(&ds);
    }
    if (proc == NULL && interp != NULL) {
	Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);







|







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194

    proc = (void *) GetProcAddress(hInstance, symbol);
    if (proc == NULL) {
	Tcl_DString ds;
	const char *sym2;

	Tcl_DStringInit(&ds);
	TclDStringAppendLiteral(&ds, "_");
	sym2 = Tcl_DStringAppend(&ds, symbol, -1);
	proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
	Tcl_DStringFree(&ds);
    }
    if (proc == NULL && interp != NULL) {
	Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
Changes to win/tclWinPipe.c.
672
673
674
675
676
677
678

679
680
681
682
683
684
685

686
687
688
689
690
691
692
693
    /*
     * Write the file out, doing line translations on the way.
     */

    if (contents != NULL) {
	DWORD result, length;
	const char *p;


	/*
	 * Convert the contents from UTF to native encoding
	 */

	native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);


	for (p = native; *p != '\0'; p++) {
	    if (*p == '\n') {
		length = p - native;
		if (length > 0) {
		    if (!WriteFile(handle, native, length, &result, NULL)) {
			goto error;
		    }
		}







>







>
|







672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
    /*
     * Write the file out, doing line translations on the way.
     */

    if (contents != NULL) {
	DWORD result, length;
	const char *p;
	int toCopy;

	/*
	 * Convert the contents from UTF to native encoding
	 */

	native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);

	toCopy = Tcl_DStringLength(&dstring);
	for (p = native; toCopy > 0; p++, toCopy--) {
	    if (*p == '\n') {
		length = p - native;
		if (length > 0) {
		    if (!WriteFile(handle, native, length, &result, NULL)) {
			goto error;
		    }
		}
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
	     * console application, and then run that hidden console as a
	     * detached process.
	     */

	    startInfo.wShowWindow = SW_HIDE;
	    startInfo.dwFlags |= STARTF_USESHOWWINDOW;
	    createFlags = CREATE_NEW_CONSOLE;
	    Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1);
	} else {
	    createFlags = DETACHED_PROCESS;
	}
    } else {
	if (HasConsole()) {
	    createFlags = 0;
	} else {







|







1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
	     * console application, and then run that hidden console as a
	     * detached process.
	     */

	    startInfo.wShowWindow = SW_HIDE;
	    startInfo.dwFlags |= STARTF_USESHOWWINDOW;
	    createFlags = CREATE_NEW_CONSOLE;
	    TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
	} else {
	    createFlags = DETACHED_PROCESS;
	}
    } else {
	if (HasConsole()) {
	    createFlags = 0;
	} else {
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504

    Tcl_DStringInit(&ds);

    /*
     * Prime the path. Add a space separator if we were primed with something.
     */

    Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
    if (Tcl_DStringLength(linePtr) > 0) {
	Tcl_DStringAppend(&ds, " ", 1);
    }

    for (i = 0; i < argc; i++) {
	if (i == 0) {
	    arg = executable;
	} else {
	    arg = argv[i];
	    Tcl_DStringAppend(&ds, " ", 1);
	}

	quote = 0;
	if (arg[0] == '\0') {
	    quote = 1;
	} else {
	    int count;
	    Tcl_UniChar ch;

	    for (start = arg; *start != '\0'; start += count) {
		count = Tcl_UtfToUniChar(start, &ch);
		if (Tcl_UniCharIsSpace(ch)) {	/* INTL: ISO space. */
		    quote = 1;
		    break;
		}
	    }
	}
	if (quote) {
	    Tcl_DStringAppend(&ds, "\"", 1);
	}
	start = arg;
	for (special = arg; ; ) {
	    if ((*special == '\\') && (special[1] == '\\' ||
		    special[1] == '"' || (quote && special[1] == '\0'))) {
		Tcl_DStringAppend(&ds, start, (int) (special - start));
		start = special;







|

|







|


















|







1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506

    Tcl_DStringInit(&ds);

    /*
     * Prime the path. Add a space separator if we were primed with something.
     */

    TclDStringAppendDString(&ds, linePtr);
    if (Tcl_DStringLength(linePtr) > 0) {
	TclDStringAppendLiteral(&ds, " ");
    }

    for (i = 0; i < argc; i++) {
	if (i == 0) {
	    arg = executable;
	} else {
	    arg = argv[i];
	    TclDStringAppendLiteral(&ds, " ");
	}

	quote = 0;
	if (arg[0] == '\0') {
	    quote = 1;
	} else {
	    int count;
	    Tcl_UniChar ch;

	    for (start = arg; *start != '\0'; start += count) {
		count = Tcl_UtfToUniChar(start, &ch);
		if (Tcl_UniCharIsSpace(ch)) {	/* INTL: ISO space. */
		    quote = 1;
		    break;
		}
	    }
	}
	if (quote) {
	    TclDStringAppendLiteral(&ds, "\"");
	}
	start = arg;
	for (special = arg; ; ) {
	    if ((*special == '\\') && (special[1] == '\\' ||
		    special[1] == '"' || (quote && special[1] == '\0'))) {
		Tcl_DStringAppend(&ds, start, (int) (special - start));
		start = special;
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
		    }
		}
		Tcl_DStringAppend(&ds, start, (int) (special - start));
		start = special;
	    }
	    if (*special == '"') {
		Tcl_DStringAppend(&ds, start, (int) (special - start));
		Tcl_DStringAppend(&ds, "\\\"", 2);
		start = special + 1;
	    }
	    if (*special == '\0') {
		break;
	    }
	    special++;
	}
	Tcl_DStringAppend(&ds, start, (int) (special - start));
	if (quote) {
	    Tcl_DStringAppend(&ds, "\"", 1);
	}
    }
    Tcl_DStringFree(linePtr);
    Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
    Tcl_DStringFree(&ds);
}








|









|







1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
		    }
		}
		Tcl_DStringAppend(&ds, start, (int) (special - start));
		start = special;
	    }
	    if (*special == '"') {
		Tcl_DStringAppend(&ds, start, (int) (special - start));
		TclDStringAppendLiteral(&ds, "\\\"");
		start = special + 1;
	    }
	    if (*special == '\0') {
		break;
	    }
	    special++;
	}
	Tcl_DStringAppend(&ds, start, (int) (special - start));
	if (quote) {
	    TclDStringAppendLiteral(&ds, "\"");
	}
    }
    Tcl_DStringFree(linePtr);
    Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
    Tcl_DStringFree(&ds);
}

Changes to win/tclWinReg.c.
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
    while (result == ERROR_MORE_DATA) {
	/*
	 * The Windows docs say that in this error case, we just need to
	 * expand our buffer and request more data. Required for
	 * HKEY_PERFORMANCE_DATA
	 */

	length *= 2;
	Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR));
	result = RegQueryValueEx(key, nativeValue,
		NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
    }
    Tcl_DStringFree(&buf);
    RegCloseKey(key);
    if (result != ERROR_SUCCESS) {







|







776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
    while (result == ERROR_MORE_DATA) {
	/*
	 * The Windows docs say that in this error case, we just need to
	 * expand our buffer and request more data. Required for
	 * HKEY_PERFORMANCE_DATA
	 */

	length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR));
	Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR));
	result = RegQueryValueEx(key, nativeValue,
		NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
    }
    Tcl_DStringFree(&buf);
    RegCloseKey(key);
    if (result != ERROR_SUCCESS) {
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    resultPtr = Tcl_NewObj();
    Tcl_DStringInit(&buffer);
    Tcl_DStringSetLength(&buffer,
	    (int) (MAX_KEY_LENGTH*sizeof(TCHAR)));
    index = 0;
    result = TCL_OK;

    if (patternObj) {
	pattern = Tcl_GetString(patternObj);
    } else {
	pattern = NULL;







|
<







885
886
887
888
889
890
891
892

893
894
895
896
897
898
899
    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    resultPtr = Tcl_NewObj();
    Tcl_DStringInit(&buffer);
    Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));

    index = 0;
    result = TCL_OK;

    if (patternObj) {
	pattern = Tcl_GetString(patternObj);
    } else {
	pattern = NULL;
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
    mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
    result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey);
    if (result != ERROR_SUCCESS) {
	return result;
    }

    Tcl_DStringInit(&subkey);
    Tcl_DStringSetLength(&subkey,
	    (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));

    mode = saveMode;
    while (result == ERROR_SUCCESS) {
	/*
	 * Always get index 0 because key deletion changes ordering.
	 */








|
<







1187
1188
1189
1190
1191
1192
1193
1194

1195
1196
1197
1198
1199
1200
1201
    mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
    result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey);
    if (result != ERROR_SUCCESS) {
	return result;
    }

    Tcl_DStringInit(&subkey);
    Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));


    mode = saveMode;
    while (result == ERROR_SUCCESS) {
	/*
	 * Always get index 0 because key deletion changes ordering.
	 */

1314
1315
1316
1317
1318
1319
1320


1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
	 * Append the elements as null terminated strings. Note that we must
	 * not assume the length of the string in case there are embedded
	 * nulls, which aren't allowed in REG_MULTI_SZ values.
	 */

	Tcl_DStringInit(&data);
	for (i = 0; i < objc; i++) {


	    Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);

	    /*
	     * Add a null character to separate this value from the next. We
	     * accomplish this by growing the string by one byte. Since the
	     * DString always tacks on an extra null byte, the new byte will
	     * already be set to null.
	     */

	    Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1);
	}

	Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
		&buf);
	result = RegSetValueEx(key, (TCHAR *)valueName, 0,
		(DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
		(DWORD) Tcl_DStringLength(&buf));







>
>
|


|
<
<
<


|







1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324



1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
	 * Append the elements as null terminated strings. Note that we must
	 * not assume the length of the string in case there are embedded
	 * nulls, which aren't allowed in REG_MULTI_SZ values.
	 */

	Tcl_DStringInit(&data);
	for (i = 0; i < objc; i++) {
	    const char *bytes = Tcl_GetStringFromObj(objv[i], &length);

	    Tcl_DStringAppend(&data, bytes, length);

	    /*
	     * Add a null character to separate this value from the next.



	     */

	    Tcl_DStringAppend(&data, "", 1);	/* NUL-terminated string */
	}

	Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
		&buf);
	result = RegSetValueEx(key, (TCHAR *)valueName, 0,
		(DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
		(DWORD) Tcl_DStringLength(&buf));
Changes to win/tclWinSock.c.
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
     */

    infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
    if (infoPtr == NULL) {
	return NULL;
    }

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel,
	    "-translation", "auto crlf")) {
	Tcl_Close(NULL, infoPtr->channel);
	return NULL;







|







1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
     */

    infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
    if (infoPtr == NULL) {
	return NULL;
    }

    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel,
	    "-translation", "auto crlf")) {
	Tcl_Close(NULL, infoPtr->channel);
	return NULL;
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
    /*
     * Start watching for read/write events on the socket.
     */

    infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
    return infoPtr->channel;
}

/*







|







1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
    /*
     * Start watching for read/write events on the socket.
     */

    infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);

    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
    return infoPtr->channel;
}

/*
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
    if (infoPtr == NULL) {
	return NULL;
    }

    infoPtr->acceptProc = acceptProc;
    infoPtr->acceptProcData = acceptProcData;

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, 0);
    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close(NULL, infoPtr->channel);
	return NULL;







|







1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
    if (infoPtr == NULL) {
	return NULL;
    }

    infoPtr->acceptProc = acceptProc;
    infoPtr->acceptProcData = acceptProcData;

    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, 0);
    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close(NULL, infoPtr->channel);
	return NULL;
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
     * Select on read/write events and create the channel.
     */

    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
	    (LPARAM) newInfoPtr);

    sprintf(channelName, "sock%Id", (size_t) newInfoPtr->sockets->fd);
    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_Close(NULL, newInfoPtr->channel);
	return;
    }







|







1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
     * Select on read/write events and create the channel.
     */

    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
	    (LPARAM) newInfoPtr);

    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) newInfoPtr->sockets->fd);
    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_Close(NULL, newInfoPtr->channel);
	return;
    }
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604

	Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds));

    } else {
	Tcl_DStringInit(&ds);
	if (TclpHasSockets(NULL) == TCL_OK) {
	    /*
	     * Buffer length of 255 copied slavishly from previous version of
	     * this routine. Presumably there's a more "correct" macro value
	     * for a properly sized buffer for a gethostname() call.
	     * Maintainers are welcome to supply it.
	     */

	    Tcl_DString inDs;

	    Tcl_DStringInit(&inDs);
	    Tcl_DStringSetLength(&inDs, 255);
	    if (gethostname(Tcl_DStringValue(&inDs),
			    Tcl_DStringLength(&inDs)) == 0) {
		Tcl_DStringSetLength(&ds, 0);
	    } else {
		Tcl_ExternalToUtfDString(NULL,
			Tcl_DStringValue(&inDs), -1, &ds);
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);







|
<
|
<





|

|
<
<
|
|







2575
2576
2577
2578
2579
2580
2581
2582

2583

2584
2585
2586
2587
2588
2589
2590
2591


2592
2593
2594
2595
2596
2597
2598
2599
2600

	Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds));

    } else {
	Tcl_DStringInit(&ds);
	if (TclpHasSockets(NULL) == TCL_OK) {
	    /*
	     * The buffer size of 256 is recommended by the MSDN page that

	     * documents gethostname() as being always adequate.

	     */

	    Tcl_DString inDs;

	    Tcl_DStringInit(&inDs);
	    Tcl_DStringSetLength(&inDs, 256);
	    if (gethostname(Tcl_DStringValue(&inDs),
		    Tcl_DStringLength(&inDs)) == 0) {


		Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
			&ds);
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);