Version 21 of snitbutton

Updated 2004-09-27 10:10:30

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 [L1 ], unwrap it, remove gbutton, add snitbutton and snit. Rewrap it, that's all!

SOURCE

 #
 #   snitbutton.tcl
 #
 #   Copyright (c) 2001-2002 by Steve Landers <steve (at) digital-smarties.com>
 #   Copyright (c) 2004 by Dr. Detlef Groth <detlef (at) dgroth.de> 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 <ButtonPress-1> [list $self press $text down]
          $canvas bind $tag0 <ButtonRelease-1> [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 <ButtonPress-1> [list $self press $text down]
          $canvas bind $tag1 <ButtonRelease-1> [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 [L2 ].


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

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?

See also


[ Category Package | Category Widget ]