'''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. What is the best way to submit changes to this package? Change the code here on this page (the old code is in the versioning system)? [DDG] 2004-09-27: As far as I understand you mean the lines with: set b0 [gButton #auto $top.n.f0] however this should not give a problem. Because it creates a command #auto, which is useless but not harmful. In order to test this I went to equi4.com, grabbed the latest wikit.kit, unwrappped it and removed the gbutton-dir and were adding the snitbutton-dir and snit. Have you really failed with this procedure ? The function init exists also, look at the member-proc init inside the gbutton-type. [UKo] 2004-09-27: there are two lines with '#auto' and thus the second one mourns "command ::#auto already exists". And the init procedure of gButton points to snitButton::init which does not exist (at least in the version present on this page. gButtons and thus snitButtons have some bugs that I have solved: * width is always the inital width of the canvas * background of the standardimages is white and thus cannot be changed * sizes (pady and wid) are not calculated right * (snitButton) options are not evaluated when given to gButton Do you have another version? The only problems I was not able to solve are * #auto must be interpreted by snit or changed to %AUTO% * i haven't found a possibility to change the default options (that's what the init procedure is supposed to do) The default options are set while creating the type but I haven't found a way to change them after this -- how can a typemethod access the internal array options? ---- '''See also''' * [gbuttons] (buttons) * [Lightbutton] (radio & checkbuttons) ---- [[ [Category Package] | [Category Widget] ]]