scripts/radiogroup.itk

   1 # vim: foldmarker=<<<,>>>
   2
   3 # Signals fired:
   4 #       onselect(value)         - Fired when a radio button is selected
   5
   6 proc tlc::radiogroup {pathname args} {
   7         uplevel [list tlc::Radiogroup $pathname] $args
   8 }
   9
  10
  11 class tlc::Radiogroup {
  12         inherit tlc::Mywidget tlc::Handlers tlc::Signalsource \
  13                         tlc::Tooltips tlc::Textvariable
  14
  15         constructor {args} {}
  16         destructor {}
  17
  18         itk_option define -foreground foreground Foreground black need_rerender
  19         itk_option define -disabledforeground disabledForeground Foreground grey need_rerender
  20         itk_option define -pady padY PadY 0
  21
  22         public {
  23                 variable state                  "normal"
  24                 variable choices                {}                      need_rerender
  25                 variable orient                 "v"                     need_rerender
  26                 variable cell_args              "-anchor w"     need_rerender
  27                 variable initial_value
  28                 variable value                  ""
  29                 variable wrap_len               ""
  30
  31                 method domino_ref {domino}
  32                 method attach_signal {key signal {sense normal}}
  33                 method path {key}
  34         }
  35
  36         protected {
  37                 method textvariable_changed {newvalue}
  38         }
  39
  40         private {
  41                 variable dominos
  42                 variable toggles
  43                 variable keymap
  44                 variable base
  45                 variable afterid        ""
  46
  47                 method need_rerender {} {$dominos(need_rerender) tip}
  48                 method rerender {}
  49                 method option_changed {key newvalue}
  50                 method value_changed {}
  51                 method update_value {val}
  52         }
  53 }
  54
  55
  56 configbody tlc::Radiogroup::state { #<<<1
  57         [stategate_ref] configure -default [expr {$state == "normal"}]
  58 }
  59
  60
  61 configbody tlc::Radiogroup::pady { #<<<1
  62         #foreach child [winfo children $w] {
  63         #       $child configure -pady $itk_option(-pady)
  64         #}
  65 }
  66
  67
  68 body tlc::Radiogroup::constructor {args} { #<<<1
  69         log debug
  70         if {[catch {
  71                 package require Tk 8.4
  72         } errmsg]} {
  73                 error "Need at least Tk 8.4 for Radiogroup"
  74         }
  75
  76         array set dominos       {}
  77         array set toggles       {}
  78         array set keymap        {}
  79
  80         tlc::Domino #auto dominos(need_rerender) -name "$w need_rerender"
  81         tlc::Domino #auto dominos(value_changed) -name "$w value_changed"
  82         tlc::Gate #auto signals(item_selected) -name "$w item_selected" \
  83                         -mode "or" -default 0
  84
  85         itk_component add border {
  86                 ttk::labelframe $w.border
  87         } {
  88                 keep -borderwidth -relief -text -labelanchor -labelwidget
  89         }
  90
  91         blt::table $w \
  92                         $w.border       1,1 -fill both
  93
  94         set base        $w.border.inner
  95
  96         $dominos(need_rerender) attach_output [code $this rerender]
  97
  98         eval itk_initialize $args
  99
 100         #if {0 && [$dominos(need_rerender) pending]} {
 101         #       log debug "forcing rerender in constructor"
 102         #       $dominos(need_rerender) tip_now
 103         #}
 104
 105         $dominos(need_rerender) force_if_pending
 106
 107         # Nasty hack to allow -initial_value <<<
 108         array set tmp   $args
 109         if {[info exists tmp(-initial_value)]} {
 110                 set_textvariable $initial_value
 111                 textvariable_changed $initial_value
 112                 #value_changed
 113         }
 114         # Nasty hack to allow -initial_value >>>
 115 }
 116
 117
 118 body tlc::Radiogroup::rerender {} { #<<<1
 119         log debug $w
 120         foreach key [array names toggles] {
 121                 array unset toggles $key
 122         }
 123         array unset keymap
 124         array set keymap        {}
 125         catch {eval destroy [winfo children $w.border]}
 126         foreach signal [array names signals option_*] {
 127                 array unset signals($signal)
 128         }
 129         ttk::frame $w.border.inner
 130         pack $w.border.inner -fill both -expand true
 131
 132         set seq 0
 133         foreach {name key} $choices {
 134                 if {$wrap_len != ""} {
 135                         set major       [expr {$seq % $wrap_len}]
 136                         set minor       [expr {$seq / int($wrap_len)}]
 137                         if {$orient == "h"} {
 138                                 set r   $minor
 139                                 set c   $major
 140                         } else {
 141                                 set r   $major
 142                                 set c   $minor
 143                         }
 144                 } else {
 145                         if {$orient == "h"} {
 146                                 set c   $seq
 147                                 set r   0
 148                         } else {
 149                                 set c   0
 150                                 set r   $seq
 151                         }
 152                 }
 153
 154                 ttk::radiobutton $base.$c,$r -text "$name" \
 155                                 -value $key \
 156                                 -variable [scope value] \
 157                                 -command [code $this value_changed]
 158
 159                 tlc::StateToggle #auto toggles($c,$r) $base.$c,$r \
 160                                 -state {disabled normal}
 161                 $toggles($c,$r) attach_input [stategate_ref]
 162
 163                 tlc::Signal #auto signals(option_$key) -name "$w option $key selected"
 164                 $signals(item_selected) attach_input $signals(option_$key)
 165                 $signals(option_$key) attach_output [code $this option_changed $key]
 166
 167                 set keymap($key)        "$c,$r"
 168
 169                 eval [list blt::table $base $base.$c,$r $r,$c] \
 170                                 $cell_args
 171
 172                 incr seq
 173         }
 174 }
 175
 176
 177 body tlc::Radiogroup::destructor {} { #<<<1
 178         log debug
 179         array unset toggles
 180         array unset dominos
 181         after cancel $afterid; set afterid      ""
 182 }
 183
 184
 185 body tlc::Radiogroup::attach_signal {key signal {sense normal}} { #<<<1
 186         if {![info exists keymap($key)]} {error "No such key: ($key)"}
 187
 188         return [$toggles($keymap($key)) attach_input $signal $sense]
 189 }
 190
 191
 192 body tlc::Radiogroup::path {key} { #<<<1
 193         if {[$dominos(need_rerender) pending]} {
 194                 log debug "forcing rerender to answer path request"
 195                 $dominos(need_rerender) tip_now
 196         }
 197
 198         if {![info exists keymap($key)]} {error "No such key: ($key)"}
 199
 200         return "$base.$keymap($key)"
 201 }
 202
 203
 204 body tlc::Radiogroup::option_changed {key newvalue} { #<<<1
 205         log debug
 206         if {$newvalue} {
 207                 invoke_handlers onselect $key
 208         }
 209 }
 210
 211
 212 body tlc::Radiogroup::value_changed {} { #<<<1
 213         log debug "setting textvariable to ($value)"
 214         set_textvariable        $value
 215
 216         foreach key [array names keymap] {
 217                 $signals(option_$key) set_state [expr {$value == $key}]
 218         }
 219
 220         $dominos(value_changed) tip
 221 }
 222
 223
 224 body tlc::Radiogroup::textvariable_changed {newvalue} { #<<<1
 225         log debug
 226         set afterid     [after idle [code $this update_value $newvalue]]
 227 }
 228
 229
 230 body tlc::Radiogroup::update_value {val} { #<<<1
 231         set value       $val
 232
 233         foreach key [array names keymap] {
 234                 $signals(option_$key) set_state [expr {$value == $key}]
 235         }
 236
 237         $dominos(value_changed) tip
 238         log debug "value now: ($value)"
 239 }
 240
 241
 242 body tlc::Radiogroup::domino_ref {domino} { #<<<1
 243         if {![info exists dominos($domino)]} {
 244                 error "Invalid domino: \"$domino\", choose from [array names dominos]" "" \
 245                                 [list invalid_domino $domino]
 246         }
 247         return $dominos($domino)
 248 }
 249
 250