diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclMain.c | 56 |
2 files changed, 29 insertions, 33 deletions
@@ -1,3 +1,9 @@ +2010-11-15 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclMain.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/tclMain.c b/generic/tclMain.c index a94d68d..3acc7f9 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMain.c,v 1.55 2010/11/05 08:16:46 nijtmans Exp $ + * RCS: @(#) $Id: tclMain.c,v 1.56 2010/11/15 09:21:49 nijtmans Exp $ */ /** @@ -47,23 +47,26 @@ # define TCHAR char # define TEXT(arg) arg # define _tcscmp strcmp -# define _tcslen strlen -# define _tcsncmp strncmp #endif /* - * 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. + * 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. */ -#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) +#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; +} #endif /* !UNICODE */ /* @@ -302,7 +305,6 @@ Tcl_MainEx( int code, length, tty, exitCode = 0; Tcl_MainLoopProc *mainLoopProc; Tcl_Channel inChannel, outChannel, errChannel; - Tcl_DString appName; Tcl_InitMemory(interp); @@ -322,13 +324,13 @@ Tcl_MainEx( if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) && (TEXT('-') != argv[3][0])) { - Tcl_Obj *value = Tcl_NewUnicodeObj(argv[2], -1); - Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[3], -1), Tcl_GetString(value)); + Tcl_Obj *value = NewNativeObj(argv[2]); + Tcl_SetStartupScript(NewNativeObj(argv[3]), Tcl_GetString(value)); Tcl_DecrRefCount(value); argc -= 3; argv += 3; } else if ((argc > 1) && (TEXT('-') != argv[1][0])) { - Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[1], -1), NULL); + Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL); argc--; argv++; } @@ -336,16 +338,9 @@ Tcl_MainEx( path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { - 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); + path = NewNativeObj(argv[0]); } - Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); - Tcl_DStringFree(&appName); + Tcl_SetVar2Ex(interp, "argv0", NULL, path, TCL_GLOBAL_ONLY); argc--; argv++; @@ -353,12 +348,7 @@ Tcl_MainEx( argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { - Tcl_DString ds; - - Tcl_WinTCharToUtf(*argv++, -1, &ds); - Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj( - Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); - Tcl_DStringFree(&ds); + Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++)); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); |