Tk Source Code

# This file is a Tcl script to test entry widgets in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands

testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]

# For xscrollcommand
set scrollInfo {}
proc scroll args {
    global scrollInfo
    set scrollInfo $args
}
# For trace add variable

} -body {
    .e insert end "01234567890"
    .e delete 6
    .e get
} -cleanup {
    destroy .e
} -result 0123457890
test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -constraints failsOnXQuarz -setup {
test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup {
    entry .e
    pack .e ; update idletasks
    update
    set x {}
} -body {
# UTF
    .e insert end "01234乎67890"

    pack .e ; update idletasks
    update
} -body {
    .e index 0
} -cleanup {
    destroy .e
} -returnCodes {ok} -match glob -result {*}
test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} -constraints failsOnXQuarz -setup {
test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} -setup {
    entry .e
    pack .e ; update idletasks
    update
} -body {
# UTF
    .e insert 0 abc乎œdef
    list [.e index 3] [.e index 4] [.e index end]

# This file is a Tcl script to test spinbox widgets in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands

testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]

# For xscrollcommand
set scrollInfo {}
proc scroll args {
    global scrollInfo
    set scrollInfo $args
}
# For trace add variable

} -body {
    .e insert end "01234567890"
    .e delete 6
    .e get
} -cleanup {
    destroy .e
} -result 0123457890
test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} -constraints failsOnXQuarz -setup {
test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} -setup {
    spinbox .e
    pack .e
    update
    set x {}
} -body {
# UTF
    .e insert end "01234乎67890"

    pack .e
    update
} -body {
    .e index 0
} -cleanup {
    destroy .e
} -returnCodes {ok} -match glob -result {*}
test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} -constraints failsOnXQuarz -setup {
test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} -setup {
    spinbox .e
    pack .e
    update
} -body {
# UTF
    .e insert 0 abc乎œdef
    list [.e index 3] [.e index 4] [.e index end]

static void		ReleaseFont(UnixFont *fontPtr);
static void		ReleaseSubFont(Display *display, SubFont *subFontPtr);
static int		SeenName(const char *name, Tcl_DString *dsPtr);

/*
 *-------------------------------------------------------------------------
 *
 * XLoadQueryFontNoXError --
 *
 *	This function is XLoadQueryFont wrapped in a NULL error handler.
 *	It is a temporary workaround for ticket [36e379c01b],
 *	"macOS Ventura, X11 build with XQuartz: crash in XLoadQueryFont",
 *	which actually is issue #216 in XQuartz:
 *	https://github.com/XQuartz/XQuartz/issues/216
 *
 *-------------------------------------------------------------------------
 */

static XFontStruct *
XLoadQueryFontNoXError(Display *display, char *name)
{
    XFontStruct *fontStructPtr = NULL;
    Tk_ErrorHandler handler;

    /* 45 is the major opcode of X_OpenFont */
    handler = Tk_CreateErrorHandler(display, BadValue, 45, -1, NULL, NULL);
    fontStructPtr = XLoadQueryFont(display, name);
    Tk_DeleteErrorHandler(handler);
    return fontStructPtr;
}

/*
 *-------------------------------------------------------------------------
 *
 * FontPkgCleanup --
 *
 *	This function is called when an application is created. It initializes
 *	all the structures that are used by the platform-dependent code on a
 *	per application basis.
 *
 * Results:

	    hasWild = 1;
	}
    }
    if ((dashes < 14) && !hasWild && hasSpace) {
	return NULL;
    }

    fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), name);
    fontStructPtr = XLoadQueryFontNoXError(Tk_Display(tkwin), (char *)name);
    if (fontStructPtr == NULL) {
	/*
	 * Handle all names that look like XLFDs here. Otherwise, when
	 * TkpGetFontFromAttributes is called from generic code, any foundry
	 * or encoding information specified in the XLFD will have been parsed
	 * out and lost. But make sure we don't have an "-option value" string
	 * since TkFontParseXLFD would return a false success when attempting

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

void
TkpGetFontAttrsForChar(
    Tk_Window tkwin,		/* Window on the font's display */
    Tk_Font tkfont,		/* Font to query */
    int c,         		/* Character of interest */
    int c,			/* Character of interest */
    TkFontAttributes *faPtr)	/* Output: Font attributes */
{
    FontAttributes atts;
    UnixFont *fontPtr = (UnixFont *) tkfont;
				/* Structure describing the logical font */
    SubFont *lastSubFontPtr = &fontPtr->subFontArray[0];
				/* Pointer to subfont array in case

	for (i = XLFD_PIXEL_SIZE; i < XLFD_CHARSET; i++) {
	    rest = strchr(rest + 1, '-');
	}
	*str = '\0';
	snprintf(buf, sizeof(buf), "%.200s-%d-*-*-*-*-*%s", nameList[bestIdx[1]],
		(int)(-wantPtr->fa.size+0.5), rest);
	*str = '-';
	fontStructPtr = XLoadQueryFont(display, buf);
	fontStructPtr = XLoadQueryFontNoXError(display, buf);
	bestScore[1] = INT_MAX;
    }
    if (fontStructPtr == NULL) {
	fontStructPtr = XLoadQueryFont(display, nameList[bestIdx[0]]);
	fontStructPtr = XLoadQueryFontNoXError(display, nameList[bestIdx[0]]);
	if (fontStructPtr == NULL) {
	    /*
	     * This shouldn't happen because the font name is one of the names
	     * that X gave us to use, but it does anyhow.
	     */

	    if (bestScore[1] < INT_MAX) {

static XFontStruct *
GetSystemFont(
    Display *display)		/* Display for new XFontStruct. */
{
    XFontStruct *fontStructPtr;

    fontStructPtr = XLoadQueryFont(display, "fixed");
    fontStructPtr = XLoadQueryFontNoXError(display, "fixed");
    if (fontStructPtr == NULL) {
	fontStructPtr = XLoadQueryFont(display, "*");
	fontStructPtr = XLoadQueryFontNoXError(display, "*");
	if (fontStructPtr == NULL) {
	    Tcl_Panic("TkpGetFontFromAttributes: cannot get any font");
	}
    }
    return fontStructPtr;
}