scripts/mylistbox.itk

   1 # vim: foldmarker=<<<,>>>
   2
   3 ::itk::usual tlc::Mylistbox {
   4         keep -cursor -maxitems
   5 }
   6
   7
   8 #option clear
   9 option add *Mylistbox*textBackground [$tlc::theme setting textbackground] widgetDefault
  10 option add *Mylistbox*canvasRelief sunken widgetDefault
  11 option add *Mylistbox*canvasBorderwidth 2 widgetDefault
  12 option add *Mylistbox*labelPos nw widgetDefault
  13 option add *Mylistbox.highlightThickness 0 widgetDefault
  14
  15 proc tlc::mylistbox {pathName args} {
  16         uplevel tlc::Mylistbox [list $pathName] $args
  17 }
  18
  19
  20 class tlc::Mylistbox {
  21         inherit tlc::Mywidget tlc::Handlers
  22
  23         constructor {args} {}
  24
  25         itk_option define -showdividers showDividers Bool "no" {dividers}
  26         itk_option define -dividerwidth dividerWidth Width 1 {dividers}
  27         itk_option define -colpad colPad Width 5 {layout}
  28         itk_option define -rowpad rowPad Height 0 {layout}
  29         itk_option define -colprepad colPrePad Width 3 {layout}
  30         itk_option define -rowprepad rowPrePad Width 0 {layout}
  31         itk_option define -foreground foreground Foreground \
  32                         [$tlc::theme setting foreground] {refresh}
  33         itk_option define -selectbackground selectBackground Foreground "#186aa0" \
  34                         [list setselect ""]
  35         itk_option define -selectforeground selectForeground Foreground "#ffc800" \
  36                         [list setselect ""]
  37         itk_option define -browsecommand browseCommand Command ""
  38         itk_option define -doubleclick doubleClick Command ""
  39         itk_option define -changedcommand changedCommand Command ""
  40         itk_option define -width width Width 80 {newwidth}
  41         itk_option define -height height Height 100 {newheight}
  42         itk_option define -idcolumn idcolumn Number "" {reset}
  43         itk_option define -hidecolumns hideColumns List {} {reset}
  44         itk_option define -wrap wrap Wrap 0
  45         itk_option define -maxitems maxItems Integer 100
  46
  47         public {
  48                 method headings {headinglist}
  49                 method reset_colour {args}
  50                 method reset {args}
  51                 method _reset {args}
  52                 method refresh {}
  53                 method colminsize {col size}
  54                 method xset {args}
  55                 method yset {args}
  56                 method xview {args}
  57                 method yview {args}
  58                 method rowcolour {colour rows}
  59                 method idcolour {colour ids}
  60                 method columncolour {colour columns}
  61                 method selection {cmd args}
  62                 method preprocess_row {row}
  63                 method exists {id}
  64                 method insert {index row}
  65                 method remove {id}
  66                 method removerow {row}
  67                 method updaterow {row newrow}
  68                 method replace {id {newrow {}}}
  69                 method get {{scope "ids"}}
  70                 method getrow {type index}
  71                 method getrows {type index}
  72                 method see {row}
  73                 # Selection manipulation
  74                 method next {}
  75                 method prev {}
  76                 method home {}
  77                 method end {}
  78                 method pageup {}
  79                 method pagedown {}
  80
  81                 method selected_gate_ref {}
  82         }
  83
  84         protected {
  85                 variable hull
  86                 variable canv
  87         }
  88
  89         private {
  90                 variable scroll_lock    ""
  91                 variable scroll_flag    0
  92
  93                 variable elements_all   {}
  94                 variable elements               {}
  95                 variable maxrows        0
  96                 variable maxcols        0
  97                 variable row_start
  98                 variable col_start
  99                 variable row_size
 100                 variable col_size
 101                 variable col_minsize
 102                 variable bbox
 103                 variable xmapped        0
 104                 variable ymapped        0
 105                 variable selected       ""
 106                 variable oldselected    ""
 107                 variable rowid
 108                 variable id2rows
 109                 variable row_colour
 110                 variable id_colour
 111                 variable column_colour
 112
 113                 variable paged          0;              # If configured with > -maxitems
 114
 115                 variable item_selected
 116
 117                 method render_row {row elements}
 118                 method dividers {}
 119                 method layout {}
 120                 method leftclick {x y}
 121                 method doubleclick {x y}
 122                 method setselect {row}
 123                 method browsecallback {row}
 124                 method setrowcolour {row}
 125                 method setidcolour {id}
 126                 method newwidth {}
 127                 method newheight {}
 128
 129                 method bigger {a1 a2}
 130                 method smaller {i1 i2}
 131                 method new_range {newsegment}
 132         }
 133 }
 134
 135 body tlc::Mylistbox::constructor {args} { #<<<1
 136         set hull        $itk_interior
 137
 138         tlc::Signal #auto item_selected
 139
 140         itk_component add frame {
 141                 frame $hull.frame
 142         } {
 143                 keep -width
 144                 keep -height
 145         }
 146
 147         itk_component add canvas {
 148                 canvas $itk_component(frame).canvas \
 149                         -width 0 -height 0 \
 150         } {
 151                 usual
 152                 keep -takefocus
 153                 ignore -selectbackground -selectforeground
 154                 ignore -highlightthickness
 155                 ignore -width -height
 156                 rename -background -textbackground textBackground Background
 157                 rename -borderwidth -canvasborderwidth canvasBorderwidth Borderwidth
 158                 rename -relief -canvasrelief canvasRelief Relief
 159         }
 160         set canv        $itk_component(canvas)
 161
 162         itk_component add vsb {
 163                 myscrollbar_win32 $hull.vsb \
 164                         -orient v -mode static \
 165                         -command [list $itk_component(canvas) yview]
 166         } {}
 167
 168         itk_component add hsb {
 169                 myscrollbar_win32 $hull.hsb \
 170                         -orient h -mode dynamic \
 171                         -command [list $itk_component(canvas) xview]
 172         } {}
 173
 174         $itk_component(canvas) configure \
 175                 -yscrollcommand [list $itk_component(vsb) set] \
 176                 -xscrollcommand [list $itk_component(hsb) set]
 177
 178         itk_component add rangeselect {
 179                 tlc::dropselect $hull.range -menuborderwidth 1 -pady 1
 180         }
 181
 182
 183         grid rowconfigure $hull 3 -weight 1
 184         grid columnconfig $hull 1 -weight 1
 185         newwidth
 186         newheight
 187
 188         grid $itk_component(rangeselect) -row 1 -column 1 -columnspan 2 \
 189                 -sticky news
 190         grid remove $itk_component(rangeselect)
 191         grid $itk_component(frame) -row 3 -column 1 -sticky news
 192         grid rowconfigure $itk_component(frame) 1 -weight 1
 193         grid columnconfig $itk_component(frame) 1 -weight 1
 194
 195         grid $itk_component(canvas) -row 1 -column 1 -sticky news
 196         grid $itk_component(vsb) -row 3 -column 2 -sticky ns
 197         grid $itk_component(hsb) -row 4 -column 1 -sticky ew
 198 #       grid remove $itk_component(vsb)
 199 #       grid remove $itk_component(hsb)
 200
 201         bind $itk_component(canvas) <ButtonRelease-1> [code $this leftclick %x %y]
 202         bind $itk_component(canvas) <Double-Button-1> [code $this doubleclick %x %y]
 203
 204         $canv yview moveto 0.0
 205         eval itk_initialize $args
 206
 207         $itk_component(rangeselect) configure -callback [code $this new_range]
 208 }
 209
 210
 211 body tlc::Mylistbox::headings {headings} { #<<<1
 212 }
 213
 214
 215 body tlc::Mylistbox::refresh {} { #<<<1
 216         for {set row 0} {$row < $maxrows} {incr row} {
 217                 setrowcolour $row
 218         }
 219         layout
 220         dividers
 221 }
 222
 223
 224 body tlc::Mylistbox::reset_colour {args} { #<<<1
 225         foreach key [array names row_colour] {
 226                 unset row_colour($key)
 227         }
 228         foreach key [array names id_colour] {
 229                 unset id_colour($key)
 230         }
 231 }
 232
 233
 234 body tlc::Mylistbox::reset {args} { #<<<1
 235         set hold        [selection get]
 236         set old_outer_row       [lindex [lsearch $elements_all $hold] 0]
 237         if {[llength $args] > 0} {
 238                 set elements_all        [join $args]
 239         }
 240
 241         set totitems    [llength $elements_all]
 242         if {$totitems > $itk_option(-maxitems)} {
 243                 set paged       1
 244                 set items       $totitems
 245                 set cur 0
 246                 while {$items > 0} {
 247                         lappend choices [list $cur "[expr $cur+1] - [smaller [expr $cur + $itk_option(-maxitems)] $totitems]"]
 248                         incr items      -$itk_option(-maxitems)
 249                         incr cur        $itk_option(-maxitems)
 250                 }
 251                 $itk_component(rangeselect) configure -choices $choices
 252                 grid $itk_component(rangeselect)
 253
 254                 # Swap in the correct page
 255                 set outer_row   [lindex [lsearch $elements_all $hold] 0]
 256                 if {$outer_row == -1} {
 257                         set outer_row           $old_outer_row
 258                         set hold                        ""
 259                 }
 260                 set target_page         [expr {int($outer_row / $itk_option(-maxitems)) * $itk_option(-maxitems)}]
 261                 set current_page        [$itk_component(rangeselect) get_selected_id]
 262                 if {$target_page != $current_page} {
 263                         $itk_component(rangeselect) selectid $target_page
 264                 }
 265
 266                 selection set $hold
 267 #               $itk_component(rangeselect) selectid 0
 268         } else {
 269                 set paged       0
 270                 grid remove $itk_component(rangeselect)
 271                 _reset $elements_all
 272         }
 273 }
 274
 275
 276 body tlc::Mylistbox::_reset {args} { #<<<1
 277         set holdcursor  [[winfo toplevel $hull] cget -cursor]
 278         [winfo toplevel $hull] configure -cursor watch
 279
 280         if {[llength $args] > 0} {
 281                 set elements    [join $args]
 282         }
 283
 284         set hold        [selection get]
 285
 286         set maxrows     0
 287         set maxcols 0
 288         set selected    ""
 289         set oldselected ""
 290
 291         foreach key [array names id2rows] {
 292                 unset id2rows($key)
 293         }
 294
 295         $canv delete all
 296
 297         set seq 0
 298         foreach row $elements {
 299                 render_row $seq $row
 300                 incr seq
 301         }
 302
 303         set maxrows     $seq
 304
 305         refresh
 306
 307         selection set $hold
 308
 309         if {$itk_option(-changedcommand) != ""} {
 310                 uplevel #0 $itk_option(-changedcommand)
 311         }
 312
 313         [winfo toplevel $hull] configure -cursor $holdcursor
 314 }
 315
 316
 317 body tlc::Mylistbox::render_row {row elements} { #<<<1
 318         set seq 0
 319         if {$itk_option(-idcolumn) == ""} {
 320                 set rowid($row) [lindex $elements 0]
 321                 set firstvisitem        1
 322         } else {
 323                 set rowid($row) [lindex $elements $itk_option(-idcolumn)]
 324                 set firstvisitem        0
 325         }
 326         lappend id2rows($rowid($row))   $row
 327         set visitems    [lrange $elements $firstvisitem end]
 328         foreach h $itk_option(-hidecolumns) {
 329                 set hidemap($h) 1
 330         }
 331         set cnum        [expr $firstvisitem - 1]
 332         foreach col     $visitems {
 333                 if {![info exists hidemap([incr cnum])]} {
 334                         $canv create text 0 0 -text $col \
 335                                 -fill $itk_option(-foreground) \
 336                                 -anchor nw -tags [list "row$row" "col$seq" "rowcol$row,$seq" "elements"]
 337                 }
 338                 incr seq
 339         }
 340
 341         if {$seq > $maxcols} {
 342                 set maxcols     $seq
 343         }
 344 }
 345
 346
 347 body tlc::Mylistbox::layout {} { #<<<1
 348         foreach item [$canv find withtag "elements"] {
 349                 $canv coords $item 0 0
 350         }
 351
 352         for {set row 0} {$row < $maxrows} {incr row} {
 353                 set bbox        [$canv bbox "row$row"]
 354                 set y1          [lindex $bbox 1]
 355                 set y2          [lindex $bbox 3]
 356                 set row_size($row)      [expr $y2 - $y1 +1]
 357         }
 358
 359         for {set col 0} {$col < $maxcols} {incr col} {
 360                 set bbox        [$canv bbox "col$col"]
 361                 set x1          [lindex $bbox 0]
 362                 set x2          [lindex $bbox 2]
 363                 set col_size($col)      [expr $x2 - $x1 +1]
 364                 if {[info exists col_minsize($col)]} {
 365                         set col_size($col)      [bigger $col_size($col) $col_minsize($col)]
 366                 }
 367         }
 368
 369         set row_start(0)        0
 370         for {set row 0} {$row < $maxrows} {incr row} {
 371                 $canv move "row$row" 0 [expr $row_start($row) + $itk_option(-rowprepad)]
 372                 set row_start([expr $row+1])    \
 373                         [expr $row_start($row) + \
 374                                 $row_size($row) + \
 375                                 $itk_option(-rowprepad) + \
 376                                 $itk_option(-rowpad) ]
 377         }
 378
 379         set col_start(0)        0
 380         for {set col 0} {$col < $maxcols} {incr col} {
 381                 $canv move "col$col" [expr $col_start($col) + $itk_option(-colprepad)] 0
 382                 set col_start([expr $col+1])    \
 383                         [expr $col_start($col) + \
 384                                 $col_size($col) + \
 385                                 $itk_option(-colprepad) + \
 386                                 $itk_option(-colpad) ]
 387         }
 388
 389 #       update idletasks
 390         set bbox        [$canv bbox elements]
 391         $canv configure -scrollregion $bbox
 392 }
 393
 394
 395 body tlc::Mylistbox::dividers {} { #<<<1
 396         $canv delete "row_dividers"
 397
 398         if {$itk_option(-showdividers)} {
 399                 for {set div 1} {$div < $maxcols} {incr div} {
 400                         $canv create line $col_start($div) 0 $col_start($div) 100000 \
 401                                 -tags "row_dividers" \
 402                                 -width $itk_option(-dividerwidth)
 403                 }
 404         }
 405 }
 406
 407
 408 # use the (very fast) tclx max command if it is available
 409 if {[info commands max] == "max"} {
 410         body tlc::Mylistbox::bigger {a1 a2} {
 411                 return [max $a1 $a2]
 412         }
 413 } else {
 414         body tlc::Mylistbox::bigger {a1 a2} {
 415                 if {$a2 > $a1} {
 416                         return $a2
 417                 } else {
 418                         return $a1
 419                 }
 420         }
 421 }
 422
 423 # use the (very fast) tclx max command if it is available
 424 if {[info commands min] == "min"} {
 425         body tlc::Mylistbox::smaller {i1 i2} {
 426                 return [min $i1 $i2]
 427         }
 428 } else {
 429         body tlc::Mylistbox::smaller {i1 i2} {
 430                 if {$i1 < $i2} {
 431                         return $i1
 432                 } else {
 433                         return $i2
 434                 }
 435         }
 436 }
 437
 438
 439 body tlc::Mylistbox::new_range {newsegment} { #<<<1
 440         puts "got new_range: ($newsegment)"
 441         set newbase     [lindex $newsegment 0]
 442         if {$newbase != ""} {
 443                 set foo [lrange $elements_all \
 444                         $newbase \
 445                         [expr $newbase + ($itk_option(-maxitems)-1)] \
 446                 ]
 447                 _reset $foo
 448         } else {
 449                 _reset {}
 450         }
 451
 452         if {[selection getrow] == ""} {
 453                 selection setrow 0
 454         }
 455 }
 456
 457
 458 body tlc::Mylistbox::colminsize {col size} { #<<<1
 459         set col_minsize($col)   $size
 460
 461         layout
 462         dividers
 463 }
 464
 465
 466 body tlc::Mylistbox::xview {args} { #<<<1
 467         eval $canv xview $args
 468 }
 469
 470
 471 body tlc::Mylistbox::yview {args} { #<<<1
 472         eval $canv yview $args
 473 }
 474
 475
 476 body tlc::Mylistbox::xset {args} { #<<<1
 477         return
 478         if {[lindex $args 0] == 0 && [lindex $args 1] == 1} {
 479                 if {$xmapped} {
 480                         grid remove $itk_component(hsb)
 481                         set xmapped     0
 482                 }
 483         } else {
 484                 if {!$xmapped} {
 485                         grid $itk_component(hsb)
 486                         set xmapped     1
 487                 }
 488         }
 489         eval $itk_component(hsb) set $args
 490 }
 491
 492
 493 body tlc::Mylistbox::yset {args} { #<<<1
 494         return
 495         if {[lindex $args 0] == 0 && [lindex $args 1] == 1} {
 496                 if {$ymapped} {
 497                         grid remove $itk_component(vsb)
 498                         set ymapped     0
 499                 }
 500         } else {
 501                 if {!$ymapped} {
 502                         grid $itk_component(vsb)
 503                         set ymapped     1
 504                 }
 505         }
 506         eval $itk_component(vsb) set $args
 507 }
 508
 509
 510 body tlc::Mylistbox::leftclick {x y} { #<<<1
 511         set y   [$canv canvasy $y]
 512         for {set row 1} {$row <= $maxrows} {incr row} {
 513                 if {$y < $row_start($row)} {
 514                         break
 515                 }
 516         }
 517
 518         incr row        -1
 519
 520         if {$row < $maxrows} {
 521                 setselect $row
 522         }
 523
 524         return $row
 525 }
 526
 527
 528 # FIXME:  doesn't always fire
 529 body tlc::Mylistbox::doubleclick {x y} { #<<<1
 530
 531         set y   [$canv canvasy $y]
 532         for {set row 1} {$row <= $maxrows} {incr row} {
 533                 if {$y < $row_start($row)} {
 534                         break
 535                 }
 536         }
 537
 538         incr row        -1
 539
 540         if {$row < $maxrows} {
 541                 if {$itk_option(-doubleclick) != ""} {
 542                         if {[info exists rowid($row)]} {
 543                                 uplevel #0 $itk_option(-doubleclick) $rowid($row)
 544                         } else {
 545                                 uplevel #0 $itk_option(-doubleclick) [list ""]
 546                         }
 547                 }
 548         }
 549 }
 550
 551
 552 body tlc::Mylistbox::setselect {row} { #<<<1
 553         incr [scope scroll_flag]
 554         set row         [preprocess_row $row]
 555         see $row
 556
 557         $canv delete "select_highlight"
 558
 559         if {$row == ""} {
 560                 set row $selected
 561         } elseif {$row >= $maxrows} {
 562                 set row ""
 563         }
 564         set selected    $row
 565
 566         setrowcolour $oldselected
 567
 568         if {$row != ""} {
 569                 $canv create rectangle \
 570                         0 $row_start($row) 100000 $row_start([expr $row + 1]) \
 571                         -outline $itk_option(-selectbackground) \
 572                         -fill $itk_option(-selectbackground) \
 573                         -tags "select_highlight"
 574                 $canv lower "select_highlight" "elements"
 575                 $canv itemconfigure "row$row" -fill $itk_option(-selectforeground)
 576                 set oldselected $selected
 577         } else {
 578                 set oldselected ""
 579         }
 580
 581         if {$scroll_flag > 1} {
 582                 if {$scroll_lock != ""} {
 583                         after cancel $scroll_lock
 584                         incr scroll_flag -1
 585                 }
 586                 set scroll_lock [after 400 [code $this browsecallback $row]]
 587         } else {
 588                 browsecallback $row
 589         }
 590
 591         update idletasks
 592         return $selected
 593 }
 594
 595
 596 body tlc::Mylistbox::browsecallback {row} { #<<<1
 597         $item_selected set_state [expr {[info exists rowid($row)]}]
 598         if {$itk_option(-browsecommand) != ""} {
 599                 if {[info exists rowid($row)]} {
 600                         uplevel #0 $itk_option(-browsecommand) [list $rowid($row)]
 601                 } else {
 602                         uplevel #0 $itk_option(-browsecommand) [list ""]
 603                 }
 604         }
 605
 606         invoke_handlers onselect \
 607                         [expr {[info exists rowid($row)] ? $rowid($row) : ""}]
 608
 609         set scroll_lock ""
 610         incr [scope scroll_flag] -1
 611 }
 612
 613
 614 body tlc::Mylistbox::setrowcolour {row} { #<<<1
 615         if {$row != ""} {
 616                 set id  $rowid($row)
 617                 if {$row == $selected} {
 618                         set col $itk_option(-selectforeground)
 619                 } elseif {[info exists row_colour($row)] && $row_colour($row) != ""} {
 620                         set col $row_colour($row)
 621                 } elseif {[info exists id_colour($id)] && $id_colour($id) != ""} {
 622                         set col $id_colour($id)
 623                 } else {
 624                         set col $itk_option(-foreground)
 625                 }
 626
 627                 $canv itemconfigure "row$row" -fill $col
 628                 if {[array exists column_colour]} {
 629                         foreach column [array names column_colour] {
 630                                 set colour      $column_colour($column)
 631                                 $canv itemconfigure "rowcol$row,$column" -fill $colour
 632                         }
 633                 }
 634         }
 635 }
 636
 637
 638 body tlc::Mylistbox::setidcolour {id} { #<<<1
 639         if {$id != ""} {
 640                 if {[info exists id2rows($id)]} {
 641                         foreach row $id2rows($id) {
 642                                 setrowcolour $row
 643                         }
 644                 }
 645         }
 646 }
 647
 648
 649 body tlc::Mylistbox::rowcolour {colour rows} { #<<<1
 650         foreach row $rows {
 651                 set row [preprocess_row $row]
 652                 set row_colour($row)    $colour
 653                 setrowcolour $row
 654         }
 655 }
 656
 657
 658 body tlc::Mylistbox::idcolour {colour ids} { #<<<1
 659         foreach id $ids {
 660                 set id_colour($id)              $colour
 661                 setidcolour $id
 662         }
 663 }
 664
 665
 666 body tlc::Mylistbox::columncolour {colour columns} { #<<<1
 667         foreach column $columns {
 668                 set column_colour($column)      $colour
 669                 $canv itemconfigure "col$column" -fill $colour
 670         }
 671 }
 672
 673
 674 body tlc::Mylistbox::newwidth {} { #<<<1
 675         if {$itk_option(-width) != ""} {
 676                 grid columnconfig $hull 1 -minsize $itk_option(-width)
 677         } else {
 678                 grid columnconfig $hull 1 -minsize 0
 679         }
 680 }
 681
 682
 683 body tlc::Mylistbox::newheight {} { #<<<1
 684         if {$itk_option(-height) != ""} {
 685                 grid rowconfigure $hull 3 -minsize $itk_option(-height)
 686         } else {
 687                 grid rowconfigure $hull 3 -minsize 0
 688         }
 689 }
 690
 691
 692 body tlc::Mylistbox::selection {cmd args} { #<<<1
 693         switch -exact $cmd {
 694                 "set" {
 695                         set id  [lindex $args 0]
 696                         if {[info exists id2rows($id)]} {
 697                                 return  [setselect      [lindex $id2rows($id) 0]]
 698                         } else {
 699                                 return  [setselect      ""]
 700                         }
 701                 }
 702                 "get" {
 703                         if {$selected != ""} {
 704                                 return  [lindex [lindex $elements $selected] 0]
 705                         } else {
 706                                 return ""
 707                         }
 708                 }
 709                 "setrow" {
 710                         return  [setselect      [lindex $args 0]]
 711                 }
 712                 "getrow" {
 713                         return $selected
 714                 }
 715         }
 716 }
 717
 718
 719 body tlc::Mylistbox::preprocess_row {row} { #<<<1
 720         switch -exact $row {
 721                 "selected"      {return [selection getrow]}
 722                 "last"          {return [bigger 0 [expr $maxrows - 1]]}
 723                 default         {return $row}
 724         }
 725
 726 }
 727
 728
 729 body tlc::Mylistbox::exists {id} { #<<<1
 730         return [info exists id2rows($id)]
 731 }
 732
 733
 734 body tlc::Mylistbox::insert {index args} { #<<<1
 735         eval set elements_all   "\[linsert \$elements_all \$index $args\]"
 736         reset
 737 }
 738
 739
 740 body tlc::Mylistbox::remove {id} { #<<<1
 741         if {![info exists id2rows($id)]} return
 742
 743         set rows                $id2rows($id)
 744         foreach row $rows {
 745                 set elements_all        [lreplace $elements_all $row $row]
 746         }
 747         reset
 748 }
 749
 750
 751 body tlc::Mylistbox::removerow {row} { #<<<1
 752         set row [preprocess_row $row]
 753         if {$row != ""} {
 754                 set elements_all        [lreplace $elements_all $row $row]
 755         }
 756         reset
 757 }
 758
 759
 760 body tlc::Mylistbox::updaterow {row newrow} { #<<<1
 761         if {$newrow == ""} {
 762                 removerow $row
 763                 return
 764         }
 765
 766         set row [preprocess_row $row]
 767
 768         if {$row != ""} {
 769                 set elements_all        [lreplace $elements_all $row $row $newrow]
 770         }
 771         reset
 772 }
 773
 774
 775 body tlc::Mylistbox::replace {id {newrow {}}} { #<<<1
 776         if {![info exists id2rows($id)]} return
 777
 778         if {$newrow == ""} {
 779                 remove $id
 780                 return
 781         }
 782
 783         if {[selection get] == $id} {
 784                 set needselect  1
 785         } else {
 786                 set needselect  0
 787         }
 788
 789         set firstrow    [lindex $id2rows($id) 0]
 790         set elements_all        [lreplace $elements_all $firstrow $firstrow $newrow]
 791
 792         set otherrows   [lrange $id2rows($id) 1 end]
 793         foreach row $otherrows {
 794                 set elements_all        [lreplace $elements_all $row $row]
 795         }
 796
 797         reset
 798
 799         if {$needselect} {
 800                 selection setrow $firstrow
 801         }
 802 }
 803
 804
 805 body tlc::Mylistbox::get {{scope "ids"}} { #<<<1
 806         switch -exact $scope {
 807                 "ids" {
 808                         return [array names id2rows]
 809                 }
 810                 "all" {
 811                         return $elements_all
 812                 }
 813                 default {
 814                         error "Unknown scope $scope specified for get, must be one of (ids)"
 815                 }
 816         }
 817 }
 818
 819
 820 body tlc::Mylistbox::getrow {type index} { #<<<1
 821         switch -exact -- $type {
 822                 "-withid" {
 823                         if {![info exists id2rows($index)]} {return {}}
 824                         return [lindex $elements [lindex $id2rows($index) 0]]
 825                 }
 826                 "-row" {
 827                         set index       [preprocess_row $index]
 828                         if {$index != ""} {
 829                                 return [lindex $elements $index]
 830                         } else {
 831                                 return {}
 832                         }
 833                 }
 834                 default {
 835                         error "bad type: $type.  expected one of (-withid, -row)"
 836                 }
 837         }
 838 }
 839
 840
 841 body tlc::Mylistbox::getrows {type index} { #<<<1
 842         switch -exact -- $type {
 843                 "-withid" {
 844                         if {![info exists id2rows($index)]} {return {}}
 845
 846                         set result      {}
 847                         foreach row $id2rows($index) {
 848                                 lappend result  [lindex $elements $row]
 849                         }
 850                         return $result
 851                 }
 852                 "-rows" {
 853                         set result      {}
 854                         foreach row $index {
 855                                 set row         [preprocess_row $row]
 856                                 lappend result  [lindex $elements $row]
 857                         }
 858                         return $result
 859                 }
 860                 default {
 861                         error "bad type: $type.  expected one of (-withid, -rows)"
 862                 }
 863         }
 864 }
 865
 866
 867 body tlc::Mylistbox::see {row} { #<<<1
 868         set row         [preprocess_row $row]
 869         if {$row == ""} return
 870
 871         if {$row == ""} {return}
 872         set bbox        [$canv bbox "row$row"]
 873         set itemtop     [lindex $bbox 1]
 874         set itembot     [lindex $bbox 3]
 875         set all         [$canv bbox "elements"]
 876         if {$all == ""} {return}
 877         set height      [expr [lindex $all 3] - [lindex $all 1]]
 878         set curr        [$canv yview]
 879         set viewtop     [expr $height * [lindex $curr 0]]
 880         set viewbot     [expr $height * [lindex $curr 1]]
 881         set viewheight  [expr $viewbot - $viewtop]
 882 #       puts "viewtop: ($viewtop)\nviewbot: ($viewbot)\nitemtop: ($itemtop)\nitembot: ($itembot)\nviewheight: ($viewheight)\nheight: ($height)\n-------------------------"
 883
 884         if {$itemtop < $viewtop || [expr $itembot-$itemtop] > $viewheight} {
 885                 $canv yview moveto [expr double($itemtop) / $height]
 886         } elseif {$itembot > $viewbot} {
 887                 set viewfactor  [expr double($viewheight) / $height]
 888 #               puts "VIEWFACTOR: ($viewfactor)\nMOVETO: ([expr (double($itembot) / $height) - $viewfactor])\n"
 889                 $canv yview moveto [expr (double($itembot) / $height) - $viewfactor]
 890         }
 891 }
 892
 893
 894 body tlc::Mylistbox::next {} { #<<<1
 895         if {$selected == ""} {
 896                 setselect 0
 897                 return
 898         }
 899         set lsel        [expr $selected + 1]
 900
 901
 902         if {$lsel >= $maxrows} {
 903                 if {$itk_option(-wrap)} {
 904                         set lsel        0
 905                 } else {
 906                         set lsel        [bigger [expr $maxrows-1] 0]
 907                 }
 908         }
 909
 910         setselect $lsel
 911 }
 912
 913
 914 body tlc::Mylistbox::prev {} { #<<<1
 915         if {$selected == ""} {
 916                 setselect $maxrows
 917                 return
 918         }
 919         set lsel        [expr $selected - 1]
 920
 921         if {$lsel < 0} {
 922                 if {$itk_option(-wrap)} {
 923                         set lsel        [bigger [expr $maxrows-1] 0]
 924                 } else {
 925                         set lsel        0
 926                 }
 927         }
 928
 929         setselect $lsel
 930 }
 931
 932
 933 body tlc::Mylistbox::home {} { #<<<1
 934         setselect 0
 935 }
 936
 937
 938 body tlc::Mylistbox::end {} { #<<<1
 939         set lsel        [bigger [expr $maxrows-1] 0]
 940         setselect $lsel
 941 }
 942
 943
 944 body tlc::Mylistbox::pageup {} { #<<<1
 945         $canv yview scroll -1 pages
 946 }
 947
 948
 949 body tlc::Mylistbox::pagedown {} { #<<<1
 950         $canv yview scroll +1 pages
 951 }
 952
 953
 954 body tlc::Mylistbox::selected_gate_ref {} { #<<<1
 955         return $item_selected
 956 }
 957
 958