diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tkMain.c | 66 |
2 files changed, 38 insertions, 34 deletions
@@ -1,9 +1,3 @@ -2010-11-15 Jan Nijtmans <nijtmans@users.sf.net> - - * generic/tkMain.c: [FRQ 491789]: "setargv() doesn't support a - unicode cmdline" follow-up: Eliminate use of the function - Tcl_WinTCharToUtf in generic code. - 2010-11-10 Andreas Kupries <andreask@activestate.com> * changes: Updates for 8.6b2 release. diff --git a/generic/tkMain.c b/generic/tkMain.c index 12c316f..e0ecdbd 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMain.c,v 1.36 2010/11/15 09:24:11 nijtmans Exp $ + * RCS: @(#) $Id: tkMain.c,v 1.37 2010/11/15 10:10:52 nijtmans Exp $ */ /** @@ -69,25 +69,21 @@ #endif /* - * Further on, in UNICODE mode we need to use Tcl_NewUnicodeObj - * in stead of Tcl_ExternalToUtfDString but they have a different - * signature. So, create a simple wrapper function, that can - * be used in both situations. + * Further on, in UNICODE mode, we need to use functions like + * Tcl_GetUnicodeFromObj, while otherwise Tcl_GetStringFromObj + * is needed. Those macro's assure that the right functions + * are used depending on the mode. */ -#ifdef UNICODE -# define NewNativeObj(value) Tcl_NewUnicodeObj(value, -1) -#else -static Tcl_Obj *NewNativeObj(const TCHAR *value) { - Tcl_DString ds; - Tcl_Obj *obj; - - Tcl_ExternalToUtfDString(NULL, value, -1, &ds); - obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - return obj; -} +#ifndef UNICODE +# undef Tcl_GetUnicodeFromObj +# define Tcl_GetUnicodeFromObj Tcl_GetStringFromObj +# undef Tcl_NewUnicodeObj +# define Tcl_NewUnicodeObj Tcl_NewStringObj +# undef Tcl_WinTCharToUtf +# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) #endif /* !UNICODE */ + /* * Declarations for various library functions and variables (don't want to * include tkInt.h or tkPort.h here, because people might copy this file out @@ -98,6 +94,7 @@ static Tcl_Obj *NewNativeObj(const TCHAR *value) { #if !defined(__WIN32__) && !defined(_WIN32) extern int isatty(int fd); +extern char * strrchr(const char *string, int c); #endif typedef struct ThreadSpecificData { @@ -150,12 +147,13 @@ Tk_MainEx( { Tcl_Obj *path, *argvPtr; const char *encodingName; - int code, nullStdin = 0; + int code, length, nullStdin = 0; Tcl_Channel inChannel, outChannel; ThreadSpecificData *tsdPtr; #ifdef __WIN32__ HANDLE handle; #endif + Tcl_DString appName; /* * Ensure that we are getting a compatible version of Tcl. This is really @@ -194,28 +192,28 @@ Tk_MainEx( /* * Check whether first 3 args (argv[1] - argv[3]) look like - * -encoding ENCODING FILENAME + * -encoding ENCODING FILENAME * or like - * FILENAME + * FILENAME * or like - * -file FILENAME (ancient history support only) + * -file FILENAME (ancient history support only) */ if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) && (TEXT('-') != argv[3][0])) { - Tcl_Obj *value = NewNativeObj(argv[2]); - Tcl_SetStartupScript(NewNativeObj(argv[3]), Tcl_GetString(value)); + Tcl_Obj *value = Tcl_NewUnicodeObj(argv[2], -1); + Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[3], -1), Tcl_GetString(value)); Tcl_DecrRefCount(value); argc -= 3; argv += 3; } else if ((argc > 1) && (TEXT('-') != argv[1][0])) { - Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL); + Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[1], -1), NULL); argc--; argv++; } else if ((argc > 2) && (length = _tcslen(argv[1])) && (length > 1) && (0 == _tcsncmp(TEXT("-file"), argv[1], length)) && (TEXT('-') != argv[2][0])) { - Tcl_SetStartupScript(NewNativeObj(argv[2]), NULL); + Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[2], -1), NULL); argc -= 2; argv += 2; } @@ -223,9 +221,16 @@ Tk_MainEx( path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { - path = NewNativeObj(argv[0]); + Tcl_WinTCharToUtf(argv[0], -1, &appName); + } else { + const TCHAR *pathName = Tcl_GetUnicodeFromObj(path, &length); + + Tcl_WinTCharToUtf(pathName, length * sizeof(TCHAR), &appName); + path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1); + Tcl_SetStartupScript(path, encodingName); } - Tcl_SetVar2Ex(interp, "argv0", NULL, path, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); + Tcl_DStringFree(&appName); argc--; argv++; @@ -233,7 +238,12 @@ Tk_MainEx( argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { - Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++)); + Tcl_DString ds; + + Tcl_WinTCharToUtf(*argv++, -1, &ds); + Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj( + Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); + Tcl_DStringFree(&ds); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); |