scripts/dropselect.itk

   1 package require Iwidgets
   2
   3 option add *Dropselect.highlightThickness       1               widgetDefault
   4 option add *Dropselect.borderWidth                      2               widgetDefault
   5 option add *Dropselect.labelPos                         w               widgetDefault
   6 option add *Dropselect.labelMargin                      2               widgetDefault
   7 option add *Dropselect.popupCursor                      arrow   widgetDefault
   8 option add *Dropselect.indicatoron                      1               widgetDefault
   9 option add *Dropselect.menuRelief                       raised  widgetDefault
  10 #option add *Dropselect.menuBorderWidth         2               widgetDefault
  11
  12
  13 ::itk::usual Dropselect {
  14         keep -background -font -cursor
  15 }
  16
  17
  18 class tlc::Dropselect {
  19         inherit ::iwidgets::Optionmenu
  20         #tlc::Stategate_target
  21
  22         constructor {args} {}
  23
  24         itk_option define -postcommand postCommand Command {}
  25         itk_option define -menuborderwidth menuBorderWidth BorderWidth 2
  26         itk_option define -pady padY PadY 4
  27
  28         public {
  29                 variable callback       ""
  30                 variable choices        {}
  31
  32                 method selectid {newitem}
  33                 method get_selected_id {}
  34         }
  35
  36         private {
  37                 variable idmap
  38                 variable selected       ""
  39                 variable lock           0
  40
  41                 method newitem
  42         }
  43 }
  44
  45
  46 configbody tlc::Dropselect::postcommand {
  47         set m   [component popupMenu]
  48         $m configure -postcommand $itk_option(-postcommand)
  49 }
  50
  51
  52 configbody tlc::Dropselect::menuborderwidth {
  53         $itk_component(menuBtn) configure \
  54                 -borderwidth $itk_option(-menuborderwidth)
  55 }
  56
  57
  58 configbody tlc::Dropselect::pady {
  59         $itk_component(menuBtn) configure \
  60                 -pady $itk_option(-pady)
  61 }
  62
  63
  64 body tlc::Dropselect::constructor {args} {
  65         configure -command [code $this newitem]
  66
  67         eval itk_initialize $args
  68 }
  69
  70
  71 configbody tlc::Dropselect::callback {
  72         newitem
  73 }
  74
  75
  76 configbody tlc::Dropselect::choices {
  77         set lock        1
  78         catch {unset idmap}
  79
  80         set idx 0
  81         set ids         {}
  82         set values      {}
  83         foreach choice $choices {
  84                 set id          [lindex $choice 0]
  85                 set text        [lindex $choice 1]
  86
  87                 lappend ids             $id
  88                 lappend values  $text
  89
  90                 set idmap($id)  $idx
  91                 incr idx
  92         }
  93         delete 0 end
  94         if {[llength $values] > 0} {
  95                 eval insert 0 $values
  96         }
  97         if {$selected == ""} {
  98                 select 0
  99         } else {
 100 #               set selectedindex       [lsearch -exact $choices $selected]
 101                 if {![info exists idmap($selected)]} {
 102                         set selectedindex       0
 103                 } else {
 104                         set selectedindex       $idmap($selected)
 105                 }
 106                 select $selectedindex
 107         }
 108         set lock        0
 109         newitem
 110 }
 111
 112
 113 proc tlc::dropselect {pathName args} {
 114         uplevel tlc::Dropselect $pathName $args
 115 }
 116
 117
 118 body tlc::Dropselect::newitem {} {
 119         if {$lock} return
 120         set selid       [get_selected_id]
 121
 122         set selected    $selid
 123
 124         if {$callback != ""} {
 125                 uplevel #0 $callback [list $selid]
 126         }
 127 }
 128
 129
 130 body tlc::Dropselect::selectid {newitem} {
 131 #       set index       [lsearch -exact $choices $newitem]
 132         if {![info exists idmap($newitem)]} {
 133                 return -1
 134         }
 135         set index       $idmap($newitem)
 136         if {$index == -1} {return $index}
 137
 138         select $index
 139
 140         return $index
 141 }
 142
 143
 144 body tlc::Dropselect::get_selected_id {} {
 145         return  [lindex [lindex $choices [index select]] 0]
 146 }
 147
 148