#!wish -f
#
# This script demonstrates the various widgets provided by Tk,
# along with many of the features of the Tk toolkit.

#-------------------------------------------------------
# The procedures below provide behavior for widgets like
# entries and menus and menubuttons.  Eventually all of this
# behavior should be built into the widgets, so that this
# code becomes unnecessary.
#-------------------------------------------------------

proc bind.entry args {
    foreach w $args {
	bind $w <Any-KeyPress> {%W insert cursor %A}
	bind $w <2> {puts stdout "character [%W index @%x]"}
	bind $w <Delete> {bs %W}
	bind $w <BackSpace> {bs %W}
	bind $w <Control-h> {bs %W}
	bind $w <1> {%W cursor @%x; focus %W; %W select from @%x}
	bind $w <B1-Motion> {%W select to @%x}
	bind $w <Shift-1> {%W select adjust @%x}
	bind $w <Shift-B1-Motion> {%W select to @%x}
	bind $w <3> {%W scan mark %x}
	bind $w <B3-Motion> {%W scan dragto %x}
	bind $w <Control-d> {%W delete sel.first sel.last}
	bind $w <Control-v> {%W insert cursor [selection get]}
	bind $w <Control-u> {%W delete 0 end}
    }
}

proc bind.menu args {
    foreach w $args {
	bind $w <Any-Enter> "$w activate @%y"
	bind $w <Any-Leave> "$w activate none"
	bind $w <Any-Motion> "$w activate @%y"
	bind $w <ButtonRelease-1> "$w invoke active"
    }
}

proc bind.menubutton args {
    foreach w $args {
	bind $w <Enter> "$w activate"
	bind $w <B1-Enter> "$w activate; $w config -relief sunken; $w post"
	bind $w <B1-Leave> "$w deactivate; $w config -relief flat"
	bind $w <Shift-B1-Leave> "$w deactivate; $w config -relief flat"
	bind $w <Leave> "$w deactivate"
	bind $w <1> "$w config -relief sunken; $w post"
	bind $w <Shift-1> "$w.m post %X %Y"
	bind $w <ButtonRelease-1> "$w config -relief flat; $w unpost"
	bind $w <Shift-B1-Motion> "$w.m post %X %Y"
    }
}

proc bs win {
    set x [expr {[$win index cursor] - 1}]
    if {$x != -1} {$win delete $x}
}

#-------------------------------------------------------
# The code below create the main window, consisting of a
# menu bar and a message explaining the basic operation
# of the program.
#-------------------------------------------------------

frame .menu -relief raised -borderwidth 1
message .msg -font *times-medium-r-normal--*-180* -relief raised -aspect 250 \
-borderwidth 1 -text "This application demonstrates the widgets provided by the Tk toolkit.  The menus above are organized by widget type:  each menu contains one or more demonstrations of a particular type of widget.  To invoke a demonstration, press mouse button 1 over one of the menu buttons above, drag the mouse to the desired entry in the menu, then release the mouse button.

To exit this demonstration, invoke the \"Quit\" entry in the \"Quit\" menu."

pack append . .menu {top fillx} .msg {bottom expand fill}

#-------------------------------------------------------
# The code below creates all the menus, which invoke procedures
# to create particular demonstrations of various widgets.
#-------------------------------------------------------

menubutton .menu.button -text "Labels/Buttons" -menu .menu.button.m
menu .menu.button.m
.menu.button.m add command -label "Labels" -command "d.label"
.menu.button.m add command -label "Buttons" -command "d.button"
.menu.button.m add command -label "Checkbuttons" -command "d.check"
.menu.button.m add command -label "Radiobuttons" -command "d.radio"
.menu.button.m add command -label "15-puzzle" -command "d.puzzle"

menubutton .menu.listbox -text "Listboxes" -menu .menu.listbox.m
menu .menu.listbox.m
.menu.listbox.m add command -label "50 states" -command "d.listbox"
.menu.listbox.m add command -label "Many colors" -command "d.listbox2"

menubutton .menu.entry -text "Entries" -menu .menu.entry.m
menu .menu.entry.m
.menu.entry.m add command -label "Without scrollbars" -command "d.entry"
.menu.entry.m add command -label "With scrollbars" -command "d.entry2"

menubutton .menu.scroll -text "Scrollbars" -menu .menu.scroll.m
menu .menu.scroll.m
.menu.scroll.m add command -label "Vertical" -command "d.listbox2"
.menu.scroll.m add command -label "Horizontal" -command "d.entry2"

menubutton .menu.scale -text "Scales" -menu .menu.scale.m
menu .menu.scale.m
.menu.scale.m add command -label "Vertical" -command "d.scale"
.menu.scale.m add command -label "Horizontal" -command "d.scale2"

menubutton .menu.menu -text "Menus" -menu .menu.menu.m
menu .menu.menu.m
.menu.menu.m add command -label "Print hello" -command {puts stdout "Hello"} \
    -accelerator Control-a
bind .msg <Control-a> {puts stdout "Hello"}
.menu.menu.m add command -label "Print goodbye" -command {\
    puts stdout "Goodbye"} -accelerator Control-b
bind .msg <Control-b> {puts stdout "Goodbye"}
.menu.menu.m add command -label "Light blue background" \
    -command {.msg config -bg "LightBlue1"}
.menu.menu.m add command -label "Info on tear-off menus" -command d.tear
.menu.menu.m add cascade -label "Check buttons =>" -menu .menu.menu.m.check
.menu.menu.m add cascade -label "Radio buttons =>" -menu .menu.menu.m.radio

menu .menu.menu.m.check
.menu.menu.m.check add check -label "Oil checked" -variable oil
.menu.menu.m.check add check -label "Transmission checked" -variable trans
.menu.menu.m.check add check -label "Brakes checked" -variable brakes
.menu.menu.m.check add check -label "Lights checked" -variable lights
.menu.menu.m.check add separator
.menu.menu.m.check add command -label "Show current values" \
    -command "showVars .menu.menu.dialog oil trans brakes lights"
.menu.menu.m.check invoke 1
.menu.menu.m.check invoke 3

menu .menu.menu.m.radio
.menu.menu.m.radio add radio -label "10 point" -variable pointSize -value 10
.menu.menu.m.radio add radio -label "14 point" -variable pointSize -value 14
.menu.menu.m.radio add radio -label "18 point" -variable pointSize -value 18
.menu.menu.m.radio add radio -label "24 point" -variable pointSize -value 24
.menu.menu.m.radio add radio -label "32 point" -variable pointSize -value 32
.menu.menu.m.radio add sep
.menu.menu.m.radio add radio -label "Roman" -variable style -value roman
.menu.menu.m.radio add radio -label "Bold" -variable style -value bold
.menu.menu.m.radio add radio -label "Italic" -variable style -value italic
.menu.menu.m.radio add sep
.menu.menu.m.radio add command -label "Show current values" -command \
    "showVars .menu.menu.dialog pointSize style"
.menu.menu.m.radio invoke 1
.menu.menu.m.radio invoke 7

menubutton .menu.quit -text Quit -menu .menu.quit.m
menu .menu.quit.m
.menu.quit.m add command -label "Quit" -command "destroy ."

pack append .menu .menu.button left .menu.listbox left \
    .menu.entry left .menu.scroll left .menu.scale left .menu.menu left \
    .menu.quit left
bind.menubutton .menu.button .menu.listbox .menu.entry .menu.scroll \
    .menu.scale .menu.menu .menu.quit
bind.menu .menu.button.m .menu.listbox.m .menu.entry.m .menu.scroll.m \
    .menu.scale.m .menu.menu.m .menu.menu.m.check .menu.menu.m.radio \
    .menu.quit.m

#-------------------------------------------------------
# The code below consists of a number of procedures, each
# of which creates a particular demonstration.  These
# procedures are invoked by the menu entries defined above.
#-------------------------------------------------------

proc d.label {{w .l1}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 300 \
	    -text "Three labels are displayed below.  Labels are pretty boring because you can't do anything with them.  Click the \"OK\" button when you've seen enough."
    frame $w.frame -borderwidth 10
    pack append $w.frame \
	[label $w.frame.l1 -text "First label"] {top frame w pady 4 expand} \
	[label $w.frame.l2 -text "Second label, raised just for fun" \
	    -relief raised] {top frame w pady 4 expand} \
	[label $w.frame.l3 -text "Third label, sunken" -relief sunken ] \
	    {top frame w pady 4 expand}
    button $w.ok -text OK -command "destroy $w"

    pack append $w $w.msg {top fill} $w.frame {top expand fill} \
	    $w.ok {bottom fill}
}

proc d.button {{w .b1}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 300 \
	    -text "Four buttons are displayed below.  If you click on a button, it will change the background of the button area to the color indicated in the button.  Click the \"OK\" button when you've seen enough."
    frame $w.frame -borderwidth 10
    pack append $w.frame \
	[button $w.frame.b1 -text "Peach Puff" \
	    -command "$w.frame config -bg PeachPuff1"] {top pady 4 expand} \
	[button $w.frame.b2 -text "Light Blue" \
	    -command "$w.frame config -bg LightBlue1"] {top pady 4 expand} \
	[button $w.frame.b3 -text "Sea Green" \
	    -command "$w.frame config -bg SeaGreen2"] {top pady 4 expand} \
	[button $w.frame.b4 -text "Yellow" \
	    -command "$w.frame config -bg Yellow1"] {top pady 4 expand}
    button $w.ok -text OK -command "destroy $w"

    pack append $w $w.msg {top fill} $w.frame {top expand fill} \
	$w.ok {bottom fill}
}

proc d.check {{w .c1}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 300 \
	    -text "Three checkbuttons are displayed below.  If you click on a button, it will toggle the button's selection state and set a Tcl variable to a value indicating the state of the checkbutton.  Click the \"See Variables\" button to see the current values of the variables.  Click the \"OK\" button when you've seen enough."
    frame $w.frame -borderwidth 10
    pack append $w.frame \
	[checkbutton $w.frame.b1 -text "Wipers OK" -variable wipers \
	    -relief flat] {top pady 4 expand frame w} \
	[checkbutton $w.frame.b2 -text "Brakes OK" -variable brakes \
	    -relief flat] {top pady 4 expand frame w} \
	[checkbutton $w.frame.b3 -text "Driver Sober" -variable sober \
	    -relief flat] {top pady 4 expand frame w}
    frame $w.frame2
    pack append $w.frame2 \
	[button $w.frame2.ok -text OK -command "destroy $w"] \
	    {left expand fill} \
	[button $w.frame2.vars -text "See Variables" \
	    -command "showVars $w.dialog wipers brakes sober"] \
	    {left expand fill}
    button $w.ok -text OK -command "destroy $w"

    pack append $w $w.msg {top fill} $w.frame {top expand fill} \
	    $w.frame2 {bottom fill}
}

proc d.radio {{w .r1}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 300 \
	    -text "Two groups of radiobuttons are displayed below.  If you click on a button then the button will becom selected exclusively among all the buttons in its group.  A Tcl variable is associated with each group to indicate which of the group's buttons is selected.  Click the \"See Variables\" button to see the current values of the variables.  Click the \"OK\" button when you've seen enough."
    frame $w.frame -borderwidth 10
    pack append $w.frame \
	[frame $w.frame.left] {left expand} \
	[frame $w.frame.right] {right expand}
    pack append $w.frame.left \
	[radiobutton $w.frame.left.b1 -text "Point Size 10" -variable size \
	    -relief flat -value 10] {top pady 4 frame w} \
	[radiobutton $w.frame.left.b2 -text "Point Size 12" -variable size \
	    -relief flat -value 12] {top pady 4 frame w} \
	[radiobutton $w.frame.left.b3 -text "Point Size 18" -variable size \
	    -relief flat -value 18] {top pady 4 frame w} \
	[radiobutton $w.frame.left.b4 -text "Point Size 24" -variable size \
	    -relief flat -value 24] {top pady 4 frame w}
    pack append $w.frame.right \
	[radiobutton $w.frame.right.b1 -text "Red" -variable color \
	    -relief flat -value red] {top pady 4 frame w} \
	[radiobutton $w.frame.right.b2 -text "Green" -variable color \
	    -relief flat -value green] {top pady 4 frame w} \
	[radiobutton $w.frame.right.b3 -text "Blue" -variable color \
	    -relief flat -value blue] {top pady 4 frame w} \
	[radiobutton $w.frame.right.b4 -text "Yellow" -variable color \
	    -relief flat -value yellow] {top pady 4 frame w} \
	[radiobutton $w.frame.right.b5 -text "Orange" -variable color \
	    -relief flat -value orange] {top pady 4 frame w} \
	[radiobutton $w.frame.right.b6 -text "Purple" -variable color \
	    -relief flat -value purple] {top pady 4 frame w}
    frame $w.frame2
    pack append $w.frame2 \
	[button $w.frame2.ok -text OK -command "destroy $w"] \
	    {left expand fill} \
	[button $w.frame2.vars -text "See Variables" \
	    -command "showVars $w.dialog size color"] \
	    {left expand fill}
    button $w.ok -text OK -command "destroy $w"

    pack append $w $w.msg {top fill} $w.frame {top expand fill} \
	    $w.frame2 {bottom fill}
}

proc d.puzzle {{w .p1}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 300 \
	    -text "A 15-puzzle appears below as a collection of buttons.  Click on any of the pieces next to the space, and that piece will slide over the space.  Continue this until the pieces are arranged in numerical order from upper-left to lower-right.  Click the \"OK\" button when you've finished playing."
    set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12}
    global puzzleSize
    set puzzleSize 30
    set tmp [expr 4*$puzzleSize+4]
    frame $w.frame -geometry ${tmp}x$tmp -borderwidth 2 -relief sunken \
	-bg Bisque3

    for {set i 0} {$i < 15} {set i [expr $i+1]} {
	set num [lindex $order $i]
	global pos.$num
	button $w.frame.$num -relief raised -text $num
	resize $w.frame.$num $puzzleSize $puzzleSize
	set pos.$num "[expr $puzzleSize*($i%4)+2] [expr $puzzleSize*($i/4)+2]"
	eval move $w.frame.$num [set pos.$num]
	bind $w.frame.$num <1> "puzzle.switch $w $num"
	map $w.frame.$num
    }
    global pos.space
    set pos.space "[expr 3*$puzzleSize+2] [expr 3*$puzzleSize+2]"

    button $w.ok -text OK -command "destroy $w"

    pack append $w $w.msg {top fill} $w.frame {top expand padx 10 pady 10} \
	    $w.ok {bottom fill}
}

proc d.listbox {{w .l1}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 300 \
	    -text "A listbox containing the 50 states is displayed below, along with a scrollbar.  You can scan the list either using the scrollbar or by dragging in the listbox window with button 3 pressed.  Click the \"OK\" button when you've seen enough."
    frame $w.frame -borderwidth 10
    pack append $w.frame \
	[scrollbar $w.frame.scroll -relief sunken \
	    -command "$w.frame.list view"] {right expand filly frame w} \
	[listbox $w.frame.list -scroll "$w.frame.scroll set" -relief sunken] \
	    {left expand filly frame e}
    $w.frame.list insert 0 Alabama Alaska Arizona Arkansas California \
	Colorado Connecticut Delaware Florida Georgia Hawaii Idaho Illinois \
	Indiana Iowa Kansas Kentucky Louisiana Maine Maryland \
        Massachusetts Michigan Minnesota Mississippi Missouri \
        Montana Nebraska Nevada "New Hampshire" "New Jersey" "New Mexico" \
	"New York" "North Carolina" "North Dakota" \
        Ohio Oklahoma Oregon Pennsylvania "Rhode Island" \
        "South Carolina" "South Dakota" \
        Tennessee Texas Utah Vermont Virginia Washington \
        "West Virginia" Wisconsin Wyoming
    button $w.ok -text OK -command "destroy $w"

    pack append $w $w.msg {top fill} $w.frame {top expand fill} \
	$w.ok {bottom fill}
}

proc d.listbox2 {{w .l2}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 300 \
	    -text "A listbox containing several color values is displayed below, along with a scrollbar.  You can scan the list either using the scrollbar or by dragging in the listbox window with button 3 pressed.  If you double-click button 1 on a color, then the background for the window will be changed to that color.  Click the \"OK\" button when you've seen enough."
    frame $w.frame -borderwidth 10
    pack append $w.frame \
	[scrollbar $w.frame.scroll -relief sunken \
	    -command "$w.frame.list view"] {right expand filly frame w} \
	[listbox $w.frame.list -scroll "$w.frame.scroll set" -relief sunken \
	    -geometry 20x20] {left expand filly frame e}
    $w.frame.list insert 0 snow1 snow2 snow3 snow4 seashell1 seashell2 \
	seashell3 seashell4 AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 \
	AntiqueWhite4 bisque1 bisque2 bisque3 bisque4 PeachPuff1 \
	PeachPuff2 PeachPuff3 PeachPuff4 NavajoWhite1 NavajoWhite2 \
	NavajoWhite3 NavajoWhite4 LemonChiffon1 LemonChiffon2 \
	LemonChiffon3 LemonChiffon4 cornsilk1 cornsilk2 cornsilk3 \
	cornsilk4 ivory1 ivory2 ivory3 ivory4 honeydew1 honeydew2 \
	honeydew3 honeydew4 LavenderBlush1 LavenderBlush2 \
	LavenderBlush3 LavenderBlush4 MistyRose1 MistyRose2 \
	MistyRose3 MistyRose4 azure1 azure2 azure3 azure4 \
	SlateBlue1 SlateBlue2 SlateBlue3 SlateBlue4 RoyalBlue1 \
	RoyalBlue2 RoyalBlue3 RoyalBlue4 blue1 blue2 blue3 blue4 \
	DodgerBlue1 DodgerBlue2 DodgerBlue3 DodgerBlue4 SteelBlue1 \
	SteelBlue2 SteelBlue3 SteelBlue4 DeepSkyBlue1 DeepSkyBlue2 \
	DeepSkyBlue3 DeepSkyBlue4 SkyBlue1 SkyBlue2 SkyBlue3 \
	SkyBlue4 LightSkyBlue1 LightSkyBlue2 LightSkyBlue3 \
	LightSkyBlue4 SlateGray1 SlateGray2 SlateGray3 SlateGray4 \
	LightSteelBlue1 LightSteelBlue2 LightSteelBlue3 \
	LightSteelBlue4 LightBlue1 LightBlue2 LightBlue3 \
	LightBlue4 LightCyan1 LightCyan2 LightCyan3 LightCyan4 \
	PaleTurquoise1 PaleTurquoise2 PaleTurquoise3 PaleTurquoise4 \
	CadetBlue1 CadetBlue2 CadetBlue3 CadetBlue4 turquoise1 \
	turquoise2 turquoise3 turquoise4 cyan1 cyan2 cyan3 cyan4 \
	DarkSlateGray1 DarkSlateGray2 DarkSlateGray3 \
	DarkSlateGray4 aquamarine1 aquamarine2 aquamarine3 \
	aquamarine4 DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 \
	DarkSeaGreen4 SeaGreen1 SeaGreen2 SeaGreen3 SeaGreen4 \
	PaleGreen1 PaleGreen2 PaleGreen3 PaleGreen4 SpringGreen1 \
	SpringGreen2 SpringGreen3 SpringGreen4 green1 green2 \
	green3 green4 chartreuse1 chartreuse2 chartreuse3 \
	chartreuse4 OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 \
	DarkOliveGreen1 DarkOliveGreen2 DarkOliveGreen3 \
	DarkOliveGreen4 khaki1 khaki2 khaki3 khaki4 \
	LightGoldenrod1 LightGoldenrod2 LightGoldenrod3 \
	LightGoldenrod4 LightYellow1 LightYellow2 LightYellow3 \
	LightYellow4 yellow1 yellow2 yellow3 yellow4 gold1 gold2 \
	gold3 gold4 goldenrod1 goldenrod2 goldenrod3 goldenrod4 \
	DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3 DarkGoldenrod4 \
	RosyBrown1 RosyBrown2 RosyBrown3 RosyBrown4 IndianRed1 \
	IndianRed2 IndianRed3 IndianRed4 sienna1 sienna2 sienna3 \
	sienna4 burlywood1 burlywood2 burlywood3 burlywood4 wheat1 \
	wheat2 wheat3 wheat4 tan1 tan2 tan3 tan4 chocolate1 \
	chocolate2 chocolate3 chocolate4 firebrick1 firebrick2 \
	firebrick3 firebrick4 brown1 brown2 brown3 brown4 salmon1 \
	salmon2 salmon3 salmon4 LightSalmon1 LightSalmon2 \
	LightSalmon3 LightSalmon4 orange1 orange2 orange3 orange4 \
	DarkOrange1 DarkOrange2 DarkOrange3 DarkOrange4 coral1 \
	coral2 coral3 coral4 tomato1 tomato2 tomato3 tomato4 \
	OrangeRed1 OrangeRed2 OrangeRed3 OrangeRed4 red1 red2 red3 \
	red4 DeepPink1 DeepPink2 DeepPink3 DeepPink4 HotPink1 \
	HotPink2 HotPink3 HotPink4 pink1 pink2 pink3 pink4 \
	LightPink1 LightPink2 LightPink3 LightPink4 PaleVioletRed1 \
	PaleVioletRed2 PaleVioletRed3 PaleVioletRed4 maroon1 \
	maroon2 maroon3 maroon4 VioletRed1 VioletRed2 VioletRed3 \
	VioletRed4 magenta1 magenta2 magenta3 magenta4 orchid1 \
	orchid2 orchid3 orchid4 plum1 plum2 plum3 plum4 \
	MediumOrchid1 MediumOrchid2 MediumOrchid3 MediumOrchid4 \
	DarkOrchid1 DarkOrchid2 DarkOrchid3 DarkOrchid4 purple1 \
	purple2 purple3 purple4 MediumPurple1 MediumPurple2 \
	MediumPurple3 MediumPurple4 thistle1 thistle2 thistle3 \
	thistle4
    bind $w.frame.list <Double-1> \
	"$w.frame config -bg \[lindex \[selection get\] 0\]
	$w.msg config -bg \[lindex \[selection get\] 0\]"
    button $w.ok -text OK -command "destroy $w"

    pack append $w $w.msg {top fill} $w.frame {top expand fill} \
	$w.ok {bottom fill}
}

proc d.entry {{w .e1}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 200 \
	    -text "Three different entries are displayed below.  You can add characters by pointing, clicking and typing.  You can delete by selecting and typing Control-d.  Backspace, Control-h, and Delete may be typed to erase the character just before the insertion point, and Control-u clears the entry.  For entries that are too large to fit in the window all at once, you can scan through the entries by dragging with mouse button 3 pressed.  Click the \"OK\" button when you've seen enough."
    frame $w.frame -borderwidth 10
    pack append $w.frame \
	[entry $w.frame.e1 -relief sunken] {top pady 10 fillx} \
	[entry $w.frame.e2 -relief sunken] {top pady 10 fillx} \
	[entry $w.frame.e3 -relief sunken] {top pady 10 fillx}
    bind.entry $w.frame.e1 $w.frame.e2 $w.frame.e3
    $w.frame.e1 insert 0 "Initial value"
    $w.frame.e2 insert end "This entry contains a long value, much too long "
    $w.frame.e2 insert end "to fit in the window at one time, so long in fact "
    $w.frame.e2 insert end "that you'll have to scan or scroll to see the end."
    button $w.ok -text OK -command "destroy $w; focus .msg"

    pack append $w $w.msg {top fill} $w.frame {top expand fill} \
	$w.ok {bottom fill}
    focus $w.frame.e1
}

proc d.entry2 {{w .e2}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 200 \
	    -text "Three different entries are displayed below, with a scrollbar for each entry.  You can add characters by pointing, clicking and typing.  You can delete by selecting and typing Control-d.  Backspace, Control-h, and Delete may be typed to erase the character just before the insertion point, and Control-u clears the entry.  For entries that are too large to fit in the window all at once, you can scan through the entries using the scrollbars, or by dragging with mouse button 3 pressed.  Click the \"OK\" button when you've seen enough."
    frame $w.frame -borderwidth 10
    pack append $w.frame \
	[entry $w.frame.e1 -relief sunken] {top fillx} \
	[scrollbar $w.frame.s1 -relief sunken -orient horiz -command \
	    "$w.frame.e1 view"] {top fillx} \
	[frame $w.frame.f1 -geometry 20x10] {top} \
	[entry $w.frame.e2 -relief sunken] {top fillx} \
	[scrollbar $w.frame.s2 -relief sunken -orient horiz -command \
	    "$w.frame.e2 view"] {top fillx} \
	[frame $w.frame.f2 -geometry 20x10] {top} \
	[entry $w.frame.e3 -relief sunken] {top fillx} \
	[scrollbar $w.frame.s3 -relief sunken -orient horiz -command \
	    "$w.frame.e3 view"] {top fillx}
    bind.entry $w.frame.e1 $w.frame.e2 $w.frame.e3
    $w.frame.e1 config -scroll "$w.frame.s1 set"
    $w.frame.e1 insert 0 "Initial value"
    $w.frame.e2 config -scroll "$w.frame.s2 set"
    $w.frame.e2 insert end "This entry contains a long value, much too long "
    $w.frame.e2 insert end "to fit in the window at one time, so long in fact "
    $w.frame.e2 insert end "that you'll have to scan or scroll to see the end."
    $w.frame.e3 config -scroll "$w.frame.s3 set"

    button $w.ok -text OK -command "destroy $w; focus .msg"
    pack append $w $w.msg {top fill} $w.frame {top expand fill} \
	$w.ok {bottom fill}
    focus $w.frame.e1
}

proc d.scale {{w .scale1}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 300 \
	    -text "A bar and a vertical scale are displayed below.  If you click or drag mouse button 1 in the scale, you can change the height of the bar.  Click the \"OK\" button when you're finished."
    frame $w.frame -borderwidth 10
    pack append $w.frame \
	[scale $w.frame.scale -orient vertical -length 280 -from 0 -to 250 \
	    -command "setHeight $w.frame.right.inner" -tickinterval 50 \
	    -bg Bisque1] {left expand frame ne} \
	[frame $w.frame.right -borderwidth 15] {right expand frame nw}
    pack append $w.frame.right \
	[frame $w.frame.right.inner -geometry 40x20 -relief raised \
	    -borderwidth 2 -bg SteelBlue1] {expand frame nw}
    $w.frame.scale set 20
    button $w.ok -text OK -command "destroy $w"

    pack append $w $w.msg {top fill} $w.frame {top expand fill} \
	$w.ok {bottom fill}
}

proc d.scale2 {{w .scale2}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 300 \
	    -text "A bar and a horizontal scale are displayed below.  If you click or drag mouse button 1 in the scale, you can change the width of the bar.  Click the \"OK\" button when you're finished."
    frame $w.frame -borderwidth 10
    pack append $w.frame \
	[frame $w.frame.top -borderwidth 15] {top expand frame sw} \
	[scale $w.frame.scale -orient horizontal -length 280 -from 0 -to 250 \
	    -command "setWidth $w.frame.top.inner" -tickinterval 50 \
	    -bg Bisque1] {bottom expand frame nw}
    pack append $w.frame.top \
	[frame $w.frame.top.inner -geometry 20x40 -relief raised \
	    -borderwidth 2 -bg SteelBlue1] {expand frame sw}
    $w.frame.scale set 20
    button $w.ok -text OK -command "destroy $w"

    pack append $w $w.msg {top fill} $w.frame {top expand fill} \
	$w.ok {bottom fill}
}

proc d.tear {{w .t1}} {
    catch {destroy $w}
    toplevel $w
    dpos $w
    message $w.msg -font *times-medium-r-normal--*-180* -aspect 200 \
	    -text "To tear off a menu, hold the Shift key down and press mouse button 1 over the menubutton for a menu.  Then drag the menu to where you would like it.  To unpost the menu, click mouse button 1 over the menu's menubutton.  Click the \"OK\" button when you're finished with this window.\n\nThis implementation of tear-off menus is a quick-and-dirty one that's buggy (e.g. it misbehaves if you drag a torn-off menu across another menubutton).  Sorry... there will be a better implementation later."
    button $w.ok -text OK -command "destroy $w"

    pack append $w $w.msg {top fill} $w.ok {bottom fill}
}

#-------------------------------------------------------
# Miscellanous procedures:
#-------------------------------------------------------

proc tkerror err {
    global errorInfo
    puts stdout "$errorInfo"
}

# Position a dialog box at a reasonable place on the screen.

proc dpos w {
    wm geometry $w +300+400
#    wm positionfrom $w user
}

# Create a dialog box.  Takes three or more arguments.  The first is
# the name of the window to use for the dialog box.  The second is a set
# of arguments for use in creating the message of the dialog box.  The
# third and following arguments consist of two-element lists, each
# describing one button.  The first element gives the text to be displayed
# in the button, the second gives the command to be invoked when the
# button is invoked.

proc mkDialog {w msgArgs args} {
    catch {destroy $w}
    toplevel $w -class Dialog

    # Create two frames in the main window. The top frame will hold the
    # message and the bottom one will hold the buttons.  Arrange them
    # one above the other, with any extra vertical space split between
    # them.

    frame $w.top -relief raised -border 1
    frame $w.bot -relief raised -border 1
    pack append $w $w.top {top fill expand} $w.bot {top fill expand}
    
    # Create the message widget and arrange for it to be centered in the
    # top frame.
    
    eval message $w.top.msg -justify center \
	    -font -*-times-medium-r-normal--*-180* $msgArgs
    pack append $w.top $w.top.msg {top expand padx 5 pady 5}
    
    # Create as many buttons as needed and arrange them from left to right
    # in the bottom frame.  Embed the left button in an additional sunken
    # frame to indicate that it is the default button, and arrange for that
    # button to be invoked as the default action for clicks and returns in
    # the dialog.

    if {[llength $args] > 0} {
	set arg [lindex $args 0]
	frame $w.bot.0 -relief sunken -border 1
	pack append $w.bot $w.bot.0 {left expand padx 20 pady 20}
	button $w.bot.0.button -text [lindex $arg 0] \
		-command "[lindex $arg 1]; destroy $w"
	pack append $w.bot.0 $w.bot.0.button {expand padx 12 pady 12}
	bind $w.top <Enter> "$w.bot.0.button activate"
	bind $w.top.msg <Enter> "$w.bot.0.button activate"
	bind $w.bot <Enter> "$w.bot.0.button activate"
	bind $w.top <Leave> "$w.bot.0.button deactivate"
	bind $w.top.msg <Leave> "$w.bot.0.button deactivate"
	bind $w.bot <Leave> "$w.bot.0.button deactivate"
	bind $w <1> "$w.bot.0.button config -relief sunken"
	bind $w <ButtonRelease-1> \
		"[lindex $arg 1]; $w.bot.0.button deactivate; destroy $w"
	bind $w <Return> "[lindex $arg 1]; destroy $w"
	focus $w

	set i 1
	foreach arg [lrange $args 1 end] {
	    button $w.bot.$i -text [lindex $arg 0] \
		    -command "[lindex $arg 1]; destroy $w"
	    pack append $w.bot $w.bot.$i {left expand padx 20}
	    set i [expr $i+1]
	}
    }
}

# Procedure to display the values of one or more variables using a
# dialog box:

proc showVars {w args} {
    set msg "Variable values:\n"
    foreach i $args {
	set msg "$msg\n$i = [uplevel #0 set $i]"
    }
    mkDialog $w "-text {$msg} -justify left" "OK {}"
}

# Procedure to set the width of a frame widget (used by scale demos):

proc setWidth {w width} {
    $w config -geometry ${width}x40
}

# Procedure to set the height of a frame widget (used by scale demos):

proc setHeight {w height} {
    $w config -geometry 40x${height}
}

# Procedure invoked by buttons in the puzzle to move the puzzle entries:

proc puzzle.switch {w num} {
    global pos.space pos.$num puzzleSize
    set ourX [lindex [set pos.$num] 0]
    set ourY [lindex [set pos.$num] 1]
    set spaceX [lindex ${pos.space} 0]
    set spaceY [lindex ${pos.space} 1]
    if {(($ourY == $spaceY) && ($ourX >= ($spaceX - $puzzleSize))
            && ($ourX <= ($spaceX + $puzzleSize)))
            || (($ourX == $spaceX) && ($ourY >= ($spaceY - $puzzleSize))
            && ($ourY <= ($spaceY + $puzzleSize)))} {
        set tmp ${pos.space}
        set pos.space [set pos.$num]
        set pos.$num $tmp
        eval move $w.frame.$num [set pos.$num]
    }
}
