Version 16 of snitbutton

Updated 2004-06-14 13:46:24 by escargo

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!


See also


[ Category Package | Category Widget ]