Tk Source Code

Check-in [d6528cb0]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:More use of Tcl_WinTCharToUtf() in stead of Tcl_UniCharToUtfDString(), making Tk less sensitive to the value of TCL_UTF_MAX (either 3, 4, or 6)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256:d6528cb052bc02305677fcf25373bc44ede5537e22b618e7cf4c0afb0bbf87d0
User & Date: jan.nijtmans 2019-03-19 16:31:21
Context
2019-03-19
22:25
Fixed a typo that was causing extraneous "tkwin == NULL" debug messages in the mac regression tests. check-in: 79c6dea3 user: culler tags: core-8-6-branch
16:33
Merge 8.6 check-in: 3808be4c user: jan.nijtmans tags: trunk
16:31
More use of Tcl_WinTCharToUtf() in stead of Tcl_UniCharToUtfDString(), making Tk less sensitive to the value of TCL_UTF_MAX (either 3, 4, or 6) check-in: d6528cb0 user: jan.nijtmans tags: core-8-6-branch
2019-03-15
20:24
Make Tk run on win32/win64 using -DTCL_UTF_MAX=6. Adapted from androwish. check-in: d55be1ff user: jan.nijtmans tags: core-8-6-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkMain.c.

80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

/*
 * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
 * NewNativeObj is needed (which provides proper conversion from native
 * encoding to UTF-8).
 */

#if defined(UNICODE) && (TCL_UTF_MAX <= 4)
#   define NewNativeObj Tcl_NewUnicodeObj
#else /* !UNICODE || (TCL_UTF_MAX > 4) */
static inline Tcl_Obj *
NewNativeObj(
    TCHAR *string,
    int length)
{
    Tcl_Obj *obj;
    Tcl_DString ds;
................................................................................
#else
    Tcl_ExternalToUtfDString(NULL, (char *) string, length, &ds);
#endif
    obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
    Tcl_DStringFree(&ds);
    return obj;
}
#endif /* !UNICODE || (TCL_UTF_MAX > 4) */

/*
 * 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
 * of the Tk source directory to make their own modified versions). Note: do
 * not declare "exit" here even though a declaration is really needed, because
 * it will conflict with a declaration elsewhere on some systems.







<
<
<







 







<







80
81
82
83
84
85
86



87
88
89
90
91
92
93
...
100
101
102
103
104
105
106

107
108
109
110
111
112
113

/*
 * 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,
    int length)
{
    Tcl_Obj *obj;
    Tcl_DString ds;
................................................................................
#else
    Tcl_ExternalToUtfDString(NULL, (char *) string, length, &ds);
#endif
    obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
    Tcl_DStringFree(&ds);
    return obj;
}


/*
 * 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
 * of the Tk source directory to make their own modified versions). Note: do
 * not declare "exit" here even though a declaration is really needed, because
 * it will conflict with a declaration elsewhere on some systems.

Changes to generic/tkSelect.c.

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

typedef struct {
    Tcl_Interp *interp;		/* Interpreter in which to invoke command. */
    int cmdLength;		/* # of non-NULL bytes in command. */
    int charOffset;		/* The offset of the next char to retrieve. */
    int byteOffset;		/* The expected byte offset of the next
				 * chunk. */
    char buffer[TCL_UTF_MAX];	/* A buffer to hold part of a UTF character
				 * that is split across chunks. */
    char command[1];		/* Command to invoke. Actual space is
				 * allocated as large as necessary. This must
				 * be the last entry in the structure. */
} CommandInfo;

/*







|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

typedef struct {
    Tcl_Interp *interp;		/* Interpreter in which to invoke command. */
    int cmdLength;		/* # of non-NULL bytes in command. */
    int charOffset;		/* The offset of the next char to retrieve. */
    int byteOffset;		/* The expected byte offset of the next
				 * chunk. */
    char buffer[4];	/* A buffer to hold part of a UTF character
				 * that is split across chunks. */
    char command[1];		/* Command to invoke. Actual space is
				 * allocated as large as necessary. This must
				 * be the last entry in the structure. */
} CommandInfo;

/*

Changes to win/tkWinClipboard.c.

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
...
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
    if (IsClipboardFormatAvailable(CF_UNICODETEXT)) {
	handle = GetClipboardData(CF_UNICODETEXT);
	if (!handle) {
	    CloseClipboard();
	    goto error;
	}
	data = GlobalLock(handle);
	Tcl_DStringInit(&ds);
	Tcl_UniCharToUtfDString((Tcl_UniChar *)data,
		Tcl_UniCharLen((Tcl_UniChar *)data), &ds);
	GlobalUnlock(handle);
    } else if (IsClipboardFormatAvailable(CF_TEXT)) {
	/*
	 * Determine the encoding to use to convert this text.
	 */

	if (IsClipboardFormatAvailable(CF_LOCALE)) {
................................................................................
	    Tcl_DString dsTmp;
	    int count = 0, len;

	    while (*fname != 0) {
		if (count) {
		    Tcl_DStringAppend(&ds, "\n", 1);
		}
		len = Tcl_UniCharLen((Tcl_UniChar *) fname);
		Tcl_DStringInit(&dsTmp);
		Tcl_UniCharToUtfDString((Tcl_UniChar *) fname, len, &dsTmp);
		Tcl_DStringAppend(&ds, Tcl_DStringValue(&dsTmp),
			Tcl_DStringLength(&dsTmp));
		Tcl_DStringFree(&dsTmp);
		fname += len + 1;
		count++;
	    }
	    noBackslash = (count > 0);







|
<
<







 







|
<
<







75
76
77
78
79
80
81
82


83
84
85
86
87
88
89
...
151
152
153
154
155
156
157
158


159
160
161
162
163
164
165
    if (IsClipboardFormatAvailable(CF_UNICODETEXT)) {
	handle = GetClipboardData(CF_UNICODETEXT);
	if (!handle) {
	    CloseClipboard();
	    goto error;
	}
	data = GlobalLock(handle);
	Tcl_WinTCharToUtf((TCHAR *)data, -1, &ds);


	GlobalUnlock(handle);
    } else if (IsClipboardFormatAvailable(CF_TEXT)) {
	/*
	 * Determine the encoding to use to convert this text.
	 */

	if (IsClipboardFormatAvailable(CF_LOCALE)) {
................................................................................
	    Tcl_DString dsTmp;
	    int count = 0, len;

	    while (*fname != 0) {
		if (count) {
		    Tcl_DStringAppend(&ds, "\n", 1);
		}
		Tcl_WinTCharToUtf(fname, -1, &dsTmp);


		Tcl_DStringAppend(&ds, Tcl_DStringValue(&dsTmp),
			Tcl_DStringLength(&dsTmp));
		Tcl_DStringFree(&dsTmp);
		fname += len + 1;
		count++;
	    }
	    noBackslash = (count > 0);

Changes to win/tkWinKey.c.

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
	 * trans_chars members.
	 */

	KeySym keysym = KeycodeToKeysym(keyEv->keycode, keyEv->state, 0);

	if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256))
		|| (keysym == XK_Return) || (keysym == XK_Tab)) {
	    len = Tcl_UniCharToUtf((Tcl_UniChar) (keysym & 255), buf);
	    Tcl_DStringAppend(dsPtr, buf, len);
	}
    }
    return Tcl_DStringValue(dsPtr);
}
 
/*







|







118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
	 * trans_chars members.
	 */

	KeySym keysym = KeycodeToKeysym(keyEv->keycode, keyEv->state, 0);

	if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256))
		|| (keysym == XK_Return) || (keysym == XK_Tab)) {
	    len = Tcl_UniCharToUtf(keysym & 255, buf);
	    Tcl_DStringAppend(dsPtr, buf, len);
	}
    }
    return Tcl_DStringValue(dsPtr);
}
 
/*

Changes to win/tkWinMenu.c.

1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
    case WM_MENUCHAR: {
	hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
		(char *) *plParam);
	if (hashEntryPtr != NULL) {
	    int i, len, underline;
	    Tcl_Obj *labelPtr;
	    WCHAR *wlabel;
	    Tcl_UniChar menuChar;
	    Tcl_DString ds;

	    *plResult = 0;
	    menuPtr = Tcl_GetHashValue(hashEntryPtr);
	    /*
	     * Assume we have something directly convertable to Tcl_UniChar.
	     * True at least for wide systems.
	     */
	    menuChar = Tcl_UniCharToUpper((Tcl_UniChar) LOWORD(*pwParam));

	    Tcl_DStringInit(&ds);
	    for (i = 0; i < menuPtr->numEntries; i++) {
		underline = menuPtr->entries[i]->underline;
		labelPtr = menuPtr->entries[i]->labelPtr;
		if ((underline >= 0) && (labelPtr != NULL)) {
		    /*







|








|







1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
    case WM_MENUCHAR: {
	hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
		(char *) *plParam);
	if (hashEntryPtr != NULL) {
	    int i, len, underline;
	    Tcl_Obj *labelPtr;
	    WCHAR *wlabel;
	    int menuChar;
	    Tcl_DString ds;

	    *plResult = 0;
	    menuPtr = Tcl_GetHashValue(hashEntryPtr);
	    /*
	     * Assume we have something directly convertable to Tcl_UniChar.
	     * True at least for wide systems.
	     */
	    menuChar = Tcl_UniCharToUpper(LOWORD(*pwParam));

	    Tcl_DStringInit(&ds);
	    for (i = 0; i < menuPtr->numEntries; i++) {
		underline = menuPtr->entries[i]->underline;
		labelPtr = menuPtr->entries[i]->labelPtr;
		if ((underline >= 0) && (labelPtr != NULL)) {
		    /*