| 1 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2 | # FILE : bcombobox.tcl |
|---|
| 3 | # PURPOSE : Bayes Combo Box. ComboBox con varias columnas aunque solamente una |
|---|
| 4 | # puede ser visible. |
|---|
| 5 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 6 | |
|---|
| 7 | package require byscommon |
|---|
| 8 | package require bfunctions |
|---|
| 9 | |
|---|
| 10 | |
|---|
| 11 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 12 | ::snit::widgetadaptor bcombobox { |
|---|
| 13 | # |
|---|
| 14 | # PURPOSE: Sobrecargamos un ComboBox para que tenga nuevas funcionalidades |
|---|
| 15 | # |
|---|
| 16 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 17 | # opciones especificas |
|---|
| 18 | # -values -> la lista de valores (con todos los campos) |
|---|
| 19 | # -cols -> lista de campos del combobox |
|---|
| 20 | # -viscol -> campo visible |
|---|
| 21 | # -empty -> indica si se introduce un elemento en blanco [flase|true] |
|---|
| 22 | # -keypress -> Activa la busqueda de filas mediante la pulsacion de teclas |
|---|
| 23 | # -colkeypress -> Indica por que columna se busca al pulsar una tecla |
|---|
| 24 | # |
|---|
| 25 | # variables |
|---|
| 26 | # afterTime -> tiempo desde que se pulso la ultima tecla |
|---|
| 27 | # listKey -> lista de teclas pulsadas |
|---|
| 28 | # entry -> componente entry del combobox |
|---|
| 29 | # listbox -> componente listbox del combobox |
|---|
| 30 | # button -> path del button del combobox |
|---|
| 31 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 32 | |
|---|
| 33 | option -values {} |
|---|
| 34 | option -cols {} |
|---|
| 35 | option -viscol {} |
|---|
| 36 | option -empty false |
|---|
| 37 | option -keypress true |
|---|
| 38 | option -colkeypress "" |
|---|
| 39 | |
|---|
| 40 | delegate option * to hull |
|---|
| 41 | delegate method * to hull |
|---|
| 42 | |
|---|
| 43 | variable listbox |
|---|
| 44 | |
|---|
| 45 | variable afterTime 0 |
|---|
| 46 | variable listKey "" |
|---|
| 47 | |
|---|
| 48 | |
|---|
| 49 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 50 | constructor { args } { |
|---|
| 51 | # |
|---|
| 52 | # PURPOSE: Constructor de un bcombobox. Crea una instancia de un ComboBox |
|---|
| 53 | # |
|---|
| 54 | # PARAMETERS: |
|---|
| 55 | # args -> Lista de opciones especificas de un ComboBox, mas las propias de |
|---|
| 56 | # un bcombobox |
|---|
| 57 | # |
|---|
| 58 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 59 | set values [from args -values ""] |
|---|
| 60 | set cols [from args -cols ""] |
|---|
| 61 | set viscol [from args -viscol ""] |
|---|
| 62 | set empty [from args -empty false] |
|---|
| 63 | set keypress [from args -keypress true] |
|---|
| 64 | |
|---|
| 65 | # Widget que va a servir de contenedor para blistbox |
|---|
| 66 | eval installhull using ComboBox $args |
|---|
| 67 | |
|---|
| 68 | # Apply all arguments given: |
|---|
| 69 | $self configurelist $args |
|---|
| 70 | $self configure -empty $empty |
|---|
| 71 | $self configure -cols $cols |
|---|
| 72 | $self configure -viscol $viscol |
|---|
| 73 | $self configure -values $values |
|---|
| 74 | $self configure -keypress $keypress |
|---|
| 75 | |
|---|
| 76 | # bind |
|---|
| 77 | set listbox [$hull getlistbox] |
|---|
| 78 | bind $listbox <KeyPress> +[list $self _OnKeyPress %A] |
|---|
| 79 | } |
|---|
| 80 | |
|---|
| 81 | |
|---|
| 82 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 83 | # |
|---|
| 84 | # Metodos cget y configure |
|---|
| 85 | # |
|---|
| 86 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 87 | |
|---|
| 88 | onconfigure -values { lst } { |
|---|
| 89 | if { $options(-empty) } { |
|---|
| 90 | set null {} |
|---|
| 91 | for {set i 0} {$i < [llength [lindex $lst 0]]} {incr i} { |
|---|
| 92 | lappend null {} |
|---|
| 93 | } |
|---|
| 94 | set lst [linsert $lst 0 $null] |
|---|
| 95 | } |
|---|
| 96 | set options(-values) $lst |
|---|
| 97 | |
|---|
| 98 | if { $options(-cols) eq "" } { |
|---|
| 99 | $hull configure -values $lst |
|---|
| 100 | } else { |
|---|
| 101 | set auxlst {} |
|---|
| 102 | if { $options(-viscol) eq "" } { |
|---|
| 103 | set inx 0 |
|---|
| 104 | } else { |
|---|
| 105 | set inx [lsearch $options(-cols) $options(-viscol)] |
|---|
| 106 | } |
|---|
| 107 | foreach i $options(-values) { |
|---|
| 108 | lappend auxlst [lindex $i $inx] |
|---|
| 109 | } |
|---|
| 110 | $hull configure -values $auxlst |
|---|
| 111 | } |
|---|
| 112 | } |
|---|
| 113 | |
|---|
| 114 | onconfigure -cols { cols } { |
|---|
| 115 | set options(-cols) $cols |
|---|
| 116 | set inx 0 |
|---|
| 117 | set auxlst {} |
|---|
| 118 | if { $options(-viscol) ne "" } { set inx [lsearch $cols $options(-viscol)] } |
|---|
| 119 | foreach i $options(-values) { |
|---|
| 120 | lappend auxlst [lindex $i $inx] |
|---|
| 121 | } |
|---|
| 122 | $hull configure -values $auxlst |
|---|
| 123 | } |
|---|
| 124 | |
|---|
| 125 | |
|---|
| 126 | |
|---|
| 127 | onconfigure -viscol { col } { |
|---|
| 128 | set options(-viscol) $col |
|---|
| 129 | |
|---|
| 130 | if { $options(-values) ne "" } { |
|---|
| 131 | set auxlst {} |
|---|
| 132 | if { $options(-viscol) eq "" } { |
|---|
| 133 | set inx 0 |
|---|
| 134 | } else { |
|---|
| 135 | set inx [lsearch $options(-cols) $options(-viscol)] |
|---|
| 136 | } |
|---|
| 137 | foreach i $options(-values) { |
|---|
| 138 | lappend auxlst [lindex $i $inx] |
|---|
| 139 | } |
|---|
| 140 | $hull configure -values $auxlst |
|---|
| 141 | } |
|---|
| 142 | } |
|---|
| 143 | |
|---|
| 144 | |
|---|
| 145 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 146 | method _OnKeyPress {key} { |
|---|
| 147 | # |
|---|
| 148 | # PURPOSE: Activa la fila que coincide con las teclas pulsadas. Distinge |
|---|
| 149 | # entre muysuculas y minusculas |
|---|
| 150 | # |
|---|
| 151 | # PARAMETERS: key -> tecla pulsada |
|---|
| 152 | # TODO: opciones de componente para un futuro |
|---|
| 153 | # - especificar el tiempo que espara entre pulsaciones |
|---|
| 154 | # - case sensotive |
|---|
| 155 | # |
|---|
| 156 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 157 | if {[$self cget -keypress]} { |
|---|
| 158 | set diference 500 |
|---|
| 159 | set result [lbOnKeyPress $listbox $key $listKey $afterTime $diference] |
|---|
| 160 | set listKey [lindex $result 0] |
|---|
| 161 | set afterTime [lindex $result 1] |
|---|
| 162 | } |
|---|
| 163 | } |
|---|
| 164 | |
|---|
| 165 | |
|---|
| 166 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 167 | method class { } { |
|---|
| 168 | # |
|---|
| 169 | # PURPOSE: Devuelve el tipo de clase |
|---|
| 170 | # |
|---|
| 171 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 172 | return "BComboBox" |
|---|
| 173 | } |
|---|
| 174 | |
|---|
| 175 | |
|---|
| 176 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 177 | method get { {cols ""} } { |
|---|
| 178 | # |
|---|
| 179 | # PURPOSE: Devuelve los campos pedidos del elemento seleccionado |
|---|
| 180 | # |
|---|
| 181 | # PARAMETERS: cols -> campos para los que se quiere devolver valores del |
|---|
| 182 | # elemento seleccionado, si no se especifica se |
|---|
| 183 | # devuelven todos |
|---|
| 184 | # |
|---|
| 185 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 186 | set data [lindex $options(-values) [$self getvalue]] |
|---|
| 187 | if { "" eq $cols } { return $data } |
|---|
| 188 | |
|---|
| 189 | set result {} |
|---|
| 190 | foreach col $cols { |
|---|
| 191 | set inx [lsearch $options(-cols) $col] |
|---|
| 192 | lappend result [lindex $data $inx] |
|---|
| 193 | } |
|---|
| 194 | return $result |
|---|
| 195 | } |
|---|
| 196 | |
|---|
| 197 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 198 | method list { command args } { |
|---|
| 199 | # |
|---|
| 200 | # PURPOSE: comando para el mantenimiento de la lista del combobox |
|---|
| 201 | # |
|---|
| 202 | # PARAMETERS: |
|---|
| 203 | # command [args]: |
|---|
| 204 | # get [<cols>]: devuelve la lista opcionalmente con solo los campos |
|---|
| 205 | # que se especifiquen |
|---|
| 206 | # set <list>: establece la lista |
|---|
| 207 | # clear: borra la lista |
|---|
| 208 | # size: devuelve la cantidad de elementos de la lista |
|---|
| 209 | # insert <pos> <lst>: inserta elementos (<lst>) en la |
|---|
| 210 | # lista en la posicion <pos> con informacion solamente para |
|---|
| 211 | # los campos <cols> si se especifican |
|---|
| 212 | # add <elems>: igual que insert pero siempre añade al final |
|---|
| 213 | # |
|---|
| 214 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 215 | switch -exact $command { |
|---|
| 216 | get { |
|---|
| 217 | if { [lindex $args 0] ne "" } { |
|---|
| 218 | set cols [lindex $args 0] |
|---|
| 219 | set result {} |
|---|
| 220 | |
|---|
| 221 | foreach elem $options(-values) { |
|---|
| 222 | set tmpelem {} |
|---|
| 223 | foreach col $cols { |
|---|
| 224 | lappend tmpelem [lindex $elem [lsearch $options(-cols) $col]] |
|---|
| 225 | } |
|---|
| 226 | lappend result $tmpelem |
|---|
| 227 | } |
|---|
| 228 | return $result |
|---|
| 229 | } else { |
|---|
| 230 | return $options(-values) |
|---|
| 231 | } |
|---|
| 232 | } |
|---|
| 233 | |
|---|
| 234 | set { |
|---|
| 235 | $self configure -values [lindex $args 0] |
|---|
| 236 | } |
|---|
| 237 | |
|---|
| 238 | clear { |
|---|
| 239 | $self configure -values {} |
|---|
| 240 | } |
|---|
| 241 | |
|---|
| 242 | size { |
|---|
| 243 | llength $options(-values) |
|---|
| 244 | } |
|---|
| 245 | |
|---|
| 246 | insert { |
|---|
| 247 | set lst $options(-values) |
|---|
| 248 | $self configure -values [linsert $lst [lindex $args 0] [lindex $args 1]] |
|---|
| 249 | } |
|---|
| 250 | |
|---|
| 251 | add { |
|---|
| 252 | set lst $options(-values) |
|---|
| 253 | $self configure -values [lappend lst [lindex $args 0]] |
|---|
| 254 | } |
|---|
| 255 | } |
|---|
| 256 | } |
|---|
| 257 | |
|---|
| 258 | } |
|---|
| 259 | |
|---|
| 260 | package provide bcombobox 1.0 |
|---|
| 261 | |
|---|
| 262 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 263 | proc test_bcombobox {} { |
|---|
| 264 | # |
|---|
| 265 | # PURPOSE: Funcion de test de un bcombobox |
|---|
| 266 | # |
|---|
| 267 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 268 | |
|---|
| 269 | # defining the widgets |
|---|
| 270 | set __cb1 0 |
|---|
| 271 | set __cb2 1 |
|---|
| 272 | |
|---|
| 273 | destroy .top |
|---|
| 274 | toplevel .top -width 200 -height 100 |
|---|
| 275 | |
|---|
| 276 | TitleFrame .top.tf1 -text "BComboBox test" |
|---|
| 277 | set f1 [.top.tf1 getframe] |
|---|
| 278 | bcombobox $f1.bcb |
|---|
| 279 | button $f1.b -text "Get values" -command "GetCmd" |
|---|
| 280 | LabelEntry $f1.le -label "Result" |
|---|
| 281 | |
|---|
| 282 | TitleFrame .top.tf2 -text "Configure" |
|---|
| 283 | set f2 [ .top.tf2 getframe ] |
|---|
| 284 | LabelEntry $f2.le1 -label "Visual Col" -text "col2" |
|---|
| 285 | LabelEntry $f2.le2 -label "Columns" -text {col1 col2 col3} |
|---|
| 286 | LabelEntry $f2.le3 -label "Values" -text {{1 2 3} {a b c} {@ # $} {i ii iii}} |
|---|
| 287 | checkbutton $f2.cb1 -text "Empty" -variable __cb1 \ |
|---|
| 288 | -command "EmpCmd" |
|---|
| 289 | checkbutton $f2.cb2 -text "Keypresses" -variable __cb2 \ |
|---|
| 290 | -command "KeyCmd" |
|---|
| 291 | $f2.cb1 deselect |
|---|
| 292 | $f2.cb2 select |
|---|
| 293 | button $f2.b1 -text "Configure" -command "CfgCmd" |
|---|
| 294 | |
|---|
| 295 | |
|---|
| 296 | # packing all |
|---|
| 297 | |
|---|
| 298 | grid .top.tf1 -row 0 -column 0 -sticky "news" -padx 10 -pady 10 |
|---|
| 299 | grid .top.tf2 -row 1 -column 0 -sticky "news" -padx 10 -pady 10 |
|---|
| 300 | grid rowconfigure .top 0 -weight 0 |
|---|
| 301 | grid rowconfigure .top 1 -weight 1 |
|---|
| 302 | grid columnconfigure .top 0 -weight 1 |
|---|
| 303 | |
|---|
| 304 | grid $f1.bcb -row 0 -column 0 -sticky ew |
|---|
| 305 | grid $f1.b -row 0 -column 1 -sticky ew |
|---|
| 306 | grid $f1.le -row 1 -column 0 -sticky ew -columnspan 2 |
|---|
| 307 | grid columnconfigure $f1 0 -weight 1 |
|---|
| 308 | grid columnconfigure $f1 1 -weight 0 |
|---|
| 309 | grid rowconfigure $f1 0 -weight 1 |
|---|
| 310 | grid rowconfigure $f1 1 -weight 1 |
|---|
| 311 | |
|---|
| 312 | grid $f2.le1 -row 0 -column 0 -sticky ew -padx 2 -pady 2 |
|---|
| 313 | grid $f2.le2 -row 1 -column 0 -sticky ew -padx 2 -pady 2 |
|---|
| 314 | grid $f2.le3 -row 2 -column 0 -sticky ew -padx 2 -pady 2 -columnspan 2 |
|---|
| 315 | grid $f2.cb1 -row 0 -column 1 -sticky w -padx 2 |
|---|
| 316 | grid $f2.cb2 -row 1 -column 1 -sticky w -padx 2 |
|---|
| 317 | grid $f2.b1 -row 3 -column 0 -sticky ew -padx 2 -pady 5 -columnspan 3 |
|---|
| 318 | grid columnconfigure $f2 0 -weight 1 |
|---|
| 319 | grid columnconfigure $f2 1 -weight 0 |
|---|
| 320 | grid rowconfigure $f2 0 -weight 0 |
|---|
| 321 | grid rowconfigure $f2 1 -weight 0 |
|---|
| 322 | grid rowconfigure $f2 2 -weight 0 |
|---|
| 323 | grid rowconfigure $f2 3 -weight 1 |
|---|
| 324 | |
|---|
| 325 | |
|---|
| 326 | # commands attached to the widgets |
|---|
| 327 | |
|---|
| 328 | proc CfgCmd { } { |
|---|
| 329 | .top.tf1.f.bcb configure -values [.top.tf2.f.le3 cget -text] |
|---|
| 330 | .top.tf1.f.bcb configure -cols [.top.tf2.f.le2 cget -text] |
|---|
| 331 | .top.tf1.f.bcb configure -viscol [.top.tf2.f.le1 cget -text] |
|---|
| 332 | } |
|---|
| 333 | |
|---|
| 334 | proc GetCmd { } { |
|---|
| 335 | .top.tf1.f.le configure -text [.top.tf1.f.bcb get] |
|---|
| 336 | } |
|---|
| 337 | |
|---|
| 338 | proc EmpCmd { } { |
|---|
| 339 | variable __cb1 |
|---|
| 340 | .top.tf1.f.bcb configure -empty $__cb1 |
|---|
| 341 | } |
|---|
| 342 | |
|---|
| 343 | proc KeyCmd { } { |
|---|
| 344 | variable __cb2 |
|---|
| 345 | .top.tf1.f.bcb configure -keypress $__cb2 |
|---|
| 346 | } |
|---|
| 347 | } |
|---|
