Tk Source Code

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

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

Overview
Comment:Switch back to using Tcl_UtfToExternalDString() in tkWinFont.c, since - somehow - changing it doesn't work. More usage of implicit WCHAR, since we are always building with UNICODE.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-548
Files: files | file ages | folders
SHA3-256: d0b64851baeb2dfc3ed0e0186202f68ca6c37c7a6783983f3296fca23281643e
User & Date: jan.nijtmans 2019-06-11 15:14:16
Context
2019-06-15
20:56
Merge trunk check-in: 5e217f2e user: jan.nijtmans tags: tip-548
2019-06-11
15:14
Switch back to using Tcl_UtfToExternalDString() in tkWinFont.c, since - somehow - changing it doesn't work. More usage of implicit WCHAR, since we are always building with UNICODE. check-in: d0b64851 user: jan.nijtmans tags: tip-548
12:52
Missing Tcl_DStringInit() call. check-in: 08f54084 user: jan.nijtmans tags: tip-548
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to win/tkWinFont.c.

174
175
176
177
178
179
180






181
182
183
184
185
186
187
...
252
253
254
255
256
257
258

259
260
261
262
263
264
265
...
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
....
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
....
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
....
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
				 * loaded, this list grows to hold information
				 * about what characters exist in each font
				 * family. */
    Tcl_HashTable uidTable;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;







/*
 * Procedures used only in this file.
 */

static FontFamily *	AllocFontFamily(HDC hdc, HFONT hFont, int base);
static SubFont *	CanUseFallback(HDC hdc, WinFont *fontPtr,
			    const char *fallbackName, int ch,
................................................................................
 *-------------------------------------------------------------------------
 */

void
TkpFontPkgInit(
    TkMainInfo *mainPtr)	/* The application being created. */
{

    TkWinSetupSystemFonts(mainPtr);
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TkpGetNativeFont --
................................................................................
static int CALLBACK
WinFontFamilyEnumProc(
    ENUMLOGFONT *lfPtr,		/* Logical-font data. */
    NEWTEXTMETRIC *tmPtr,	/* Physical-font data (not used). */
    int fontType,		/* Type of font (not used). */
    LPARAM lParam)		/* Result object to hold result. */
{
    WCHAR *faceName = (WCHAR *) lfPtr->elfLogFont.lfFaceName;
    Tcl_Obj *resultObj = (Tcl_Obj *) lParam;
    Tcl_DString faceString;

    Tcl_DStringInit(&faceString);
    Tcl_UniCharToUtfDString(faceName, wcslen(faceName), &faceString);
    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
	    Tcl_DStringValue(&faceString), Tcl_DStringLength(&faceString)));
................................................................................

    canUsePtr	    = (CanUse *) lParam;
    ch		    = canUsePtr->ch;
    hdc		    = canUsePtr->hdc;
    fontPtr	    = canUsePtr->fontPtr;
    nameTriedPtr    = canUsePtr->nameTriedPtr;

    fallbackName = (char *)lfPtr->elfLogFont.lfFaceName;
    Tcl_DStringInit(&faceString);
    Tcl_UniCharToUtfDString((WCHAR *)fallbackName, wcslen((WCHAR *)fallbackName), &faceString);
    fallbackName = Tcl_DStringValue(&faceString);

    if (SeenName(fallbackName, nameTriedPtr) == 0) {
	subFontPtr = CanUseFallback(hdc, fontPtr, fallbackName, ch,
		canUsePtr->subFontPtrPtr);
................................................................................
    lf.lfStrikeOut	= faPtr->overstrike;
    lf.lfCharSet	= DEFAULT_CHARSET;
    lf.lfOutPrecision	= OUT_TT_PRECIS;
    lf.lfClipPrecision	= CLIP_DEFAULT_PRECIS;
    lf.lfQuality	= DEFAULT_QUALITY;
    lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;

    Tcl_DStringInit(&ds);
    Tcl_UtfToUniCharDString(faceName, -1, &ds);
    wcsncpy(lf.lfFaceName, (WCHAR *)Tcl_DStringValue(&ds), LF_FACESIZE-1);
    Tcl_DStringFree(&ds);
    lf.lfFaceName[LF_FACESIZE-1] = 0;
    hFont = CreateFontIndirect(&lf);
    return hFont;
}
 
................................................................................
FamilyExists(
    HDC hdc,			/* HDC in which font family will be used. */
    const char *faceName)	/* Font family to query. */
{
    int result;
    Tcl_DString faceString;

    Tcl_DStringInit(&faceString);
    Tcl_UtfToUniCharDString(faceName, -1, &faceString);

    /*
     * If the family exists, WinFontExistProc() will be called and
     * EnumFontFamilies() will return whatever WinFontExistProc() returns. If
     * the family doesn't exist, EnumFontFamilies() will just return a
     * non-zero value.
     */






>
>
>
>
>
>







 







>







 







|







 







|







 







|
<







 







<
|







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
...
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
...
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
....
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
....
2493
2494
2495
2496
2497
2498
2499
2500

2501
2502
2503
2504
2505
2506
2507
....
2528
2529
2530
2531
2532
2533
2534

2535
2536
2537
2538
2539
2540
2541
2542
				 * loaded, this list grows to hold information
				 * about what characters exist in each font
				 * family. */
    Tcl_HashTable uidTable;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Information cached about the system at startup time.
 */

static Tcl_Encoding systemEncoding;

/*
 * Procedures used only in this file.
 */

static FontFamily *	AllocFontFamily(HDC hdc, HFONT hFont, int base);
static SubFont *	CanUseFallback(HDC hdc, WinFont *fontPtr,
			    const char *fallbackName, int ch,
................................................................................
 *-------------------------------------------------------------------------
 */

void
TkpFontPkgInit(
    TkMainInfo *mainPtr)	/* The application being created. */
{
    systemEncoding = TkWinGetUnicodeEncoding();
    TkWinSetupSystemFonts(mainPtr);
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TkpGetNativeFont --
................................................................................
static int CALLBACK
WinFontFamilyEnumProc(
    ENUMLOGFONT *lfPtr,		/* Logical-font data. */
    NEWTEXTMETRIC *tmPtr,	/* Physical-font data (not used). */
    int fontType,		/* Type of font (not used). */
    LPARAM lParam)		/* Result object to hold result. */
{
    WCHAR *faceName = lfPtr->elfLogFont.lfFaceName;
    Tcl_Obj *resultObj = (Tcl_Obj *) lParam;
    Tcl_DString faceString;

    Tcl_DStringInit(&faceString);
    Tcl_UniCharToUtfDString(faceName, wcslen(faceName), &faceString);
    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
	    Tcl_DStringValue(&faceString), Tcl_DStringLength(&faceString)));
................................................................................

    canUsePtr	    = (CanUse *) lParam;
    ch		    = canUsePtr->ch;
    hdc		    = canUsePtr->hdc;
    fontPtr	    = canUsePtr->fontPtr;
    nameTriedPtr    = canUsePtr->nameTriedPtr;

    fallbackName = (char *) lfPtr->elfLogFont.lfFaceName;
    Tcl_DStringInit(&faceString);
    Tcl_UniCharToUtfDString((WCHAR *)fallbackName, wcslen((WCHAR *)fallbackName), &faceString);
    fallbackName = Tcl_DStringValue(&faceString);

    if (SeenName(fallbackName, nameTriedPtr) == 0) {
	subFontPtr = CanUseFallback(hdc, fontPtr, fallbackName, ch,
		canUsePtr->subFontPtrPtr);
................................................................................
    lf.lfStrikeOut	= faPtr->overstrike;
    lf.lfCharSet	= DEFAULT_CHARSET;
    lf.lfOutPrecision	= OUT_TT_PRECIS;
    lf.lfClipPrecision	= CLIP_DEFAULT_PRECIS;
    lf.lfQuality	= DEFAULT_QUALITY;
    lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;

    Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &ds);

    wcsncpy(lf.lfFaceName, (WCHAR *)Tcl_DStringValue(&ds), LF_FACESIZE-1);
    Tcl_DStringFree(&ds);
    lf.lfFaceName[LF_FACESIZE-1] = 0;
    hFont = CreateFontIndirect(&lf);
    return hFont;
}
 
................................................................................
FamilyExists(
    HDC hdc,			/* HDC in which font family will be used. */
    const char *faceName)	/* Font family to query. */
{
    int result;
    Tcl_DString faceString;


    Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &faceString);

    /*
     * If the family exists, WinFontExistProc() will be called and
     * EnumFontFamilies() will return whatever WinFontExistProc() returns. If
     * the family doesn't exist, EnumFontFamilies() will just return a
     * non-zero value.
     */

Changes to win/tkWinInt.h.

113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
#define TkWinGetPalette(colormap) (((TkWinColormap *) colormap)->palette)

/*
 * The following macros define the class names for Tk Window types.
 */

#define TK_WIN_TOPLEVEL_CLASS_NAME TEXT("TkTopLevel")
#define TK_WIN_CHILD_CLASS_NAME TEXT("TkChild")

/*
 * The following variable is a translation table between X gc functions and
 * Win32 raster and BitBlt op modes.
 */

MODULE_SCOPE const int tkpWinRopModes[];






|
|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
#define TkWinGetPalette(colormap) (((TkWinColormap *) colormap)->palette)

/*
 * The following macros define the class names for Tk Window types.
 */

#define TK_WIN_TOPLEVEL_CLASS_NAME L"TkTopLevel"
#define TK_WIN_CHILD_CLASS_NAME L"TkChild"

/*
 * The following variable is a translation table between X gc functions and
 * Win32 raster and BitBlt op modes.
 */

MODULE_SCOPE const int tkpWinRopModes[];

Changes to win/tkWinTest.c.

374
375
376
377
378
379
380
381
382
383
384
385
386

387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
	Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
	Tcl_DStringFree(&ds);
	break;
    }
    case WM_SETTEXT: {
	Tcl_DString ds;

        control = TestFindControl(hwnd, id);
        if (control == NULL) {
            Tcl_SetObjResult(interp,
                             Tcl_ObjPrintf("Could not find control with id %d", id));
            return TCL_ERROR;
        }

	Tcl_UtfToExternalDString(NULL, Tcl_GetString(objv[4]), -1, &ds);
        result = SendMessageA(control, WM_SETTEXT, 0,
                                  (LPARAM) Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
	if (result == 0) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1));
            AppendSystemError(interp, GetLastError());
            return TCL_ERROR;
	}
	break;
    }
    case WM_COMMAND: {
	char buf[TCL_INTEGER_SPACE];
	if (objc < 5) {
	    wParam = MAKEWPARAM(id, 0);






|
|
|
|
|
|
>

|
|


|
|
|







374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
	Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
	Tcl_DStringFree(&ds);
	break;
    }
    case WM_SETTEXT: {
	Tcl_DString ds;

	control = TestFindControl(hwnd, id);
	if (control == NULL) {
	    Tcl_SetObjResult(interp,
		    Tcl_ObjPrintf("Could not find control with id %d", id));
	    return TCL_ERROR;
	}
	Tcl_DStringInit(&ds);
	Tcl_UtfToExternalDString(NULL, Tcl_GetString(objv[4]), -1, &ds);
	result = SendMessageA(control, WM_SETTEXT, 0,
		(LPARAM) Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
	if (result == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1));
	    AppendSystemError(interp, GetLastError());
	    return TCL_ERROR;
	}
	break;
    }
    case WM_COMMAND: {
	char buf[TCL_INTEGER_SPACE];
	if (objc < 5) {
	    wParam = MAKEWPARAM(id, 0);