'''DESCRIPTION''' [DDG] 2004-06-10: A working [snit]-port of the [gbuttons]-widget that uses [itcl]. That way the [wikit]-tkGui can also be used on platforms where [itcl] is not available (like MacOS 9). Maybe command renaming is a better approach than naming the package gbutton. But that's more than I can do. Any suggestions how to do this? In order to test the code below grab the latest wikit.kit from [http://www.equi4.com/wikit.html], unwrap it, remove gbutton, add snitbutton and snit. Rewrap it, that's all! '''SOURCE''' # # snitbutton.tcl # # Copyright (c) 2001-2002 by Steve Landers # Copyright (c) 2004 by Dr. Detlef Groth porting to the snit framework # package provide snitButton 0.3 package provide gbutton 0.4 package require Tk package require snit 0.93 # this is a wrapper type for the snitButton, simply remove the gbutton dir and # add the snitbutton and the snit-dir to replace the itcl gbutton. snit::type gButton { variable sb delegate option * to sb delegate method * to sb constructor {path args} { set sb [snitButton $path.p] pack $sb -side left -fill x -expand no $self configurelist $args } proc modify {args} { eval ::snitButton::modify $args } proc cget {args} { eval ::snitButton::cget $args } proc init {args} { eval snitButton::init $args } } snit::widget snitButton { variable canvas "" variable over variable numbut 0 variable wid variable ht variable command option -padx 0 option -pady 0 option -font "" option -bg "" option -fill "" option -activefill "" option -disabledfill "" typevariable numobj 0 typevariable textopts typevariable imageopts typevariable button typevariable up_img "" typevariable down_img "" typevariable disabled_img "" typevariable path "" constructor {args} { #installhull $win $self configurelist $args set ht [expr {[image height $up_img] + $options(-pady)}] set wid [expr {[image width $up_img] + 2*$options(-padx)}] set canvas [canvas $win.c$numobj -height $ht \ -highlightthickness 0] if { $options(-bg) ne ""} { $canvas configure -background $options(-bg) } pack $canvas -padx 0 -pady 0 incr numobj } proc path {dir} { set path $dir } proc init_opts {canv text} { foreach arg [lsort [$canv itemconfigure img_$text]] { set imageopts([lindex $arg 0]) 1 } foreach arg [lsort [$canv itemconfigure txt_$text]] { set textopts([lindex $arg 0]) 1 } } proc locate {text} { return $button($text) } proc modify {text args} { if {[info exists button($text)]} { #puts "$text $args" eval $button($text) config $text $args } } proc cget {text opt} { if {[info exists button($text)]} { eval $button($text) get $text $opt } } method new {text {cmd ""}} { set x [expr {$numbut * $wid + $options(-padx)}] set y $options(-pady) set tag0 [$canvas create image $x $y -image $up_img -tag img_$text \ -anchor nw] $canvas bind $tag0 [list $self press $text down] $canvas bind $tag0 [list $self release $text] set command($text) $cmd set x [expr {$x + $wid/2 - $options(-padx)}] set y [expr {$y + $ht/2}] set tag1 [$canvas create text $x $y -tag txt_$text -anchor center \ -text $text] $canvas bind $tag1 [list $self press $text down] $canvas bind $tag1 [list $self release $text] if {$disabled_img != ""} { $canvas itemconfigure $tag0 -disabledimage $disabled_img } if {$options(-fill) != ""} { $canvas itemconfigure $tag1 -fill $options(-fill) } if {$options(-activefill) != ""} { $canvas itemconfigure $tag1 -activefill $options(-activefill) } if {$options(-disabledfill) != ""} { $canvas itemconfigure $tag1 -disabledfill $options(-disabledfill) } if {$options(-font) != ""} { $canvas itemconfigure $tag1 -font $options(-font) } set button($text) [list $self] incr numbut if {[array size textopts] == 0} { init_opts $canvas $text } } method config {text args} { foreach {opt arg} $args { if {$opt == "-command"} { set command($text) $arg } else { if {[info exists imageopts($opt)]} { $canvas itemconfigure img_$text $opt $arg } if {[info exists textopts($opt)]} { $canvas itemconfigure txt_$text $opt $arg } } } } method get {text opt} { set result "" if {[info exists textopts($opt)]} { set result [$canvas itemcget txt_$text $opt] } elseif {[info exists imageopts($opt)]} { set result [$canvas itemcget img_$text $opt] } return $result } method press {text event} { if {[string equal $event up]} { $canvas itemconfigure img_$text -image $up_img } else { $canvas itemconfigure img_$text -image $down_img } } method release {text} { $self press $text up # Do we need to make this "after idle", in case the command is # long running? Perhaps it is best done in the calling # application if needed uplevel #0 $command($text) } method size {} { $canvas configure -width [expr {$numbut * $wid}] } typeconstructor { set path [file dirname [info script]] set up_img [image create photo -data { R0lGODlhRQAeAKUAAP////v7++zs7N/f39XV1dHR0c3NzcLCwrm5uby8vMfH x7S0tL29vcDAwMHBwbi4uLe3t8vLy8/Pz9DQ0Ojo6MbGxtjY2PLy8rOzs+Tk 5Lu7u66urtPT0/b29q+vr6urq8PDw6SkpKampra2trq6upycnKCgoKWlpaen p6mpqZiYmJubm6GhoZeXl7+/v56enqKioqioqJ2dnZ+fn62traOjo6ysrJaW ltra2pGRkYyMjLGxsb6+vtTU1MrKysTExCwAAAAARQAeAAAG/kCAcEgsGo/I pHLJbDqf0Kh0Sq1ar8qAYEAoFAzgsHhMLpu9hIEgMNUWDohEIi6v2+/4vD7B 4LkOPWtQAQMKCwgIDA0OjI2Oj5CRko4NDQwRA2xNhAcPEA4REhOjpKWmp6ip pRISPg4uCplMARSdDxUTFrq7vL2+v8DBExWwFJpIARcFGBgNEgTB0dLTuwQR lgUXx0YBGRobGKATHAQc5ufo6err7OYE7+UT1wguGdtEAR0FHh8eCQ4VAgoc SLCgwYMIK/xo8IBZgQ73hCQD8SGECA8YRjzYyLGjx48gQ4pkRiOFBwXajnQQ QOJDCRMnTqBAkWJmips4c+rcybNn/s6ZJ0yY+EBCQAduHSiMEKFiRYmnUKNK nUq1qlWpK1QQpQCxSDIKJFisaEG2rNmzaNOqXZt2BQsSFFLiu5DBxYsSbPPq 3Yu2xIt6cocky6AAhgkViBMrXsy4sePHjU3AUJAhsMQLFArEkDHjqufPoKPO kBGjQNx7+SgQIPFihompnUPLvup6xgsSBLhGXFmIhgoYQYUKH068uPHjyGHC UEEjltEjgwu4qNGiBA0bMbJr3869u/fv3W3QwFvDRYHKEQHk22KARIwbKkrA oMGsvv37+PPrr08DRgkVN8RAggFqdAUdZji0R0MNN+Sgw4MQRijhhBRWGGEO N9RAw4A4jpyWRD50JQgCCTvQkF0NKKao4oostuhidjTsQAIIBuBQmYHIdIDZ AF+A4AIJJIwg5JBEFmnkkUgC6QKNBQwQF44f6ihABlx4YcaVWGaJxgAZCHAB lFmAKAAFGVA5wJlopqnmmmy2yWUGFHgJUXphdqDjBXjmqeeefPbp5552BkCn E4IWauihiCaq6KJNBAEAOw== }] set disabled_img [image create photo -data { R0lGODlhRQAeAKUAAP////39/ff39/Hx8e3t7ezs7Orq6uXl5eLi4uPj4+Tk 5Ofn5+Dg4Onp6eHh4evr6/X19e/v7/n5+d/f3/T09N3d3fv7+9zc3Obm5tnZ 2dra2tvb29bW1tfX19TU1NXV1djY2NPT09HR0c/Pz97e3v////////////// //////////////////////////////////////////////////////////// /////////////////////////////////ywAAAAARQAeAAAG/kCAcEgsGo/I pHLJbDqf0Kh0Sq1ar8qAYEAoFAzgsHhMLpu9hIEgMNUWDohEIi6v2+/4vF6u UBwIa1ABAwsMCHEHiYqLjI2Oj44JDQNsTYMHDg4HDQ+dnp+goaKjog0HCguU TAEQmA4LDxGys7S1tre4uQ8LqBCVSAESBRMTBw8EucnKy7MEpgkFEr9GARQI FcWcBV1e3d7f4OHiaATlBQ+mCAoU00QBFgUVFxUJBwv3+Pn6+/z9/gsYMBEr YKGdkGAYLmTQgI1BpocQI0qcSLGiA2IVNlRYIO2IBQEILnDokGGhhg0aTm5Y ybKly5cwY7JMmaFDhwsIBFigZgEC/gMNHj5wGEq0qNGjSJMqNfrBA04IBYsE g4AARFMPWLNq3cq1q9evXD+AQAChozsJFBQMBcu2rVuuQ9eZHRKMwgIQHd7q 3du1A4gFFOYelAChwIaRSxMrXly0A4cNBcq2eweBAIKRjo1mZsxZqU3HCAhA NfiRUAUPIGp+Xs26tevXsD9nAOFho5qd1NAWUJDBAwd5MoMLHz6Pg4cMCgoE Ngjg3RYDCDaE8A0CG7Hr2LNr384dIwjjITYgMHCbeXPCEaBXyBBCxIj38OPL n0+/fnwRITJUGB9BcpJ3aKWHAQIkZLRBSQgmqOCCDDaYwUoVkIAABgZEEFhU /1lA2ABfZWCgwCEMhCjiiCSWaOKJhyhAYQEDlIVhFhoKQAEXXphh4404ojEA BQJI8OISAQAoAAQUzDjAkUgmqeSSTDa5IwUQ9FiQef+9o6EEWGap5ZZcdunl lhZMaUWQZJZp5plopqlmE0EAADs= } ] set down_img [image create photo -data { R0lGODlhRQAeAMYAAP////n5+eXl5dLS0sXFxb+/v7i4uKWrsZGfsZGluIul xYufxZGlxZelv5+lsb/FxauxuIuXsZGly5Gry5ery5eluLG4uIufuIWfv6W4 2au/2bG/2aW40pelxd/f34WfxZ+x0rjL3+zs7IuXq36Xv7jF37/L39nZ2Z+f q3eRuLHF36Wlq/Ly8oWRpXGLuHeRv5ex0ouXpaurq3eLq2SFsWuFuH6XxX6f xXGRv2uLuH6RsbGxsZ+fn1d3sV1+uGSFuGuFv2uLv5eXl1FxsVF3uFd3uGR+ q0pxuKWlpWt3l1F3v0pxv3d+i1d+xUpxxYWFi2R3pVF+0kp30nF3hV13v1F+ 2Up32Up+2YuLi2RxhWR+v1eF2X5+fmRxd113pWSR312R31eL34WFhWtrcWRx fmR3l2uR0nGX38vLy2tra2RkZF1dXZGRkf////////////////////////// /////////////////////////////////////////////////ywAAAAARQAe AAAH/oAAgoOEhYaHiImKi4yNjo+QkZKTlJWWl4oBAgMEBQUGoKGio6Slpp4E AwIBk5oFBwgJCgsKtba3uLm6uwoMDQ4HD6uQAQMQEQsLEhMUzc7P0NHS088T ExUWA6yNxQcXGBQZGhvk5ebn6Onq5hoaHBQdENqMAR7eHyAbIfv8/f7/AAMK 3AAinodtiAKIKDCCxAQNJUKYmEixosWLGDNiDFEiw7UCIhAaCnACRQoS4Tao KKGipcuXMGPKnNmyhE2WGzwuWHFCJKEALAq0cPFCAQUQSJMqXcq0qdOnIGBM +EAiRgEWPgUplDGDRo0XNm58GEu2rNmzaNOqtWEDRw4d/jtCHmIhgIeLHj5+ /AACJAjfIIADCx5MuLBhwXx/+PDhgocAFiNZeBBSYwiRIpgza97MubPnz5uJ DGnsAWshhR54GCFypLXr17Bjy55NWzYRIzw8yP0p4gSSJEqWCB9OvLjx48iT H1eSBMmJ3YMUntjBpImT69iza9/Ovbt37k2Y7HjuE3WBJ1CiSFnPvr379/Dj y3cfBcqTArrLSybAYwqVKlYEKOAVAhZo4IEIJojgFVVQMQUPBJSWFV0D7IBF FlpsUcWGHHbo4YcghihiFVtokQUWO6gC2Ui9FYAEF1148QUYYdRo44045qjj jjmC8YUXXXCBRAHkHQLUJgbwzSDGGGSUoYUZZ0Qp5ZRUVmnllVGaoUUZZIwh Bg8GqJiVViJ4gEaSWHCRhhprtOnmm3DGKeecb6qRBhdYgIlGfokA1duZMvDA BhZiiMHFoYgmquiijDZaKBZs8CCDAWg8Z1qfLJQ5wCcyIMEDD0KEKuqopJZq 6qmfIjFpAQPodmkmmQpwAieemGLrrbiiMsAJAojw6iIB+CmAByfMOsCxyCar 7LLMNrvrCR70itWYmQCVqQjYZqvtttx26+22LExrSbDklmvuueimq24jgQAA Ow== } ] } } The pkgIndex.tcl should be like this: package ifneeded snitButton 0.3 [list source [file join $dir snitbutton.tcl]] package ifneeded gbutton 0.4 [list source [file join $dir snitbutton.tcl]] ---- Please consider submitting a Feature Request to the sf.net site for [tklib] to have this package added to tklib! [DDG]: Did this request on SF [https://sourceforge.net/tracker/?func=detail&atid=362883&aid=971076&group_id=12883]. ---- '''EXAMPLE''' if {0} { pack [snitButton .t] -side top -fill x -expand no set b0 .t $b0 new Back $b0 new Forward $b0 new Home snitButton::modify Back -command [list Cmd 0] snitButton::modify Forward -command [list Cmd 1] snitButton::modify Forward -state disabled proc Cmd {state} { tk_messageBox -type ok -message "Cmd" if {$state == 0} { snitButton::modify Forward -state normal snitButton::modify Back -state disabled } else { snitButton::modify Forward -state disabled snitButton::modify Back -state normal } } } [http://goblet.molgen.mpg.de/images/snitbutton.gif] ---- [stevel] - Great work! [UKo] 2004-09-26: it can't work as an replacement for gbutton in wikit, cause there is no such thing as #auto and the memberfunction init doesn't exist. ---- '''See also''' * [gbuttons] (buttons) * [Lightbutton] (radio & checkbuttons) ---- [[ [Category Package] | [Category Widget] ]]