I've been playing with the code in the [spinbox] wiki for some time. The code below is compatible with versions of [tcl/tk] before 8.4 and has the following features: * the arrow buttons affect a ''[menubutton]'' widget full of [radiobutton] entries, rather than an ''[entry]'' widget * the menubutton can still be used for input * arrows are shown by use of [unicode] characters rather than drawing a shape or using [bitmap]s * font and color attributes are passed through the routine to the underlying widgets * a ''-cycle'' flag can be used to come back to the top of the list when hitting the last entry (and vice-versa) * if the widget is not in ''-cycle'' mode, then an up/down arrow is disabled when at one or the other limit of the list, whether the list edge was reached via up/down buttons, '''or''' invoking the menubutton directly * a ''-numeric'' flag can be used to reverse the action of the arrows--in a typical list of say... names... you would want the up/down arrows to move up/down through menu entries, but in a numeric list, you probably want the entries to have the lowest number at the top of the menu, highest at the bottom, but have the up arrow go to a higher numeric value (therefore down the list) * there is automatic repeating functionality on the up/down buttons (if they are held down) * the user must supply the name of a global variable that will be 'bound' to the menubutton after the ''-variable'' flag * the user must supply a list of values to place in the menu after the ''-values'' flag * if the variable is set before creating a widget, its contents will be the initial value of the menubutton enjoy #!/usr/bin/wish proc spin_mb {args} { set w [lindex $args 0] set cycle "-nocycle" array set buttoncmd {up listprev dn listnext} array set buttonsym "up \u25b2 dn \u25bc" array set passthrough {} # process flags for { set i 1 } { $i < [llength $args] } { incr i } { set flag [ lindex $args $i ] switch -glob -- $flag { {-cycle} { set cycle "-cycle" } {-variable} { incr i set var [ lindex $args $i ] } {-values} { incr i set values [ lindex $args $i ] } {-numeric} { # with a numeric list, we probably want the numbers to list # smallest at top, but the down arrow should take us to a # numerically smaller number...which means the down arrow moves # up, visually, through the list array set buttoncmd {up listnext dn listprev} } {-font} - {-bg} - {-fg} - {-*background} - {-*foreground} - {-*color} { # pass through color and font values to the sub-widgets set nextarg [ lindex $args [ expr $i + 1 ] ] if { ($nextarg != "") && ([string index $nextarg 0] != "-") } { set passthrough([lindex $args $i]) $nextarg incr i } } } } # check that we have all info we need to actually function if { (![info exists var]) || (![info exists values]) } { error " " "spin_mb needs -variable and -values " } set fullvarname $var if { [string range $var 0 1] != "::"} { set fullvarname "::$var" } # if initial value in $var isn't in list, set it to 1st list element if {(![info exists $fullvarname])} { set $fullvarname [ lindex $values 0 ] } if { [ lsearch -exact $values [ set $fullvarname ] ] == -1 } { set $fullvarname [ lindex $values 0 ] } frame $w -relief groove menubutton $w.menubutton -menu $w.menubutton.menu -textvariable $var -relief raised menu $w.menubutton.menu set maxlen 0 foreach item $values { $w.menubutton.menu add radiobutton -label $item -variable $var -command "ghostarrows $cycle $w $fullvarname" if { [string length $item] > $maxlen } { set maxlen [ string length $item ] } } $w.menubutton configure -width $maxlen namespace eval ::spmb_vals {} set ::spmb_vals$fullvarname $values foreach i {up dn} { set arr $w.$i button $arr -padx 0 -pady 0 -text $buttonsym($i) -command "$buttoncmd($i) $cycle $fullvarname $w" -font {Times 6} # add repeating fuctionality to arrow button... more code based on wiki proc repeat$arr {arr pause} { if {![set ::ok_$arr]} { return } $arr config -relief sunken uplevel eval [$arr cget -command] after $pause "repeat$arr $arr 100" } bind $arr {set ::ok_%W 1; repeat%W %W 1000} bind $arr "set ::ok_%W 0; $arr config -relief raised" #bind $arr "set ::ok_%W 0; [ bind Button ]" bind $arr [ bind Button ] bind $arr [ bind Button ] bindtags $arr [lreplace [bindtags $arr] 1 1 ] } # use color and font passthroughs foreach i [array names passthrough] { foreach j {menubutton menubutton.menu up dn} { $w.$j configure $i $passthrough($i) } if { ($i == "-bg")||($i == "-background") } { # apply bg color to frame and trough around arrowbuttons $w configure $i $passthrough($i) $w.dn configure -highlightbackground $passthrough($i) $w.up configure -highlightbackground $passthrough($i) } elseif { $i == "-font" } { # int(font*2/3) applied to arrowbuttons set fontsize [ lindex $passthrough($i) 1 ] if { $fontsize != "" } { set arrowfont [ lreplace $passthrough($i) 1 1 [ expr int ( $fontsize / 2 ) ] ] $w.up configure -font $arrowfont $w.dn configure -font $arrowfont } } } pack $w.menubutton -side left -fill y pack $w.up -anchor n -ipady 0 -ipadx 0 -pady 0 pack $w.dn -anchor s -ipady 0 -ipadx 0 -pady 0 ghostarrows $cycle $w $fullvarname } # return the next element in a list proc listprev {cycle var w} { upvar $var currval set fullist [set ::spmb_vals$var] set element_pos [lsearch -exact $fullist $currval] set listlen [ expr [ llength $fullist ] - 1 ] if { $element_pos > 0 } { set currval [ lindex $fullist [incr element_pos -1] ] } elseif { $cycle == "-cycle" } { set currval [ lindex $fullist $listlen ] } ghostarrows $cycle $w $var } # return the next element in a list proc listnext {cycle var w} { upvar $var currval set fullist [set ::spmb_vals$var] set listlen [ expr [ llength $fullist ] - 1 ] set element_pos [lsearch -exact $fullist $currval] if { $element_pos < $listlen } { set currval [ lindex $fullist [incr element_pos] ] } elseif { $cycle == "-cycle" } { set currval [ lindex $fullist 0 ] } ghostarrows $cycle $w $var } # (de)activate arrowbuttons, based on location in list of data proc ghostarrows {cycle w var} { upvar $var currval set fullist [set ::spmb_vals$var] set listlen [ expr [ llength $fullist ] - 1 ] set element_pos [lsearch -exact $fullist $currval] if {$cycle == "-cycle"} { return } if {$element_pos == 0 } { $w.dn configure -state disabled } else { $w.dn configure -state normal } if {$element_pos == $listlen } { $w.up configure -state disabled } else { $w.up configure -state normal } } set blah "3" spin_mb .test -cycle -fg green -bg black -variable bleh -values {joe fred bill henry} spin_mb .test2 -numeric -font {Times 24 bold} -variable blah -values {1 2 3 4 5 6 7 8} pack .test .test2 ---- [Category GUI] | [Category Widget]