Import Tk 8.6.10

This commit is contained in:
Steve Dower
2020-09-24 22:55:34 +01:00
parent 5ba5cbc9af
commit 42c69189d9
365 changed files with 24323 additions and 12832 deletions

View File

@@ -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 {