#
# demo.tcl,v 1.114 2007/12/13 20:14:02 jenglish Exp
#
# Tile widget set -- widget demo
#
package require Tk

eval destroy [winfo children .]		;# in case script is re-sourced

### Load auxilliary scripts.
#
variable demodir [file dirname [info script]]
lappend auto_path . $demodir
package require tile
package require keynav

source [file join $demodir iconlib.tcl]
source [file join $demodir repeater.tcl]

# This forces an update of the available packages list.
# It's required for package names to find the themes in demos/themes/*.tcl
eval [package unknown] Tcl [package provide Tcl]

### Global options and bindings.
#
option add *Button.default normal 
option add *Text.background white
option add *Entry.background white
option add *tearOff false

# See toolbutton.tcl.
#
option add *Toolbar.relief groove
option add *Toolbar.borderWidth 2
option add *Toolbar.Button.Pad 2
option add *Toolbar.Button.default disabled
option add *Toolbar*takeFocus 0

# ... for debugging:
bind all <ButtonPress-3> { set ::W %W }
bind all <Control-ButtonPress-3> { focus %W }

# Stealth feature:
#
if {![catch {package require Img 1.3}]} {
    bind all <Control-Shift-Alt-KeyPress-S> screenshot
    proc screenshot {} {
	image create photo ScreenShot -format window -data .
	bell
	# Gamma looks off if we use PNG ... 
	# Looks even worse if we use GIF ...
	ScreenShot write screenshot.png -format png
	image delete ScreenShot
	bell
    }
}

### Global data.
#

foreach theme [lsort [ttk::themes]] {
    lappend THEMELIST $theme [string totitle $theme]
}

# Generate icons (see also: iconlib.tcl):
#
foreach {icon data} [array get ::ImgData]  {
    set ::ICON($icon) [image create photo -data $data]
}

variable ROOT "."
variable BASE [ttk::frame .base]
pack $BASE -side top -expand true -fill both

array set ::V {
    COMPOUND	top
    CONSOLE	0
    MENURADIO1	One
    PBMODE	determinate
    SELECTED 	1
    CHOICE	2
    SCALE	50
    VSCALE	0
}

### Utilities.
#

## foreachWidget varname widget script --
#	Execute $script with $varname set to each widget in the hierarchy.
#
proc foreachWidget {varname Q script} {
    upvar 1 $varname w
    while {[llength $Q]} {
    	set QN [list]
	foreach w $Q {
	    uplevel 1 $script
	    foreach child [winfo children $w] {
		lappend QN $child
	    }
	}
	set Q $QN
    }
}

## sbstub $sb -- stub -command option for a scrollbar.
#	Updates the scrollbar's position.
#
proc sbstub {sb cmd number {units units}} { sbstub.$cmd $sb $number $units }
proc sbstub.moveto {sb number _} { $sb set $number [expr {$number + 0.5}] }
proc sbstub.scroll {sb number units} {
    if {$units eq "pages"} {
    	set delta 0.2
    } else {
	set delta 0.05
    }
    set current [$sb get]
    set new0 [expr {[lindex $current 0] + $delta*$number}]
    set new1 [expr {[lindex $current 1] + $delta*$number}]
    $sb set $new0 $new1
}

## sbset $sb -- auto-hide scrollbar 
#	Scrollable widget -[xy]scrollcommand prefix.
#	Sets the scrollbar, auto-hides/shows.
#	Scrollbar must be controlled by the grid geometry manager.
#
proc sbset {sb first last} {
    if {$first <= 0 && $last >= 1} {
    	grid remove $sb
    } else {	
        grid $sb
    }
    $sb set $first $last
}

## scrolled -- create a widget with attached scrollbars.
#
proc scrolled {class w args} {
    set sf "${w}_sf"

    frame $sf
    eval [linsert $args 0 $class $w]
    scrollbar $sf.hsb -orient horizontal -command [list $w xview]
    scrollbar $sf.vsb -orient vertical -command [list $w yview]

    configure.scrolled $sf $w
    return $sf
}

## ttk::scrolled -- create a widget with attached Tile scrollbars.
#
proc ttk::scrolled {class w args} {
    set sf "${w}_sf"

    ttk::frame $sf
    eval [linsert $args 0 $class $w]
    ttk::scrollbar $sf.hsb -orient horizontal -command [list $w xview]
    ttk::scrollbar $sf.vsb -orient vertical -command [list $w yview]

    configure.scrolled $sf $w
    return $sf
}

## configure.scrolled -- common factor of [scrolled] and [ttk::scrolled]
#
proc configure.scrolled {sf w} {
    $w configure -xscrollcommand [list $sf.hsb set]
    $w configure -yscrollcommand [list $sf.vsb set]

    grid $w -in $sf -row 0 -column 0 -sticky nwse
    grid $sf.hsb -row 1 -column 0 -sticky we
    grid $sf.vsb -row 0 -column 1 -sticky ns

    grid columnconfigure $sf 0 -weight 1
    grid rowconfigure $sf 0 -weight 1
}

### Toolbars.
#
proc makeToolbars {} {
    set buttons [list open new save]
    set checkboxes [list bold italic]

    #
    # Tile toolbar:
    #
    set tb [ttk::frame $::BASE.tbar_styled -class Toolbar]
    set i 0
    foreach icon $buttons {
	set b [ttk::button $tb.tb[incr i] \
	       -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \
	       -style Toolbutton]
	grid $b -row 0 -column $i -sticky news
    }
    ttk::separator $tb.sep -orient vertical
    grid $tb.sep -row 0 -column [incr i] -sticky news -padx 2 -pady 2
    foreach icon $checkboxes {
	set b [ttk::checkbutton $tb.cb[incr i] \
		-variable ::V($icon) \
	       -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \
	       -style Toolbutton]
	grid $b -row 0 -column $i -sticky news
    }

    ttk::menubutton $tb.compound \
    	-text "toolbar" -image $::ICON(file) -compound $::V(COMPOUND)
    $tb.compound configure -menu [makeCompoundMenu $tb.compound.menu]
    grid $tb.compound -row 0 -column [incr i] -sticky news

    grid columnconfigure $tb [incr i] -weight 1

    #
    # Standard toolbar:
    #
    set tb [frame $::BASE.tbar_orig -class Toolbar]
    set i 0
    foreach icon $buttons {
	set b [button $tb.tb[incr i] \
		  -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \
		  -relief flat -overrelief raised]
	grid $b -row 0 -column $i -sticky news
    }
    frame $tb.sep -borderwidth 1 -width 2 -relief sunken
    grid $tb.sep -row 0 -column [incr i] -sticky news  -padx 2 -pady 2
    foreach icon $checkboxes {
	set b [checkbutton $tb.cb[incr i] -variable ::V($icon) \
		  -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \
		  -indicatoron false \
		  -selectcolor {} \
		  -relief flat \
		  -overrelief raised \
		  -offrelief flat]
	grid $b -row 0 -column $i -sticky news
    }

    menubutton $tb.compound \
    	-text "toolbar" -image $::ICON(file) -compound $::V(COMPOUND) \
	-indicatoron true
    $tb.compound configure -menu [makeCompoundMenu $tb.compound.menu]
    grid $tb.compound -row 0 -column [incr i] -sticky news

    grid columnconfigure $tb [incr i] -weight 1
}

#
# Toolbar -compound control:
#
proc makeCompoundMenu {menu} {
    variable compoundStrings {text image none top bottom left right center}
    menu $menu
    foreach string $compoundStrings {
	$menu add radiobutton \
	    -label [string totitle $string] \
	    -variable ::V(COMPOUND) -value $string \
	    -command changeToolbars ;
    }
    return $menu
}

proc changeToolbars {} {
    foreachWidget w [list $::BASE.tbar_styled $::BASE.tbar_orig] {
	catch { $w configure -compound $::V(COMPOUND) }
    }
}

makeToolbars

### Theme control panel.
#
proc makeThemeControl {c} {
    ttk::labelframe $c -text "Theme" -padding {6 0}
    foreach {theme name} $::THEMELIST {
	set b [ttk::radiobutton $c.s$theme -text $name \
		   -variable ::ttk::currentTheme -value $theme \
		   -command [list ttk::setTheme $theme]]
	pack $b -side top -expand false -fill x
    }
    return $c
}
makeThemeControl $::BASE.control

### Notebook widget.
#
set nb [ttk::notebook $::BASE.nb]
ttk::notebook::enableTraversal $nb

### Main demo pane.
#
# Side-by comparison of Tile vs. core widgets.
#


set pw [ttk::panedwindow $nb.client -orient horizontal]
$nb add $pw -text "Demo" -underline 0 -padding 6
set l [ttk::labelframe $pw.l -text "Themed" -padding 6 -underline 1]
set r [labelframe $pw.r -text "Standard" -padx 6 -pady 6]
$pw add $l -weight 1; $pw add $r -weight 1

## menubuttonMenu -- demo menu for menubutton widgets.
#
proc menubuttonMenu {menu} {
    menu $menu
    foreach dir {above below left right flush} {
	$menu add command -label [string totitle $dir] \
	    -command [list [winfo parent $menu] configure -direction $dir]
    }
    $menu add cascade -label "Submenu" -menu [set submenu [menu $menu.submenu]]
    $submenu add command -label "Subcommand 1"
    $submenu add command -label "Subcommand 2"
    $submenu add command -label "Subcommand 3"
    $menu add separator
    $menu add command -label "Quit"  -command [list destroy .]

    return $menu
}

## Main demo pane - themed widgets.
#
ttk::checkbutton $l.cb -text "Checkbutton" -variable ::V(SELECTED) -underline 2
ttk::radiobutton $l.rb1 -text "One" -variable ::V(CHOICE) -value 1 -underline 0
ttk::radiobutton $l.rb2 -text "Two" -variable ::V(CHOICE) -value 2
ttk::radiobutton $l.rb3 -text "Three" -variable ::V(CHOICE) -value 3 -under 0
ttk::button $l.button -text "Button" -underline 0

ttk::menubutton $l.mb -text "Menubutton" -underline 2
$l.mb configure -menu [menubuttonMenu $l.mb.menu]

set ::entryText "Entry widget"
ttk::entry $l.e -textvariable ::entryText
$l.e selection range 6 end 

set ltext [ttk::scrolled text $l.t -width 12 -height 5 -wrap none]

grid $l.cb  -sticky ew
grid $l.rb1 -sticky ew
grid $l.rb2 -sticky ew
grid $l.rb3 -sticky ew
grid $l.button -sticky ew -padx 2 -pady 2
grid $l.mb -sticky ew -padx 2 -pady 2
grid $l.e -sticky ew -padx 2 -pady 2
grid $ltext -sticky news

grid columnconfigure $l 0 -weight 1
grid rowconfigure    $l 7 -weight 1 ; # text widget (grid is a PITA)

## Main demo pane - core widgets.
#
checkbutton $r.cb -text "Checkbutton" -variable ::V(SELECTED) 
radiobutton $r.rb1 -text "One" -variable ::V(CHOICE) -value 1 
radiobutton $r.rb2 -text "Two" -variable ::V(CHOICE) -value 2 -underline 1
radiobutton $r.rb3 -text "Three" -variable ::V(CHOICE) -value 3
button $r.button -text "Button"
menubutton $r.mb -text "Menubutton" -underline 3 -takefocus 1
$r.mb configure -menu [menubuttonMenu $r.mb.menu]
# Add -indicatoron control:
set ::V(rmbIndicatoron) [$r.mb cget -indicatoron]
$r.mb.menu insert 0 checkbutton -label "Indicator?" \
    -variable ::V(rmbIndicatoron) \
    -command "$r.mb configure -indicatoron \$::V(rmbIndicatoron)" ;
$r.mb.menu insert 1 separator

entry $r.e -textvariable ::entryText

set rtext [scrolled text $r.t -width 12 -height 5 -wrap none]

grid $r.cb -sticky ew
grid $r.rb1 -sticky ew
grid $r.rb2 -sticky ew
grid $r.rb3 -sticky ew
grid $r.button -sticky ew -padx 2 -pady 2
grid $r.mb -sticky ew -padx 2 -pady 2
grid $r.e -sticky ew -padx 2 -pady 2
grid $rtext -sticky news

grid columnconfigure $r 0 -weight 1
grid rowconfigure    $r 7 -weight 1 ; # text widget

#
# Add some text to the text boxes:
#

set cb $::BASE.tbar_orig.cb5
set txt "checkbutton $cb \\\n"
foreach copt [$cb configure] {
    if {[llength $copt] == 5} {
	append txt "  [lindex $copt 0] [lindex $copt 4] \\\n"
    }
}
append txt "  ;\n"

$l.t insert end $txt
$r.t insert end $txt

### Scales and sliders pane.
#
proc scales.pane {scales} {
    ttk::frame $scales

    ttk::panedwindow $scales.pw -orient horizontal
    set l [ttk::labelframe $scales.styled -text "Themed" -padding 6]
    set r [labelframe $scales.orig -text "Standard" -padx 6 -pady 6]

    ttk::scale $l.scale -orient horizontal -from 0 -to 100 -variable ::V(SCALE)
    ttk::scale $l.vscale -orient vertical -from 100 -to 0 -variable ::V(VSCALE)
    ttk::progressbar $l.progress -orient horizontal -maximum 100 
    ttk::progressbar $l.vprogress -orient vertical -maximum 100
    if {1} {
	$l.scale configure -command [list $l.progress configure -value]
	$l.vscale configure -command [list $l.vprogress configure -value]
    } else {
	# This would also work, but the Tk scale widgets 
	# in the right hand pane cause some interference when 
	# in autoincrement/indeterminate mode.
	#
    	$l.progress configure -variable ::V(SCALE)
        $l.vprogress configure -variable ::V(VSCALE)
    }

    $l.scale set 50
    $l.vscale set 50

    ttk::label $l.lmode -text "Progress bar mode:"
    ttk::radiobutton $l.pbmode0 -variable ::V(PBMODE) \
    	-text determinate -value determinate -command [list pbMode $l]
    ttk::radiobutton $l.pbmode1 -variable ::V(PBMODE) \
    	-text indeterminate -value indeterminate -command [list pbMode $l]
    proc pbMode {l} {
	variable V
	$l.progress configure -mode $V(PBMODE)
	$l.vprogress configure -mode $V(PBMODE)
    }

    ttk::button $l.start -text "Start" -command [list pbStart $l]
    proc pbStart {l} {
	set ::V(PBMODE) indeterminate; pbMode $l
	$l.progress start 10
	$l.vprogress start
    }

    ttk::button $l.stop -text "Stop" -command [list pbStop $l]
    proc pbStop {l} {
    	$l.progress stop
    	$l.vprogress stop
    }

    grid $l.scale -columnspan 2 -sticky ew
    grid $l.progress -columnspan 2 -sticky ew
    grid $l.vscale $l.vprogress -sticky nws

    grid $l.lmode -sticky we -columnspan 2
    grid $l.pbmode0 -sticky we -columnspan 2
    grid $l.pbmode1 -sticky we -columnspan 2
    grid $l.start -sticky we -columnspan 2
    grid $l.stop  -sticky we -columnspan 2

    grid columnconfigure $l 0 -weight 1
    grid columnconfigure $l 1 -weight 1

    grid rowconfigure $l 99 -weight 1

    scale $r.scale -orient horizontal -from 0 -to 100 -variable ::V(SCALE)
    scale $r.vscale -orient vertical -from 100 -to 0 -variable ::V(VSCALE)
    grid $r.scale -sticky news
    grid $r.vscale -sticky nws

    grid rowconfigure $r 99 -weight 1
    grid columnconfigure $r 0 -weight 1

    ##
    $scales.pw add $l -weight 1
    $scales.pw add $r -weight 1
    pack $scales.pw -expand true -fill both

    return $scales
}
$nb add [scales.pane $nb.scales] -text Scales -sticky nwes -padding 6

### Combobox demo pane.
#
proc combobox.pane {cbf} {
    ttk::frame $cbf
    set values [list abc def ghi jkl mno pqr stu vwx yz]
    pack \
	[ttk::combobox $cbf.cb1 -values $values -textvariable ::COMBO] \
	[ttk::combobox $cbf.cb2 -values $values -textvariable ::COMBO ] \
	[ttk::combobox $cbf.cb3 -values $values -textvariable ::COMBO ] \
    -side top -padx 2 -pady 2 -expand false -fill x;
    $cbf.cb1 configure -state readonly
    $cbf.cb3 configure -height 5
    $cbf.cb1 current 3
    return $cbf
}
$nb add [combobox.pane $nb.combos] -text "Combobox" -underline 7

### Treeview widget demo pane.
#
proc tree.pane {w} {
    ttk::frame $w
    pack [ttk::scrolled ttk::treeview $w.t -columns [list Class]] \
	-expand true -fill both

    $w.t heading #0 -text "Widget"
    $w.t heading Class -text "Class"

    # Populate tree:
    #
    $w.t insert {} 0 -id . -text "Main Window" \
	-values [list [winfo class .]]
    populateTree $w.t .

    bind $w.t <KeyPress-F5> [list refreshTree %W]

    return $w
}

# populateTree $tv $id --
#	Recursively add child nodes to treeview widget.
#
proc populateTree {tv id} {
    if {![winfo exists $id]} {
	$tv delete $id
	return ""
    }

    # Replace tree item children with current list of child windows.
    #
    $tv delete [$tv children $id]
    foreach child [winfo children $id] {
	$tv insert $id end -id $child -text [winfo name $child] \
	    -values [list [winfo class $child]]
	populateTree $tv $child
    }
    return $id 
}

# refreshTree -- <KeyPress-F5> binding for treeview demo.
#	Recompute children.
#

proc refreshTree {tv} {
    set id [$tv focus]
    $tv item [populateTree $tv $id] -open true
}

$nb add [tree.pane $nb.tree] -text "Tree" -sticky news

### Other demos.
#
$nb add [ttk::frame $nb.others] -text "Others" -underline 4

set Timers(StateMonitor) {}
set Timers(FocusMonitor) {}

set others $::BASE.nb.others

ttk::label $others.m -justify left -wraplength 300
bind ShowDescription <Enter> { $BASE.nb.others.m configure -text $Desc(%W) }
bind ShowDescription <Leave> { $BASE.nb.others.m configure -text "" }

foreach {command label description} {
    trackStates "Widget states..." 
    "Display/modify widget state bits"

    scrollbarResizeDemo  "Scrollbar resize behavior..."
    "Shows how Tile and standard scrollbars differ when they're sized too large"

    trackFocus "Track keyboard focus..." 
    "Display the name of the widget that currently has focus"

    repeatDemo "Repeating buttons"
    "Demonstrates custom classes (see demos/repeater.tcl)"

} {
    set b [ttk::button $others.$command -text $label -command $command]
    set Desc($b) $description
    bindtags $b [lreplace [bindtags $b] end 0 ShowDescription]

    pack $b -side top -expand false -fill x -padx 6 -pady 6
}

pack $others.m -side bottom -expand true -fill both


### Scrollbar resize demo.
#
proc scrollbarResizeDemo {} {
    set t .scrollbars
    destroy $t
    toplevel $t ; wm geometry $t 200x200
    frame $t.f -height 200
    grid \
	[ttk::scrollbar $t.f.tsb -command [list sbstub $t.f.tsb]] \
	[scrollbar $t.f.sb -command [list sbstub $t.f.sb]] \
    -sticky news

    $t.f.sb set 0 0.5	;# prevent backwards-compatibility mode for old SB

    grid columnconfigure $t.f 0 -weight 1
    grid columnconfigure $t.f 1 -weight 1
    grid rowconfigure $t.f 0 -weight 1
    pack $t.f -expand true -fill both
}

### Track focus demo.
#
proc trackFocus {} {
    global Focus
    set t .focus
    destroy $t
    toplevel $t 
    wm title $t "Keyboard focus"
    set i 0
    foreach {label variable} {
	"Focus widget:" Focus(Widget)
	"Class:" Focus(WidgetClass)
	"Next:"  Focus(WidgetNext)
	"Grab:"  Focus(Grab)
	"Status:"  Focus(GrabStatus)
    } {
	grid [ttk::label $t.l$i -text $label -anchor e] \
	     [ttk::label $t.v$i -textvariable $variable \
		-width 40 -anchor w -relief groove] \
	-sticky ew;
	incr i
    }
    grid columnconfigure $t 1 -weight 1
    grid rowconfigure $t $i -weight 1

    bind $t <Destroy> {after cancel $Timers(FocusMonitor)}
    FocusMonitor
}

proc FocusMonitor {} {
    global Focus

    set Focus(Widget) [focus]
    if {$::Focus(Widget) ne ""} {
	set Focus(WidgetClass) [winfo class $Focus(Widget)]
	set Focus(WidgetNext) [tk_focusNext $Focus(Widget)]
    } else {
	set Focus(WidgetClass) [set Focus(WidgetNext) ""]
    }

    set Focus(Grab) [grab current]
    if {$Focus(Grab) ne ""} {
	set Focus(GrabStatus) [grab status $Focus(Grab)]
    } else {
	set Focus(GrabStatus) ""
    }

    set ::Timers(FocusMonitor) [after 200 FocusMonitor]
}

### Widget states demo.
#
variable Widget .tbar_styled.tb1

bind all <Control-Shift-ButtonPress-1> { TrackWidget %W ; break }

proc TrackWidget {w} {
    set ::Widget $w ;
    if {[winfo exists .states]} {
	UpdateStates
    } else {
    	trackStates 
    }
}

variable states [list \
    active disabled focus pressed selected readonly \
    background alternate invalid]

proc trackStates {} {
    variable states
    set t .states
    destroy $t; toplevel $t ; wm title $t "Widget states"

    set tf [ttk::frame $t.f] ; pack $tf -expand true -fill both

    ttk::label $tf.info -text "Press Control-Shift-Button-1 on any widget"

    ttk::label $tf.lw -text "Widget:" -anchor e -relief groove
    ttk::label $tf.w -textvariable ::Widget -anchor w -relief groove

    grid $tf.info - -sticky ew -padx 6 -pady 6
    grid $tf.lw $tf.w -sticky ew

    foreach state $states {
	ttk::checkbutton $tf.s$state \
	    -text $state \
	    -variable ::State($state) \
	    -command [list ChangeState $state] ;
	grid x $tf.s$state -sticky nsew
    }

    grid columnconfigure $tf 1 -weight 1

    grid x [ttk::frame $tf.cmd] -sticky nse
    grid x \
    	[ttk::button $tf.cmd.close -text Close -command [list destroy $t]] \
    	 -padx 4 -pady {6 4};
    grid columnconfigure $tf.cmd 0 -weight 1

    bind $t <KeyPress-Escape> [list event generate $tf.cmd.close <<Invoke>>]
    bind $t <Destroy> { after cancel $::Timers(StateMonitor) }
    StateMonitor
}

proc StateMonitor {} {
    if {$::Widget ne ""} { UpdateStates }
    set ::Timers(StateMonitor) [after 200 StateMonitor]
}

proc UpdateStates {}  {
    variable states
    variable State
    variable Widget

    foreach state $states {
	if {[catch {set State($state) [$Widget instate $state]}]} {
	    # Not a Tile widget:
	    .states.f.s$state state disabled
	} else {
	    .states.f.s$state state !disabled
	}
    }
}

proc ChangeState {state} {
    variable State
    variable Widget
    if {$Widget ne ""} {
	if {$State($state)} { 
	    $Widget state $state
	} else {
	    $Widget state !$state
	}
    }
}

### Repeating button demo.
#

proc repeatDemo {} {
    set top .repeatDemo
    if {![catch { wm deiconify $top ; raise $top }]} { return }
    toplevel $top
    wm title $top "Repeating button"
    keynav::enableMnemonics $top

    set f [ttk::frame .repeatDemo.f]
    ttk::button $f.b -class Repeater -text "Press and hold" \
    	-command [list $f.p step]
    ttk::progressbar $f.p -orient horizontal -maximum 10

    ttk::separator $f.sep -orient horizontal
    set cmd [ttk::frame $f.cmd]
    pack \
    	[ttk::button $cmd.close -text Close -command [list destroy $top]]  \
    -side right -padx 6;

    pack $f.cmd -side bottom -expand false -fill x -padx 6 -pady 6
    pack $f.sep -side bottom -expand false -fill x -padx 6 -pady 6
    pack $f.b -side left -expand false -fill none -padx 6 -pady 6
    pack $f.p -side right -expand true -fill x -padx 6 -pady 6

    $f.b configure -underline 0
    $cmd.close configure -underline 0
    bind $top <KeyPress-Escape> [list event generate $cmd.close <<Invoke>>]

    pack $f -expand true -fill both
}


### Command box.
#
set cmd [ttk::frame $::BASE.command]
ttk::button $cmd.close -text Close -underline 0 -command [list destroy .]
ttk::button $cmd.help -text Help -command showHelp

proc showHelp {} {
    if {![winfo exists .helpDialog]} {
	lappend detail "Tile version [package provide tile]"
	lappend detail "Tile library: $::tile::library"
	lappend detail "[package ifneeded tile [package provide tile]]"
	lappend detail "Tk version: $::tk_patchLevel"
	lappend detail "Tk library: $::tk_library"
	ttk::dialog .helpDialog -type ok -icon info \
	    -message "Tile demo" -detail [join $detail \n]
    }
}

grid x $cmd.close $cmd.help -pady 6 -padx 6
grid columnconfigure $cmd 0 -weight 1

## Status bar (to demonstrate size grip)
#
set statusbar [ttk::frame $BASE.statusbar]
pack [ttk::sizegrip $statusbar.grip] -side right -anchor se

## Accelerators:
#
bind $::ROOT <KeyPress-Escape>	[list event generate $cmd.close <<Invoke>>]
bind $::ROOT <<Help>>		[list event generate $cmd.help <<Invoke>>]
keynav::enableMnemonics $::ROOT

### Menubar.
#
set menu [menu $::BASE.menu]
$::ROOT configure -menu $menu
$menu add cascade -label "File" -underline 0 -menu [menu $menu.file]
$menu.file add command -label "Open" -underline 0 \
    -compound left -image $::ICON(open)
$menu.file add command -label "Save" -underline 0 \
    -compound left -image $::ICON(save)
$menu.file add separator
$menu.file add checkbutton -label "Checkbox" -underline 0 \
    -variable ::V(SELECTED)
$menu.file add cascade -label "Choices" -underline 1 \
    -menu [menu $menu.file.choices]
foreach {label value} {One 1 Two 2 Three 3} {
    $menu.file.choices add radiobutton \
    	-label $label -variable ::V(CHOICE) -value $value
}

$menu.file insert end separator
if {[tk windowingsystem] ne "x11"} {
    $menu.file insert end checkbutton -label Console -underline 5 \
	-variable ::V(CONSOLE) -command toggleconsole
    proc toggleconsole {} {
	if {$::V(CONSOLE)} {console show} else {console hide}
    }
}
$menu.file add command -label "Exit" -underline 1 \
    -command [list event generate $cmd.close <<Invoke>>]

# Add Theme menu.
#
proc makeThemeMenu {menu} {
    menu $menu
    foreach {theme name} $::THEMELIST {
	$menu add radiobutton -label $name \
	    -variable ::ttk::currentTheme -value $theme \
	    -command [list ttk::setTheme $theme]
    }
    return $menu
}

$menu add cascade -label "Theme" -underline 3 -menu [makeThemeMenu $menu.theme]

## Tools menu.
#
$menu add cascade -label "Tools" -underline 3 -menu [menu $menu.tools]
$menu.tools add command -label "Track focus" -command trackFocus
$menu.tools add command -label "Widget states" -command trackStates

### Main window layout.
#

pack $BASE.statusbar -side bottom -expand false -fill x
pack $BASE.command -side bottom -expand false -fill x
pack $BASE.tbar_styled -side top -expand false -fill x
pack $BASE.tbar_orig -side top -expand false -fill x
pack $BASE.control -side left -expand false -fill y -padx 6 -pady 6
pack $BASE.nb -side left -expand true -fill both -padx 6 -pady 6

wm title $ROOT "Tile demo"
wm iconname $ROOT "Tile demo"
update; wm deiconify $ROOT