Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | tip-402 |
Files: | files | file ages | folders |
SHA1: |
777950336d0f45be59bfe03d8c7cd3ea |
User & Date: | jan.nijtmans 2012-07-16 11:24:21.260 |
Context
2012-08-02
| ||
12:54 | merge trunk check-in: 15da7fc903 user: jan.nijtmans tags: tip-402 | |
2012-07-16
| ||
11:24 | merge trunk check-in: 777950336d user: jan.nijtmans tags: tip-402 | |
08:09 | Make registry 1.3 package dynamically loadable when ::tcl::pkgconfig is available check-in: a65bf226ec user: jan.nijtmans tags: trunk | |
2012-06-27
| ||
15:12 | Experimental support for UNC paths (through VFS) on UNIX/Mac check-in: c91c7cef8f user: jan.nijtmans tags: tip-402 | |
Changes
Changes to ChangeLog.
1 2 3 4 5 6 7 8 9 10 11 | 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: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | 2012-07-16 Jan Nijtmans <[email protected]> * library/reg/pkgIndex.tcl: Make registry 1.3 package dynamically loadable in Tcl 8.4.20. 2012-07-11 Jan Nijtmans <[email protected]> * win/tclWinReg.c: [Bug #3362446]: registry keys command fails with 8.5/8.6. Follow Microsofts example better in order to prevent problems when using HKEY_PERFORMANCE_DATA. 2012-07-10 Jan Nijtmans <[email protected]> * unix/tclUnixNotfy.c: [Bug 3541646] Don't panic on triggerPipe overrun 2012-07-10 Donal K. Fellows <[email protected]> * win/tclWinSock.c (InitializeHostName): Corrected logic that extracted the name of the computer from the gethostname call so that it would use the name on success, not failure. Also ensured that the buffer size is exactly that recommended by Microsoft. 2012-07-08 Reinhard Max <[email protected]> * library/http/http.tcl: Add fix and test for URLs that contain * tests/http.test: literal IPv6 addresses. [Bug 3531209] 2012-07-05 Don Porter <[email protected]> * unix/tclUnixPipe.c: [Bug 1189293] Make "<<" binary safe. * win/tclWinPipe.c: 2012-07-03 Donal K. Fellows <[email protected]> * generic/tclUtil.c (TclDStringAppendObj, TclDStringAppendDString): * generic/tclInt.h (TclDStringAppendLiteral, TclDStringClear): * generic/tclCompile.h (TclDStringAppendToken): Added wrappers to make common cases of appending to Tcl_DStrings simpler to write. Prompted by looking at [FRQ 1357401] (these are an _internal_ implementation of that FRQ). 2012-06-29 Jan Nijtmans <[email protected]> * library/msgcat/msgcat.tcl: Add tn, ro_MO and ru_MO to msgcat. 2012-06-29 Harald Oehlmann <[email protected]> * library/msgcat/msgcat.tcl: [Bug 3536888] Locale guessing of msgcat * library/msgcat/pkgIndex.tcl: fails on (some) Windows 7. Bump to 1.4.5 * unix/Makefile.in * win/Makefile.in 2012-06-29 Donal K. Fellows <[email protected]> * doc/GetIndex.3: Reinforced the description of the requirement for the tables of names to index over to be static, following posting to tcl-core by Brian Griffin about a bug caused by Tktreectrl not obeying this rule correctly. This does not represent a functionality change, merely a clearer documentation of a long-standing constraint. 2012-06-26 Jan Nijtmans <[email protected]> * unix/tcl.m4: Let Cygwin shared build link with * unix/configure.in: zlib1.dll, not cygz.dll (two less * unix/configure: dependencies on cygwin-specific dll's) * unix/Makefile.in: 2012-06-26 Reinhard Max <[email protected]> * generic/tclIOSock.c: Use EAI_SYSTEM only if it exists. * unix/tclUnixSock.c: 2012-06-25 Don Porter <[email protected]> * generic/tclFileSystem.h: [Bug 3024359] Make sure that the * generic/tclIOUtil.c: per-thread cache of the list of file systems * generic/tclPathObj.c: currently registered is only updated at times when no active loops are traversing it. Also reduce the amount of epoch storing and checking to where it can make a difference. |
︙ | ︙ | |||
799 800 801 802 803 804 805 | * tools/uniParse.tcl: [Bug 3444754]: string tolower \u01c5 is wrong * generic/tclUniData.c: * tests/utf.test: 2011-11-30 Jan Nijtmans <[email protected]> | | | < | 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 | * tools/uniParse.tcl: [Bug 3444754]: string tolower \u01c5 is wrong * generic/tclUniData.c: * tests/utf.test: 2011-11-30 Jan Nijtmans <[email protected]> * library/tcltest/tcltest.tcl: [Bug 967195]: Make tcltest work when tclsh is compiled without using the setargv() function on mingw. 2011-11-29 Jan Nijtmans <[email protected]> * win/Makefile.in: don't install tommath_(super)?class.h * unix/Makefile.in: don't install directories like 8.2 and 8.3 * generic/tclTomMath.h: [Bug 2991415]: move include tclInt.h from * generic/tclTomMathInt.h: tclTomMath.h to tclTomMathInt.h |
︙ | ︙ |
Changes to changes.
︙ | ︙ | |||
7972 7973 7974 7975 7976 7977 7978 7979 7980 7981 7982 7983 | 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) | > > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 7972 7973 7974 7975 7976 7977 7978 7979 7980 7981 7982 7983 7984 7985 7986 7987 7988 7989 7990 7991 7992 7993 7994 7995 7996 7997 7998 7999 8000 8001 8002 8003 8004 8005 8006 8007 8008 8009 8010 8011 8012 8013 8014 8015 8016 8017 8018 8019 8020 8021 8022 8023 8024 8025 8026 8027 8028 8029 8030 8031 8032 8033 8034 8035 8036 8037 8038 8039 8040 8041 8042 8043 8044 8045 8046 8047 8048 8049 8050 8051 8052 8053 8054 8055 8056 8057 8058 8059 8060 8061 8062 8063 8064 8065 8066 8067 8068 8069 8070 8071 8072 8073 8074 8075 8076 8077 8078 8079 8080 8081 8082 8083 8084 8085 8086 8087 8088 8089 8090 8091 8092 8093 8094 8095 8096 8097 8098 8099 8100 8101 8102 8103 8104 8105 8106 | 2011-08-30 (bug fix)[3398794] panic in interp limit setting (gavlian,fellows) 2011-09-08 (bug fix)[3401704] revised expr parser to permit function names like "nano()" instead of parsing as "nan o()" with missing op (duquette,porter) *** POTENTIAL INCOMPATIBILITY *** 2011-09-10 (bug fix)[3400658] wrong num args msg with TclOO (rsooltan,fellows) 2011-09-13 (bug fix)[3390638] solaris studio cc workaround (kechel,porter) 2011-09-13 (bug fix)[3405652] DTrace workaround (michelson,porter) 2011-09-16 (bug fix)[3391977] -headers overrides -type (ziegenhagen,fellows) => http 2.8.3 2011-09-16 (TIP 388) New \Uhhhhhhhh syntax (nijtmans) 2011-10-06 (enhancement) bytecode compile [dict with] (fellows) 2011-10-11 (bug fix)[2935503] [file stat] returns bad mode (nadkarni,nijtmans) 2011-10-20 (bug fix)[3418547] cmd lits and custom resolvers (soberning,fellows) 2011-10-31 (bug fix)[3414754] EIAS violation in fs paths (porter) 2011-11-22 (bug fix)[2935503] Win: [file mtime] sets wrong time (nijtmans) 2011-11-30 (bug fix)[967195] Simply args passed to child processes (nijtmans) => tcltest 2.3.4 2011-12-07 (bug fix)[3444754] fix [string tolower \u01C5] (nijtmans) 2011-12-11 (update)[3457031] Update [[:print:]] to Unicode 6.0 (nijtmans) 2011-12-24 (bug fix)[3464428] fix [string is graph \u0120] (nijtmans) 2012-01-08 (bug fix)[3470928] zoneinfo trouble with Windhoek data file (kenny) 2012-01-13 (bug fix)[3472316] fix retrieval of socket error (fellows) 2012-01-21 (bug fix)[3475667] [regexp] buffer read overflow (sebres) 2012-01-22 (bug fix)[3475264] [dict exists] return 0, not error (fellows) 2012-01-25 (bug fix)[3474460] [oo::copy] var resolution list (fellows) 2012-01-26 (bug fix)[3475569,3479689] mem corrupt in fs path (sebres,porter) 2012-01-30 (enhancement) improve bytecode compile of [catch] (fellows) 2012-02-02 (bug fix)[2974459,2879351,1951574,1852572,1661378,1613456] Fix problems where [file *able] would return false results on Win/Samba (porter) 2012-02-02 (update)[3464401] Support Unicode 6.1 (nijtmans) 2012-02-06 (bug fix)[3484621] bump bytecode epoch on exec traces (kuhn,sofer) 2012-02-15 (bug fix)[3487626] crash compiling [dict for] (fellows) 2012-02-15 (enhancement) bytecode compile [lrange],[lreplace] (fellows) 2012-02-17 (bug fix)[2233954] compile problem on AIX & Android (nijtmans) 2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans) 2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries) 2012-03-26 (TIP 380) New builtin class [oo::Slot] (fellows) *** POTENTIAL INCOMPATIBILITY *** 2012-03-27 (TIP 397) <cloned> method to extend [oo::copy] (fellows) *** POTENTIAL INCOMPATIBILITY *** 2012-03-27 (TIP 395) New subcommand [string is entier] (fellows) 2012-04-02 (TIP 396) New command [yieldto] (fellows) 2012-04-04 (bug fix)[3514761] crash combining objects and ensembles (fellows) 2012-04-09 (bug fix)[2712377] [info vars] and oo variables (fellows) 2012-04-09 (bug fix)[3396896] no dups in oo var lists (fellows) 2012-04-11 (bug fix)[3448512] [clock scan 1958-01-01] fail on Win (nijtmans) 2012-04-15 (bug fix)[3517696] fix flush of zlib chan xform (fellows) 2012-04-18 tzdata updated to Olson's tzdata2012c (kenny) 2012-04-28 (TIP 398) exit non-blocking chan without flush (ferrieux) *** POTENTIAL INCOMPATIBILITY *** 2012-05-02 (enhancement) Better use of Intel cpuid instruction (nijtmans) 2012-05-03 (bug fix)[3428753] Unbreak synchronous [socket -async] (porter) 2012-05-10 (bug fix)[2812981] force consistent config of Tcl+pkgs (ferrieux) 2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans) 2012-05-17 (bug fix)[3445787] fix [file] ensemble in Safe Base (fellows) 2012-05-17 (bug fix)[2964715] fix [glob] in Safe Base (fellows) 2012-05-17 (bug fix)[3106532] proper [switch -indexvar] values (fellows) *** POTENTIAL INCOMPATIBILITY *** 2012-05-21 (TIP 106) New -binary option to [dde execute|poke] (oehlmann) => dde 1.4.0 2012-05-23 (bug fix)[3525907] [zlib push decompress] & [chan event] (fellows,ferrieux,kupries) 2012-05-28 (bug fix)[3529949] Protect ~ paths in Safe Base (fellows) 2012-06-21 (bug fix)[3362446] [registry keys] failure (nijtmans) => registry 1.3.0 2012-06-25 (bug fix)[3537605] [encoding dirs a b] error message (fellows) 2012-06-25 (bug fix)[3024359] crash when multi-thread concurrent [file system] and Tcl_FSMountsChanged(). (porter) 2012-06-29 (bug fix)[3536888] fix locale guessing (oehlmann,nijtmans) => msgcat 1.4.5 2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter) 2012-07-08 (bug fix)[3531209] accept IPv6 URLs (max) => http 2.8.4 Many revisions to better support a Cygwin environment (nijtmans) --- Released 8.6b3, July 30, 2012 --- See ChangeLog for details --- |
Changes to doc/GetIndex.3.
︙ | ︙ | |||
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | .AP Tcl_Obj *objPtr in/out The string value of this object is used to search through \fItablePtr\fR. The internal representation is modified to hold the index of the matching table entry. .AP "const char *const" *tablePtr in An array of null-terminated strings. The end of the array is marked by a NULL string pointer. .AP "const void" *structTablePtr in An array of arbitrary type, typically some \fBstruct\fR type. The first member of the structure must be a null-terminated string. The size of the structure is given by \fIoffset\fR. .AP int offset in The offset to add to structTablePtr to get to the next entry. The end of the array is marked by a NULL string pointer. .AP "const char" *msg in Null-terminated string describing what is being looked up, such as \fBoption\fR. This string is included in error messages. .AP int flags in OR-ed combination of bits providing additional information for operation. The only bit that is currently defined is \fBTCL_EXACT\fR. .AP int *indexPtr out The index of the string in \fItablePtr\fR that matches the value of \fIobjPtr\fR is returned here. .BE .SH DESCRIPTION .PP | > > > > > > | | | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | .AP Tcl_Obj *objPtr in/out The string value of this object is used to search through \fItablePtr\fR. The internal representation is modified to hold the index of the matching table entry. .AP "const char *const" *tablePtr in An array of null-terminated strings. The end of the array is marked by a NULL string pointer. Note that references to the \fItablePtr\fR may be retained in the internal representation of \fIobjPtr\fR, so this should represent the address of a statically-allocated array. .AP "const void" *structTablePtr in An array of arbitrary type, typically some \fBstruct\fR type. The first member of the structure must be a null-terminated string. The size of the structure is given by \fIoffset\fR. Note that references to the \fIstructTablePtr\fR may be retained in the internal representation of \fIobjPtr\fR, so this should represent the address of a statically-allocated array of structures. .AP int offset in The offset to add to structTablePtr to get to the next entry. The end of the array is marked by a NULL string pointer. .AP "const char" *msg in Null-terminated string describing what is being looked up, such as \fBoption\fR. This string is included in error messages. .AP int flags in OR-ed combination of bits providing additional information for operation. The only bit that is currently defined is \fBTCL_EXACT\fR. .AP int *indexPtr out The index of the string in \fItablePtr\fR that matches the value of \fIobjPtr\fR is returned here. .BE .SH DESCRIPTION .PP These procedures provide an efficient way for looking up keywords, switch names, option names, and similar things where the value of an object must be one of a predefined set of values. \fBTcl_GetIndexFromObj\fR compares \fIobjPtr\fR against each of the strings in \fItablePtr\fR to find a match. A match occurs if \fIobjPtr\fR's string value is identical to one of the strings in \fItablePtr\fR, or if it is a non-empty unique abbreviation for exactly one of the strings in \fItablePtr\fR and the \fBTCL_EXACT\fR flag was not specified; in either case the index of the matching entry is stored at \fI*indexPtr\fR and \fBTCL_OK\fR is returned. |
︙ | ︙ |
Changes to doc/msgcat.n.
︙ | ︙ | |||
9 10 11 12 13 14 15 | .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 | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME msgcat \- Tcl message catalog .SH SYNOPSIS \fBpackage require Tcl 8.5\fR .sp \fBpackage require msgcat 1.4.5\fR .sp \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR? .sp \fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR? .sp \fB::msgcat::mclocale \fR?\fInewLocale\fR? .sp |
︙ | ︙ | |||
171 172 173 174 175 176 177 | 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 | | | > > > > | | < | 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | to extract its parts. The initial locale is then set by calling \fB::msgcat::mclocale\fR with the argument .PP .CS language[_country][_modifier] .CE .PP On Windows and Cygwin, if none of those environment variables is set, msgcat will attempt to extract locale information from the registry. From Windows Vista on, the RFC4747 locale name "lang-script-country-options" is transformed to the locale as "lang_country_script" (Example: sr-Latn-CS -> sr_cs_latin). For Windows XP, the language id is transformed analoguously (Example: 0c1a -> sr_yu_cyrillic). If all these attempts to discover an initial locale from the user's environment fail, msgcat defaults to an initial locale of .QW C . .PP When a locale is specified by the user, a .QW "best match" search is performed during string translation. For example, if a user specifies en_GB_Funky, the locales |
︙ | ︙ |
Changes to generic/tclAssembly.c.
︙ | ︙ | |||
261 262 263 264 265 266 267 | 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*, | | | 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 | static int CheckOneByte(Tcl_Interp*, int); static int CheckSignedOneByte(Tcl_Interp*, int); static int CheckStack(AssemblyEnv*); static int CheckStrictlyPositive(Tcl_Interp*, int); static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*, const TalInstDesc*); static int DefineLabel(AssemblyEnv* envPtr, const char* label); static void DeleteMirrorJumpTable(JumptableInfo* jtPtr); static void DupAssembleCodeInternalRep(Tcl_Obj* src, Tcl_Obj* dest); static void FillInJumpOffsets(AssemblyEnv*); static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, Tcl_Obj* jumpTable); |
︙ | ︙ | |||
346 347 348 349 350 351 352 | #define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ /* * Source instructions recognized in the Tcl Assembly Language (TAL) */ | | | 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 | #define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ /* * Source instructions recognized in the Tcl Assembly Language (TAL) */ static const TalInstDesc TalInstructionTable[] = { /* PUSH must be first, see the code near the end of TclAssembleCode */ {"push", ASSEM_PUSH, (INST_PUSH1<<8 | INST_PUSH4), 0, 1}, {"add", ASSEM_1BYTE, INST_ADD, 2, 1}, {"append", ASSEM_LVT, (INST_APPEND_SCALAR1<<8 | INST_APPEND_SCALAR4),1, 1}, |
︙ | ︙ | |||
1764 1765 1766 1767 1768 1769 1770 | *----------------------------------------------------------------------------- */ static void CompileEmbeddedScript( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token* tokenPtr, /* Tcl_Token containing the script */ | | | 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 | *----------------------------------------------------------------------------- */ static void CompileEmbeddedScript( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token* tokenPtr, /* Tcl_Token containing the script */ const TalInstDesc* instPtr) /* Instruction that determines whether * the script is 'expr' or 'eval' */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
130 131 132 133 134 135 136 137 138 139 140 141 142 143 | static Tcl_Obj * GetCommandSource(Interp *iPtr, int objc, Tcl_Obj *const objv[], int lookup); static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineActivateCallback; static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static Tcl_NRPostProc NRRunObjProc; static Tcl_NRPostProc NRTailcallEval; static Tcl_ObjCmdProc OldMathFuncProc; static void OldMathFuncDeleteProc(ClientData clientData); static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); | > > | 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | static Tcl_Obj * GetCommandSource(Interp *iPtr, int objc, Tcl_Obj *const objv[], int lookup); static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineActivateCallback; static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); static Tcl_NRPostProc NRRunObjProc; static Tcl_NRPostProc NRTailcallEval; static Tcl_ObjCmdProc OldMathFuncProc; static void OldMathFuncDeleteProc(ClientData clientData); static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); |
︙ | ︙ | |||
2606 2607 2608 2609 2610 2611 2612 | * 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) { | | | 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 | * function to get the namespace from which the old command is being * renamed! */ Tcl_DStringInit(&newFullName); Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1); if (newNsPtr != iPtr->globalNsPtr) { TclDStringAppendLiteral(&newFullName, "::"); } Tcl_DStringAppend(&newFullName, newTail, -1); cmdPtr->refCount++; CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName), Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME); Tcl_DStringFree(&newFullName); |
︙ | ︙ | |||
3464 3465 3466 3467 3468 3469 3470 | 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); | | | 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 | data->proc = proc; data->numArgs = numArgs; data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType)); memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType)); data->clientData = clientData; Tcl_DStringInit(&bigName); TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::"); Tcl_DStringAppend(&bigName, name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName), OldMathFuncProc, data, OldMathFuncDeleteProc); Tcl_DStringFree(&bigName); } |
︙ | ︙ | |||
4359 4360 4361 4362 4363 4364 4365 | TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); TCLNR_FREE(interp, callbackPtr); } return result; } | | | 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 | TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); TCLNR_FREE(interp, callbackPtr); } return result; } static int NRCommand( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = data[0]; |
︙ | ︙ | |||
8589 8590 8591 8592 8593 8594 8595 | 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); | | | 8591 8592 8593 8594 8595 8596 8597 8598 8599 8600 8601 8602 8603 8604 8605 | NRE_ASSERT(COR_IS_SUSPENDED(corPtr)); NRE_ASSERT(corPtr->eePtr != NULL); NRE_ASSERT(corPtr->eePtr != iPtr->execEnvPtr); corPtr->eePtr->rewind = 1; TclNRAddCallback(interp, RewindCoroutineCallback, state, NULL, NULL, NULL); return TclNRInterpCoroutine(corPtr, interp, 0, NULL); } static void DeleteCoroutine( ClientData clientData) { CoroutineData *corPtr = clientData; |
︙ | ︙ | |||
8816 8817 8818 8819 8820 8821 8822 | if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?"); return TCL_ERROR; } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); | | | 8818 8819 8820 8821 8822 8823 8824 8825 8826 8827 8828 8829 8830 8831 8832 | if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?"); return TCL_ERROR; } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_AppendResult(interp, "can only inject a command into a coroutine", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objv[1]), NULL); return TCL_ERROR; } |
︙ | ︙ | |||
8845 8846 8847 8848 8849 8850 8851 | TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; } int | | | 8847 8848 8849 8850 8851 8852 8853 8854 8855 8856 8857 8858 8859 8860 8861 | TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; } int TclNRInterpCoroutine( ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { CoroutineData *corPtr = clientData; |
︙ | ︙ | |||
8967 8968 8969 8970 8971 8972 8973 | */ corPtr = ckalloc(sizeof(CoroutineData)); Tcl_DStringInit(&ds); if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, nsPtr->fullName, -1); | | | | 8969 8970 8971 8972 8973 8974 8975 8976 8977 8978 8979 8980 8981 8982 8983 8984 8985 8986 8987 8988 | */ corPtr = ckalloc(sizeof(CoroutineData)); Tcl_DStringInit(&ds); if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, nsPtr->fullName, -1); TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, procName, -1); cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); Tcl_DStringFree(&ds); corPtr->cmdPtr = cmdPtr; cmdPtr->refCount++; /* * #280. |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
︙ | ︙ | |||
1041 1042 1043 1044 1045 1046 1047 | {"writable", 1}, {NULL, 0} }; int i; Tcl_DString oldBuf, newBuf; Tcl_DStringInit(&oldBuf); | | | | 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 | /* * Check we've got a pair of variables and that they are local variables. * Then extract their indices in the LVT. */ Tcl_DStringInit(&buffer); | | | 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 | /* * Check we've got a pair of variables and that they are local variables. * Then extract their indices in the LVT. */ Tcl_DStringInit(&buffer); TclDStringAppendToken(&buffer, &varsTokenPtr[1]); if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars, &argv) != TCL_OK) { Tcl_DStringFree(&buffer); return TCL_ERROR; } Tcl_DStringFree(&buffer); if (numVars != 2) { |
︙ | ︙ | |||
1957 1958 1959 1960 1961 1962 1963 | /* * Lots of copying going on here. Need a ListObj wizard to show a * better way. */ Tcl_DStringInit(&varList); | | | 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 | /* * Lots of copying going on here. Need a ListObj wizard to show a * better way. */ Tcl_DStringInit(&varList); TclDStringAppendToken(&varList, &tokenPtr[1]); code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), &varcList[loopIndex], &varvList[loopIndex]); Tcl_DStringFree(&varList); if (code != TCL_OK) { code = TCL_ERROR; goto done; } |
︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
︙ | ︙ | |||
1554 1555 1556 1557 1558 1559 1560 | * 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); | | < | 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 | switch (nodePtr->lexeme) { case FUNCTION: { Tcl_DString cmdName; const char *p; int length; Tcl_DStringInit(&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 | /* * 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. */ | | | | 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 | /* * We copy the string before trying to find the command by * name. We used to modify the string in place, but this * is not safe because the name resolution handlers could * have side effects that rely on the unmodified string. */ TclDStringClear(&ds); TclDStringAppendToken(&ds, &tokenPtr[1]); cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds), (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0); if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL) |
︙ | ︙ | |||
2040 2041 2042 2043 2044 2045 2046 | } Tcl_DStringInit(&textBuffer); numObjsToConcat = 0; for ( ; count > 0; count--, tokenPtr++) { switch (tokenPtr->type) { case TCL_TOKEN_TEXT: | | | 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 | } Tcl_DStringInit(&textBuffer); numObjsToConcat = 0; for ( ; count > 0; count--, tokenPtr++) { switch (tokenPtr->type) { case TCL_TOKEN_TEXT: TclDStringAppendToken(&textBuffer, tokenPtr); TclAdvanceLines(&envPtr->line, tokenPtr->start, tokenPtr->start + tokenPtr->size); break; case TCL_TOKEN_BS: length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, buffer); |
︙ | ︙ | |||
2087 2088 2089 2090 2091 2092 2093 | case TCL_TOKEN_COMMAND: /* * Push any accumulated chars appearing before the command. */ if (Tcl_DStringLength(&textBuffer) > 0) { | | < < | 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 | case TCL_TOKEN_COMMAND: /* * Push any accumulated chars appearing before the command. */ if (Tcl_DStringLength(&textBuffer) > 0) { int literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; Tcl_DStringFree(&textBuffer); if (numCL) { TclContinuationsEnter( |
︙ | ︙ | |||
2116 2117 2118 2119 2120 2121 2122 | /* * Push any accumulated chars appearing before the $<var>. */ if (Tcl_DStringLength(&textBuffer) > 0) { int literal; | | < < | 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 | /* * Push any accumulated chars appearing before the $<var>. */ if (Tcl_DStringLength(&textBuffer) > 0) { int literal; literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; Tcl_DStringFree(&textBuffer); } TclCompileVarSubst(interp, tokenPtr, envPtr); numObjsToConcat++; |
︙ | ︙ | |||
2141 2142 2143 2144 2145 2146 2147 | } /* * Push any accumulated characters appearing at the end. */ if (Tcl_DStringLength(&textBuffer) > 0) { | | < < < | 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 | } /* * Push any accumulated characters appearing at the end. */ if (Tcl_DStringLength(&textBuffer) > 0) { int literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; if (numCL) { TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr, numCL, clPosition); } numCL = 0; } |
︙ | ︙ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
862 863 864 865 866 867 868 | /* *---------------------------------------------------------------- * Procedures exported by tclBasic.c to be used within the engine. *---------------------------------------------------------------- */ | < | | 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 | /* *---------------------------------------------------------------- * Procedures exported by tclBasic.c to be used within the engine. *---------------------------------------------------------------- */ MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine; /* *---------------------------------------------------------------- * Procedures exported by the engine to be used by tclBasic.c *---------------------------------------------------------------- */ |
︙ | ︙ | |||
1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 | /* * Check if there is an LVT for compiled locals */ #define EnvHasLVT(envPtr) \ (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr) /* * DTrace probe macros (NOPs if DTrace support is not enabled). */ /* * Define the following macros to enable debug logging of the DTrace proc, * cmd, and inst probes. Note that this does _not_ require a platform with | > > > > > > > > > > | 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 | /* * Check if there is an LVT for compiled locals */ #define EnvHasLVT(envPtr) \ (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr) /* * Macros for making it easier to deal with tokens and DStrings. */ #define TclDStringAppendToken(dsPtr, tokenPtr) \ Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size) #define TclRegisterDStringLiteral(envPtr, dsPtr) \ TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \ Tcl_DStringLength(dsPtr), /*flags*/ 0) /* * DTrace probe macros (NOPs if DTrace support is not enabled). */ /* * Define the following macros to enable debug logging of the DTrace proc, * cmd, and inst probes. Note that this does _not_ require a platform with |
︙ | ︙ |
Changes to generic/tclConfig.c.
︙ | ︙ | |||
151 152 153 154 155 156 157 | /* * Now create the interface command for retrieval of the package * information. */ Tcl_DStringInit(&cmdName); | | | | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | /* * Now create the interface command for retrieval of the package * information. */ Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "::"); Tcl_DStringAppend(&cmdName, pkgName, -1); /* * The incomplete command name is the name of the namespace to place it * in. */ if (Tcl_FindNamespace(interp, Tcl_DStringValue(&cmdName), NULL, TCL_GLOBAL_ONLY) == NULL) { if (Tcl_CreateNamespace(interp, Tcl_DStringValue(&cmdName), NULL, NULL) == NULL) { Tcl_Panic("%s.\n%s: %s", Tcl_GetStringResult(interp), "Tcl_RegisterConfig", "Unable to create namespace for package configuration."); } } TclDStringAppendLiteral(&cmdName, "::pkgconfig"); if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName), QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) { Tcl_Panic("%s: %s", "Tcl_RegisterConfig", "Unable to create query command for package configuration"); } |
︙ | ︙ |
Changes to generic/tclEncoding.c.
︙ | ︙ | |||
1868 1869 1870 1871 1872 1873 1874 | goto doneParse; } /* * Read lines from the encoding until EOF. */ | | | | 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 | /* * Construct the path for the ensemble namespace and create it. */ Tcl_DStringInit(&buf); Tcl_DStringInit(&hiddenBuf); | | | | | | 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 | /* * Construct the path for the ensemble namespace and create it. */ Tcl_DStringInit(&buf); Tcl_DStringInit(&hiddenBuf); TclDStringAppendLiteral(&hiddenBuf, "tcl:"); Tcl_DStringAppend(&hiddenBuf, name, -1); TclDStringAppendLiteral(&hiddenBuf, ":"); hiddenLen = Tcl_DStringLength(&hiddenBuf); if (name[0] == ':' && name[1] == ':') { /* * An absolute name, so use it directly. */ cmdName = name; Tcl_DStringAppend(&buf, name, -1); ensembleFlags = TCL_ENSEMBLE_PREFIX; } else { /* * Not an absolute name, so do munging of it. Note that this treats a * multi-word list differently to a single word. */ TclDStringAppendLiteral(&buf, "::tcl"); if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) { Tcl_Panic("invalid ensemble name '%s'", name); } for (i = 0; i < nameCount; ++i) { TclDStringAppendLiteral(&buf, "::"); Tcl_DStringAppend(&buf, nameParts[i], -1); } } ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL, TCL_CREATE_NS_IF_UNKNOWN); if (!ns) { |
︙ | ︙ | |||
1481 1482 1483 1484 1485 1486 1487 | * Create the ensemble mapping dictionary and the ensemble command procs. */ if (ensemble != NULL) { Tcl_Obj *mapDict, *fromObj, *toObj; Command *cmdPtr; | | | 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 | * Create the ensemble mapping dictionary and the ensemble command procs. */ if (ensemble != NULL) { Tcl_Obj *mapDict, *fromObj, *toObj; Command *cmdPtr; TclDStringAppendLiteral(&buf, "::"); TclNewObj(mapDict); for (i=0 ; map[i].name != NULL ; i++) { fromObj = Tcl_NewStringObj(map[i].name, -1); TclNewStringObj(toObj, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); Tcl_AppendToObj(toObj, map[i].name, -1); Tcl_DictObjPut(NULL, mapDict, fromObj, toObj); |
︙ | ︙ | |||
1611 1612 1613 1614 1615 1616 1617 | 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++) { | | | | | 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 | if (ensemblePtr->parameterList == NULL) { len = 0; } else if (TclListObjGetElements(NULL, ensemblePtr->parameterList, &len, &elemPtrs) != TCL_OK) { Tcl_Panic("List of ensemble parameters is not a list"); } for (; len>0; len--,elemPtrs++) { TclDStringAppendObj(&buf, *elemPtrs); TclDStringAppendLiteral(&buf, " "); } TclDStringAppendLiteral(&buf, "subcommand ?arg ...?"); Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf)); Tcl_DStringFree(&buf); return TCL_ERROR; } if (ensemblePtr->nsPtr->flags & NS_DYING) { |
︙ | ︙ |
Changes to generic/tclFileName.c.
︙ | ︙ | |||
68 69 70 71 72 73 74 | SetResultLength( Tcl_DString *resultPtr, int offset, int extended) { Tcl_DStringSetLength(resultPtr, offset); if (extended == 2) { | | | | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | SetResultLength( Tcl_DString *resultPtr, int offset, int extended) { Tcl_DStringSetLength(resultPtr, offset); if (extended == 2) { TclDStringAppendLiteral(resultPtr, "//?/UNC/"); } else if (extended == 1) { TclDStringAppendLiteral(resultPtr, "//?/"); } } /* *---------------------------------------------------------------------- * * ExtractWinRoot -- |
︙ | ︙ | |||
127 128 129 130 131 132 133 | const char *host, *share, *tail; int hlen, slen; if (path[1] != '/' && path[1] != '\\') { SetResultLength(resultPtr, offset, extended); *typePtr = TCL_PATH_VOLUME_RELATIVE; | | | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | const char *host, *share, *tail; int hlen, slen; if (path[1] != '/' && path[1] != '\\') { SetResultLength(resultPtr, offset, extended); *typePtr = TCL_PATH_VOLUME_RELATIVE; TclDStringAppendLiteral(resultPtr, "/"); return &path[1]; } host = &path[2]; /* * Skip separators. */ |
︙ | ︙ | |||
157 158 159 160 161 162 163 | * 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; | | | | | 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | * page). If there are more than one, we are simply assuming they * are superfluous and we trim them away. (An alternative * interpretation would be that it is a host name, but we have * been documented that that is not the case). */ *typePtr = TCL_PATH_VOLUME_RELATIVE; TclDStringAppendLiteral(resultPtr, "/"); return &path[2]; } SetResultLength(resultPtr, offset, extended); share = &host[hlen]; /* * Skip separators. */ while (share[0] == '/' || share[0] == '\\') { share++; } for (slen=0; share[slen]; slen++) { if (share[slen] == '/' || share[slen] == '\\') { break; } } TclDStringAppendLiteral(resultPtr, "//"); Tcl_DStringAppend(resultPtr, host, hlen); TclDStringAppendLiteral(resultPtr, "/"); Tcl_DStringAppend(resultPtr, share, slen); tail = &share[slen]; /* * Skip separators. */ |
︙ | ︙ | |||
217 218 219 220 221 222 223 | while (*tail && (tail[0] == '/' || tail[0] == '\\')) { tail++; } *typePtr = TCL_PATH_ABSOLUTE; Tcl_DStringAppend(resultPtr, path, 2); | | | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 | while (*tail && (tail[0] == '/' || tail[0] == '\\')) { tail++; } *typePtr = TCL_PATH_ABSOLUTE; Tcl_DStringAppend(resultPtr, path, 2); TclDStringAppendLiteral(resultPtr, "/"); return tail; } } else { int abs = 0; /* |
︙ | ︙ | |||
1049 1050 1051 1052 1053 1054 1055 | transPtr = Tcl_FSGetTranslatedPath(interp, path); if (transPtr == NULL) { Tcl_DecrRefCount(path); return NULL; } Tcl_DStringInit(bufferPtr); | | | 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 | transPtr = Tcl_FSGetTranslatedPath(interp, path); if (transPtr == NULL) { Tcl_DecrRefCount(path); return NULL; } Tcl_DStringInit(bufferPtr); TclDStringAppendObj(bufferPtr, transPtr); Tcl_DecrRefCount(path); Tcl_DecrRefCount(transPtr); /* * Convert forward slashes to backslashes in Windows paths because some * system interfaces don't accept forward slashes. */ |
︙ | ︙ | |||
1405 1406 1407 1408 1409 1410 1411 | * Need to quote 'prefix'. */ Tcl_DStringInit(&prefix); search = Tcl_DStringValue(&pref); while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) { Tcl_DStringAppend(&prefix, search, find-search); | | | 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 | * Need to quote 'prefix'. */ Tcl_DStringInit(&prefix); search = Tcl_DStringValue(&pref); while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) { Tcl_DStringAppend(&prefix, search, find-search); TclDStringAppendLiteral(&prefix, "\\"); Tcl_DStringAppend(&prefix, find, 1); search = find+1; if (*search == '\0') { break; } } if (*search != '\0') { |
︙ | ︙ | |||
1567 1568 1569 1570 1571 1572 1573 | result = TCL_OK; if (join) { if (dir != PATH_GENERAL) { Tcl_DStringInit(&prefix); } for (i = 0; i < objc; i++) { | < | | < < | | 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 | result = TCL_OK; if (join) { if (dir != PATH_GENERAL) { Tcl_DStringInit(&prefix); } for (i = 0; i < objc; i++) { TclDStringAppendObj(&prefix, objv[i]); if (i != objc -1) { Tcl_DStringAppend(&prefix, separators, 1); } } if (TclGlob(interp, Tcl_DStringValue(&prefix), pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; goto endOfGlob; } } else if (dir == PATH_GENERAL) { Tcl_DString str; for (i = 0; i < objc; i++) { Tcl_DStringInit(&str); if (dir == PATH_GENERAL) { TclDStringAppendDString(&str, &prefix); } TclDStringAppendObj(&str, objv[i]); if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; Tcl_DStringFree(&str); goto endOfGlob; } } |
︙ | ︙ | |||
2393 2394 2395 2396 2397 2398 2399 | } switch (tclPlatform) { case TCL_PLATFORM_WINDOWS: if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) || (*name == '/')) { | | | | | | 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 | } switch (tclPlatform) { case TCL_PLATFORM_WINDOWS: if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) || (*name == '/')) { TclDStringAppendLiteral(&append, "/"); } else { TclDStringAppendLiteral(&append, "."); } } break; case TCL_PLATFORM_UNIX: if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if ((*name == '\\' && name[1] == '/') || (*name == '/')) { TclDStringAppendLiteral(&append, "/"); } else { TclDStringAppendLiteral(&append, "."); } } break; } /* * Common for all platforms. |
︙ | ︙ |
Changes to generic/tclFileSystem.h.
︙ | ︙ | |||
11 12 13 14 15 16 17 | */ #ifndef _TCLFILESYSTEM #define _TCLFILESYSTEM #include "tcl.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 | */ #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 | 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; | | < < | | 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 | Tcl_Channel chan, /* Channel from which to read. */ Tcl_DString *lineRead) /* The line read will be appended to this * DString as UTF-8 characters. The caller * must have initialized it and is responsible * for managing the storage. */ { Tcl_Obj *objPtr; int charsStored; TclNewObj(objPtr); charsStored = Tcl_GetsObj(chan, objPtr); if (charsStored > 0) { TclDStringAppendObj(lineRead, objPtr); } TclDecrRefCount(objPtr); return charsStored; } /* *--------------------------------------------------------------------------- |
︙ | ︙ | |||
7546 7547 7548 7549 7550 7551 7552 | const char **argv; int argc, i; Tcl_DString ds; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, genericopt, -1); if (optionList && (*optionList)) { | | | 7544 7545 7546 7547 7548 7549 7550 7551 7552 7553 7554 7555 7556 7557 7558 | const char **argv; int argc, i; Tcl_DString ds; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, genericopt, -1); if (optionList && (*optionList)) { TclDStringAppendLiteral(&ds, " "); Tcl_DStringAppend(&ds, optionList, -1); } if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), &argc, &argv) != TCL_OK) { Tcl_Panic("malformed option list in channel driver"); } Tcl_ResetResult(interp); |
︙ | ︙ |
Changes to generic/tclIORChan.c.
︙ | ︙ | |||
1943 1944 1945 1946 1947 1948 1949 | /* * The result has to go into the 'dsPtr' for propagation to the caller of * the driver. */ if (optionObj != NULL) { | | | 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 | /* * The result has to go into the 'dsPtr' for propagation to the caller of * the driver. */ if (optionObj != NULL) { TclDStringAppendObj(dsPtr, resObj); goto ok; } /* * Extract the list and append each item as element. */ |
︙ | ︙ | |||
1978 1979 1980 1981 1982 1983 1984 | (listc == 1 ? "" : "s"))); goto error; } else { int len; const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { | | | 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 | (listc == 1 ? "" : "s"))); goto error; } else { int len; const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); } goto ok; } ok: result = TCL_OK; |
︙ | ︙ | |||
3203 3204 3205 3206 3207 3208 3209 | 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 { | | < | 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 | Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1); Tcl_IncrRefCount(optionObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { TclDStringAppendObj(paramPtr->getOpt.value, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); break; } case ForwardedGetOptAll: |
︙ | ︙ | |||
3229 3230 3231 3232 3233 3234 3235 | * NOTE (4) as well. */ int listc; Tcl_Obj **listv; if (Tcl_ListObjGetElements(interp, resObj, &listc, | | | | 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 | * NOTE (4) as well. */ int listc; Tcl_Obj **listv; if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); } else if ((listc % 2) == 1) { /* * Odd number of elements is wrong. [x]. */ char *buf = ckalloc(200); sprintf(buf, "{Expected list with even number of elements, got %d %s instead}", listc, (listc == 1 ? "element" : "elements")); ForwardSetDynamicError(paramPtr, buf); } else { int len; const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } } Tcl_Release(rcPtr); break; |
︙ | ︙ |
Changes to generic/tclIOUtil.c.
︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 | #endif #include "tclInt.h" #ifdef __WIN32__ # include "tclWinInt.h" #endif #include "tclFileSystem.h" /* * Prototypes for functions defined later in this file. */ static int EvalFileCallback(ClientData data[], Tcl_Interp *interp, int result); static FilesystemRecord*FsGetFirstFilesystem(void); | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | #endif #include "tclInt.h" #ifdef __WIN32__ # include "tclWinInt.h" #endif #include "tclFileSystem.h" /* * struct FilesystemRecord -- * * A filesystem record is used to keep track of each filesystem currently * registered with the core, in a linked list. */ typedef struct FilesystemRecord { ClientData clientData; /* Client specific data for the new filesystem * (can be NULL) */ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ struct FilesystemRecord *nextPtr; /* The next filesystem registered to Tcl, or * NULL if no more. */ struct FilesystemRecord *prevPtr; /* The previous filesystem registered to Tcl, * or NULL if no more. */ } FilesystemRecord; /* * This structure holds per-thread private copy of the current directory * maintained by the global cwdPathPtr. This structure holds per-thread * private copies of some global data. This way we avoid most of the * synchronization calls which boosts performance, at cost of having to update * this information each time the corresponding epoch counter changes. */ typedef struct ThreadSpecificData { int initialized; int cwdPathEpoch; int filesystemEpoch; Tcl_Obj *cwdPathPtr; ClientData cwdClientData; FilesystemRecord *filesystemList; int claims; } ThreadSpecificData; /* * Prototypes for functions defined later in this file. */ static int EvalFileCallback(ClientData data[], Tcl_Interp *interp, int result); static FilesystemRecord*FsGetFirstFilesystem(void); |
︙ | ︙ | |||
191 192 193 194 195 196 197 | */ static Tcl_Obj *cwdPathPtr = NULL; static int cwdPathEpoch = 0; static ClientData cwdClientData = NULL; TCL_DECLARE_MUTEX(cwdMutex) | | | 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 | */ static Tcl_Obj *cwdPathPtr = NULL; static int cwdPathEpoch = 0; static ClientData cwdClientData = NULL; TCL_DECLARE_MUTEX(cwdMutex) static Tcl_ThreadDataKey fsDataKey; /* * One of these structures is used each time we successfully load a file from * a file system by way of making a temporary copy of the file on the native * filesystem. We need to store both the actual unloadProc/clientData * combination which was used, and the original and modified filenames, so * that we can correctly undo the entire operation when we want to unload the |
︙ | ︙ | |||
364 365 366 367 368 369 370 | { Tcl_Obj *cwd = Tcl_FSGetCwd(interp); if (cwd == NULL) { return NULL; } Tcl_DStringInit(cwdPtr); | | | 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 | { Tcl_Obj *cwd = Tcl_FSGetCwd(interp); if (cwd == NULL) { return NULL; } Tcl_DStringInit(cwdPtr); TclDStringAppendObj(cwdPtr, cwd); Tcl_DecrRefCount(cwd); return Tcl_DStringValue(cwdPtr); } /* Obsolete */ int Tcl_EvalFile( |
︙ | ︙ | |||
425 426 427 428 429 430 431 | } tsdPtr->initialized = 0; } int TclFSCwdIsNative(void) { | | | 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 | } tsdPtr->initialized = 0; } int TclFSCwdIsNative(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (tsdPtr->cwdClientData != NULL) { return 1; } else { return 0; } } |
︙ | ︙ | |||
459 460 461 462 463 464 465 | *---------------------------------------------------------------------- */ int TclFSCwdPointerEquals( Tcl_Obj **pathPtrPtr) { | | | 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 | *---------------------------------------------------------------------- */ int TclFSCwdPointerEquals( Tcl_Obj **pathPtrPtr) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); Tcl_MutexLock(&cwdMutex); if (tsdPtr->cwdPathPtr == NULL || tsdPtr->cwdPathEpoch != cwdPathEpoch) { if (tsdPtr->cwdPathPtr != NULL) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); } |
︙ | ︙ | |||
521 522 523 524 525 526 527 | } } } static void FsRecacheFilesystemList(void) { | | | 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 | } } } static void FsRecacheFilesystemList(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list; /* * Trash the current cache. */ fsRecPtr = tsdPtr->filesystemList; |
︙ | ︙ | |||
585 586 587 588 589 590 591 | tsdPtr->initialized = 1; } } static FilesystemRecord * FsGetFirstFilesystem(void) { | | | 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 | tsdPtr->initialized = 1; } } static FilesystemRecord * FsGetFirstFilesystem(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0) && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) { FsRecacheFilesystemList(); } return tsdPtr->filesystemList; } |
︙ | ︙ | |||
608 609 610 611 612 613 614 | { return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch); } static void Claim() { | | | > > > > > > > > | | 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 | { return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch); } static void Claim() { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); tsdPtr->claims++; } static void Disclaim() { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); tsdPtr->claims--; } int TclFSEpoch() { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); return tsdPtr->filesystemEpoch; } /* * If non-NULL, clientData is owned by us and must be freed later. */ static void FsUpdateCwd( Tcl_Obj *cwdObj, ClientData clientData) { int len; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (cwdObj != NULL) { str = Tcl_GetStringFromObj(cwdObj, &len); } Tcl_MutexLock(&cwdMutex); if (cwdPathPtr != NULL) { |
︙ | ︙ | |||
2573 2574 2575 2576 2577 2578 2579 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSGetCwd( Tcl_Interp *interp) { | | | 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_FSGetCwd( Tcl_Interp *interp) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (TclFSCwdPointerEquals(NULL)) { FilesystemRecord *fsRecPtr; Tcl_Obj *retVal = NULL; /* * We've never been called before, try to find a cwd. Call each of the |
︙ | ︙ | |||
2924 2925 2926 2927 2928 2929 2930 | * 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. */ | | | 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 | * again here. On Unix it might actually be true that we always * have the correct form in the native rep in which case we could * simply use: * cd = Tcl_FSGetNativePath(pathPtr); * instead. This should be examined by someone on Unix. */ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); ClientData cd; ClientData oldcd = tsdPtr->cwdClientData; /* * Assumption we are using a filesystem version 2. */ |
︙ | ︙ |
Changes to generic/tclIndexObj.c.
︙ | ︙ | |||
298 299 300 301 302 303 304 305 306 307 308 309 310 311 | * - Several abbreviations (never allowed, but overridden by exact match) */ for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL; entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { index = idx; goto done; } } if (*p1 == '\0') { /* * The value is an abbreviation for this entry. Continue checking | > > > > | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 | * - Several abbreviations (never allowed, but overridden by exact match) */ for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL; entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { if (p1 == key) { /* empty keys never match */ continue; } index = idx; goto done; } } if (*p1 == '\0') { /* * The value is an abbreviation for this entry. Continue checking |
︙ | ︙ | |||
352 353 354 355 356 357 358 | error: if (interp != NULL) { /* * Produce a fancy error message. */ | | > > > > | < < | | > | > > | 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 | error: if (interp != NULL) { /* * Produce a fancy error message. */ int count = 0; TclNewObj(resultPtr); entryPtr = tablePtr; while ((*entryPtr != NULL) && !**entryPtr) { entryPtr = NEXT_ENTRY(entryPtr, offset); } Tcl_AppendStringsToObj(resultPtr, (numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "), msg, " \"", key, NULL); if (*entryPtr == NULL) { Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL); } else { Tcl_AppendStringsToObj(resultPtr, "\": must be ", *entryPtr, NULL); entryPtr = NEXT_ENTRY(entryPtr, offset); while (*entryPtr != NULL) { if (*NEXT_ENTRY(entryPtr, offset) == NULL) { Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""), " or ", *entryPtr, NULL); } else if (**entryPtr) { Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL); count++; } entryPtr = NEXT_ENTRY(entryPtr, offset); } } Tcl_SetObjResult(interp, resultPtr); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL); } return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclInt.decls.
︙ | ︙ | |||
1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 | # Signature changed in 8.1: # declare 16 win { # TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr) # } # declare 17 win { # char *TclpGetTZName(void) # } declare 18 win { TclFile TclpMakeFile(Tcl_Channel channel, int direction) } declare 19 win { TclFile TclpOpenFile(const char *fname, int mode) } declare 20 win { | > > > > > | 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 | # Signature changed in 8.1: # declare 16 win { # TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr) # } # declare 17 win { # char *TclpGetTZName(void) # } # new for 8.5.12+ Cygwin only declare 17 win { int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts) } declare 18 win { TclFile TclpMakeFile(Tcl_Channel channel, int direction) } declare 19 win { TclFile TclpOpenFile(const char *fname, int mode) } declare 20 win { |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 | MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd; MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); MODULE_SCOPE void TclFinalizeEncodingSubsystem(void); MODULE_SCOPE void TclFinalizeEnvironment(void); MODULE_SCOPE void TclFinalizeEvaluation(void); | > > > > | 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 | MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd; MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); MODULE_SCOPE void TclFinalizeEncodingSubsystem(void); MODULE_SCOPE void TclFinalizeEnvironment(void); MODULE_SCOPE void TclFinalizeEvaluation(void); |
︙ | ︙ | |||
4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 | /* * The sLiteral argument *must* be a string literal; the incantation with * sizeof(sLiteral "") will fail to compile otherwise. */ #define TclNewLiteralStringObj(objPtr, sLiteral) \ TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) /* *---------------------------------------------------------------- * Macros used by the Tcl core to test for some special double values. * The ANSI C "prototypes" for these macros are: * * MODULE_SCOPE int TclIsInfinite(double d); * MODULE_SCOPE int TclIsNaN(double d); | > > > > > > > > > > > > > > > | 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 | /* * The sLiteral argument *must* be a string literal; the incantation with * sizeof(sLiteral "") will fail to compile otherwise. */ #define TclNewLiteralStringObj(objPtr, sLiteral) \ TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) /* *---------------------------------------------------------------- * Convenience macros for DStrings. * The ANSI C "prototypes" for these macros are: * * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr, * const char *sLiteral); * MODULE_SCOPE void TclDStringClear(Tcl_DString *dsPtr); */ #define TclDStringAppendLiteral(dsPtr, sLiteral) \ Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) #define TclDStringClear(dsPtr) \ Tcl_DStringSetLength((dsPtr), 0) /* *---------------------------------------------------------------- * Macros used by the Tcl core to test for some special double values. * The ANSI C "prototypes" for these macros are: * * MODULE_SCOPE int TclIsInfinite(double d); * MODULE_SCOPE int TclIsNaN(double d); |
︙ | ︙ |
Changes to generic/tclIntPlatDecls.h.
︙ | ︙ | |||
136 137 138 139 140 141 142 | /* 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); | | > > > | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 | /* 15 */ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 16 */ EXTERN int TclpIsAtty(int fd); /* 17 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 18 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 19 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 20 */ EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id); /* 21 */ |
︙ | ︙ | |||
285 286 287 288 289 290 291 | 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 */ | | | 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 | Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile) (TclFile file); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */ int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */ int (*tclpIsAtty) (int fd); /* 16 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */ void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */ char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ |
︙ | ︙ | |||
429 430 431 432 433 434 435 | (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ #define TclpIsAtty \ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ | | > | 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 | (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */ #define TclpCreatePipe \ (tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ #define TclpIsAtty \ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 18 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ #define TclpInetNtoa \ |
︙ | ︙ |
Changes to generic/tclLoad.c.
︙ | ︙ | |||
194 195 196 197 198 199 200 | Tcl_MutexLock(&packageMutex); defaultPtr = NULL; for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { if (packageName == NULL) { namesMatch = 0; } else { | | | | | 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 | Tcl_MutexLock(&packageMutex); defaultPtr = NULL; for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { if (packageName == NULL) { namesMatch = 0; } else { TclDStringClear(&pkgName); Tcl_DStringAppend(&pkgName, packageName, -1); TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); Tcl_UtfToLower(Tcl_DStringValue(&tmp)); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&pkgName)) == 0) { namesMatch = 1; } else { namesMatch = 0; } } TclDStringClear(&pkgName); filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (packageName == NULL))) { break; } if (namesMatch && (fullFileName[0] == 0)) { defaultPtr = pkgPtr; |
︙ | ︙ | |||
325 326 327 328 329 330 331 | "couldn't figure out package name for ", fullFileName, NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "WHATPACKAGE", NULL); code = TCL_ERROR; goto done; } | | | | | | | | | | | 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 | "couldn't figure out package name for ", fullFileName, NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "WHATPACKAGE", NULL); code = TCL_ERROR; goto done; } Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess); Tcl_DecrRefCount(splitPtr); } } /* * Fix the capitalization in the package name so that the first * character is in caps (or title case) but the others are all * lower-case. */ Tcl_DStringSetLength(&pkgName, Tcl_UtfToTitle(Tcl_DStringValue(&pkgName))); /* * Compute the names of the two initialization functions, based on the * package name. */ TclDStringAppendDString(&initName, &pkgName); TclDStringAppendLiteral(&initName, "_Init"); TclDStringAppendDString(&safeInitName, &pkgName); TclDStringAppendLiteral(&safeInitName, "_SafeInit"); TclDStringAppendDString(&unloadName, &pkgName); TclDStringAppendLiteral(&unloadName, "_Unload"); TclDStringAppendDString(&safeUnloadName, &pkgName); TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload"); /* * Call platform-specific code to load the package and find the two * initialization functions. */ symbols[0] = Tcl_DStringValue(&initName); |
︙ | ︙ | |||
619 620 621 622 623 624 625 | defaultPtr = NULL; for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { int namesMatch, filesMatch; if (packageName == NULL) { namesMatch = 0; } else { | | | | | 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 | defaultPtr = NULL; for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) { int namesMatch, filesMatch; if (packageName == NULL) { namesMatch = 0; } else { TclDStringClear(&pkgName); Tcl_DStringAppend(&pkgName, packageName, -1); TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); Tcl_UtfToLower(Tcl_DStringValue(&tmp)); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&pkgName)) == 0) { namesMatch = 1; } else { namesMatch = 0; } } TclDStringClear(&pkgName); filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (packageName == NULL))) { break; } if (namesMatch && (fullFileName[0] == 0)) { defaultPtr = pkgPtr; |
︙ | ︙ |
Changes to generic/tclNamesp.c.
︙ | ︙ | |||
20 21 22 23 24 25 26 | * [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" | | | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | * [email protected] * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" /* for TclLogCommandInfo visibility */ /* * Thread-local storage used to avoid having a global lock on data that is not * limited to a single interpreter. */ typedef struct ThreadSpecificData { |
︙ | ︙ | |||
799 800 801 802 803 804 805 | namePtr = &buffer1; buffPtr = &buffer2; for (ancestorPtr = nsPtr; ancestorPtr != NULL; ancestorPtr = ancestorPtr->parentPtr) { if (ancestorPtr != globalNsPtr) { register Tcl_DString *tempPtr = namePtr; | | | < | | 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 | namePtr = &buffer1; buffPtr = &buffer2; for (ancestorPtr = nsPtr; ancestorPtr != NULL; ancestorPtr = ancestorPtr->parentPtr) { if (ancestorPtr != globalNsPtr) { register Tcl_DString *tempPtr = namePtr; TclDStringAppendLiteral(buffPtr, "::"); Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1); TclDStringAppendDString(buffPtr, namePtr); /* * Clear the unwanted buffer or we end up appending to previous * results, making the namespace fullNames of nested namespaces * very wrong (and strange). */ TclDStringClear(namePtr); /* * Now swap the buffer pointers so that we build in the other * buffer. This is faster than repeated copying back and forth * between buffers. */ |
︙ | ︙ | |||
912 913 914 915 916 917 918 | * 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); | | | 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 | * NOTE: we could avoid traversing the ns's command list by keeping a * separate list of coros. */ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL;) { cmdPtr = Tcl_GetHashValue(entryPtr); if (cmdPtr->nreProc == TclNRInterpCoroutine) { Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, (Tcl_Command) cmdPtr); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); } else { entryPtr = Tcl_NextHashEntry(&search); } } |
︙ | ︙ | |||
1663 1664 1665 1666 1667 1668 1669 | ImportedCmdData *dataPtr; Command *cmdPtr; ImportRef *refPtr; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, nsPtr->fullName, -1); if (nsPtr != ((Interp *) interp)->globalNsPtr) { | | | 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 | ImportedCmdData *dataPtr; Command *cmdPtr; ImportRef *refPtr; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, nsPtr->fullName, -1); if (nsPtr != ((Interp *) interp)->globalNsPtr) { TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, cmdName, -1); /* * Check whether creating the new imported command in the current * namespace would create a cycle of imported command references. */ |
︙ | ︙ | |||
2237 2238 2239 2240 2241 2242 2243 | * 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. */ | | | 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 | * start points to the beginning of a namespace qualifier ending * in "::". end points to the start of a name in that namespace * that might be empty. Copy the namespace qualifier to a buffer * so it can be null terminated. We can't modify the incoming * qualName since it may be a string constant. */ TclDStringClear(&buffer); Tcl_DStringAppend(&buffer, start, len); nsName = Tcl_DStringValue(&buffer); } /* * Look up the namespace qualifier nsName in the current namespace * context. If it isn't found but TCL_CREATE_NS_IF_UNKNOWN is set, |
︙ | ︙ | |||
2912 2913 2914 2915 2916 2917 2918 | const char *name = TclGetString(objv[2]); if ((*name == ':') && (*(name+1) == ':')) { pattern = name; } else { Tcl_DStringAppend(&buffer, nsPtr->fullName, -1); if (nsPtr != globalNsPtr) { | | | 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 | const char *name = TclGetString(objv[2]); if ((*name == ':') && (*(name+1) == ':')) { pattern = name; } else { Tcl_DStringAppend(&buffer, nsPtr->fullName, -1); if (nsPtr != globalNsPtr) { TclDStringAppendLiteral(&buffer, "::"); } Tcl_DStringAppend(&buffer, name, -1); pattern = Tcl_DStringValue(&buffer); } } /* |
︙ | ︙ |
Changes to generic/tclOO.c.
︙ | ︙ | |||
352 353 354 355 356 357 358 | /* * Create the subcommands in the oo::define and oo::objdefine spaces. */ Tcl_DStringInit(&buffer); for (i=0 ; defineCmds[i].name ; i++) { | | | | 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 | /* * Create the subcommands in the oo::define and oo::objdefine spaces. */ Tcl_DStringInit(&buffer); for (i=0 ; defineCmds[i].name ; i++) { TclDStringAppendLiteral(&buffer, "::oo::define::"); Tcl_DStringAppend(&buffer, defineCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } for (i=0 ; objdefCmds[i].name ; i++) { TclDStringAppendLiteral(&buffer, "::oo::objdefine::"); Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } Tcl_CallWhenDeleted(interp, KillFoundation, NULL); |
︙ | ︙ | |||
653 654 655 656 657 658 659 | PublicObjectCmd, oPtr, NULL); } else { Tcl_DString buffer; Tcl_DStringInit(&buffer); Tcl_DStringAppend(&buffer, Tcl_GetCurrentNamespace(interp)->fullName, -1); | | | 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 | PublicObjectCmd, oPtr, NULL); } else { Tcl_DString buffer; Tcl_DStringInit(&buffer); Tcl_DStringAppend(&buffer, Tcl_GetCurrentNamespace(interp)->fullName, -1); TclDStringAppendLiteral(&buffer, "::"); Tcl_DStringAppend(&buffer, nameStr, -1); oPtr->command = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL); Tcl_DStringFree(&buffer); } /* |
︙ | ︙ |
Changes to generic/tclOOBasic.c.
︙ | ︙ | |||
1186 1187 1188 1189 1190 1191 1192 | if (name[0]!=':' || name[1]!=':') { Interp *iPtr = (Interp *) interp; if (iPtr->varFramePtr != NULL) { Tcl_DStringAppend(&buffer, iPtr->varFramePtr->nsPtr->fullName, -1); } | | | 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 | if (name[0]!=':' || name[1]!=':') { Interp *iPtr = (Interp *) interp; if (iPtr->varFramePtr != NULL) { Tcl_DStringAppend(&buffer, iPtr->varFramePtr->nsPtr->fullName, -1); } TclDStringAppendLiteral(&buffer, "::"); Tcl_DStringAppend(&buffer, name, -1); name = Tcl_DStringValue(&buffer); } o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, NULL); Tcl_DStringFree(&buffer); } |
︙ | ︙ |
Changes to generic/tclPathObj.c.
︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 | Tcl_Obj *copyPtr); static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); static int FindSplitPos(const char *path, int separator); static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); /* * Define the 'path' object type, which Tcl uses to represent file paths * internally. */ static const Tcl_ObjType tclFsPathType = { | > > | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | Tcl_Obj *copyPtr); static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); static int FindSplitPos(const char *path, int separator); static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); static int MakePathFromNormalized(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* * Define the 'path' object type, which Tcl uses to represent file paths * internally. */ static const Tcl_ObjType tclFsPathType = { |
︙ | ︙ | |||
428 429 430 431 432 433 434 | TclFSNormalizeToUniquePath(interp, retVal, 0); /* * Since we know it is a normalized path, we can actually convert this * object into an FsPath for greater efficiency */ | | | 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 | TclFSNormalizeToUniquePath(interp, retVal, 0); /* * Since we know it is a normalized path, we can actually convert this * object into an FsPath for greater efficiency */ MakePathFromNormalized(interp, retVal); /* * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs. */ return retVal; } |
︙ | ︙ | |||
1453 1454 1455 1456 1457 1458 1459 | return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen); } /* *--------------------------------------------------------------------------- * | | | | < | 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 | return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen); } /* *--------------------------------------------------------------------------- * * MakePathFromNormalized -- * * Like SetFsPathFromAny, but assumes the given object is an absolute * normalized path. Only for internal use. * * Results: * Standard Tcl error code. * * Side effects: * The old representation may be freed, and new memory allocated. * *--------------------------------------------------------------------------- */ static int MakePathFromNormalized( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; } /* * Free old representation |
︙ | ︙ | |||
1517 1518 1519 1520 1521 1522 1523 | */ fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; /* Remember the epoch under which we decided pathPtr was normalized */ | | | 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 | */ fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; /* Remember the epoch under which we decided pathPtr was normalized */ fsPathPtr->filesystemEpoch = TclFSEpoch(); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; return TCL_OK; } |
︙ | ︙ | |||
1559 1560 1561 1562 1563 1564 1565 | Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, ClientData clientData) { Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; | < | 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 | Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, ClientData clientData) { Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; if (fromFilesystem->internalToNormalizedProc != NULL) { pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); } if (pathPtr == NULL) { return NULL; } |
︙ | ︙ | |||
1595 1596 1597 1598 1599 1600 1601 | * Circular reference, by design. */ fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsPtr = fromFilesystem; | | | 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 | * Circular reference, by design. */ fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsPtr = fromFilesystem; fsPathPtr->filesystemEpoch = TclFSEpoch(); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; pathPtr->typePtr = &tclFsPathType; return pathPtr; } |
︙ | ︙ | |||
2202 2203 2204 2205 2206 2207 2208 | void TclFSSetPathDetails( Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr, ClientData clientData) { | < | | 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 | void TclFSSetPathDetails( Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr, ClientData clientData) { FsPath *srcFsPathPtr; /* * Make sure pathPtr is of the correct type. */ if (pathPtr->typePtr != &tclFsPathType) { if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return; } } srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->fsPtr = fsPtr; srcFsPathPtr->nativePathPtr = clientData; srcFsPathPtr->filesystemEpoch = TclFSEpoch(); } /* *--------------------------------------------------------------------------- * * Tcl_FSEqualPaths -- * |
︙ | ︙ | |||
2307 2308 2309 2310 2311 2312 2313 | 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; | < | 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 | Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { int len; FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; } /* * First step is to translate the filename. This is similar to |
︙ | ︙ | |||
2462 2463 2464 2465 2466 2467 2468 | fsPathPtr = ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; if (transPtr != pathPtr) { Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); /* Redo translation when $env(HOME) changes */ | | | 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 | fsPathPtr = ckalloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; if (transPtr != pathPtr) { Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); /* Redo translation when $env(HOME) changes */ fsPathPtr->filesystemEpoch = TclFSEpoch(); } else { fsPathPtr->filesystemEpoch = 0; } fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; |
︙ | ︙ |
Changes to generic/tclPkg.c.
︙ | ︙ | |||
1708 1709 1710 1711 1712 1713 1714 | Tcl_Obj *const reqv[]) /* 0 means to use the latest version * available. */ { if (reqc > 0) { int i; for (i = 0; i < reqc; i++) { | | | | | 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 | * 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); | | | 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 | * qualifiers. To create the new command in the right namespace, we * generate a fully qualified name for it. */ Tcl_DStringInit(&ds); if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, nsPtr->fullName, -1); TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, procName, -1); cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc); Tcl_DStringFree(&ds); |
︙ | ︙ |
Changes to generic/tclStubInit.c.
︙ | ︙ | |||
51 52 53 54 55 56 57 58 59 60 61 62 63 64 | { return TclSockMinimumBuffers(INT2PTR(sock), size); } #endif #ifdef __WIN32__ # define TclUnixWaitForFile 0 # define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) # define TclpIsAtty TclPlatIsAtty # define TclWinSetInterfaces (void (*) (int)) doNothing # define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing # define TclWinFlushDirtyChannels doNothing | > | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | { return TclSockMinimumBuffers(INT2PTR(sock), size); } #endif #ifdef __WIN32__ # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 # define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) # define TclpIsAtty TclPlatIsAtty # define TclWinSetInterfaces (void (*) (int)) doNothing # define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing # define TclWinFlushDirtyChannels doNothing |
︙ | ︙ | |||
494 495 496 497 498 499 500 | TclpReaddir, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ TclpCreatePipe, /* 14 */ TclpCreateProcess, /* 15 */ TclpIsAtty, /* 16 */ | | | 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 | TclpReaddir, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ TclpCreatePipe, /* 14 */ TclpCreateProcess, /* 15 */ TclpIsAtty, /* 16 */ TclUnixCopyFile, /* 17 */ TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ TclpInetNtoa, /* 21 */ TclpCreateTempFile, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ |
︙ | ︙ |
Changes to generic/tclTrace.c.
︙ | ︙ | |||
1294 1295 1296 1297 1298 1299 1300 | */ 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) { | | | | 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 | */ Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length); Tcl_DStringAppendElement(&cmd, oldName); Tcl_DStringAppendElement(&cmd, (newName ? newName : "")); if (flags & TCL_TRACE_RENAME) { TclDStringAppendLiteral(&cmd, " rename"); } else if (flags & TCL_TRACE_DELETE) { TclDStringAppendLiteral(&cmd, " delete"); } /* * Execute the command. We discard any object result the command * returns. * * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to other |
︙ | ︙ | |||
1990 1991 1992 1993 1994 1995 1996 | 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) { | | | | | | | | | | 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 | Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length); Tcl_DStringAppendElement(&cmd, name1); Tcl_DStringAppendElement(&cmd, (name2 ? name2 : "")); #ifndef TCL_REMOVE_OBSOLETE_TRACES if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) { if (flags & TCL_TRACE_ARRAY) { TclDStringAppendLiteral(&cmd, " a"); } else if (flags & TCL_TRACE_READS) { TclDStringAppendLiteral(&cmd, " r"); } else if (flags & TCL_TRACE_WRITES) { TclDStringAppendLiteral(&cmd, " w"); } else if (flags & TCL_TRACE_UNSETS) { TclDStringAppendLiteral(&cmd, " u"); } } else { #endif if (flags & TCL_TRACE_ARRAY) { TclDStringAppendLiteral(&cmd, " array"); } else if (flags & TCL_TRACE_READS) { TclDStringAppendLiteral(&cmd, " read"); } else if (flags & TCL_TRACE_WRITES) { TclDStringAppendLiteral(&cmd, " write"); } else if (flags & TCL_TRACE_UNSETS) { TclDStringAppendLiteral(&cmd, " unset"); } #ifndef TCL_REMOVE_OBSOLETE_TRACES } #endif /* * Execute the command. We discard any object result the command |
︙ | ︙ | |||
2573 2574 2575 2576 2577 2578 2579 | } while (*p != '\0'); p--; if (*p == ')') { int offset = (openParen - part1); char *newPart1; Tcl_DStringInit(&nameCopy); | | | 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 | } while (*p != '\0'); p--; if (*p == ')') { int offset = (openParen - part1); char *newPart1; Tcl_DStringInit(&nameCopy); Tcl_DStringAppend(&nameCopy, part1, p-part1); newPart1 = Tcl_DStringValue(&nameCopy); newPart1[offset] = 0; part1 = newPart1; part2 = newPart1 + offset + 1; copiedName = 1; } break; |
︙ | ︙ |
Changes to generic/tclUtil.c.
︙ | ︙ | |||
2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 | dsPtr->string[dsPtr->length] = '\0'; return dsPtr->string; } /* *---------------------------------------------------------------------- * * Tcl_DStringAppendElement -- * * Append a list element to the current value of a dynamic string. * * Results: * The return value is a pointer to the dynamic string's new value. * | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 | dsPtr->string[dsPtr->length] = '\0'; return dsPtr->string; } /* *---------------------------------------------------------------------- * * TclDStringAppendObj, TclDStringAppendDString -- * * Simple wrappers round Tcl_DStringAppend that make it easier to append * from particular sources of strings. * *---------------------------------------------------------------------- */ char * TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { int length; char *bytes = Tcl_GetStringFromObj(objPtr, &length); return Tcl_DStringAppend(dsPtr, bytes, length); } char * TclDStringAppendDString( Tcl_DString *dsPtr, Tcl_DString *toAppendPtr) { return Tcl_DStringAppend(dsPtr, Tcl_DStringValue(toAppendPtr), Tcl_DStringLength(toAppendPtr)); } /* *---------------------------------------------------------------------- * * Tcl_DStringAppendElement -- * * Append a list element to the current value of a dynamic string. * * Results: * The return value is a pointer to the dynamic string's new value. * |
︙ | ︙ | |||
2789 2790 2791 2792 2793 2794 2795 | */ void Tcl_DStringStartSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) { | | | | 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 | */ void Tcl_DStringStartSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) { TclDStringAppendLiteral(dsPtr, " {"); } else { TclDStringAppendLiteral(dsPtr, "{"); } } /* *---------------------------------------------------------------------- * * Tcl_DStringEndSublist -- |
︙ | ︙ | |||
2817 2818 2819 2820 2821 2822 2823 | *---------------------------------------------------------------------- */ void Tcl_DStringEndSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { | | | 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 | *---------------------------------------------------------------------- */ void Tcl_DStringEndSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { TclDStringAppendLiteral(dsPtr, "}"); } /* *---------------------------------------------------------------------- * * Tcl_PrintDouble -- * |
︙ | ︙ |
Changes to generic/tclZlib.c.
︙ | ︙ | |||
569 570 571 572 573 574 575 | */ if (interp != NULL) { if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) { goto error; } Tcl_DStringInit(&cmdname); | | | < | 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 | */ if (interp != NULL) { if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) { goto error; } Tcl_DStringInit(&cmdname); TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_"); TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp)); if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname), &cmdinfo) == 1) { Tcl_SetResult(interp, "BUG: Stream command name already exists", TCL_STATIC); Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL); Tcl_DStringFree(&cmdname); goto error; |
︙ | ︙ | |||
2691 2692 2693 2694 2695 2696 2697 | ExtractHeader(&cd->inHeader.header, tmpObj); if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-header"); Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj)); Tcl_DecrRefCount(tmpObj); } else { | < < < | | 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 | ExtractHeader(&cd->inHeader.header, tmpObj); if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-header"); Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj)); Tcl_DecrRefCount(tmpObj); } else { TclDStringAppendObj(dsPtr, tmpObj); Tcl_DecrRefCount(tmpObj); return TCL_OK; } } /* * Now we do the standard processing of the stream we wrapped. |
︙ | ︙ | |||
3018 3019 3020 3021 3022 3023 3024 | } 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); | | | 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 | } else /* have <= toRead */ { /* * There is just or not enough in the buffer to fully satisfy the * caller, so take everything as best effort. */ memcpy(buf, Tcl_DStringValue(&cd->decompressed), have); TclDStringClear(&cd->decompressed); return have; } } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to library/dde/pkgIndex.tcl.
1 2 3 | if {![package vsatisfies [package provide Tcl] 8.5]} return if {[info sharedlibextension] ne ".dll"} return if {[::tcl::pkgconfig get debug]} { | | | | 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 | # 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. | < | > > > > | 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 | # # 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. | | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.5 # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. package provide msgcat 1.4.5 namespace eval msgcat { namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \ mcunknown # Records the current locale as passed to mclocale variable Locale "" # Records the list of locales to search variable Loclist {} # Records the mapping between source strings and translated strings. The # dict key is of the form "<locale> <namespace> <src>", where locale and # namespace should be themselves dict values and the value is # the translated string. variable Msgs [dict create] # Map of language codes used in Windows registry to those of ISO-639 if {[info sharedlibextension] eq ".dll"} { variable WinRegToISO639 [dict create {*}{ 01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ 1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY 2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH 4001 ar_QA 02 bg 0402 bg_BG 03 ca 0403 ca_ES |
︙ | ︙ | |||
62 63 64 65 66 67 68 | 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 | | | | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | 11 ja 0411 ja_JP 12 ko 0412 ko_KR 13 nl 0413 nl_NL 0813 nl_BE 14 no 0414 no_NO 0814 nn_NO 15 pl 0415 pl_PL 16 pt 0416 pt_BR 0816 pt_PT 17 rm 0417 rm_CH 18 ro 0418 ro_RO 0818 ro_MO 19 ru 0819 ru_MO 1a hr 041a hr_HR 081a sr_YU 0c1a sr_YU@cyrillic 1b sk 041b sk_SK 1c sq 041c sq_AL 1d sv 041d sv_SE 081d sv_FI 1e th 041e th_TH 1f tr 041f tr_TR 20 ur 0420 ur_PK 0820 ur_IN |
︙ | ︙ | |||
88 89 90 91 92 93 94 95 96 97 98 99 100 101 | 2b hy 042b hy_AM 2c az 042c az_AZ@latin 082c az_AZ@cyrillic 2d eu 2e wen 042e wen_DE 2f mk 042f mk_MK 30 bnt 0430 bnt_TZ 31 ts 0431 ts_ZA 33 ven 0433 ven_ZA 34 xh 0434 xh_ZA 35 zu 0435 zu_ZA 36 af 0436 af_ZA 37 ka 0437 ka_GE 38 fo 0438 fo_FO 39 hi 0439 hi_IN | > | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | 2b hy 042b hy_AM 2c az 042c az_AZ@latin 082c az_AZ@cyrillic 2d eu 2e wen 042e wen_DE 2f mk 042f mk_MK 30 bnt 0430 bnt_TZ 31 ts 0431 ts_ZA 32 tn 33 ven 0433 ven_ZA 34 xh 0434 xh_ZA 35 zu 0435 zu_ZA 36 af 0436 af_ZA 37 ka 0437 ka_GE 38 fo 0438 fo_FO 39 hi 0439 hi_IN |
︙ | ︙ | |||
337 338 339 340 341 342 343 | 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 { | | | 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 | should be \"[lindex [info level 0] 0] locale {src dest ...}\"" } set locale [string tolower $locale] set ns [uplevel 1 [list ::namespace current]] foreach {src dest} $pairs { dict set Msgs $locale $ns $src $dest } return $length } # msgcat::mcunknown -- # |
︙ | ︙ | |||
383 384 385 386 387 388 389 | # 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]] | | | | | 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 | # Results: # Returns the length of the longest translated string. proc msgcat::mcmax {args} { set max 0 foreach string $args { set translated [uplevel 1 [list [namespace origin mc] $string]] set len [string length $translated] if {$len>$max} { set max $len } } return $max } # Convert the locale values stored in environment variables to a form # suitable for passing to [mclocale] proc msgcat::ConvertLocale {value} { |
︙ | ︙ | |||
422 423 424 425 426 427 428 | append ret _$modifier } return $ret } # Initialize the default locale proc msgcat::Init {} { | | | 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 | append ret _$modifier } return $ret } # Initialize the default locale proc msgcat::Init {} { global env # # set default locale, try to get from environment # foreach varName {LC_ALL LC_MESSAGES LANG} { if {[info exists env($varName)] && ("" ne $env($varName))} { if {![catch { |
︙ | ︙ | |||
447 448 449 450 451 452 453 | if {![catch { mclocale [ConvertLocale $::tcl::mac::locale] }]} { return } } # | | | | > | | | | > > > > > > > > | > > > > > > > > > > > > > > > > > > > > | | 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 | if {![catch { mclocale [ConvertLocale $::tcl::mac::locale] }]} { return } } # # The rest of this routine is special processing for Windows or # Cygwin. All other platforms, get out now. # if {([info sharedlibextension] ne ".dll") || [catch {package require registry}]} { mclocale C return } # # On Windows or Cygwin, try to set locale depending on registry # settings, or fall back on locale of "C". # # First check registry value LocalName present from Windows Vista # which contains the local string as RFC5646, composed of: # [a-z]{2,3} : language # -[a-z]{4} : script (optional, translated by table Latn->latin) # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used) # (-.*)* : variant, extension, private use (optional, not used) # Those are translated to local strings. # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs@latin, es-419 -> es # set key {HKEY_CURRENT_USER\Control Panel\International} if {([registry values $key "LocaleName"] ne "") && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\ [string tolower [registry get $key "LocaleName"]] match locale\ script territory]} { if {"" ne $territory} { append locale _ $territory } set modifierDict [dict create latn latin cyrl cyrillic] if {[dict exists $modifierDict $script]} { append locale @ [dict get $modifierDict $script] } if {![catch { mclocale [ConvertLocale $locale] }]} { return } } # then check key locale which contains a numerical language ID if {[catch { set locale [registry get $key "locale"] }]} { mclocale C return } # # Keep trying to match against smaller and smaller suffixes # of the registry value, since the latter hexadigits appear # to determine general language and earlier hexadigits determine # more precise information, such as territory. For example, |
︙ | ︙ |
Changes to library/msgcat/pkgIndex.tcl.
1 | if {![package vsatisfies [package provide Tcl] 8.5]} {return} | | | 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 {([info commands ::tcl::pkgconfig] eq "") || ([info sharedlibextension] ne ".dll")} return if {[::tcl::pkgconfig get debug]} { package ifneeded registry 1.3.0 \ [list load [file join $dir tclreg13g.dll] registry] } else { package ifneeded registry 1.3.0 \ [list load [file join $dir tclreg13.dll] registry] } |
Changes to tests/http.test.
︙ | ︙ | |||
131 132 133 134 135 136 137 138 139 140 141 142 143 144 | </body></html>" set tail /a/b/c set url //[info hostname]:$port/a/b/c set fullurl http://user:pass@[info hostname]:$port/a/b/c set binurl //[info hostname]:$port/binary set posturl //[info hostname]:$port/post set badposturl //[info hostname]:$port/droppost test http-3.4 {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { http::cleanup $token } -result "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> | > | 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | </body></html>" set tail /a/b/c set url //[info hostname]:$port/a/b/c set fullurl http://user:pass@[info hostname]:$port/a/b/c set binurl //[info hostname]:$port/binary set posturl //[info hostname]:$port/post set badposturl //[info hostname]:$port/droppost set ipv6url http://\[::1\]:$port/ test http-3.4 {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { http::cleanup $token } -result "<html><head><title>HTTP/1.0 TEST</title></head><body> <h1>Hello, World!</h1> |
︙ | ︙ | |||
386 387 388 389 390 391 392 393 394 395 396 397 398 399 | } -match regexp -result {(?n)Accept \*/\* Host .* User-Agent .* Connection close Content-Type {text/plain;charset=utf-8} Accept-Encoding .* Content-Length 5} test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] upvar #0 $token data array set meta $data(meta) expr {($data(totalsize) == $meta(Content-Length))} } -cleanup { | > > > > > > | 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 | } -match regexp -result {(?n)Accept \*/\* Host .* User-Agent .* Connection close Content-Type {text/plain;charset=utf-8} Accept-Encoding .* Content-Length 5} test http-3.29 "http::geturl $ipv6url" -body { set token [http::geturl $ipv6url -validate 1] http::code $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 200 OK" test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] upvar #0 $token data array set meta $data(meta) expr {($data(totalsize) == $meta(Content-Length))} } -cleanup { |
︙ | ︙ |
Changes to tests/msgcat.test.
︙ | ︙ | |||
13 14 15 16 17 18 19 | # 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 } | | | | 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 | @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; | | | | 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 | { (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 | | | 7131 7132 7133 7134 7135 7136 7137 7138 7139 7140 7141 7142 7143 7144 7145 | { (exit 1); exit 1; }; } fi if test "x${TCL_THREADS}" = "x0"; then { { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5 echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;} { (exit 1); exit 1; }; } fi if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then { { echo "$as_me:$LINENO: error: Please configure and make the ../win directory first." >&5 echo "$as_me: error: Please configure and make the ../win directory first." >&2;} { (exit 1); exit 1; }; } fi ;; dgux*) SHLIB_CFLAGS="-K PIC" |
︙ | ︙ | |||
14396 14397 14398 14399 14400 14401 14402 | #-------------------------------------------------------------------- # 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 | > | > | 14396 14397 14398 14399 14400 14401 14402 14403 14404 14405 14406 14407 14408 14409 14410 14411 14412 | #-------------------------------------------------------------------- # Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But # we might be able to use fstatfs instead. Some systems (OpenBSD?) also # lack blkcnt_t. #-------------------------------------------------------------------- if test "$ac_cv_cygwin" = "yes"; then if test "x${SHARED_BUILD}" = "x1"; then TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib" fi else echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5 echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6 if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF |
︙ | ︙ |
Changes to unix/configure.in.
︙ | ︙ | |||
299 300 301 302 303 304 305 | #-------------------------------------------------------------------- # 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 | > | > | 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 | ) 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 | | | 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 | # tclConfig.sh -- | | | 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 | * the underscore. */ native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds); proc = dlsym(handle, native); /* INTL: Native. */ if (proc == NULL) { Tcl_DStringInit(&newName); | | | 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 | Tcl_DString newName; /* * dyld adds an underscore to the beginning of symbol names. */ Tcl_DStringInit(&newName); | | | 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 | * 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); | | | | | 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 | return TCL_ERROR; } GETIOSTATE(fsPtr->fd, &iostate); Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds); iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds); | | | 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 | return TCL_ERROR; } GETIOSTATE(fsPtr->fd, &iostate); Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds); iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds); TclDStringClear(&ds); Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds); iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds); Tcl_DStringFree(&ds); ckfree(argv); SETIOSTATE(fsPtr->fd, &iostate); |
︙ | ︙ | |||
912 913 914 915 916 917 918 | 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)); | | | 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 | valid = 1; GETIOSTATE(fsPtr->fd, &iostate); Tcl_DStringInit(&ds); Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); TclDStringClear(&ds); Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); } if (len == 0) { Tcl_DStringEndSublist(dsPtr); |
︙ | ︙ |
Changes to unix/tclUnixFCmd.c.
︙ | ︙ | |||
963 964 965 966 967 968 969 | result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_PRED, errorPtr); if (result != TCL_OK) { closedir(dirPtr); return result; } | | | | 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 | result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_PRED, errorPtr); if (result != TCL_OK) { closedir(dirPtr); return result; } TclDStringAppendLiteral(sourcePtr, "/"); sourceLen = Tcl_DStringLength(sourcePtr); if (targetPtr != NULL) { TclDStringAppendLiteral(targetPtr, "/"); targetLen = Tcl_DStringLength(targetPtr); } while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */ if ((dirEntPtr->d_name[0] == '.') && ((dirEntPtr->d_name[1] == '\0') || (strcmp(dirEntPtr->d_name, "..") == 0))) { |
︙ | ︙ | |||
2121 2122 2123 2124 2125 2126 2127 | string = Tcl_GetStringFromObj(dirObj, &len); Tcl_UtfToExternalDString(NULL, string, len, &template); } else { Tcl_DStringInit(&template); Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */ } | | | | | | | 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 | string = Tcl_GetStringFromObj(dirObj, &len); Tcl_UtfToExternalDString(NULL, string, len, &template); } else { Tcl_DStringInit(&template); Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */ } TclDStringAppendLiteral(&template, "/"); if (basenameObj) { string = Tcl_GetStringFromObj(basenameObj, &len); Tcl_UtfToExternalDString(NULL, string, len, &tmp); TclDStringAppendDString(&template, &tmp); Tcl_DStringFree(&tmp); } else { TclDStringAppendLiteral(&template, "tcl"); } TclDStringAppendLiteral(&template, "_XXXXXX"); #ifdef HAVE_MKSTEMPS if (extensionObj) { string = Tcl_GetStringFromObj(extensionObj, &len); Tcl_UtfToExternalDString(NULL, string, len, &tmp); TclDStringAppendDString(&template, &tmp); fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); } else #endif { fd = mkstemp(Tcl_DStringValue(&template)); } |
︙ | ︙ |
Changes to unix/tclUnixFile.c.
︙ | ︙ | |||
47 48 49 50 51 52 53 | 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; } | | | | | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | GetModuleFileNameW(NULL, buf, PATH_MAX); cygwin_conv_path(3, buf, name, PATH_MAX); length = strlen(name); if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) { /* Strip '.exe' part. */ length -= 4; } encoding = Tcl_GetEncoding(NULL, NULL); TclSetObjNameOfExecutable( Tcl_NewStringObj(name, length), encoding); #else const char *name, *p; Tcl_StatBuf statBuf; Tcl_DString buffer, nameString, cwd, utfName; if (argv0 == NULL) { return; |
︙ | ︙ | |||
101 102 103 104 105 106 107 | while (TclIsSpaceProc(*p)) { p++; } name = p; while ((*p != ':') && (*p != 0)) { p++; } | | | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | while (TclIsSpaceProc(*p)) { p++; } name = p; while ((*p != ':') && (*p != 0)) { p++; } TclDStringClear(&buffer); if (p != name) { Tcl_DStringAppend(&buffer, name, p - name); if (p[-1] != '/') { TclDStringAppendLiteral(&buffer, "/"); } } name = Tcl_DStringAppend(&buffer, argv0, -1); /* * INTL: The following calls to access() and stat() should not be * converted to Tclp routines because they need to operate on native |
︙ | ︙ | |||
170 171 172 173 174 175 176 | TclpGetCwd(NULL, &cwd); Tcl_DStringFree(&buffer); Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), Tcl_DStringLength(&cwd), &buffer); if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') { | | | < | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 | TclpGetCwd(NULL, &cwd); Tcl_DStringFree(&buffer); Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), Tcl_DStringLength(&cwd), &buffer); if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') { TclDStringAppendLiteral(&buffer, "/"); } Tcl_DStringFree(&cwd); TclDStringAppendDString(&buffer, &nameString); Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1, &utfName); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); |
︙ | ︙ | |||
284 285 286 287 288 289 290 | dirName = Tcl_DStringValue(&dsOrig); /* * Make sure we have a trailing directory delimiter. */ if (dirName[dirLength-1] != '/') { | | | 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 | dirName = Tcl_DStringValue(&dsOrig); /* * Make sure we have a trailing directory delimiter. */ if (dirName[dirLength-1] != '/') { dirName = TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } } /* * Now open the directory for reading and iterate over the contents. */ |
︙ | ︙ |
Changes to unix/tclUnixNotfy.c.
︙ | ︙ | |||
891 892 893 894 895 896 897 | if (waitingListPtr) { waitingListPtr->prevPtr = tsdPtr; } tsdPtr->prevPtr = 0; waitingListPtr = tsdPtr; tsdPtr->onList = 1; | | | 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 | if (waitingListPtr) { waitingListPtr->prevPtr = tsdPtr; } tsdPtr->prevPtr = 0; waitingListPtr = tsdPtr; tsdPtr->onList = 1; if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { Tcl_Panic("Tcl_WaitForEvent: %s", "unable to write to triggerPipe"); } } FD_ZERO(&tsdPtr->readyMasks.readable); FD_ZERO(&tsdPtr->readyMasks.writable); |
︙ | ︙ | |||
954 955 956 957 958 959 960 | waitingListPtr = tsdPtr->nextPtr; } if (tsdPtr->nextPtr) { tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; | | | 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 | waitingListPtr = tsdPtr->nextPtr; } if (tsdPtr->nextPtr) { tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { Tcl_Panic("Tcl_WaitForEvent: %s", "unable to write to triggerPipe"); } } #else tsdPtr->readyMasks = tsdPtr->checkMasks; |
︙ | ︙ |
Changes to unix/tclUnixPipe.c.
︙ | ︙ | |||
207 208 209 210 211 212 213 | return NULL; } fcntl(fd, F_SETFD, FD_CLOEXEC); unlink(fileName); /* INTL: Native. */ if (contents != NULL) { native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); | | | 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 | @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; | | | | 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 | */ static HSZ ddeServiceGlobal = 0; static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; | | | 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 | path = (const char *) nativePath; Tcl_DStringInit(&buffer); len = strlen(path); find = Tcl_DStringAppend(&buffer, path, len); if ((len > 0) && (find[len - 1] != '\\')) { | | | | 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 | Tcl_DStringInit(&dsOrig); dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); lastChar = dirName[dirLength -1]; if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { | | | | 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 | Tcl_DStringInit(&dsOrig); dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); lastChar = dirName[dirLength -1]; if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { TclDStringAppendLiteral(&dsOrig, "/"); dirLength++; } dirName = Tcl_DStringValue(&dsOrig); /* * We need to check all files in the directory, so we append '*.*' to * the path, unless the pattern we've been given is rather simple, * when we can use that instead. */ if (strpbrk(pattern, "[]\\") == NULL) { /* * The pattern is a simple one containing just '*' and/or '?'. * This means we can get the OS to help us, by passing it the * pattern. */ dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); } else { dirName = TclDStringAppendLiteral(&dsOrig, "*.*"); } native = Tcl_WinUtfToTChar(dirName, -1, &ds); if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) { handle = FindFirstFile(native, &data); } else { /* |
︙ | ︙ | |||
1463 1464 1465 1466 1467 1468 1469 | /* * User exists but has no home dir. Return * "{Windows Drive}:/users/default". */ GetWindowsDirectoryW(buf, MAX_PATH); Tcl_UniCharToUtfDString(buf, 2, bufferPtr); | | | 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 | /* * User exists but has no home dir. Return * "{Windows Drive}:/users/default". */ GetWindowsDirectoryW(buf, MAX_PATH); Tcl_UniCharToUtfDString(buf, 2, bufferPtr); TclDStringAppendLiteral(bufferPtr, "/users/default"); } result = Tcl_DStringValue(bufferPtr); NetApiBufferFree((void *) uiPtr); } Tcl_DStringFree(&ds); } if (wDomain != NULL) { |
︙ | ︙ | |||
2072 2073 2074 2075 2076 2077 2078 | p = strchr(p + 1, '\\'); if (p == NULL) { /* * Add terminating backslash to fullpath or GetVolumeInformation() * won't work. */ | | | 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 | p = strchr(p + 1, '\\'); if (p == NULL) { /* * Add terminating backslash to fullpath or GetVolumeInformation() * won't work. */ fullPath = TclDStringAppendLiteral(&ds, "\\"); p = fullPath + Tcl_DStringLength(&ds); } else { p++; } nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); dw = (DWORD) -1; GetVolumeInformation(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0); |
︙ | ︙ | |||
2532 2533 2534 2535 2536 2537 2538 | } /* * This is usually the '/' in 'c:/' at end of * string. */ | | | | | 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 | } /* * This is usually the '/' in 'c:/' at end of * string. */ TclDStringAppendLiteral(&dsNorm, "/"); } else { char *nativeName; if (fData.cFileName[0] != '\0') { nativeName = fData.cFileName; } else { nativeName = fData.cAlternateFileName; } FindClose(handle); TclDStringAppendLiteral(&dsNorm, "/"); Tcl_DStringAppend(&dsNorm, nativeName, -1); } } } Tcl_DStringFree(&ds); lastValidPathEnd = currentPathEndPosition; if (cur == 0) { break; |
︙ | ︙ |
Changes to win/tclWinInt.h.
︙ | ︙ | |||
22 23 24 25 26 27 28 29 30 31 32 33 34 35 | #ifndef VER_PLATFORM_WIN32_WINDOWS #define VER_PLATFORM_WIN32_WINDOWS 1 #endif #ifndef VER_PLATFORM_WIN32_CE #define VER_PLATFORM_WIN32_CE 3 #endif #ifdef _WIN64 # define TCL_I_MODIFIER "I" #else # define TCL_I_MODIFIER "" #endif | > > > > > > | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | #ifndef VER_PLATFORM_WIN32_WINDOWS #define VER_PLATFORM_WIN32_WINDOWS 1 #endif #ifndef VER_PLATFORM_WIN32_CE #define VER_PLATFORM_WIN32_CE 3 #endif #ifdef _WIN64 # define TCL_I_MODIFIER "I" #else # define TCL_I_MODIFIER "" #endif #ifdef _WIN64 # define TCL_I_MODIFIER "I" #else # define TCL_I_MODIFIER "" #endif |
︙ | ︙ |
Changes to win/tclWinLoad.c.
︙ | ︙ | |||
180 181 182 183 184 185 186 | proc = (void *) GetProcAddress(hInstance, symbol); if (proc == NULL) { Tcl_DString ds; const char *sym2; Tcl_DStringInit(&ds); | | | 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 | /* * 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); | > > | | 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 | /* * Write the file out, doing line translations on the way. */ if (contents != NULL) { DWORD result, length; const char *p; int toCopy; /* * Convert the contents from UTF to native encoding */ native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); toCopy = Tcl_DStringLength(&dstring); for (p = native; toCopy > 0; p++, toCopy--) { if (*p == '\n') { length = p - native; if (length > 0) { if (!WriteFile(handle, native, length, &result, NULL)) { goto error; } } |
︙ | ︙ | |||
1111 1112 1113 1114 1115 1116 1117 | * console application, and then run that hidden console as a * detached process. */ startInfo.wShowWindow = SW_HIDE; startInfo.dwFlags |= STARTF_USESHOWWINDOW; createFlags = CREATE_NEW_CONSOLE; | | | 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 | * console application, and then run that hidden console as a * detached process. */ startInfo.wShowWindow = SW_HIDE; startInfo.dwFlags |= STARTF_USESHOWWINDOW; createFlags = CREATE_NEW_CONSOLE; TclDStringAppendLiteral(&cmdLine, "cmd.exe /c"); } else { createFlags = DETACHED_PROCESS; } } else { if (HasConsole()) { createFlags = 0; } else { |
︙ | ︙ | |||
1461 1462 1463 1464 1465 1466 1467 | Tcl_DStringInit(&ds); /* * Prime the path. Add a space separator if we were primed with something. */ | | | | | | 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 | Tcl_DStringInit(&ds); /* * Prime the path. Add a space separator if we were primed with something. */ TclDStringAppendDString(&ds, linePtr); if (Tcl_DStringLength(linePtr) > 0) { TclDStringAppendLiteral(&ds, " "); } for (i = 0; i < argc; i++) { if (i == 0) { arg = executable; } else { arg = argv[i]; TclDStringAppendLiteral(&ds, " "); } quote = 0; if (arg[0] == '\0') { quote = 1; } else { int count; Tcl_UniChar ch; for (start = arg; *start != '\0'; start += count) { count = Tcl_UtfToUniChar(start, &ch); if (Tcl_UniCharIsSpace(ch)) { /* INTL: ISO space. */ quote = 1; break; } } } if (quote) { TclDStringAppendLiteral(&ds, "\""); } start = arg; for (special = arg; ; ) { if ((*special == '\\') && (special[1] == '\\' || special[1] == '"' || (quote && special[1] == '\0'))) { Tcl_DStringAppend(&ds, start, (int) (special - start)); start = special; |
︙ | ︙ | |||
1519 1520 1521 1522 1523 1524 1525 | } } Tcl_DStringAppend(&ds, start, (int) (special - start)); start = special; } if (*special == '"') { Tcl_DStringAppend(&ds, start, (int) (special - start)); | | | | 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 | } } Tcl_DStringAppend(&ds, start, (int) (special - start)); start = special; } if (*special == '"') { Tcl_DStringAppend(&ds, start, (int) (special - start)); TclDStringAppendLiteral(&ds, "\\\""); start = special + 1; } if (*special == '\0') { break; } special++; } Tcl_DStringAppend(&ds, start, (int) (special - start)); if (quote) { TclDStringAppendLiteral(&ds, "\""); } } Tcl_DStringFree(linePtr); Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr); Tcl_DStringFree(&ds); } |
︙ | ︙ |
Changes to win/tclWinReg.c.
︙ | ︙ | |||
776 777 778 779 780 781 782 | 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 */ | | | 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 | while (result == ERROR_MORE_DATA) { /* * The Windows docs say that in this error case, we just need to * expand our buffer and request more data. Required for * HKEY_PERFORMANCE_DATA */ length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR)); Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR)); result = RegQueryValueEx(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { |
︙ | ︙ | |||
885 886 887 888 889 890 891 | mode |= KEY_QUERY_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); | | < | 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 | mode |= KEY_QUERY_VALUE; if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); index = 0; result = TCL_OK; if (patternObj) { pattern = Tcl_GetString(patternObj); } else { pattern = NULL; |
︙ | ︙ | |||
1188 1189 1190 1191 1192 1193 1194 | 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); | | < | 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 | mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey); if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); mode = saveMode; while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. */ |
︙ | ︙ | |||
1314 1315 1316 1317 1318 1319 1320 | * 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++) { | > > | | < < < | | 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 | * Append the elements as null terminated strings. Note that we must * not assume the length of the string in case there are embedded * nulls, which aren't allowed in REG_MULTI_SZ values. */ Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { const char *bytes = Tcl_GetStringFromObj(objv[i], &length); Tcl_DStringAppend(&data, bytes, length); /* * Add a null character to separate this value from the next. */ Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); result = RegSetValueEx(key, (TCHAR *)valueName, 0, (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); |
︙ | ︙ |
Changes to win/tclWinSock.c.
︙ | ︙ | |||
1399 1400 1401 1402 1403 1404 1405 | */ infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async); if (infoPtr == NULL) { return NULL; } | | | 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 | */ infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async); if (infoPtr == NULL) { return NULL; } sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, infoPtr, (TCL_READABLE | TCL_WRITABLE)); if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf")) { Tcl_Close(NULL, infoPtr->channel); return NULL; |
︙ | ︙ | |||
1462 1463 1464 1465 1466 1467 1468 | /* * 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); | | | 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 | /* * Start watching for read/write events on the socket. */ infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr); sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, infoPtr, (TCL_READABLE | TCL_WRITABLE)); Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf"); return infoPtr->channel; } /* |
︙ | ︙ | |||
1515 1516 1517 1518 1519 1520 1521 | if (infoPtr == NULL) { return NULL; } infoPtr->acceptProc = acceptProc; infoPtr->acceptProcData = acceptProcData; | | | 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 | if (infoPtr == NULL) { return NULL; } infoPtr->acceptProc = acceptProc; infoPtr->acceptProcData = acceptProcData; sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd); infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, infoPtr, 0); if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "") == TCL_ERROR) { Tcl_Close(NULL, infoPtr->channel); return NULL; |
︙ | ︙ | |||
1621 1622 1623 1624 1625 1626 1627 | * 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); | | | 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 | * Select on read/write events and create the channel. */ newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) newInfoPtr); sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) newInfoPtr->sockets->fd); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", "auto crlf") == TCL_ERROR) { Tcl_Close(NULL, newInfoPtr->channel); return; } |
︙ | ︙ | |||
2575 2576 2577 2578 2579 2580 2581 | Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds)); } else { Tcl_DStringInit(&ds); if (TclpHasSockets(NULL) == TCL_OK) { /* | | < | < | | < < | | | 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 | Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds)); } else { Tcl_DStringInit(&ds); if (TclpHasSockets(NULL) == TCL_OK) { /* * The buffer size of 256 is recommended by the MSDN page that * documents gethostname() as being always adequate. */ Tcl_DString inDs; Tcl_DStringInit(&inDs); Tcl_DStringSetLength(&inDs, 256); if (gethostname(Tcl_DStringValue(&inDs), Tcl_DStringLength(&inDs)) == 0) { Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1, &ds); } Tcl_DStringFree(&inDs); } } *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); |
︙ | ︙ |