Tk Source Code

have been returned by a previous call to \fBTk_GetFont\fR.
.AP "const char" *string in
Potentially multi-line string whose dimensions are to be computed and
stored in the text layout.  The \fIstring\fR must remain valid for the
lifetime of the text layout.
.AP int numChars in
The number of characters to consider from \fIstring\fR.  If
\fInumChars\fR is less than 0, then assumes \fIstring\fR is null
terminated and uses \fBTcl_NumUtfChars\fR to determine the length of
\fIstring\fR.
.AP int wrapLength in
Longest permissible line length, in pixels.  Lines in \fIstring\fR will
automatically be broken at word boundaries and wrapped when they reach
this length.  If \fIwrapLength\fR is too small for even a single
character to fit on a line, it will be expanded to allow one character to

\fBTk_PointToChar\fR uses the information in \fIlayout\fR to determine the
character closest to the given point.  The point is specified with respect
to the upper-left hand corner of the \fIlayout\fR, which is considered to be
located at (0, 0).  Any point whose \fIy\fR-value is less that 0 will be
considered closest to the first character in the text layout; any point
whose \fIy\fR-value is greater than the height of the text layout will be
considered closest to the last character in the text layout.  Any point
whose \fIx\fR-value is less than 0 will be considered closest to the first
character on that line; any point whose \fIx\fR-value is greater than the
width of the text layout will be considered closest to the last character on
that line.  The return value is the index of the character that was closest
to the point, or one more than the index of any character (to indicate that
the point was after the end of the string and that the corresponding caret
would be at the end of the string).  Given a \fIlayout\fR with no characters,
the value 0 will always be returned, referring to a hypothetical zero-width

Specifies an increment for horizontal scrolling, in any of the usual forms
permitted for screen distances. If the value of this option is greater
than zero, the horizontal view in the window will be constrained so that
the canvas x coordinate at the left edge of the window is always an even
multiple of \fBxScrollIncrement\fR; furthermore, the units for scrolling
(e.g., the change in view when the left and right arrows of a scrollbar
are selected) will also be \fBxScrollIncrement\fR. If the value of
this option is less than or equal to zero, then horizontal scrolling
is unconstrained.
.OP \-yscrollincrement yScrollIncrement ScrollIncrement
Specifies an increment for vertical scrolling, in any of the usual forms
permitted for screen distances. If the value of this option is greater
than zero, the vertical view in the window will be constrained so that
the canvas y coordinate at the top edge of the window is always an even
multiple of \fByScrollIncrement\fR; furthermore, the units for scrolling
(e.g., the change in view when the top and bottom arrows of a scrollbar
are selected) will also be \fByScrollIncrement\fR. If the value of
this option is less than or equal to zero, then vertical scrolling
is unconstrained.
.BE
.SH INTRODUCTION
.PP
The \fBcanvas\fR command creates a new window (given
by the \fIpathName\fR argument) and makes it into a canvas widget.
Additional options, described above, may be specified on the

always, because coordinates always appear in pairs.
.IP \fInumber\fR 10
A decimal number giving the position of the desired character
within the text item.
0 refers to the first character, 1 to the next character, and
so on. If indexes are odd for lines and polygons, they will be
automatically decremented by one.
A number less than 0 is treated as if it were zero, and a
number greater than the length of the text item is treated
as if it were equal to the length of the text item. For
polygons, numbers less than 0 or greater than the length
of the coordinate list will be adjusted by adding or subtracting
the length until the result is between zero and the length,
inclusive.
.IP \fBend\fR 10
Refers to the character or coordinate just after the last one
in the item (same as the number of characters or coordinates
in the item).

to display in the top portion of
the dialog, to the left of the text.
If this is an empty string then no bitmap is displayed in the dialog.
.IP \fIdefault\fR
If this is an integer greater than or equal to zero, then it gives
the index of the button that is to be the default button for the dialog
(0 for the leftmost button, and so on).
If less than zero or an empty string then there will not be any default
button.
.IP \fIstring\fR
There will be one button for each of these arguments.
Each \fIstring\fR specifies text to display in a button,
in order from left to right.
.PP
After creating a dialog box, \fBtk_dialog\fR waits for the user to

the valid Tcl boolean equivalent) then it means you reject the new edition
and it will not occur and the \fB\-invalidcommand\fR will be evaluated if it
is set. If it returns 1, then the new edition occurs.
See \fBVALIDATION\fR below for more information.
.OP \-width width Width
Specifies an integer value indicating the desired width of the entry window,
in average-size characters of the widget's font.
If the value is less than or equal to zero, the widget picks a
size just large enough to hold its current text.
.BE
.SH DESCRIPTION
.PP
The \fBentry\fR command creates a new window (given by the
\fIpathName\fR argument) and makes it into an entry widget.
Additional options, described above, may be specified on the

children of its own in this application.
This option may not be changed with the \fBconfigure\fR
widget command.
Note that \fB\-borderwidth\fR, \fB\-padx\fR and \fB\-pady\fR are ignored when
configured as a container since a container has no border.
.OP \-height height Height
Specifies the desired height for the window in any of the forms
acceptable to \fBTk_GetPixels\fR.  If this option is less than or equal
to zero then the window will not request any size at all.  Note that this
sets the total height of the frame, any \fB\-borderwidth\fR or similar is
not added.  Normally \fB\-height\fR should not be used if a propagating
geometry manager, such as \fBgrid\fR or \fBpack\fR, is used within the
frame since the geometry manager will override the height of the frame.
.OP \-tile tile Tile
.VS "8.7, TIP262"
This specifies how to draw the background image (see

forms accepted by \fBTk_GetVisual\fR.
If this option is not specified, the new window will use the same
visual as its parent.
The \fB\-visual\fR option may not be modified with the \fBconfigure\fR
widget command.
.OP \-width width Width
Specifies the desired width for the window in any of the forms
acceptable to \fBTk_GetPixels\fR.  If this option is less than or equal
to zero then the window will not request any size at all.  Note that this
sets the total width of the frame, any \fB\-borderwidth\fR or similar is
not added.  Normally \fB\-width\fR should not be used if a propagating
geometry manager, such as \fBgrid\fR or \fBpack\fR, is used within the
frame since the geometry manager will override the width of the frame.
.BE
.SH DESCRIPTION
.PP

If the \fB\-colormap\fR option is not specified, the new window
uses the same colormap as its parent.
This option may not be changed with the \fBconfigure\fR
widget command.
.OP \-height height Height
Specifies the desired height for the window in any of the forms
acceptable to \fBTk_GetPixels\fR.
If this option is less than or equal to zero then the window will
not request any size at all.
.OP \-labelanchor labelAnchor LabelAnchor
Specifies where to place the label. A label is only displayed if the
\fB\-text\fR option is not the empty string.
Valid values for this option are (listing them clockwise)
\fBnw\fR, \fBn\fR, \fBne\fR, \fBen\fR, \fBe\fR, \fBes\fR,
\fBse\fR, \fBs\fR,\fBsw\fR, \fBws\fR, \fBw\fR and \fBwn\fR.

If this option is not specified, the new window will use the same
visual as its parent.
The \fB\-visual\fR option may not be modified with the \fBconfigure\fR
widget command.
.OP \-width width Width
Specifies the desired width for the window in any of the forms
acceptable to \fBTk_GetPixels\fR.
If this option is less than or equal to zero then the window will
not request any size at all.
.BE
.SH DESCRIPTION
.PP
The \fBlabelframe\fR command creates a new window (given by the
\fIpathName\fR argument) and makes it into a labelframe widget.
Additional

in the vertical span of the window.
.OP \-width width Width
Specifies the length of lines in the window.
The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
If this option has a value greater than zero then the \fB\-aspect\fR
option is ignored and the \fB\-width\fR option determines the line
length.
If this option has a value less than or equal to zero, then
the \fB\-aspect\fR option determines the line length.
.BE
.SH DESCRIPTION
.PP
The \fBmessage\fR command creates a new window (given by the
\fIpathName\fR argument) and makes it into a message widget.
Additional

.OP \-wraplength wrapLength WrapLength
For widgets that can perform word-wrapping, this option specifies
the maximum line length.
Lines that would exceed this length are wrapped onto the next line,
so that no line is longer than the specified length.
The value may be specified in any of the standard forms for
screen distances.
If this value is less than or equal to 0 then no wrapping is done:  lines
will break only at newline characters in the text.
.OP \-xscrollcommand xScrollCommand ScrollCommand
Specifies the prefix for a command used to communicate with horizontal
scrollbars.
When the view in the widget's window changes (or
whenever anything else occurs that could change the display in a
scrollbar, such as a change in the total size of the widget's

value is changed via a widget command.
The actual command consists
of this option followed by a space and a real number indicating the
new value of the scale.
.OP \-digits digits Digits
An integer specifying how many significant digits should be retained
when converting the value of the scale to a string.
If the number is less than or equal to zero, then the scale picks
the smallest value that guarantees that every possible slider
position prints as a different string.
.OP \-from from From
A real value corresponding to the left or top end of the scale.
.OP \-label label Label
A string to display as a label for the scale.  For
vertical scales the label is displayed just to the right of the
top end of the scale.  For horizontal scales the label is displayed
just above the left end of the scale.  If the option is specified
as an empty string, no label is displayed.
.OP \-length length Length
Specifies the desired long dimension of the scale in screen units
(i.e. any of the forms acceptable to \fBTk_GetPixels\fR).
For vertical scales this is the scale's height;  for horizontal scales
it is the scale's width.
.OP \-resolution resolution Resolution
A real value specifying the resolution for the scale.
If this value is greater than zero then the scale's value will always be
rounded to an even multiple of this value, as will
the endpoints of the scale.  If the value is less than zero then no
rounding occurs.  Defaults to 1 (i.e., the value will be integral).
.OP \-showvalue showValue ShowValue
Specifies a boolean value indicating whether or not the current
value of the scale is to be displayed.
.OP \-sliderlength sliderLength SliderLength
Specifies the size of the slider, measured in screen units along the slider's
long dimension.  The value may be specified in any of the forms acceptable

All scrollable widgets have \fBxview\fR and \fByview\fR commands
that take exactly the additional arguments appended by the scrollbar
as described in \fBSCROLLING COMMANDS\fR below.
.OP \-elementborderwidth elementBorderWidth BorderWidth
Specifies the width of borders drawn around the internal elements
of the scrollbar (the two arrows and the slider).  The value may
have any of the forms acceptable to \fBTk_GetPixels\fR.
If this value is less than zero, the value of the \fB\-borderwidth\fR
option is used in its place.
.OP \-width width Width
Specifies the desired narrow dimension of the scrollbar window,
not including 3-D border, if any.  For vertical
scrollbars this will be the width and for horizontal scrollbars
this will be the height.
The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
.BE

.OP \-values values Values
Must be a proper list value.  If specified, the spinbox will use these
values as to control its contents, starting with the first value.  This
option has precedence over the \fB\-from\fR and \fB\-to\fR range.
.OP \-width width Width
Specifies an integer value indicating the desired width of the spinbox window,
in average-size characters of the widget's font.
If the value is less than or equal to zero, the widget picks a
size just large enough to hold its current text.
.OP \-wrap wrap wrap
Must be a proper boolean value.  If on, the spinbox will wrap around the
values of data in the widget.
.BE
.SH DESCRIPTION
.PP

things like geometry requests.  The window should not have any
children of its own in this application.
This option may not be changed with the \fBconfigure\fR
widget command.
.OP \-height height Height
Specifies the desired height for the window in any of the forms
acceptable to \fBTk_GetPixels\fR.
If this option is less than or equal to zero then the window will
not request any size at all.
.OP \-menu menu Menu
Specifies a menu widget to be used as a menubar. On the Macintosh, the
menubar will be displayed across the top of the main monitor. On
Microsoft Windows and all UNIX platforms, the menu will appear across
the toplevel window as part of the window dressing maintained by the
window manager.

If this option is not specified, the new window will use the default
visual for its screen.
The \fB\-visual\fR option may not be modified with the \fBconfigure\fR
widget command.
.OP \-width width Width
Specifies the desired width for the window in any of the forms
acceptable to \fBTk_GetPixels\fR.
If this option is less than or equal to zero then the window will
not request any size at all.
.BE
.SH DESCRIPTION
.PP
The \fBtoplevel\fR command creates a new toplevel widget (given
by the \fIpathName\fR argument).  Additional
options, described above, may be specified on the command line

A script template to evaluate whenever validation is triggered.
If set to the empty string (the default), validation is disabled.
The script must return a boolean value.
See \fBVALIDATION\fR below.
.OP \-width width Width
Specifies an integer value indicating the desired width of the entry window,
in average-size characters of the widget's font.
.\" Not in ttk: If the value is less than or equal to zero, the widget picks a
.\" Not in ttk: size just large enough to hold its current text.
.SH NOTES
.PP
A portion of the entry may be selected as described below.
If an entry is exporting its selection (see the \fB\-exportselection\fR
option), then it will observe the standard X11 protocols for handling the
selection;  entry selections are available as type \fBSTRING\fR.

a single number specifies the same border all the way around the element.
See \fBIMAGE STRETCHING\fR, below.
.\" OPTION: -height
.TP
\fB\-height \fIheight\fR
.
Specifies a minimum height for the element.
If less than zero, the base image's height is used as a default.
.\" OPTION: -padding
.TP
\fB\-padding\fI padding\fR
.
Specifies the element's interior padding.
The padding is a list of up to four length specifications
\fIleft top right bottom\fR.

or
.QW e .
.\" OPTION: -width
.TP
\fB\-width \fIwidth\fR
.
Specifies a minimum width for the element.
If less than zero, the base image's width is used as a default.
.SH "IMAGE STRETCHING"
.PP
If the element's allocated parcel is larger than the image,
the image will be placed in the parcel based on the \fB\-sticky\fR option.
If the image needs to stretch horizontally (i.e., \fB\-sticky ew\fR)
or vertically (\fB\-sticky ns\fR),
subregions of the image are replicated to fill the parcel

.\" Rewrite this:
Specifies the 3-D effect desired for the widget border.
Valid values are
\fBflat\fR, \fBgroove\fR, \fBraised\fR, \fBridge\fR, \fBsolid\fR,
and \fBsunken\fR.
.OP \-wraplength wrapLength WrapLength
Specifies the maximum line length (in pixels).
If this option is less than or equal to zero,
then automatic wrapping is not performed; otherwise
the text is split into lines such that no line is longer
than the specified value.
.SH "WIDGET COMMAND"
.PP
Label widgets support the standard commands
\fBcget\fR, \fBconfigure\fR, \fBidentify element\fR, \fBinstate\fR,

.
Creates a new item.
\fIparent\fR is the item ID of the parent item,
or the empty string \fB{}\fR
to create a new top-level item.
\fIindex\fR is an integer, or the value \fBend\fR, specifying where in the
list of \fIparent\fR's children to insert the new item.
If \fIindex\fR is less than or equal to zero,
the new node is inserted at the beginning;
if \fIindex\fR is greater than or equal to the current number of children,
it is inserted at the end.
If \fB\-id\fR is specified, it is used as the item identifier;
\fIid\fR must not already exist in the tree.
Otherwise, a new unique identifier is generated.
.RS

.TP
\fIpathname \fBmove \fIitem parent index\fR
.
Moves \fIitem\fR to position \fIindex\fR in \fIparent\fR's list of children.
It is illegal to move an item under one of its descendants.
.RS
.PP
If \fIindex\fR is less than or equal to zero, \fIitem\fR is moved
to the beginning; if greater than or equal to the number of children,
it is moved to the end.
.RE
.\" METHOD: next
.TP
\fIpathname \fBnext \fIitem\fR
.

/*
 * Flag values for Tk_OptionSpec structures. These flags are shared by
 * Tk_ConfigSpec structures, so be sure to coordinate any changes carefully.
 */

#define TK_OPTION_DONT_SET_DEFAULT	(1 << 3)
#if TCL_MAJOR_VERSION > 8
#    define TK_OPTION_NULL_OK		(1 << 5)
#else
#    define TK_OPTION_NULL_OK		(1 << 0)
#endif
#define TK_OPTION_NEG_OK		(1 << 6) /* For TK_OPTION_PIXELS only, so no conflict with TK_OPTION_VAR */
#define TK_OPTION_VAR(type)		((sizeof(type) < 2 * sizeof(int)) ? ((int)(sizeof(type)&(sizeof(int)-1))<<6) : (3<<6))
#define TK_OPTION_ENUM_VAR		TK_OPTION_VAR(Tk_OptionType)

 * Before changing any values here, coordinate with tkOldConfig.c
 * (internal-use-only flags are defined there).
 */

#define TK_CONFIG_COLOR_ONLY		(1 << 1)
#define TK_CONFIG_MONO_ONLY		(1 << 2)
#define TK_CONFIG_DONT_SET_DEFAULT	(1 << 3)
#define TK_CONFIG_USER_BIT		0x100
#if TCL_MAJOR_VERSION > 8
#    define TK_CONFIG_NULL_OK		(1 << 5)
#else
#    define TK_CONFIG_NULL_OK		(1 << 0)
#endif

#endif /* __NO_OLD_CONFIG */

/*
 * Structure used to specify how to handle argv options.
 */

typedef struct {

	if ((butPtr->state == STATE_ACTIVE)
		&& !Tk_StrictMotif(butPtr->tkwin)) {
	    Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->activeBorder);
	} else {
	    Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder);
	}
	if (butPtr->wrapLength < 0) {
	    butPtr->wrapLength = 0;
	    if (butPtr->wrapLengthPtr) {
		Tcl_DecrRefCount(butPtr->wrapLengthPtr);
	    }
	    butPtr->wrapLengthPtr = Tcl_NewIntObj(0);
	    Tcl_IncrRefCount(butPtr->wrapLengthPtr);
	}
	if (butPtr->borderWidth < 0) {
	    butPtr->borderWidth = 0;
	    if (butPtr->borderWidthPtr) {
		Tcl_DecrRefCount(butPtr->borderWidthPtr);
	    }
	    butPtr->borderWidthPtr = Tcl_NewIntObj(0);
	    Tcl_IncrRefCount(butPtr->borderWidthPtr);
	}
	if (butPtr->highlightWidth < 0) {
	    butPtr->highlightWidth = 0;
	    if (butPtr->highlightWidthPtr) {
		Tcl_DecrRefCount(butPtr->highlightWidthPtr);
	    }
	    butPtr->highlightWidthPtr = Tcl_NewIntObj(0);
	    Tcl_IncrRefCount(butPtr->highlightWidthPtr);
	}
	if (butPtr->padX < 0) {
	    butPtr->padX = 0;
	    if (butPtr->padXPtr) {
		Tcl_DecrRefCount(butPtr->padXPtr);
	    }
	    butPtr->padXPtr = Tcl_NewIntObj(0);
	    Tcl_IncrRefCount(butPtr->padXPtr);
	}
	if (butPtr->padY < 0) {
	    butPtr->padY = 0;
	    if (butPtr->padYPtr) {
		Tcl_DecrRefCount(butPtr->padYPtr);
	    }
	    butPtr->padYPtr = Tcl_NewIntObj(0);
	    Tcl_IncrRefCount(butPtr->padYPtr);
	}

	if (butPtr->type >= TYPE_CHECK_BUTTON) {
	    Tcl_Obj *valuePtr, *namePtr;

	    if (butPtr->selVarNamePtr == NULL) {
		butPtr->selVarNamePtr = Tcl_NewStringObj(
			Tk_Name(butPtr->tkwin), TCL_INDEX_NONE);

	    Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin),
		    canvasPtr->bgBorder, canvasPtr->highlightWidth,
		    canvasPtr->highlightWidth,
		    Tk_Width(tkwin) - 2*canvasPtr->highlightWidth,
		    Tk_Height(tkwin) - 2*canvasPtr->highlightWidth,
		    canvasPtr->borderWidth, canvasPtr->relief);
	}
	if (canvasPtr->highlightWidth != 0) {
	    GC fgGC, bgGC;

	    bgGC = Tk_GCForColor(canvasPtr->highlightBgColorPtr,
		    Tk_WindowId(tkwin));
	    if (canvasPtr->textInfo.gotFocus) {
		fgGC = Tk_GCForColor(canvasPtr->highlightColorPtr,
			Tk_WindowId(tkwin));

		goto invalidIntValue;
	    }
		if (internalPtr != NULL) {
			if (sizeof(long) > sizeof(int)) {
			    *((long *)oldInternalPtr) = *((long *)internalPtr);
			    *((long *)internalPtr) = (long)newWideInt;
			} else {
			    *((long long *)oldInternalPtr) = *((long long *) internalPtr);
			    *((long long *)internalPtr) = (long long)newWideInt;
			}
		}
	} else {
	    Tcl_Panic("Invalid flags for %s", "TK_OPTION_INT");
	}
	break;

	int newPixels;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
	    valuePtr = NULL;
	    newPixels = INT_MIN;
	} else if (Tk_GetPixelsFromObj(nullOK ? NULL : interp, tkwin, valuePtr,
		&newPixels) != TCL_OK) {
	    if (nullOK && interp) {


	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "expected screen distance or \"\" but got \"%.50s\"", Tcl_GetString(valuePtr)));

		Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL);

	    }
	    return TCL_ERROR;
	} else if (!(optionPtr->specPtr->flags & TK_OPTION_NEG_OK) && (newPixels < 0)) {
	    if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "expected nonnegative screen distance but got \"%.50s\"", Tcl_GetString(valuePtr)));
		    Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL);
	    }
	    return TCL_ERROR;
	}
	if (internalPtr != NULL) {
	    *((int *)oldInternalPtr) = *((int *)internalPtr);
	    *((int *)internalPtr) = newPixels;
	}
	break;
    }

	/*
	 * Recompute the window's geometry and arrange for it to be
	 * redisplayed.
	 */

	Tk_SetInternalBorder(entryPtr->tkwin,
		entryPtr->borderWidth + entryPtr->highlightWidth);
	if (entryPtr->highlightWidth <= 0) {
	    entryPtr->highlightWidth = 0;
	}
	entryPtr->inset = entryPtr->highlightWidth
		+ entryPtr->borderWidth + XPAD;
	break;
    }
    if (!error) {
	Tk_FreeSavedOptions(&savedOptions);
    }

    if (framePtr->border != NULL) {
	Tk_SetBackgroundFromBorder(framePtr->tkwin, framePtr->border);
    } else {
	Tk_SetWindowBackgroundPixmap(framePtr->tkwin, None);
    }

    if (framePtr->highlightWidth < 0) {
	framePtr->highlightWidth = 0;
    }
    if (framePtr->padX < 0) {
	framePtr->padX = 0;
    }
    if (framePtr->padY < 0) {
	framePtr->padY = 0;
    }

    /*
     * If a -labelwidget is specified, check that it is valid and set up
     * geometry management for it.
     */

    if (framePtr->type == TYPE_LABELFRAME) {
	if (oldWindow != labelframePtr->labelWin) {

	/*
	 * A few options need special processing, such as setting the
	 * background from a 3-D border.
	 */

	Tk_SetBackgroundFromBorder(listPtr->tkwin, listPtr->normalBorder);

	if (listPtr->highlightWidth < 0) {
	    listPtr->highlightWidth = 0;
	}
	listPtr->inset = listPtr->highlightWidth + listPtr->borderWidth;

	/*
	 * Claim the selection if we've suddenly started exporting it and
	 * there is a selection to export and this interp is unsafe.
	 */

	if ((mbPtr->state == STATE_ACTIVE)
		&& !Tk_StrictMotif(mbPtr->tkwin)) {
	    Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder);
	} else {
	    Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder);
	}

	if (mbPtr->highlightWidth < 0) {
	    mbPtr->highlightWidth = 0;
	}

	if (mbPtr->padX < 0) {
	    mbPtr->padX = 0;
	}
	if (mbPtr->padY < 0) {
	    mbPtr->padY = 0;
	}

	/*
	 * Get the image for the widget, if there is one. Allocate the new
	 * image before freeing the old one, so that the reference count
	 * doesn't go to zero and cause image data to be discarded.
	 */

	if (mbPtr->imageString != NULL) {

	    break;
	case TK_CONFIG_JOIN_STYLE:
	    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
	    if (Tk_GetJoinStyle(interp, uid, (int *)ptr) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case TK_CONFIG_PIXELS:
	    if (nullValue) {
		*(int *)ptr = (specPtr->specFlags & TK_OPTION_NEG_OK) ? INT_MIN : -1;
	    } if (Tk_GetPixels(interp, tkwin, value, (int *)ptr)
		!= TCL_OK) {
		return TCL_ERROR;
	    } else if (*(int *)ptr < 0) {
		*(int *)ptr = (specPtr->specFlags & TK_OPTION_NEG_OK) ? INT_MIN : -1;
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected nonnegative screen distance but got \"%.50s\"", value));

		Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", (char *)NULL);
		return TCL_ERROR;
	    }

	    break;

	case TK_CONFIG_MM:
	    if (Tk_GetScreenMM(interp, tkwin, value, (double *)ptr) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case TK_CONFIG_WINDOW: {
	    Tk_Window tkwin2;

	ComputeFormat(scalePtr, 0);
	ComputeFormat(scalePtr, 1);

	scalePtr->labelLength = scalePtr->label ? strlen(scalePtr->label) : 0;

	Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);

	if (scalePtr->highlightWidth < 0) {
	    scalePtr->highlightWidth = 0;
	}
	scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
	break;
    }
    if (!error) {
	Tk_FreeSavedOptions(&savedOptions);
    }

    scrollPtr->activeBorder = NULL;
    scrollPtr->troughColorPtr = NULL;
    scrollPtr->relief = TK_RELIEF_FLAT;
    scrollPtr->highlightWidth = 0;
    scrollPtr->highlightBgColorPtr = NULL;
    scrollPtr->highlightColorPtr = NULL;
    scrollPtr->inset = 0;
    scrollPtr->elementBorderWidth = -1;
    scrollPtr->arrowLength = 0;
    scrollPtr->sliderFirst = 0;
    scrollPtr->sliderLast = 0;
    scrollPtr->activeField = 0;
    scrollPtr->activeRelief = TK_RELIEF_RAISED;
    scrollPtr->firstFraction = 0.0;
    scrollPtr->lastFraction = 0.0;

	    textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &index1);
	}
	if (TkTextIndexCmp(&index3, &index2) > 0) {
	    textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &index2);
	}
    }

    /*
     * Don't allow negative spacings.
     */

    if (textPtr->spacing1 < 0) {
	textPtr->spacing1 = 0;
    }
    if (textPtr->spacing2 < 0) {
	textPtr->spacing2 = 0;
    }
    if (textPtr->spacing3 < 0) {
	textPtr->spacing3 = 0;
    }

    /*
     * Parse tab stops.
     */

    if (textPtr->tabArrayPtr != NULL) {
	ckfree(textPtr->tabArrayPtr);
	textPtr->tabArrayPtr = NULL;

	Tk_Draw3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
		textPtr->border, textPtr->highlightWidth,
		textPtr->highlightWidth,
		Tk_Width(textPtr->tkwin) - 2*textPtr->highlightWidth,
		Tk_Height(textPtr->tkwin) - 2*textPtr->highlightWidth,
		textPtr->borderWidth, textPtr->relief);
	if (textPtr->highlightWidth != 0) {
	    GC fgGC, bgGC;

	    bgGC = Tk_GCForColor(textPtr->highlightBgColorPtr,
		    Tk_WindowId(textPtr->tkwin));
	    if (textPtr->flags & GOT_FOCUS) {
		fgGC = Tk_GCForColor(textPtr->highlightColorPtr,
			Tk_WindowId(textPtr->tkwin));

    /*
     * Recompute some overall things for the layout. Even if the window gets
     * very small, pretend that there's at least one pixel of drawing space in
     * it.
     */

    if (textPtr->highlightWidth < 0) {
	textPtr->highlightWidth = 0;
    }
    dInfoPtr->x = textPtr->highlightWidth + textPtr->borderWidth
	    + textPtr->padX;
    dInfoPtr->y = textPtr->highlightWidth + textPtr->borderWidth
	    + textPtr->padY;
    dInfoPtr->maxX = Tk_Width(textPtr->tkwin) - textPtr->highlightWidth
	    - textPtr->borderWidth - textPtr->padX;
    if (dInfoPtr->maxX <= dInfoPtr->x) {

	    /*
	     * Some of the configuration options, like -underline and
	     * -justify, require additional translation (this is needed
	     * because we need to distinguish a particular value of an option
	     * from "unspecified").
	     */

	    if (tagPtr->borderWidth < 0) {
		tagPtr->borderWidth = 0;
	    }
	    if (tagPtr->spacing1 != INT_MIN) {
		if (tagPtr->spacing1 < 0) {
		    tagPtr->spacing1 = 0;
		}
	    }
	    if (tagPtr->spacing2 != INT_MIN) {
		if (tagPtr->spacing2 < 0) {
		    tagPtr->spacing2 = 0;
		}
	    }
	    if (tagPtr->spacing3 != INT_MIN) {
		if (tagPtr->spacing3 < 0) {
		    tagPtr->spacing3 = 0;
		}
	    }
	    if (tagPtr->tabArrayPtr != NULL) {
		ckfree(tagPtr->tabArrayPtr);
		tagPtr->tabArrayPtr = NULL;
	    }
	    if (tagPtr->tabStringPtr != NULL) {
		tagPtr->tabArrayPtr =
			TkTextGetTabs(interp, textPtr->tkwin, tagPtr->tabStringPtr);

    Tcl_Release(scalePtr);

    /*
     * Now handle the part of redisplay that is the same for horizontal and
     * vertical scales: border and traversal highlight.
     */

    if (scalePtr->highlightWidth != 0) {
	GC gc = Tk_GCForColor(scalePtr->highlightColorPtr, Tk_WindowId(tkwin));

	Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth,
		Tk_WindowId(tkwin));
    }
    Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), scalePtr->bgBorder,
	    scalePtr->highlightWidth, scalePtr->highlightWidth,

    CGContextConcatCTM(dc.context, t);

    /*
     * Draw a 3D rectangle to provide a base for the native scrollbar.
     */

    if (scrollPtr->highlightWidth != 0) {
    	GC fgGC, bgGC;

    	bgGC = Tk_GCForColor(scrollPtr->highlightBgColorPtr, (Pixmap) macWin);
    	if (scrollPtr->flags & GOT_FOCUS) {
    	    fgGC = Tk_GCForColor(scrollPtr->highlightColorPtr, (Pixmap) macWin);
    	} else {
    	    fgGC = bgGC;

     * case of having both buttons at the end, but where scrollPtr->arrowLength
     * happens to be zero.  To adjust for having both arrows at the same end we
     * shift the scrollbar up by the arrowLength.
     */

    int fieldLength;

    if (scrollPtr->highlightWidth < 0) {
	scrollPtr->highlightWidth = 0;
    }
    scrollPtr->inset = scrollPtr->highlightWidth + scrollPtr->borderWidth;
    if ([NSApp macOSVersion] == 100600) {
	scrollPtr->arrowLength = scrollPtr->width;
    } else {
	scrollPtr->arrowLength = 0;
    }
    fieldLength = (scrollPtr->vertical ? Tk_Height(scrollPtr->tkwin)

	msPtr->info.value = factor * scrollPtr->firstFraction;
    }

    if ((scrollPtr->firstFraction <= 0.0 && scrollPtr->lastFraction >= 1.0)
	    || height <= metrics.minHeight) {
    	msPtr->info.enableState = kThemeTrackHideTrack;
    } else {
        msPtr->info.enableState = kThemeTrackActive;
    	msPtr->info.attributes =
		kThemeTrackShowThumb | kThemeTrackThumbRgnIsNotGhost;
    }
}

/*
 *--------------------------------------------------------------
 *

    pack .e ; update idletasks
    update
} -body {
    .e configure -highlightthickness -2
    .e cget -highlightthickness
} -cleanup {
    destroy .e
} -returnCodes error -result {expected nonnegative screen distance but got "-2"}
test entry-1.29 {configuration option: "highlightthickness" for entry} -setup {
    entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
    pack .e ; update idletasks
    update
} -body {
    .e configure -highlightthickness badValue
} -cleanup {

    .l configure -highlightthickness bogus
} -returnCodes error -result {expected screen distance but got "bogus"}
test listbox-1.31 {configuration options} -body {
    .l configure -highlightthickness -2
    list [lindex [.l configure -highlightthickness] 4] [.l cget -highlightthickness]
} -cleanup {
    .l configure -highlightthickness [lindex [.l configure -highlightthickness] 3]
} -returnCodes error -result {expected nonnegative screen distance but got "-2"}
test listbox-1.32.1 {configuration options} -setup {
    set res {}
} -body {
    .l configure -justify left
    set res [list [lindex [.l configure -justify] 4] [.l cget -justify]]
    .l configure -justify center
    lappend res [lindex [.l configure -justify] 4] [.l cget -justify]

    pack .l
    update
} -body {
    .l configure -highlightthickness -3
    .l cget -highlightthickness
} -cleanup {
    deleteWindows
} -returnCodes error -result {expected nonnegative screen distance but got "-3"}
test listbox-4.3 {ConfigureListbox procedure} -setup {
    deleteWindows
    destroy .l
    listbox .l -setgrid 1 -width 25 -height 15
    pack .l
    update
} -body {

    pack .m
    update
} -body {
    .m configure -padx -2 -pady -2 -width -2
    list [.m cget -padx] [.m cget -pady] [.m cget -borderwidth] [.m cget -highlightthickness]  [.m cget -width]
} -cleanup {
    destroy .m
} -returnCodes error -result {expected nonnegative screen distance but got "-2"}


test message-2.1 {Tk_MessageObjCmd procedure} -body {
    message
} -returnCodes {error} -result {wrong # args: should be "message pathName ?-option value ...?"}

test message-2.2 {Tk_MessageObjCmd procedure} -body {

    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bd 4 4 badValue {expected screen distance but got "badValue"}}
    {-bg #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-borderwidth 1.3 1 badValue {expected screen distance but got "badValue"}}
    {-command "set x" {set x} {} {}}
    {-elementborderwidth 4 4 badValue {expected screen distance but got "badValue"}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
    {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
    {-highlightthickness 6 6 bogus {expected screen distance but got "bogus"}}
    {-highlightthickness -2 0 {} {}}
    {-jump true 1 silly {expected boolean value but got "silly"}}
    {-orient horizontal horizontal badValue
	    {bad orientation "badValue": must be vertical or horizontal}}
    {-orient horizontal horizontal bogus {bad orientation "bogus": must be vertical or horizontal}}
    {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
    {-repeatdelay 140 140 129.3 {expected integer but got "129.3"}}
    {-repeatinterval 140 140 129.3 {expected integer but got "129.3"}}

    pack .e
    update
} -body {
    .e configure -highlightthickness -2
    .e cget -highlightthickness
} -cleanup {
    destroy .e
} -returnCodes error -result {expected nonnegative screen distance but got "-2"}

test spinbox-1.41 {configuration option: "increment"} -setup {
        spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \
        -relief sunken
    pack .e
    update
} -body {

    pack .t
    update
} -body {
    .t configure -highlightthickness -2
    .t cget -highlightthickness
} -cleanup {
    destroy .t
} -returnCodes error -result {expected nonnegative screen distance but got "-2"}
test text-1.30 {configuration option: "highlightthickness"} -setup {
    text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold}
    pack .t
    update
} -body {
    .t configure -highlightthickness bad
} -cleanup {

    pack .t
    update
} -body {
    .t configure -spacing1 -5
    .t cget -spacing1
} -cleanup {
    destroy .t
} -returnCodes error -result {expected nonnegative screen distance but got "-5"}
test text-1.60 {configuration option: "spacing1"} -setup {
    text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold}
    pack .t
    update
} -body {
    .t configure -spacing1 bogus
} -cleanup {

    pack .t
    update
} -body {
    .t configure -spacing2 -1
    .t cget -spacing2
} -cleanup {
    destroy .t
} -returnCodes error -result {expected nonnegative screen distance but got "-1"}
test text-1.64 {configuration option: "spacing2"} -setup {
    text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold}
    pack .t
    update
} -body {
    .t configure -spacing2 bogus
} -cleanup {

    pack .t
    update
} -body {
    .t configure -spacing3 -10
    .t cget -spacing3
} -cleanup {
    destroy .t
} -returnCodes error -result {expected nonnegative screen distance but got "-10"}
test text-1.68 {configuration option: "spacing3"} -setup {
    text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold}
    pack .t
    update
} -body {
    .t configure -spacing3 bogus
} -cleanup {

test text-14.2 {ConfigureText procedure} -setup {
    text .t
} -body {
    .t configure -spacing1 -2 -spacing2 1 -spacing3 1
    list [.t cget -spacing1] [.t cget -spacing2] [.t cget -spacing3]
} -cleanup {
    destroy .t
} -returnCodes {error} -result {expected nonnegative screen distance but got "-2"}
test text-14.3 {ConfigureText procedure} -setup {
    text .t
} -body {
    .t configure -spacing1 1 -spacing2 -1 -spacing3 1
    list [.t cget -spacing1] [.t cget -spacing2] [.t cget -spacing3]
} -cleanup {
    destroy .t
} -returnCodes {error} -result {expected nonnegative screen distance but got "-1"}
test text-14.4 {ConfigureText procedure} -setup {
    text .t
} -body {
    .t configure -spacing1 1 -spacing2 1 -spacing3 -3
    list [.t cget -spacing1] [.t cget -spacing2] [.t cget -spacing3]
} -cleanup {
    destroy .t
} -returnCodes {error} -result {expected nonnegative screen distance but got "-3"}
test text-14.5 {ConfigureText procedure} -setup {
    text .t
} -body {
    .t configure -tabs {30 foo}
} -cleanup {
    destroy .t
} -returnCodes {error} -result {bad tab alignment "foo": must be left, right, center, or numeric}

    if (mbPtr->relief != TK_RELIEF_FLAT) {
	Tk_Draw3DRectangle(tkwin, pixmap, border,
		mbPtr->highlightWidth, mbPtr->highlightWidth,
		Tk_Width(tkwin) - 2*mbPtr->highlightWidth,
		Tk_Height(tkwin) - 2*mbPtr->highlightWidth,
		mbPtr->borderWidth, mbPtr->relief);
    }
    if (mbPtr->highlightWidth != 0) {
	if (mbPtr->flags & GOT_FOCUS) {
	    gc = Tk_GCForColor(mbPtr->highlightColorPtr, pixmap);
	} else {
	    gc = Tk_GCForColor(mbPtr->highlightBgColorPtr, pixmap);
	}
	Tk_DrawFocusHighlight(tkwin, gc, mbPtr->highlightWidth, pixmap);
    }

	if (scalePtr->relief != TK_RELIEF_FLAT) {
	    Tk_Draw3DRectangle(tkwin, pixmap, scalePtr->bgBorder,
		    scalePtr->highlightWidth, scalePtr->highlightWidth,
		    Tk_Width(tkwin) - 2*scalePtr->highlightWidth,
		    Tk_Height(tkwin) - 2*scalePtr->highlightWidth,
		    scalePtr->borderWidth, scalePtr->relief);
	}
	if (scalePtr->highlightWidth != 0) {
	    GC gc;

	    if (scalePtr->flags & GOT_FOCUS) {
		gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap);
	    } else {
		gc = Tk_GCForColor(
			Tk_3DBorderColor(scalePtr->highlightBorder), pixmap);

     * operation. This means that there's no point in time where the on-sreen
     * image has been cleared.
     */

    pixmap = Tk_GetPixmap(scrollPtr->display, Tk_WindowId(tkwin),
	    Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));

    if (scrollPtr->highlightWidth != 0) {
	GC gc;

	if (scrollPtr->flags & GOT_FOCUS) {
	    gc = Tk_GCForColor(scrollPtr->highlightColorPtr, pixmap);
	} else {
	    gc = Tk_GCForColor(scrollPtr->highlightBgColorPtr, pixmap);
	}

TkpComputeScrollbarGeometry(
    TkScrollbar *scrollPtr)
				/* Scrollbar whose geometry may have
				 * changed. */
{
    int width, fieldLength;

    if (scrollPtr->highlightWidth < 0) {
	scrollPtr->highlightWidth = 0;
    }
    scrollPtr->inset = scrollPtr->highlightWidth + scrollPtr->borderWidth;
    width = (scrollPtr->vertical) ? Tk_Width(scrollPtr->tkwin)
	    : Tk_Height(scrollPtr->tkwin);

    /*
     * Next line assumes that the arrow area is a square.
     */

    SetEnvironmentVariable("LINK", "");

    if (argc > 1 && *argv[1] == '-') {
	switch (*(argv[1]+1)) {
	case 'c':
	    if (argc != 3) {
		chars = snprintf(msg, sizeof(msg) - 1,
		        "usage: %s -c <compiler option>\n"
			"Tests for whether cl.exe supports an option\n"
			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
			&dwWritten, NULL);
		return 2;
	    }
	    return CheckForCompilerFeature(argv[2]);

    /*
     * Look for the commandline warning code in both streams.
     *  - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002.
     */

    return !(strstr(Out.buffer, "D4002") != NULL
             || strstr(Err.buffer, "D4002") != NULL
             || strstr(Out.buffer, "D9002") != NULL
             || strstr(Err.buffer, "D9002") != NULL
             || strstr(Out.buffer, "D2021") != NULL
             || strstr(Err.buffer, "D2021") != NULL);
}

static int
CheckForLinkerFeature(
    char **options,
    int count)
{

    int result, locale, noBackslash = 0;

    if ((selection != Tk_InternAtom(tkwin, "CLIPBOARD"))
	    || (target != XA_STRING)) {
	goto error;
    }
    if (!OpenClipboard(NULL)) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	        "clipboard cannot be opened, another application grabbed it"));
        Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "BUSY", NULL);
        return TCL_ERROR;
    }

    /*
     * Attempt to get the data in Unicode form if available as this is less
     * work that CF_TEXT.
     */

    Tcl_Obj *initialTypeObj;    /* Initial value of above, or NULL */
    Tcl_DString utfDirString;   /* Initial dir */
    int multi;                  /* Multiple selection enabled */
    int confirmOverwrite;       /* Confirm before overwriting */
    int mustExist;              /* Used only for  */
    int forceXPStyle;          /* XXX - Force XP style even on newer systems */
    WCHAR file[TK_MULTI_MAX_PATH]; /* File name
                                      XXX - fixed size because it was so
                                      historically. Why not malloc'ed ?
                                   */
} OFNOpts;

/* Define the operation for which option parsing is to be done. */
enum OFNOper {
    OFN_FILE_SAVE,              /* tk_getOpenFile */
    OFN_FILE_OPEN,              /* tk_getSaveFile */
    OFN_DIR_CHOOSE              /* tk_chooseDirectory */

#endif /* __MSVCRT__ */
typedef struct IShellItemArray IShellItemArray;
typedef struct IShellItemArrayVtbl
{
    BEGIN_INTERFACE

    HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
        IShellItemArray *, REFIID riid,void **ppvObject);
    ULONG ( STDMETHODCALLTYPE *AddRef )(IShellItemArray *);
    ULONG ( STDMETHODCALLTYPE *Release )(IShellItemArray *);
    HRESULT ( STDMETHODCALLTYPE *BindToHandler )(IShellItemArray *,
        IBindCtx *, REFGUID, REFIID, void **);
    /* flags is actually is enum GETPROPERTYSTOREFLAGS */
    HRESULT ( STDMETHODCALLTYPE *GetPropertyStore )(
        IShellItemArray *, int,  REFIID, void **);
    /* keyType actually REFPROPERTYKEY */
    HRESULT ( STDMETHODCALLTYPE *GetPropertyDescriptionList )(
         IShellItemArray *, void *, REFIID, void **);
    HRESULT ( STDMETHODCALLTYPE *GetAttributes )(IShellItemArray *,
        SIATTRIBFLAGS, SFGAOF, SFGAOF *);
    HRESULT ( STDMETHODCALLTYPE *GetCount )(
        IShellItemArray *, DWORD *);
    HRESULT ( STDMETHODCALLTYPE *GetItemAt )(
        IShellItemArray *, DWORD, IShellItem **);
    /* ppenumShellItems actually (IEnumShellItems **) */
    HRESULT ( STDMETHODCALLTYPE *EnumItems )(
        IShellItemArray *, void **);

    END_INTERFACE
} IShellItemArrayVtbl;

struct IShellItemArray {
    CONST_VTBL struct IShellItemArrayVtbl *lpVtbl;
};

typedef struct IFileDialog IFileDialog;
typedef struct IFileDialogVtbl
{
    BEGIN_INTERFACE

    HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
         IFileDialog *, REFIID, void **);
    ULONG ( STDMETHODCALLTYPE *AddRef )( IFileDialog *);
    ULONG ( STDMETHODCALLTYPE *Release )( IFileDialog *);
    HRESULT ( STDMETHODCALLTYPE *Show )( IFileDialog *, HWND);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileDialog *,
        UINT, const TCLCOMDLG_FILTERSPEC *);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(IFileDialog *, UINT);
    HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(IFileDialog *, UINT *);
    /* XXX - Actually pfde is IFileDialogEvents* but we do not use
       this call and do not want to define IFileDialogEvents as that
       pulls in a whole bunch of other stuff. */
    HRESULT ( STDMETHODCALLTYPE *Advise )(
        IFileDialog *, void *, DWORD *);
    HRESULT ( STDMETHODCALLTYPE *Unadvise )(IFileDialog *, DWORD);
    HRESULT ( STDMETHODCALLTYPE *SetOptions )(
        IFileDialog *, FILEOPENDIALOGOPTIONS);
    HRESULT ( STDMETHODCALLTYPE *GetOptions )(
        IFileDialog *, FILEOPENDIALOGOPTIONS *);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )(
        IFileDialog *, IShellItem *);
    HRESULT ( STDMETHODCALLTYPE *SetFolder )(
        IFileDialog *, IShellItem *);
    HRESULT ( STDMETHODCALLTYPE *GetFolder )(
        IFileDialog *, IShellItem **);
    HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )(
        IFileDialog *, IShellItem **);
    HRESULT ( STDMETHODCALLTYPE *SetFileName )(
        IFileDialog *,  LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *GetFileName )(
        IFileDialog *,  LPWSTR *);
    HRESULT ( STDMETHODCALLTYPE *SetTitle )(
        IFileDialog *, LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )(
        IFileDialog *, LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )(
        IFileDialog *,  LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *GetResult )(
        IFileDialog *, IShellItem **);
    HRESULT ( STDMETHODCALLTYPE *AddPlace )(
        IFileDialog *, IShellItem *, FDAP);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )(
         IFileDialog *, LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *Close )( IFileDialog *, HRESULT);
    HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
        IFileDialog *, REFGUID);
    HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileDialog *);
    /* pFilter actually IShellItemFilter. But deprecated in Win7 AND we do
       not use it anyways. So define as void* */
    HRESULT ( STDMETHODCALLTYPE *SetFilter )(
         IFileDialog *, void *);

    END_INTERFACE
} IFileDialogVtbl;

struct IFileDialog {
    CONST_VTBL struct IFileDialogVtbl *lpVtbl;
};


typedef struct IFileSaveDialog IFileSaveDialog;
typedef struct IFileSaveDialogVtbl {
    BEGIN_INTERFACE

    HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
        IFileSaveDialog *, REFIID, void **);
    ULONG ( STDMETHODCALLTYPE *AddRef )( IFileSaveDialog *);
    ULONG ( STDMETHODCALLTYPE *Release )( IFileSaveDialog *);
    HRESULT ( STDMETHODCALLTYPE *Show )(
        IFileSaveDialog *, HWND);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileSaveDialog *,
        UINT, const TCLCOMDLG_FILTERSPEC *);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(
        IFileSaveDialog *, UINT);
    HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(
         IFileSaveDialog *, UINT *);
    /* Actually pfde is IFileSaveDialogEvents* */
    HRESULT ( STDMETHODCALLTYPE *Advise )(
         IFileSaveDialog *, void *, DWORD *);
    HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileSaveDialog *, DWORD);
    HRESULT ( STDMETHODCALLTYPE *SetOptions )(
         IFileSaveDialog *, FILEOPENDIALOGOPTIONS);
    HRESULT ( STDMETHODCALLTYPE *GetOptions )(
         IFileSaveDialog *, FILEOPENDIALOGOPTIONS *);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )(
         IFileSaveDialog *, IShellItem *);
    HRESULT ( STDMETHODCALLTYPE *SetFolder )(
        IFileSaveDialog *, IShellItem *);
    HRESULT ( STDMETHODCALLTYPE *GetFolder )(
         IFileSaveDialog *, IShellItem **);
    HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )(
         IFileSaveDialog *, IShellItem **);
    HRESULT ( STDMETHODCALLTYPE *SetFileName )(
         IFileSaveDialog *,  LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *GetFileName )(
         IFileSaveDialog *,  LPWSTR *);
    HRESULT ( STDMETHODCALLTYPE *SetTitle )(
         IFileSaveDialog *, LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )(
         IFileSaveDialog *,  LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )(
         IFileSaveDialog *,  LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *GetResult )(
         IFileSaveDialog *, IShellItem **);
    HRESULT ( STDMETHODCALLTYPE *AddPlace )(
         IFileSaveDialog *, IShellItem *, FDAP);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )(
         IFileSaveDialog *, LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *Close )( IFileSaveDialog *, HRESULT);
    HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
        IFileSaveDialog *, REFGUID);
    HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileSaveDialog *);
    /* pFilter Actually IShellItemFilter* */
    HRESULT ( STDMETHODCALLTYPE *SetFilter )(
        IFileSaveDialog *, void *);
    HRESULT ( STDMETHODCALLTYPE *SetSaveAsItem )(
        IFileSaveDialog *, IShellItem *);
    HRESULT ( STDMETHODCALLTYPE *SetProperties )(
        IFileSaveDialog *, IPropertyStore *);
    HRESULT ( STDMETHODCALLTYPE *SetCollectedProperties )(
        IFileSaveDialog *, IPropertyDescriptionList *, BOOL);
    HRESULT ( STDMETHODCALLTYPE *GetProperties )(
        IFileSaveDialog *, IPropertyStore **);
    HRESULT ( STDMETHODCALLTYPE *ApplyProperties )(
        IFileSaveDialog *, IShellItem *, IPropertyStore *,
        HWND, IFileOperationProgressSink *);

    END_INTERFACE

} IFileSaveDialogVtbl;

struct IFileSaveDialog {
    CONST_VTBL struct IFileSaveDialogVtbl *lpVtbl;
};

typedef struct IFileOpenDialog IFileOpenDialog;
typedef struct IFileOpenDialogVtbl {
    BEGIN_INTERFACE

    HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
        IFileOpenDialog *, REFIID, void **);
    ULONG ( STDMETHODCALLTYPE *AddRef )( IFileOpenDialog *);
    ULONG ( STDMETHODCALLTYPE *Release )( IFileOpenDialog *);
    HRESULT ( STDMETHODCALLTYPE *Show )( IFileOpenDialog *, HWND);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileOpenDialog *,
        UINT, const TCLCOMDLG_FILTERSPEC *);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(
        IFileOpenDialog *, UINT);
    HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(
        IFileOpenDialog *, UINT *);
    /* Actually pfde is IFileDialogEvents* */
    HRESULT ( STDMETHODCALLTYPE *Advise )(
        IFileOpenDialog *, void *, DWORD *);
    HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileOpenDialog *, DWORD);
    HRESULT ( STDMETHODCALLTYPE *SetOptions )(
        IFileOpenDialog *, FILEOPENDIALOGOPTIONS);
    HRESULT ( STDMETHODCALLTYPE *GetOptions )(
        IFileOpenDialog *, FILEOPENDIALOGOPTIONS *);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )(
        IFileOpenDialog *, IShellItem *);
    HRESULT ( STDMETHODCALLTYPE *SetFolder )(
        IFileOpenDialog *, IShellItem *);
    HRESULT ( STDMETHODCALLTYPE *GetFolder )(
        IFileOpenDialog *, IShellItem **);
    HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )(
        IFileOpenDialog *, IShellItem **);
    HRESULT ( STDMETHODCALLTYPE *SetFileName )(
        IFileOpenDialog *,  LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *GetFileName )(
        IFileOpenDialog *, LPWSTR *);
    HRESULT ( STDMETHODCALLTYPE *SetTitle )(
        IFileOpenDialog *, LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )(
        IFileOpenDialog *, LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )(
        IFileOpenDialog *, LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *GetResult )(
        IFileOpenDialog *, IShellItem **);
    HRESULT ( STDMETHODCALLTYPE *AddPlace )(
        IFileOpenDialog *, IShellItem *, FDAP);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )(
        IFileOpenDialog *, LPCWSTR);
    HRESULT ( STDMETHODCALLTYPE *Close )( IFileOpenDialog *, HRESULT);
    HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
        IFileOpenDialog *, REFGUID);
    HRESULT ( STDMETHODCALLTYPE *ClearClientData )(
        IFileOpenDialog *);
    HRESULT ( STDMETHODCALLTYPE *SetFilter )(
        IFileOpenDialog *,
        /* pFilter is actually IShellItemFilter */
        void *);
    HRESULT ( STDMETHODCALLTYPE *GetResults )(
        IFileOpenDialog *, IShellItemArray **);
    HRESULT ( STDMETHODCALLTYPE *GetSelectedItems )(
        IFileOpenDialog *, IShellItemArray **);

    END_INTERFACE
} IFileOpenDialogVtbl;

struct IFileOpenDialog
{
    CONST_VTBL struct IFileOpenDialogVtbl *lpVtbl;

static UINT APIENTRY	ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg,
			    LPARAM wParam, LPARAM lParam);
static UINT CALLBACK	ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
			    LPARAM lParam);
static void             CleanupOFNOptions(OFNOpts *optsPtr);
static int              ParseOFNOptions(void *clientData,
                            Tcl_Interp *interp, int objc,
                            Tcl_Obj *const objv[], enum OFNOper oper, OFNOpts *optsPtr);
static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr,
                         enum OFNOper oper);
static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr,
                            enum OFNOper oper);
static int 		GetFileName(void *clientData,
                                    Tcl_Interp *interp, int objc,
                                    Tcl_Obj *const objv[], enum OFNOper oper);
static int MakeFilterVista(Tcl_Interp *interp, OFNOpts *optsPtr,
               DWORD *countPtr, TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr,
               DWORD *defaultFilterIndexPtr);
static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr);
static int 		MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_DString *dsPtr, Tcl_Obj *initialPtr,
			    int *indexPtr);
static UINT APIENTRY	OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
			    LPARAM lParam);
static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam);

    OFNOpts *optsPtr)           /* Output, uninitialized on entry */
{
    int i;
    Tcl_DString ds;
    enum options {
	FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, FILE_PARENT,
	FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW,
        FILE_MUSTEXIST,
    };
    struct Options {
	const char *name;
	enum options value;
    };
    static const struct Options saveOptions[] = {
	{"-confirmoverwrite",	FILE_CONFIRMOW},

    for (i = 1; i < objc; i += 2) {
	int index;
	const char *string;
	Tcl_Obj *valuePtr;

	if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
		sizeof(struct Options), "option", 0, &index) != TCL_OK) {
            /*
             * XXX -xpstyle is explicitly checked for as it is undocumented
             * and we do not want it to show in option error messages.
             */
            if (strcmp(Tcl_GetString(objv[i]), "-xpstyle"))
                goto error_return;
            if (i + 1 == objc) {
                Tcl_SetObjResult(interp, Tcl_NewStringObj("value for \"-xpstyle\" missing", TCL_INDEX_NONE));
                Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
                goto error_return;
            }
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1],
                                      &optsPtr->forceXPStyle) != TCL_OK)
                goto error_return;

            continue;

	} else if (i + 1 == objc) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                                 "value for \"%s\" missing", options[index].name));
            Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
            goto error_return;
	}

        valuePtr = objv[i + 1];
	string = Tcl_GetString(valuePtr);
	switch (options[index].value) {
	case FILE_DEFAULT:
	    optsPtr->extObj = valuePtr;
	    break;
	case FILE_TYPES:
	    optsPtr->filterObj = valuePtr;
	    break;
	case FILE_INITDIR:
	    Tcl_DStringFree(&optsPtr->utfDirString);
	    if (Tcl_TranslateFileName(interp, string,
                                      &optsPtr->utfDirString) == NULL)
		goto error_return;
	    break;
	case FILE_INITFILE:
	    if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
		goto error_return;
	    Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(),
                              Tcl_DStringValue(&ds), Tcl_DStringLength(&ds),
                              TCL_ENCODING_PROFILE_TCL8, NULL, (char *)&optsPtr->file[0],
                              sizeof(optsPtr->file), NULL, NULL, NULL);
	    Tcl_DStringFree(&ds);
	    break;
	case FILE_PARENT:
	    optsPtr->tkwin = Tk_NameToWindow(interp, string, (Tk_Window)clientData);
	    if (optsPtr->tkwin == NULL)
		goto error_return;
	    break;
	case FILE_TITLE:
	    optsPtr->titleObj = valuePtr;
	    break;
	case FILE_TYPEVARIABLE:
	    optsPtr->typeVariableObj = valuePtr;
	    optsPtr->initialTypeObj = Tcl_ObjGetVar2(interp, valuePtr,
                                                     NULL, TCL_GLOBAL_ONLY);
	    break;
	case FILE_MULTIPLE:
	    if (Tcl_GetBooleanFromObj(interp, valuePtr,
                                      &optsPtr->multi) != TCL_OK)
                goto error_return;
	    break;
	case FILE_CONFIRMOW:
	    if (Tcl_GetBooleanFromObj(interp, valuePtr,
                                      &optsPtr->confirmOverwrite) != TCL_OK)
                goto error_return;
	    break;
        case FILE_MUSTEXIST:
	    if (Tcl_GetBooleanFromObj(interp, valuePtr,
                                      &optsPtr->mustExist) != TCL_OK)
                goto error_return;
            break;
	}
    }

    return TCL_OK;

error_return:                   /* interp should already hold error */
    /* On error, we need to clean up anything we might have allocated */

 *----------------------------------------------------------------------
 */
static int VistaFileDialogsAvailable(void)
{
    HRESULT hr;
    IFileDialog *fdlgPtr = NULL;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
        Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (tsdPtr->newFileDialogsState == FDLG_STATE_INIT) {
	tsdPtr->newFileDialogsState = FDLG_STATE_USE_OLD;
	hr = CoInitialize(0);
	/* XXX - need we schedule CoUninitialize at thread shutdown ? */

	/* Ensure all COM interfaces we use are available */

 *      TCL_ERROR - error return
 *
 * Side effects:
 *      Dialogs is displayed
 *----------------------------------------------------------------------
 */
static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr,
                            enum OFNOper oper)
{
    HRESULT hr;
    HWND hWnd;
    DWORD flags, nfilters, defaultFilterIndex;
    TCLCOMDLG_FILTERSPEC *filterPtr = NULL;
    IFileDialog *fdlgIf = NULL;
    IShellItem *dirIf = NULL;

    hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin));

    /*
     * The only validation we need to do w.r.t caller supplied data
     * is the filter specification so do that before creating
     */
    if (MakeFilterVista(interp, optsPtr, &nfilters, &filterPtr,
                        &defaultFilterIndex) != TCL_OK)
        return TCL_ERROR;

    /*
     * Beyond this point, do not just return on error as there will be
     * resources that need to be released/freed.
     */

    if (oper == OFN_FILE_OPEN || oper == OFN_DIR_CHOOSE)
        hr = CoCreateInstance(&ClsidFileOpenDialog, NULL,
                              CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgIf);
    else
        hr = CoCreateInstance(&ClsidFileSaveDialog, NULL,
                              CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog, (void **) &fdlgIf);

    if (FAILED(hr))
        goto vamoose;

    /*
     * Get current settings first because we want to preserve existing
     * settings like whether to show hidden files etc. based on the
     * user's existing preference
     */
    hr = fdlgIf->lpVtbl->GetOptions(fdlgIf, &flags);
    if (FAILED(hr))
        goto vamoose;

    if (filterPtr) {
        /*
         * Causes -filetypes {{All *}} -defaultextension ext to return
         * foo.ext.ext when foo is typed into the entry box
         *     flags |= FOS_STRICTFILETYPES;
         */
        hr = fdlgIf->lpVtbl->SetFileTypes(fdlgIf, nfilters, filterPtr);
        if (FAILED(hr))
            goto vamoose;
        hr = fdlgIf->lpVtbl->SetFileTypeIndex(fdlgIf, defaultFilterIndex);
        if (FAILED(hr))
            goto vamoose;
    }

    /* Flags are equivalent to those we used in the older API */

    /*
     * Following flags must be set irrespective of original setting
     * XXX - should FOS_NOVALIDATE be there ? Note FOS_NOVALIDATE has different
     * semantics than OFN_NOVALIDATE in the old API.
     */
    flags |=
        FOS_FORCEFILESYSTEM | /* Only want files, not other shell items */
        FOS_NOVALIDATE |           /* Don't check for access denied etc. */
        FOS_PATHMUSTEXIST;           /* The *directory* path must exist */


    if (oper == OFN_DIR_CHOOSE) {
        flags |= FOS_PICKFOLDERS;
        if (optsPtr->mustExist)
            flags |= FOS_FILEMUSTEXIST; /* XXX - check working */
    } else
        flags &= ~ FOS_PICKFOLDERS;

    if (optsPtr->multi)
        flags |= FOS_ALLOWMULTISELECT;
    else
        flags &= ~FOS_ALLOWMULTISELECT;

    if (optsPtr->confirmOverwrite)
        flags |= FOS_OVERWRITEPROMPT;
    else
        flags &= ~FOS_OVERWRITEPROMPT;

    hr = fdlgIf->lpVtbl->SetOptions(fdlgIf, flags);
    if (FAILED(hr))
        goto vamoose;

    if (optsPtr->extObj != NULL) {
        Tcl_DString ds;
        const char *src;

        src = Tcl_GetString(optsPtr->extObj);
        Tcl_DStringInit(&ds);
        wstr = Tcl_UtfToWCharDString(src, optsPtr->extObj->length, &ds);
        if (wstr[0] == '.')
            ++wstr;
        hr = fdlgIf->lpVtbl->SetDefaultExtension(fdlgIf, wstr);
        Tcl_DStringFree(&ds);
        if (FAILED(hr))
            goto vamoose;
    }

    if (optsPtr->titleObj != NULL) {
        Tcl_DString ds;
        const char *src;

        src = Tcl_GetString(optsPtr->titleObj);
        Tcl_DStringInit(&ds);
        wstr = Tcl_UtfToWCharDString(src, optsPtr->titleObj->length, &ds);
        hr = fdlgIf->lpVtbl->SetTitle(fdlgIf, wstr);
        Tcl_DStringFree(&ds);
        if (FAILED(hr))
            goto vamoose;
    }

    if (optsPtr->file[0]) {
        hr = fdlgIf->lpVtbl->SetFileName(fdlgIf, optsPtr->file);
        if (FAILED(hr))
            goto vamoose;
    }

    if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') {
        Tcl_Obj *normPath, *iniDirPath;
        iniDirPath = Tcl_NewStringObj(Tcl_DStringValue(&optsPtr->utfDirString), TCL_INDEX_NONE);
        Tcl_IncrRefCount(iniDirPath);
        normPath = Tcl_FSGetNormalizedPath(interp, iniDirPath);
        /* XXX - Note on failures do not raise error, simply ignore ini dir */
        if (normPath) {
            LPCWSTR nativePath;
            Tcl_IncrRefCount(normPath);
            nativePath = (LPCWSTR)Tcl_FSGetNativePath(normPath); /* Points INTO normPath*/
            if (nativePath) {
                hr = SHCreateItemFromParsingName(
                    nativePath, NULL,
                    &IIDIShellItem, (void **) &dirIf);
                if (SUCCEEDED(hr)) {
                    /* Note we use SetFolder, not SetDefaultFolder - see MSDN */
                    fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */
                }
            }
            Tcl_DecrRefCount(normPath); /* ALSO INVALIDATES nativePath !! */
        }
        Tcl_DecrRefCount(iniDirPath);
    }

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    hr = fdlgIf->lpVtbl->Show(fdlgIf, hWnd);
    Tcl_SetServiceMode(oldMode);
    EatSpuriousMessageBugFix();

    /*
     * Ensure that hWnd is enabled, because it can happen that we have updated
     * the wrapper of the parent, which causes us to leave this child disabled
     * (Windows loses sync).
     */

    if (hWnd)
        EnableWindow(hWnd, 1);

    /*
     * Clear interp result since it might have been set during the modal loop.
     * https://core.tcl-lang.org/tk/tktview/4a0451f5291b3c9168cc560747dae9264e1d2ef6
     */
    Tcl_ResetResult(interp);

    if (SUCCEEDED(hr)) {
        if ((oper == OFN_FILE_OPEN) && optsPtr->multi) {
            IShellItemArray *multiIf;
            DWORD dw, count;
            IFileOpenDialog *fodIf = (IFileOpenDialog *) fdlgIf;
            hr = fodIf->lpVtbl->GetResults(fodIf, &multiIf);
            if (SUCCEEDED(hr)) {
                Tcl_Obj *multiObj;
                hr = multiIf->lpVtbl->GetCount(multiIf, &count);
                multiObj = Tcl_NewListObj(count, NULL);
                if (SUCCEEDED(hr)) {
                    IShellItem *itemIf;
                    for (dw = 0; dw < count; ++dw) {
                        hr = multiIf->lpVtbl->GetItemAt(multiIf, dw, &itemIf);
                        if (FAILED(hr))
                            break;
                        hr = itemIf->lpVtbl->GetDisplayName(itemIf,
                                        SIGDN_FILESYSPATH, &wstr);
                        if (SUCCEEDED(hr)) {
                            Tcl_DString fnds;

                            ConvertExternalFilename(wstr, &fnds);
                            CoTaskMemFree(wstr);
                            Tcl_ListObjAppendElement(
                                interp, multiObj,
                                Tcl_NewStringObj(Tcl_DStringValue(&fnds),
                                                 Tcl_DStringLength(&fnds)));
                            Tcl_DStringFree(&fnds);
                        }
                        itemIf->lpVtbl->Release(itemIf);
                        if (FAILED(hr))
                            break;
                    }
                }
                multiIf->lpVtbl->Release(multiIf);
                if (SUCCEEDED(hr))
                    resultObj = multiObj;
                else
                    Tcl_DecrRefCount(multiObj);
            }
        } else {
            IShellItem *resultIf;
            hr = fdlgIf->lpVtbl->GetResult(fdlgIf, &resultIf);
            if (SUCCEEDED(hr)) {
                hr = resultIf->lpVtbl->GetDisplayName(resultIf, SIGDN_FILESYSPATH,
                                                      &wstr);
                if (SUCCEEDED(hr)) {
                    Tcl_DString fnds;

                    ConvertExternalFilename(wstr, &fnds);
                    resultObj = Tcl_NewStringObj(Tcl_DStringValue(&fnds),
                                                 Tcl_DStringLength(&fnds));
                    CoTaskMemFree(wstr);
                    Tcl_DStringFree(&fnds);
                }
                resultIf->lpVtbl->Release(resultIf);
            }
        }
        if (SUCCEEDED(hr)) {
            if (filterPtr && optsPtr->typeVariableObj) {
                UINT ftix;

                hr = fdlgIf->lpVtbl->GetFileTypeIndex(fdlgIf, &ftix);
                if (SUCCEEDED(hr)) {
                    /* Note ftix is a 1-based index */
                    if (ftix > 0 && ftix <= nfilters) {
                        Tcl_DString ftds;
                        Tcl_Obj *ftobj;

                        Tcl_DStringInit(&ftds);
                        Tcl_WCharToUtfDString(filterPtr[ftix-1].pszName, wcslen(filterPtr[ftix-1].pszName), &ftds);
                        ftobj = Tcl_NewStringObj(Tcl_DStringValue(&ftds),
                                Tcl_DStringLength(&ftds));
                        Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL,
                                ftobj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
                        Tcl_DStringFree(&ftds);
                    }
                }
            }
        }
    } else {
        if (hr == HRESULT_FROM_WIN32(ERROR_CANCELLED))
            hr = 0;             /* User cancelled, return empty string */
    }

vamoose: /* (hr != 0) => error */
    if (dirIf)
        dirIf->lpVtbl->Release(dirIf);
    if (fdlgIf)
        fdlgIf->lpVtbl->Release(fdlgIf);

    if (filterPtr)
        FreeFilterVista(nfilters, filterPtr);

    if (hr == 0) {
        if (resultObj)          /* May be NULL if user cancelled */
            Tcl_SetObjResult(interp, resultObj);
        return TCL_OK;
    } else {
        if (resultObj)
            Tcl_DecrRefCount(resultObj);
        Tcl_SetObjResult(interp, TkWin32ErrorObj(hr));
        return TCL_ERROR;
    }
}


/*
 *----------------------------------------------------------------------
 *

    int cdlgerr;
    int filterIndex = 0, result = TCL_ERROR, winCode, oldMode;
    HWND hWnd;
    Tcl_DString utfFilterString, ds;
    Tcl_DString extString, filterString, dirString, titleString;
    const char *str;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
        Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    memset(&ofnData, 0, sizeof(OFNData));
    Tcl_DStringInit(&utfFilterString);
    Tcl_DStringInit(&dirString); /* XXX - original code was missing this
                                    leaving dirString uninitialized for
                                    the unlikely code path where cwd failed */

    if (MakeFilter(interp, optsPtr->filterObj, &utfFilterString,
                   optsPtr->initialTypeObj, &filterIndex) != TCL_OK) {
	goto end;
    }

    Tk_MakeWindowExist(optsPtr->tkwin);
    hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin));

    memset(&ofn, 0, sizeof(OPENFILENAME));

	 */

	Tcl_DString cwd;

	Tcl_DStringFree(&optsPtr->utfDirString);
	if ((Tcl_GetCwd(interp, &optsPtr->utfDirString) == NULL) ||
		(Tcl_TranslateFileName(interp,
                     Tcl_DStringValue(&optsPtr->utfDirString), &cwd) == NULL)) {
	    Tcl_ResetResult(interp);
	} else {
		Tcl_DStringInit(&dirString);
		Tcl_UtfToWCharDString(Tcl_DStringValue(&cwd),
		    Tcl_DStringLength(&cwd), &dirString);
	}
	Tcl_DStringFree(&cwd);

		    &listObjc, &listObjv) != TCL_OK) {
		result = TCL_ERROR;
	    } else if (Tcl_ListObjGetElements(interp,
		    listObjv[ofn.nFilterIndex - 1], &count,
		    &typeInfo) != TCL_OK) {
		result = TCL_ERROR;
	    } else {
                /*
                 * BUGFIX for d43a10ce2fed950e00890049f3c273f2cdd12583
                 * The original code was broken because it passed typeinfo[0]
                 * directly into Tcl_ObjSetVar2. In the case of typeInfo[0]
                 * pointing into a list which is also referenced by
                 * typeVariableObj, TOSV2 shimmers the object into
                 * variable intrep which loses the list representation.
                 * This invalidates typeInfo[0] which is freed but
                 * nevertheless stored as the value of the variable.
                 */
                Tcl_Obj *selFilterObj = typeInfo[0];
                Tcl_IncrRefCount(selFilterObj);
                if (Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL,
                                   selFilterObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
                    result = TCL_ERROR;
                }
                Tcl_DecrRefCount(selFilterObj);
	    }
	}
    } else if (cdlgerr == FNERR_INVALIDFILENAME) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid filename \"%s\"",
		ConvertExternalFilename(ofn.lpstrFile, &ds)));
	Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "INVALID_FILENAME",
		NULL);
	Tcl_DStringFree(&ds);
    } else {
	result = TCL_OK;
    }

    if (ofn.lpstrTitle != NULL) {
	Tcl_DStringFree(&titleString);
    }
    if (ofn.lpstrInitialDir != NULL) {
        /* XXX - huh? lpstrInitialDir is set from Tcl_DStringValue which
           can never return NULL */
	Tcl_DStringFree(&dirString);
    }
    Tcl_DStringFree(&filterString);
    if (ofn.lpstrDefExt != NULL) {
	Tcl_DStringFree(&extString);
    }

				 * GetSaveFileName(). */
{
    OFNOpts ofnOpts;
    int result;

    result = ParseOFNOptions(clientData, interp, objc, objv, oper, &ofnOpts);
    if (result != TCL_OK)
        return result;

    if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle)
        result = GetFileNameVista(interp, &ofnOpts, oper);
    else
        result = GetFileNameXP(interp, &ofnOpts, oper);

    CleanupOFNOptions(&ofnOpts);
    return result;
}


/*

 *
 *      Frees storage previously allocated by MakeFilterVista.
 *      count is the number of elements in dlgFilterPtr[]
 */
static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr)
{
    if (dlgFilterPtr != NULL) {
        DWORD dw;
        for (dw = 0; dw < count; ++dw) {
            if (dlgFilterPtr[dw].pszName != NULL)
                ckfree((void *)dlgFilterPtr[dw].pszName);
            if (dlgFilterPtr[dw].pszSpec != NULL)
                ckfree((void *)dlgFilterPtr[dw].pszSpec);
        }
        ckfree(dlgFilterPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * MakeFilterVista --

 *----------------------------------------------------------------------
 */
static int MakeFilterVista(
    Tcl_Interp *interp,		/* Current interpreter. */
    OFNOpts *optsPtr,           /* Caller specified options */
    DWORD *countPtr,            /* Will hold number of filters */
    TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr, /* Will hold pointer to filter array.
                                         Set to NULL if no filters specified.
                                         Must be freed by calling
                                         FreeFilterVista */
    DWORD *initialIndexPtr)     /* Will hold index of default type */
{
    TCLCOMDLG_FILTERSPEC *dlgFilterPtr;
    const char *initial = NULL;
    FileFilterList flist;
    FileFilter *filterPtr;
    DWORD initialIndex = 0;
    Tcl_DString ds, patterns;
    int       i;

    if (optsPtr->filterObj == NULL) {
        *dlgFilterPtrPtr = NULL;
        *countPtr = 0;
        return TCL_OK;
    }

    if (optsPtr->initialTypeObj)
	initial = Tcl_GetString(optsPtr->initialTypeObj);

    TkInitFileFilters(&flist);
    if (TkGetFileFilters(interp, &flist, optsPtr->filterObj, 1) != TCL_OK)
	return TCL_ERROR;

    if (flist.filters == NULL) {
        *dlgFilterPtrPtr = NULL;
        *countPtr = 0;
        return TCL_OK;
    }

    Tcl_DStringInit(&ds);
    Tcl_DStringInit(&patterns);
    dlgFilterPtr = (TCLCOMDLG_FILTERSPEC *)ckalloc(flist.numFilters * sizeof(*dlgFilterPtr));

    for (i = 0, filterPtr = flist.filters;
         filterPtr;
         filterPtr = filterPtr->next, ++i) {
	const char *sep;
	FileFilterClause *clausePtr;
	size_t nbytes;

	/* Check if this entry should be shown as the default */
	if (initial && strcmp(initial, filterPtr->name) == 0)
            initialIndex = i+1; /* Windows filter indices are 1-based */

	/* First stash away the text description of the pattern */
        Tcl_DStringInit(&ds);
        Tcl_UtfToWCharDString(filterPtr->name, TCL_INDEX_NONE, &ds);
	nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */
	nbytes += sizeof(WCHAR);         /* Terminating \0 */
	dlgFilterPtr[i].pszName = (LPCWSTR)ckalloc(nbytes);
	memmove((void *) dlgFilterPtr[i].pszName, Tcl_DStringValue(&ds), nbytes);
	Tcl_DStringFree(&ds);

	/*

		Tcl_DStringAppend(&patterns, sep, TCL_INDEX_NONE);
		Tcl_DStringAppend(&patterns, globPtr->pattern, TCL_INDEX_NONE);
		sep = ";";
	    }
	}

	/* Again we need a Unicode form of the string */
        Tcl_DStringInit(&ds);
        Tcl_UtfToWCharDString(Tcl_DStringValue(&patterns), TCL_INDEX_NONE, &ds);
	nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */
	nbytes += sizeof(WCHAR);         /* Terminating \0 */
	dlgFilterPtr[i].pszSpec = (LPCWSTR)ckalloc(nbytes);
	memmove((void *)dlgFilterPtr[i].pszSpec, Tcl_DStringValue(&ds), nbytes);
	Tcl_DStringFree(&ds);
	Tcl_DStringSetLength(&patterns, 0);
    }

    Tcl_DString titleString;	/* Title */
    Tcl_DString tempString;	/* temporary */
    Tcl_Obj *objPtr;
    OFNOpts ofnOpts;
    const char *utfDir;

    result = ParseOFNOptions(clientData, interp, objc, objv,
                 OFN_DIR_CHOOSE, &ofnOpts);
    if (result != TCL_OK)
        return result;

    /* Use new dialogs if available */
    if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle) {
        result = GetFileNameVista(interp, &ofnOpts, OFN_DIR_CHOOSE);
        CleanupOFNOptions(&ofnOpts);
        return result;
    }

    /* Older dialogs */

    path[0] = '\0';
    memset(&cdCBData, 0, sizeof(ChooseDir));
    cdCBData.interp = interp;
    cdCBData.mustExist = ofnOpts.mustExist;

    utfDir = Tcl_DStringValue(&ofnOpts.utfDirString);
    if (utfDir[0] != '\0') {
	LPCWSTR uniStr;

	Tcl_DStringInit(&tempString);
	Tcl_UtfToWCharDString(Tcl_DStringValue(&ofnOpts.utfDirString), TCL_INDEX_NONE,
                          &tempString);
        uniStr = (WCHAR *) Tcl_DStringValue(&tempString);

        /* Convert possible relative path to full path to keep dialog happy. */

        GetFullPathNameW(uniStr, MAX_PATH, saveDir, NULL);
        wcsncpy(cdCBData.initDir, saveDir, MAX_PATH);
    }

    /* XXX - rest of this (original) code has no error checks at all. */

    /*
     * Get ready to call the browser
     */

     * user a chance to change their mind on an invalid folder if mustexist is
     * 0.
     */

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    GetCurrentDirectoryW(MAX_PATH, saveDir);
    if (SHGetMalloc(&pMalloc) == NOERROR) {
        /*
         * XXX - MSDN says CoInitialize must have been called before
         * SHBrowseForFolder can be used but don't see that called anywhere.
         */
	pidl = SHBrowseForFolderW(&bInfo);

	/*
	 * This is a fix for Windows 2000, which seems to modify the folder
	 * name buffer even when the dialog is canceled (in this case the
	 * buffer contains garbage). See [Bug #3002230]
	 */

		    chooseDirSharedData->retDir, NULL);
	    if (chooseDirSharedData->mustExist) {
		/*
		 * User HAS to select a valid directory.
		 */

		wsprintfW(selDir, L"Directory '%s' does not exist,\n"
		        L"please select or enter an existing directory.",
			chooseDirSharedData->retDir);
		MessageBoxW(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK);
		chooseDirSharedData->retDir[0] = '\0';
		return 1;
	    }
	} else {
	    /*

 */
static void
MakeAndStrokePath(
    HDC dc,
    POINT *winPoints,
    int npoints,
    WinDrawFunc func)        /* Name of the Windows GDI drawing function:
                                this is either Polyline or Polygon. */
{
    BeginPath(dc);
    func(dc, winPoints, (int)npoints);
    /*
     * In the case of closed polylines, the first and last points
     * are the same. We want miter or bevel join be rendered also
     * at this point, this needs telling the Windows GDI that the
     * path is closed.
     */
    if (func == Polyline) {
        if ((winPoints[0].x == winPoints[npoints-1].x) &&
                (winPoints[0].y == winPoints[npoints-1].y)) {
            CloseFigure(dc);
        }
        EndPath(dc);
        StrokePath(dc);
    } else {
        EndPath(dc);
        StrokeAndFillPath(dc);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * RenderObject --

	 * Draw the object in the foreground color and copy it to the
	 * destination wherever the pattern is set.
	 */

	SetPolyFillMode(dcMem, (gc->fill_rule == EvenOddRule) ? ALTERNATE
		: WINDING);
	oldMemBrush = (HBRUSH)SelectObject(dcMem, CreateSolidBrush(gc->foreground));
        MakeAndStrokePath(dcMem, winPoints, npoints, func);
	BitBlt(dc, rect.left, rect.top, width, height, dcMem, 0, 0, COPYFG);

	/*
	 * If we are rendering an opaque stipple, then draw the polygon in the
	 * background color and copy it to the destination wherever the
	 * pattern is clear.
	 */

	if (gc->fill_style == FillOpaqueStippled) {
	    DeleteObject(SelectObject(dcMem,
		    CreateSolidBrush(gc->background)));
            MakeAndStrokePath(dcMem, winPoints, npoints, func);
	    BitBlt(dc, rect.left, rect.top, width, height, dcMem, 0, 0,
		    COPYBG);
	}

	SelectObject(dcMem, oldPen);
	DeleteObject(SelectObject(dcMem, oldMemBrush));
	DeleteObject(SelectObject(dcMem, oldBitmap));
	DeleteDC(dcMem);
    } else {
	oldPen = (HPEN)SelectObject(dc, pen);
	oldBrush = (HBRUSH)SelectObject(dc, CreateSolidBrush(gc->foreground));
	SetROP2(dc, tkpWinRopModes[gc->function]);

	SetPolyFillMode(dc, (gc->fill_rule == EvenOddRule) ? ALTERNATE
		: WINDING);
        MakeAndStrokePath(dc, winPoints, npoints, func);
	SelectObject(dc, oldPen);
    }
    DeleteObject(SelectObject(dc, oldBrush));
}

/*
 *----------------------------------------------------------------------

{
    Container *containerPtr = (Container *)clientData;
    Tk_Window tkwin = (Tk_Window)containerPtr->parentPtr;

    if (eventPtr->type == ConfigureNotify) {

	/*
         * Send a ConfigureNotify  to the embedded application.
         */

        if (containerPtr->embeddedPtr != NULL) {
            TkDoConfigureNotify(containerPtr->embeddedPtr);
        }

	/*
	 * Resize the embedded window, if there is any.
	 */

	if (containerPtr->embeddedHWnd) {
	    SetWindowPos(containerPtr->embeddedHWnd, NULL, 0, 0,

    int n;
    int nbpoints = 0;
    POINT* bpoints;

    inPointList = (double *)attemptckalloc(2 * sizeof(double) * npoly);
    if (inPointList == 0) {
	/* TODO: unreachable */
        return nbpoints; /* 0. */
    }

    for (n=0; n<npoly; n++) {
        inPointList[2*n] = polypoints[n].x;
        inPointList[2*n + 1] = polypoints[n].y;
    }

    nbpoints = 1 + npoly * nStep; /* this is the upper limit. */
    outPointList = (double *)attemptckalloc(2 * sizeof(double) * nbpoints);
    if (outPointList == 0) {
	/* TODO: unreachable */
        ckfree(inPointList);
        return 0;
    }

    nbpoints = TkMakeBezierCurve(NULL, inPointList, npoly, nStep,
	    NULL, outPointList);

    ckfree(inPointList);
    bpoints = (POINT *)attemptckalloc(sizeof(POINT)*nbpoints);
    if (bpoints == 0) {
	/* TODO: unreachable */
        ckfree(outPointList);
        return 0;
    }

    for (n=0; n<nbpoints; n++) {
        bpoints[n].x = (long)outPointList[2*n];
        bpoints[n].y = (long)outPointList[2*n + 1];
    }
    ckfree(outPointList);
    *bpointptr = *bpoints;
    return nbpoints;
}

/*

     * fails, get the "extended" error code and return. Be sure to deallocate
     * the font if necessary.
     */
    if (retval == FALSE) {
	DWORD val = GetLastError();

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "::tk::print::_gdi character failed with code %ld", val));
	if (made_font) {
	    SelectObject(hDC, oldfont);
	    DeleteObject(hfont);
	}
	return TCL_ERROR;
    }

    HANDLE hDIB;
    HBITMAP hBitmap;
    HPALETTE hPalette;

    /* Check for a valid window handle. */

    if (!hWnd) {
        return NULL;
    }

    switch (type) {
    case PTWindow: {	/* Copy entire window. */
	RECT rectWnd;

	/* Get the window rectangle. */

    xScrn = GetDeviceCaps(hScrDC, HORZRES);
    yScrn = GetDeviceCaps(hScrDC, VERTRES);

    /* Make sure bitmap rectangle is visible. */

    if (nX < 0) {
        nX = 0;
    }
    if (nY < 0) {
        nY = 0;
    }
    if (nX2 > xScrn) {
        nX2 = xScrn;
    }
    if (nY2 > yScrn) {
        nY2 = yScrn;
    }

    nWidth = nX2 - nX;
    nHeight = nY2 - nY;

    /* Create a bitmap compatible with the screen DC. */
    hBitmap = CreateCompatibleBitmap(hScrDC, nWidth, nHeight);

    HANDLE              h;
    HDC                 hDC;
    WORD                biBits;

    /* Check if bitmap handle is valid. */

    if (!hBitmap) {
        return NULL;
    }

    /* Fill in BITMAP structure, return NULL if it didn't work. */

    if (!GetObjectW(hBitmap, sizeof(bm), (LPWSTR)&bm)) {
        return NULL;
    }

    /* Ff no palette is specified, use default palette. */

    if (hPal == NULL) {
        hPal = (HPALETTE)GetStockObject(DEFAULT_PALETTE);
    }

    /* Calculate bits per pixel. */

    biBits = bm.bmPlanes * bm.bmBitsPixel;

    /* Make sure bits per pixel is valid. */

    if (biBits <= 1) {
        biBits = 1;
    } else if (biBits <= 4) {
        biBits = 4;
    } else if (biBits <= 8) {
        biBits = 8;
    } else { /* If greater than 8-bit, force to 24-bit. */
        biBits = 24;
    }

    /* Initialize BITMAPINFOHEADER. */

    bi.biSize = sizeof(BITMAPINFOHEADER);
    bi.biWidth = bm.bmWidth;
    bi.biHeight = bm.bmHeight;

    /* get the info. returned by GetDIBits and unlock memory block. */

    bi = *lpbi;
    GlobalUnlock(hDIB);

    /* If the driver did not fill in the biSizeImage field, make one up. */
    if (bi.biSizeImage == 0) {
        bi.biSizeImage = (((((DWORD)bm.bmWidth * biBits) + 31) / 32) * 4)
		* bm.bmHeight;
    }

    /* Realloc the buffer big enough to hold all the bits. */

    dwLen = bi.biSize + DIBNumColors(&bi) * sizeof(RGBQUAD) + bi.biSizeImage;

    if ((h = GlobalReAlloc(hDIB, dwLen, 0)) != 0) {
        hDIB = h;
    } else {
	/* Clean up and return NULL. */

	GlobalFree(hDIB);
	SelectPalette(hDC, hPal, TRUE);
	RealizePalette(hDC);
	ReleaseDC(NULL, hDC);

    LPLOGPALETTE lpLogPal;  /* Pointer to a logical palette. */
    int nColors;            /* Number of colors. */

    /* Find out how many palette entries we want.. */

    hDC = GetDC(NULL);
    if (!hDC) {
        return NULL;
    }

    nColors = PalEntriesOnDevice(hDC);   /* Number of palette entries. */

    /* Allocate room for the palette and lock it.. */

    hLogPal = GlobalAlloc(GHND, sizeof(LOGPALETTE) + nColors *
	    sizeof(PALETTEENTRY));
    if (!hLogPal) {
	/* If we didn't get a logical palette, return NULL. */

        return NULL;
    }

    /* get a pointer to the logical palette. */

    lpLogPal = (LPLOGPALETTE)GlobalLock(hLogPal);

    /* Set some important fields. */

    }

    /*
     * Store print properties and link variables so they can be accessed from
     * script level.
     */
    if (localPrinterName != NULL) {
        char* varlink1 = (char*)ckalloc(100 * sizeof(char));
        char** varlink2 = (char**)ckalloc(sizeof(char*));
        *varlink2 = varlink1;
        WideCharToMultiByte(CP_UTF8, 0, localPrinterName, -1, varlink1, 0, NULL, NULL);

        Tcl_LinkVar(interp, "::tk::print::printer_name", varlink2,
            TCL_LINK_STRING | TCL_LINK_READ_ONLY);
        Tcl_LinkVar(interp, "::tk::print::copies", &copies,
            TCL_LINK_INT | TCL_LINK_READ_ONLY);
        Tcl_LinkVar(interp, "::tk::print::dpi_x", &dpi_x,
            TCL_LINK_INT | TCL_LINK_READ_ONLY);
        Tcl_LinkVar(interp, "::tk::print::dpi_y", &dpi_y,
            TCL_LINK_INT | TCL_LINK_READ_ONLY);
        Tcl_LinkVar(interp, "::tk::print::paper_width", &paper_width,
            TCL_LINK_INT | TCL_LINK_READ_ONLY);
        Tcl_LinkVar(interp, "::tk::print::paper_height", &paper_height,
            TCL_LINK_INT | TCL_LINK_READ_ONLY);
    }

    return TCL_OK;
}

/*
 * --------------------------------------------------------------------------

    bmInfo.bmiHeader.biWidth = width;
    bmInfo.bmiHeader.biHeight = -height;
    bmInfo.bmiHeader.biPlanes = 1;
    bmInfo.bmiHeader.biBitCount = 32;
    bmInfo.bmiHeader.biCompression = BI_RGB;

    iconInfo.hbmColor = CreateDIBSection(NULL, &bmInfo, DIB_RGB_COLORS,
            &bgraPixel.voidPtr, NULL, 0);
    if (!iconInfo.hbmColor) {
        return NULL;
    }

    /*
     * Convert the photo image data into BGRA format (RGBQUAD).
     */

    bufferSize = height * width * 4;
    for (idx = 0 ; idx < bufferSize ; idx += 4) {
        bgraPixel.ptr[idx] = block.pixelPtr[idx+2];
        bgraPixel.ptr[idx+1] = block.pixelPtr[idx+1];
        bgraPixel.ptr[idx+2] = block.pixelPtr[idx+0];
        bgraPixel.ptr[idx+3] = block.pixelPtr[idx+3];
    }

    /*
     * Create a dummy mask bitmap. The contents of this don't appear to
     * matter, as CreateIconIndirect will setup the icon mask based on the
     * alpha channel in our color bitmap.
     */

    bmInfo.bmiHeader.biBitCount = 1;

    iconInfo.hbmMask = CreateDIBSection(NULL, &bmInfo, DIB_RGB_COLORS,
            &bgraMask.voidPtr, NULL, 0);
    if (!iconInfo.hbmMask) {
        DeleteObject(iconInfo.hbmColor);
        return NULL;
    }

    memset(bgraMask.ptr, 0, width*height/8);

    /*
     * Create an icon from the bitmaps.
     */

    hIcon = CreateIconIndirect(&iconInfo);
    DeleteObject(iconInfo.hbmColor);
    DeleteObject(iconInfo.hbmMask);
    if (hIcon == NULL) {
        return NULL;
    }

    return hIcon;
}
/*
 * Local Variables:
 * mode: c

/*
 * The following are implemented in tkWinIco.c and also used in tkWinWm.c and tkWinSysTray.c.
 */

DWORD BytesPerLine(LPBITMAPINFOHEADER lpBMIH);
LPSTR FindDIBBits(LPSTR lpbi);
HICON CreateIcoFromPhoto(int width, int height,
                        Tk_PhotoImageBlock block);


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78

	 * pressed, return the appropriate keycode. Otherwise, we fall through
	 * and rely on the keymap table to hold the correct keysym value.
	 * Note: this little trick only works for KeyPress, not for KeyRelease,
	 * for reasons stated in bug [2945130]
	 */

    case VK_CONTROL:
        if (state & EXTENDED_MASK) {
            return XK_Control_R;
        }
	break;
    case VK_SHIFT:
	if (GetKeyState(VK_RSHIFT) & 0x80) {
	    return XK_Shift_R;
	}
	break;
    case VK_MENU:
        if (state & EXTENDED_MASK) {
            return XK_Alt_R;
        }
	break;
    }
    return keymap[keycode];
}

/*
 *----------------------------------------------------------------------

    } else {
	int borderWidth;

	Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
		menuPtr->borderWidthPtr, &borderWidth);
	*widthPtr = indicatorDimensions[1] - borderWidth;

        /*
         * Quite dubious about the above (why would borderWidth play a role?)
         * and about how indicatorDimensions[1] is obtained in SetDefaults().
         * At least don't let the result be negative!
         */
        if (*widthPtr < 0) {
            *widthPtr = 0;
        }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetMenuAccelGeometry --

    Tk_Font tkfont,		/* The precalculated font */
    const Tk_FontMetrics *fmPtr,/* The precalculated font metrics */
    int *widthPtr,		/* The resulting width */
    int *heightPtr)		/* The resulting height */
{
    *heightPtr = fmPtr->linespace;
    if (mePtr->type == CASCADE_ENTRY) {
        /*
         * Cascade entries have no accelerator but do show an arrow. Set
         * this field width to the width of the OBM_MNARROW system bitmap
         * used to display the arrow. I couldn't find how to query the
         * system for this value, therefore I resort to hardcoding.
         */
	*widthPtr = CASCADE_ARROW_WIDTH;
    } else if ((menuPtr->menuType != MENUBAR) && (mePtr->accelPtr != NULL)) {
	const char *accel = Tcl_GetString(mePtr->accelPtr);

	*widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
    } else {
    	*widthPtr = 0;

    int height)			/* Height of menu entry */
{
    int baseline;
    int leftEdge = x + mePtr->indicatorSpace + mePtr->labelWidth;
    const char *accel;

    if (menuPtr->menuType == MENUBAR) {
        return;
    }

    if (mePtr->accelPtr != NULL) {
	accel = Tcl_GetString(mePtr->accelPtr);
    } else {
	accel = NULL;
    }

    /*
     * Don't draw the arrow if a submenu is not attached to this
     * cascade entry.
     */

    if ((mePtr->childMenuRefPtr == NULL)
           || (mePtr->childMenuRefPtr->menuPtr == NULL)) {
        return;
    }

    oldFgColor = gc->foreground;
    oldBgColor = gc->background;

    /*
     * Set bitmap bg to highlight color if the menu is highlighted.

	    Tk_GetReliefFromObj(NULL, menuPtr->activeReliefPtr, &relief);
	}
	Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
		menuPtr->activeBorderWidthPtr, &activeBorderWidth);
	Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
		activeBorderWidth, relief);
    } else {
        Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height, 0,
                TK_RELIEF_FLAT);
    }
}

/*
 *--------------------------------------------------------------
 *
 * TkpComputeStandardMenuGeometry --

    /*
     * A multi-screen system may have different logical pixels/inch, with
     * Windows applying behind-the-scenes scaling on secondary screens.
     * Don't try and emulate that, instead fall back to SetCursor if the
     * requested position is off the primary screen.
     */
    if ( x < 0 || x > xscreen || y < 0 || y > yscreen ) {
        SetCursorPos(x, y);
        return;
    }

    input.type = INPUT_MOUSE;
    input.mi.dx = (x * 65535 + xscreen/2) / xscreen;
    input.mi.dy = (y * 65535 + yscreen/2) / yscreen;

    /*
     * Horrible workaround here. There is a bug on Win 10: when warping to
     * pixel (x = 0, y = 0) the SendInput() below just does not move the
     * mouse pointer. However, as soon as dx or dy is non zero it moves as
     * expected. Given the scaling factor of 65535 (see above),
     * (dx = 1 , dy = 0) still means pixel (x = 0, y = 0).
     * See ticket [69b48f427e].
     */
    if (input.mi.dx == 0 && input.mi.dy == 0) {
        input.mi.dx = 1;
    }

    input.mi.mouseData = 0;
    input.mi.dwFlags = MOUSEEVENTF_ABSOLUTE | MOUSEEVENTF_MOVE;
    input.mi.time = 0;
    input.mi.dwExtraInfo = 0;
    SendInput(1, &input, sizeof(input));

    int fieldLength, minThumbSize;

    /*
     * Windows doesn't use focus rings on scrollbars, but we still perform
     * basic sanity checks to appease backwards compatibility.
     */

    if (scrollPtr->highlightWidth < 0) {
	scrollPtr->highlightWidth = 0;
    }

    if (scrollPtr->vertical) {
	scrollPtr->arrowLength = vArrowHeight;
	fieldLength = Tk_Height(scrollPtr->tkwin);
	minThumbSize = vThumb;
    } else {
	scrollPtr->arrowLength = hArrowWidth;
	fieldLength = Tk_Width(scrollPtr->tkwin);

#define TKWINSENDCOM_DISPID_ASYNC  2

/*
 * TkWinSendCom public functions
 */

MODULE_SCOPE HRESULT    TkWinSendCom_CreateInstance(Tcl_Interp *interp,
                            REFIID riid, void **ppv);
MODULE_SCOPE int        TkWinSend_QueueCommand(Tcl_Interp *interp,
                            Tcl_Obj *cmdPtr);
MODULE_SCOPE void       TkWinSend_SetExcepInfo(Tcl_Interp *interp,
                            EXCEPINFO *pExcepInfo);

#endif /* _tkWinSendCom_h_INCLUDE */

/*
 * Local Variables:
 * mode: c
 * End:

 */

#define GETHINSTANCE Tk_GetHINSTANCE()

typedef struct IcoInfo {
    HICON hIcon;                /* icon handle returned by LoadIcon. */
    unsigned id;                /* Identifier for command;  used to
                                 * cancel it. */
    Tcl_Obj *taskbar_txt;       /* text to display in the taskbar */
    Tcl_Interp *interp;         /* interp which created the icon */
    Tcl_Obj *taskbar_command;   /* command to eval if events in the taskbar
                                 * arrive */
    int taskbar_flags;          /* taskbar related flags*/
    HWND hwndFocus;
    struct IcoInfo *nextPtr;
} IcoInfo;

/* Per-interp struture */
typedef struct IcoInterpInfo {

    RECT Rect,
    LPLPICONIMAGE lpIcon)
{
    int x, y;

    /* Sanity checks */
    if (lpIcon == NULL)
        return FALSE;
    if (lpIcon->lpBits == NULL)
        return FALSE;

    /* Account for height*2 thing */
    lpIcon->lpbi->bmiHeader.biHeight /= 2;

    /* Locate it */
    x = Rect.left + ((RectWidth(Rect) - lpIcon->lpbi->bmiHeader.biWidth) / 2);
    y = Rect.top + ((RectHeight(Rect) - lpIcon->lpbi->bmiHeader.biHeight) / 2);

    /* Blast it to the screen */
    SetDIBitsToDevice(hDC, x, y,
            lpIcon->lpbi->bmiHeader.biWidth,
            lpIcon->lpbi->bmiHeader.biHeight,
            0, 0, 0, lpIcon->lpbi->bmiHeader.biHeight,
            lpIcon->lpXOR, lpIcon->lpbi, DIB_RGB_COLORS);

    /* UnAccount for height*2 thing */
    lpIcon->lpbi->bmiHeader.biHeight *= 2;

    return TRUE;
}

    LPLPICONIMAGE lpIcon)
{
    LPBITMAPINFO lpbi;
    int x, y;

    /* Sanity checks */
    if (lpIcon == NULL)
        return FALSE;
    if (lpIcon->lpBits == NULL)
        return FALSE;

    /* Need a bitmap header for the mono mask */
    lpbi = ckalloc(sizeof(BITMAPINFO) + (2 * sizeof(RGBQUAD)));
    lpbi->bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
    lpbi->bmiHeader.biWidth = lpIcon->lpbi->bmiHeader.biWidth;
    lpbi->bmiHeader.biHeight = lpIcon->lpbi->bmiHeader.biHeight / 2;
    lpbi->bmiHeader.biPlanes = 1;

    /* Locate it */
    x = Rect.left + ((RectWidth(Rect) - lpbi->bmiHeader.biWidth) / 2);
    y = Rect.top + ((RectHeight(Rect) - lpbi->bmiHeader.biHeight) / 2);

    /* Blast it to the screen */
    SetDIBitsToDevice(hDC, x, y,
            lpbi->bmiHeader.biWidth,
            lpbi->bmiHeader.biHeight,
            0, 0, 0, lpbi->bmiHeader.biHeight,
            lpIcon->lpAND, lpbi, DIB_RGB_COLORS);

    /* clean up */
    ckfree(lpbi);

    return TRUE;
}
#endif /* ICO_DRAW */

    ni.hWnd = icoInterpPtr->hwnd;
    ni.uID = icoPtr->id;
    ni.uFlags = NIF_ICON | NIF_TIP | NIF_MESSAGE;
    ni.uCallbackMessage = ICON_MESSAGE;
    ni.hIcon = icoPtr->hIcon;

    if (icoPtr->taskbar_txt != NULL) {
        Tcl_DString dst;
        Tcl_DStringInit(&dst);
        str = (WCHAR *)Tcl_UtfToWCharDString(Tcl_GetString(icoPtr->taskbar_txt), TCL_INDEX_NONE, &dst);
        wcsncpy(ni.szTip, str, (Tcl_DStringLength(&dst) + 2) / 2);
        Tcl_DStringFree(&dst);
    } else {
        ni.szTip[0] = 0;
    }

    if (Shell_NotifyIconW(oper, &ni) == 1) {
        if (oper == NIM_ADD || oper == NIM_MODIFY) {
            icoPtr->taskbar_flags |= TASKBAR_ICON;
        }
        if (oper == NIM_DELETE) {
            icoPtr->taskbar_flags &= ~TASKBAR_ICON;
        }
    }
    /* Silently ignore error? */
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

static void
FreeIcoPtr(
    IcoInterpInfo *icoInterpPtr,
    IcoInfo *icoPtr)
{
    IcoInfo *prevPtr;
    if (icoInterpPtr->firstIcoPtr == icoPtr) {
        icoInterpPtr->firstIcoPtr = icoPtr->nextPtr;
    } else {
        for (prevPtr = icoInterpPtr->firstIcoPtr; prevPtr->nextPtr != icoPtr;
                prevPtr = prevPtr->nextPtr) {
            /* Empty loop body. */
        }
        prevPtr->nextPtr = icoPtr->nextPtr;
    }
    if (icoPtr->taskbar_flags & TASKBAR_ICON) {
        TaskbarOperation(icoInterpPtr, icoPtr, NIM_DELETE);
    }
    if (icoPtr->taskbar_txt != NULL) {
        Tcl_DecrRefCount(icoPtr->taskbar_txt);
    }
    if (icoPtr->taskbar_command != NULL) {
        Tcl_DecrRefCount(icoPtr->taskbar_command);
    }
    ckfree(icoPtr);
}

/*
 *----------------------------------------------------------------------
 *

{
    IcoInfo *icoPtr;
    unsigned id;
    const char *start;
    char *end;

    if (strncmp(string, "ico#", 4) != 0) {
        goto notfound;
    }
    start = string + 4;
    id = strtoul(start, &end, 10);
    if ((end == start) || (*end != 0)) {
        goto notfound;
    }
    for (icoPtr = icoInterpPtr->firstIcoPtr; icoPtr != NULL; icoPtr = icoPtr->nextPtr) {
        if (icoPtr->id == id) {
            return icoPtr;
        }
    }

notfound:
    Tcl_AppendResult(interp, "icon \"", string,
        "\" doesn't exist", NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * GetInt --

#define SPACELEFT (*aftersize-(dst-after)-1)
#define AFTERLEN ((*aftersize>0)?(*aftersize*2):1024)
#define ALLOCLEN ((len>AFTERLEN)?(len*2):AFTERLEN)
    char buffer[TCL_INTEGER_SPACE + 5];
    char* dst;
    dst = after;
    while (*before) {
        const char *ptr = before;
        int len = 1;
        if(*before == '%') {
            switch(before[1]){
                case 'M':
                case 'm': {
                    before++;
                    len = strlen(msgstring);
                    ptr = msgstring;
                    break;
                }
                /* case 'W': {
                   before++;
                   len = (int)strlen(winstring);
                   ptr = winstring;
                   break;
                   }
                */
                case 'i': {
                    before++;
                    snprintf(buffer, sizeof(buffer) - 1, "ico#%d", icoPtr->id);
                    len = strlen(buffer);
                    ptr = buffer;
                    break;
                }
                case 'w': {
                    before++;
                    len = GetInt((long)wParam,buffer, sizeof(buffer));
                    ptr = buffer;
                    break;
                }
                case 'l': {
                    before++;
                    len = GetInt((long)lParam,buffer, sizeof(buffer));
                    ptr = buffer;
                    break;
                }
                case 't': {
                    before++;
                    len = GetInt((long)GetTickCount(), buffer, sizeof(buffer));
                    ptr = buffer;
                    break;
                }
                case 'x': {
                    POINT pt;
                    GetCursorPos(&pt);
                    before++;
                    len = GetIntDec((long)pt.x, buffer, sizeof(buffer));
                    ptr = buffer;
                    break;
                }
                case 'y': {
                    POINT pt;
                    GetCursorPos(&pt);
                    before++;
                    len = GetIntDec((long)pt.y,buffer, sizeof(buffer));
                    ptr = buffer;
                    break;
                }
                case 'X': {
                    DWORD dw;
                    dw = GetMessagePos();
                    before++;
                    len = GetIntDec((long)LOWORD(dw),buffer, sizeof(buffer));
                    ptr = buffer;
                    break;
                }
                case 'Y': {
                    DWORD dw;
                    dw = GetMessagePos();
                    before++;
                    len = GetIntDec((long)HIWORD(dw),buffer, sizeof(buffer));
                    ptr = buffer;
                    break;
                }
                case 'H': {
                    before++;
                    len = GetInt(PTR2INT(icoPtr->hwndFocus), buffer, sizeof(buffer));
                    ptr = buffer;
                    break;
                }
                case '%': {
                    before++;
                    len = 1;
                    ptr = "%";
                    break;
                }
            }
        }
        if (SPACELEFT < len) {
            char *newspace;
            ptrdiff_t dist = dst - after;
            int alloclen = ALLOCLEN;
            newspace = (char *)ckalloc(alloclen);
            if (dist>0)
                memcpy(newspace, after, dist);
            if (after && *aftersize) {
                ckfree(after);
            }
            *aftersize =alloclen;
            after = newspace;
            dst = after + dist;
        }
        if (len > 0) {
            memcpy(dst, ptr, len);
        }
        dst += len;
        if ((dst-after)>(*aftersize-1)) {
            printf("oops\n");
        }
        before++;
    }
    *dst = 0;
    return after;
}

/*
 *----------------------------------------------------------------------

    char evalspace[200];
    int evalsize = 200;
    char *expanded;
    int fixup = 0;

    switch (lParam) {
    case WM_MOUSEMOVE:
        msgstring = "WM_MOUSEMOVE";
        icoPtr->hwndFocus = GetFocus();
        break;
    case WM_LBUTTONDOWN:
        msgstring = "WM_LBUTTONDOWN";
        fixup = 1;
        break;
    case WM_LBUTTONUP:
        msgstring = "WM_LBUTTONUP";
        fixup = 1;
        break;
    case WM_LBUTTONDBLCLK:
        msgstring = "WM_LBUTTONDBLCLK";
        fixup = 1;
        break;
    case WM_RBUTTONDOWN:
        msgstring = "WM_RBUTTONDOWN";
        fixup = 1;
        break;
    case WM_RBUTTONUP:
        msgstring = "WM_RBUTTONUP";
        fixup = 1;
        break;
    case WM_RBUTTONDBLCLK:
        msgstring = "WM_RBUTTONDBLCLK";
        fixup = 1;
        break;
    case WM_MBUTTONDOWN:
        msgstring = "WM_MBUTTONDOWN";
        fixup = 1;
        break;
    case WM_MBUTTONUP:
        msgstring = "WM_MBUTTONUP";
        fixup = 1;
        break;
    case WM_MBUTTONDBLCLK:
        msgstring = "WM_MBUTTONDBLCLK";
        fixup = 1;
        break;
    default:
        msgstring = "WM_NULL";
        fixup = 0;
    }
    expanded = TaskbarExpandPercents(icoPtr, msgstring, wParam, lParam,
            Tcl_GetString(icoPtr->taskbar_command), evalspace, &evalsize);
    if (icoPtr->interp != NULL) {
        int result;
        HWND hwnd = NULL;

        /* See http://support.microsoft.com/kb/q135788/
         * Seems to have moved to https://www.betaarchive.com/wiki/index.php/Microsoft_KB_Archive/135788 */
        if (fixup) {
            if (icoPtr->hwndFocus != NULL && IsWindow(icoPtr->hwndFocus)) {
                hwnd = icoPtr->hwndFocus;
            } else {
                Tk_Window tkwin = Tk_MainWindow(icoPtr->interp);
                if (tkwin != NULL) {
                    hwnd = Tk_GetHWND(Tk_WindowId(tkwin));
                }
            }
            if (hwnd != NULL) {
                SetForegroundWindow(hwnd);
            }
        }

        result = Tcl_GlobalEval(icoPtr->interp, expanded);

        if (hwnd != NULL) {
            /* See http://support.microsoft.com/kb/q135788/
             * Seems to have moved to https://www.betaarchive.com/wiki/index.php/Microsoft_KB_Archive/135788 */
            PostMessageW(hwnd, WM_NULL, 0, 0);
        }
        if (result != TCL_OK) {
            char buffer[100];
            snprintf(buffer, 100, "\n  (command bound to taskbar-icon ico#%d)", icoPtr->id);
            Tcl_AddErrorInfo(icoPtr->interp, buffer);
            Tcl_BackgroundError(icoPtr->interp);
        }
    }
    if (expanded != evalspace) {
        ckfree(expanded);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TaskbarHandlerProc --

{
    static UINT msgTaskbarCreated = 0;
    IcoInterpInfo *icoInterpPtr;
    IcoInfo *icoPtr;

    switch (message) {
    case WM_CREATE:
        msgTaskbarCreated = RegisterWindowMessage(TEXT("TaskbarCreated"));
        break;

    case ICON_MESSAGE:
        for (icoInterpPtr = firstIcoInterpPtr; icoInterpPtr != NULL; icoInterpPtr = icoInterpPtr->nextPtr) {
            if (icoInterpPtr->hwnd == hwnd) {
                for (icoPtr = icoInterpPtr->firstIcoPtr; icoPtr != NULL; icoPtr = icoPtr->nextPtr) {
                    if (icoPtr->id == wParam) {
                        if (icoPtr->taskbar_command != NULL) {
                            TaskbarEval(icoPtr, wParam, lParam);
                        }
                        break;
                    }
                }
                break;
            }
        }
        break;

    default:
        /*
         * Check to see if explorer has been restarted and we need to
         * re-add our icons.
         */
        if (message == msgTaskbarCreated) {
            for (icoInterpPtr = firstIcoInterpPtr; icoInterpPtr != NULL; icoInterpPtr = icoInterpPtr->nextPtr) {
                if (icoInterpPtr->hwnd == hwnd) {
                    for (icoPtr = icoInterpPtr->firstIcoPtr; icoPtr != NULL; icoPtr = icoPtr->nextPtr) {
                        if (icoPtr->taskbar_flags & TASKBAR_ICON) {
                            TaskbarOperation(icoInterpPtr, icoPtr, NIM_ADD);
                        }
                    }
                    break;
                }
            }
        }
        return DefWindowProc(hwnd, message, wParam, lParam);
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *

 */

static HWND
CreateTaskbarHandlerWindow(void) {
    static int registered = 0;
    HINSTANCE hInstance = GETHINSTANCE;
    if (!registered) {
        if (!RegisterHandlerClass(hInstance))
            return 0;
        registered = 1;
    }
    return CreateWindow(HANDLER_CLASS, "", WS_OVERLAPPED, 0, 0,
            CW_USEDEFAULT, CW_USEDEFAULT, NULL, NULL, hInstance, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * WinIcoDestroy --
 *

{
    IcoInterpInfo *icoInterpPtr = (IcoInterpInfo*) clientData;
    IcoInterpInfo *prevIcoInterpPtr;
    IcoInfo *icoPtr;
    IcoInfo *nextPtr;

    if (eventPtr->type != DestroyNotify) {
        return;
    }

    if (firstIcoInterpPtr == icoInterpPtr) {
        firstIcoInterpPtr = icoInterpPtr->nextPtr;
    } else {
        for (prevIcoInterpPtr = firstIcoInterpPtr; prevIcoInterpPtr->nextPtr != icoInterpPtr;
                prevIcoInterpPtr = prevIcoInterpPtr->nextPtr) {
            /* Empty loop body. */
        }
        prevIcoInterpPtr->nextPtr = icoInterpPtr->nextPtr;
    }

    DestroyWindow(icoInterpPtr->hwnd);
    for (icoPtr = icoInterpPtr->firstIcoPtr; icoPtr != NULL; icoPtr = nextPtr) {
            nextPtr = icoPtr->nextPtr;
        FreeIcoPtr(icoInterpPtr, icoPtr);
    }
    ckfree(icoInterpPtr);
}

/*
 *----------------------------------------------------------------------
 *

WinSystrayCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const cmdStrings[] = {
        "add", "delete", "modify", NULL
    };
    enum { CMD_ADD, CMD_DELETE, CMD_MODIFY };
    static const char *const optStrings[] = {
        "-callback", "-image", "-text", NULL
    };
    enum { OPT_CALLBACK, OPT_IMAGE, OPT_TEXT };
    int cmd, opt;

    HICON hIcon;
    int i;
    IcoInterpInfo *icoInterpPtr = (IcoInterpInfo*) clientData;
    IcoInfo *icoPtr = NULL;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "command ...");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], cmdStrings, "command",
            0, &cmd) == TCL_ERROR) {
        return TCL_ERROR;
    }
    switch (cmd) {
        case CMD_ADD:
        case CMD_MODIFY: {
            Tcl_Obj *imageObj = NULL, *textObj = NULL, *callbackObj = NULL;
            int optStart;
            int oper;
            if (cmd == CMD_ADD) {
                optStart = 2;
                oper = NIM_ADD;
            } else {
                optStart = 3;
                oper = NIM_MODIFY;
                if (objc != 5) {
                    Tcl_WrongNumArgs(interp, 2, objv, "id option value");
                    return TCL_ERROR;
                }
                icoPtr = GetIcoPtr(interp, icoInterpPtr, Tcl_GetString(objv[2]));
                if (icoPtr == NULL) {
                    return TCL_ERROR;
                }
            }
            for (i = optStart; i < objc; i += 2) {
                if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
                        0, &opt) == TCL_ERROR) {
                    return TCL_ERROR;
                }
                if (i+1 >= objc) {
                    Tcl_AppendResult(interp,
                            "missing value for option \"", Tcl_GetString(objv[i]),
                            "\"", NULL);
                    return TCL_ERROR;
                }
                switch (opt) {
                    case OPT_IMAGE:
                        imageObj = objv[i+1];
                        break;
                    case OPT_TEXT:
                        textObj = objv[i+1];
                        break;
                    case OPT_CALLBACK:
                        callbackObj = objv[i+1];
                        break;
                }
            }
            if (cmd == CMD_ADD && imageObj == NULL) {
                Tcl_SetObjResult(interp, Tcl_NewStringObj("missing required option \"-image\"", TCL_INDEX_NONE));
                return TCL_ERROR;
            }
            if (imageObj != NULL) {
                Tk_PhotoHandle photo;
                int width, height;
                Tk_PhotoImageBlock block;

                photo = Tk_FindPhoto(interp, Tcl_GetString(imageObj));
                if (photo == NULL) {
                    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "image \"%s\" doesn't exist", Tcl_GetString(imageObj)));
                    return TCL_ERROR;
                }
                Tk_PhotoGetSize(photo, &width, &height);
                Tk_PhotoGetImage(photo, &block);
                hIcon = CreateIcoFromPhoto(width, height, block);
                if (hIcon == NULL) {
                    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "failed to create an iconphoto with image \"%s\"", Tcl_GetString(imageObj)));
                    return TCL_ERROR;
                }
            }
            if (cmd == CMD_ADD) {
                icoPtr = NewIcon(interp, icoInterpPtr, hIcon);
            } else {
                if (imageObj != NULL) {
                    DestroyIcon(icoPtr->hIcon);
                    icoPtr->hIcon = hIcon;
                }
            }
            if (callbackObj != NULL) {
                if (icoPtr->taskbar_command != NULL) {
                    Tcl_DecrRefCount(icoPtr->taskbar_command);
                }
                icoPtr->taskbar_command = callbackObj;
                Tcl_IncrRefCount(icoPtr->taskbar_command);
            }
            if (textObj != NULL) {
                if (icoPtr->taskbar_txt != NULL) {
                    Tcl_DecrRefCount(icoPtr->taskbar_txt);
                }
                icoPtr->taskbar_txt = textObj;
                Tcl_IncrRefCount(icoPtr->taskbar_txt);
            }
            TaskbarOperation(icoInterpPtr, icoPtr, oper);
            if (cmd == CMD_ADD) {
                char buffer[5 + TCL_INTEGER_SPACE];
                int n;
                n = snprintf(buffer, sizeof(buffer) - 1, "ico#%d", icoPtr->id);
                buffer[n] = 0;
                Tcl_SetObjResult(interp, Tcl_NewStringObj(buffer, n));
            }
            return TCL_OK;
        }
        case CMD_DELETE:
            if (objc != 3) {
                Tcl_WrongNumArgs(interp, 2, objv, "id");
                return TCL_ERROR;
            }
            icoPtr = GetIcoPtr(interp, icoInterpPtr, Tcl_GetString(objv[2]));
            if (icoPtr == NULL) {
                return TCL_ERROR;
            }
            FreeIcoPtr(icoInterpPtr, icoPtr);
            return TCL_OK;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    Tcl_DString infodst;
    Tcl_DString titledst;
    NOTIFYICONDATAW ni;
    char *msgtitle;
    char *msginfo;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "command ...");
        return TCL_ERROR;
    }
    if (strcmp(Tcl_GetString(objv[1]), "notify") != 0) {
        Tcl_AppendResult(interp, "unknown subcommand \"", Tcl_GetString(objv[1]),
                "\": must be notify", NULL);
        return TCL_ERROR;
    }
    if (objc != 5) {
        Tcl_WrongNumArgs(interp, 2, objv, "id title detail");
        return TCL_ERROR;
    }

    icoPtr = GetIcoPtr(interp, icoInterpPtr, Tcl_GetString(objv[2]));
    if (icoPtr == NULL) {
        return TCL_ERROR;
    }

    ni.cbSize = sizeof(NOTIFYICONDATAW);
    ni.hWnd = icoInterpPtr->hwnd;
    ni.uID = icoPtr->id;
    ni.uFlags = NIF_INFO;
    ni.uCallbackMessage = ICON_MESSAGE;
    ni.hIcon = icoPtr->hIcon;
    ni.dwInfoFlags = NIIF_INFO; /* Use a sane platform-specific icon here.*/

    msgtitle = Tcl_GetString(objv[3]);
    msginfo = Tcl_GetString(objv[4]);

    /* Balloon notification for system tray icon. */
    if (msgtitle != NULL) {
        WCHAR *title;
        Tcl_DStringInit(&titledst);
        title = Tcl_UtfToWCharDString(msgtitle, TCL_INDEX_NONE, &titledst);
        wcsncpy(ni.szInfoTitle, title, (Tcl_DStringLength(&titledst) + 2) / 2);
        Tcl_DStringFree(&titledst);
    }
    if (msginfo != NULL) {
        WCHAR *info;
        Tcl_DStringInit(&infodst);
        info = Tcl_UtfToWCharDString(msginfo, TCL_INDEX_NONE, &infodst);
        wcsncpy(ni.szInfo, info, (Tcl_DStringLength(&infodst) + 2) / 2);
        Tcl_DStringFree(&infodst);
    }

    Shell_NotifyIconW(NIM_MODIFY, &ni);
    return TCL_OK;
}

/*

    Tcl_Interp *interp)
{
    IcoInterpInfo *icoInterpPtr;
    Tk_Window mainWindow;

    mainWindow = Tk_MainWindow(interp);
    if (mainWindow == NULL) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("main window has been destroyed", TCL_INDEX_NONE));
        return TCL_ERROR;
    }

    icoInterpPtr = (IcoInterpInfo*) ckalloc(sizeof(IcoInterpInfo));
    icoInterpPtr->counter = 0;
    icoInterpPtr->firstIcoPtr = NULL;
    icoInterpPtr->hwnd = CreateTaskbarHandlerWindow();
    icoInterpPtr->nextPtr = firstIcoInterpPtr;
    firstIcoInterpPtr = icoInterpPtr;
    Tcl_CreateObjCommand(interp, "::tk::systray::_systray", WinSystrayCmd,
            icoInterpPtr, NULL);
    Tcl_CreateObjCommand(interp, "::tk::sysnotify::_sysnotify", WinSysNotifyCmd,
            icoInterpPtr, NULL);

    Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
            WinIcoDestroy, icoInterpPtr);

    return TCL_OK;
}

/*
 * Local variables:
 * mode: c
 * indent-tabs-mode: nil
 * End:
 */

 */
HWND TestFindControl(HWND root, int id)
{
    struct TestFindControlState fcs;

    fcs.control = GetDlgItem(root, id);
    if (fcs.control == NULL) {
        /* Control is not a direct child. Look in descendents */
        fcs.id = id;
        fcs.control = NULL;
        EnumChildWindows(root, TestFindControlCallback, (LPARAM) &fcs);
    }
    return fcs.control;
}


/*
 *----------------------------------------------------------------------

    case WM_GETTEXT: {
	Tcl_DString ds;
	char buf[256];

#if 0
	GetDlgItemTextA(hwnd, id, buf, 256);
#else
        control = TestFindControl(hwnd, id);
        if (control == NULL) {
            Tcl_SetObjResult(interp,
                             Tcl_ObjPrintf("Could not find control with id %d", id));
            return TCL_ERROR;
        }
        buf[0] = 0;
        SendMessageA(control, WM_GETTEXT, (WPARAM)sizeof(buf),
                     (LPARAM) buf);
#endif
	Tcl_AppendResult(interp, Tcl_ExternalToUtfDString(NULL, buf, TCL_INDEX_NONE, &ds), NULL);
	Tcl_DStringFree(&ds);
	break;
    }
    case WM_SETTEXT: {
	Tcl_DString ds;

    int r = TCL_OK;
    DWORD myPid;

    Tcl_DStringInit(&classString);
    Tcl_DStringInit(&titleString);

    if (objc < 2 || objc > 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "title ?class?");
        return TCL_ERROR;
    }

    Tcl_DStringInit(&titleString);
    title = Tcl_UtfToWCharDString(Tcl_GetString(objv[1]), TCL_INDEX_NONE, &titleString);
    if (objc == 3) {
	Tcl_DStringInit(&classString);
	windowClass = Tcl_UtfToWCharDString(Tcl_GetString(objv[2]), TCL_INDEX_NONE, &classString);
    }
    if (title[0] == 0)
        title = NULL;
    /* We want find a window the belongs to us and not some other process */
    hwnd = NULL;
    myPid = GetCurrentProcessId();
    while (1) {
        DWORD pid, tid;
        hwnd = FindWindowExW(NULL, hwnd, windowClass, title);
        if (hwnd == NULL)
            break;
        tid = GetWindowThreadProcessId(hwnd, &pid);
        if (tid == 0) {
            /* Window has gone */
            hwnd = NULL;
            break;
        }
        if (pid == myPid)
            break;              /* Found it */
    }

    if (hwnd == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", TCL_INDEX_NONE));
	AppendSystemError(interp, GetLastError());
	r = TCL_ERROR;
    } else {
        Tcl_SetObjResult(interp, Tcl_NewWideIntObj(PTR2INT(hwnd)));
    }

    Tcl_DStringFree(&titleString);
    Tcl_DStringFree(&classString);
    return r;

}

    case TK_SETMENU:
    case TK_STATE:
    case TK_INFO:
	result = TkWinEmbeddedEventProc(hwnd, message, wParam, lParam);
	break;

    case WM_UNICHAR:
        if (wParam == UNICODE_NOCHAR) {
	    /* If wParam is UNICODE_NOCHAR and the application processes
	     * this message, then return TRUE. */
	    result = 1;
	} else {
	    /* If the event was translated, we must return 0 */
            if (TkTranslateWinEvent(hwnd, message, wParam, lParam, &result)) {
                result = 0;
	    } else {
	        result = 1;
	    }
	}
	break;

    default:
	if (!TkTranslateWinEvent(hwnd, message, wParam, lParam, &result)) {
	    result = DefWindowProcW(hwnd, message, wParam, lParam);

	if (winPtr) {
	    TkWinClipboardRender(winPtr->dispPtr, wParam);
	}
	return 1;
    }

    case WM_RENDERALLFORMATS: {
        TkWindow *winPtr = (TkWindow *) Tk_HWNDToWindow(hwnd);

        if (winPtr && OpenClipboard(hwnd)) {
            /*
             * Make sure that nobody had taken ownership of the clipboard
             * before we opened it.
             */

            if (GetClipboardOwner() == hwnd) {
                TkWinClipboardRender(winPtr->dispPtr, CF_TEXT);
            }
            CloseClipboard();
        }
        return 1;
    }

    case WM_COMMAND:
    case WM_NOTIFY:
    case WM_VSCROLL:
    case WM_HSCROLL: {
	/*

	     * MBCS characters that came from the TranslateMessage call.
	     */

	    event.x.type = KeyPress;
	    event.x.xany.send_event = -1;
	    event.x.xkey.keycode = wParam;
	    GetTranslatedKey(&event.key, (message == WM_KEYDOWN) ? WM_CHAR :
	            WM_SYSCHAR);
	    break;

	case WM_SYSKEYUP:
	case WM_KEYUP:
	    /*
	     * We don't check for translated characters on keyup because Tk
	     * won't know what to do with them. Instead, we wait for the

		event.key.nbytes = 1;
		event.key.trans_chars[0] = (char) wParam;

		if (IsDBCSLeadByte((BYTE) wParam)) {
		    MSG msg;

		    if ((PeekMessageW(&msg, NULL, WM_CHAR, WM_CHAR,
		            PM_NOREMOVE) != 0)
			    && (msg.message == WM_CHAR)) {
			GetMessageW(&msg, NULL, WM_CHAR, WM_CHAR);
			event.key.nbytes = 2;
			event.key.trans_chars[1] = (char) msg.wParam;
		   }
		}
	    }