'''DESCRIPTION''' [DDG] 2004-06-10: A [snidget] that works like 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 # Copyright (c) 2004 by Uwe Koloska # removing the errors taken from the original # # Changes: # - width is now the width of the buttons # - the background of the standardbuttons is transparent # and thus the background of the widget is now visible # - options are now interpreted if used as gButton # - sizes are now calculated the right way and honoured # # Bugs: # - there is no "#auto" and thus this package cannot replace gbutton in # wikit package provide snitButton 0.4 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 based gbutton. snit::type gButton { variable sb delegate option * to sb delegate method * to sb constructor {path args} { set sb [eval snitButton $path.p $args] pack $sb -side left -fill x -expand no } proc modify {args} { eval ::snitButton::modify $args } proc cget {args} { eval ::snitButton::cget $args } proc 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] + 2*$options(-pady)}] set wid [expr {[image width $up_img] + 2*$options(-padx)}] set canvas [canvas $win.c$numobj -height $ht -width $wid \ -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 - $options(-pady)}] 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 } $self size } 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 { R0lGODlhRQAeAMYAAP////v7++zs7N/f39XV1dHR0c3NzcLCwrm5uby8vMfH x7S0tL29vcDAwMHBwbi4uLe3t8vLy8/Pz9DQ0Ojo6MbGxtjY2PLy8rOzs+Tk 5Lu7u66urtPT0/b29q+vr6urq8PDw6SkpKampra2trq6upycnKCgoKWlpaen p6mpqZiYmJubm6GhoZeXl7+/v56enqKioqioqJ2dnZ+fn62traOjo6ysrJaW ltra2pGRkYyMjLGxsb6+vtTU1MrKysTExP////////////////////////// //////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////// /////////////////////////////////////////////////yH5BAEKAB0A LAAAAABFAB4AAAf+gB2Cg4SFhoeIiYqLjI2Oj5CRkpOUlZaXiwIDBAUFBp+g oaKjpKWdBAMClQIFBwgJCa+ws7S1tre4CQw8Lgc9qpEDCgsICAwNDsnKy8zN zs/LDQ0MEQOQAwcPEA4REhPf4OHi4+Tl4RISPg4uCtaNFNkPFRMW9fb3+Pn6 +/wTFewUGhXAgKGBBAL8EipcaI9AhGkFGGXQsAEDtwkcCHDYyLGjx48gQ24k QFLjhIcIXGRYVMDDBw8JHFSYSbOmzZs4c+qs8KPBA4IRFYH4EEKEBwwjHihd yrSp06dQoxKkkcKDAkUCSHwoYeLECRQoUoBNQbas2bNo06o1C/aECRP+H0gA O0RhhAgVK0ro3cu3r9+/gAP3XaEibkBEFEiwWNGisePHkCNLnkxZ8goWJA4f yuDiRYnKoEOLjlzihcpEGRTAMKGitevXsGPLnk1btgkYClYiLhBDxgzBwIML 5ztDRowCmg1RIEDixQwTfn8Pny74+YwXJAgkL6RJAQ0VMNy+HU++vPnz6NN3 haGCRru5mwu4qNGiBA0bMfLr38+/v////dlAw2c1uFCAboloYgAJMdygQgkw 0EDQhBRWaOGFGE5IAwwlqHBDDCQYkAojFOCwIA013JCDDiy26OKLMMYoo4s5 3FADDSHisB1qJoJAwg405FfDkEQWaeSRSCZTmR8NO5AAggE4IPjOAJ6A4AIJ JIyg5ZZcdunll2Bi6cKTBQywIyMCZLBJJ6W06eabpwyQAXyRCEBBBmoOoOee fPbp55+AypkBBXRiYuihiCb6SCAAOw== }] set disabled_img [image create photo -data { R0lGODlhRQAeAKUAAP////39/ff39/Hx8e3t7ezs7Orq6uXl5eLi4uPj4+Tk 5Ofn5+Dg4Onp6eHh4evr6/X19e/v7/n5+d/f3/T09N3d3fv7+9zc3Obm5tnZ 2dra2tvb29bW1tfX19TU1NXV1djY2NPT09HR0c/Pz97e3v////////////// //////////////////////////////////////////////////////////// /////////////////////////////////yH5BAEKAD8ALAAAAABFAB4AAAb+ wJ9wSCwaj8ikcslsOp/QqHRKrVqvzkLBwO16v+CwWIv9FQ6IRCKtbrvf8Lhc rVAcqgsGIn3o+/+AgYKDggkNUgcODgcND46PkJGSk5STDQcKC1CJDgsPEaCh oqOkpaanDwuZWRMTBw8Ep7KztKEElwkFTQgVro0FBFrCw8TFxsfCBMrBD5cI CkwFFRcVCQcL2Nna29zd3t8LGImtukoYFxkavQyK7e7v8PHy8w6tFRsVmkoI FxwdGek0bNAgcIPBgwgTKlzI8CDBDB06XECwhIEGDx84aNzIsaPHjyBDdvzg YeISBCBIeljJsqXLlzBjynz5AQRFJQo0ztzJs+e+S43QlCwA0cGn0aMwO4DQ l6TABn8io0qdyrEDhw3l9vmz2pEr1a8hI1q9uWRBBQ8gIIpdy7at27dwxWYA 4SFfkwIKMnjgMK2h37+AqXHwkEFB1iUGEGwIsRdEr1aQI0ueTLmyPRCDQ2xA YABK4goZQogYQbq06dOoU6s2LSJEhgqcpRjAgIDEvQ0Ac+vezbu37wwGK5BA gKHzlC0YFOxhwLy58+fQo0vfo6D4YSpaxGjfzp1Mme/gw4sfTx5LEAA7 } ] 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////////////////////////// /////////////////////////////////////////////////yH5BAEKAH8A LAAAAABFAB4AAAf+gH+Cg4SFhoeIiYqLjI2Oj5CRkpOUlZaXiwIDBAUFBp+g oaKjpKWdBAMClQIFBwgJCgsKs7S1tre4uQoMDQ4HD6qRAxARCwsSExTKy8zN zs/QzBMTFRYDkAMHFxgUGRob4OHi4+Tl5uIaGhwUHRDXjR7aHyAbIfb3+Pn6 +/z9GyDtPDASUWAEiQkaSoQwwbChw4cQI0qMGKJEBmoFRCw6gSIFiW4bVJRQ QbKkyZMoU6okWaLlyA0XF6w4sahACxcvFFAAwbOnz59AgwodCgLGhA8kYhRQ JELGDBo1Xti48aGq1atYs2rdytWGDRw5dOzQiEgADxc9fPz4AQRIkLb+QeLK nUu3rt27c9v+8OHDBY9ghzwIqTGESJHDiBMrXsy4sWPFRIb4FXhIhAceRogc 2cy5s+fPoEOLBk3ECA8PZAuJOIEkiZIlsGPLnk27tu3btZUkQXIiNaHVO5g0 cUK8uPHjyJMrX568CZMdvSt7KPAEShQp2LNr3869u/fv26NAeVIANSIPBHhM oVLFivv3V97Ln0+/vv36V6pQmcKDAOVDmuyARRZabFHFgQgmqOCCDDboYBVb aJEFFjukkshqBSDBRRdefAFGGCCGKOKIJJZoIolgfOFFF1wgUUB0iWhiAA9i jEFGGVqYccaOPPbo449ABrmjGVqUQcYYYvCXYICFTHmAxoxYcJGGGmtUaeWV WGap5ZZXqpEGF1goiYZ5i6z2pAw8sIGFGGJw4eabcMYp55x0sokFGzzIYAAa MA7kwQCeyIAEDzwIYeihiCaq6KKMEoqEngUMQKYjIghwwiadlKLpppyeMsAJ Avj2SKUenHDpAKimquqqrLbq6qcneBAqJiLUauutuOaq6665YuLrr4gEAgA7 } ] } } 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". [DDG] 2004-09-27: Hmm, should complain but I don't get an error: % package require Tk 8.4 % package require snit 0.93 0.93 % package require gbutton 0.4 % frame .f0 .f0 % frame .f2 .f2 % set b0 [gButton #auto .f0] ::#auto % set b2 [gButton #auto .f2] ::#auto % $b0 new Back % $b2 new Back2 % pack .f0 .f2 It installs two times the same command without error (TclTk8.4.6) ?! [UKo] 2004-09-27: And the init procedure of gButton points to snitButton::init which does not exist (at least in the version present on this page. [DDG] 2004-09-27: That's true and I missed it because inside wikit/gui.tcl the gButton::init procedure is inside a catch block. We may add a snitButton::init procedure or just delete the proc inside the gbutton-wrapper, because the only use of the wrapper should enabling wikit-gui-help. [UKo] 2004-09-27: No! init is used to set default values for the options that a gbutton object is created with. [UKo] 2004-09-27: 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 Here's a simple example that shows this problems: package require Tk lappend auto_path . package require snit 0.93 package require snitButton . configure -padx 8 -pady 8 set b1 [snitButton .t1 -bg red] set b2 [snitButton .t2 -bg yellow] set b3 [snitButton .t3 -bg green] pack $b1 $b2 $b3 -side top $b1 new 1 $b2 new 2; $b2 new 3 $b3 new 4; $b3 new 5; $b3 new 6 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? [DDG] 2004-09-27: If you solved a bug, improved the snit::type just feel free to add/change the code on this page. Changing, the Font,Color etc should be done via options like -font and an configure-handler which delegates the option accordingly to the right canvas item.. [UKo] 2004-09-27: OK, I have changed the source above. And like I've said above, the init can help avoid lots of the same -font or similar config flags while creating the snitButton objects. If you want all your buttons with font f you can say snitButton::init -font f Maybe there is a place in snit to change the default settings for object options. [WHD]: You could always use the option database. Alternatively, you can define a typemethod to set the option database values for you. ---- '''See also''' * [gbuttons] (buttons) * [Lightbutton] (radio & checkbuttons) ---- [[ [Category Package] | [Category Widget] ]]