diff options
| -rw-r--r-- | generic/tclCmdAH.c | 39 | ||||
| -rw-r--r-- | generic/tclInt.decls | 3 | ||||
| -rw-r--r-- | generic/tclIntPlatDecls.h | 16 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 6 | ||||
| -rw-r--r-- | tests/cmdAH.test | 2 | ||||
| -rw-r--r-- | win/tclWinInit.c | 48 |
6 files changed, 109 insertions, 5 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index ea98a83..9970b0e 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -53,6 +53,11 @@ static Tcl_ObjCmdProc EncodingDirsObjCmd; static Tcl_ObjCmdProc EncodingNamesObjCmd; static Tcl_ObjCmdProc EncodingProfilesObjCmd; static Tcl_ObjCmdProc EncodingSystemObjCmd; +#ifdef _WIN32 +static Tcl_ObjCmdProc EncodingUserObjCmd; +#else +# define EncodingUserObjCmd EncodingSystemObjCmd +#endif static inline int ForeachAssignments(Tcl_Interp *interp, struct ForeachState *statePtr); static inline void ForeachCleanup(Tcl_Interp *interp, @@ -394,6 +399,7 @@ TclInitEncodingCmd( {"names", EncodingNamesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"profiles", EncodingProfilesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"system", EncodingSystemObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, + {"user", EncodingUserObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -829,6 +835,39 @@ EncodingSystemObjCmd( } /* + *----------------------------------------------------------------------------- + * + * EncodingUserObjCmd -- + * + * This command retrieves the encoding as per the user settings. + * + * Results: + * Returns a standard Tcl result + * + *----------------------------------------------------------------------------- + */ + +#ifdef _WIN32 +int +EncodingUserObjCmd( + TCL_UNUSED(void *), + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Number of command line args */ + Tcl_Obj* const objv[]) /* Vector of command line args */ +{ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + const char *encodingName = Tcl_GetEncodingName(TclWinGetUserEncoding(interp)); + if (encodingName) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(encodingName, -1)); + } + return TCL_OK; +} +#endif + +/* *---------------------------------------------------------------------- * * Tcl_ErrorObjCmd -- diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 17cad13..a0efa13 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -683,6 +683,9 @@ declare 8 { declare 9 { TclFile TclpCreateTempFile(const char *contents) } +declare 10 { + Tcl_Encoding TclWinGetUserEncoding(Tcl_Interp *interp) +} declare 11 { void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) } diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index aab3737..527536e 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -547,7 +547,8 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode); EXTERN Tcl_Size TclpGetPid(Tcl_Pid pid); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); -/* Slot 10 is reserved */ +/* 10 */ +EXTERN Tcl_Encoding TclWinGetUserEncoding(Tcl_Interp *interp); /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); @@ -600,7 +601,7 @@ typedef struct TclIntPlatStubs { TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ Tcl_Size (*tclpGetPid) (Tcl_Pid pid); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - void (*reserved10)(void); + Tcl_Encoding (*tclWinGetUserEncoding) (Tcl_Interp *interp); /* 10 */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ void (*reserved12)(void); void (*reserved13)(void); @@ -654,7 +655,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -/* Slot 10 is reserved */ +#define TclWinGetUserEncoding \ + (tclIntPlatStubsPtr->tclWinGetUserEncoding) /* 10 */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ /* Slot 12 is reserved */ @@ -736,4 +738,12 @@ MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp, # define TclpGetPid(pid) ((Tcl_Size)(pid)) #endif +#ifdef USE_TCL_STUBS +/* Protect TclWinGetUserEncoding() for environments it doen't exist, e.g. Tcl 9.0.0/9.0.1 */ +#undef TclWinGetUserEncoding +#define TclWinGetUserEncoding(interp) \ + (tclIntPlatStubsPtr->tclWinGetUserEncoding ? tclIntPlatStubsPtr->tclWinGetUserEncoding(interp) : NULL) +#endif + + #endif /* _TCLINTPLATDECLS */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 9bfce36..73e8765 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -69,6 +69,10 @@ # undef Tcl_WinConvertError # define Tcl_WinConvertError 0 #endif +#if !defined(_WIN32) /* TODO: implement for Cygwin too */ +# undef TclWinGetUserEncoding +# define TclWinGetUserEncoding 0 +#endif #undef TclGetStringFromObj #if defined(TCL_NO_DEPRECATED) # define TclGetStringFromObj 0 @@ -692,7 +696,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpOpenFile, /* 7 */ TclpGetPid, /* 8 */ TclpCreateTempFile, /* 9 */ - 0, /* 10 */ + TclWinGetUserEncoding, /* 10 */ TclGetAndDetachPids, /* 11 */ 0, /* 12 */ 0, /* 13 */ diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 50e49e8..7b9e4f3 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -323,7 +323,7 @@ test cmdAH-4.1.1 {encoding} -returnCodes error -body { } -result {wrong # args: should be "encoding subcommand ?arg ...?"} test cmdAH-4.1.2 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding foo -} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, profiles, or system} +} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, profiles, system, or user} # # encoding system 4.2.* diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 079b1c8..0034ba0 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -453,6 +453,54 @@ TclpSetInitialEncodings(void) Tcl_DStringFree(&encodingName); } +static Tcl_Encoding userEncoding = NULL; + +/* + *--------------------------------------------------------------------------- + * + * TclWinGetUserEncoding -- + * + * Determines the encoding corresponding to the GetACP() call. + * Since GetACP() cannot be thrusted, poke the + * value from the registry directly. + * + * Results: + * The found encoding. Or NULL if the encoding cannot be found. + * + * Side effects: + * The returned encoding is valid until a future TclWinGetUserEncoding() + * call determines that the ACP encoding changed. That should never happen. + * + *--------------------------------------------------------------------------- + */ +Tcl_Encoding +TclWinGetUserEncoding(Tcl_Interp *interp) +{ + WCHAR buf[32] = L"cp"; + + HKEY hKey; + DWORD type = -1; + DWORD size=sizeof(buf) - 2; + Tcl_DString ds; + RegOpenKeyExW(HKEY_LOCAL_MACHINE, L"SYSTEM\\CurrentControlSet\\Control\\Nls\\CodePage", + 0, KEY_READ, &hKey); + RegQueryValueExW(hKey, L"ACP", NULL, &type, (BYTE *)&buf[2], &size); + RegCloseKey(hKey); + if (!wcscmp(buf, L"cp65001")) { + wcscpy(buf, L"utf-8"); + } + Tcl_DStringInit(&ds); + Tcl_WCharToUtfDString(buf, -1, &ds); + if (!userEncoding || strcmp(Tcl_GetEncodingName(userEncoding), Tcl_DStringValue(&ds))) { + if (userEncoding) { + Tcl_FreeEncoding(userEncoding); + } + userEncoding = Tcl_GetEncoding(interp, Tcl_DStringValue(&ds)); + } + Tcl_DStringFree(&ds); + return userEncoding; +} + const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) |