Tk Source Code

Check-in [d55be1ff]
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:Make Tk run on win32/win64 using -DTCL_UTF_MAX=6. Adapted from androwish.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: d55be1ff372d824ec0e2beae21e36f6f372b3f0acaec5d9444385632cb95b372
User & Date: jan.nijtmans 2019-03-15 20:24:47
Context
2019-03-19
22:13
Fixed a typo that was causing extraneous "tkwin == NULL" debug messages in the mac regression tests. Closed-Leaf check-in: bd7621bc user: culler tags: mistake
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:28
Merge 8.6 check-in: 8d31bf8b user: jan.nijtmans tags: trunk
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
2019-03-14
21:01
Fix [609e0045f5]: MouseWheel binding for canvas on MacOS provides wrong values for %x %y check-in: d0405802 user: fvogel tags: core-8-6-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkFocus.c.

626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
...
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
	tlFocusPtr->topLevelPtr = topLevelPtr;
	tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
	winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
    }
    tlFocusPtr->focusWinPtr = winPtr;

    if (topLevelPtr->flags & TK_EMBEDDED) {
			
	/*
	 * We are assigning focus to an embedded toplevel.  The platform
	 * specific function TkpClaimFocus needs to handle the job of
	 * assigning focus to the container, since we have no way to find the
	 * contaiuner.
	 */

................................................................................
    } else if ((displayFocusPtr->focusWinPtr != NULL) || force) {

	/*
	 * If we are forcing removal of focus from a container hosting a
	 * toplevel from a different application, clear the focus in that
	 * application.
	 */
	
    	if (force) {
	    TkWindow *focusPtr = winPtr->dispPtr->focusPtr;
	    if (focusPtr && focusPtr->mainPtr != winPtr->mainPtr) {
		DisplayFocusInfo *displayFocusPtr2 = FindDisplayFocusInfo(
		    focusPtr->mainPtr, focusPtr->dispPtr);
		displayFocusPtr2->focusWinPtr = NULL;
	    }
    	}

	/*
	 * Call the platform specific function TkpChangeFocus to move the
	 * window manager's focus to a new toplevel.
	 */
	
	serial = TkpChangeFocus(TkpGetWrapperWindow(topLevelPtr), force);
	if (serial != 0) {
	    displayFocusPtr->focusSerial = serial;
	}
	GenerateFocusEvents(displayFocusPtr->focusWinPtr, winPtr);
	displayFocusPtr->focusWinPtr = winPtr;
	winPtr->dispPtr->focusPtr = winPtr;






|







 







|













|







626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
...
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
	tlFocusPtr->topLevelPtr = topLevelPtr;
	tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
	winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
    }
    tlFocusPtr->focusWinPtr = winPtr;

    if (topLevelPtr->flags & TK_EMBEDDED) {

	/*
	 * We are assigning focus to an embedded toplevel.  The platform
	 * specific function TkpClaimFocus needs to handle the job of
	 * assigning focus to the container, since we have no way to find the
	 * contaiuner.
	 */

................................................................................
    } else if ((displayFocusPtr->focusWinPtr != NULL) || force) {

	/*
	 * If we are forcing removal of focus from a container hosting a
	 * toplevel from a different application, clear the focus in that
	 * application.
	 */

    	if (force) {
	    TkWindow *focusPtr = winPtr->dispPtr->focusPtr;
	    if (focusPtr && focusPtr->mainPtr != winPtr->mainPtr) {
		DisplayFocusInfo *displayFocusPtr2 = FindDisplayFocusInfo(
		    focusPtr->mainPtr, focusPtr->dispPtr);
		displayFocusPtr2->focusWinPtr = NULL;
	    }
    	}

	/*
	 * Call the platform specific function TkpChangeFocus to move the
	 * window manager's focus to a new toplevel.
	 */

	serial = TkpChangeFocus(TkpGetWrapperWindow(topLevelPtr), force);
	if (serial != 0) {
	    displayFocusPtr->focusSerial = serial;
	}
	GenerateFocusEvents(displayFocusPtr->focusWinPtr, winPtr);
	displayFocusPtr->focusWinPtr = winPtr;
	winPtr->dispPtr->focusPtr = winPtr;

Changes to generic/tkImgGIF.c.

1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
    /*
     * Now read until the final zero byte.
     * It was observed that there might be 1 length blocks
     * (test imgPhoto-14.1) which are not read.
     *
     * The field "stack" is abused for temporary buffer. it has 4096 bytes
     * and we need 256.
     * 
     * Loop until we hit a 0 length block which is the end sign.
     */
    while ( 0 < (count = GetDataBlock(gifConfPtr, chan, stack)))
    {
	if (-1 == count ) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error reading GIF image: %s", Tcl_PosixError(interp)));






|







1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
    /*
     * Now read until the final zero byte.
     * It was observed that there might be 1 length blocks
     * (test imgPhoto-14.1) which are not read.
     *
     * The field "stack" is abused for temporary buffer. it has 4096 bytes
     * and we need 256.
     *
     * Loop until we hit a 0 length block which is the end sign.
     */
    while ( 0 < (count = GetDataBlock(gifConfPtr, chan, stack)))
    {
	if (-1 == count ) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error reading GIF image: %s", Tcl_PosixError(interp)));

Changes to generic/tkMain.c.

75
76
77
78
79
80
81
82
83
84
85
86


87
88

89



90
91







92

93
94
95
96
97
98
99
100
101
102
103
104
#endif

#ifdef MAC_OSX_TK
#include "tkMacOSXInt.h"
#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).
 */
#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;
}
#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
 * 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.






|
|
|

<
>
>

|
>
|
>
>
>
|
|
>
>
>
>
>
>
>
|
>
|
|
|

|







75
76
77
78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
#endif

#ifdef MAC_OSX_TK
#include "tkMacOSXInt.h"
#endif

/*
 * 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;

#ifdef UNICODE
    if (length > 0) {
	length *= sizeof(WCHAR);
    }
    Tcl_WinTCharToUtf(string, length, &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.

Changes to unix/tkUnixMenu.c.

853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
    const Tk_FontMetrics *fmPtr,/* The precalculated font metrics */
    int x, int y,
    int width, int height)
{
    if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) {
	int len;

	/*
	 * Do the unicode call just to prevent overruns.
	 */

	Tcl_GetUnicodeFromObj(mePtr->labelPtr, &len);
	if (mePtr->underline < len) {
	    int activeBorderWidth, leftEdge;
	    const char *label, *start, *end;

	    label = Tcl_GetString(mePtr->labelPtr);
	    start = Tcl_UtfAtIndex(label, mePtr->underline);
	    end = Tcl_UtfNext(start);






<
<
<
<
|







853
854
855
856
857
858
859




860
861
862
863
864
865
866
867
    const Tk_FontMetrics *fmPtr,/* The precalculated font metrics */
    int x, int y,
    int width, int height)
{
    if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) {
	int len;





	len = Tcl_GetCharLength(mePtr->labelPtr);
	if (mePtr->underline < len) {
	    int activeBorderWidth, leftEdge;
	    const char *label, *start, *end;

	    label = Tcl_GetString(mePtr->labelPtr);
	    start = Tcl_UtfAtIndex(label, mePtr->underline);
	    end = Tcl_UtfNext(start);

Changes to win/tkWinDialog.c.

2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920

2921
2922
2923
2924
2925
2926
2927
	    }
	}
	flags = buttonFlagMap[defaultBtnIdx];
    }

    flags |= icon | type | MB_TASKMODAL | MB_SETFOREGROUND;

    tmpObj = messageObj ? Tcl_DuplicateObj(messageObj)
	    : Tcl_NewUnicodeObj(NULL, 0);
    Tcl_IncrRefCount(tmpObj);
    if (detailObj) {
	const Tcl_UniChar twoNL[] = { '\n', '\n' };

	Tcl_AppendUnicodeToObj(tmpObj, twoNL, 2);

	Tcl_AppendObjToObj(tmpObj, detailObj);
    }

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);

    /*
     * MessageBoxW exists for all platforms. Use it to allow unicode error






|
<


<
<
<
>







2907
2908
2909
2910
2911
2912
2913
2914

2915
2916



2917
2918
2919
2920
2921
2922
2923
2924
	    }
	}
	flags = buttonFlagMap[defaultBtnIdx];
    }

    flags |= icon | type | MB_TASKMODAL | MB_SETFOREGROUND;

    tmpObj = messageObj ? Tcl_DuplicateObj(messageObj) : Tcl_NewObj();

    Tcl_IncrRefCount(tmpObj);
    if (detailObj) {



	Tcl_AppendStringsToObj(tmpObj, "\n\n", NULL);
	Tcl_AppendObjToObj(tmpObj, detailObj);
    }

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);

    /*
     * MessageBoxW exists for all platforms. Use it to allow unicode error

Changes to win/tkWinMenu.c.

1245
1246
1247
1248
1249
1250
1251

1252

1253
1254
1255
1256
1257
1258
1259
1260
1261

1262
1263
1264
1265
1266
1267
1268
1269



1270
1271
1272
1273
1274
1275
1276
1277

1278
1279
1280
1281
1282
1283
1284
....
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
....
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
    case WM_MENUCHAR: {
	hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
		(char *) *plParam);
	if (hashEntryPtr != NULL) {
	    int i, len, underline;
	    Tcl_Obj *labelPtr;

	    Tcl_UniChar *wlabel, menuChar;


	    *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));


	    for (i = 0; i < menuPtr->numEntries; i++) {
		underline = menuPtr->entries[i]->underline;
		labelPtr = menuPtr->entries[i]->labelPtr;
		if ((underline >= 0) && (labelPtr != NULL)) {
		    /*
		     * Ensure we don't exceed the label length, then check
		     */
		    wlabel = Tcl_GetUnicodeFromObj(labelPtr, &len);



		    if ((underline < len) && (menuChar ==
				Tcl_UniCharToUpper(wlabel[underline]))) {
			*plResult = (2 << 16) | i;
			returnResult = 1;
			break;
		    }
		}
	    }

	}
	break;
    }

    case WM_MEASUREITEM: {
	LPMEASUREITEMSTRUCT itemPtr = (LPMEASUREITEMSTRUCT) *plParam;

................................................................................
    int y,			/* Top Edge */
    int width,			/* Width of entry */
    int height)			/* Height of entry */
{
    if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) {
	int len;

	/* do the unicode call just to prevent overruns */
	Tcl_GetUnicodeFromObj(mePtr->labelPtr, &len);
	if (mePtr->underline < len) {
	    const char *label, *start, *end;

	    label = Tcl_GetString(mePtr->labelPtr);
	    start = Tcl_UtfAtIndex(label, mePtr->underline);
	    end = Tcl_UtfNext(start);
	    Tk_UnderlineChars(menuPtr->display, d,
................................................................................
    }

    if (mePtr->state == ENTRY_DISABLED) {
	if (menuPtr->disabledFgPtr == NULL) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
		    (unsigned) width, (unsigned) height);
	} else if ((mePtr->image != NULL)
		&& (menuPtr->disabledImageGC != NULL)) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    leftEdge + imageXOffset,
		    (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset),
		    (unsigned) imageWidth, (unsigned) imageHeight);
	}
    }
}






>
|
>









>







|
>
>
>








>







 







<
|







 







|







1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
....
2073
2074
2075
2076
2077
2078
2079

2080
2081
2082
2083
2084
2085
2086
2087
....
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
    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)) {
		    /*
		     * Ensure we don't exceed the label length, then check
		     */
		    const char *src = Tcl_GetStringFromObj(labelPtr, &len);

		    Tcl_DStringFree(&ds);
		    wlabel = (WCHAR *) Tcl_WinUtfToTChar(src, len, &ds);
		    if ((underline < len) && (menuChar ==
				Tcl_UniCharToUpper(wlabel[underline]))) {
			*plResult = (2 << 16) | i;
			returnResult = 1;
			break;
		    }
		}
	    }
	    Tcl_DStringFree(&ds);
	}
	break;
    }

    case WM_MEASUREITEM: {
	LPMEASUREITEMSTRUCT itemPtr = (LPMEASUREITEMSTRUCT) *plParam;

................................................................................
    int y,			/* Top Edge */
    int width,			/* Width of entry */
    int height)			/* Height of entry */
{
    if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) {
	int len;


	len = Tcl_GetCharLength(mePtr->labelPtr);
	if (mePtr->underline < len) {
	    const char *label, *start, *end;

	    label = Tcl_GetString(mePtr->labelPtr);
	    start = Tcl_UtfAtIndex(label, mePtr->underline);
	    end = Tcl_UtfNext(start);
	    Tk_UnderlineChars(menuPtr->display, d,
................................................................................
    }

    if (mePtr->state == ENTRY_DISABLED) {
	if (menuPtr->disabledFgPtr == NULL) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
		    (unsigned) width, (unsigned) height);
	} else if ((mePtr->image != NULL)
		&& menuPtr->disabledImageGC) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    leftEdge + imageXOffset,
		    (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset),
		    (unsigned) imageWidth, (unsigned) imageHeight);
	}
    }
}

Changes to win/ttkWinXPTheme.c.

451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
...
825
826
827
828
829
830
831



832
833
834
835


836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853

854
855
856
857
858
859
860
861
862
863
864



865
866
867
868


869
870
871
872
873
874
875
876
877
878


879
880
881
882
883
884
885
....
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113

1114
1115
1116
1117
1118
1119
1120
....
1124
1125
1126
1127
1128
1129
1130
1131

1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
....
1213
1214
1215
1216
1217
1218
1219

1220
1221
1222
1223
1224
1225
1226
....
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249

1250




1251
1252
1253
1254
1255
1256
1257
 */

static int
InitElementData(ElementData *elementData, Tk_Window tkwin, Drawable d)
{
    Window win = Tk_WindowId(tkwin);

    if (win != None) {
	elementData->hwnd = Tk_GetHWND(win);
    } else  {
	elementData->hwnd = elementData->procs->stubWindow;
    }

    elementData->hTheme = elementData->procs->OpenThemeData(
	elementData->hwnd, elementData->info->className);
................................................................................
    void *clientData, void *elementRecord, Tk_Window tkwin,
    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
{
    TextElement *element = elementRecord;
    ElementData *elementData = clientData;
    RECT rc = {0, 0};
    HRESULT hr = S_OK;




    if (!InitElementData(elementData, tkwin, 0))
	return;



    hr = elementData->procs->GetThemeTextExtent(
	    elementData->hTheme,
	    elementData->hDC,
	    elementData->info->partId,
	    Ttk_StateTableLookup(elementData->info->statemap, 0),
	    Tcl_GetUnicode(element->textObj),
	    -1,
	    DT_LEFT,// | DT_BOTTOM | DT_NOPREFIX,
	    NULL,
	    &rc);

    if (SUCCEEDED(hr)) {
	*widthPtr = rc.right - rc.left;
	*heightPtr = rc.bottom - rc.top;
    }
    if (*widthPtr < 80) *widthPtr = 80;
    if (*heightPtr < 20) *heightPtr = 20;


    FreeElementData(elementData);
}

static void TextElementDraw(
    ClientData clientData, void *elementRecord, Tk_Window tkwin,
    Drawable d, Ttk_Box b, unsigned int state)
{
    TextElement *element = elementRecord;
    ElementData *elementData = clientData;
    RECT rc = BoxToRect(b);
    HRESULT hr = S_OK;




    if (!InitElementData(elementData, tkwin, d))
	return;



    hr = elementData->procs->DrawThemeText(
	    elementData->hTheme,
	    elementData->hDC,
	    elementData->info->partId,
	    Ttk_StateTableLookup(elementData->info->statemap, state),
	    Tcl_GetUnicode(element->textObj),
	    -1,
	    DT_LEFT,// | DT_BOTTOM | DT_NOPREFIX,
	    (state & TTK_STATE_DISABLED) ? DTT_GRAYED : 0,
	    &rc);


    FreeElementData(elementData);
}

static Ttk_ElementSpec TextElementSpec =
{
    TK_STYLE_VERSION_2,
    sizeof(TextElement),
................................................................................
    const char *elementName,
    int objc,
    Tcl_Obj *const objv[])
{
    XPThemeData *themeData = clientData;
    ElementInfo *elementPtr = NULL;
    ClientData elementData;
    Tcl_UniChar *className;
    int partId = 0;
    Ttk_StateTable *stateTable;
    Ttk_Padding pad = {0, 0, 0, 0};
    int flags = 0;
    int length = 0;
    char *name;
    LPWSTR wname;
    Ttk_ElementSpec *elementSpec = &GenericElementSpec;


    static const char *optionStrings[] =
	{ "-padding","-width","-height","-margins", "-syssize",
	  "-halfheight", "-halfwidth", NULL };
    enum { O_PADDING, O_WIDTH, O_HEIGHT, O_MARGINS, O_SYSSIZE,
	   O_HALFHEIGHT, O_HALFWIDTH };

................................................................................
	Tcl_SetErrorCode(interp, "TTK", "VSAPI", "REQUIRED", NULL);
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &partId) != TCL_OK) {
	return TCL_ERROR;
    }
    className = Tcl_GetUnicodeFromObj(objv[0], &length);


    /* flags or padding */
    if (objc > 3) {
	int i = 3, option = 0;
	for (i = 3; i < objc; i += 2) {
	    int tmp = 0;
	    if (i == objc -1) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"Missing value for \"%s\".",
			Tcl_GetString(objv[i])));
		Tcl_SetErrorCode(interp, "TTK", "VSAPI", "MISSING", NULL);
		return TCL_ERROR;
	    }
	    if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
		    sizeof(char *), "option", 0, &option) != TCL_OK)
		return TCL_ERROR;
	    switch (option) {
	    case O_PADDING:
		if (Ttk_GetBorderFromObj(interp, objv[i+1], &pad) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case O_MARGINS:
		if (Ttk_GetBorderFromObj(interp, objv[i+1], &pad) != TCL_OK) {
		    return TCL_ERROR;
		}
		flags |= PAD_MARGINS;
		break;
	    case O_WIDTH:
		if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		pad.left = pad.right = tmp;
		flags |= IGNORE_THEMESIZE;
		break;
	    case O_HEIGHT:
		if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		pad.top = pad.bottom = tmp;
		flags |= IGNORE_THEMESIZE;
		break;
	    case O_SYSSIZE:
		if (GetSysFlagFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		elementSpec = &GenericSizedElementSpec;
		flags |= (tmp & 0xFFFF);
		break;
	    case O_HALFHEIGHT:
		if (Tcl_GetBooleanFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp)
		    flags |= HALF_HEIGHT;
		break;
	    case O_HALFWIDTH:
		if (Tcl_GetBooleanFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp)
		    flags |= HALF_WIDTH;
		break;
	    }
	}
    }

    /* convert a statemap into a state table */
    if (objc > 2) {
	Tcl_Obj **specs;
	int n,j,count, status = TCL_OK;
	if (Tcl_ListObjGetElements(interp, objv[2], &count, &specs) != TCL_OK)
	    return TCL_ERROR;
	/* we over-allocate to ensure there is a terminating entry */
	stateTable = ckalloc(sizeof(Ttk_StateTable) * (count + 1));
	memset(stateTable, 0, sizeof(Ttk_StateTable) * (count + 1));
	for (n = 0, j = 0; status == TCL_OK && n < count; n += 2, ++j) {
	    Ttk_StateSpec spec = {0,0};
	    status = Ttk_GetStateSpecFromObj(interp, specs[n], &spec);
	    if (status == TCL_OK) {
................................................................................
		stateTable[j].offBits = spec.offbits;
		status = Tcl_GetIntFromObj(interp, specs[n+1],
			&stateTable[j].index);
	    }
	}
	if (status != TCL_OK) {
	    ckfree(stateTable);

	    return status;
	}
    } else {
	stateTable = ckalloc(sizeof(Ttk_StateTable));
	memset(stateTable, 0, sizeof(Ttk_StateTable));
    }

................................................................................

    /* set the element name to an allocated copy */
    name = ckalloc(strlen(elementName) + 1);
    strcpy(name, elementName);
    elementPtr->elementName = name;

    /* set the class name to an allocated copy */
    wname = ckalloc(sizeof(WCHAR) * (length + 1));
    wcscpy(wname, className);
    elementPtr->className = wname;

    elementData = NewElementData(themeData->procs, elementPtr);
    Ttk_RegisterElementSpec(
	theme, elementName, elementPtr->elementSpec, elementData);

    Ttk_RegisterCleanup(interp, elementData, DestroyElementData);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1));

    return TCL_OK;




}

/*----------------------------------------------------------------------
 * +++ Initialization routine:
 */

MODULE_SCOPE int TtkXPTheme_Init(Tcl_Interp *interp, HWND hwnd)






|







 







>
>
>




>
>





|












>











>
>
>




>
>





|




>
>







 







|








>







 







|
>











|



|



|




|





|






|






|






|






|













|







 







>







 







|









>

>
>
>
>







451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
...
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
....
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
....
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
....
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
....
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
 */

static int
InitElementData(ElementData *elementData, Tk_Window tkwin, Drawable d)
{
    Window win = Tk_WindowId(tkwin);

    if (win) {
	elementData->hwnd = Tk_GetHWND(win);
    } else  {
	elementData->hwnd = elementData->procs->stubWindow;
    }

    elementData->hTheme = elementData->procs->OpenThemeData(
	elementData->hwnd, elementData->info->className);
................................................................................
    void *clientData, void *elementRecord, Tk_Window tkwin,
    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
{
    TextElement *element = elementRecord;
    ElementData *elementData = clientData;
    RECT rc = {0, 0};
    HRESULT hr = S_OK;
    const char *src;
    int len;
    Tcl_DString ds;

    if (!InitElementData(elementData, tkwin, 0))
	return;

    src = Tcl_GetStringFromObj(element->textObj, &len);
    Tcl_WinUtfToTChar(src, len, &ds);
    hr = elementData->procs->GetThemeTextExtent(
	    elementData->hTheme,
	    elementData->hDC,
	    elementData->info->partId,
	    Ttk_StateTableLookup(elementData->info->statemap, 0),
	    (WCHAR *) Tcl_DStringValue(&ds),
	    -1,
	    DT_LEFT,// | DT_BOTTOM | DT_NOPREFIX,
	    NULL,
	    &rc);

    if (SUCCEEDED(hr)) {
	*widthPtr = rc.right - rc.left;
	*heightPtr = rc.bottom - rc.top;
    }
    if (*widthPtr < 80) *widthPtr = 80;
    if (*heightPtr < 20) *heightPtr = 20;

    Tcl_DStringFree(&ds);
    FreeElementData(elementData);
}

static void TextElementDraw(
    ClientData clientData, void *elementRecord, Tk_Window tkwin,
    Drawable d, Ttk_Box b, unsigned int state)
{
    TextElement *element = elementRecord;
    ElementData *elementData = clientData;
    RECT rc = BoxToRect(b);
    HRESULT hr = S_OK;
    const char *src;
    int len;
    Tcl_DString ds;

    if (!InitElementData(elementData, tkwin, d))
	return;

    src = Tcl_GetStringFromObj(element->textObj, &len);
    Tcl_WinUtfToTChar(src, len, &ds);
    hr = elementData->procs->DrawThemeText(
	    elementData->hTheme,
	    elementData->hDC,
	    elementData->info->partId,
	    Ttk_StateTableLookup(elementData->info->statemap, state),
	    (WCHAR *) Tcl_DStringValue(&ds),
	    -1,
	    DT_LEFT,// | DT_BOTTOM | DT_NOPREFIX,
	    (state & TTK_STATE_DISABLED) ? DTT_GRAYED : 0,
	    &rc);

    Tcl_DStringFree(&ds);
    FreeElementData(elementData);
}

static Ttk_ElementSpec TextElementSpec =
{
    TK_STYLE_VERSION_2,
    sizeof(TextElement),
................................................................................
    const char *elementName,
    int objc,
    Tcl_Obj *const objv[])
{
    XPThemeData *themeData = clientData;
    ElementInfo *elementPtr = NULL;
    ClientData elementData;
    WCHAR *className;
    int partId = 0;
    Ttk_StateTable *stateTable;
    Ttk_Padding pad = {0, 0, 0, 0};
    int flags = 0;
    int length = 0;
    char *name;
    LPWSTR wname;
    Ttk_ElementSpec *elementSpec = &GenericElementSpec;
    Tcl_DString classBuf;

    static const char *optionStrings[] =
	{ "-padding","-width","-height","-margins", "-syssize",
	  "-halfheight", "-halfwidth", NULL };
    enum { O_PADDING, O_WIDTH, O_HEIGHT, O_MARGINS, O_SYSSIZE,
	   O_HALFHEIGHT, O_HALFWIDTH };

................................................................................
	Tcl_SetErrorCode(interp, "TTK", "VSAPI", "REQUIRED", NULL);
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &partId) != TCL_OK) {
	return TCL_ERROR;
    }
    name = Tcl_GetStringFromObj(objv[0], &length);
    className = (WCHAR *) Tcl_WinUtfToTChar(name, length, &classBuf);

    /* flags or padding */
    if (objc > 3) {
	int i = 3, option = 0;
	for (i = 3; i < objc; i += 2) {
	    int tmp = 0;
	    if (i == objc -1) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"Missing value for \"%s\".",
			Tcl_GetString(objv[i])));
		Tcl_SetErrorCode(interp, "TTK", "VSAPI", "MISSING", NULL);
		goto retErr;
	    }
	    if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
		    sizeof(char *), "option", 0, &option) != TCL_OK)
		goto retErr;
	    switch (option) {
	    case O_PADDING:
		if (Ttk_GetBorderFromObj(interp, objv[i+1], &pad) != TCL_OK) {
		    goto retErr;
		}
		break;
	    case O_MARGINS:
		if (Ttk_GetBorderFromObj(interp, objv[i+1], &pad) != TCL_OK) {
		    goto retErr;
		}
		flags |= PAD_MARGINS;
		break;
	    case O_WIDTH:
		if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    goto retErr;
		}
		pad.left = pad.right = tmp;
		flags |= IGNORE_THEMESIZE;
		break;
	    case O_HEIGHT:
		if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    goto retErr;
		}
		pad.top = pad.bottom = tmp;
		flags |= IGNORE_THEMESIZE;
		break;
	    case O_SYSSIZE:
		if (GetSysFlagFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    goto retErr;
		}
		elementSpec = &GenericSizedElementSpec;
		flags |= (tmp & 0xFFFF);
		break;
	    case O_HALFHEIGHT:
		if (Tcl_GetBooleanFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    goto retErr;
		}
		if (tmp)
		    flags |= HALF_HEIGHT;
		break;
	    case O_HALFWIDTH:
		if (Tcl_GetBooleanFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    goto retErr;
		}
		if (tmp)
		    flags |= HALF_WIDTH;
		break;
	    }
	}
    }

    /* convert a statemap into a state table */
    if (objc > 2) {
	Tcl_Obj **specs;
	int n,j,count, status = TCL_OK;
	if (Tcl_ListObjGetElements(interp, objv[2], &count, &specs) != TCL_OK)
	    goto retErr;
	/* we over-allocate to ensure there is a terminating entry */
	stateTable = ckalloc(sizeof(Ttk_StateTable) * (count + 1));
	memset(stateTable, 0, sizeof(Ttk_StateTable) * (count + 1));
	for (n = 0, j = 0; status == TCL_OK && n < count; n += 2, ++j) {
	    Ttk_StateSpec spec = {0,0};
	    status = Ttk_GetStateSpecFromObj(interp, specs[n], &spec);
	    if (status == TCL_OK) {
................................................................................
		stateTable[j].offBits = spec.offbits;
		status = Tcl_GetIntFromObj(interp, specs[n+1],
			&stateTable[j].index);
	    }
	}
	if (status != TCL_OK) {
	    ckfree(stateTable);
	    Tcl_DStringFree(&classBuf);
	    return status;
	}
    } else {
	stateTable = ckalloc(sizeof(Ttk_StateTable));
	memset(stateTable, 0, sizeof(Ttk_StateTable));
    }

................................................................................

    /* set the element name to an allocated copy */
    name = ckalloc(strlen(elementName) + 1);
    strcpy(name, elementName);
    elementPtr->elementName = name;

    /* set the class name to an allocated copy */
    wname = ckalloc(Tcl_DStringLength(&classBuf) + sizeof(WCHAR));
    wcscpy(wname, className);
    elementPtr->className = wname;

    elementData = NewElementData(themeData->procs, elementPtr);
    Ttk_RegisterElementSpec(
	theme, elementName, elementPtr->elementSpec, elementData);

    Ttk_RegisterCleanup(interp, elementData, DestroyElementData);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1));
    Tcl_DStringFree(&classBuf);
    return TCL_OK;

retErr:
    Tcl_DStringFree(&classBuf);
    return TCL_ERROR;
}

/*----------------------------------------------------------------------
 * +++ Initialization routine:
 */

MODULE_SCOPE int TtkXPTheme_Init(Tcl_Interp *interp, HWND hwnd)