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 Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/tkFocus.c.

   626    626   	tlFocusPtr->topLevelPtr = topLevelPtr;
   627    627   	tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
   628    628   	winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
   629    629       }
   630    630       tlFocusPtr->focusWinPtr = winPtr;
   631    631   
   632    632       if (topLevelPtr->flags & TK_EMBEDDED) {
   633         -			
          633  +
   634    634   	/*
   635    635   	 * We are assigning focus to an embedded toplevel.  The platform
   636    636   	 * specific function TkpClaimFocus needs to handle the job of
   637    637   	 * assigning focus to the container, since we have no way to find the
   638    638   	 * contaiuner.
   639    639   	 */
   640    640   
................................................................................
   642    642       } else if ((displayFocusPtr->focusWinPtr != NULL) || force) {
   643    643   
   644    644   	/*
   645    645   	 * If we are forcing removal of focus from a container hosting a
   646    646   	 * toplevel from a different application, clear the focus in that
   647    647   	 * application.
   648    648   	 */
   649         -	
          649  +
   650    650       	if (force) {
   651    651   	    TkWindow *focusPtr = winPtr->dispPtr->focusPtr;
   652    652   	    if (focusPtr && focusPtr->mainPtr != winPtr->mainPtr) {
   653    653   		DisplayFocusInfo *displayFocusPtr2 = FindDisplayFocusInfo(
   654    654   		    focusPtr->mainPtr, focusPtr->dispPtr);
   655    655   		displayFocusPtr2->focusWinPtr = NULL;
   656    656   	    }
   657    657       	}
   658    658   
   659    659   	/*
   660    660   	 * Call the platform specific function TkpChangeFocus to move the
   661    661   	 * window manager's focus to a new toplevel.
   662    662   	 */
   663         -	
          663  +
   664    664   	serial = TkpChangeFocus(TkpGetWrapperWindow(topLevelPtr), force);
   665    665   	if (serial != 0) {
   666    666   	    displayFocusPtr->focusSerial = serial;
   667    667   	}
   668    668   	GenerateFocusEvents(displayFocusPtr->focusWinPtr, winPtr);
   669    669   	displayFocusPtr->focusWinPtr = winPtr;
   670    670   	winPtr->dispPtr->focusPtr = winPtr;

Changes to generic/tkImgGIF.c.

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

Changes to generic/tkMain.c.

    75     75   #endif
    76     76   
    77     77   #ifdef MAC_OSX_TK
    78     78   #include "tkMacOSXInt.h"
    79     79   #endif
    80     80   
    81     81   /*
    82         - * Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj,
    83         - * while otherwise NewNativeObj is needed (which provides proper
    84         - * conversion from native encoding to UTF-8).
           82  + * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
           83  + * NewNativeObj is needed (which provides proper conversion from native
           84  + * encoding to UTF-8).
    85     85    */
    86         -#ifdef UNICODE
           86  +
           87  +#if defined(UNICODE) && (TCL_UTF_MAX <= 4)
    87     88   #   define NewNativeObj Tcl_NewUnicodeObj
    88         -#else /* !UNICODE */
    89         -    static Tcl_Obj *NewNativeObj(char *string, int length) {
    90         -	Tcl_Obj *obj;
    91         -	Tcl_DString ds;
    92         -	Tcl_ExternalToUtfDString(NULL, string, length, &ds);
    93         -	obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
    94         -	Tcl_DStringFree(&ds);
    95         -	return obj;
           89  +#else /* !UNICODE || (TCL_UTF_MAX > 4) */
           90  +static inline Tcl_Obj *
           91  +NewNativeObj(
           92  +    TCHAR *string,
           93  +    int length)
           94  +{
           95  +    Tcl_Obj *obj;
           96  +    Tcl_DString ds;
           97  +
           98  +#ifdef UNICODE
           99  +    if (length > 0) {
          100  +	length *= sizeof(WCHAR);
          101  +    }
          102  +    Tcl_WinTCharToUtf(string, length, &ds);
          103  +#else
          104  +    Tcl_ExternalToUtfDString(NULL, (char *) string, length, &ds);
          105  +#endif
          106  +    obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
          107  +    Tcl_DStringFree(&ds);
          108  +    return obj;
    96    109   }
    97         -#endif /* !UNICODE */
          110  +#endif /* !UNICODE || (TCL_UTF_MAX > 4) */
    98    111   
    99    112   /*
   100    113    * Declarations for various library functions and variables (don't want to
   101    114    * include tkInt.h or tkPort.h here, because people might copy this file out
   102    115    * of the Tk source directory to make their own modified versions). Note: do
   103    116    * not declare "exit" here even though a declaration is really needed, because
   104    117    * it will conflict with a declaration elsewhere on some systems.

Changes to unix/tkUnixMenu.c.

   853    853       const Tk_FontMetrics *fmPtr,/* The precalculated font metrics */
   854    854       int x, int y,
   855    855       int width, int height)
   856    856   {
   857    857       if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) {
   858    858   	int len;
   859    859   
   860         -	/*
   861         -	 * Do the unicode call just to prevent overruns.
   862         -	 */
   863         -
   864         -	Tcl_GetUnicodeFromObj(mePtr->labelPtr, &len);
          860  +	len = Tcl_GetCharLength(mePtr->labelPtr);
   865    861   	if (mePtr->underline < len) {
   866    862   	    int activeBorderWidth, leftEdge;
   867    863   	    const char *label, *start, *end;
   868    864   
   869    865   	    label = Tcl_GetString(mePtr->labelPtr);
   870    866   	    start = Tcl_UtfAtIndex(label, mePtr->underline);
   871    867   	    end = Tcl_UtfNext(start);

Changes to win/tkWinDialog.c.

  2907   2907   	    }
  2908   2908   	}
  2909   2909   	flags = buttonFlagMap[defaultBtnIdx];
  2910   2910       }
  2911   2911   
  2912   2912       flags |= icon | type | MB_TASKMODAL | MB_SETFOREGROUND;
  2913   2913   
  2914         -    tmpObj = messageObj ? Tcl_DuplicateObj(messageObj)
  2915         -	    : Tcl_NewUnicodeObj(NULL, 0);
         2914  +    tmpObj = messageObj ? Tcl_DuplicateObj(messageObj) : Tcl_NewObj();
  2916   2915       Tcl_IncrRefCount(tmpObj);
  2917   2916       if (detailObj) {
  2918         -	const Tcl_UniChar twoNL[] = { '\n', '\n' };
  2919         -
  2920         -	Tcl_AppendUnicodeToObj(tmpObj, twoNL, 2);
         2917  +	Tcl_AppendStringsToObj(tmpObj, "\n\n", NULL);
  2921   2918   	Tcl_AppendObjToObj(tmpObj, detailObj);
  2922   2919       }
  2923   2920   
  2924   2921       oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
  2925   2922   
  2926   2923       /*
  2927   2924        * MessageBoxW exists for all platforms. Use it to allow unicode error

Changes to win/tkWinMenu.c.

  1245   1245   
  1246   1246       case WM_MENUCHAR: {
  1247   1247   	hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
  1248   1248   		(char *) *plParam);
  1249   1249   	if (hashEntryPtr != NULL) {
  1250   1250   	    int i, len, underline;
  1251   1251   	    Tcl_Obj *labelPtr;
  1252         -	    Tcl_UniChar *wlabel, menuChar;
         1252  +	    WCHAR *wlabel;
         1253  +	    Tcl_UniChar menuChar;
         1254  +	    Tcl_DString ds;
  1253   1255   
  1254   1256   	    *plResult = 0;
  1255   1257   	    menuPtr = Tcl_GetHashValue(hashEntryPtr);
  1256   1258   	    /*
  1257   1259   	     * Assume we have something directly convertable to Tcl_UniChar.
  1258   1260   	     * True at least for wide systems.
  1259   1261   	     */
  1260   1262   	    menuChar = Tcl_UniCharToUpper((Tcl_UniChar) LOWORD(*pwParam));
  1261   1263   
         1264  +	    Tcl_DStringInit(&ds);
  1262   1265   	    for (i = 0; i < menuPtr->numEntries; i++) {
  1263   1266   		underline = menuPtr->entries[i]->underline;
  1264   1267   		labelPtr = menuPtr->entries[i]->labelPtr;
  1265   1268   		if ((underline >= 0) && (labelPtr != NULL)) {
  1266   1269   		    /*
  1267   1270   		     * Ensure we don't exceed the label length, then check
  1268   1271   		     */
  1269         -		    wlabel = Tcl_GetUnicodeFromObj(labelPtr, &len);
         1272  +		    const char *src = Tcl_GetStringFromObj(labelPtr, &len);
         1273  +
         1274  +		    Tcl_DStringFree(&ds);
         1275  +		    wlabel = (WCHAR *) Tcl_WinUtfToTChar(src, len, &ds);
  1270   1276   		    if ((underline < len) && (menuChar ==
  1271   1277   				Tcl_UniCharToUpper(wlabel[underline]))) {
  1272   1278   			*plResult = (2 << 16) | i;
  1273   1279   			returnResult = 1;
  1274   1280   			break;
  1275   1281   		    }
  1276   1282   		}
  1277   1283   	    }
         1284  +	    Tcl_DStringFree(&ds);
  1278   1285   	}
  1279   1286   	break;
  1280   1287       }
  1281   1288   
  1282   1289       case WM_MEASUREITEM: {
  1283   1290   	LPMEASUREITEMSTRUCT itemPtr = (LPMEASUREITEMSTRUCT) *plParam;
  1284   1291   
................................................................................
  2066   2073       int y,			/* Top Edge */
  2067   2074       int width,			/* Width of entry */
  2068   2075       int height)			/* Height of entry */
  2069   2076   {
  2070   2077       if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) {
  2071   2078   	int len;
  2072   2079   
  2073         -	/* do the unicode call just to prevent overruns */
  2074         -	Tcl_GetUnicodeFromObj(mePtr->labelPtr, &len);
         2080  +	len = Tcl_GetCharLength(mePtr->labelPtr);
  2075   2081   	if (mePtr->underline < len) {
  2076   2082   	    const char *label, *start, *end;
  2077   2083   
  2078   2084   	    label = Tcl_GetString(mePtr->labelPtr);
  2079   2085   	    start = Tcl_UtfAtIndex(label, mePtr->underline);
  2080   2086   	    end = Tcl_UtfNext(start);
  2081   2087   	    Tk_UnderlineChars(menuPtr->display, d,
................................................................................
  2463   2469       }
  2464   2470   
  2465   2471       if (mePtr->state == ENTRY_DISABLED) {
  2466   2472   	if (menuPtr->disabledFgPtr == NULL) {
  2467   2473   	    XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
  2468   2474   		    (unsigned) width, (unsigned) height);
  2469   2475   	} else if ((mePtr->image != NULL)
  2470         -		&& (menuPtr->disabledImageGC != NULL)) {
         2476  +		&& menuPtr->disabledImageGC) {
  2471   2477   	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
  2472   2478   		    leftEdge + imageXOffset,
  2473   2479   		    (int) (y + (mePtr->height - imageHeight)/2 + imageYOffset),
  2474   2480   		    (unsigned) imageWidth, (unsigned) imageHeight);
  2475   2481   	}
  2476   2482       }
  2477   2483   }

Changes to win/ttkWinXPTheme.c.

   451    451    */
   452    452   
   453    453   static int
   454    454   InitElementData(ElementData *elementData, Tk_Window tkwin, Drawable d)
   455    455   {
   456    456       Window win = Tk_WindowId(tkwin);
   457    457   
   458         -    if (win != None) {
          458  +    if (win) {
   459    459   	elementData->hwnd = Tk_GetHWND(win);
   460    460       } else  {
   461    461   	elementData->hwnd = elementData->procs->stubWindow;
   462    462       }
   463    463   
   464    464       elementData->hTheme = elementData->procs->OpenThemeData(
   465    465   	elementData->hwnd, elementData->info->className);
................................................................................
   825    825       void *clientData, void *elementRecord, Tk_Window tkwin,
   826    826       int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
   827    827   {
   828    828       TextElement *element = elementRecord;
   829    829       ElementData *elementData = clientData;
   830    830       RECT rc = {0, 0};
   831    831       HRESULT hr = S_OK;
          832  +    const char *src;
          833  +    int len;
          834  +    Tcl_DString ds;
   832    835   
   833    836       if (!InitElementData(elementData, tkwin, 0))
   834    837   	return;
   835    838   
          839  +    src = Tcl_GetStringFromObj(element->textObj, &len);
          840  +    Tcl_WinUtfToTChar(src, len, &ds);
   836    841       hr = elementData->procs->GetThemeTextExtent(
   837    842   	    elementData->hTheme,
   838    843   	    elementData->hDC,
   839    844   	    elementData->info->partId,
   840    845   	    Ttk_StateTableLookup(elementData->info->statemap, 0),
   841         -	    Tcl_GetUnicode(element->textObj),
          846  +	    (WCHAR *) Tcl_DStringValue(&ds),
   842    847   	    -1,
   843    848   	    DT_LEFT,// | DT_BOTTOM | DT_NOPREFIX,
   844    849   	    NULL,
   845    850   	    &rc);
   846    851   
   847    852       if (SUCCEEDED(hr)) {
   848    853   	*widthPtr = rc.right - rc.left;
   849    854   	*heightPtr = rc.bottom - rc.top;
   850    855       }
   851    856       if (*widthPtr < 80) *widthPtr = 80;
   852    857       if (*heightPtr < 20) *heightPtr = 20;
   853    858   
          859  +    Tcl_DStringFree(&ds);
   854    860       FreeElementData(elementData);
   855    861   }
   856    862   
   857    863   static void TextElementDraw(
   858    864       ClientData clientData, void *elementRecord, Tk_Window tkwin,
   859    865       Drawable d, Ttk_Box b, unsigned int state)
   860    866   {
   861    867       TextElement *element = elementRecord;
   862    868       ElementData *elementData = clientData;
   863    869       RECT rc = BoxToRect(b);
   864    870       HRESULT hr = S_OK;
          871  +    const char *src;
          872  +    int len;
          873  +    Tcl_DString ds;
   865    874   
   866    875       if (!InitElementData(elementData, tkwin, d))
   867    876   	return;
   868    877   
          878  +    src = Tcl_GetStringFromObj(element->textObj, &len);
          879  +    Tcl_WinUtfToTChar(src, len, &ds);
   869    880       hr = elementData->procs->DrawThemeText(
   870    881   	    elementData->hTheme,
   871    882   	    elementData->hDC,
   872    883   	    elementData->info->partId,
   873    884   	    Ttk_StateTableLookup(elementData->info->statemap, state),
   874         -	    Tcl_GetUnicode(element->textObj),
          885  +	    (WCHAR *) Tcl_DStringValue(&ds),
   875    886   	    -1,
   876    887   	    DT_LEFT,// | DT_BOTTOM | DT_NOPREFIX,
   877    888   	    (state & TTK_STATE_DISABLED) ? DTT_GRAYED : 0,
   878    889   	    &rc);
          890  +
          891  +    Tcl_DStringFree(&ds);
   879    892       FreeElementData(elementData);
   880    893   }
   881    894   
   882    895   static Ttk_ElementSpec TextElementSpec =
   883    896   {
   884    897       TK_STYLE_VERSION_2,
   885    898       sizeof(TextElement),
................................................................................
  1098   1111       const char *elementName,
  1099   1112       int objc,
  1100   1113       Tcl_Obj *const objv[])
  1101   1114   {
  1102   1115       XPThemeData *themeData = clientData;
  1103   1116       ElementInfo *elementPtr = NULL;
  1104   1117       ClientData elementData;
  1105         -    Tcl_UniChar *className;
         1118  +    WCHAR *className;
  1106   1119       int partId = 0;
  1107   1120       Ttk_StateTable *stateTable;
  1108   1121       Ttk_Padding pad = {0, 0, 0, 0};
  1109   1122       int flags = 0;
  1110   1123       int length = 0;
  1111   1124       char *name;
  1112   1125       LPWSTR wname;
  1113   1126       Ttk_ElementSpec *elementSpec = &GenericElementSpec;
         1127  +    Tcl_DString classBuf;
  1114   1128   
  1115   1129       static const char *optionStrings[] =
  1116   1130   	{ "-padding","-width","-height","-margins", "-syssize",
  1117   1131   	  "-halfheight", "-halfwidth", NULL };
  1118   1132       enum { O_PADDING, O_WIDTH, O_HEIGHT, O_MARGINS, O_SYSSIZE,
  1119   1133   	   O_HALFHEIGHT, O_HALFWIDTH };
  1120   1134   
................................................................................
  1124   1138   	Tcl_SetErrorCode(interp, "TTK", "VSAPI", "REQUIRED", NULL);
  1125   1139   	return TCL_ERROR;
  1126   1140       }
  1127   1141   
  1128   1142       if (Tcl_GetIntFromObj(interp, objv[1], &partId) != TCL_OK) {
  1129   1143   	return TCL_ERROR;
  1130   1144       }
  1131         -    className = Tcl_GetUnicodeFromObj(objv[0], &length);
         1145  +    name = Tcl_GetStringFromObj(objv[0], &length);
         1146  +    className = (WCHAR *) Tcl_WinUtfToTChar(name, length, &classBuf);
  1132   1147   
  1133   1148       /* flags or padding */
  1134   1149       if (objc > 3) {
  1135   1150   	int i = 3, option = 0;
  1136   1151   	for (i = 3; i < objc; i += 2) {
  1137   1152   	    int tmp = 0;
  1138   1153   	    if (i == objc -1) {
  1139   1154   		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  1140   1155   			"Missing value for \"%s\".",
  1141   1156   			Tcl_GetString(objv[i])));
  1142   1157   		Tcl_SetErrorCode(interp, "TTK", "VSAPI", "MISSING", NULL);
  1143         -		return TCL_ERROR;
         1158  +		goto retErr;
  1144   1159   	    }
  1145   1160   	    if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
  1146   1161   		    sizeof(char *), "option", 0, &option) != TCL_OK)
  1147         -		return TCL_ERROR;
         1162  +		goto retErr;
  1148   1163   	    switch (option) {
  1149   1164   	    case O_PADDING:
  1150   1165   		if (Ttk_GetBorderFromObj(interp, objv[i+1], &pad) != TCL_OK) {
  1151         -		    return TCL_ERROR;
         1166  +		    goto retErr;
  1152   1167   		}
  1153   1168   		break;
  1154   1169   	    case O_MARGINS:
  1155   1170   		if (Ttk_GetBorderFromObj(interp, objv[i+1], &pad) != TCL_OK) {
  1156         -		    return TCL_ERROR;
         1171  +		    goto retErr;
  1157   1172   		}
  1158   1173   		flags |= PAD_MARGINS;
  1159   1174   		break;
  1160   1175   	    case O_WIDTH:
  1161   1176   		if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
  1162         -		    return TCL_ERROR;
         1177  +		    goto retErr;
  1163   1178   		}
  1164   1179   		pad.left = pad.right = tmp;
  1165   1180   		flags |= IGNORE_THEMESIZE;
  1166   1181   		break;
  1167   1182   	    case O_HEIGHT:
  1168   1183   		if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
  1169         -		    return TCL_ERROR;
         1184  +		    goto retErr;
  1170   1185   		}
  1171   1186   		pad.top = pad.bottom = tmp;
  1172   1187   		flags |= IGNORE_THEMESIZE;
  1173   1188   		break;
  1174   1189   	    case O_SYSSIZE:
  1175   1190   		if (GetSysFlagFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
  1176         -		    return TCL_ERROR;
         1191  +		    goto retErr;
  1177   1192   		}
  1178   1193   		elementSpec = &GenericSizedElementSpec;
  1179   1194   		flags |= (tmp & 0xFFFF);
  1180   1195   		break;
  1181   1196   	    case O_HALFHEIGHT:
  1182   1197   		if (Tcl_GetBooleanFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
  1183         -		    return TCL_ERROR;
         1198  +		    goto retErr;
  1184   1199   		}
  1185   1200   		if (tmp)
  1186   1201   		    flags |= HALF_HEIGHT;
  1187   1202   		break;
  1188   1203   	    case O_HALFWIDTH:
  1189   1204   		if (Tcl_GetBooleanFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
  1190         -		    return TCL_ERROR;
         1205  +		    goto retErr;
  1191   1206   		}
  1192   1207   		if (tmp)
  1193   1208   		    flags |= HALF_WIDTH;
  1194   1209   		break;
  1195   1210   	    }
  1196   1211   	}
  1197   1212       }
  1198   1213   
  1199   1214       /* convert a statemap into a state table */
  1200   1215       if (objc > 2) {
  1201   1216   	Tcl_Obj **specs;
  1202   1217   	int n,j,count, status = TCL_OK;
  1203   1218   	if (Tcl_ListObjGetElements(interp, objv[2], &count, &specs) != TCL_OK)
  1204         -	    return TCL_ERROR;
         1219  +	    goto retErr;
  1205   1220   	/* we over-allocate to ensure there is a terminating entry */
  1206   1221   	stateTable = ckalloc(sizeof(Ttk_StateTable) * (count + 1));
  1207   1222   	memset(stateTable, 0, sizeof(Ttk_StateTable) * (count + 1));
  1208   1223   	for (n = 0, j = 0; status == TCL_OK && n < count; n += 2, ++j) {
  1209   1224   	    Ttk_StateSpec spec = {0,0};
  1210   1225   	    status = Ttk_GetStateSpecFromObj(interp, specs[n], &spec);
  1211   1226   	    if (status == TCL_OK) {
................................................................................
  1213   1228   		stateTable[j].offBits = spec.offbits;
  1214   1229   		status = Tcl_GetIntFromObj(interp, specs[n+1],
  1215   1230   			&stateTable[j].index);
  1216   1231   	    }
  1217   1232   	}
  1218   1233   	if (status != TCL_OK) {
  1219   1234   	    ckfree(stateTable);
         1235  +	    Tcl_DStringFree(&classBuf);
  1220   1236   	    return status;
  1221   1237   	}
  1222   1238       } else {
  1223   1239   	stateTable = ckalloc(sizeof(Ttk_StateTable));
  1224   1240   	memset(stateTable, 0, sizeof(Ttk_StateTable));
  1225   1241       }
  1226   1242   
................................................................................
  1233   1249   
  1234   1250       /* set the element name to an allocated copy */
  1235   1251       name = ckalloc(strlen(elementName) + 1);
  1236   1252       strcpy(name, elementName);
  1237   1253       elementPtr->elementName = name;
  1238   1254   
  1239   1255       /* set the class name to an allocated copy */
  1240         -    wname = ckalloc(sizeof(WCHAR) * (length + 1));
         1256  +    wname = ckalloc(Tcl_DStringLength(&classBuf) + sizeof(WCHAR));
  1241   1257       wcscpy(wname, className);
  1242   1258       elementPtr->className = wname;
  1243   1259   
  1244   1260       elementData = NewElementData(themeData->procs, elementPtr);
  1245   1261       Ttk_RegisterElementSpec(
  1246   1262   	theme, elementName, elementPtr->elementSpec, elementData);
  1247   1263   
  1248   1264       Ttk_RegisterCleanup(interp, elementData, DestroyElementData);
  1249   1265       Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1));
         1266  +    Tcl_DStringFree(&classBuf);
  1250   1267       return TCL_OK;
         1268  +
         1269  +retErr:
         1270  +    Tcl_DStringFree(&classBuf);
         1271  +    return TCL_ERROR;
  1251   1272   }
  1252   1273   
  1253   1274   /*----------------------------------------------------------------------
  1254   1275    * +++ Initialization routine:
  1255   1276    */
  1256   1277   
  1257   1278   MODULE_SCOPE int TtkXPTheme_Init(Tcl_Interp *interp, HWND hwnd)