scripts/lookup.itk

   1 # vim: foldmarker=<<<,>>>
   2
   3 # Signals:
   4 #       onchange(id,text)       - Fired when the data is changed
   5
   6 option add *Lookup.buttonBorderwidth            1       widgetDefault
   7 option add *Lookup.buttonPadX                           2       widgetDefault
   8 option add *Lookup.buttonPadY                           0       widgetDefault
   9
  10 class tlc::Lookup {
  11         inherit tlc::Mywidget tlc::Handlers tlc::Textvariable tlc::Signalsource
  12
  13         constructor {args} {}
  14         destructor {}
  15
  16         public {
  17                 variable button_label   "..."
  18                 variable lookup_command {}
  19                 variable state                  "normal"
  20
  21                 method set_data {id text}
  22                 method get_id {}
  23                 method get_text {}
  24                 method selected_ref {}
  25         }
  26
  27         protected {
  28                 variable toggles
  29                 variable id                                     ""
  30                 variable text                           ""
  31
  32                 method fire_lookup {}
  33                 method textvariable_changed {newvalue}
  34         }
  35 }
  36
  37
  38 configbody tlc::Lookup::lookup_command { #<<<1
  39         $signals(lookup_set) set_state  [expr {$lookup_command != {}}]
  40         log debug "$w lookup_command: ([$signals(lookup_set) state]) ($lookup_command)"
  41 }
  42
  43
  44 configbody tlc::Lookup::state { #<<<1
  45         $signals(enabled) set_state [expr {$state == "normal"}]
  46         log debug "$w state: ([$signals(enabled) state]) ($state)"
  47 }
  48
  49
  50 configbody tlc::Lookup::button_label { #<<<1
  51         log debug $w
  52         switch -- [string index $button_label 0] {
  53                 "@" {
  54                         $w.button configure \
  55                                         -text "" -image [string range $button_label 1 end]
  56                 }
  57
  58                 default {
  59                         $w.button configure \
  60                                         -text $button_label -image ""
  61                 }
  62         }
  63 }
  64
  65
  66 body tlc::Lookup::constructor {args} { #<<<1
  67         tlc::Signal #auto signals(lookup_set) -name "$w lookup_set"
  68         tlc::Signal #auto signals(enabled) -name "$w enabled"
  69         tlc::Signal #auto signals(item_selected) -name "$w item_selected"
  70
  71         $signals(enabled) set_state [expr {$state == "normal"}]
  72
  73         itk_component add entry {
  74                 entry $w.entry -state disabled -background $tlc::config(textbackground) \
  75                                 -textvariable [scope text]
  76         } {
  77                 usual
  78                 ignore -background -state -textvariable
  79                 keep -width
  80                 switch -- $::tcl_version {
  81                         "8.0" -
  82                         "8.1" -
  83                         "8.2" -
  84                         "8.3" {
  85                         }
  86
  87                         default {
  88                                 ignore -disabledbackground
  89 #                               keep -disabledbackground
  90                         }
  91                 }
  92         }
  93
  94         bind $w.entry <Button-1> [code $this fire_lookup]
  95
  96         itk_component add button {
  97                 button $w.button -command [code $this fire_lookup]
  98         } {
  99                 usual
 100                 ignore -text
 101                 rename -borderwidth -buttonborderwidth buttonBorderwidth ButtonBorderwidth
 102                 rename -padx -buttonpadx buttonPadX ButtonPadX
 103                 rename -pady -buttonpady buttonPadY ButtonPadY
 104         }
 105
 106         switch -- $::tcl_version {
 107                 "8.0" -
 108                 "8.1" -
 109                 "8.2" -
 110                 "8.3" {
 111                         tlc::StateToggle #auto toggles(entry) $w.entry \
 112                                         -background [list $tlc::config(disabledbackground) $tlc::config(textbackground)]
 113                 }
 114
 115                 default {
 116                         tlc::StateToggle #auto toggles(entry) $w.entry \
 117                                         -background [list $tlc::config(disabledbackground) $tlc::config(textbackground)] \
 118                                         -disabledbackground [list $tlc::config(disabledbackground) $tlc::config(textbackground)]
 119                 }
 120         }
 121
 122         tlc::StateToggle #auto toggles(button) $w.button \
 123                         -state {disabled normal}
 124
 125         $toggles(entry) attach_signal $signals(enabled)
 126         $toggles(button) attach_signal $signals(enabled)
 127         $toggles(button) attach_signal $signals(lookup_set)
 128
 129         table $w \
 130                         $w.entry        1,1 -fill x \
 131                         $w.button       1,2 -fill y
 132         table configure $w c2 -resize none
 133
 134         eval itk_initialize $args
 135 }
 136
 137
 138 body tlc::Lookup::destructor {} { #<<<1
 139         array unset toggles
 140 }
 141
 142
 143
 144 body tlc::Lookup::fire_lookup {} { #<<<1
 145         if {![$signals(enabled) state]} return
 146         if {![$signals(lookup_set) state]} return
 147         set res [uplevel #0 $lookup_command [list $id $text]]
 148         set status      [lindex $res 0]
 149         if {$status} {
 150                 set_data [lindex $res 1] [lindex $res 2]
 151         }
 152 }
 153
 154
 155 body tlc::Lookup::set_data {id newtext} { #<<<1
 156         set id          $id
 157         set text        $newtext
 158
 159         set_textvariable $id
 160
 161         $signals(item_selected) set_state [expr {$id != ""}]
 162
 163         invoke_handlers onchange $id $text
 164 }
 165
 166
 167 body tlc::Lookup::get_id {} { #<<<1
 168         return $id
 169 }
 170
 171
 172 body tlc::Lookup::get_text {} { #<<<1
 173         return $text
 174 }
 175
 176
 177 body tlc::Lookup::selected_ref {} { #<<<1
 178         log warning "selected_ref is deprecated.  use signal_ref item_selected\n[tlc::stackdump]"
 179         return $signals(item_selected)
 180 }
 181
 182
 183 body tlc::Lookup::textvariable_changed {newvalue} { #<<<1
 184         # TODO: select item
 185         # Nasty hack
 186         if {$newvalue == ""} {
 187                 set_data "" ""
 188         }
 189 }
 190
 191