'''DESCRIPTION'''

[DDG] 2004-06-10: A working port of the gbutton-widget which uses [itcl] to the snit framwork. That way the wikit-tkGui can also be used on platforms where [itcl] is not available (like MacOS 9).

May be command renaming is a better approach than naming the the package gbutton. Any suggestions ?

'''SOURCE'''
 #
 #   snitbutton.tcl
 #
 #   Copyright (c) 2001-2002 by Steve Landers <steve@digital-smarties.com>
 #   Copyright (c) 2004 by Dr. Detlef Groth <detlef@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,
 # therefor you can simply remove the gbutton dir and add the snitbutton and the snit-dir
 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
          if {$up_img == ""} {
              init
          }
          $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
     }
     typeconstructor {
         set path [file dirname [info script]]
     }
 
     proc path {dir} {
         set path $dir
     }
     
     proc init {args} {
         # used to initialise common variables - invoke using "-var value"
         # puts "path: [file join $path up.gif]"
         foreach {opt val} $args {
             set [string range $opt 1 end] $val
          }
          if {[info exists up]} {
              set up_img [image create photo -file $up]
          } else {
              set up_img [image create photo -file [file join $path up.gif]]
          }
          if {[info exists down]} {
              set down_img [image create photo -file $down]
          } else {
              set down_img [image create photo \
                            -file [file join $path down.gif]]
          }
          if {[info exists disabled]} {
              set disabled_img [image create photo -file $disabled]
          } else {
              set disabled_img [image create photo \
                                -file [file join $path disabled.gif]]
          }
      }

      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}]
      }
  }

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]]