Boolean Checkbutton

glennj Some time ago [L1 ], I because frustrated with Tk's default checkbutton. I wanted it to accept any boolean value [L2 ]. I ended up writing this package:

  package require Tk
  package provide booleanCheckbutton 0.1

  # create a checkbutton that selects when it's variable is set to
  # a boolean true value
  #
  # arguments:
  #   widget  - the widget "pathName"
  #   args    - list of checkbutton configuration options 
  #
  # example:
  #   set cb [booleanCheckbutton .bcb -textvariable bcbVal \
  #               -text "checkbutton label" -relief flat]
  #   set bcbVal true
  #
  # Any errors will be propagated up to the caller.
  #

  namespace eval ::booleanCheckbutton {
      namespace export booleanCheckbutton
      variable varName
      variable traceCmd
      array set varName {}
      array set traceCmd {}
  }

  proc ::booleanCheckbutton::booleanCheckbutton {pathName args} {

      # create the checkbutton with the specified options
      eval [linsert $args 0 checkbutton $pathName]

      # set the namespace variables now that the widget command has been created
      variable varName
      variable traceCmd 
      set varName($pathName) [$pathName cget -variable]
      set traceCmd($pathName) [list [namespace current]::selectIfTrue $pathName]

      # ensure the trace occurs in the global scope
      uplevel #0 [list trace add variable $varName($pathName) write $traceCmd($pathName)]

      # need to remove the variable trace if the checkbutton is deleted
      # i.e. if it's parent window is destroyed
      uplevel #0 [list trace add command $pathName delete [namespace current]::removeTrace]

      # trigger the trace for the current value of $varName, if it exists
      upvar #0 $varName($pathName) var
      if {[info exists var]} {
          uplevel #0 [list set $varName($pathName) $var]
      }

      return $pathName
  }

  proc ::booleanCheckbutton::selectIfTrue {widget varName arrayIndex op} {
      if {$op eq "write"} {
          if {$arrayIndex eq ""} {
              upvar #0 $varName var
          } else {
              upvar #0 ${varName}($arrayIndex) var
          }
          if {[string is boolean -strict $var] && $var} {
              set var [$widget cget -onvalue]
          }
      }
  }

  proc ::booleanCheckbutton::removeTrace {pathName args} {
      variable varName
      variable traceCmd
      uplevel #0 [list trace remove variable $varName($pathName) write $traceCmd($pathName)]
      uplevel #0 [list trace remove command $pathName delete [namespace current]::removeTrace]
      unset -nocomplain varName($pathName) traceCmd($pathName)
  }


  if 0 {
      # test
      package require Tk
      package require booleanCheckbutton
      namespace import ::booleanCheckbutton::booleanCheckbutton

      entry .e -textvar entry_value
      bind .e <Return> {set checkbutton_value $entry_value; set entry_value ""}

      booleanCheckbutton .c -variable checkbutton_value -textvariable checkbutton_value

      button .l -text "type a value, hit return, observe the checkbutton"
      pack .l .e .c
  }

glennj 20071202 - updated to fix an error in the test code, and placed package in a namespace
glennj 20090309 - updated to use arrays for namespace variables, to allow for more than one booleanCheckbutton per application

Category Widget