Tcl Source Code

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

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | jn-unc-vfs
Files: files | file ages | folders
SHA1: 777950336d0f45be59bfe03d8c7cd3ea78c4a9b1
User & Date: jan.nijtmans 2012-07-16 11:24:21
Context
2012-08-02
12:54
merge trunk check-in: 15da7fc903 user: jan.nijtmans tags: jn-unc-vfs
2012-07-16
11:24
merge trunk check-in: 777950336d user: jan.nijtmans tags: jn-unc-vfs
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: jn-unc-vfs
Changes
Hide Diffs Unified Diffs 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
...
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815



























































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.
................................................................................

	* 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
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











|







 







|
|
<







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
...
859
860
861
862
863
864
865
866
867

868
869
870
871
872
873
874
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.
................................................................................

	* 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
..
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
................................................................................
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
..
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
................................................................................
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
...
171
172
173
174
175
176
177
178
179




180
181
182
183
184
185
186
187
188
189
.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
................................................................................
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






|







 







|
|
>
>
>
>
|
|
<







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185

186
187
188
189
190
191
192
.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
................................................................................
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
...
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
....
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
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);
................................................................................

#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},
................................................................................
 *-----------------------------------------------------------------------------
 */

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 */







|







 







|







 







|







261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
...
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
....
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
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);
................................................................................

#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},
................................................................................
 *-----------------------------------------------------------------------------
 */

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
....
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
....
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
....
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
....
8589
8590
8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
....
8816
8817
8818
8819
8820
8821
8822
8823
8824
8825
8826
8827
8828
8829
8830
....
8845
8846
8847
8848
8849
8850
8851
8852
8853
8854
8855
8856
8857
8858
8859
....
8967
8968
8969
8970
8971
8972
8973
8974
8975
8976
8977
8978
8979
8980
8981
8982
8983
8984
8985
8986
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);
................................................................................
     * 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);

................................................................................
    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);
}
 
................................................................................
	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];
................................................................................
    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;
................................................................................

    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;
    }

................................................................................
    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;

................................................................................
     */

    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.






>
>







 







|







 







|







 







|







 







|







 







|







 







|







 







|




|







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
....
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
....
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
....
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
....
8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
8604
8605
....
8818
8819
8820
8821
8822
8823
8824
8825
8826
8827
8828
8829
8830
8831
8832
....
8847
8848
8849
8850
8851
8852
8853
8854
8855
8856
8857
8858
8859
8860
8861
....
8969
8970
8971
8972
8973
8974
8975
8976
8977
8978
8979
8980
8981
8982
8983
8984
8985
8986
8987
8988
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);
................................................................................
     * 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);

................................................................................
    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);
}
 
................................................................................
	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];
................................................................................
    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;
................................................................................

    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;
    }

................................................................................
    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;

................................................................................
     */

    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
....
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
    /*
     * 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) {
................................................................................

	/*
	 * 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;
	}






|







 







|







816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
....
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
    /*
     * 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) {
................................................................................

	/*
	 * 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
....
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
....
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
....
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
....
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
		    /*
		     * 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)
................................................................................
    }

    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);
................................................................................

	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(
................................................................................
	    /*
	     * 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++;
................................................................................
    }

    /*
     * 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;
    }







|
|







 







|







 







|
<
<







 







|
<
<







 







|

<
<


<







1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
....
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
....
2087
2088
2089
2090
2091
2092
2093
2094


2095
2096
2097
2098
2099
2100
2101
....
2114
2115
2116
2117
2118
2119
2120
2121


2122
2123
2124
2125
2126
2127
2128
....
2137
2138
2139
2140
2141
2142
2143
2144
2145


2146
2147

2148
2149
2150
2151
2152
2153
2154
		    /*
		     * 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)
................................................................................
    }

    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);
................................................................................

	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(
................................................................................
	    /*
	     * 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++;
................................................................................
    }

    /*
     * 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
....
1360
1361
1362
1363
1364
1365
1366










1367
1368
1369
1370
1371
1372
1373
 
/*
 *----------------------------------------------------------------
 * 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
 *----------------------------------------------------------------
 */

................................................................................
/*
 * 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






<
|







 







>
>
>
>
>
>
>
>
>
>







862
863
864
865
866
867
868

869
870
871
872
873
874
875
876
....
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
 
/*
 *----------------------------------------------------------------
 * 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
 *----------------------------------------------------------------
 */

................................................................................
/*
 * 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
...
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.
     */

................................................................................
		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
...
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.
     */

................................................................................
		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
....
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
....
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
....
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
    /*
     * 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;
................................................................................
	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) {
................................................................................
     * 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);
................................................................................
	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) {






|

|







 







|






|







 







|







 







|
|

|







1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
....
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
....
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
....
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
    /*
     * 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;
................................................................................
	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) {
................................................................................
     * 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);
................................................................................
	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
...
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
...
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
...
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
...
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
....
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
....
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
....
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
....
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595

1596
1597
1598
1599
1600
1601
1602
....
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
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 --
................................................................................

	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.
	 */
................................................................................
	     * 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.
................................................................................
	}

	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.
	 */
................................................................................

	    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;

	/*
................................................................................
    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.
     */
................................................................................
	     * 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') {
................................................................................
    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;
................................................................................
	}
    } 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;
	    }
	}
................................................................................
	}

	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.






|

|







 







|







 







|







 







|

|







 







|







 







|







 







|







 







|
<







 







|
<

<
<
>







 







|

|








|

|







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
...
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
...
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
...
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
...
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
....
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
....
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
....
1567
1568
1569
1570
1571
1572
1573
1574

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

1591


1592
1593
1594
1595
1596
1597
1598
1599
....
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
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 --
................................................................................

	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.
	 */
................................................................................
	     * 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.
................................................................................
	}

	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.
	 */
................................................................................

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

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

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

	/*
................................................................................
    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.
     */
................................................................................
	     * 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') {
................................................................................
    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;
................................................................................
	}
    } 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;
	    }
	}
................................................................................
	}

	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
....
7546
7547
7548
7549
7550
7551
7552
7553
7554
7555
7556
7557
7558
7559
7560
    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;
}
 
/*
 *---------------------------------------------------------------------------
................................................................................
	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);






|
<




|
<







 







|







4427
4428
4429
4430
4431
4432
4433
4434

4435
4436
4437
4438
4439

4440
4441
4442
4443
4444
4445
4446
....
7544
7545
7546
7547
7548
7549
7550
7551
7552
7553
7554
7555
7556
7557
7558
    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;
}
 
/*
 *---------------------------------------------------------------------------
................................................................................
	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
....
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
....
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
....
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
....
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
    /*
     * 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.
     */

................................................................................
		(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;
................................................................................
	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:
................................................................................
	     * 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].
		 */
................................................................................

		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;







|







 







|







 







|
<







 







|







 







|







1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
....
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
....
3203
3204
3205
3206
3207
3208
3209
3210

3211
3212
3213
3214
3215
3216
3217
....
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
....
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
    /*
     * 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.
     */

................................................................................
		(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;
................................................................................
	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:
................................................................................
	     * 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].
		 */
................................................................................

		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
...
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
...
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
...
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
...
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
...
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
...
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
...
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
....
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
....
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
#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);
................................................................................
 */

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
................................................................................
{
    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(
................................................................................
    }
    tsdPtr->initialized = 0;
}
 
int
TclFSCwdIsNative(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

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

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);
	}
................................................................................
	}
    }
}
 
static void
FsRecacheFilesystemList(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list;

    /*
     * Trash the current cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
................................................................................
	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;
}
 
................................................................................
{
    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) {
................................................................................
 *----------------------------------------------------------------------
 */

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
................................................................................
	     * 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.
	     */







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







 







|







 







|







 







|







 







|







 







|







 







|







 







|






|


>
>
>
>
>
>
>
>












|







 







|







 







|







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
...
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
...
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
...
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
...
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
...
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
...
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
...
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
....
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
....
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
#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);
................................................................................
 */

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
................................................................................
{
    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(
................................................................................
    }
    tsdPtr->initialized = 0;
}
 
int
TclFSCwdIsNative(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

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

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);
	}
................................................................................
	}
    }
}
 
static void
FsRecacheFilesystemList(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
    FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list;

    /*
     * Trash the current cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
................................................................................
	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;
}
 
................................................................................
{
    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) {
................................................................................
 *----------------------------------------------------------------------
 */

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
................................................................................
	     * 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
...
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
     *  - 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
................................................................................

  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;
}






>
>
>
>







 







|


>
>
>
>



|



|
|
|
<



|

>

>







298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
...
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
     *  - 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
................................................................................

  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
....
4446
4447
4448
4449
4450
4451
4452















4453
4454
4455
4456
4457
4458
4459
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);
................................................................................
/*
 * 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);






>
>
>
>







 







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







2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
....
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
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);
................................................................................
/*
 * 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
...
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
...
429
430
431
432
433
434
435
436

437
438
439
440
441
442
443
/* 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 */
................................................................................
    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 */
................................................................................
	(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 \






|
>
>
>







 







|







 







|
>







136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
...
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
...
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
/* 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 */
................................................................................
    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 */
................................................................................
	(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
...
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
...
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
...
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
    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;
................................................................................
			    "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
................................................................................
		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);
................................................................................
    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;






|

|










|







 







|







 







|
|
|
|
|
|
|
|







 







|

|










|







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
...
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
...
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
...
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
    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;
................................................................................
			    "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
................................................................................
		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);
................................................................................
    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
...
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
...
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
....
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
....
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
....
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
 *   [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 {
................................................................................
    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.
	     */

................................................................................
     * 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);
	}
    }
................................................................................
	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.
	 */
................................................................................
	     * 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,
................................................................................
	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);
	}
    }

    /*






|







 







|

|
<







|







 







|







 







|







 







|







 







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
...
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
...
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
....
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
....
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
....
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
 *   [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 {
................................................................................
    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.
	     */

................................................................................
     * 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);
	}
    }
................................................................................
	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.
	 */
................................................................................
	     * 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,
................................................................................
	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
...
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
    /*
     * 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);
................................................................................
		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);
    }

    /*






|






|







 







|







352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
...
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
    /*
     * 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);
................................................................................
		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
...
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
....
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
....
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
....
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
....
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
....
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
....
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
....
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
....
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
			    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 = {
................................................................................
    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;
}
................................................................................

    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
................................................................................
     */

    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;
}
................................................................................
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;
    }
................................................................................
     * 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;
}
................................................................................

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) {
................................................................................
	    return;
	}
    }

    srcFsPathPtr = PATHOBJ(pathPtr);
    srcFsPathPtr->fsPtr = fsPtr;
    srcFsPathPtr->nativePathPtr = clientData;
    srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSEqualPaths --
 *
................................................................................
    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
................................................................................

    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;






>
>







 







|







 







|













|
|




<







 







|







 







<







 







|







 







<







 







|







 







<







 







|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
...
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
....
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
....
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
....
1560
1561
1562
1563
1564
1565
1566

1567
1568
1569
1570
1571
1572
1573
....
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
....
2202
2203
2204
2205
2206
2207
2208

2209
2210
2211
2212
2213
2214
2215
....
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
....
2306
2307
2308
2309
2310
2311
2312

2313
2314
2315
2316
2317
2318
2319
....
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
			    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 = {
................................................................................
    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;
}
................................................................................

    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
................................................................................
     */

    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;
}
................................................................................
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;
    }
................................................................................
     * 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;
}
................................................................................

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) {
................................................................................
	    return;
	}
    }

    srcFsPathPtr = PATHOBJ(pathPtr);
    srcFsPathPtr->fsPtr = fsPtr;
    srcFsPathPtr->nativePathPtr = clientData;
    srcFsPathPtr->filesystemEpoch = TclFSEpoch();
}
 
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSEqualPaths --
 *
................................................................................
    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
................................................................................

    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
...
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
{
    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
................................................................................
    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 */






>







 







|







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
...
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
{
    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
................................................................................
    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
....
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
....
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
	 */

	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
................................................................................
	    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
................................................................................
		} 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;






|

|







 







|

|

|

|




|

|

|

|







 







|







1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
....
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
....
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
	 */

	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
................................................................................
	    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
................................................................................
		} 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
....
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
....
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
    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.
 *
................................................................................
 */

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 --
................................................................................
 *----------------------------------------------------------------------
 */

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






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







 







|

|







 







|







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
....
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
....
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
    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.
 *
................................................................................
 */

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

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
....
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
....
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
     */

    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;
................................................................................

	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.
................................................................................
    } 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;
    }
}
 
/*
 *----------------------------------------------------------------------
 *






|
|
<







 







<
<
<
|







 







|







569
570
571
572
573
574
575
576
577

578
579
580
581
582
583
584
....
2690
2691
2692
2693
2694
2695
2696



2697
2698
2699
2700
2701
2702
2703
2704
....
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
     */

    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;
................................................................................

	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.
................................................................................
    } 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
..
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
..
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
..
88
89
90
91
92
93
94

95
96
97
98
99
100
101
...
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
...
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
...
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
...
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
#
# 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 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
................................................................................
	    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 [email protected]
	    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
................................................................................
	    2b hy 042b hy_AM
	    2c az 042c [email protected] 082c [email protected]
	    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
................................................................................
		 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 --
#
................................................................................
# 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} {
................................................................................
	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 {
................................................................................
	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,






|







 







|







 







|
|







 







>







 







|







 







|
|

|







 







|







 







|
|

|
>




|
|

<
>
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
..
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
..
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
...
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
...
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
...
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
...
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
#
# 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 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
................................................................................
	    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 [email protected]
	    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
................................................................................
	    2b hy 042b hy_AM
	    2c az 042c [email protected] 082c [email protected]
	    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
................................................................................
		 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 --
#
................................................................................
# 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} {
................................................................................
	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 {
................................................................................
	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 -> [email protected], 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
...
386
387
388
389
390
391
392






393
394
395
396
397
398
399
</body></html>"
set tail /a/b/c
set url //[info hostname]:$port/a/b/c
set fullurl http://user:[email protected][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>
................................................................................
} -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 {






>







 







>
>
>
>
>
>







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
...
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
</body></html>"
set tail /a/b/c
set url //[info hostname]:$port/a/b/c
set fullurl http://user:[email protected][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>
................................................................................
} -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
.....
14396
14397
14398
14399
14400
14401
14402

14403

14404
14405
14406
14407
14408
14409
14410
   { (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"
................................................................................
#--------------------------------------------------------------------
#	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






|







 







>
|
>







7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
.....
14396
14397
14398
14399
14400
14401
14402
14403
14404
14405
14406
14407
14408
14409
14410
14411
14412
   { (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"
................................................................................
#--------------------------------------------------------------------
#	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
...
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
	    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);
................................................................................

	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);






|







 







|







729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
...
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
	    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);
................................................................................

	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
....
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
    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))) {
................................................................................
	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));
    }






|



|







 







|




|


|


|





|







963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
....
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
    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))) {
................................................................................
	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
...
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
...
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
...
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
    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;
................................................................................
	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
................................................................................

    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);
................................................................................
	    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.
	 */






|
|
|







 







|



|







 







|


|
<







 







|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
...
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
...
170
171
172
173
174
175
176
177
178
179
180

181
182
183
184
185
186
187
...
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
    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;
................................................................................
	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
................................................................................

    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);
................................................................................
	    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
...
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
	    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);
................................................................................
		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;






|







 







|







891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
...
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
	    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);
................................................................................
		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
....
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
....
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
....
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
....
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
	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,
................................................................................
	     * 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 {
	    /*
................................................................................
		/*
		 * 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) {
................................................................................
	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);
................................................................................
			    }

			    /*
			     * 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;






|







 







|







 







|







 







|







 







|









|
|







992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
....
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
....
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
....
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
....
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
	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,
................................................................................
	     * 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 {
	    /*
................................................................................
		/*
		 * 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) {
................................................................................
	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);
................................................................................
			    }

			    /*
			     * 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
....
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
....
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
....
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
....
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
    /*
     * 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;
		    }
		}
................................................................................
	     * 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 {
................................................................................

    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;
................................................................................
		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;
................................................................................
		    }
		}
		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);
}
 






>







>
|







 







|







 







|

|







|







 







|







 







|









|







672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
....
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
....
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
....
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
....
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
    /*
     * 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;
		    }
		}
................................................................................
	     * 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 {
................................................................................

    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;
................................................................................
		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;
................................................................................
		    }
		}
		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
...
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
....
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
....
1314
1315
1316
1317
1318
1319
1320


1321
1322
1323
1324
1325
1326
1327
1328
1329
1330

1331
1332
1333
1334
1335
1336
1337
    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) {
................................................................................
    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;
................................................................................
    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.
	 */

................................................................................
	 * 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));






|







 







|
<







 







<
|







 







>
>
|


|
<
<
<


<
>







776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
...
885
886
887
888
889
890
891
892

893
894
895
896
897
898
899
....
1187
1188
1189
1190
1191
1192
1193

1194
1195
1196
1197
1198
1199
1200
1201
....
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324



1325
1326

1327
1328
1329
1330
1331
1332
1333
1334
    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) {
................................................................................
    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;
................................................................................
    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.
	 */

................................................................................
	 * 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
....
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
....
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
....
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
....
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
     */

    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;
................................................................................
    /*
     * 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;
}
 
/*
................................................................................
    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;
................................................................................
     * 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;
    }
................................................................................

	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);






|







 







|







 







|







 







|







 







|
|
<
<





|

|
<
<
|
<
>







1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
....
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
....
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
....
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
....
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
     */

    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;
................................................................................
    /*
     * 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;
}
 
/*
................................................................................
    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;
................................................................................
     * 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;
    }
................................................................................

	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);