| 1 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2 | # FILE : bmultiselec.tcl |
|---|
| 3 | # PURPOSE : Component for creating a multiple selector of items and |
|---|
| 4 | # managing its events. A multiple selector consist of two listboxes: |
|---|
| 5 | # unselected (left) and selected (right) with items which you can |
|---|
| 6 | # move from one listbox to the other. |
|---|
| 7 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 8 | |
|---|
| 9 | package require byscommon |
|---|
| 10 | package require blistbox |
|---|
| 11 | package require blistboxplus |
|---|
| 12 | |
|---|
| 13 | |
|---|
| 14 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 15 | ::snit::widget bmultiselect { |
|---|
| 16 | # |
|---|
| 17 | # PURPOSE: Selector de elementos multiple |
|---|
| 18 | # |
|---|
| 19 | # opciones especificas |
|---|
| 20 | # unsel -> valores no seleccionados |
|---|
| 21 | # sel -> valores seleccionados |
|---|
| 22 | # labelsel -> etiqueta para la lista de elementos seleccionados |
|---|
| 23 | # labelunsel -> etiqueta para la lista de elementos no seleccionados |
|---|
| 24 | # font -> font for the both listboxes |
|---|
| 25 | # onchanged -> comando a ejecutar cada vez que cambia algo en las listas |
|---|
| 26 | # unique -> si esta a true solamente se permite pasar un elemento a la lista |
|---|
| 27 | # de seleccionados |
|---|
| 28 | # cols -> lista con las columnas de cada ListBox |
|---|
| 29 | # hiddencols -> aquellas columnas del ListBox que queremos mantener ocultas |
|---|
| 30 | # width -> ancho total orientativo del widget |
|---|
| 31 | # height -> alto total orientativo del widget |
|---|
| 32 | # initialdir -> directory where to go when opening a save dialog |
|---|
| 33 | # |
|---|
| 34 | # variables |
|---|
| 35 | # lright -> the right label |
|---|
| 36 | # lleft -> the left label |
|---|
| 37 | # right -> the right blistbox or blistcontrol |
|---|
| 38 | # left -> the left blistbox or blistcontrol |
|---|
| 39 | # bbox -> the buttonbox |
|---|
| 40 | # plus -> indicates if the listbox is listbox+ (columns) |
|---|
| 41 | # created -> indicates if the widget has been fully created |
|---|
| 42 | # |
|---|
| 43 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 44 | widgetclass Bmultiselect |
|---|
| 45 | |
|---|
| 46 | option -sel {} |
|---|
| 47 | option -unsel {} |
|---|
| 48 | option -labelsel "Selected" |
|---|
| 49 | option -labelunsel "Not Selected" |
|---|
| 50 | option -font {arial 10} |
|---|
| 51 | option -onchanged "" |
|---|
| 52 | option -unique false |
|---|
| 53 | option -width {} |
|---|
| 54 | option -height {} |
|---|
| 55 | option -cols {} |
|---|
| 56 | option -hiddencols {} |
|---|
| 57 | option -initialdir "" |
|---|
| 58 | |
|---|
| 59 | variable lright |
|---|
| 60 | variable lleft |
|---|
| 61 | variable right |
|---|
| 62 | variable left |
|---|
| 63 | variable bbox |
|---|
| 64 | variable bboxright |
|---|
| 65 | |
|---|
| 66 | variable created 0 |
|---|
| 67 | variable plus 0 |
|---|
| 68 | |
|---|
| 69 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 70 | constructor { args } { |
|---|
| 71 | # |
|---|
| 72 | # PURPOSE: Constructor de un bmultiselect. Crea una instancia de un selector |
|---|
| 73 | # multiple |
|---|
| 74 | # |
|---|
| 75 | # PARAMETERS: |
|---|
| 76 | # args -> Lista de opciones para el bmultiselect |
|---|
| 77 | # |
|---|
| 78 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 79 | $self configure -cols [from args -cols ""] |
|---|
| 80 | $self configure -sel [from args -sel ""] |
|---|
| 81 | $self configure -unsel [from args -unsel ""] |
|---|
| 82 | $self configure -unique [from args -unique 0] |
|---|
| 83 | |
|---|
| 84 | # Create the widget |
|---|
| 85 | $self createwidget $args |
|---|
| 86 | |
|---|
| 87 | # Apply all arguments given: |
|---|
| 88 | $self configurelist $args |
|---|
| 89 | } |
|---|
| 90 | |
|---|
| 91 | |
|---|
| 92 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 93 | # |
|---|
| 94 | # PURPOSE: Metodos cget y configure |
|---|
| 95 | # |
|---|
| 96 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 97 | |
|---|
| 98 | onconfigure -sel { lst } { |
|---|
| 99 | set options(-sel) $lst |
|---|
| 100 | if { $created } { |
|---|
| 101 | $self _FillLB |
|---|
| 102 | } |
|---|
| 103 | } |
|---|
| 104 | |
|---|
| 105 | onconfigure -unsel { lst } { |
|---|
| 106 | set options(-unsel) $lst |
|---|
| 107 | if { $created } { |
|---|
| 108 | $self _FillLB |
|---|
| 109 | } |
|---|
| 110 | } |
|---|
| 111 | |
|---|
| 112 | onconfigure -labelsel { value } { |
|---|
| 113 | if { $created } { |
|---|
| 114 | set options(-labelsel) $value |
|---|
| 115 | $lright configure -text $value |
|---|
| 116 | } |
|---|
| 117 | } |
|---|
| 118 | |
|---|
| 119 | onconfigure -labelunsel { value } { |
|---|
| 120 | if { $created } { |
|---|
| 121 | set options(-labelunsel) $value |
|---|
| 122 | $lleft configure -text $value |
|---|
| 123 | } |
|---|
| 124 | } |
|---|
| 125 | |
|---|
| 126 | onconfigure -cols { value } { |
|---|
| 127 | set options(-cols) $value |
|---|
| 128 | set plus [llength $options(-cols)] |
|---|
| 129 | if { $created && $plus } { |
|---|
| 130 | $right configure -cols $value |
|---|
| 131 | $left configure -cols $value |
|---|
| 132 | } |
|---|
| 133 | } |
|---|
| 134 | |
|---|
| 135 | onconfigure -hiddencols { value } { |
|---|
| 136 | set options(-hiddencols) $value |
|---|
| 137 | set plus [llength $options(-cols)] |
|---|
| 138 | if { $created && $plus } { |
|---|
| 139 | $right configure -hiddencols $value |
|---|
| 140 | $left configure -hiddencols $value |
|---|
| 141 | } |
|---|
| 142 | } |
|---|
| 143 | |
|---|
| 144 | onconfigure -width { value } { |
|---|
| 145 | set options(-width) $value |
|---|
| 146 | if { ! $plus } { |
|---|
| 147 | set value [expr $value / 2] |
|---|
| 148 | } |
|---|
| 149 | if { $created } { |
|---|
| 150 | $left configure -width $value |
|---|
| 151 | $right configure -width $value |
|---|
| 152 | } |
|---|
| 153 | } |
|---|
| 154 | |
|---|
| 155 | onconfigure -height { value } { |
|---|
| 156 | set options(-height) $value |
|---|
| 157 | if { ! $plus } { |
|---|
| 158 | set value [expr $value / 2] |
|---|
| 159 | } |
|---|
| 160 | if { $created } { |
|---|
| 161 | $left configure -height $value |
|---|
| 162 | $right configure -height $value |
|---|
| 163 | } |
|---|
| 164 | } |
|---|
| 165 | |
|---|
| 166 | onconfigure -initialdir { value } { |
|---|
| 167 | set options(-initialdir) $value |
|---|
| 168 | if { $created && $plus } { |
|---|
| 169 | $left configure -initialdir $options(-initialdir) |
|---|
| 170 | $right configure -initialdir $options(-initialdir) |
|---|
| 171 | } |
|---|
| 172 | } |
|---|
| 173 | |
|---|
| 174 | onconfigure -font { f } { |
|---|
| 175 | set options(-font) $f |
|---|
| 176 | if { $created } { |
|---|
| 177 | $left configure -font $f |
|---|
| 178 | $right configure -font $f |
|---|
| 179 | } |
|---|
| 180 | } |
|---|
| 181 | |
|---|
| 182 | |
|---|
| 183 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 184 | method createwidget { args } { |
|---|
| 185 | # |
|---|
| 186 | # PURPOSE: Creacion de los objetos que componen el widget |
|---|
| 187 | # |
|---|
| 188 | # PARAMETERS: |
|---|
| 189 | # args -> Lista de opciones para el bmultiselect |
|---|
| 190 | # |
|---|
| 191 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 192 | set labelunsel [from args -labelunsel [mc "Not Selected"]] |
|---|
| 193 | set labelsel [from args -labelsel [mc "Selected"]] |
|---|
| 194 | set cols [from args -cols ""] |
|---|
| 195 | set initialdir [from args -initialdir ""] |
|---|
| 196 | |
|---|
| 197 | # listbox 1 |
|---|
| 198 | install lleft using label $self.l1 -text $labelunsel -bd 1 -relief raised |
|---|
| 199 | if { ! $plus } { |
|---|
| 200 | ScrolledWindow $self.sw1 |
|---|
| 201 | install left using blistbox $self.sw1.lb -selectmode extended \ |
|---|
| 202 | -breadonly true -bkeypress true -bparent $self |
|---|
| 203 | $self.sw1 setwidget $self.sw1.lb |
|---|
| 204 | bind $left <Button-1> +[list focus -force %W] |
|---|
| 205 | bind $left <Double-Button-1> +[list $self _LBLeftToRight] |
|---|
| 206 | } else { |
|---|
| 207 | install left using blistboxplus $self.lbl -cols $options(-cols) \ |
|---|
| 208 | -hiddencols $options(-hiddencols) -initialdir $initialdir -readonly true |
|---|
| 209 | if { $options(-unique) } { |
|---|
| 210 | $left configure -selectmode single |
|---|
| 211 | } else { |
|---|
| 212 | $left configure -selectmode multiple |
|---|
| 213 | } |
|---|
| 214 | $left bind all <Double-Button-1> +[list $self _LBLeftToRight] |
|---|
| 215 | } |
|---|
| 216 | |
|---|
| 217 | # buttons |
|---|
| 218 | install bbox using ButtonBox $self.bb -orient vertical -spacing 0 \ |
|---|
| 219 | -padx 4 -pady 1 |
|---|
| 220 | $bbox add -image [Bitmap::get play] -height 16 -width 16 \ |
|---|
| 221 | -command [list $self _LBLeftToRight] -relief link \ |
|---|
| 222 | -helptext [mc "Moves selection from left to right"] |
|---|
| 223 | $bbox add -image [Bitmap::get reverse] -height 16 -width 16 \ |
|---|
| 224 | -command [list $self _LBRightToLeft] -relief link \ |
|---|
| 225 | -helptext [mc "Moves selection from right to left"] |
|---|
| 226 | if { ! $options(-unique) } { |
|---|
| 227 | $bbox add -image [Bitmap::get end] -height 16 -width 16 \ |
|---|
| 228 | -command [list $self _LBAllLeftToRight] -relief link \ |
|---|
| 229 | -helptext [mc "Moves all from left to right"] |
|---|
| 230 | $bbox add -image [Bitmap::get begin] -height 16 -width 16 \ |
|---|
| 231 | -command [list $self _LBAllRightToLeft] -relief link \ |
|---|
| 232 | -helptext [mc "Moves all from right to left"] |
|---|
| 233 | } |
|---|
| 234 | |
|---|
| 235 | |
|---|
| 236 | install bboxright using ButtonBox $self.bbr -orient vertical -spacing 0 \ |
|---|
| 237 | -padx 4 -pady 1 |
|---|
| 238 | $bboxright add -image [Bitmap::get upNext] -height 16 -width 16 \ |
|---|
| 239 | -command [list $self _LBDownToUp] -relief link \ |
|---|
| 240 | -helptext [mc "Moves selection up"] |
|---|
| 241 | $bboxright add -image [Bitmap::get downNext] -height 16 -width 16 \ |
|---|
| 242 | -command [list $self _LBUpToDown] -relief link \ |
|---|
| 243 | -helptext [mc "Moves selection down"] |
|---|
| 244 | |
|---|
| 245 | |
|---|
| 246 | # listbox 2 |
|---|
| 247 | install lright using label $self.l2 -text $labelsel -bd 1 -relief raised |
|---|
| 248 | if { ! $plus } { |
|---|
| 249 | ScrolledWindow $self.sw2 |
|---|
| 250 | install right using blistbox $self.sw2.lb -selectmode extended \ |
|---|
| 251 | -breadonly true -bkeypress true -bparent $self |
|---|
| 252 | $self.sw2 setwidget $self.sw2.lb |
|---|
| 253 | bind $right <Button-1> +[list focus -force %W] |
|---|
| 254 | bind $right <Double-Button-1> +[list $self _LBRightToLeft] |
|---|
| 255 | } else { |
|---|
| 256 | install right using blistboxplus $self.lbr -cols $options(-cols) \ |
|---|
| 257 | -initialdir $initialdir -readonly true |
|---|
| 258 | if { $options(-unique) } { |
|---|
| 259 | $right configure -selectmode single |
|---|
| 260 | } else { |
|---|
| 261 | $right configure -selectmode multiple |
|---|
| 262 | } |
|---|
| 263 | $right bind all <Double-Button-1> +[list $self _LBRightToLeft] |
|---|
| 264 | } |
|---|
| 265 | |
|---|
| 266 | # fill the listbox |
|---|
| 267 | $self _FillLB |
|---|
| 268 | |
|---|
| 269 | grid $self.l1 $bbox $self.l2 $bboxright -sticky news |
|---|
| 270 | if { ! $plus } { |
|---|
| 271 | grid $self.sw1 ^ $self.sw2 ^ -sticky news |
|---|
| 272 | } else { |
|---|
| 273 | grid $left ^ $right ^ -sticky news |
|---|
| 274 | } |
|---|
| 275 | grid rowconfigure $self 1 -weight 1 |
|---|
| 276 | grid columnconfigure $self 0 -weight 1 |
|---|
| 277 | grid columnconfigure $self 1 -pad 5 |
|---|
| 278 | grid columnconfigure $self 2 -weight 1 |
|---|
| 279 | grid columnconfigure $self 3 -pad 5 |
|---|
| 280 | update |
|---|
| 281 | bind <Destroy> $self [list $self KillData] |
|---|
| 282 | |
|---|
| 283 | set created 1 |
|---|
| 284 | |
|---|
| 285 | return $self |
|---|
| 286 | } |
|---|
| 287 | |
|---|
| 288 | |
|---|
| 289 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 290 | method _EvalOnChanged {} { |
|---|
| 291 | # |
|---|
| 292 | # PURPOSE: Evaluates a procedure when any of the listboxes changes any of |
|---|
| 293 | # its items and actualizes the -sel and -unsel options. |
|---|
| 294 | # |
|---|
| 295 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 296 | |
|---|
| 297 | set options(-unsel) [$left get 0 end] |
|---|
| 298 | set options(-sel) [$right get 0 end] |
|---|
| 299 | |
|---|
| 300 | if { [string length $options(-onchanged)] } { |
|---|
| 301 | eval $options(-onchanged) |
|---|
| 302 | } |
|---|
| 303 | } |
|---|
| 304 | |
|---|
| 305 | |
|---|
| 306 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 307 | method _FillLB {} { |
|---|
| 308 | # |
|---|
| 309 | # PURPOSE: Fill unselected and selected listboxes. |
|---|
| 310 | # |
|---|
| 311 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 312 | |
|---|
| 313 | if { "" eq $options(-cols) } { |
|---|
| 314 | $left delete 0 end |
|---|
| 315 | $right delete 0 end |
|---|
| 316 | } else { |
|---|
| 317 | $left clear |
|---|
| 318 | $right clear |
|---|
| 319 | } |
|---|
| 320 | |
|---|
| 321 | foreach it $options(-unsel) { |
|---|
| 322 | $left insert end $it |
|---|
| 323 | } |
|---|
| 324 | foreach it $options(-sel) { |
|---|
| 325 | |
|---|
| 326 | $right insert end $it |
|---|
| 327 | if { $options(-unique) } { break } |
|---|
| 328 | } |
|---|
| 329 | $self _EvalOnChanged |
|---|
| 330 | } |
|---|
| 331 | |
|---|
| 332 | |
|---|
| 333 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 334 | method _ListTransferSel { src dst } { |
|---|
| 335 | # |
|---|
| 336 | # PURPOSE: Transfer selected items from scr listbox to dst listbox. |
|---|
| 337 | # |
|---|
| 338 | # PARAMETERS: |
|---|
| 339 | # src -> source listbox path |
|---|
| 340 | # dst -> destination listbox path |
|---|
| 341 | # |
|---|
| 342 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 343 | |
|---|
| 344 | if { "$dst" eq "$right" && $options(-unique) } { |
|---|
| 345 | if { [$right size] eq 0 } { |
|---|
| 346 | if { "" ne [$src curselection] } { |
|---|
| 347 | switch [llength $options(-cols)] { |
|---|
| 348 | 1 { |
|---|
| 349 | eval $dst insert end [$src get [lindex [$src curselection] 0]] |
|---|
| 350 | } |
|---|
| 351 | default { |
|---|
| 352 | $dst insert end [$src get [lindex [$src curselection] 0]] |
|---|
| 353 | } |
|---|
| 354 | } |
|---|
| 355 | } |
|---|
| 356 | } else { |
|---|
| 357 | if { $plus } { |
|---|
| 358 | $src selection clearall |
|---|
| 359 | } else { |
|---|
| 360 | $src select clear 0 end |
|---|
| 361 | } |
|---|
| 362 | } |
|---|
| 363 | } else { |
|---|
| 364 | foreach i [$src curselection] { |
|---|
| 365 | switch [llength $options(-cols)] { |
|---|
| 366 | 1 { eval $dst insert end [$src get $i] } |
|---|
| 367 | default { $dst insert end [$src get $i] } |
|---|
| 368 | } |
|---|
| 369 | } |
|---|
| 370 | } |
|---|
| 371 | } |
|---|
| 372 | |
|---|
| 373 | |
|---|
| 374 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 375 | method _ListDeleteSel { w } { |
|---|
| 376 | # |
|---|
| 377 | # PURPOSE: Deletes selected items of a listbox |
|---|
| 378 | # |
|---|
| 379 | # PARAMETERS: |
|---|
| 380 | # w -> listbox's path |
|---|
| 381 | # |
|---|
| 382 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 383 | |
|---|
| 384 | if { "$w" eq "$left" && $options(-unique) } { |
|---|
| 385 | set index [lindex [$w curselection] 0] |
|---|
| 386 | if { $index >= 0 } { $w delete $index } |
|---|
| 387 | } else { |
|---|
| 388 | foreach i [lsort -integer -decreasing [$w curselection]] { |
|---|
| 389 | $w delete $i |
|---|
| 390 | } |
|---|
| 391 | } |
|---|
| 392 | } |
|---|
| 393 | |
|---|
| 394 | |
|---|
| 395 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 396 | method _LBLeftToRight {} { |
|---|
| 397 | # |
|---|
| 398 | # PURPOSE: Moves selected items from unselected listbox to selected listbox |
|---|
| 399 | # |
|---|
| 400 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 401 | $self _ListTransferSel $left $right |
|---|
| 402 | $self _ListDeleteSel $left |
|---|
| 403 | $self _EvalOnChanged |
|---|
| 404 | } |
|---|
| 405 | |
|---|
| 406 | |
|---|
| 407 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 408 | method _LBRightToLeft {} { |
|---|
| 409 | # |
|---|
| 410 | # PURPOSE: Moves selected items from selectedu listbox to unselected listbox |
|---|
| 411 | # |
|---|
| 412 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 413 | $self _ListTransferSel $right $left |
|---|
| 414 | $self _ListDeleteSel $right |
|---|
| 415 | $self _EvalOnChanged |
|---|
| 416 | } |
|---|
| 417 | |
|---|
| 418 | |
|---|
| 419 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 420 | method _LBAllLeftToRight {} { |
|---|
| 421 | # |
|---|
| 422 | # PURPOSE: Moves all items from unselected listbox to selected listbox |
|---|
| 423 | # |
|---|
| 424 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 425 | if { $plus } { |
|---|
| 426 | foreach i [$left get] { |
|---|
| 427 | switch [llength $options(-cols)] { |
|---|
| 428 | 1 { eval $right add [$left get $i] } |
|---|
| 429 | default { $right add [$left get $i] } |
|---|
| 430 | } |
|---|
| 431 | $left delete $i |
|---|
| 432 | } |
|---|
| 433 | } else { |
|---|
| 434 | eval $right insert end [$left get 0 end] |
|---|
| 435 | $left delete 0 end |
|---|
| 436 | } |
|---|
| 437 | $self _EvalOnChanged |
|---|
| 438 | } |
|---|
| 439 | |
|---|
| 440 | |
|---|
| 441 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 442 | method _LBAllRightToLeft {} { |
|---|
| 443 | # |
|---|
| 444 | # PURPOSE: Moves all items from selected listbox to unselected listbox |
|---|
| 445 | # |
|---|
| 446 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 447 | if { $plus } { |
|---|
| 448 | foreach i [$right get] { |
|---|
| 449 | switch [llength $options(-cols)] { |
|---|
| 450 | 1 { eval $left add [$right get $i] } |
|---|
| 451 | default { $left add [$right get $i] } |
|---|
| 452 | } |
|---|
| 453 | $right delete $i |
|---|
| 454 | } |
|---|
| 455 | } else { |
|---|
| 456 | eval $left insert end [$right get 0 end] |
|---|
| 457 | $right delete 0 end |
|---|
| 458 | } |
|---|
| 459 | $self _EvalOnChanged |
|---|
| 460 | } |
|---|
| 461 | |
|---|
| 462 | |
|---|
| 463 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 464 | method _LBDownToUp {} { |
|---|
| 465 | # |
|---|
| 466 | # PURPOSE: Moves selected items in listbox on the right side up |
|---|
| 467 | # |
|---|
| 468 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 469 | set indexes [$right curselection] |
|---|
| 470 | if {$indexes != ""} { |
|---|
| 471 | set first [lindex $indexes 0] |
|---|
| 472 | set last [lindex $indexes end] |
|---|
| 473 | if { $plus } { |
|---|
| 474 | # hacia arriba |
|---|
| 475 | if {$first eq [$right item firstchild root]} return |
|---|
| 476 | foreach index $indexes { |
|---|
| 477 | $right move $index before {} |
|---|
| 478 | } |
|---|
| 479 | #@+ set start [$right first] |
|---|
| 480 | #@+ if { $first != $start } { |
|---|
| 481 | #@+ $right move [lindex [$right range [$right first] $first] end-1] after $last |
|---|
| 482 | #@+ $right selection clearall |
|---|
| 483 | #@+ $right selection set $first $last |
|---|
| 484 | #@+ } |
|---|
| 485 | } else { |
|---|
| 486 | if { $first != 0 } { |
|---|
| 487 | set previous [$right get [expr {$first-1}]] |
|---|
| 488 | $right delete [expr {$first-1}] |
|---|
| 489 | $right insert $last $previous |
|---|
| 490 | } |
|---|
| 491 | } |
|---|
| 492 | } |
|---|
| 493 | } |
|---|
| 494 | |
|---|
| 495 | |
|---|
| 496 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 497 | method _LBUpToDown {} { |
|---|
| 498 | # |
|---|
| 499 | # PURPOSE: Moves selected items in listbox on the right side down |
|---|
| 500 | # |
|---|
| 501 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 502 | set indexes [$right curselection] |
|---|
| 503 | if {$indexes != ""} { |
|---|
| 504 | set first [lindex $indexes 0] |
|---|
| 505 | set last [lindex $indexes end] |
|---|
| 506 | if { $plus } { |
|---|
| 507 | # hacia abajo |
|---|
| 508 | if {$last eq [$right item lastchild root]} return |
|---|
| 509 | foreach index [lreverse $indexes] { |
|---|
| 510 | $right move $index after {} |
|---|
| 511 | } |
|---|
| 512 | #@+ set end [$right last] |
|---|
| 513 | #@+ if { $last != $end } { |
|---|
| 514 | #@+ $right move [lindex [$right find $last] 1] before $first |
|---|
| 515 | #@+ $right selection clearall |
|---|
| 516 | #@+ $right selection set $first $last |
|---|
| 517 | #@+ } |
|---|
| 518 | } else { |
|---|
| 519 | set end [$right index end] |
|---|
| 520 | if { $last != [expr {$end-1}] } { |
|---|
| 521 | set next [$right get [expr {$last+1}]] |
|---|
| 522 | $right delete [expr {$last+1}] |
|---|
| 523 | $right insert $first $next |
|---|
| 524 | } |
|---|
| 525 | } |
|---|
| 526 | } |
|---|
| 527 | } |
|---|
| 528 | |
|---|
| 529 | |
|---|
| 530 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 531 | method get { {sel "selected"} } { |
|---|
| 532 | # |
|---|
| 533 | # PURPOSE: gets items selected or unselected |
|---|
| 534 | # |
|---|
| 535 | # PARAMETERS: |
|---|
| 536 | # sel: selected or unselected, indicates which ones to return |
|---|
| 537 | # |
|---|
| 538 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 539 | if { $sel eq "selected" } { |
|---|
| 540 | if { $plus } { |
|---|
| 541 | set result {} |
|---|
| 542 | foreach i [$right get] { |
|---|
| 543 | switch [llength $options(-cols)] { |
|---|
| 544 | 1 { lappend result [lindex [$right get $i] 0] } |
|---|
| 545 | default { lappend result [$right get $i] } |
|---|
| 546 | } |
|---|
| 547 | } |
|---|
| 548 | return $result |
|---|
| 549 | } else { |
|---|
| 550 | return [$right get 0 end] |
|---|
| 551 | } |
|---|
| 552 | } |
|---|
| 553 | |
|---|
| 554 | if { $sel eq "unselected" } { |
|---|
| 555 | if { $plus } { |
|---|
| 556 | set result {} |
|---|
| 557 | foreach i [$left get] { |
|---|
| 558 | switch [llength $options(-cols)] { |
|---|
| 559 | 1 { lappend result [lindex [$left get $i] 0] } |
|---|
| 560 | default { lappend result [$left get $i] } |
|---|
| 561 | } |
|---|
| 562 | } |
|---|
| 563 | return $result |
|---|
| 564 | } else { |
|---|
| 565 | return [$left get 0 end] |
|---|
| 566 | } |
|---|
| 567 | } |
|---|
| 568 | } |
|---|
| 569 | |
|---|
| 570 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 571 | method GetSelected {} { |
|---|
| 572 | # |
|---|
| 573 | # PURPOSE: Gets item from selected listbox (rigth) |
|---|
| 574 | # |
|---|
| 575 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 576 | puts "This function is deprecated use get selected instead" |
|---|
| 577 | $self get selected |
|---|
| 578 | } |
|---|
| 579 | |
|---|
| 580 | |
|---|
| 581 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 582 | method GetUnselected {} { |
|---|
| 583 | # |
|---|
| 584 | # PURPOSE: Gets item from unselected listbox (left) |
|---|
| 585 | # |
|---|
| 586 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 587 | puts "This function is deprecated use get unselected instead" |
|---|
| 588 | $self get unselected |
|---|
| 589 | } |
|---|
| 590 | } |
|---|
| 591 | |
|---|
| 592 | |
|---|
| 593 | # TEST CODE |
|---|
| 594 | |
|---|
| 595 | |
|---|
| 596 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 597 | proc closeBmultiselectDialog { w } { |
|---|
| 598 | # |
|---|
| 599 | # PURPOSE: closes the dialog and returns the result |
|---|
| 600 | # |
|---|
| 601 | # PARAMETERS: |
|---|
| 602 | # w -> The dialog's window pathname |
|---|
| 603 | # |
|---|
| 604 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 605 | set f [$w getframe] |
|---|
| 606 | set result [$f.bms get selected] |
|---|
| 607 | $w enddialog $result |
|---|
| 608 | } |
|---|
| 609 | |
|---|
| 610 | |
|---|
| 611 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 612 | proc launchDialog { unique multicolumn le } { |
|---|
| 613 | # |
|---|
| 614 | # PURPOSE: Launches a Dialog with a bmultiselect widget |
|---|
| 615 | # |
|---|
| 616 | # PARAMETERS: |
|---|
| 617 | # w -> The dialog's window pathname |
|---|
| 618 | # unique -> This option tells the bmultiselect widget if it will admit only |
|---|
| 619 | # one selected item |
|---|
| 620 | # |
|---|
| 621 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 622 | |
|---|
| 623 | # example of how to use in a dialog |
|---|
| 624 | destroy .top.d |
|---|
| 625 | set dialog [Dialog .top.d -title "Prueba de BMultiSelect" \ |
|---|
| 626 | -modal local -parent .top] |
|---|
| 627 | set dialogframe [$dialog getframe] |
|---|
| 628 | |
|---|
| 629 | if { $multicolumn } { |
|---|
| 630 | bmultiselect $dialogframe.bms -cols {una dos tres} -unique $unique \ |
|---|
| 631 | -unsel { {un dos tres} {i ii iii} {x y z} {@ # &} } \ |
|---|
| 632 | -sel { {one two three} {a b c} {k kk kkk} } \ |
|---|
| 633 | -labelunsel "no seleccionados" -labelsel "seleccionados" \ |
|---|
| 634 | -height 200 |
|---|
| 635 | } else { |
|---|
| 636 | bmultiselect $dialogframe.bms -unsel {uno 2 tres 4} -sel {cinco 5 siete} \ |
|---|
| 637 | -labelunsel "no seleccionados" -labelsel "seleccionados" -unique $unique |
|---|
| 638 | } |
|---|
| 639 | |
|---|
| 640 | set dialogframe_bbox \ |
|---|
| 641 | [ButtonBox $dialogframe.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \ |
|---|
| 642 | -homogeneous false] |
|---|
| 643 | $dialogframe_bbox add -text [mc "Accept"] -relief link \ |
|---|
| 644 | -helptext [mc "Accept selection"] \ |
|---|
| 645 | -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \ |
|---|
| 646 | -command [list closeBmultiselectDialog $dialog] |
|---|
| 647 | $dialogframe_bbox add -text [mc "Cancel"] -relief link \ |
|---|
| 648 | -helptext [mc "Cancel selection"]\ |
|---|
| 649 | -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \ |
|---|
| 650 | -command [list $dialog enddialog ""] |
|---|
| 651 | |
|---|
| 652 | pack $dialogframe_bbox -fill x -expand false -side bottom |
|---|
| 653 | pack $dialogframe.bms -fill both -expand true |
|---|
| 654 | |
|---|
| 655 | set result [$dialog draw] |
|---|
| 656 | $le configure -text $result |
|---|
| 657 | } |
|---|
| 658 | |
|---|
| 659 | |
|---|
| 660 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 661 | proc test_bmultiselect {} { |
|---|
| 662 | # |
|---|
| 663 | # PURPOSE: Test function of a bmultiselect |
|---|
| 664 | # |
|---|
| 665 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 666 | destroy .top |
|---|
| 667 | toplevel .top |
|---|
| 668 | variable multcols 0 |
|---|
| 669 | variable uniq 0 |
|---|
| 670 | |
|---|
| 671 | radiobutton .top.rb1 -text "Multiple columns" -value 1 -variable multcols |
|---|
| 672 | radiobutton .top.rb2 -text "Only one column" -value 0 -variable multcols |
|---|
| 673 | checkbutton .top.cb -text "Only one selected" -command toggleuniq |
|---|
| 674 | .top.cb deselect |
|---|
| 675 | button .top.b -text "Launch a MultiSelect Dialog" -command "preLaunchDialog" |
|---|
| 676 | LabelEntry .top.le -label Result |
|---|
| 677 | |
|---|
| 678 | |
|---|
| 679 | grid .top.rb1 -row 0 -column 0 |
|---|
| 680 | grid .top.rb2 -row 1 -column 0 |
|---|
| 681 | grid .top.cb -row 0 -column 1 |
|---|
| 682 | grid .top.b -row 1 -column 1 |
|---|
| 683 | grid .top.le -row 2 -column 0 -columnspan 2 -sticky "ew" |
|---|
| 684 | |
|---|
| 685 | proc toggleunique {} { |
|---|
| 686 | variable uniq |
|---|
| 687 | set uniq [expr ! $uniq] |
|---|
| 688 | } |
|---|
| 689 | |
|---|
| 690 | proc preLaunchDialog {} { |
|---|
| 691 | variable uniq |
|---|
| 692 | variable multcols |
|---|
| 693 | launchDialog $uniq $multcols .top.le |
|---|
| 694 | } |
|---|
| 695 | |
|---|
| 696 | } |
|---|
| 697 | |
|---|
| 698 | package provide bmultiselect 1.0 |
|---|
