Tk Source Code

# bgerror.tcl --
#
#	Implementation of the bgerror procedure.  It posts a dialog box with
#	the error message and gives the user a chance to see a more detailed
#	stack trace, and possible do something more interesting with that
#	trace (like save it to a log).  This is adapted from work done by
#	Donal K. Fellows.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 2007 by ActiveState Software Inc.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
# Copyright (c) 2009 Pat Thoyts <[email protected]>
# Copyright © 1998-2000 by Ajuba Solutions.
# Copyright © 2007 by ActiveState Software Inc.
# Copyright © 2007 Daniel A. Steffen <[email protected]>
# Copyright © 2009 Pat Thoyts <[email protected]>

namespace eval ::tk::dialog::error {
    namespace import -force ::tk::msgcat::*
    namespace export bgerror
    option add *ErrorDialog.function.text [mc "Save To Log"] \
	widgetDefault
    option add *ErrorDialog.function.command [namespace code SaveToLog]

# button.tcl --
#
# This file defines the default bindings for Tk label, button,
# checkbutton, and radiobutton widgets and provides procedures
# that help in implementing those bindings.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 2002 ActiveState Corporation.
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 2002 ActiveState Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# The code below creates the default class bindings for buttons.

# choosedir.tcl --
#
#	Choose directory dialog implementation for Unix/Mac.
#
# Copyright (c) 1998-2000 by Scriptics Corporation.
# Copyright © 1998-2000 by Scriptics Corporation.
# All rights reserved.

# Make sure the tk::dialog namespace, in which all dialogs should live, exists
namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::file {}

# Make the chooseDir namespace inside the dialog namespace

# clrpick.tcl --
#
#	Color selection dialog for platforms that do not support a
#	standard color selection dialog.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# ToDo:
#
#	(1): Find out how many free colors are left in the colormap and

# comdlg.tcl --
#
#	Some functions needed for the common dialog boxes. Probably need to go
#	in a different file.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# tclParseConfigSpec --
#

# console.tcl --
#
# This code constructs the console window for an application.  It
# can be used by non-unix systems that do not have built-in support
# for shells.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2007-2008 Daniel A. Steffen <[email protected]>
# Copyright © 1995-1997 Sun Microsystems, Inc.
# Copyright © 1998-2000 Ajuba Solutions.
# Copyright © 2007-2008 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# TODO: history - remember partially written command

# Create bindings for tags.

foreach tag {d1 d2 d3 d4 d5 d6} {
    $w.text tag bind $tag <Enter> "$w.text tag configure $tag $bold"
    $w.text tag bind $tag <Leave> "$w.text tag configure $tag $normal"
}
# Main widget program sets variable tk_demoDirectory
$w.text tag bind d1 <Button-1> {source [file join $tk_demoDirectory items.tcl]}
$w.text tag bind d2 <Button-1> {source [file join $tk_demoDirectory plot.tcl]}
$w.text tag bind d3 <Button-1> {source [file join $tk_demoDirectory ctext.tcl]}
$w.text tag bind d4 <Button-1> {source [file join $tk_demoDirectory arrow.tcl]}
$w.text tag bind d5 <Button-1> {source [file join $tk_demoDirectory ruler.tcl]}
$w.text tag bind d6 <Button-1> {source [file join $tk_demoDirectory cscroll.tcl]}
$w.text tag bind d1 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory items.tcl]}
$w.text tag bind d2 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory plot.tcl]}
$w.text tag bind d3 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory ctext.tcl]}
$w.text tag bind d4 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory arrow.tcl]}
$w.text tag bind d5 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory ruler.tcl]}
$w.text tag bind d6 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory cscroll.tcl]}

$w.text mark set insert 0.0
$w.text configure -state disabled

    bind $w.c <Destroy> {
	after cancel $animationCallbacks(goldberg)
	unset animationCallbacks(goldberg)
    }
    DoCtrlFrame $w
    DoDetailFrame $w
    if {[tk windowingsystem] ne "aqua"} {
	ttk::button $w.show -text "\u00bb" -command [list ShowCtrl $w] -width 2
	ttk::button $w.show -text "»" -command [list ShowCtrl $w] -width 2
    } else {
	button $w.show -text "\u00bb" -command [list ShowCtrl $w] -width 2 -highlightbackground $C(bg)
	button $w.show -text "»" -command [list ShowCtrl $w] -width 2 -highlightbackground $C(bg)
    }
    place $w.show -in $w.c -relx 1 -rely 0 -anchor ne
    update
}

proc DoCtrlFrame {w} {
    global S

    grid columnconfigure $w2 1 -weight 1
}

# Map or unmap the ctrl window
proc ShowCtrl {w} {
    if {[winfo ismapped $w.ctrl]} {
	pack forget $w.ctrl
	$w.show config -text "\u00bb"
	$w.show config -text "»"
    } else {
	pack $w.ctrl -side right -fill both -ipady 5
	$w.show config -text "\u00ab"
	$w.show config -text "»"
    }
}

proc DrawAll {w} {
    ResetStep
    $w.c delete all
    for {set i 0} {1} {incr i} {

# Copyright (C) 2008 Pat Thoyts <[email protected]>
# Copyright © 2008 Pat Thoyts <[email protected]>
#
#	Calculate a Knight's tour of a chessboard.
#
#	This uses Warnsdorff's rule to calculate the next square each
#	time. This specifies that the next square should be the one that
#	has the least number of available moves.
#

                            [expr {$col * 30 + 30}] [expr {$row * 30 + 30}]]
            $c create rectangle $coords -fill $fill -disabledfill $dfill \
                -width 2 -state disabled -outline black
        }
    }
    if {[tk windowingsystem] ne "x11"} {
        catch {eval font create KnightFont -size -24}
        $c create text 0 0 -font KnightFont -text "\u265e" \
        $c create text 0 0 -font KnightFont -text "♞" \
            -anchor nw -tags knight -fill black -activefill "#600000"
    } else {
        # On X11 we cannot reliably tell if the \u265e glyph is available
        # On X11 we cannot reliably tell if the ♞ glyph is available
        # so just use a polygon
        set pts {
            2 25   24 25  21 19   20 8   14 0   10 0   0 13   0 16
            2 17    4 14   5 15    3 17   5 17   9 14  10 15  5 21
        }
        $c create polygon $pts -tag knight -offset 8 \
            -fill black -activefill "#600000"

$w.k create line 160 200 160 0 -fill grey75 -arrow last -tags y_axis
$w.k create line 0 100 320 100 -fill grey75 -arrow last -tags x_axis
for {set i 90} {$i>=0} {incr i -10} {
    # Coordinates of these items don't matter; they will be set properly below
    $w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i
}

$w.k create text 0 0 -anchor ne -text "\u03b8" -tags label_theta
$w.k create text 0 0 -anchor ne -text "\u03b4\u03b8" -tags label_dtheta
$w.k create text 0 0 -anchor ne -text "θ" -tags label_theta
$w.k create text 0 0 -anchor ne -text "δθ" -tags label_dtheta
pack $w.k -in $w.p.l2 -fill both -expand true

# Initialize some variables
set points {}
set Theta   45.0
set dTheta   0.0
set pi       3.1415926535897933

toplevel $w
wm title $w "Toolbar Demonstration"
wm iconname $w "toolbar"
positionWindow $w

ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\
	a toolbar that is styled correctly and which can be torn off. The\
	buttons are configured to be \u201Ctoolbar style\u201D buttons by\
	buttons are configured to be “toolbar style” buttons by\
	telling them that they are to use the Toolbutton style. At the left\
	end of the toolbar is a simple marker that the cursor changes to a\
	movement icon over; drag that away from the toolbar to tear off the\
	whole toolbar into a separate toplevel widget. When the dragged-off\
	toolbar is no longer needed, just close it like any normal toplevel\
	and it will reattach to the window it was torn off from."

set w .ttkbut
catch {destroy $w}
toplevel $w
wm title $w "Simple Ttk Widgets"
wm iconname $w "ttkbut"
positionWindow $w

ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the \u201cEnabled\u201d button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons."
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the “Enabled” button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons."
pack $w.msg -side top -fill x

## See Code / Dismiss
pack [addSeeDismiss $w.seeDismiss $w {enabled cheese tomato basil oregano happiness}]\
	-side bottom -fill x

## Add buttons for setting the theme

set w .ttkprogress
catch {destroy $w}
toplevel $w
wm title $w "Progress Bar Demonstration"
wm iconname $w "ttkprogress"
positionWindow $w

ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a \u201Cdeterminate\u201D progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an \u201Cindeterminate\u201D progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath."
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a “determinate” progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an “indeterminate” progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath."
pack $w.msg -side top -fill x

## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x

ttk::frame $w.f

positionWindow $w

label $w.msg -font $font -wraplength 4i -anchor w -justify left \
	-text "This is a sample of Tk's support for languages that use\
	non-Western character sets.  However, what you will actually see\
	below depends largely on what character sets you have installed,\
	and what you see for characters that are not present varies greatly\
	between platforms as well.  The strings are written in Tcl using\
	between platforms as well."
	UNICODE characters using the \\uXXXX (or \\UXXXXXX) escape so as to\
	do so in a portable fashion."
pack $w.msg -side top

## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x

## The frame that will contain the sample texts.

set oldCursor [$w cget -cursor]
$w conf -cursor watch
update

## Add the samples...
if {[usePresentationFormsFor Arabic]} {
    # Using presentation forms (pre-layouted)
    addSample $w Arabic \
    addSample $w Arabic "ﺔﻴﺑﺮﻌﻟﺍ ﺔﻤﻠﻜﻟﺍ"
	    "\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \
	    "\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D"
} else {
    # Using standard text characters
    addSample $w Arabic \
    addSample $w Arabic "الكلمة العربية"
	    "\u0627\u0644\u0643\u0644\u0645\u0629 " \
	    "\u0627\u0644\u0639\u0631\u0628\u064A\u0629"
}
addSample $w "Trad. Chinese"  "\u4E2D\u570B\u7684\u6F22\u5B57"
addSample $w "Simpl. Chinese" "\u6C49\u8BED"
addSample $w French "Langue fran\xE7aise"
addSample $w Greek \
addSample $w "Trad. Chinese"  "中國的漢字"
addSample $w "Simpl. Chinese" "汉语"
addSample $w French "Langue française"
addSample $w Greek "Ελληνική γλώσσα"
	"\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AE " \
	"\u03B3\u03BB\u03CE\u03C3\u03C3\u03B1"
if {[usePresentationFormsFor Hebrew]} {
    # Visual order (pre-layouted)
    addSample $w Hebrew \
    addSample $w Hebrew "תירבע בתכ"
	    "\u05EA\u05D9\u05E8\u05D1\u05E2 \u05D1\u05EA\u05DB"
} else {
    # Standard logical order
    addSample $w Hebrew \
    addSample $w Hebrew "כתב עברית"
	    "\u05DB\u05EA\u05D1 \u05E2\u05D1\u05E8\u05D9\u05EA"
}
addSample $w Hindi \
addSample $w Hindi "हिन्दी भाषा"
    "\u0939\u093F\u0928\u094D\u0926\u0940 \u092D\u093E\u0937\u093E"
addSample $w Icelandic "\xCDslenska"
addSample $w Japanese \
addSample $w Icelandic "Íslenska"
addSample $w Japanese "日本語のひらがな, 漢字とカタカナ"
	"\u65E5\u672C\u8A9E\u306E\u3072\u3089\u304C\u306A, " \
	"\u6F22\u5B57\u3068\u30AB\u30BF\u30AB\u30CA"
addSample $w Korean "\uB300\uD55C\uBBFC\uAD6D\uC758 \uD55C\uAE00"
addSample $w Russian \
addSample $w Korean "대한민국의 한글"
addSample $w Russian "Русский язык"
	"\u0420\u0443\u0441\u0441\u043A\u0438\u0439 \u044F\u0437\u044B\u043A"
if {([tk windowingsystem] ne "x11") || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))} {
    if {[package vsatisfies [package provide Tcl] 8.7-]} {
	addSample $w Emoji \
    addSample $w Emoji "😀💩👍🇳🇱"
		"\U1F600\U1F4A9\U1F44D\U1F1F3\U1F1F1"
    } else {
	addSample $w Emoji \
		"\uD83D\uDE00\uD83D\uDCA9\uD83D\uDC4D\uD83C\uDDF3\uD83C\uDDF1"
    }
}

## We're done processing, so change things back to normal running...
destroy $w.wait
$w conf -cursor $oldCursor

# tkAboutDialog --
#
#	Pops up a message box with an "about" message
#
proc tkAboutDialog {} {
    tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \
	    -message [mc "Tk widget demonstration application"] -detail \
"[mc "Copyright \xA9 %s" {1996-1997 Sun Microsystems, Inc.}]
[mc "Copyright \xA9 %s" {1997-2000 Ajuba Solutions, Inc.}]
[mc "Copyright \xA9 %s" {2001-2009 Donal K. Fellows}]
[mc "Copyright \xA9 %s" {2002-2007 Daniel A. Steffen}]"
"[mc "Copyright © %s" {1996-1997 Sun Microsystems, Inc.}]
[mc "Copyright © %s" {1997-2000 Ajuba Solutions, Inc.}]
[mc "Copyright © %s" {2001-2009 Donal K. Fellows}]
[mc "Copyright © %s" {2002-2007 Daniel A. Steffen}]"
}

# Local Variables:
# mode: tcl
# End:

# dialog.tcl --
#
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright © 1992-1993 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#
# ::tk_dialog:

# entry.tcl --
#
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# Elements of tk::Priv that are used in this file:

# focus.tcl --
#
# This file defines several procedures for managing the input
# focus.
#
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright © 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# ::tk_focusNext --
# This procedure returns the name of the next window after "w" in

# iconlist.tcl
#
#	Implements the icon-list megawidget used in the "Tk" standard file
#	selection dialog boxes.
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
# Copyright (c) 2009 Donal K. Fellows
# Copyright © 1994-1998 Sun Microsystems, Inc.
# Copyright © 2009 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# API Summary:
#	tk::IconList <path> ?<option> <value>? ...
#	<path> add <imageName> <itemList>

# icons.tcl --
#
#	A set of stock icons for use in Tk dialogs. The icons used here
#	were provided by the Tango Desktop project which provides a
#	unified set of high quality icons licensed under the
#	Creative Commons Attribution Share-Alike license
#	(http://creativecommons.org/licenses/by-sa/3.0/)
#
#	See http://tango.freedesktop.org/Tango_Desktop_Project
#
# Copyright (c) 2009 Pat Thoyts <[email protected]>
# Copyright © 2009 Pat Thoyts <[email protected]>

namespace eval ::tk::icons {}

image create photo ::tk::icons::warning -data {
    iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABSZJREFU
    WIXll1toVEcYgL+Zc87u2Yu7MYmrWRuTJuvdiMuqiJd4yYKXgMQKVkSjFR80kFIVJfWCWlvpg4h9
    8sXGWGof8iKNICYSo6JgkCBEJRG8ImYThNrNxmaTeM7pQ5IlJkabi0/9YZhhZv7///4z/8zPgf+7

# listbox.tcl --
#
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1995 Sun Microsystems, Inc.
# Copyright © 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#--------------------------------------------------------------------------
# tk::Priv elements used in this file:
#

# megawidget.tcl
#
#	Basic megawidget support classes. Experimental for any use other than
#	the ::tk::IconList megawdget, which is itself only designed for use in
#	the Unix file dialogs.
#
# Copyright (c) 2009-2010 Donal K. Fellows
# Copyright © 2009-2010 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package require Tk


# menu.tcl --
#
# This file defines the default bindings for Tk menus and menubuttons.
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# Copyright © 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# Elements of tk::Priv that are used in this file:

# msgbox.tcl --
#
#	Implements messageboxes for platforms that do not have native
#	messagebox support.
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# Ensure existence of ::tk::dialog namespace
#

# obsolete.tcl --
#
# This file contains obsolete procedures that people really shouldn't
# be using anymore, but which are kept around for backward compatibility.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# The procedures below are here strictly for backward compatibility with
# Tk version 3.6 and earlier.  The procedures are no longer needed, so

# optMenu.tcl --
#
# This file defines the procedure tk_optionMenu, which creates
# an option button and its associated menu.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# ::tk_optionMenu --
# This procedure creates an option button named $w and an associated

# palette.tcl --
#
# This file contains procedures that change the color palette used
# by Tk.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright © 1995-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# ::tk_setPalette --
# Changes the default color scheme for a Tk application by setting

# safetk.tcl --
#
# Support procs to use Tk in safe interpreters.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright © 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# see safetk.n for documentation

#

# scale.tcl --
#
# This file defines the default bindings for Tk scale widgets and provides
# procedures that help in implementing the bindings.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.

# scrlbar.tcl --
#
# This file defines the default bindings for Tk scrollbar widgets.
# It also provides procedures that help in implementing the bindings.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# The code below creates the default class bindings for scrollbars.

# spinbox.tcl --
#
# This file defines the default bindings for Tk spinbox widgets and provides
# procedures that help in implementing those bindings.  The spinbox builds
# off the entry widget, so it can reuse Entry bindings and procedures.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1999-2000 Jeffrey Hobbs
# Copyright (c) 2000 Ajuba Solutions
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1999-2000 Jeffrey Hobbs
# Copyright © 2000 Ajuba Solutions
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# Elements of tk::Priv that are used in this file:

# tearoff.tcl --
#
# This file contains procedures that implement tear-off menus.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# ::tk::TearoffMenu --
# Given the name of a menu, this procedure creates a torn-off menu

# text.tcl --
#
# This file defines the default bindings for Tk text widgets and provides
# procedures that help in implementing the bindings.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998 by Scriptics Corporation.
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# Elements of ::tk::Priv that are used in this file:

# tk.tcl --
#
# Initialization script normally executed in the interpreter for each Tk-based
# application.  Arranges class bindings for widgets.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Verify that we have Tk binary and script components from the same release
package require -exact Tk  8.7a4


# tkfbox.tcl --
#
#	Implements the "TK" standard file selection dialog box.  This dialog
#	box is used on the Unix platforms whenever the tk_strictMotif flag is
#	not set.
#
#	The "TK" standard file selection dialog box is similar to the file
#	selection dialog box on Win95(TM).  The user can navigate the
#	directories by clicking on the folder icons or by selecting the
#	"Directory" option menu.  The user can select files by clicking on the
#	file icons or by entering a filename in the "Filename:" entry.
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
# Copyright © 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::file {

#
# DERIVED FROM: tk/library/entry.tcl r1.22
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 2004, Joe English
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 2004, Joe English
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

namespace eval ttk {
    namespace eval entry {

# xmfbox.tcl --
#
#	Implements the "Motif" style file selection dialog for the
#	Unix platform. This implementation is used only if the
#	"::tk_strictMotif" flag is set.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Scriptics Corporation
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-2000 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::file {}

# This file is a Tcl script to test out Tk's "bell" command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1998-2000 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1998-2000 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test the bgerror command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out Tk's "bind" and "bindtags"
# commands plus the procedures in tkBind.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the procedures in the file
# tkBitmap.c.  It is organized in the standard white-box fashion for
# Tcl tests.
#
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the procedures in the file
# tkBorder.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# Tests for the tk busy command.
#
# This file contains a collection of tests for one or more of the Tk built-in
# commands. Sourcing this file runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1998-2000 by Jos Decoster. All rights reserved.
# Copyright © 1998-2000 by Jos Decoster. All rights reserved.

package require tcltest 2.2
tcltest::configure {*}$argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# There's currently no way to test the actual grab effect, per se, in an

# This file is a Tcl script to test labels, buttons, checkbuttons, and
# radiobuttons in Tk (i.e., all the widgets defined in tkButton.c).  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the procedures in tkCanvImg.c,
# which implement canvas "image" items.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the canvas "moveto" command. It is
# derived from canvRect.test.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2004 Neil McKay.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# Copyright © 2004 Neil McKay.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands

canvas .c -width 400 -height 300 -bd 2 -relief sunken

# This file is a Tcl script to test out procedures to write postscript
# for canvases to files and channels. It exercises the procedure
# TkCanvPostscriptCmd in generic/tkCanvPs.c
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the procedures in tkRectOval.c,
# which implement canvas "rectangle" and "oval" items.  It is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the procedures in tkCanvText.c,
# which implement canvas "text" items.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the procedures in tkCanvWind.c,
# which implement canvas "window" items.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the procedures in tkCanvas.c, which
# implements generic code for canvases. It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2008 Donal K. Fellows
# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-2000 Ajuba Solutions.
# Copyright © 2008 Donal K. Fellows
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
imageInit

# This file is a Tcl script to test out Tk's "tk_chooseDir" and
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out Tk's clipboard management code,
# especially the "clipboard" command.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# Note: Multiple display clipboard handling will only be tested if the
# environment variable TK_ALT_DISPLAY is set to an alternate display.
#

# This file is a Tcl script to test out Tk's "tk_chooseColor" command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test the procedures in the file
# tkCmds.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test out the procedures in the file
# tkColor.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995-1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1995-1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands

# cname --

# This file is a Tcl script to test the procedures in tkConfig.c,
# which comprise the new new option configuration system.  It is
# organized in the standard "white-box" fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the procedures in the file
# tkCursor.c.  It is organized in the standard white-box fashion for
# Tcl tests.
#
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out embedded Windows.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

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

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

	fonts
} -setup {
    entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2
    pack .e
    update
} -body {
# Tcl_UtfAtIndex(): utf at end
    .e insert 0 "ab\u4e4e"
    .e insert 0 "ab乎"
    .e bbox end
} -cleanup {
    destroy .e
} -result {19 5 12 13}
test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} -constraints {
	fonts
} -setup {
    entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2
    pack .e
    update
} -body {
# Tcl_UtfAtIndex(): utf before index
    .e insert 0 "ab\u4e4ec"
    .e insert 0 "ab乎c"
    .e bbox 3
} -cleanup {
    destroy .e
} -result {31 5 7 13}
test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} -setup {
    entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2
    pack .e

test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} -constraints {
	fonts
} -setup {
    entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2
    pack .e
    update
} -body {
    .e insert 0 "abcdefghij\u4e4eklmnop"
    .e insert 0 "abcdefghij乎klmnop"
    list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end]
} -cleanup {
    destroy .e
} -result {{5 5 7 13} {12 5 7 13} {75 5 12 13} {122 5 7 13}}
test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} -setup {
    entry .e
} -body {

test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup {
    entry .e
    pack .e
    update
    set x {}
} -body {
# UTF
    .e insert end "01234\u4e4e67890"
    .e insert end "01234乎67890"
    .e delete 6
    lappend x [.e get]
    .e delete 0 end
    .e insert end "012345\u4e4e7890"
    .e insert end "012345乎7890"
    .e delete 6
    lappend x [.e get]
    .e delete 0 end
    .e insert end "0123456\u4e4e890"
    .e insert end "0123456乎890"
    .e delete 6
    lappend x [.e get]
} -cleanup {
    destroy .e
} -result [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"]
} -result [list "01234乎7890" "0123457890" "012345乎890"]
test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} -setup {
    entry .e
    pack .e
    update
} -body {
    .e insert end "01234567890"
    .e delete 6 5

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

} -result 73
test entry-3.86 {EntryWidgetCmd procedure, "xview" widget command} -setup {
    entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2
    pack .e
} -body {
    .e insert end "This is quite a long text string, so long that it "
    .e insert end "runs off the end of the window quite a bit."
    .e insert 10 \u4e4e
    .e insert 10 乎
    update
# UTF
# If Tcl_NumUtfChars wasn't used, wrong answer would be:
# 0.106383 0.117021 0.117021
    set x {}
    .e xview moveto .1
    lappend x [format {%.6f} [lindex [.e xview] 0]]

# This file is a Tcl script to test the code in tkEvent.c.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test out Tk's "tk_getOpenFile" and
# "tk_getSaveFile" commands. It is organized in the standard fashion
# for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands

test fileDialog-0.1 {GetFileName: file types: MakeFilter() fails} {

# This file is a Tcl script to test out the "focus" command and the
# other procedures in the file tkFocus.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test out the features of the script
# file focus.tcl, which includes the procedures tk_focusNext and
# tk_focusPrev, among other things.  This file is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test out Tk's "font" command
# plus the procedures in tkFont.c.  It is organized in the
# standard white-box fashion for Tcl tests.
#
# Copyright (c) 1996-1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996-1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

    # (objc > 3) so objPtr = objv[3 + skip]
    font actual {-family times} -family
} -result {times}
test font-4.11 {font command: bad option} -body {
    font actual xyz -style
} -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}
test font-4.12 {font command: actual} -body {
    font actual {-family times} -- \ud800
    font actual {-family times} -- \uD800
} -match glob -result {*}
test font-4.13 {font command: actual} -body {
    font actual {-family times} -- \udc00
    font actual {-family times} -- \uDC00
} -match glob -result {*}
test font-4.14 {font command: actual} -constraints {utfcompat win} -body {
    font actual {-family times} -family -- \uD800\uDC00
} -result {times}
test font-4.15 {font command: actual} -body {
    font actual {-family times} -- \udc00\ud800
    font actual {-family times} -- \uDC00\uD800
} -returnCodes 1 -match glob -result {expected a single character but got "*"}
test font-4.16 {font command: actual} -constraints {fullutf win} -body {
    font actual {-family times} -family -- \U10000
} -result {times}


test font-5.1 {font command: configure} -body {

# Test the "tk::fontchooser" command
#
# Copyright (c) 2008 Pat Thoyts
# Copyright © 2008 Pat Thoyts

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands

testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}]

    }
    set x
} -result {Hello}

test fontchooser-2.1 {fontchooser -title (cyrillic)} -constraints scriptImpl -body {
    start {
        tk::fontchooser::Configure \
            -title "\u041f\u0440\u0438\u0432\u0435\u0442"
            -title "Привет"
        tk::fontchooser::Show
    }
    then {
        set x [wm title $::tk_dialog]
        Click cancel
    }
    set x
} -result "\u041f\u0440\u0438\u0432\u0435\u0442"
} -result "Привет"

test fontchooser-3.0 {fontchooser -parent} -constraints scriptImpl -body {
    start {
        tk::fontchooser::Configure -parent .
        tk::fontchooser::Show
    }
    then {

# This file is a Tcl script to test out the "frame", "labelframe" and
# "toplevel" commands of Tk.  It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test the procedures in the file
# tkGeometry.c (generic support for geometry managers).  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

proc getsize w {
    regexp {(^[^+-]*)} [wm geometry $w] foo x
    return $x
}

# This file is a Tcl script to test out the procedures in the file
# tkGet.c.  It is organized in the standard fashion for Tcl
# white-box tests.
#
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1998 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# Tests for the grab command.
#
# This file contains a collection of tests for one or more of the Tk
# built-in commands.  Sourcing this file runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright © 1998-2000 by Ajuba Solutions.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test out the *NEW* "grid" command of Tk. It is
# (almost) organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test out the "image" command and the
# other procedures in the file tkImage.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out images of type "bitmap" (i.e.,
# the procedures in the file tkImgBmap.c).  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the default image data format
# ("list format") implementend in the file tkImgListFormat.c.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 2017 Simon Bachmann
# Copyright © 2017 Simon Bachmann
# All rights reserved.
#
# Author: Simon Bachmann ([email protected])

package require tcltest 2.2
namespace import ::tcltest::*
tcltest::configure {*}$argv

# This file is a Tcl script to test out the code in tkImgFmtPNG.c, which reads
# and write PNG-format image files for photo widgets. The files is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998 Willem van Schaik (images only)
# Copyright (c) 2008 Donal K. Fellows
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# Copyright © 1998 Willem van Schaik (images only)
# Copyright © 2008 Donal K. Fellows
# All rights reserved.

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

# This file is a Tcl script to test out the code in tkImgFmtPPM.c,
# which reads and write PPM-format image files for photo widgets.
# The files is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the "photo" image type and the other
# procedures in the file tkImgPhoto.c. It is organized in the standard fashion
# for Tcl tests.
#
# Copyright (c) 1994 The Australian National University
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2002-2008 Donal K. Fellows
# Copyright © 1994 The Australian National University
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# Copyright © 2002-2008 Donal K. Fellows
# All rights reserved.
#
# Author: Paul Mackerras ([email protected])

#
# This file is somewhat caothic: the order of the tests does not
# really follow the order of the corresponding functions in

# This file is a Tcl script to test out the code in tkImgSVGnano.c, which reads
# and write SVG-format image files for photo widgets. The files is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 2018 Rene Zaumseil
# Copyright © 2018 Rene Zaumseil
# All rights reserved.

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

# This file is a Tcl script to test out the "listbox" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1993-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1993-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file contains tests for the tkMain.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright © 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

test main-2.1 {Tk_MainEx: -encoding option} -constraints stdio -setup {
	set script [makeFile {} script]
	file delete $script
	set f [open $script w]
	fconfigure $f -encoding utf-8
	puts $f {puts [list $argv0 $argv $tcl_interactive]}
	puts -nonewline $f {puts [string equal \u20ac }
	puts $f {puts [string equal \u20AC €]; exit}
	puts $f "\u20ac]; exit"
	close $f
	catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]}
} -body {
	read $f
} -cleanup {
	close $f
	removeFile script
} -result "script {} 0\n1\n"

test main-2.2 {Tk_MainEx: -encoding option} -constraints stdio -setup {
	set script [makeFile {} script]
	file delete $script
	set f [open $script w]
	fconfigure $f -encoding utf-8
	puts $f {puts [list $argv0 $argv $tcl_interactive]}
	puts -nonewline $f {puts [string equal \u20ac }
	puts $f {puts [string equal \u20AC €]; exit}
	puts $f "\u20ac]; exit"
	close $f
	catch {set f [open "|[list [interpreter] -encoding ascii script]" r]}
} -body {
	read $f
} -cleanup {
	close $f
	removeFile script

test main-2.3 {Tk_MainEx: -encoding option} -constraints stdio -setup {
	set script [makeFile {} script]
	file delete $script
	set f [open $script w]
	fconfigure $f -encoding utf-8
	puts $f {puts [list $argv0 $argv $tcl_interactive]}
	puts -nonewline $f {puts [string equal \u20ac }
	puts $f {puts [string equal \u20AC €]}
	puts $f "\u20ac]"
	close $f
	catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]}
} -body {
	type $f {
		puts $argv
		exit
	}

# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1995-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test drawing of menus in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test
imageInit

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

# XXX This test file is woefully incomplete right now.  If any part
# XXX of a procedure has tests then the whole procedure has tests,
# XXX but many procedures have no tests.

package require tcltest 2.2

# This file is a Tcl script to test out the "message" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-2000 by Ajuba Solutions.
# All rights reserved.

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

# This file is a Tcl script to test out Tk's "tk_messageBox" command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test new object types in Tk.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out the old syntax of Tk's
# "pack" command (before release 3.3).  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1991-1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test out the option-handling facilities
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

} -result burgundy
test option-15.10 {database files} -body {
    set option2 [file join [testsDirectory] option.file2]
    option read $option2
} -returnCodes error -result {missing colon on line 2}
set option3 [file join [testsDirectory] option.file3]
option read $option3
test option-15.11 {database files} {option get . {x 4} color} br\xf3wn
test option-15.11 {database files} {option get . {x 4} color} brówn

test option-16.1 {ReadOptionFile} -body {
    set option4 [makeFile {} option.file3]
    set file [open $option4 w]
    fconfigure $file -translation crlf
    puts $file "*x7: true\n*x8: false"
    close $file

# This file is a Tcl script to test out the "pack" command of Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1993 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test out interaction between Tk's "pack" and
# "grid" commands.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 2008 Peter Spjuth
# Copyright © 2008 Peter Spjuth
# All rights reserved.

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

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

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# -*- tcl -*-
# Commands covered:  pkgconfig
#
# This file contains a collection of tests for one or more of the Tk
# built-in commands.  Sourcing this file into Tk runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2017 Stuart Cassoff <[email protected]>
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# Copyright © 2017 Stuart Cassoff <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

# This file is a Tcl script to test out the "place" command.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out Tk's "raise" and
# "lower" commands, plus associated code to manage window
# stacking order.  It is organized in the standard fashion
# for Tcl tests.
#
# Copyright (c) 1993-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1993-1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test the Safe Tk facility. It is organized in
# the standard fashion for Tk tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

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

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

# This file is a Tcl script to test out the "scale" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

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

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands

testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

# This file is a Tcl script to test out Tk's selection management code,
# especially the "selection" command. It is organized in the standard fashion
# for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# Note: Multiple display selection handling will only be tested if the
# environment variable TK_ALT_DISPLAY is set to an alternate display.
#

# This file is a Tcl script to test out the "send" command and the
# other procedures in the file tkSend.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by ActiveState Corporation.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# Copyright © 2001 by ActiveState Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands

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

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

	fonts
} -setup {
    spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2
    pack .e
    update
} -body {
# Tcl_UtfAtIndex(): utf at end
    .e insert 0 "ab\u4e4e"
    .e insert 0 "ab乎"
    .e bbox end
} -cleanup {
    destroy .e
} -result {19 5 12 13}
test spinbox-3.8 {SpinboxWidgetCmd procedure, "bbox" widget command} -constraints {
	fonts
} -setup {
    spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2
    pack .e
    update
} -body {
# Tcl_UtfAtIndex(): utf before index
    .e insert 0 "ab\u4e4ec"
    .e insert 0 "ab乎c"
    .e bbox 3
} -cleanup {
    destroy .e
} -result {31 5 7 13}
test spinbox-3.9 {SpinboxWidgetCmd procedure, "bbox" widget command} -setup {
    spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2
    pack .e

test spinbox-3.10 {SpinboxWidgetCmd procedure, "bbox" widget command} -constraints {
	fonts
} -setup {
    spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2
    pack .e
    update
} -body {
    .e insert 0 "abcdefghij\u4e4eklmnop"
    .e insert 0 "abcdefghij乎klmnop"
    list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end]
} -cleanup {
    destroy .e
} -result {{5 5 7 13} {12 5 7 13} {75 5 12 13} {122 5 7 13}}
test spinbox-3.11 {SpinboxWidgetCmd procedure, "cget" widget command} -setup {
    spinbox .e
} -body {

test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} -setup {
    spinbox .e
    pack .e
    update
    set x {}
} -body {
# UTF
    .e insert end "01234\u4e4e67890"
    .e insert end "01234乎67890"
    .e delete 6
    lappend x [.e get]
    .e delete 0 end
    .e insert end "012345\u4e4e7890"
    .e insert end "012345乎7890"
    .e delete 6
    lappend x [.e get]
    .e delete 0 end
    .e insert end "0123456\u4e4e890"
    .e insert end "0123456乎890"
    .e delete 6
    lappend x [.e get]
} -cleanup {
    destroy .e
} -result [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"]
} -result [list "01234乎7890" "0123457890" "012345乎890"]
test spinbox-3.25 {SpinboxWidgetCmd procedure, "delete" widget command} -setup {
    spinbox .e
    pack .e
    update
} -body {
    .e insert end "01234567890"
    .e delete 6 5

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

} -result 73
test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} -setup {
    spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2
    pack .e
} -body {
    .e insert end "This is quite a long text string, so long that it "
    .e insert end "runs off the end of the window quite a bit."
    .e insert 10 \u4e4e
    .e insert 10 乎
    update
# UTF
# If Tcl_NumUtfChars wasn't used, wrong answer would be:
# 0.106383 0.117021 0.117021
    set x {}
    .e xview moveto .1
    lappend x [format {%.6f} [lindex [.e xview] 0]]

# This file is a Tcl script to test the code in the file tkText.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

    set p $p$p$p$p$p
    .t search -nocase $p 1.0
} -cleanup {
    destroy .t
} -result {}
test text-22.69 {TextSearchCmd, unicode} -body {
    text .t
    .t insert end "foo\u30c9\u30cabar"
    .t search \u30c9\u30ca 1.0
    .t insert end "fooドナbar"
    .t search ドナ 1.0
} -cleanup {
    destroy .t
} -result {1.3}
test text-22.70 {TextSearchCmd, unicode} -body {
    text .t
    .t insert end "foo\u30c9\u30cabar"
    list [.t search -count n \u30c9\u30ca 1.0] $n
    .t insert end "fooドナbar"
    list [.t search -count n ドナ 1.0] $n
} -cleanup {
    destroy .t
} -result {1.3 2}
test text-22.71 {TextSearchCmd, unicode with non-text segments} -body {
    text .t
    button .b1 -text baz
    .t insert end "foo\u30c9"
    .t insert end "fooド"
    .t window create end -window .b1
    .t insert end "\u30cabar"
    list [.t search -count n \u30c9\u30ca 1.0] $n
    .t insert end "ナbar"
    list [.t search -count n ドナ 1.0] $n
} -cleanup {
    destroy .t .b1
} -result {1.3 3}
test text-22.72 {TextSearchCmd, hidden text does not affect match index} -body {
    pack [text .t]
    .t insert end "12345H7890"
    .t search 7 1.0

} -result {{} {} 1.0 2.1 2.0 3.1 2.0 3.0}
test text-22.217.1 {elide up to match, with UTF-8 chars before the match} -setup {
    pack [text .t]
    set res {}
} -body {
    .t tag configure e -elide 0
    .t insert end A {} xyz e bb\n
    .t insert end \xC4 {} xyz e bb
    .t insert end Ä {} xyz e bb
    set res {}
    lappend res [.t search bb 1.0 "1.0 lineend"]
    lappend res [.t search bb 2.0 "2.0 lineend"]
    lappend res [.t search -regexp bb 1.0 "1.0 lineend"]
    lappend res [.t search -regexp bb 2.0 "2.0 lineend"]
    .t tag configure e -elide 1
    lappend res [.t search bb 1.0 "1.0 lineend"]

    return $x
} -cleanup {
    destroy .t
    rename Append {}
} -result {mark 1.0 current mark 1.0 insert mark 2.4 m}
test text-24.25 {TextDumpCmd procedure, unicode characters} -body {
    text .t
    .t insert 1.0 \xb1\xb1\xb1
    .t insert 1.0 ±±±
    .t dump -all 1.0 2.0
} -cleanup {
    destroy .t
} -result "text \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3"
} -result "text ±±± 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3"
test text-24.26 {TextDumpCmd procedure, unicode characters} -body {
    text .t
    .t delete 1.0 end
    .t insert 1.0 abc\xb1\xb1\xb1
    .t insert 1.0 abc±±±
    .t dump -all 1.0 2.0
} -cleanup {
    destroy .t
} -result "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6"
} -result "text abc±±± 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6"
test text-24.27 {TextDumpCmd procedure, peer present} -body {
    text .t
    .t peer create .t.t
    .t dump -all 1.0 end
} -cleanup {
    destroy .t
} -result "mark insert 1.0 mark current 1.0 text {\n} 1.0"

# This file is a Tcl script to test out the B-tree facilities of
# Tk's text widget (the contents of the file "tkTextBTree.c".  There are
# several file with additional tests for other features of text widgets.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test the code in the file tkTextDisp.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# textImage.test -- test images embedded in text widgets
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test the code in the file tkTextIndex.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

wm positionfrom . user
wm deiconify .

.t insert 1.0 "Line 1
abcdefghijklm
12345
Line 4
b\u4e4fy GIrl .#@? x_yz
b乏y GIrl .#@? x_yz
!@#$%
Line 7"

image create photo textimage -width 10 -height 10
textimage put red -to 0 0 9 9

test textIndex-1.1 {TkTextMakeByteIndex} {testtext} {

} {3.4 4}
test textIndex-1.16 {TkTextMakeByteIndex: UTF-8 characters} {testtext} {
    testtext .t byteindex 5 100
} {5.18 20}
test textIndex-1.17 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \
	{testtext} {
    # ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType))
    # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f).
    # Wrong answer would be ¹ (the 2nd byte of UTF rep of 0x4e4f).

    set x [testtext .t byteindex 5 2]
    list $x [.t get insert]
} {{5.2 4} y}
test textIndex-1.18 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \
	{testtext} {
    # ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType))
    testtext .t byteindex 5 1
    .t get insert
} "\u4e4f"
} "乏"

test textIndex-2.1 {TkTextMakeCharIndex} {
    # (lineIndex < 0)
    .t index -1.3
} 1.0
test textIndex-2.2 {TkTextMakeCharIndex} {
    # (lineIndex < 0), because lineIndex == strtol(argv[2]) - 1

} 3.5
test textIndex-2.11 {TkTextMakeCharIndex: verify index is in range} {
    # not (segPtr == NULL)
    .t index 3.4
} 3.4
test textIndex-2.12 {TkTextMakeCharIndex: verify index is in range} {
    # (segPtr->typePtr == &tkTextCharType)
    # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f).
    # Wrong answer would be ¹ (the 2nd byte of UTF rep of 0x4e4f).

    .t mark set insert 5.2
    .t get insert
} y
test textIndex-2.13 {TkTextMakeCharIndex: verify index is in range} {
    # not (segPtr->typePtr == &tkTextCharType)

    .t index {2.5 - 6 chars}
} 1.6
test textIndex-14.15 {TkTextIndexBackChars: UTF} {
    .t get {5.3 - 1 chars}
} y
test textIndex-14.16 {TkTextIndexBackChars: UTF} {
    .t get {5.3 - 2 chars}
} \u4e4f
} 乏
test textIndex-14.17 {TkTextIndexBackChars: UTF} {
    .t get {5.3 - 3 chars}
} b

proc getword index {
    .t get [.t index "$index wordstart"] [.t index "$index wordend"]
}

test textIndex-21.8 {text index wordend} {
    text_test_word worde "x.y" 0
} 1
test textIndex-21.9 {text index wordend} {
    text_test_word worde "x.y" end-1
} 2
test textIndex-21.10 {text index wordend, unicode} {
    text_test_word wordend "xyz\xC7de fg" 0
    text_test_word wordend "xyzÇde fg" 0
} 6
test textIndex-21.11 {text index wordend, unicode} {
    text_test_word wordend "xyz\uc700de fg" 0
    text_test_word wordend "xyz윀de fg" 0
} 6
test textIndex-21.12 {text index wordend, unicode} {
    text_test_word wordend "xyz\u203fde fg" 0
    text_test_word wordend "xyz‿de fg" 0
} 6
test textIndex-21.13 {text index wordend, unicode} {
    text_test_word wordend "xyz\u2045de fg" 0
    text_test_word wordend "xyz⁅de fg" 0
} 3
test textIndex-21.14 {text index wordend, unicode} {
    text_test_word wordend "\uc700\uc700 abc" 8
    text_test_word wordend "윀윀 abc" 8
} 6

test textIndex-22.5 {text index wordstart} {
    text_test_word wordstart "one two three_words" 400
} 8
test textIndex-22.6 {text index wordstart} {
    text_test_word wordstart "one two three_words" 2

test textIndex-22.9 {text index wordstart} {
    text_test_word wordstart "one two three" 4
} 4
test textIndex-22.10 {text index wordstart} {
    text_test_word wordstart "one two three" end-5
} 7
test textIndex-22.11 {text index wordstart, unicode} {
    text_test_word wordstart "one tw\xC7o three" 7
    text_test_word wordstart "one twÇo three" 7
} 4
test textIndex-22.12 {text index wordstart, unicode} {
    text_test_word wordstart "ab\uc700\uc700 cdef ghi" 12
    text_test_word wordstart "ab윀윀 cdef ghi" 12
} 10
test textIndex-22.13 {text index wordstart, unicode} {
    text_test_word wordstart "\uc700\uc700 abc" 8
    text_test_word wordstart "윀윀 abc" 8
} 3
test textIndex-22.14 {text index wordstart, unicode, start index at internal segment start} {
    catch {destroy .t}
    text .t
    .t insert end "C'est du texte en fran\xE7ais\n"
    .t insert end "\u042D\u0442\u043E \u0442\u0435\u043A\u0441\u0442 \u043D\u0430 \u0440\u0443\u0441\u0441\u043A\u043E\u043C"
    .t insert end "C'est du texte en français\n"
    .t insert end "Это текст на русском"
    .t mark set insert 1.23
    set res [.t index "1.23 wordstart"]
    .t mark set insert 2.16
    lappend res [.t index "2.16 wordstart"] [.t index "2.15 wordstart"]
} {1.18 2.13 2.13}
test textIndex-22.15 {text index display wordstart} {
    catch {destroy .t}

# This file is a Tcl script to test the code in the file tkTextMark.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test the code in the file tkTextTag.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test the code in the file tkTextWind.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test the tk command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2002 ActiveState Corporation.
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# Copyright © 2002 ActiveState Corporation.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

testConstraint testprintf [llength [info command testprintf]]

# Bounding box / scrolling tests.
test entry-3.0 "Series 3 setup" -body {
    ttk::style theme use default
    variable fixed TkFixedFont
    variable cw [font measure $fixed a]
    variable ch [font metrics $fixed -linespace]
    variable bd 2	;# border + padding
    variable ux [font measure $fixed \u4e4e]
    variable ux [font measure $fixed 乎]

    pack [ttk::entry .e -font $fixed -width 20]
    update
}

test entry-3.1 "bbox widget command" -body {
    .e delete 0 end

# This file is a Tcl script to test the Unix specific behavior of
# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
# widgets defined in tkUnixButton.c).  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test
imageInit

# This file is a Tcl script to test out the procedures in the file
# tkUnixEmbed.c.  It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test out the procedures in tkUnixFont.c.
# It is organized in the standard fashion for Tcl tests.
#
# Many of these tests are visually oriented and cannot be checked
# programmatically (such as "does an underlined font appear to be
# underlined?"); these tests attempt to exercise the code in question,
# but there are no results that can be checked.  Some tests depend on the
# fonts having or not having certain properties, which may not be valid
# at all sites.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands

testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

    array set fontArray [font actual a12biluc]
    set result [lsort [array names fontArray]]
    catch {unset fontArray}
    set result
} {-family -overstrike -size -slant -underline -weight}
test unixfont-8.4 {AllocFont procedure: classify characters} {x11 failsOnUbuntu failsOnXQuarz} {
    set x 0
    incr x [font measure $courier "\u4000"]   ;# 6
    incr x [font measure $courier "䀀"]   ;# 6
    incr x [font measure $courier "\002"]   ;# 4
    incr x [font measure $courier "\012"]   ;# 2
    incr x [font measure $courier "\101"]   ;# 1
    set x
} [expr $cx*13]
test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} x11 {
    font metrics $courier -fixed

# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests. This
# file tests the Macintosh-specific features of the menu
# system.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file contains tests for the tkUnixSelect.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1999 by Scriptics Corporation.
# Copyright © 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2.2
namespace import ::tcltest::*
tcltest::configure {*}$argv

    x11
} -setup {
    destroy .e
    setupbg
} -body {
    pack [entry .e]
    update
    .e insert 0 \xFCber
    .e insert 0 über
    .e selection range 0 end
    dobg {string length [selection get]}
} -cleanup {
    cleanupbg
    destroy .e
} -result 4

test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [entry .e]
        update
        .e insert 0 \xFC\u0444
        .e insert 0 üф
        .e selection range 0 end
    }
    selection get
} -cleanup {
    cleanupbg
} -result \xFC?
} -result ü?

test unixSelect-1.3 {TkSelGetSelection procedure: simple i18n text, iso2022} -constraints {
    x11
} -setup {
    setupbg
    setup
} -body {
    selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
        {handler COMPOUND_TEXT}
    selection own .
    set selValue \xFC\u0444
    set selValue üф
    set selInfo {}
    set result [dobg {
        set x [selection get -type COMPOUND_TEXT]
        list [string equal \xFC\u0444 $x] [string length $x]
        list [string equal üф $x] [string length $x]
    }]
    lappend result $selInfo
} -cleanup {
    cleanupbg
} -result {1 2 {COMPOUND_TEXT 0 4000}}

test unixSelect-1.4 {TkSelGetSelection procedure: INCR i18n text, iso2022} -constraints {
    x11
} -setup {
    setupbg
    setup
} -body {
    # This test is subtle.  The selection ends up getting fetched twice by
    # Tk:  once to compute the length, and again to actually send the data.
    # The first time through, we don't convert the data to ISO2022, so the
    # buffer boundaries end up being different in the two passes.
    selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
        {handler COMPOUND_TEXT}
    selection own .
    set selValue [string repeat x 3999]\xFC\u0444[string repeat x 3999]
    set selValue [string repeat x 3999]üф[string repeat x 3999]
    set selInfo {}
    set result [dobg {
        set x [selection get -type COMPOUND_TEXT]
        list [string equal \
            [string repeat x 3999]\xFC\u0444[string repeat x 3999] $x] \
            [string repeat x 3999]üф[string repeat x 3999] $x] \
            [string length $x]
    }]
    lappend result $selInfo
} -cleanup {
    cleanupbg
} -result {1 8000 {COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3999 COMPOUND_TEXT 7998 4000 COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3998 COMPOUND_TEXT 7997 4000}}

test unixSelect-1.5 {TkSelGetSelection procedure: simple i18n text, iso2022} -constraints {
    x11
} -setup {
    setupbg
    setup
} -body {
    selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
        {handler COMPOUND_TEXT}
    selection own .
    set selValue \xFC\u0444
    set selValue üф
    set selInfo {}
    set result [dobg {
        set x [selection get -type COMPOUND_TEXT]
        list [string equal \xFC\u0444 $x] [string length $x]
        list [string equal üф $x] [string length $x]
    }]
    lappend result $selInfo
} -cleanup {
    cleanupbg
} -result {1 2 {COMPOUND_TEXT 0 4000}}

test unixSelect-1.6 {TkSelGetSelection procedure: INCR i18n text} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg [subst -nobackslashes {entry .e; pack .e; update
    .e insert 0 \xFCber$longValue
    .e insert 0 über$longValue
    .e selection range 0 end}]
    string length [selection get]
} -cleanup {
    cleanupbg
} -result [expr {4 + [string length $longValue]}]

test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [entry .e]
        update
        .e insert 0 [string repeat x 3999]\xFC
        .e insert 0 [string repeat x 3999]ü
        .e selection range 0 end
    }
    selection get
} -cleanup {
    cleanupbg
} -result [string repeat x 3999]\xFC
} -result [string repeat x 3999]ü

test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [entry .e]
        update
        .e insert 0 \xFC[string repeat x 3999]
        .e insert 0 ü[string repeat x 3999]
        .e selection range 0 end
    }
    selection get
} -cleanup {
    cleanupbg
} -result \xFC[string repeat x 3999]
} -result ü[string repeat x 3999]

test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [entry .e]
        update
        .e insert 0 [string repeat x 3999]\xFC[string repeat x 4000]
        .e insert 0 [string repeat x 3999]ü[string repeat x 4000]
        .e selection range 0 end
    }
    selection get
} -cleanup {
    cleanupbg
} -result [string repeat x 3999]\xFC[string repeat x 4000]
} -result [string repeat x 3999]ü[string repeat x 4000]
# Now some tests to make sure that the right thing is done when
# transferring UTF8 selections, to prevent [Bug 614650] and its ilk
# from rearing its ugly head again.

test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [entry .e]
        update
        .e insert 0 [string repeat x 3999]\xFC
        .e insert 0 [string repeat x 3999]ü
        .e selection range 0 end
    }
    selection get -type UTF8_STRING
} -cleanup {
    cleanupbg
} -result [string repeat x 3999]\xFC
} -result [string repeat x 3999]ü

test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [entry .e]
        update
        .e insert 0 \xFC[string repeat x 3999]
        .e insert 0 ü[string repeat x 3999]
        .e selection range 0 end
    }
    selection get -type UTF8_STRING
} -cleanup {
    cleanupbg
} -result \xFC[string repeat x 3999]
} -result ü[string repeat x 3999]

test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [entry .e]
        update
        .e insert 0 [string repeat x 3999]\xFC[string repeat x 4000]
        .e insert 0 [string repeat x 3999]ü[string repeat x 4000]
        .e selection range 0 end
    }
    selection get -type UTF8_STRING
} -cleanup {
    cleanupbg
} -result [string repeat x 3999]\xFC[string repeat x 4000]
} -result [string repeat x 3999]ü[string repeat x 4000]

test unixSelect-1.13 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints {
    x11
} -setup {
    destroy .e
    setupbg
} -body {
    pack [entry .e]
    update
    .e insert 0 \xFCber\u0444
    .e insert 0 überф
    .e selection range 0 end
    dobg {string length [selection get -type UTF8_STRING]}
} -cleanup {
    destroy .e
    cleanupbg
} -result 5

test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [entry .e]
        update
        .e insert 0 \xFC\u0444
        .e insert 0 üф
        .e selection range 0 end
    }
    selection get -type UTF8_STRING
} -cleanup {
    cleanupbg
} -result \xFC\u0444
} -result üф

test unixSelect-1.15 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [entry .e]
        update
        .e insert 0 [string repeat [string repeat \xC4\xE4 50]\n 21]
        .e insert 0 [string repeat [string repeat Ää 50]\n 21]
        .e selection range 0 end
    }
    selection get -type UTF8_STRING
} -cleanup {
    cleanupbg
} -result [string repeat [string repeat \xC4\xE4 50]\n 21]
} -result [string repeat [string repeat Ää 50]\n 21]

test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [entry .e]
        update
        .e insert 0 i[string repeat [string repeat \xC4\xE4 50]\n 21]
        .e insert 0 i[string repeat [string repeat Ää 50]\n 21]
        .e selection range 0 end
    }
    selection get -type UTF8_STRING
} -cleanup {
    cleanupbg
} -result i[string repeat [string repeat \xC4\xE4 50]\n 21]
} -result i[string repeat [string repeat Ää 50]\n 21]

test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [text .t]
        update
        .t insert 1.0 [string repeat [string repeat \xC4\xE4 50]\n 21]
        .t insert 1.0 [string repeat [string repeat Ää 50]\n 21]
        # Has to be selected in a separate stage
        .t tag add sel 1.0 21.end+1c
    }
    after 10
    selection get -type UTF8_STRING
} -cleanup {
    cleanupbg
} -result [string repeat [string repeat \xC4\xE4 50]\n 21]
} -result [string repeat [string repeat Ää 50]\n 21]

test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
    x11
} -setup {
    setupbg
} -body {
    dobg {
        pack [text .t]
        update
        .t insert 1.0 i[string repeat [string repeat \xC4\xE4 50]\n 21]
        .t insert 1.0 i[string repeat [string repeat Ää 50]\n 21]
        # Has to be selected in a separate stage
        .t tag add sel 1.0 21.end+1c
    }
    after 10
    selection get -type UTF8_STRING
} -cleanup {
    cleanupbg
} -result i[string repeat [string repeat \xC4\xE4 50]\n 21]
} -result i[string repeat [string repeat Ää 50]\n 21]

test unixSelect-1.19 {Automatic UTF8_STRING support for selection handle} -constraints {
    unix
} -setup {
    destroy .l
} -body {
    # See Bug #666346 "Selection handling crashes under KDE 3.0"

# This file is a Tcl script to test out Tk's interactions with
# the window manager, including the "wm" command.  It is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands

namespace import -force ::tk::test:loadTkCommand

# This file is a Tcl script to test out the procedures in the file
# tkUtil.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# This file is a Tcl script to test the visual- and colormap-handling
# procedures in the file tkVisual.c.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test the Windows specific behavior of
# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
# widgets defined in tkWinButton.c).  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
namespace import ::tcltest::*
tcltest::configure {*}$argv
tcltest::loadTestedCommands
imageInit

# This file is a Tcl script to test out Tk's Windows specific
# clipboard code.  It is organized in the standard fashion for Tcl
# tests.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
# Copyright © 1997 by Sun Microsystems, Inc.
# Copyright © 1998-2000 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} -constraints {
    win testclipboard
} -setup {
    clipboard clear
} -body {
    set map [list "\r" "\\r" "\n" "\\n"]
    clipboard append "line 1\xC7\nline 2"
    clipboard append "line 1Ç\nline 2"
    list [string map $map [selection get -selection CLIPBOARD]]\
        [string map $map [testclipboard]]
} -cleanup {
    clipboard clear
} -result [list "line 1\xC7\\nline 2" "line 1\xC7\\nline 2"]
} -result [list "line 1Ç\\nline 2" "line 1Ç\\nline 2"]

test winClipboard-1.6 {TkSelGetSelection & TkWinClipboardRender} -constraints {
    win testclipboard
} -setup {
    clipboard clear
} -body {
    clipboard append "\u043f\u0440\u0438\u0432\u0435\u0442 \u043c\u0438\u0444"
    clipboard append "привет миф"
    list [selection get -selection CLIPBOARD] [testclipboard]
} -cleanup {
    clipboard clear
} -result [list "\u043f\u0440\u0438\u0432\u0435\u0442 \u043c\u0438\u0444"\
} -result [list "привет миф" "привет миф"]
              "\u043f\u0440\u0438\u0432\u0435\u0442 \u043c\u0438\u0444"]

test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} -constraints {
    win testclipboard
} -setup {
    clipboard clear
} -body {
    clipboard append -type OUR_ACTION "action data"

# -*- tcl -*-
# This file is a Tcl script to test the Windows specific behavior of
# the common dialog boxes.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 ActiveState Corporation.
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# Copyright © 1998-1999 ActiveState Corporation.

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

if {[testConstraint testwinevent]} {

    testwinevent
} -setup {
    catch {unset a x}
} -body {
    set x {}
    start {
        set clr [tk_chooseColor -initialcolor "#ff9933" \
                     -title "\u041f\u0440\u0438\u0432\u0435\u0442"]
                     -title "Привет"]
    }
    then {
        if {[catch {
            array set a [testgetwindowinfo $::tk_dialog]
            if {[info exists a(text)]} {lappend x $a(text)}
        } err]} { lappend x $err }
        lappend x [Click ok]
    }
    lappend x $clr
} -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"]
} -result [list "Привет" 0 "#ff9933"]
test winDialog-1.6 {Tk_ChooseColorObjCmd: -parent} -constraints {
    testwinevent
} -setup {
    catch {unset a x}
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933" -parent .]}
    set x {}

    }
    string equal $x [file join $newdir testfile]
} -result 1

test winDialog-5.12.4 {tk_getSaveFile: initial directory: unicode} -constraints {
    nt testwinevent
} -body {
    set dir [tcltest::makeDirectory "\u0167\xE9\u015d\u0167"]
    set dir [tcltest::makeDirectory "ŧéŝŧ"]
    unset -nocomplain x
    start {set x [tk_getSaveFile \
                      -initialdir $dir \
                      -initialfile "testfile" -title Foo]}
    then {
        Click ok
    }

    }
    string equal $x $path
} -result 1

test winDialog-5.12.9 {tk_getOpenFile: initial directory: unicode} -constraints {
    nt testwinevent
} -body {
    set dir [tcltest::makeDirectory "\u0167\xE9\u015d\u0167"]
    set dir [tcltest::makeDirectory "ŧéŝŧ"]
    set path [tcltest::makeFile "" testfile $dir]
    unset -nocomplain x
    start {set x [tk_getOpenFile \
                      -initialdir $dir \
                      -initialfile "testfile" -title Foo]}
    then {
        Click ok

    return $x
} -result 0
test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraints {
    nt
} -body {
    # MacOS type that is correct, but has embedded high-bit chars.

    start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]}
    start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {••••}}}}]}
    then {
        Click cancel
    }
    return $x
} -result 0

test winDialog-10.9 {Tk_FontchooserObjCmd: -title} -constraints {
    nt testwinevent
} -setup {
    array set a {text failed}
} -body {
    start {
        tk fontchooser configure -command ApplyFont \
            -title  "\u041f\u0440\u0438\u0432\u0435\u0442"
            -title  "Привет"
        tk fontchooser show
    }
    then {
        array set a [testgetwindowinfo $::tk_dialog]
        Click cancel
    }
    set a(text)
} -result "\u041f\u0440\u0438\u0432\u0435\u0442"
} -result "Привет"

if {[testConstraint testwinevent]} {
    catch {testwinevent debug 0}
}

# cleanup
cleanupTests
return

# Local variables:
# mode: tcl
# End:

# This file is a Tcl script to test out the procedures in tkWinFont.c.
# It is organized in the standard fashion for Tcl tests.
#
# Many of these tests are visually oriented and cannot be checked
# programmatically (such as "does an underlined font appear to be
# underlined?"); these tests attempt to exercise the code in question,
# but there are no results that can be checked.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests. This
# file tests the Macintosh-specific features of the menu
# system.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1995-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test the Windows specific message box
#
# Copyright (c) 2007 Pat Thoyts <[email protected]>
# Copyright © 2007 Pat Thoyts <[email protected]>

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

testConstraint getwindowinfo [expr {[llength [info command ::testgetwindowinfo]] > 0}]

    win getwindowinfo
} -setup {
    wm iconify .
    unset -nocomplain info
} -body {
    global windowInfo
    set title "winMsgbox-2.2 [pid]"
    set message "\u041f\u043e\u0438\u0441\u043a \u0441\u0442\u0440\u0430\u043d\u0438\u0446"
    set message "Поиск страниц"
    after 100 [list GetWindowInfo $title 2]
    set r [tk_messageBox -type ok -title $title -message $message]
    array set info $windowInfo
    lappend r $info(childtext)
} -cleanup {
    wm deiconify .
} -result [list ok "\u041f\u043e\u0438\u0441\u043a \u0441\u0442\u0440\u0430\u043d\u0438\u0446"]
} -result [list ok "Поиск страниц"]

test winMsgbox-2.4 {tk_messageBox message (empty)} -constraints {
    win getwindowinfo
} -setup {
    wm iconify .
    unset -nocomplain info
} -body {

    win getwindowinfo
} -setup {
    wm iconify .
    unset -nocomplain info
} -body {
    global windowInfo
    set title "winMsgbox-3.1 [pid]"
    set message "\u041f\u043e\u0438\u0441\u043a"
    set detail "\u0441\u0442\u0440\u0430\u043d\u0438\u0446"
    set message "Поиск"
    set detail "страниц"
    after 100 [list GetWindowInfo $title 2]
    set r [tk_messageBox -type ok -title $title -message $message -detail $detail]
    array set info $windowInfo
    lappend r $info(childtext)
} -cleanup {
    wm deiconify .
} -result [list ok "\u041f\u043e\u0438\u0441\u043a\n\n\u0441\u0442\u0440\u0430\u043d\u0438\u0446"]
} -result [list ok "Поиск\n\nстраниц"]

# -------------------------------------------------------------------------

if {[testConstraint testwinevent]} {
    catch {testwinevent debug 0}
}
cleanupTests
return

# Local variables:
# mode: tcl
# indent-tabs-mode: nil
# End:

# This file is a Tcl script to test out the "send" command and the
# other procedures in the file tkSend.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 Sun Microsystems, Inc.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands

# Compute a script that will load Tk into a child interpreter.

# This file tests  is a Tcl script to test the procedures in the file
# tkWinWm.c.  It is organized in the standard fashion for Tcl tests.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1996 by Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test the procedures in the file
# tkWindow.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1995 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

package require tcltest 2.2
namespace import ::tcltest::*
tcltest::configure {*}$argv
tcltest::loadTestedCommands
namespace import ::tk::test::loadTkCommand

# This file is a Tcl script to test out the "winfo" command.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

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

# This file is a Tcl script to test out Tk's interactions with the window
# manager, including the "wm" command. It is organized in the standard fashion
# for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1992-1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.

# This file tests window manager interactions that work across platforms.
# Window manager tests that only work on a specific platform should be placed
# in unixWm.test or winWm.test.

package require tcltest 2.2

# xmfbox.test --
#
#	This file is a Tcl script to test the file dialog that's used
#	when the tk_strictMotif flag is set. Because the file dialog
#	runs in a modal loop, the only way to test it sufficiently is
#	to call the internal Tcl procedures in xmfbox.tcl directly.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
# All rights reserved.

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