Tk Source Code

{
    TkButton *butPtr = (TkButton *)clientData;
    int index;
    int result;
    Tcl_Obj *objPtr;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }
    result = Tcl_GetIndexFromObjStruct(interp, objv[1], commandNames[butPtr->type],
	    sizeof(char *), "option", 0, &index);
    if (result != TCL_OK) {
	return result;
    }

	     * appropriate value, initialize the variable if it doesn't exist,
	     * then set a trace on the variable to monitor future changes to
	     * its value.
	     */

	    valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY);
	    butPtr->flags &= ~SELECTED;
            butPtr->flags &= ~TRISTATED;
	    if (valuePtr != NULL) {
		const char *value = Tcl_GetString(valuePtr);
		if (strcmp(value, Tcl_GetString(butPtr->onValuePtr)) == 0) {
		    butPtr->flags |= SELECTED;
		} else if (strcmp(value,
                        Tcl_GetString(butPtr->tristateValuePtr)) == 0) {
		    butPtr->flags |= TRISTATED;

		    /*
		     * For checkbuttons if the tristate value is the
		     * same as the offvalue then prefer off to tristate
		     */

		    if (butPtr->offValuePtr
			&& strcmp(value,
			    Tcl_GetString(butPtr->offValuePtr)) == 0) {
			butPtr->flags &= ~TRISTATED;
		    }
                }
	    } else {
		if (Tcl_ObjSetVar2(interp, namePtr, NULL,
			(butPtr->type == TYPE_CHECK_BUTTON)
			? butPtr->offValuePtr : Tcl_NewObj(),
			TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
			== NULL) {
		    continue;

	    /*
	     * The button must display the contents of an image or bitmap.
	     */

	    if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->widthPtr,
		    &butPtr->width) != TCL_OK) {
	    widthError:
		Tcl_AddErrorInfo(interp, "\n    (processing -width option)");
		continue;
	    }
	    if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->heightPtr,
		    &butPtr->height) != TCL_OK) {
	    heightError:
		Tcl_AddErrorInfo(interp, "\n    (processing -height option)");
		continue;
	    }
	} else {
	    /*
	     * The button displays an ordinary text string.
	     */

	value = Tcl_GetString(valuePtr);
    }
    if (strcmp(value, Tcl_GetString(butPtr->onValuePtr)) == 0) {
	if (butPtr->flags & SELECTED) {
	    return NULL;
	}
	butPtr->flags |= SELECTED;
        butPtr->flags &= ~TRISTATED;
    } else if (butPtr->offValuePtr
	&& strcmp(value, Tcl_GetString(butPtr->offValuePtr)) == 0) {
	if (!(butPtr->flags & (SELECTED | TRISTATED))) {
	    return NULL;
	}
	butPtr->flags &= ~(SELECTED | TRISTATED);
    } else if (strcmp(value, Tcl_GetString(butPtr->tristateValuePtr)) == 0) {
        if (butPtr->flags & TRISTATED) {
            return NULL;
        }
        butPtr->flags |= TRISTATED;
        butPtr->flags &= ~SELECTED;
    } else if (butPtr->flags & (SELECTED | TRISTATED)) {
	butPtr->flags &= ~(SELECTED | TRISTATED);
    } else {
	return NULL;
    }

  redisplay:

typedef struct {
    XKeyEvent keyEvent;		/* The real event from X11. */
#ifdef _WIN32
#   ifndef XMaxTransChars
#	define XMaxTransChars 7
#   endif
    char trans_chars[XMaxTransChars];
                            /* translated characters */
    unsigned char nbytes;
#elif !defined(MAC_OSX_TK)
    char *charValuePtr;		/* A pointer to a string that holds the key's
				 * %A substitution text (before backslash
				 * adding), or NULL if that has not been
				 * computed yet. If non-NULL, this string was
				 * allocated with ckalloc(). */

	 * Recompute the geometry for the button.
	 */

	if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) {
	    if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString,
		    &mbPtr->width) != TCL_OK) {
	    widthError:
		Tcl_AddErrorInfo(interp, "\n    (processing -width option)");
		continue;
	    }
	    if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString,
		    &mbPtr->height) != TCL_OK) {
	    heightError:
		Tcl_AddErrorInfo(interp, "\n    (processing -height option)");
		continue;
	    }
	} else {
	    if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width)
		    != TCL_OK) {
		goto widthError;
	    }

    /*
     * If the variable is unset, then immediately recreate it unless the whole
     * interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
        if (!Tcl_InterpDeleted(interp) && msgPtr->textVarName) {
            void *probe = NULL;

            do {
                probe = Tcl_VarTraceInfo(interp,
                        msgPtr->textVarName,
                        TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
                        MessageTextVarProc, probe);
                if (probe == (void *)msgPtr) {
                    break;
                }
            } while (probe);
            if (probe) {
                /*
                 * We were able to fetch the unset trace for our
                 * textVarName, which means it is not unset and not
                 * the cause of this unset trace. Instead some outdated
                 * former variable must be, and we should ignore it.
                 */
                return NULL;
            }
	    Tcl_SetVar2(interp, msgPtr->textVarName, NULL, msgPtr->string,
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar2(interp, msgPtr->textVarName, NULL,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    MessageTextVarProc, clientData);
	}
	return NULL;

	$w configure -state normal
    }

    # Restore the original button "selected" color; but only if the user
    # has not changed it in the meantime.

    if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} {
        if {[$w cget -selectcolor] eq $Priv($w,selectcolor)
                || ([info exist Priv($w,aselectcolor)] &&
                    [$w cget -selectcolor] eq $Priv($w,aselectcolor))} {
	    $w configure -selectcolor $Priv($w,selectcolor)
	}
    }
    unset -nocomplain Priv($w,selectcolor) Priv($w,aselectcolor)

    # Restore the original button relief if it was changed by Tk. That is
    # signaled by the existence of Priv($w,prelief).

package require -exact tk  9.0b3

# Create a ::tk namespace
namespace eval ::tk {
    # Set up the msgcat commands
    namespace eval msgcat {
	namespace export mc mcmax
        if {[interp issafe] || [catch {package require msgcat}]} {
            # The msgcat package is not available.  Supply our own
            # minimal replacement.
            proc mc {src args} {
                return [format $src {*}$args]
            }
            proc mcmax {args} {
                set max 0
                foreach string $args {
                    set len [string length $string]
                    if {$len>$max} {
                        set max $len
                    }
                }
                return $max
            }
        } else {
            # Get the commands from the msgcat package that Tk uses.
            namespace import ::msgcat::mc
            namespace import ::msgcat::mcmax
            ::msgcat::mcload [file join $::tk_library msgs]
        }
    }
    namespace import ::tk::msgcat::*
}
# and a ::ttk namespace
namespace eval ::ttk {
    if {$::tk_library ne ""} {
	# avoid file join to work in safe interps, but this is also x-plat ok


# ----------------------------------------------------------------------
# Read in files that define all of the class bindings.
# ----------------------------------------------------------------------

if {$::tk_library ne ""} {
    proc ::tk::SourceLibFile {file} {
        namespace eval :: [list source [file join $::tk_library $file.tcl]]
    }
    namespace eval ::tk {
	SourceLibFile icons
	SourceLibFile iconbadges
	SourceLibFile button
	SourceLibFile entry
	SourceLibFile listbox

    proc ::tk::mac::DoScriptText {script} {
	uplevel #0 $script
	eval $script
    }
    #This procedure is required to silence warnings generated
    #by inline AppleScript execution.
    proc ::tk::mac::GetDynamicSdef {} {
         puts ""
     }
}

if {[info commands ::tk::endOfWord] eq ""} {
    proc ::tk::endOfWord {str start {locale {}}} {
	if {$start < 0} {
	    set start -1
	}

	    Tk_Fill3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, 0,
		    Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
	} else {
	    Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0,
		    Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
	}

        /*
	 * Display image or bitmap or text for labels or custom controls.
	 */

	DrawButtonImageAndText(butPtr);
        needhighlight = 1;
    } else {
        /*
	 * Draw the native portion of the buttons.
	 */

        TkMacOSXDrawButton(macButtonPtr, dpPtr->gc, pixmap);

        /*
	 * Ask for the highlight border, if needed.
	 */

        if (butPtr->highlightWidth < 3) {
            needhighlight = 1;
        }
    }

    /*
     * Draw highlight border, if needed.
     */

    if (needhighlight) {
	GC gc = NULL;
        if ((butPtr->flags & GOT_FOCUS) && butPtr->highlightColorPtr) {
	    gc = Tk_GCForColor(butPtr->highlightColorPtr, pixmap);
	} else if (butPtr->type == TYPE_LABEL) {
	    gc = Tk_GCForColor(Tk_3DBorderColor(butPtr->highlightBorder), pixmap);
	}
	if (gc) {
	    TkMacOSXDrawSolidBorder(tkwin, gc, 0, butPtr->highlightWidth);
	}

	    /*
	     * Allow room to shift the image.
	     */
	    width += 2;
	    height += 2;
	}
    } else { /* Text only */
        width = txtWidth + butPtr->indicatorSpace;
	height = txtHeight;
	if (butPtr->width > 0) {
	    charWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
	    width = butPtr->width * charWidth + 2*butPtr->padX;
	}
	if (butPtr->height > 0) {
	    Tk_GetFontMetrics(butPtr->tkfont, &fm);

    width += butPtr->inset*2;
    height += butPtr->inset*2;
    if ([NSApp macOSVersion] == 100600) {
	width += 12;
    }
    if (mbPtr->btnkind == kThemePushButton) {
        HIRect tmpRect;
    	HIRect contBounds;

	/*
	 * A PushButton has a minimum size.  We make sure that we are not
	 * underestimating the size by requesting the content size of a
	 * Pushbutton whose overall size is our content size expanded by the
	 * standard padding.
	 */

	tmpRect = CGRectMake(0, 0, width + 2*HI_PADX, height + 2*HI_PADY);
        HIThemeGetButtonContentBounds(&tmpRect, &mbPtr->drawinfo, &contBounds);
        if (height < contBounds.size.height) {
	    height = (int)contBounds.size.height;
        }
        if (width < contBounds.size.width) {
	    width = (int)contBounds.size.width;
        }
	height += 2*HI_PADY;
	width += 2*HI_PADX;
    }
    Tk_GeometryRequest(butPtr->tkwin, width, height);
    Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset);
}


    int imageXOffset = 0, imageYOffset = 0;
    int textXOffset = 0, textYOffset = 0;
    int width = 0, height = 0;
    int fullWidth = 0, fullHeight = 0;
    DrawParams *dpPtr = &mbPtr->drawParams;

    if (tkwin == NULL || !Tk_IsMapped(tkwin)) {
        return;
    }

    pixmap = (Pixmap) Tk_WindowId(tkwin);

    if (butPtr->image != NULL) {
        Tk_SizeOfImage(butPtr->image, &width, &height);
        haveImage = 1;
    } else if (butPtr->bitmap != None) {
        Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
        haveImage = 1;
    }

    imageWidth = width;
    imageHeight = height;

    if (mbPtr->drawinfo.state == kThemeStatePressed) {
        pressed = 1;
    }

    haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0);
    if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) { /* Image and Text */
        int x, y;

        switch ((enum compound) butPtr->compound) {
	case COMPOUND_TOP:
	case COMPOUND_BOTTOM:
	    /* Image is above or below text */
	    if (butPtr->compound == COMPOUND_TOP) {
		textYOffset = height + butPtr->padY;
	    } else {
		imageYOffset = butPtr->textHeight + butPtr->padY;

	    textYOffset = (fullHeight - butPtr->textHeight)/2;
	    imageYOffset = (fullHeight - height)/2;
	    break;
	default:
	    break;
	}

        TkComputeAnchor(butPtr->anchor, tkwin,
                butPtr->padX + butPtr->borderWidth,
                butPtr->padY + butPtr->borderWidth,
                fullWidth + butPtr->indicatorSpace, fullHeight, &x, &y);
	x += butPtr->indicatorSpace;

        if (dpPtr->relief == TK_RELIEF_SUNKEN) {
            x += dpPtr->offset;
            y += dpPtr->offset;
        } else if (dpPtr->relief == TK_RELIEF_RAISED) {
            x -= dpPtr->offset;
            y -= dpPtr->offset;
        }
        if (pressed) {
            x += dpPtr->offset;
            y += dpPtr->offset;
        }
        imageXOffset += x;
        imageYOffset += y;

        if (butPtr->image != NULL) {
	    if ((butPtr->selectImage != NULL) &&
		    (butPtr->flags & SELECTED)) {
		Tk_RedrawImage(butPtr->selectImage, 0, 0,
			width, height, pixmap, imageXOffset, imageYOffset);
	    } else if ((butPtr->tristateImage != NULL) &&
		    (butPtr->flags & TRISTATED)) {
		Tk_RedrawImage(butPtr->tristateImage, 0, 0,
			width, height, pixmap, imageXOffset, imageYOffset);
	    } else {
		Tk_RedrawImage(butPtr->image, 0, 0, width,
			height, pixmap, imageXOffset, imageYOffset);
	    }
        } else {
	    XSetClipOrigin(butPtr->display, dpPtr->gc,
		    imageXOffset, imageYOffset);
	    XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, dpPtr->gc,
		    0, 0, (unsigned int) width, (unsigned int) height,
		    imageXOffset, imageYOffset, 1);
	    XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0);
        }
	y += 1; /* Tweak to match native buttons. */
        Tk_DrawTextLayout(butPtr->display, pixmap, dpPtr->gc, butPtr->textLayout,
			  x + textXOffset, y + textYOffset, 0, -1);
        Tk_UnderlineTextLayout(butPtr->display, pixmap, dpPtr->gc,
                butPtr->textLayout,
                x + textXOffset, y + textYOffset,
                butPtr->underline);
    } else if (haveImage) { /* Image only */
        int x = 0, y;

	TkComputeAnchor(butPtr->anchor, tkwin,
		butPtr->padX + butPtr->borderWidth,
		butPtr->padY + butPtr->borderWidth,
		width + butPtr->indicatorSpace, height, &x, &y);
        x += butPtr->indicatorSpace;
	if (pressed) {
	    x += dpPtr->offset;
	    y += dpPtr->offset;
	}
	imageXOffset += x;
	imageYOffset += y;

	    XSetClipOrigin(butPtr->display, dpPtr->gc, x, y);
	    XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, dpPtr->gc,
		    0, 0, (unsigned int) width, (unsigned int) height,
		    imageXOffset, imageYOffset, 1);
	    XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0);
	}
    } else { /* Text only */
        int x, y;

	TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
		butPtr->textWidth + butPtr->indicatorSpace,
		butPtr->textHeight, &x, &y);
	x += butPtr->indicatorSpace;
	y += 1; /* Tweak to match native buttons */
	Tk_DrawTextLayout(butPtr->display, pixmap, dpPtr->gc, butPtr->textLayout,
			  x, y, 0, -1);
    }

    /*
     * If the button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.  If the widget is
     * selected and we use a different background color when selected, must
     * temporarily modify the GC so the stippling is the right color.
     */

    if (mbPtr->useTkText) {
        if ((butPtr->state == STATE_DISABLED)
                && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
            if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
                    && (butPtr->selectBorder != NULL)) {
                XSetForeground(butPtr->display, butPtr->stippleGC,
                        Tk_3DBorderColor(butPtr->selectBorder)->pixel);
            }
            /*
             * Stipple the whole button if no disabledFg was specified,
             * otherwise restrict stippling only to displayed image
             */
            if (butPtr->disabledFg == NULL) {
                XFillRectangle(butPtr->display, pixmap, butPtr->stippleGC,
                        0, 0, (unsigned) Tk_Width(tkwin),
                        (unsigned) Tk_Height(tkwin));
            } else {
                XFillRectangle(butPtr->display, pixmap, butPtr->stippleGC,
                        imageXOffset, imageYOffset,
                        (unsigned) imageWidth, (unsigned) imageHeight);
            }
            if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
                && (butPtr->selectBorder != NULL)
            ) {
                XSetForeground(butPtr->display, butPtr->stippleGC,
                        Tk_3DBorderColor(butPtr->normalBorder)->pixel);
            }
        }

        /*
         * Draw the border and traversal highlight last.  This way, if the
         * button's contents overflow they'll be covered up by the border.
         */

        if (dpPtr->relief != TK_RELIEF_FLAT) {
	    int inset = butPtr->highlightWidth;

	    Tk_Draw3DRectangle(tkwin, pixmap, dpPtr->border, inset, inset,
		    Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset,
		    butPtr->borderWidth, dpPtr->relief);
        }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkpDestroyButton --

void
TkpDestroyButton(
    TkButton *butPtr)
{
    MacButton *mbPtr = (MacButton *) butPtr; /* Mac button. */

    if (mbPtr->defaultPulseHandler) {
        Tcl_DeleteTimerHandler(mbPtr->defaultPulseHandler);
    }
}

/*
 *--------------------------------------------------------------
 *
 * TkMacOSXDrawButton --

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

static void
TkMacOSXDrawButton(
    MacButton *mbPtr,    /* Mac button. */
    TCL_UNUSED(GC),      /* The GC we are drawing into - needed for
                          * the bevel button */
    Pixmap pixmap)       /* The pixmap we are drawing into - needed
                          * for the bevel button */
{
    TkButton *butPtr = (TkButton *) mbPtr;
    TkWindow *winPtr = (TkWindow *) butPtr->tkwin;
    HIRect cntrRect;
    TkMacOSXDrawingContext dc;
    DrawParams *dpPtr = &mbPtr->drawParams;
    int useNewerHITools = 1;

    TkMacOSXComputeButtonParams(butPtr, &mbPtr->btnkind, &mbPtr->drawinfo);

    cntrRect = CGRectMake(winPtr->privatePtr->xOff, winPtr->privatePtr->yOff,
	    Tk_Width(butPtr->tkwin), Tk_Height(butPtr->tkwin));

    cntrRect = CGRectInset(cntrRect, butPtr->inset, butPtr->inset);

    if (useNewerHITools == 1) {
        HIRect contHIRec;
        static HIThemeButtonDrawInfo hiinfo;

        ButtonBackgroundDrawCB(&cntrRect, mbPtr, 32, true);

	if (!TkMacOSXSetupDrawingContext(pixmap, dpPtr->gc, &dc)) {
	    return;
	}

        hiinfo.version = 0;
        hiinfo.state = mbPtr->drawinfo.state;
        hiinfo.kind = mbPtr->btnkind;
        hiinfo.value = mbPtr->drawinfo.value;
        hiinfo.adornment = mbPtr->drawinfo.adornment;
        hiinfo.animation.time.current = CFAbsoluteTimeGetCurrent();
        if (hiinfo.animation.time.start == 0) {
            hiinfo.animation.time.start = hiinfo.animation.time.current;
        }

	/*
	 * To avoid buttons with white text on a white background, we set the
	 * state to inactive in Dark Mode unless the button is pressed or is a
	 * -default active button.  This isn't perfect but it is mostly usable.
	 * Using a ttk::button would be a much better choice, however.
	 */

	if ([NSApp macOSVersion] < 101500) {
	    if (TkMacOSXInDarkMode(butPtr->tkwin) &&
		mbPtr->drawinfo.state != kThemeStatePressed &&
		!(mbPtr->drawinfo.adornment & kThemeAdornmentDefault)) {
		hiinfo.state = kThemeStateInactive;
	    }
	}
	HIThemeDrawButton(&cntrRect, &hiinfo, dc.context,
		kHIThemeOrientationNormal, &contHIRec);

	TkMacOSXRestoreDrawingContext(&dc);
        ButtonContentDrawCB(&contHIRec, mbPtr->btnkind, &mbPtr->drawinfo,
		(MacButton *) mbPtr, 32, true);
    } else {
	if (!TkMacOSXSetupDrawingContext(pixmap, dpPtr->gc, &dc)) {
	    return;
	}

	TkMacOSXRestoreDrawingContext(&dc);

    MacButton *mbPtr = (MacButton *) ptr;
    TkButton *butPtr = (TkButton *) mbPtr;
    Tk_Window tkwin = butPtr->tkwin;
    Pixmap pixmap;
    int usehlborder = 0;

    if (tkwin == NULL || !Tk_IsMapped(tkwin)) {
        return;
    }
    pixmap = (Pixmap) Tk_WindowId(tkwin);

    if (butPtr->type != TYPE_LABEL) {
        switch (mbPtr->btnkind) {
	case kThemeSmallBevelButton:
	case kThemeBevelButton:
	case kThemeRoundedBevelButton:
	case kThemePushButton:
	    usehlborder = 1;
	    break;
        }
    }
    if (usehlborder) {
        Tk_Fill3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, 0,
            Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
    } else {
        Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0,
            Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
    }
}

/*
 *--------------------------------------------------------------
 *
 * ButtonContentDrawCB --

    TCL_UNUSED(SInt16),
    TCL_UNUSED(Boolean))
{
    TkButton *butPtr = (TkButton *) ptr;
    Tk_Window tkwin = butPtr->tkwin;

    if (tkwin == NULL || !Tk_IsMapped(tkwin)) {
        return;
    }

    /*
     * Overlay Tk elements over button native region: drawing elements within
     * button boundaries/native region causes unpredictable metrics.
     */

    TkButton *butPtr,
    ThemeButtonKind *btnkind,
    HIThemeButtonDrawInfo *drawinfo)
{
    MacButton *mbPtr = (MacButton *) butPtr;

    if (butPtr->borderWidth <= 2) {
        *btnkind = kThemeSmallBevelButton;
    } else if (butPtr->borderWidth == 3) {
        *btnkind = kThemeBevelButton;
    } else if (butPtr->borderWidth == 4) {
        *btnkind = kThemeRoundedBevelButton;
    } else {
        *btnkind = kThemePushButton;
    }

    if ((butPtr->image == NULL) && (butPtr->bitmap == None)) {
        switch (butPtr->type) {
	case TYPE_BUTTON:
	    *btnkind = kThemePushButton;
	    break;
	case TYPE_RADIO_BUTTON:
	    if (butPtr->borderWidth <= 1) {
		*btnkind = kThemeSmallRadioButton;
	    } else {

		*btnkind = kThemeCheckBox;
	    }
	    break;
	}
    }

    if (butPtr->indicatorOn) {
        switch (butPtr->type) {
	case TYPE_RADIO_BUTTON:
	    if (butPtr->borderWidth <= 1) {
		*btnkind = kThemeSmallRadioButton;
	    } else {
		*btnkind = kThemeRadioButton;
	    }
	    break;
	case TYPE_CHECK_BUTTON:
	    if (butPtr->borderWidth <= 1) {
		*btnkind = kThemeSmallCheckBox;
	    } else {
		*btnkind = kThemeCheckBox;
	    }
	    break;
        }
    } else {
        if (butPtr->type == TYPE_RADIO_BUTTON ||
		butPtr->type == TYPE_CHECK_BUTTON) {
	    if (*btnkind == kThemePushButton) {
		*btnkind = kThemeBevelButton;
	    }
        }
    }

    if (butPtr->flags & SELECTED) {
        drawinfo->value = kThemeButtonOn;
    } else if (butPtr->flags & TRISTATED) {
        drawinfo->value = kThemeButtonMixed;
    } else {
        drawinfo->value = kThemeButtonOff;
    }

    if ((mbPtr->flags & FIRST_DRAW) != 0) {
	mbPtr->flags &= ~FIRST_DRAW;
	if (Tk_MacOSXIsAppInFront()) {
	    mbPtr->flags |= ACTIVE;
	}
    }

    drawinfo->state = kThemeStateInactive;
    if ((mbPtr->flags & ACTIVE) == 0) {
        if (butPtr->state == STATE_DISABLED) {
            drawinfo->state = kThemeStateUnavailableInactive;
        } else {
            drawinfo->state = kThemeStateInactive;
        }
    } else if (butPtr->state == STATE_DISABLED) {
        drawinfo->state = kThemeStateUnavailable;
    } else if (butPtr->state == STATE_ACTIVE) {
        drawinfo->state = kThemeStatePressed;
    } else {
        drawinfo->state = kThemeStateActive;
    }

    drawinfo->adornment = kThemeAdornmentNone;
    if (butPtr->defaultState == DEFAULT_ACTIVE) {
	if (drawinfo->state != kThemeStatePressed) {
	    drawinfo->adornment |= kThemeAdornmentDefault;
	}

	/*
	 * Older macOS systems (10.9 and earlier) use an animation to
	 * indicate the active button.  This is simulated by redrawing
	 * the button periodically.
	 */

        if (!mbPtr->defaultPulseHandler && ([NSApp macOSVersion] <= 100900)) {
            mbPtr->defaultPulseHandler = Tcl_CreateTimerHandler(
                    PULSE_TIMER_MSECS, PulseDefaultButtonProc, butPtr);
        }
    } else if (mbPtr->defaultPulseHandler) {
        Tcl_DeleteTimerHandler(mbPtr->defaultPulseHandler);
    }
    if (butPtr->highlightWidth >= 3) {
        if ((butPtr->flags & GOT_FOCUS)) {
            drawinfo->adornment |= kThemeAdornmentFocus;
        }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkMacOSXComputeButtonDrawParams --

{
    MacButton *mbPtr = (MacButton *) butPtr;

    dpPtr->hasImageOrBitmap = ((butPtr->image != NULL)
	    || (butPtr->bitmap != None));

    if (butPtr->type != TYPE_LABEL) {
        dpPtr->offset = 0;
        if (dpPtr->hasImageOrBitmap) {
            switch (mbPtr->btnkind) {
	    case kThemeSmallBevelButton:
	    case kThemeBevelButton:
	    case kThemeRoundedBevelButton:
	    case kThemePushButton:
		dpPtr->offset = 1;
		break;
            }
        }
    }

    dpPtr->border = butPtr->normalBorder;
    if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
	dpPtr->gc = butPtr->disabledGC;
    } else if (butPtr->type == TYPE_BUTTON && butPtr->state == STATE_ACTIVE) {
	dpPtr->gc = butPtr->activeTextGC;

     * Fix 40ada90762: any idle calls to TkpDisplayButton need to be canceled
     * in case the button is destroyed and has its data freed before the idle
     * event is handled (DestroyButton only cancels calls when REDRAW_PENDING
     * is set, which is not the case after calling TkpDisplayButton directly).
     */
    Tcl_CancelIdleCall(TkpDisplayButton, clientData);
    mbPtr->defaultPulseHandler = Tcl_CreateTimerHandler(
            PULSE_TIMER_MSECS, PulseDefaultButtonProc, clientData);
}

/*
 * Local Variables:
 * mode: objc
 * c-basic-offset: 4
 * fill-column: 79
 * coding: utf-8
 * End:
 */

.t.t insert end \n
.t.t insert end rrr r1
.t.t insert end *****
.t.t insert end rrr r1

font configure TkFixedFont -size 20
.t.t tag configure sol100 -relief solid -borderwidth 100 \
                          -foreground red -font TkFixedFont
.t.t tag configure sol12 -relief solid -borderwidth 12 \
                          -foreground red -font TkFixedFont
.t.t tag configure big -font TkFixedFont
set ind [.t.t index end]

.t.t insert end "\n\nBorders do not leak on the neighbour chars"
.t.t insert end "\nOnly \"S\" is on dark background"
.t.t insert end {
 xxx

pack .t.control.left .t.control.right -side left -expand 1 -fill x
label .t.anchorLabel -text "Color:"
frame .t.control.left.f -width 6c -height 3c
pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top -anchor w
foreach opt {activebackground activeforeground background disabledforeground foreground highlightbackground highlightcolor } {
    #button .t.color-$opt -text $opt -command "config -$opt \[tk_chooseColor]"
    menubutton .t.color-$opt -text $opt -menu .t.color-$opt.m -indicatoron 1 \
        -relief raised -bd 2
    menu .t.color-$opt.m -tearoff 0
    .t.color-$opt.m add command -label Red -command "config -$opt red"
    .t.color-$opt.m add command -label Green -command "config -$opt green"
    .t.color-$opt.m add command -label Blue -command "config -$opt blue"
    .t.color-$opt.m add command -label Other... \
          -command "config -$opt \[tk_chooseColor]"
    pack .t.color-$opt -in .t.control.left.f -fill x
}

set default disabled
label .t.default -text Default:
radiobutton .t.default-normal -text "Default normal" -relief flat \
	-command "config-but -default normal" -variable default \

test button-5.17 {ConfigureButton - -width option} -body {
    button .b -text "Button 1"
    catch {.b configure -width 1i}
    return $errorInfo
} -cleanup {
    destroy .b
} -result  {expected integer but got "1i"
    (processing -width option)
    invoked from within
".b configure -width 1i"}
test button-5.18 {ConfigureButton - -height option} -body {
    button .b -text "Button 1"
    .b configure -height 0.5c
} -cleanup {
    destroy .b
} -returnCodes {error} -result {expected integer but got "0.5c"}
test button-5.19 {ConfigureButton - -height option} -body {
    button .b -text "Button 1"
    catch {.b configure -height 0.5c}
    return $errorInfo
} -cleanup {
    destroy .b
} -result {expected integer but got "0.5c"
    (processing -height option)
    invoked from within
".b configure -height 0.5c"}
#ex 6.16
test button-5.20 {ConfigureButton - -width option} -body {
    button .b -bitmap questhead
    .b configure -width abc
} -cleanup {
    destroy .b
} -returnCodes {error} -result  {expected screen distance but got "abc"}
test button-5.21 {ConfigureButton - -width option} -body {
    button .b -bitmap questhead
    catch {.b configure -width abc}
    return $errorInfo
} -cleanup {
    destroy .b
} -result {expected screen distance but got "abc"
    (processing -width option)
    invoked from within
".b configure -width abc"}
test button-5.22 {ConfigureButton - -height option} -constraints {
    testImageType
} -setup {
    image create test image1
} -body {

    button .b -image image1
    catch {.b configure -height 0.5x}
    return $errorInfo
} -cleanup {
    destroy .b
    image delete image1
} -result  {expected screen distance but got "0.5x"
    (processing -height option)
    invoked from within
".b configure -height 0.5x"}
#ex 6.18
test button-5.24 {ConfigureButton - computing geometry} -constraints {
    fonts
} -body {
    button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \

    set y {}
    set timer [after 500 {lappend y "timed out"}]
    .c itemconfigure i1 -image foo2
    update idletasks
    update
    # On MacOS we need to wait for the test image display procedure to run.
    while {"timed out" ni $y && [lindex $y end 1] ne "display"} {
        vwait y
    }
    after cancel $timer
    list $x $y [.c bbox i1]
} -cleanup {
    .c delete all
    image delete foo
    image delete foo2

test clrpick-2.1 {tk_chooseColor command} -constraints {
    nonUnixUserInteraction colorsLeftover
} -setup {
    set verylongstring [string repeat longstring: 100]
} -body {
    ToPressButton . ok
    tk_chooseColor -title "Press Ok $verylongstring" -initialcolor #404040 \
        -parent .
} -result {#404040}
test clrpick-2.2 {tk_chooseColor command} -constraints {
    nonUnixUserInteraction colorsLeftover
} -body {
    set colors "128 128 64"
    ToChooseColorByKey . 128 128 64
    tk_chooseColor -parent . -title "choose #808040"

} -returnCodes error -result {error reading PPM image file "test.ppm": not enough data}
test imgPPM-1.8 {FileReadPPM procedure} -body {
    put test.ppm "P6\n5 4\n255\n01234567890123456789012345678901234567890123456789012345678"
    image create photo p1 -file test.ppm
} -returnCodes error -result {error reading PPM image file "test.ppm": not enough data}
test imgPPM-1.9 {FileReadPPM procedure} -body {
    put test.ppm "P6\n5 4\n150\n012345678901234567890123456789012345678901234567890123456789"
    list [image create photo p1 -file test.ppm] \
        [image width p1] [image height p1]
} -returnCodes ok -result {p1 5 4}


test imgPPM-2.1 {FileWritePPM procedure} -setup {
    catch {image delete p1}
} -body {
    put test.ppm "P6\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789"
    image create photo p1 -file test.ppm
    list [catch {p1 write not_a_dir/bar/baz/gorp} msg] [string tolower $msg] \
        [string tolower $errorCode]
} -cleanup {
    image delete p1
} -result {1 {couldn't open "not_a_dir/bar/baz/gorp": no such file or directory} {posix enoent {no such file or directory}}}

test imgPPM-2.2 {FileWritePPM procedure} -setup {
    catch {image delete p1}
    catch {unset data}

} -body {
    button .mb1 -text "Menubutton 1"
    catch {.mb1 configure -width 1i}
    return $errorInfo
} -cleanup {
    deleteWindows
} -result {expected integer but got "1i"
    (processing -width option)
    invoked from within
".mb1 configure -width 1i"}

test menubutton-4.3 {ConfigureMenuButton procedure} -setup {
    deleteWindows
} -body {
    button .mb1 -text "Menubutton 1"
    .mb1 configure -height 0.5c
} -cleanup {
    deleteWindows
} -returnCodes error -result {expected integer but got "0.5c"}
test menubutton-4.4 {ConfigureMenuButton procedure} -setup {
    deleteWindows
} -body {
    button .mb1 -text "Menubutton 1"
    catch {.mb1 configure -height 0.5c}
    return $errorInfo
} -cleanup {
    deleteWindows
} -result {expected integer but got "0.5c"
    (processing -height option)
    invoked from within
".mb1 configure -height 0.5c"}

test menubutton-4.5 {ConfigureMenuButton procedure} -setup {
    deleteWindows
} -body {
    button .mb1 -bitmap questhead
    .mb1 configure -width abc
} -cleanup {
    deleteWindows
} -returnCodes error -result {expected screen distance but got "abc"}
test menubutton-4.6 {ConfigureMenuButton procedure} -setup {
    deleteWindows
} -body {
    button .mb1 -bitmap questhead
    catch {.mb1 configure -width abc}
    return $errorInfo
} -cleanup {
    deleteWindows
} -result {expected screen distance but got "abc"
    (processing -width option)
    invoked from within
".mb1 configure -width abc"}

test menubutton-4.7 {ConfigureMenuButton procedure} -constraints {
    testImageType
} -setup {
    deleteWindows

    button .mb1 -image image1
    catch {.mb1 configure -height 0.5x}
    return $errorInfo
} -cleanup {
    deleteWindows
    imageCleanup
} -result {expected screen distance but got "0.5x"
    (processing -height option)
    invoked from within
".mb1 configure -height 0.5x"}

test menubutton-4.9 {ConfigureMenuButton procedure} -constraints {
    nonPortable fonts
} -setup {
    deleteWindows

    .cb invoke
    lappend result [info exists .cb] [set .cb] [.cb state]
} -result [list .cb 0 alternate   1 on selected  1 off {}]

# Bug [109865fa01]
test checkbutton-1.7 "Button destroyed by click" -body {
    proc destroy_button {} {
        destroy .top
    }
    toplevel .top
    ttk::menubutton .top.mb -text Button -style TLabel
    bind .top.mb <ButtonRelease-1> destroy_button
    pack .top.mb
    focus -force .top.mb
    update

}  -cleanup {destroy .te .tsb}

test entry-2.1.1 "Create entry before scrollbar - scrollbar catches up" -body {
    pack [ttk::entry .te -xscrollcommand [list .tsb set]] \
	    -expand true -fill both
    .te insert end [string repeat "abc" 50]
    catch {update} ; # error triggers because the -xscrollcommand callback
                     # errors out: invalid command name ".tsb"
    focus -force .te ; # needed on some systems such as Ubuntu (see ticket [3c2a3a988f])
    pack [ttk::scrollbar .tsb -orient horizontal -command [list .te xview]] \
	    -expand false -fill x
    update ; # no error
    set res [expr [lindex [.tsb get] 1] < 1] ; # scrollbar did update
} -result 1 -cleanup {destroy .te .tsb}

test panedwindow-6.1 "style command" -body {
    # Contrary to ttk::scrollbar, ttk::progressbar and ttk::scale,
    # ttk::panedwindow has same style TPanedwindow whatever -orient is
    ttk::panedwindow .wv  ; # default is  -orient vertical
    ttk::panedwindow .wh -orient horizontal
    list [.wv cget -style] [.wv style] [winfo class .wv]\
         [.wh cget -style] [.wh style] [winfo class .wh]
} -cleanup {
    destroy .wv .wh
} -result {{} TPanedwindow TPanedwindow {} TPanedwindow TPanedwindow}
test panedwindow-6.2 "style command" -body {
    ttk::style configure customStyle.TPanedwindow
    ttk::panedwindow .w -style customStyle.TPanedwindow
    list [.w cget -style] [.w style] [winfo class .w]

    unset -nocomplain res
} -result {0 normal 1 disabled 0 normal 1 normal {disabled readonly} normal}

test scale-3.1 "style command" -body {
    ttk::scale .wh  ; # default is  -orient horizontal
    ttk::scale .wv -orient vertical
    list [.wh cget -style] [.wh style] [winfo class .wh] \
         [.wv cget -style] [.wv style] [winfo class .wv]
} -cleanup {
    destroy .wh .wv
} -result {{} Horizontal.TScale TScale {} Vertical.TScale TScale}
test scale-3.2 "style command" -body {
    ttk::style configure customStyle.Vertical.TScale
    ttk::scale .w -orient vertical -style customStyle.Vertical.TScale
    list [.w cget -style] [.w style] [winfo class .w]

    destroy .t .s
} -result {1.3}

test scrollbar-11.1 "style command" -body {
    ttk::scrollbar .wv  ; # default is  -orient vertical
    ttk::scrollbar .wh -orient horizontal
    list [.wv cget -style] [.wv style] [winfo class .wv] \
         [.wh cget -style] [.wh style] [winfo class .wh]
} -cleanup {
    destroy .wv .wh
} -result {{} Vertical.TScrollbar TScrollbar {} Horizontal.TScrollbar TScrollbar}
test scrollbar-11.2 "style command" -body {
    ttk::style configure customStyle.Horizontal.TScrollbar
    ttk::scrollbar .w -orient horizontal -style customStyle.Horizontal.TScrollbar
    list [.w cget -style] [.w style] [winfo class .w]

package require tk
package require tcltest 2.2
namespace import -force tcltest::*
loadTestedCommands

### treeview tag invariants:
#

proc assert {expr {message ""}} {
    if {![uplevel 1 [list expr $expr]]} {
        error "PANIC: $message ($expr failed)"
    }
}

proc itemConstraints {tv item} {
    # $tag in [$tv item $item -tags] <==> [$tv tag has $tag $item]
    foreach tag [$tv item $item -tags] {
	assert {$item in [$tv tag has $tag]}

# @@@ fragile test
test treetags-3.2 "tag configure - enumerate" -body {
    $tv tag configure tag1
} -cleanup {
    treeConstraints $tv
} -result [list \
    -image {} -imageanchor {} -background red -stripedbackground {} -foreground blue -font {} -padding {} \
                  ]

test treetags-4.1 "tag cell add" -body {
    $tv tag cell add _thetag
} -returnCodes 1 -result {wrong # args: should be ".tv tag cell add tagName cells"}

test treetags-4.2 "tag cell remove" -body {
    $tv tag cell remove _thetag
    $tv tag cell remove

tock

now
test ttk-8.1 "Test -compound options" -body {
    # Exhaustively test each combination.
    # Main goal is to make sure no code paths crash.
    foreach image {icon ""} {
        foreach text {"Hi!" ""} {
	    foreach compound $::compoundStrings {
		.ctb configure -image $image -text $text -compound $compound
		update; tick
	    }
	}
    }
}
tock

test ttk-8.2 "Test -compound options with regular button" -body {
    button .rtb
    pack .rtb

    foreach image {"" icon} {
        foreach text {"Hi!" ""} {
	    foreach compound [lrange $::compoundStrings 2 end] {
		.rtb configure -image $image -text $text -compound $compound
		update; tick
	    }
	}
    }
}
tock

test ttk-8.3 "Rerun test 8.1" -body {
    foreach image {icon ""} {
        foreach text {"Hi!" ""} {
	    foreach compound $::compoundStrings {
		.ctb configure -image $image -text $text -compound $compound
		update; tick
	    }
	}
    }
}

    /*
     * Compute width of default ring and offset for pushed buttons.
     */

    if (butPtr->type == TYPE_LABEL) {
	defaultWidth = butPtr->highlightWidth;
        offset = 0;
    } else if (butPtr->type == TYPE_BUTTON) {
	defaultWidth = ((butPtr->defaultState == DEFAULT_ACTIVE)
		? butPtr->highlightWidth : 0);
	offset = 1;
    } else {
	defaultWidth = 0;
	if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {

	Tk_Draw3DRectangle(tkwin, pixmap, border,
		defaultWidth, defaultWidth,
		Tk_Width(tkwin) - 2*defaultWidth,
		Tk_Height(tkwin) - 2*defaultWidth,
		butPtr->borderWidth, relief);
    }
    if (defaultWidth != 0) {
        int highlightColor;

	dc = TkWinGetDrawableDC(butPtr->display, pixmap, &state);
        if (butPtr->type == TYPE_LABEL) {
            highlightColor = (int) Tk_3DBorderColor(butPtr->highlightBorder)->pixel;
        } else {
            highlightColor = (int) butPtr->highlightColorPtr->pixel;
        }
	TkWinFillRect(dc, 0, 0, Tk_Width(tkwin), defaultWidth,
		highlightColor);
	TkWinFillRect(dc, 0, 0, defaultWidth, Tk_Height(tkwin),
		highlightColor);
	TkWinFillRect(dc, 0, Tk_Height(tkwin) - defaultWidth,
		Tk_Width(tkwin), defaultWidth,
		highlightColor);

    case BN_CLICKED: {
	/*
	 * OOPS: chromium fires WM_NULL regularly to ping if plugin is still
	 * alive. When using an external window (i.e. via the tcl plugin), this
	 * causes all buttons to fire once a second, so we need to make sure
	 * that we are not dealing with the chromium life check.
	*/
        if (wParam != 0 || lParam != 0) {
	    int code;
	    Tcl_Interp *interp = butPtr->info.interp;

	    if (butPtr->info.state != STATE_DISABLED) {
		Tcl_Preserve(interp);
		code = TkInvokeButton((TkButton*)butPtr);
		if (code != TCL_OK && code != TCL_CONTINUE