summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tkMain.c66
2 files changed, 38 insertions, 34 deletions
diff --git a/ChangeLog b/ChangeLog
index d17a512..443840e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);