Tk Source Code

	} else if ((formatObj != NULL) && !matched) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "image format \"%s\" is not supported", formatString));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
		    formatString, NULL);
	    return TCL_ERROR;
	} else {








	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "couldn't recognize image data", -1));
	    Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
		    "UNRECOGNIZED_DATA", NULL);

	    return TCL_ERROR;
	}
    }

    *imageFormatPtr = formatPtr;
    *oldformat = useoldformat;

	} else if ((formatObj != NULL) && !matched) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "image format \"%s\" is not supported", formatString));
	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT",
		    formatString, NULL);
	    return TCL_ERROR;
	} else {

            /*
             * Some lower level routine (stringMatchProc) may have already set
             * a specific error message, so just return this. Otherwise return
             * a generic image data error.
             */

            if (Tcl_GetString(Tcl_GetObjResult(interp))[0] == '\0') {
                Tcl_SetObjResult(interp, Tcl_NewStringObj(
                        "couldn't recognize image data", -1));
	        Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO",
		        "UNRECOGNIZED_DATA", NULL);
            }
	    return TCL_ERROR;
	}
    }

    *imageFormatPtr = formatPtr;
    *oldformat = useoldformat;

    const char *name2,		/* (unused) */
    int flags)			/* Information about what happened. */
{
    Ttk_TraceHandle *tracePtr = clientData;
    const char *name, *value;
    Tcl_Obj *valuePtr;

    if (flags & TCL_INTERP_DESTROYED) {
	return NULL;
    }

    name = Tcl_GetString(tracePtr->varnameObj);

    /*
     * If the variable is being unset, then re-establish the trace:

    const char *name2,		/* (unused) */
    int flags)			/* Information about what happened. */
{
    Ttk_TraceHandle *tracePtr = clientData;
    const char *name, *value;
    Tcl_Obj *valuePtr;

    if (Tcl_InterpDeleted(interp)) {
	return NULL;
    }

    name = Tcl_GetString(tracePtr->varnameObj);

    /*
     * If the variable is being unset, then re-establish the trace:

    [self _setupApplicationNotifications];

    /*
     * Construct the menu bar.
     */
    _defaultMainMenu = nil;
    [self _setupMenus];

    /*
     * Initialize event processing.
     */
    TkMacOSXInitAppleEvents(_eventInterp);

    /*
     * Initialize the graphics context.

    [self _setupApplicationNotifications];

    /*
     * Construct the menu bar.
     */
    _defaultMainMenu = nil;
    [self _setupMenus];

    /*
     * Initialize event processing.
     */
    TkMacOSXInitAppleEvents(_eventInterp);

    /*
     * Initialize the graphics context.

    if (!Tk_IsTopLevel(macWin->winPtr)) {
	TkMacOSXInvalidateWindow(macWin, TK_PARENT_WINDOW);
	if (macWin->winPtr->parentPtr != NULL) {
	    TkMacOSXInvalClipRgns((Tk_Window) macWin->winPtr->parentPtr);
	}
	if (macWin->visRgn) {
	    CFRelease(macWin->visRgn);

	}
	if (macWin->aboveVisRgn) {
	    CFRelease(macWin->aboveVisRgn);

	}
	if (macWin->drawRgn) {
	    CFRelease(macWin->drawRgn);

	}

	if (macWin->toplevel->referenceCount == 0) {
	    ckfree(macWin->toplevel);
	}
	ckfree(macWin);
	return;
    }
    if (macWin->visRgn) {
	CFRelease(macWin->visRgn);

    }
    if (macWin->aboveVisRgn) {
	CFRelease(macWin->aboveVisRgn);

    }
    if (macWin->drawRgn) {
	CFRelease(macWin->drawRgn);

    }
    macWin->view = nil;

    /*
     * Delay deletion of a toplevel data structure untill all children have
     * been deleted.
     */

    if (!Tk_IsTopLevel(macWin->winPtr)) {
	TkMacOSXInvalidateWindow(macWin, TK_PARENT_WINDOW);
	if (macWin->winPtr->parentPtr != NULL) {
	    TkMacOSXInvalClipRgns((Tk_Window) macWin->winPtr->parentPtr);
	}
	if (macWin->visRgn) {
	    CFRelease(macWin->visRgn);
            macWin->visRgn = NULL;
	}
	if (macWin->aboveVisRgn) {
	    CFRelease(macWin->aboveVisRgn);
            macWin->aboveVisRgn = NULL;
	}
	if (macWin->drawRgn) {
	    CFRelease(macWin->drawRgn);
            macWin->drawRgn = NULL;
	}

	if (macWin->toplevel->referenceCount == 0) {
	    ckfree(macWin->toplevel);
	}
	ckfree(macWin);
	return;
    }
    if (macWin->visRgn) {
	CFRelease(macWin->visRgn);
        macWin->visRgn = NULL;
    }
    if (macWin->aboveVisRgn) {
	CFRelease(macWin->aboveVisRgn);
        macWin->aboveVisRgn = NULL;
    }
    if (macWin->drawRgn) {
	CFRelease(macWin->drawRgn);
        macWin->drawRgn = NULL;
    }
    macWin->view = nil;

    /*
     * Delay deletion of a toplevel data structure untill all children have
     * been deleted.
     */

	iVBORw0KGgoAAAANSUhEUgAAAAIAAAACCA
	YAAAEFsT2yAAAABGdBTUEAAYagMeiWXwAA
	ABdJREFUCJkFwQEBAAAAgiD6P9pACRoqDk
	fUBvt1wUFKAAAAAElFTkSuQmCC
    } -format default
} -cleanup {
    imageCleanup
} -returnCodes error -result {couldn't recognize image data}
test imgListFormat-3.5 {StringMatchDef: valid data} -setup {
    image create photo photo1
} -body {
    photo1 put {{blue green}
		{yellow magenta}
	        {#000000 #FFFFFFFF}}
    list [image width photo1] [image height photo1] \

	iVBORw0KGgoAAAANSUhEUgAAAAIAAAACCA
	YAAAEFsT2yAAAABGdBTUEAAYagMeiWXwAA
	ABdJREFUCJkFwQEBAAAAgiD6P9pACRoqDk
	fUBvt1wUFKAAAAAElFTkSuQmCC
    } -format default
} -cleanup {
    imageCleanup
} -returnCodes error -result {invalid color name "iVBORw0KGgoAAAANSUhEUgAAAAIAAAACCA"}
test imgListFormat-3.5 {StringMatchDef: valid data} -setup {
    image create photo photo1
} -body {
    photo1 put {{blue green}
		{yellow magenta}
	        {#000000 #FFFFFFFF}}
    list [image width photo1] [image height photo1] \

} -result {wrong # args: should be "photo1 put data ?-option value ...?"}
test imgPhoto-4.27 {ImgPhotoCmd procedure: put option} -setup {
    image create photo photo1
} -body {
    photo1 put {{white} {white white}}
} -returnCodes error -cleanup {
    image delete photo1
} -result {couldn't recognize image data}
test imgPhoto-4.28 {ImgPhotoCmd procedure: put option} -setup {
    image create photo photo1
} -body {
    photo1 put {{blahgle}}
} -cleanup {
    image delete photo1
} -returnCodes error -result {couldn't recognize image data}
test imgPhoto-4.29 {ImgPhotoCmd procedure: put option} -setup {
    image create photo photo1
} -body {
    # SB: odd thing - this test passed with tk 8.6.6, even if the data
    # is in the wrong position:
    #photo1 put -to 10 10 20 20 {{white}}

................................................................................
test imgPhoto-4.95 {ImgPhotoCmd put: default fmt, invalid data} -setup {
    image create photo photo1
} -body {
    photo1 put {{red green blue} {red " blue}}
    #"
} -cleanup {
    imageCleanup
} -returnCodes error -result {couldn't recognize image data}
test imgPhoto-4.96 {ImgPhotoCmd put: "default" handler is selected} -setup {
    image create photo photo1
    image create photo photo2
    set imgData {{{1 2 3 4} {5 6 7 8} {9 10 11 12}}
        {{13 14 15 15} {17 18 19 20} {21 22 23 24}}}
} -body {
    photo1 put $imgData
................................................................................
} -returnCodes error -result {image format "bogus" is not supported}
test imgPhoto-19.6 {MatchStringFormat: invalid data for default} -setup {
    image create photo photo1
} -body {
    photo1 put bogus
} -cleanup {
    imageCleanup
} -returnCodes error -result {couldn't recognize image data}
test imgPhoto-19.7 {MatchStringFormat: invalid data for default} -setup {
    image create photo photo1
} -body {
    photo1 put bogus -format dEFault
} -cleanup {
    imageCleanup
} -returnCodes error -result {couldn't recognize image data}
test imgPhoto-19.8 {MatchStirngFormat: invalid data for gif} -setup {
    image create photo photo1
} -body {
    photo1 put bogus -format giF
} -cleanup {
    imageCleanup
} -returnCodes error -result {couldn't recognize image data}

} -result {wrong # args: should be "photo1 put data ?-option value ...?"}
test imgPhoto-4.27 {ImgPhotoCmd procedure: put option} -setup {
    image create photo photo1
} -body {
    photo1 put {{white} {white white}}
} -returnCodes error -cleanup {
    image delete photo1
} -result {invalid row # 1: all rows must have the same number of elements}
test imgPhoto-4.28 {ImgPhotoCmd procedure: put option} -setup {
    image create photo photo1
} -body {
    photo1 put {{blahgle}}
} -cleanup {
    image delete photo1
} -returnCodes error -result {invalid color name "blahgle"}
test imgPhoto-4.29 {ImgPhotoCmd procedure: put option} -setup {
    image create photo photo1
} -body {
    # SB: odd thing - this test passed with tk 8.6.6, even if the data
    # is in the wrong position:
    #photo1 put -to 10 10 20 20 {{white}}

................................................................................
test imgPhoto-4.95 {ImgPhotoCmd put: default fmt, invalid data} -setup {
    image create photo photo1
} -body {
    photo1 put {{red green blue} {red " blue}}
    #"
} -cleanup {
    imageCleanup
} -returnCodes error -result {unmatched open quote in list}
test imgPhoto-4.96 {ImgPhotoCmd put: "default" handler is selected} -setup {
    image create photo photo1
    image create photo photo2
    set imgData {{{1 2 3 4} {5 6 7 8} {9 10 11 12}}
        {{13 14 15 15} {17 18 19 20} {21 22 23 24}}}
} -body {
    photo1 put $imgData
................................................................................
} -returnCodes error -result {image format "bogus" is not supported}
test imgPhoto-19.6 {MatchStringFormat: invalid data for default} -setup {
    image create photo photo1
} -body {
    photo1 put bogus
} -cleanup {
    imageCleanup
} -returnCodes error -result {invalid color name "bogus"}
test imgPhoto-19.7 {MatchStringFormat: invalid data for default} -setup {
    image create photo photo1
} -body {
    photo1 put bogus -format dEFault
} -cleanup {
    imageCleanup
} -returnCodes error -result {invalid color name "bogus"}
test imgPhoto-19.8 {MatchStirngFormat: invalid data for gif} -setup {
    image create photo photo1
} -body {
    photo1 put bogus -format giF
} -cleanup {
    imageCleanup
} -returnCodes error -result {couldn't recognize image data}

} -result {100 100}


test imgSVGnano-2.1 {reading a bad image} -body {
    image create photo foo -format svg -data $data(bad)
} -returnCodes error -result {couldn't recognize image data}
test imgSVGnano-2.2 {using bad option} -body {
    image create photo -data $data(plus) -format {svg -scale 0}
} -returnCodes error -result {couldn't recognize image data}







};# end of namespace svgnano

namespace delete svgnano
imageFinish
cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

} -result {100 100}


test imgSVGnano-2.1 {reading a bad image} -body {
    image create photo foo -format svg -data $data(bad)
} -returnCodes error -result {couldn't recognize image data}
test imgSVGnano-2.2 {using bad option} -body {
    image create photo foo -data $data(plus) -format {svg -scale 0}
} -returnCodes error -result {-scale value must be positive}
test imgSVGnano-2.3 {using bad option} -body {
    image create photo foo -data $data(plus)
    foo configure -format {svg 1.0}
} -cleanup {
    rename foo ""
} -returnCodes error -result {bad option "1.0": must be -dpi, -scale, or -unit}

};# end of namespace svgnano

namespace delete svgnano
imageFinish
cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

    unset msg
} -result bar.c


test winDialog-5.7.6 {GetFileName: All/extension } -constraints {
    nt testwinevent
} -body {
    # In 8.6.4 this combination resulted in bar.ext.ext which is bad
    start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {ext} -title Save]}
    set msg {}
    then {
	if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} {
	    Click cancel
	} else {
	    Click ok
	}
    }
    set x "[file tail $x]$msg"
} -cleanup {
    unset msg
} -result bar.ext

test winDialog-5.7.7 {tk_getOpenFile: -defaultextension} -constraints {
    nt testwinevent
} -body {
    unset -nocomplain x
    tcltest::makeFile "" "5 7 7.ext" [initialdir]
    start {set x [tk_getOpenFile \
                      -defaultextension ext \
                      -initialdir [file nativename [initialdir]] \
                      -initialfile "5 7 7" -title Foo]}
    then {
        Click ok
    }
    return $x
} -result [file join [initialdir] "5 7 7.ext"]

test winDialog-5.7.8 {tk_getOpenFile: -defaultextension} -constraints {
    nt testwinevent
} -body {
    unset -nocomplain x
    tcltest::makeFile "" "5 7 8.ext" [initialdir]
    start {set x [tk_getOpenFile \
                      -defaultextension ext \
                      -initialdir [file nativename [initialdir]] \
                      -initialfile "5 7 8.ext" -title Foo]}
    then {
        Click ok
    }
    return $x
} -result [file join [initialdir] "5 7 8.ext"]

test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints {
    nt testwinevent
} -body {
    start {set x [tk_getSaveFile -defaultextension foo -title Save]}
    set msg {}
    then {

    unset msg
} -result bar.c


test winDialog-5.7.6 {GetFileName: All/extension } -constraints {
    nt testwinevent
} -body {
    # In 8.6.4 this combination resulted in bar.aaa.aaa which is bad
    start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {aaa} -title Save]}
    set msg {}
    then {
	if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} {
	    Click cancel
	} else {
	    Click ok
	}
    }
    set x "[file tail $x]$msg"
} -cleanup {
    unset msg
} -result bar.aaa

test winDialog-5.7.7 {tk_getOpenFile: -defaultextension} -constraints {
    nt testwinevent
} -body {
    unset -nocomplain x
    tcltest::makeFile "" "5 7 7.aaa" [initialdir]
    start {set x [tk_getOpenFile \
                      -defaultextension aaa \
                      -initialdir [file nativename [initialdir]] \
                      -initialfile "5 7 7" -title Foo]}
    then {
        Click ok
    }
    return $x
} -result [file join [initialdir] "5 7 7.aaa"]

test winDialog-5.7.8 {tk_getOpenFile: -defaultextension} -constraints {
    nt testwinevent
} -body {
    unset -nocomplain x
    tcltest::makeFile "" "5 7 8.aaa" [initialdir]
    start {set x [tk_getOpenFile \
                      -defaultextension aaa \
                      -initialdir [file nativename [initialdir]] \
                      -initialfile "5 7 8.aaa" -title Foo]}
    then {
        Click ok
    }
    return $x
} -result [file join [initialdir] "5 7 8.aaa"]

test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints {
    nt testwinevent
} -body {
    start {set x [tk_getSaveFile -defaultextension foo -title Save]}
    set msg {}
    then {

/*
 * The zmouse.h file includes the definition for WM_MOUSEWHEEL.
 */

#include <zmouse.h>










/*
 * imm.h is needed by HandleIMEComposition
 */

#include <imm.h>
#ifdef _MSC_VER
#   pragma comment (lib, "imm32.lib")
................................................................................
 */

typedef struct ThreadSpecificData {
    TkDisplay *winDisplay;	/* TkDisplay structure that represents Windows
				 * screen. */
    int updatingClipboard;	/* If 1, we are updating the clipboard. */
    int surrogateBuffer;	/* Buffer for first of surrogate pair. */
    DWORD wheelTickPrev;	/* For high resolution wheels. */

    short wheelAcc;		/* For high resolution wheels. */

} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations of functions used in this file.
 */

................................................................................
    const char *display_name)
{
    Screen *screen;
    TkWinDrawable *twdPtr;
    Display *display;
    ThreadSpecificData *tsdPtr =
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));


    if (tsdPtr->winDisplay != NULL) {
	if (!strcmp(tsdPtr->winDisplay->display->display_name, display_name)) {
	    return tsdPtr->winDisplay;
	} else {
	    return NULL;
	}
................................................................................

    TkWinDisplayChanged(display);

    tsdPtr->winDisplay = ckalloc(sizeof(TkDisplay));
    ZeroMemory(tsdPtr->winDisplay, sizeof(TkDisplay));
    tsdPtr->winDisplay->display = display;
    tsdPtr->updatingClipboard = FALSE;
    tsdPtr->wheelTickPrev = GetTickCount();


    tsdPtr->wheelAcc = 0;


    /*
     * Key map info must be available immediately, because of "send event".
     */
    TkpInitKeymapInfo(tsdPtr->winDisplay);

    return tsdPtr->winDisplay;
................................................................................
    case WM_KILLFOCUS:
    case WM_DESTROYCLIPBOARD:
    case WM_UNICHAR:
    case WM_CHAR:
    case WM_SYSKEYUP:
    case WM_KEYUP:
    case WM_MOUSEWHEEL:

	GenerateXEvent(hwnd, message, wParam, lParam);
	return 1;
    case WM_MENUCHAR:
	GenerateXEvent(hwnd, message, wParam, lParam);

	/*
	 * MNC_CLOSE is the only one that looks right. This is a hack.
................................................................................
    LPARAM lParam)
{
    XEvent event;
    TkWindow *winPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (message == WM_MOUSEWHEEL) {
	union {LPARAM lParam; POINTS point;} root;
	POINT pos;
	root.lParam = lParam;

	/*
	 * Redirect mousewheel events to the window containing the cursor.
	 * That feels much less strange to users, and is how all the other
................................................................................
	event.type = SelectionClear;
	event.xselectionclear.selection =
		Tk_InternAtom((Tk_Window)winPtr, "CLIPBOARD");
	event.xselectionclear.time = TkpGetMS();
	break;

    case WM_MOUSEWHEEL:

    case WM_CHAR:
    case WM_UNICHAR:
    case WM_SYSKEYDOWN:
    case WM_SYSKEYUP:
    case WM_KEYDOWN:
    case WM_KEYUP: {
	unsigned int state = GetState(message, wParam, lParam);
................................................................................
	/*
	 * Now set up event specific fields.
	 */

	switch (message) {
	case WM_MOUSEWHEEL: {
	    /*
	     * Support for high resolution wheels.
	     */

	    DWORD wheelTick = GetTickCount();

	    if (wheelTick - tsdPtr->wheelTickPrev < 1500) {
		tsdPtr->wheelAcc += (short) HIWORD(wParam);
	    } else {
		tsdPtr->wheelAcc = (short) HIWORD(wParam);
	    }
	    tsdPtr->wheelTickPrev = wheelTick;
	    if (abs(tsdPtr->wheelAcc) < WHEEL_DELTA) {
































		return;
	    }

	    /*
	     * We have invented a new X event type to handle this event. It
	     * still uses the KeyPress struct. However, the keycode field has
	     * been overloaded to hold the zDelta of the wheel. Set nbytes to
................................................................................
	     * 0 to prevent conversion of the keycode to a keysym in
	     * TkpGetString. [Bug 1118340].
	     */

	    event.type = MouseWheelEvent;
	    event.xany.send_event = -1;
	    event.xkey.nbytes = 0;
	    event.xkey.keycode = tsdPtr->wheelAcc / WHEEL_DELTA * WHEEL_DELTA;
	    tsdPtr->wheelAcc = tsdPtr->wheelAcc % WHEEL_DELTA;

	    break;
	}
	case WM_SYSKEYDOWN:
	case WM_KEYDOWN:
	    /*
	     * Check for translated characters in the event queue. Setting
	     * xany.send_event to -1 indicates to the Windows implementation

/*
 * The zmouse.h file includes the definition for WM_MOUSEWHEEL.
 */

#include <zmouse.h>

/*
 * WM_MOUSEHWHEEL is normally defined by Winuser.h for Vista/2008 or later,
 * but is also usable on 2000/XP if IntelliPoint drivers are installed.
 */

#ifndef WM_MOUSEHWHEEL
#define WM_MOUSEHWHEEL 0x020E
#endif

/*
 * imm.h is needed by HandleIMEComposition
 */

#include <imm.h>
#ifdef _MSC_VER
#   pragma comment (lib, "imm32.lib")
................................................................................
 */

typedef struct ThreadSpecificData {
    TkDisplay *winDisplay;	/* TkDisplay structure that represents Windows
				 * screen. */
    int updatingClipboard;	/* If 1, we are updating the clipboard. */
    int surrogateBuffer;	/* Buffer for first of surrogate pair. */
    DWORD vWheelTickPrev;	/* For high resolution wheels (vertical). */
    DWORD hWheelTickPrev;	/* For high resolution wheels (horizontal). */
    short vWheelAcc;		/* For high resolution wheels (vertical). */
    short hWheelAcc;		/* For high resolution wheels (horizontal). */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations of functions used in this file.
 */

................................................................................
    const char *display_name)
{
    Screen *screen;
    TkWinDrawable *twdPtr;
    Display *display;
    ThreadSpecificData *tsdPtr =
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    DWORD initialWheelTick;

    if (tsdPtr->winDisplay != NULL) {
	if (!strcmp(tsdPtr->winDisplay->display->display_name, display_name)) {
	    return tsdPtr->winDisplay;
	} else {
	    return NULL;
	}
................................................................................

    TkWinDisplayChanged(display);

    tsdPtr->winDisplay = ckalloc(sizeof(TkDisplay));
    ZeroMemory(tsdPtr->winDisplay, sizeof(TkDisplay));
    tsdPtr->winDisplay->display = display;
    tsdPtr->updatingClipboard = FALSE;
    initialWheelTick = GetTickCount();
    tsdPtr->vWheelTickPrev = initialWheelTick;
    tsdPtr->hWheelTickPrev = initialWheelTick;
    tsdPtr->vWheelAcc = 0;
    tsdPtr->hWheelAcc = 0;

    /*
     * Key map info must be available immediately, because of "send event".
     */
    TkpInitKeymapInfo(tsdPtr->winDisplay);

    return tsdPtr->winDisplay;
................................................................................
    case WM_KILLFOCUS:
    case WM_DESTROYCLIPBOARD:
    case WM_UNICHAR:
    case WM_CHAR:
    case WM_SYSKEYUP:
    case WM_KEYUP:
    case WM_MOUSEWHEEL:
    case WM_MOUSEHWHEEL:
	GenerateXEvent(hwnd, message, wParam, lParam);
	return 1;
    case WM_MENUCHAR:
	GenerateXEvent(hwnd, message, wParam, lParam);

	/*
	 * MNC_CLOSE is the only one that looks right. This is a hack.
................................................................................
    LPARAM lParam)
{
    XEvent event;
    TkWindow *winPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if ((message == WM_MOUSEWHEEL) || (message == WM_MOUSEHWHEEL)) {
	union {LPARAM lParam; POINTS point;} root;
	POINT pos;
	root.lParam = lParam;

	/*
	 * Redirect mousewheel events to the window containing the cursor.
	 * That feels much less strange to users, and is how all the other
................................................................................
	event.type = SelectionClear;
	event.xselectionclear.selection =
		Tk_InternAtom((Tk_Window)winPtr, "CLIPBOARD");
	event.xselectionclear.time = TkpGetMS();
	break;

    case WM_MOUSEWHEEL:
    case WM_MOUSEHWHEEL:
    case WM_CHAR:
    case WM_UNICHAR:
    case WM_SYSKEYDOWN:
    case WM_SYSKEYUP:
    case WM_KEYDOWN:
    case WM_KEYUP: {
	unsigned int state = GetState(message, wParam, lParam);
................................................................................
	/*
	 * Now set up event specific fields.
	 */

	switch (message) {
	case WM_MOUSEWHEEL: {
	    /*
	     * Support for high resolution wheels (vertical).
	     */

	    DWORD wheelTick = GetTickCount();

	    if (wheelTick - tsdPtr->vWheelTickPrev < 1500) {
		tsdPtr->vWheelAcc += (short) HIWORD(wParam);
	    } else {
		tsdPtr->vWheelAcc = (short) HIWORD(wParam);
	    }
	    tsdPtr->vWheelTickPrev = wheelTick;
	    if (abs(tsdPtr->vWheelAcc) < WHEEL_DELTA) {
		return;
	    }

	    /*
	     * We have invented a new X event type to handle this event. It
	     * still uses the KeyPress struct. However, the keycode field has
	     * been overloaded to hold the zDelta of the wheel. Set nbytes to
	     * 0 to prevent conversion of the keycode to a keysym in
	     * TkpGetString. [Bug 1118340].
	     */

	    event.type = MouseWheelEvent;
	    event.xany.send_event = -1;
	    event.xkey.nbytes = 0;
	    event.xkey.keycode = tsdPtr->vWheelAcc / WHEEL_DELTA * WHEEL_DELTA;
	    tsdPtr->vWheelAcc = tsdPtr->vWheelAcc % WHEEL_DELTA;
	    break;
	}
	case WM_MOUSEHWHEEL: {
	    /*
	     * Support for high resolution wheels (horizontal).
	     */

	    DWORD wheelTick = GetTickCount();

	    if (wheelTick - tsdPtr->hWheelTickPrev < 1500) {
		tsdPtr->hWheelAcc -= (short) HIWORD(wParam);
	    } else {
		tsdPtr->hWheelAcc = -((short) HIWORD(wParam));
	    }
	    tsdPtr->hWheelTickPrev = wheelTick;
	    if (abs(tsdPtr->hWheelAcc) < WHEEL_DELTA) {
		return;
	    }

	    /*
	     * We have invented a new X event type to handle this event. It
	     * still uses the KeyPress struct. However, the keycode field has
	     * been overloaded to hold the zDelta of the wheel. Set nbytes to
................................................................................
	     * 0 to prevent conversion of the keycode to a keysym in
	     * TkpGetString. [Bug 1118340].
	     */

	    event.type = MouseWheelEvent;
	    event.xany.send_event = -1;
	    event.xkey.nbytes = 0;
	    event.xkey.state |= ShiftMask;
	    event.xkey.keycode = tsdPtr->hWheelAcc / WHEEL_DELTA * WHEEL_DELTA;
	    tsdPtr->hWheelAcc = tsdPtr->hWheelAcc % WHEEL_DELTA;
	    break;
	}
	case WM_SYSKEYDOWN:
	case WM_KEYDOWN:
	    /*
	     * Check for translated characters in the event queue. Setting
	     * xany.send_event to -1 indicates to the Windows implementation