Import Tk 8.6.10
This commit is contained in:
@@ -45,7 +45,7 @@ extern int TkCygwinMainEx(int, char **, Tcl_AppInitProc *, Tcl_Interp *);
|
||||
* The default prompt used when the user has not overridden it.
|
||||
*/
|
||||
|
||||
#define DEFAULT_PRIMARY_PROMPT "% "
|
||||
static const char DEFAULT_PRIMARY_PROMPT[] = "% ";
|
||||
|
||||
/*
|
||||
* This file can be compiled on Windows in UNICODE mode, as well as
|
||||
@@ -79,22 +79,27 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj,
|
||||
* while otherwise NewNativeObj is needed (which provides proper
|
||||
* conversion from native encoding to UTF-8).
|
||||
* Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
|
||||
* NewNativeObj is needed (which provides proper conversion from native
|
||||
* encoding to UTF-8).
|
||||
*/
|
||||
|
||||
static inline Tcl_Obj *
|
||||
NewNativeObj(
|
||||
TCHAR *string)
|
||||
{
|
||||
Tcl_Obj *obj;
|
||||
Tcl_DString ds;
|
||||
|
||||
#ifdef UNICODE
|
||||
# define NewNativeObj Tcl_NewUnicodeObj
|
||||
#else /* !UNICODE */
|
||||
static Tcl_Obj *NewNativeObj(char *string, int length) {
|
||||
Tcl_Obj *obj;
|
||||
Tcl_DString ds;
|
||||
Tcl_ExternalToUtfDString(NULL, string, length, &ds);
|
||||
obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
|
||||
Tcl_DStringFree(&ds);
|
||||
return obj;
|
||||
Tcl_WinTCharToUtf(string, -1, &ds);
|
||||
#else
|
||||
Tcl_ExternalToUtfDString(NULL, (char *) string, -1, &ds);
|
||||
#endif
|
||||
obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
|
||||
Tcl_DStringFree(&ds);
|
||||
return obj;
|
||||
}
|
||||
#endif /* !UNICODE */
|
||||
|
||||
/*
|
||||
* Declarations for various library functions and variables (don't want to
|
||||
@@ -235,7 +240,7 @@ Tk_MainEx(
|
||||
is.gotPartial = 0;
|
||||
Tcl_Preserve(interp);
|
||||
|
||||
#if defined(_WIN32) && !defined(__CYGWIN__)
|
||||
#if defined(_WIN32)
|
||||
#if !defined(STATIC_BUILD)
|
||||
/* If compiled for Win32 but running on Cygwin, don't use console */
|
||||
if (!tclStubsPtr->reserved9)
|
||||
@@ -269,19 +274,19 @@ Tk_MainEx(
|
||||
|
||||
if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
|
||||
&& (TEXT('-') != argv[3][0])) {
|
||||
Tcl_Obj *value = NewNativeObj(argv[2], -1);
|
||||
Tcl_SetStartupScript(NewNativeObj(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(NewNativeObj(argv[1], -1), NULL);
|
||||
Tcl_SetStartupScript(NewNativeObj(argv[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], -1), NULL);
|
||||
Tcl_SetStartupScript(NewNativeObj(argv[2]), NULL);
|
||||
argc -= 2;
|
||||
argv += 2;
|
||||
}
|
||||
@@ -289,7 +294,7 @@ Tk_MainEx(
|
||||
|
||||
path = Tcl_GetStartupScript(&encodingName);
|
||||
if (path == NULL) {
|
||||
appName = NewNativeObj(argv[0], -1);
|
||||
appName = NewNativeObj(argv[0]);
|
||||
} else {
|
||||
appName = path;
|
||||
}
|
||||
@@ -301,7 +306,7 @@ Tk_MainEx(
|
||||
|
||||
argvPtr = Tcl_NewListObj(0, NULL);
|
||||
while (argc--) {
|
||||
Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
|
||||
Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++));
|
||||
}
|
||||
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
|
||||
|
||||
@@ -431,7 +436,7 @@ StdinProc(
|
||||
|
||||
count = Tcl_Gets(chan, &isPtr->line);
|
||||
|
||||
if (count < 0 && !isPtr->gotPartial) {
|
||||
if (count == -1 && !isPtr->gotPartial) {
|
||||
if (isPtr->tty) {
|
||||
Tcl_Exit(0);
|
||||
} else {
|
||||
@@ -519,7 +524,7 @@ Prompt(
|
||||
chan = Tcl_GetStdChannel(TCL_STDOUT);
|
||||
if (chan != NULL) {
|
||||
Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
|
||||
strlen(DEFAULT_PRIMARY_PROMPT));
|
||||
sizeof(DEFAULT_PRIMARY_PROMPT) - 1);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
|
||||
Reference in New Issue
Block a user