1#============================================================================== 2# Contains private utility procedures for tablelist widgets. 3# 4# Structure of the module: 5# - Namespace initialization 6# - Private utility procedures 7# 8# Copyright (c) 2000-2010 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) 9#============================================================================== 10 11# 12# Namespace initialization 13# ======================== 14# 15 16namespace eval tablelist { 17 # 18 # alignment -> anchor mapping 19 # 20 variable anchors 21 array set anchors { 22 left w 23 right e 24 center center 25 } 26 27 # 28 # <alignment, changeSnipSide> -> snipSide mapping 29 # 30 variable snipSides 31 array set snipSides { 32 left,0 r 33 left,1 l 34 right,0 l 35 right,1 r 36 center,0 r 37 center,1 l 38 } 39 40 # 41 # <incrArrowType, sortOrder> -> direction mapping 42 # 43 variable directions 44 array set directions { 45 up,increasing Up 46 up,decreasing Dn 47 down,increasing Dn 48 down,decreasing Up 49 } 50} 51 52# 53# Private utility procedures 54# ========================== 55# 56 57#------------------------------------------------------------------------------ 58# tablelist::rowIndex 59# 60# Checks the row index idx and returns either its numerical value or an error. 61# endIsSize must be a boolean value: if true, end refers to the number of items 62# in the tablelist, i.e., to the element just after the last one; if false, end 63# refers to 1 less than the number of items, i.e., to the last element in the 64# tablelist. checkRange must be a boolean value: if true, it is additionally 65# checked whether the numerical value corresponding to idx is within the 66# allowed range. 67#------------------------------------------------------------------------------ 68proc tablelist::rowIndex {win idx endIsSize {checkRange 0}} { 69 upvar ::tablelist::ns${win}::data data 70 71 if {[catch {format "%d" $idx} index] == 0} { 72 # nothing 73 } elseif {[string first $idx "end"] == 0} { 74 if {$endIsSize} { 75 set index $data(itemCount) 76 } else { 77 set index $data(lastRow) 78 } 79 } elseif {[string first $idx "active"] == 0 && [string length $idx] >= 2} { 80 set index $data(activeRow) 81 } elseif {[string first $idx "anchor"] == 0 && [string length $idx] >= 2} { 82 set index $data(anchorRow) 83 } elseif {[scan $idx "@%d,%d" x y] == 2} { 84 displayItems $win 85 incr x -[winfo x $data(body)] 86 incr y -[winfo y $data(body)] 87 set textIdx [$data(body) index @$x,$y] 88 set index [expr {int($textIdx) - 1}] 89 } elseif {[set row [keyToRow $win $idx]] >= 0} { 90 set index $row 91 } else { 92 for {set row 0} {$row < $data(itemCount)} {incr row} { 93 set key [lindex $data(keyList) $row] 94 set hasName [info exists data($key-name)] 95 if {($hasName && [string compare $idx $data($key-name)] == 0) || 96 (!$hasName && [string compare $idx ""] == 0)} { 97 set index $row 98 break 99 } 100 } 101 if {$row == $data(itemCount)} { 102 return -code error \ 103 "bad row index \"$idx\": must be active, anchor,\ 104 end, @x,y, a number, a full key, or a name" 105 } 106 } 107 108 if {$checkRange && ($index < 0 || $index > $data(lastRow))} { 109 return -code error "row index \"$idx\" out of range" 110 } else { 111 return $index 112 } 113} 114 115#------------------------------------------------------------------------------ 116# tablelist::colIndex 117# 118# Checks the column index idx and returns either its numerical value or an 119# error. checkRange must be a boolean value: if true, it is additionally 120# checked whether the numerical value corresponding to idx is within the 121# allowed range. 122#------------------------------------------------------------------------------ 123proc tablelist::colIndex {win idx checkRange} { 124 upvar ::tablelist::ns${win}::data data 125 126 if {[catch {format "%d" $idx} index] == 0} { 127 # nothing 128 } elseif {[string first $idx "end"] == 0} { 129 set index $data(lastCol) 130 } elseif {[string first $idx "active"] == 0 && [string length $idx] >= 2} { 131 set index $data(activeCol) 132 } elseif {[string first $idx "anchor"] == 0 && [string length $idx] >= 2} { 133 set index $data(anchorCol) 134 } elseif {[scan $idx "@%d,%d" x y] == 2} { 135 synchronize $win 136 displayItems $win 137 incr x -[winfo x $data(body)] 138 set bodyWidth [winfo width $data(body)] 139 if {$x >= $bodyWidth} { 140 set x [expr {$bodyWidth - 1}] 141 } elseif {$x < 0} { 142 set x 0 143 } 144 set x [expr {$x + [winfo rootx $data(body)]}] 145 146 set lastVisibleCol -1 147 for {set col 0} {$col < $data(colCount)} {incr col} { 148 if {$data($col-hide) || $data($col-elide)} { 149 continue 150 } 151 152 set lastVisibleCol $col 153 set w $data(hdrTxtFrLbl)$col 154 set wX [winfo rootx $w] 155 if {$x >= $wX && $x < $wX + [winfo width $w]} { 156 return $col 157 } 158 } 159 set index $lastVisibleCol 160 } else { 161 for {set col 0} {$col < $data(colCount)} {incr col} { 162 set hasName [info exists data($col-name)] 163 if {($hasName && [string compare $idx $data($col-name)] == 0) || 164 (!$hasName && [string compare $idx ""] == 0)} { 165 set index $col 166 break 167 } 168 } 169 if {$col == $data(colCount)} { 170 return -code error \ 171 "bad column index \"$idx\": must be active, anchor,\ 172 end, @x,y, a number, or a name" 173 } 174 } 175 176 if {$checkRange && ($index < 0 || $index > $data(lastCol))} { 177 return -code error "column index \"$idx\" out of range" 178 } else { 179 return $index 180 } 181} 182 183#------------------------------------------------------------------------------ 184# tablelist::cellIndex 185# 186# Checks the cell index idx and returns either a list of the form {row col} or 187# an error. checkRange must be a boolean value: if true, it is additionally 188# checked whether the two numerical values corresponding to idx are within the 189# respective allowed ranges. 190#------------------------------------------------------------------------------ 191proc tablelist::cellIndex {win idx checkRange} { 192 upvar ::tablelist::ns${win}::data data 193 194 set lst [split $idx ","] 195 if {[llength $lst] == 2 && 196 [catch {rowIndex $win [lindex $lst 0] 0} row] == 0 && 197 [catch {colIndex $win [lindex $lst 1] 0} col] == 0} { 198 # nothing 199 } elseif {[string first $idx "end"] == 0} { 200 set row [rowIndex $win $idx 0] 201 set col [colIndex $win $idx 0] 202 } elseif {[string first $idx "active"] == 0 && [string length $idx] >= 2} { 203 set row $data(activeRow) 204 set col $data(activeCol) 205 } elseif {[string first $idx "anchor"] == 0 && [string length $idx] >= 2} { 206 set row $data(anchorRow) 207 set col $data(anchorCol) 208 } elseif {[string compare [string index $idx 0] "@"] == 0 && 209 [catch {rowIndex $win $idx 0} row] == 0 && 210 [catch {colIndex $win $idx 0} col] == 0} { 211 # nothing 212 } else { 213 return -code error \ 214 "bad cell index \"$idx\": must be active, anchor,\ 215 end, @x,y, or row,col, where row must be active,\ 216 anchor, end, a number, a full key, or a name, and\ 217 col must be active, anchor, end, a number, or a name" 218 } 219 220 if {$checkRange && ($row < 0 || $row > $data(lastRow) || 221 $col < 0 || $col > $data(lastCol))} { 222 return -code error "cell index \"$idx\" out of range" 223 } else { 224 return [list $row $col] 225 } 226} 227 228#------------------------------------------------------------------------------ 229# tablelist::adjustRowIndex 230# 231# Sets the row index specified by $rowName to the index of the nearest 232# (non-hidden) row. 233#------------------------------------------------------------------------------ 234proc tablelist::adjustRowIndex {win rowName {forceNonHidden 0}} { 235 upvar ::tablelist::ns${win}::data data $rowName row 236 237 # 238 # Don't operate on row directly, because $rowName might 239 # be data(activeRow), in which case any temporary changes 240 # made on row would trigger the activeTrace procedure 241 # 242 set _row $row 243 if {$_row > $data(lastRow)} { 244 set _row $data(lastRow) 245 } 246 if {$_row < 0} { 247 set _row 0 248 } 249 250 if {$forceNonHidden} { 251 set _rowSav $_row 252 for {} {$_row < $data(itemCount)} {incr _row} { 253 set key [lindex $data(keyList) $_row] 254 if {![info exists data($key-hide)]} { 255 set row $_row 256 return "" 257 } 258 } 259 for {set _row [expr {$_rowSav - 1}]} {$_row >= 0} {incr _row -1} { 260 set key [lindex $data(keyList) $_row] 261 if {![info exists data($key-hide)]} { 262 set row $_row 263 return "" 264 } 265 } 266 set row 0 267 } else { 268 set row $_row 269 } 270} 271 272#------------------------------------------------------------------------------ 273# tablelist::adjustColIndex 274# 275# Sets the column index specified by $colName to the index of the nearest 276# (non-hidden) column. 277#------------------------------------------------------------------------------ 278proc tablelist::adjustColIndex {win colName {forceNonHidden 0}} { 279 upvar ::tablelist::ns${win}::data data $colName col 280 281 # 282 # Don't operate on col directly, because $colName might 283 # be data(activeCol), in which case any temporary changes 284 # made on col would trigger the activeTrace procedure 285 # 286 set _col $col 287 if {$_col > $data(lastCol)} { 288 set _col $data(lastCol) 289 } 290 if {$_col < 0} { 291 set _col 0 292 } 293 294 if {$forceNonHidden} { 295 set _colSav $_col 296 for {} {$_col < $data(colCount)} {incr _col} { 297 if {!$data($_col-hide)} { 298 set col $_col 299 return "" 300 } 301 } 302 for {set _col [expr {$_colSav - 1}]} {$_col >= 0} {incr _col -1} { 303 if {!$data($_col-hide)} { 304 set col $_col 305 return "" 306 } 307 } 308 set _col 0 309 } else { 310 set col $_col 311 } 312} 313 314#------------------------------------------------------------------------------ 315# tablelist::nodeIndexToKey 316# 317# Checks the node index idx and returns either the corresponding full key or 318# "root", or an error. 319#------------------------------------------------------------------------------ 320proc tablelist::nodeIndexToKey {win idx} { 321 if {[string first $idx "root"] == 0} { 322 return "root" 323 } elseif {[catch {rowIndex $win $idx 0} row] == 0} { 324 upvar ::tablelist::ns${win}::data data 325 if {$row < 0 || $row > $data(lastRow)} { 326 return -code error "node index \"$idx\" out of range" 327 } else { 328 return [lindex $data(keyList) $row] 329 } 330 } else { 331 return -code error \ 332 "bad node index \"$idx\": must be root, active, anchor,\ 333 end, last, @x,y, a number, a full key, or a name" 334 } 335} 336 337#------------------------------------------------------------------------------ 338# tablelist::depth 339# 340# Returns the number of steps from the node with the given full key to the root 341# node of the tablelist widget win. 342#------------------------------------------------------------------------------ 343proc tablelist::depth {win key} { 344 upvar ::tablelist::ns${win}::data data 345 346 set depth 0 347 while {[string compare $key "root"] != 0} { 348 incr depth 349 set key $data($key-parent) 350 } 351 352 return $depth 353} 354 355#------------------------------------------------------------------------------ 356# tablelist::topLevelKey 357# 358# Returns the full key of the top-level item of the tablelist widget win having 359# the item with the given key as descendant. 360#------------------------------------------------------------------------------ 361proc tablelist::topLevelKey {win key} { 362 upvar ::tablelist::ns${win}::data data 363 364 set parentKey $data($key-parent) 365 while {[string compare $parentKey "root"] != 0} { 366 set key $data($key-parent) 367 set parentKey $data($key-parent) 368 } 369 370 return $key 371} 372 373#------------------------------------------------------------------------------ 374# tablelist::descCount 375# 376# Returns the number of descendants of the node with the given full key of the 377# tablelist widget win. 378#------------------------------------------------------------------------------ 379proc tablelist::descCount {win key} { 380 upvar ::tablelist::ns${win}::data data 381 382 if {[string compare $key "root"] == 0} { 383 return $data(itemCount) 384 } else { 385 set count [llength $data($key-children)] 386 foreach child $data($key-children) { 387 incr count [descCount $win $child] 388 } 389 return $count 390 } 391} 392 393#------------------------------------------------------------------------------ 394# tablelist::nodeRow 395# 396# Returns the row of the child item identified by childIdx of the node given by 397# parentKey within the tablelist widget win. 398#------------------------------------------------------------------------------ 399proc tablelist::nodeRow {win parentKey childIdx endIsSize} { 400 upvar ::tablelist::ns${win}::data data 401 402 if {[catch {format "%d" $childIdx} idx] == 0} { 403 if {$idx < [llength $data($parentKey-children)]} { 404 set childKey [lindex $data($parentKey-children) $idx] 405 return [keyToRow $win $childKey] 406 } else { 407 return [expr {[keyToRow $win $parentKey] + 408 [descCount $win $parentKey] + 1}] 409 } 410 } elseif {[string first $childIdx "end"] == 0} { 411 if {$endIsSize} { 412 return [expr {[keyToRow $win $parentKey] + 413 [descCount $win $parentKey] + 1}] 414 } else { 415 set childKey [lindex $data($parentKey-children) end] 416 return [keyToRow $win $childKey] 417 } 418 } else { 419 return -code error \ 420 "bad child index \"$childIdx\": must be end or a number" 421 } 422} 423 424#------------------------------------------------------------------------------ 425# tablelist::keyToRow 426# 427# Returns the row corresponding to the given full key within the tablelist 428# widget win. 429#------------------------------------------------------------------------------ 430proc tablelist::keyToRow {win key} { 431 upvar ::tablelist::ns${win}::data data 432 if {[string compare $key "root"] == 0} { 433 return -1 434 } elseif {$data(keyToRowMapValid) && [info exists data($key-row)]} { 435 return $data($key-row) 436 } else { 437 if {$::tk_version < 8.4} { 438 return [lsearch -exact $data(keyList) $key] 439 } else { 440 # 441 # Speed up the search by starting at the last found position 442 # 443 set row [lsearch -exact -start $data(searchStartIdx) \ 444 $data(keyList) $key] 445 if {$row < 0 && $data(searchStartIdx) != 0} { 446 set row [lsearch -exact $data(keyList) $key] 447 } 448 if {$row >= 0} { 449 set data(searchStartIdx) $row 450 } 451 452 return $row 453 } 454 } 455} 456 457#------------------------------------------------------------------------------ 458# tablelist::updateKeyToRowMapWhenIdle 459# 460# Arranges for the key -> row map associated with the tablelist widget win to 461# be updated at idle time. 462#------------------------------------------------------------------------------ 463proc tablelist::updateKeyToRowMapWhenIdle win { 464 upvar ::tablelist::ns${win}::data data 465 if {[info exists data(mapId)]} { 466 return "" 467 } 468 469 set data(mapId) [after idle [list tablelist::updateKeyToRowMap $win]] 470} 471 472#------------------------------------------------------------------------------ 473# tablelist::updateKeyToRowMap 474# 475# Updates the key -> row map associated with the tablelist widget win. 476#------------------------------------------------------------------------------ 477proc tablelist::updateKeyToRowMap win { 478 upvar ::tablelist::ns${win}::data data 479 if {[info exists data(mapId)]} { 480 after cancel $data(mapId) 481 unset data(mapId) 482 } 483 484 set row 0 485 foreach key $data(keyList) { 486 set data($key-row) $row 487 incr row 488 } 489 490 set data(keyToRowMapValid) 1 491} 492 493#------------------------------------------------------------------------------ 494# tablelist::findTabs 495# 496# Searches for the first and last occurrences of the tab character in the cell 497# range specified by firstCol and lastCol in the given line of the body text 498# child of the tablelist widget win. Assigns the index of the first tab to 499# $idx1Name and the index of the last tab to $idx2Name. It is assumed that 500# both columns are non-hidden (but there may be hidden ones between them). 501#------------------------------------------------------------------------------ 502proc tablelist::findTabs {win line firstCol lastCol idx1Name idx2Name} { 503 upvar ::tablelist::ns${win}::data data $idx1Name idx1 $idx2Name idx2 504 505 set w $data(body) 506 set endIdx $line.end 507 variable canElide 508 variable elide 509 510 set idx $line.1 511 for {set col 0} {$col < $firstCol} {incr col} { 512 if {!$data($col-hide) || $canElide} { 513 set idx [$w search $elide "\t" $idx $endIdx]+2c 514 if {[string compare $idx "+2c"] == 0} { 515 return 0 516 } 517 } 518 } 519 set idx1 [$w index $idx-1c] 520 521 for {} {$col < $lastCol} {incr col} { 522 if {!$data($col-hide) || $canElide} { 523 set idx [$w search $elide "\t" $idx $endIdx]+2c 524 if {[string compare $idx "+2c"] == 0} { 525 return 0 526 } 527 } 528 } 529 set idx2 [$w search $elide "\t" $idx $endIdx] 530 if {[string compare $idx2 ""] == 0} { 531 return 0 532 } 533 534 return 1 535} 536 537#------------------------------------------------------------------------------ 538# tablelist::sortStretchableColList 539# 540# Replaces the column indices different from end in the list of the stretchable 541# columns of the tablelist widget win with their numerical equivalents and 542# sorts the resulting list. 543#------------------------------------------------------------------------------ 544proc tablelist::sortStretchableColList win { 545 upvar ::tablelist::ns${win}::data data 546 if {[llength $data(-stretch)] == 0 || 547 [string compare $data(-stretch) "all"] == 0} { 548 return "" 549 } 550 551 set containsEnd 0 552 foreach elem $data(-stretch) { 553 if {[string first $elem "end"] == 0} { 554 set containsEnd 1 555 } else { 556 set tmp([colIndex $win $elem 0]) "" 557 } 558 } 559 560 set data(-stretch) [lsort -integer [array names tmp]] 561 if {$containsEnd} { 562 lappend data(-stretch) end 563 } 564} 565 566#------------------------------------------------------------------------------ 567# tablelist::deleteColData 568# 569# Cleans up the data associated with the col'th column of the tablelist widget 570# win. 571#------------------------------------------------------------------------------ 572proc tablelist::deleteColData {win col} { 573 upvar ::tablelist::ns${win}::data data 574 if {$data(editCol) == $col} { 575 set data(editCol) -1 576 set data(editRow) -1 577 } 578 579 # 580 # Remove the elements with names of the form $col-* 581 # 582 if {[info exists data($col-redispId)]} { 583 after cancel $data($col-redispId) 584 } 585 foreach name [array names data $col-*] { 586 unset data($name) 587 } 588 589 # 590 # Remove the elements with names of the form k*,$col-* 591 # 592 foreach name [array names data k*,$col-*] { 593 unset data($name) 594 if {[string match "k*,$col-\[bf\]*" $name]} { 595 incr data(cellTagRefCount) -1 596 } elseif {[string match "k*,$col-image" $name]} { 597 incr data(imgCount) -1 598 } elseif {[string match "k*,$col-window" $name]} { 599 incr data(winCount) -1 600 } elseif {[string match "k*,$col-indent" $name]} { 601 incr data(indentCount) -1 602 } 603 } 604 605 # 606 # Remove col from the list of stretchable columns if explicitly specified 607 # 608 if {[string compare $data(-stretch) "all"] != 0} { 609 set stretchableCols {} 610 foreach elem $data(-stretch) { 611 if {[string first $elem "end"] == 0 || $elem != $col} { 612 lappend stretchableCols $elem 613 } 614 } 615 set data(-stretch) $stretchableCols 616 } 617} 618 619#------------------------------------------------------------------------------ 620# tablelist::deleteColAttribs 621# 622# Cleans up the attributes associated with the col'th column of the tablelist 623# widget win. 624#------------------------------------------------------------------------------ 625proc tablelist::deleteColAttribs {win col} { 626 upvar ::tablelist::ns${win}::attribs attribs 627 628 # 629 # Remove the elements with names of the form $col-* 630 # 631 foreach name [array names attribs $col-*] { 632 unset attribs($name) 633 } 634 635 # 636 # Remove the elements with names of the form k*,$col-* 637 # 638 foreach name [array names attribs k*,$col-*] { 639 unset attribs($name) 640 } 641} 642 643#------------------------------------------------------------------------------ 644# tablelist::moveColData 645# 646# Moves the elements of oldArrName corresponding to oldCol to those of 647# newArrName corresponding to newCol. 648#------------------------------------------------------------------------------ 649proc tablelist::moveColData {oldArrName newArrName imgArrName oldCol newCol} { 650 upvar $oldArrName oldArr $newArrName newArr $imgArrName imgArr 651 652 foreach specialCol {activeCol anchorCol editCol -treecolumn treeCol} { 653 if {$oldArr($specialCol) == $oldCol} { 654 set newArr($specialCol) $newCol 655 } 656 } 657 658 if {$newCol < $newArr(colCount)} { 659 foreach l [getSublabels $newArr(hdrTxtFrLbl)$newCol] { 660 destroy $l 661 } 662 set newArr(fmtCmdFlagList) \ 663 [lreplace $newArr(fmtCmdFlagList) $newCol $newCol 0] 664 } 665 666 # 667 # Move the elements of oldArr with names of the form $oldCol-* 668 # to those of newArr with names of the form $newCol-* 669 # 670 foreach newName [array names newArr $newCol-*] { 671 unset newArr($newName) 672 } 673 foreach oldName [array names oldArr $oldCol-*] { 674 regsub "$oldCol-" $oldName "$newCol-" newName 675 set newArr($newName) $oldArr($oldName) 676 unset oldArr($oldName) 677 678 set tail [lindex [split $newName "-"] 1] 679 switch $tail { 680 formatcommand { 681 if {$newCol < $newArr(colCount)} { 682 set newArr(fmtCmdFlagList) \ 683 [lreplace $newArr(fmtCmdFlagList) $newCol $newCol 1] 684 } 685 } 686 labelimage { 687 set imgArr($newCol-$tail) $newArr($newName) 688 unset newArr($newName) 689 } 690 } 691 } 692 693 # 694 # Move the elements of oldArr with names of the form k*,$oldCol-* 695 # to those of newArr with names of the form k*,$newCol-* 696 # 697 foreach newName [array names newArr k*,$newCol-*] { 698 unset newArr($newName) 699 } 700 foreach oldName [array names oldArr k*,$oldCol-*] { 701 regsub -- ",$oldCol-" $oldName ",$newCol-" newName 702 set newArr($newName) $oldArr($oldName) 703 unset oldArr($oldName) 704 } 705 706 # 707 # Replace oldCol with newCol in the list of 708 # stretchable columns if explicitly specified 709 # 710 if {[info exists oldArr(-stretch)] && 711 [string compare $oldArr(-stretch) "all"] != 0} { 712 set stretchableCols {} 713 foreach elem $oldArr(-stretch) { 714 if {[string first $elem "end"] != 0 && $elem == $oldCol} { 715 lappend stretchableCols $newCol 716 } else { 717 lappend stretchableCols $elem 718 } 719 } 720 set newArr(-stretch) $stretchableCols 721 } 722} 723 724#------------------------------------------------------------------------------ 725# tablelist::moveColAttribs 726# 727# Moves the elements of oldArrName corresponding to oldCol to those of 728# newArrName corresponding to newCol. 729#------------------------------------------------------------------------------ 730proc tablelist::moveColAttribs {oldArrName newArrName oldCol newCol} { 731 upvar $oldArrName oldArr $newArrName newArr 732 733 # 734 # Move the elements of oldArr with names of the form $oldCol-* 735 # to those of newArr with names of the form $newCol-* 736 # 737 foreach newName [array names newArr $newCol-*] { 738 unset newArr($newName) 739 } 740 foreach oldName [array names oldArr $oldCol-*] { 741 regsub "$oldCol-" $oldName "$newCol-" newName 742 set newArr($newName) $oldArr($oldName) 743 unset oldArr($oldName) 744 } 745 746 # 747 # Move the elements of oldArr with names of the form k*,$oldCol-* 748 # to those of newArr with names of the form k*,$newCol-* 749 # 750 foreach newName [array names newArr k*,$newCol-*] { 751 unset newArr($newName) 752 } 753 foreach oldName [array names oldArr k*,$oldCol-*] { 754 regsub -- ",$oldCol-" $oldName ",$newCol-" newName 755 set newArr($newName) $oldArr($oldName) 756 unset oldArr($oldName) 757 } 758} 759 760#------------------------------------------------------------------------------ 761# tablelist::deleteColFromCellList 762# 763# Returns the list obtained from a given list of cell indices by removing the 764# elements whose column component equals a given column number. 765#------------------------------------------------------------------------------ 766proc tablelist::deleteColFromCellList {cellList col} { 767 set newCellList {} 768 foreach cellIdx $cellList { 769 scan $cellIdx "%d,%d" cellRow cellCol 770 if {$cellCol != $col} { 771 lappend newCellList $cellIdx 772 } 773 } 774 775 return $newCellList 776} 777 778#------------------------------------------------------------------------------ 779# tablelist::extractColFromCellList 780# 781# Returns the list of row indices obtained from those elements of a given list 782# of cell indices whose column component equals a given column number. 783#------------------------------------------------------------------------------ 784proc tablelist::extractColFromCellList {cellList col} { 785 set rowList {} 786 foreach cellIdx $cellList { 787 scan $cellIdx "%d,%d" cellRow cellCol 788 if {$cellCol == $col} { 789 lappend rowList $cellRow 790 } 791 } 792 793 return $rowList 794} 795 796#------------------------------------------------------------------------------ 797# tablelist::replaceColInCellList 798# 799# Returns the list obtained from a given list of cell indices by replacing the 800# occurrences of oldCol in the column components with newCol. 801#------------------------------------------------------------------------------ 802proc tablelist::replaceColInCellList {cellList oldCol newCol} { 803 set cellList [deleteColFromCellList $cellList $newCol] 804 set newCellList {} 805 foreach cellIdx $cellList { 806 scan $cellIdx "%d,%d" cellRow cellCol 807 if {$cellCol == $oldCol} { 808 lappend newCellList $cellRow,$newCol 809 } else { 810 lappend newCellList $cellIdx 811 } 812 } 813 814 return $newCellList 815} 816 817#------------------------------------------------------------------------------ 818# tablelist::condUpdateListVar 819# 820# Updates the list variable of the tablelist widget win if present. 821#------------------------------------------------------------------------------ 822proc tablelist::condUpdateListVar win { 823 upvar ::tablelist::ns${win}::data data 824 if {$data(hasListVar)} { 825 upvar #0 $data(-listvariable) var 826 trace vdelete var wu $data(listVarTraceCmd) 827 set var {} 828 foreach item $data(itemList) { 829 lappend var [lrange $item 0 $data(lastCol)] 830 } 831 trace variable var wu $data(listVarTraceCmd) 832 } 833} 834 835#------------------------------------------------------------------------------ 836# tablelist::reconfigColLabels 837# 838# Reconfigures the labels of the col'th column of the tablelist widget win. 839#------------------------------------------------------------------------------ 840proc tablelist::reconfigColLabels {win imgArrName col} { 841 upvar ::tablelist::ns${win}::data data $imgArrName imgArr 842 843 set optList {-labelalign -labelbackground -labelborderwidth -labelfont 844 -labelforeground -labelpady -labelrelief} 845 variable usingTile 846 if {!$usingTile} { 847 lappend optList -labelheight 848 } 849 850 foreach opt $optList { 851 if {[info exists data($col$opt)]} { 852 doColConfig $col $win $opt $data($col$opt) 853 } else { 854 doColConfig $col $win $opt "" 855 } 856 } 857 858 if {[info exists imgArr($col-labelimage)]} { 859 doColConfig $col $win -labelimage $imgArr($col-labelimage) 860 } 861} 862 863#------------------------------------------------------------------------------ 864# tablelist::charsToPixels 865# 866# Returns the width in pixels of the string consisting of a given number of "0" 867# characters. 868#------------------------------------------------------------------------------ 869proc tablelist::charsToPixels {win font charCount} { 870 ### set str [string repeat "0" $charCount] 871 set str "" 872 for {set n 0} {$n < $charCount} {incr n} { 873 append str 0 874 } 875 876 return [font measure $font -displayof $win $str] 877} 878 879#------------------------------------------------------------------------------ 880# tablelist::strRange 881# 882# Gets the largest initial (for snipSide = r) or final (for snipSide = l) range 883# of characters from str whose width, when displayed in the given font, is no 884# greater than pixels decremented by the width of snipStr. Returns a string 885# obtained from this substring by appending (for snipSide = r) or prepending 886# (for snipSide = l) (part of) snipStr to it. 887#------------------------------------------------------------------------------ 888proc tablelist::strRange {win str font pixels snipSide snipStr} { 889 if {$pixels < 0} { 890 return "" 891 } 892 893 if {[string compare $snipSide ""] == 0} { 894 return $str 895 } 896 897 898 set width [font measure $font -displayof $win $str] 899 if {$width <= $pixels} { 900 return $str 901 } 902 903 set snipWidth [font measure $font -displayof $win $snipStr] 904 if {$pixels <= $snipWidth} { 905 set str $snipStr 906 set snipStr "" 907 } else { 908 incr pixels -$snipWidth 909 } 910 911 if {[string compare $snipSide "r"] == 0} { 912 set idx [expr {[string length $str]*$pixels/$width - 1}] 913 set subStr [string range $str 0 $idx] 914 set width [font measure $font -displayof $win $subStr] 915 if {$width < $pixels} { 916 while 1 { 917 incr idx 918 set subStr [string range $str 0 $idx] 919 set width [font measure $font -displayof $win $subStr] 920 if {$width > $pixels} { 921 incr idx -1 922 set subStr [string range $str 0 $idx] 923 return $subStr$snipStr 924 } elseif {$width == $pixels} { 925 return $subStr$snipStr 926 } 927 } 928 } elseif {$width == $pixels} { 929 return $subStr$snipStr 930 } else { 931 while 1 { 932 incr idx -1 933 set subStr [string range $str 0 $idx] 934 set width [font measure $font -displayof $win $subStr] 935 if {$width <= $pixels} { 936 return $subStr$snipStr 937 } 938 } 939 } 940 941 } else { 942 set idx [expr {[string length $str]*($width - $pixels)/$width}] 943 set subStr [string range $str $idx end] 944 set width [font measure $font -displayof $win $subStr] 945 if {$width < $pixels} { 946 while 1 { 947 incr idx -1 948 set subStr [string range $str $idx end] 949 set width [font measure $font -displayof $win $subStr] 950 if {$width > $pixels} { 951 incr idx 952 set subStr [string range $str $idx end] 953 return $snipStr$subStr 954 } elseif {$width == $pixels} { 955 return $snipStr$subStr 956 } 957 } 958 } elseif {$width == $pixels} { 959 return $snipStr$subStr 960 } else { 961 while 1 { 962 incr idx 963 set subStr [string range $str $idx end] 964 set width [font measure $font -displayof $win $subStr] 965 if {$width <= $pixels} { 966 return $snipStr$subStr 967 } 968 } 969 } 970 } 971} 972 973#------------------------------------------------------------------------------ 974# tablelist::adjustItem 975# 976# Returns the list obtained by adjusting the list specified by item to the 977# length expLen. 978#------------------------------------------------------------------------------ 979proc tablelist::adjustItem {item expLen} { 980 set len [llength $item] 981 if {$len == $expLen} { 982 return $item 983 } elseif {$len > $expLen} { 984 return [lrange $item 0 [expr {$expLen - 1}]] 985 } else { 986 for {set n $len} {$n < $expLen} {incr n} { 987 lappend item "" 988 } 989 return $item 990 } 991} 992 993#------------------------------------------------------------------------------ 994# tablelist::formatElem 995# 996# Returns the string obtained by formatting the last argument. 997#------------------------------------------------------------------------------ 998proc tablelist::formatElem {win key row col text} { 999 upvar ::tablelist::ns${win}::data data 1000 array set data [list fmtKey $key fmtRow $row fmtCol $col] 1001 1002 return [uplevel #0 $data($col-formatcommand) [list $text]] 1003} 1004 1005#------------------------------------------------------------------------------ 1006# tablelist::formatItem 1007# 1008# Returns the list obtained by formatting the elements of the last argument. 1009#------------------------------------------------------------------------------ 1010proc tablelist::formatItem {win key row item} { 1011 upvar ::tablelist::ns${win}::data data 1012 array set data [list fmtKey $key fmtRow $row] 1013 set formattedItem {} 1014 set col 0 1015 foreach text $item fmtCmdFlag $data(fmtCmdFlagList) { 1016 if {$fmtCmdFlag} { 1017 set data(fmtCol) $col 1018 set text [uplevel #0 $data($col-formatcommand) [list $text]] 1019 } 1020 lappend formattedItem $text 1021 incr col 1022 } 1023 1024 return $formattedItem 1025} 1026 1027#------------------------------------------------------------------------------ 1028# tablelist::hasChars 1029# 1030# Checks whether at least one element of the given list is a nonempty string. 1031#------------------------------------------------------------------------------ 1032proc tablelist::hasChars list { 1033 foreach str $list { 1034 if {[string compare $str ""] != 0} { 1035 return 1 1036 } 1037 } 1038 1039 return 0 1040} 1041 1042#------------------------------------------------------------------------------ 1043# tablelist::getListWidth 1044# 1045# Returns the max. number of pixels that the elements of the given list would 1046# use in the specified font when displayed in the window win. 1047#------------------------------------------------------------------------------ 1048proc tablelist::getListWidth {win list font} { 1049 set width 0 1050 foreach str $list { 1051 set strWidth [font measure $font -displayof $win $str] 1052 if {$strWidth > $width} { 1053 set width $strWidth 1054 } 1055 } 1056 1057 return $width 1058} 1059 1060#------------------------------------------------------------------------------ 1061# tablelist::joinList 1062# 1063# Returns the string formed by joining together with "\n" the strings obtained 1064# by applying strRange to the elements of the given list, with the specified 1065# arguments. 1066#------------------------------------------------------------------------------ 1067proc tablelist::joinList {win list font pixels snipSide snipStr} { 1068 set list2 {} 1069 foreach str $list { 1070 lappend list2 [strRange $win $str $font $pixels $snipSide $snipStr] 1071 } 1072 1073 return [join $list2 "\n"] 1074} 1075 1076#------------------------------------------------------------------------------ 1077# tablelist::displayIndent 1078# 1079# Displays an indentation image in a label widget to be embedded into the 1080# specified cell of the tablelist widget win. 1081#------------------------------------------------------------------------------ 1082proc tablelist::displayIndent {win key col width} { 1083 # 1084 # Create a label widget and replace the binding tag Label with 1085 # $data(bodyTag) and TablelistBody in the list of its binding tags 1086 # 1087 upvar ::tablelist::ns${win}::data data 1088 set w $data(body).ind_$key,$col 1089 if {![winfo exists $w]} { 1090 tk::label $w -anchor w -borderwidth 0 -height 0 -highlightthickness 0 \ 1091 -image $data($key,$col-indent) -padx 0 -pady 0 \ 1092 -relief flat -takefocus 0 -width $width 1093 bindtags $w [lreplace [bindtags $w] 1 1 $data(bodyTag) TablelistBody] 1094 } 1095 1096 updateColorsWhenIdle $win 1097 return $w 1098} 1099 1100#------------------------------------------------------------------------------ 1101# tablelist::displayImage 1102# 1103# Displays an image in a label widget to be embedded into the specified cell of 1104# the tablelist widget win. 1105#------------------------------------------------------------------------------ 1106proc tablelist::displayImage {win key col anchor width} { 1107 # 1108 # Create a label widget and replace the binding tag Label with 1109 # $data(bodyTag) and TablelistBody in the list of its binding tags 1110 # 1111 upvar ::tablelist::ns${win}::data data 1112 set w $data(body).img_$key,$col 1113 if {![winfo exists $w]} { 1114 tk::label $w -anchor $anchor -borderwidth 0 -height 0 \ 1115 -highlightthickness 0 -image $data($key,$col-image) \ 1116 -padx 0 -pady 0 -relief flat -takefocus 0 -width $width 1117 bindtags $w [lreplace [bindtags $w] 1 1 $data(bodyTag) TablelistBody] 1118 } 1119 1120 updateColorsWhenIdle $win 1121 return $w 1122} 1123 1124#------------------------------------------------------------------------------ 1125# tablelist::displayText 1126# 1127# Displays the given text in a message widget to be embedded into the specified 1128# cell of the tablelist widget win. 1129#------------------------------------------------------------------------------ 1130proc tablelist::displayText {win key col text font pixels alignment} { 1131 upvar ::tablelist::ns${win}::data data 1132 set w $data(body).msg_$key,$col 1133 if {![winfo exists $w]} { 1134 # 1135 # Create a message widget and replace the binding tag Message with 1136 # $data(bodyTag) and TablelistBody in the list of its binding tags 1137 # 1138 message $w -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 \ 1139 -relief flat -takefocus 0 1140 bindtags $w [lreplace [bindtags $w] 1 1 $data(bodyTag) TablelistBody] 1141 } 1142 1143 variable anchors 1144 set width $pixels 1145 if {$pixels == 0} { 1146 set width 1000000 1147 } 1148 $w configure -anchor $anchors($alignment) -font $font \ 1149 -justify $alignment -text $text -width $width 1150 1151 updateColorsWhenIdle $win 1152 return $w 1153} 1154 1155#------------------------------------------------------------------------------ 1156# tablelist::getAuxData 1157# 1158# Gets the name, type, and width of the image or window associated with the 1159# specified cell of the tablelist widget win. 1160#------------------------------------------------------------------------------ 1161proc tablelist::getAuxData {win key col auxTypeName auxWidthName {pixels 0}} { 1162 upvar ::tablelist::ns${win}::data data \ 1163 $auxTypeName auxType $auxWidthName auxWidth 1164 1165 if {[info exists data($key,$col-window)]} { 1166 if {$pixels != 0 && [info exists data($key,$col-stretchwindow)]} { 1167 set auxType 3 ;# dynamic-width window 1168 set auxWidth [expr {$pixels + $data($col-delta)}] 1169 } else { 1170 set auxType 2 ;# static-width window 1171 set auxWidth $data($key,$col-reqWidth) 1172 } 1173 return $data(body).frm_$key,$col 1174 } elseif {[info exists data($key,$col-image)]} { 1175 set auxType 1 ;# image 1176 set auxWidth [image width $data($key,$col-image)] 1177 return [list ::tablelist::displayImage $win $key $col w 0] 1178 } else { 1179 set auxType 0 ;# none 1180 set auxWidth 0 1181 return "" 1182 } 1183} 1184 1185#------------------------------------------------------------------------------ 1186# tablelist::getIndentData 1187# 1188# Gets the creation script and width of the label displaying the indentation 1189# image associated with the specified cell of the tablelist widget win. 1190#------------------------------------------------------------------------------ 1191proc tablelist::getIndentData {win key col indentWidthName} { 1192 upvar ::tablelist::ns${win}::data data $indentWidthName indentWidth 1193 1194 if {[info exists data($key,$col-indent)]} { 1195 set indentWidth [image width $data($key,$col-indent)] 1196 return [list ::tablelist::displayIndent $win $key $col 0] 1197 } else { 1198 set indentWidth 0 1199 return "" 1200 } 1201} 1202 1203#------------------------------------------------------------------------------ 1204# tablelist::getMaxTextWidth 1205# 1206# Returns the number of pixels available for displaying the text of a static- 1207# width tablelist cell. 1208#------------------------------------------------------------------------------ 1209proc tablelist::getMaxTextWidth {pixels auxWidth indentWidth} { 1210 if {$indentWidth != 0} { 1211 incr pixels -$indentWidth 1212 if {$pixels <= 0} { 1213 set pixels 1 1214 } 1215 } 1216 1217 if {$auxWidth == 0} { 1218 return $pixels 1219 } else { 1220 set lessPixels [expr {$pixels - $auxWidth - 5}] 1221 if {$lessPixels > 0} { 1222 return $lessPixels 1223 } else { 1224 return 1 1225 } 1226 } 1227} 1228 1229#------------------------------------------------------------------------------ 1230# tablelist::adjustElem 1231# 1232# Prepares the text specified by $textName and the auxiliary object width 1233# specified by $auxWidthName for insertion into a cell of the tablelist widget 1234# win. 1235#------------------------------------------------------------------------------ 1236proc tablelist::adjustElem {win textName auxWidthName indentWidthName font 1237 pixels snipSide snipStr} { 1238 upvar $textName text $auxWidthName auxWidth $indentWidthName indentWidth 1239 1240 if {$pixels == 0} { ;# convention: dynamic width 1241 if {$auxWidth != 0 && [string compare $text ""] != 0} { 1242 incr auxWidth 3 1243 } 1244 } elseif {$indentWidth >= $pixels} { 1245 set indentWidth $pixels 1246 set text "" ;# can't display the text 1247 set auxWidth 0 ;# can't display the aux. object 1248 } else { 1249 incr pixels -$indentWidth 1250 if {$auxWidth == 0} { ;# no image or window 1251 set text [strRange $win $text $font $pixels $snipSide $snipStr] 1252 } elseif {[string compare $text ""] == 0} { ;# aux. object w/o text 1253 if {$auxWidth > $pixels} { 1254 set auxWidth $pixels 1255 } 1256 } else { ;# both aux. object and text 1257 if {$auxWidth + 5 <= $pixels} { 1258 incr auxWidth 3 1259 incr pixels -$auxWidth 1260 set text [strRange $win $text $font $pixels $snipSide $snipStr] 1261 } elseif {$auxWidth <= $pixels} { 1262 set text "" ;# can't display the text 1263 } else { 1264 set auxWidth $pixels 1265 set text "" ;# can't display the text 1266 } 1267 } 1268 } 1269} 1270 1271#------------------------------------------------------------------------------ 1272# tablelist::adjustMlElem 1273# 1274# Prepares the list specified by $listName and the auxiliary object width 1275# specified by $auxWidthName for insertion into a multiline cell of the 1276# tablelist widget win. 1277#------------------------------------------------------------------------------ 1278proc tablelist::adjustMlElem {win listName auxWidthName indentWidthName font 1279 pixels snipSide snipStr} { 1280 upvar $listName list $auxWidthName auxWidth $indentWidthName indentWidth 1281 1282 set list2 {} 1283 if {$pixels == 0} { ;# convention: dynamic width 1284 if {$auxWidth != 0 && [hasChars $list]} { 1285 incr auxWidth 3 1286 } 1287 } elseif {$indentWidth >= $pixels} { 1288 set indentWidth $pixels 1289 foreach str $list { 1290 lappend list2 "" 1291 } 1292 set list $list2 ;# can't display the text 1293 set auxWidth 0 ;# can't display the aux. object 1294 } else { 1295 incr pixels -$indentWidth 1296 if {$auxWidth == 0} { ;# no image or window 1297 foreach str $list { 1298 lappend list2 \ 1299 [strRange $win $str $font $pixels $snipSide $snipStr] 1300 } 1301 set list $list2 1302 } elseif {![hasChars $list]} { ;# aux. object w/o text 1303 if {$auxWidth > $pixels} { 1304 set auxWidth $pixels 1305 } 1306 } else { ;# both aux. object and text 1307 if {$auxWidth + 5 <= $pixels} { 1308 incr auxWidth 3 1309 incr pixels -$auxWidth 1310 foreach str $list { 1311 lappend list2 \ 1312 [strRange $win $str $font $pixels $snipSide $snipStr] 1313 } 1314 set list $list2 1315 } elseif {$auxWidth <= $pixels} { 1316 foreach str $list { 1317 lappend list2 "" 1318 } 1319 set list $list2 ;# can't display the text 1320 } else { 1321 set auxWidth $pixels 1322 foreach str $list { 1323 lappend list2 "" 1324 } 1325 set list $list2 ;# can't display the text 1326 } 1327 } 1328 } 1329} 1330 1331#------------------------------------------------------------------------------ 1332# tablelist::getElemWidth 1333# 1334# Returns the number of pixels that the given text together with the aux. 1335# object (image or window) of the specified width would use when displayed in a 1336# cell of a dynamic-width column of the tablelist widget win. 1337#------------------------------------------------------------------------------ 1338proc tablelist::getElemWidth {win text auxWidth indentWidth cellFont} { 1339 if {[string match "*\n*" $text]} { 1340 set list [split $text "\n"] 1341 if {$auxWidth != 0 && [hasChars $list]} { 1342 incr auxWidth 5 1343 } 1344 return [expr {[getListWidth $win $list $cellFont] + \ 1345 $auxWidth + $indentWidth}] 1346 } else { 1347 if {$auxWidth != 0 && [string compare $text ""] != 0} { 1348 incr auxWidth 5 1349 } 1350 return [expr {[font measure $cellFont -displayof $win $text] + 1351 $auxWidth + $indentWidth}] 1352 } 1353} 1354 1355#------------------------------------------------------------------------------ 1356# tablelist::insertOrUpdateIndent 1357# 1358# Sets the width of the indentation label embedded into the text widget w at 1359# the given index to the specified value, after inserting the label if needed. 1360# Returns 1 if the label had to be inserted and 0 otherwise. 1361#------------------------------------------------------------------------------ 1362proc tablelist::insertOrUpdateIndent {w index indent indentWidth} { 1363 if {[catch {$w window cget $index -create} script] == 0 && 1364 [string match "::tablelist::displayIndent *" $script]} { 1365 if {$indentWidth != [lindex $script end]} { 1366 set padY [expr {[$w cget -spacing1] == 0}] 1367 set script [lreplace $script end end $indentWidth] 1368 $w window configure $index -pady $padY -create $script 1369 1370 set path [lindex [$w dump -window $index] 1] 1371 if {[string compare $path ""] != 0} { 1372 $path configure -width $indentWidth 1373 } 1374 } 1375 return 0 1376 } else { 1377 set padY [expr {[$w cget -spacing1] == 0}] 1378 set indent [lreplace $indent end end $indentWidth] 1379 $w window create $index -pady $padY -create $indent 1380 return 1 1381 } 1382} 1383 1384#------------------------------------------------------------------------------ 1385# tablelist::insertElem 1386# 1387# Inserts the given text and auxiliary object (image or window) into the text 1388# widget w, just before the character position specified by index. The object 1389# will follow the text if alignment is "right", and will precede it otherwise. 1390#------------------------------------------------------------------------------ 1391proc tablelist::insertElem {w index text aux auxType alignment} { 1392 set index [$w index $index] 1393 1394 if {$auxType == 0} { ;# no image or window 1395 $w insert $index $text 1396 } elseif {[string compare $alignment "right"] == 0} { 1397 set padY [expr {[$w cget -spacing1] == 0}] 1398 if {$auxType == 1} { ;# image 1399 set aux [lreplace $aux 4 4 e] 1400 $w window create $index -padx 1 -pady $padY -create $aux 1401 } else { ;# window 1402 if {$auxType == 2} { ;# static width 1403 place $aux.w -anchor ne -relwidth "" -relx 1.0 1404 } else { ;# dynamic width 1405 place $aux.w -anchor ne -relwidth 1.0 -relx 1.0 1406 } 1407 $w window create $index -padx 1 -pady $padY -window $aux 1408 } 1409 $w insert $index $text 1410 } else { 1411 $w insert $index $text 1412 set padY [expr {[$w cget -spacing1] == 0}] 1413 if {$auxType == 1} { ;# image 1414 set aux [lreplace $aux 4 4 w] 1415 $w window create $index -padx 1 -pady $padY -create $aux 1416 } else { ;# window 1417 if {$auxType == 2} { ;# static width 1418 place $aux.w -anchor nw -relwidth "" -relx 0.0 1419 } else { ;# dynamic width 1420 place $aux.w -anchor nw -relwidth 1.0 -relx 0.0 1421 } 1422 $w window create $index -padx 1 -pady $padY -window $aux 1423 } 1424 } 1425} 1426 1427#------------------------------------------------------------------------------ 1428# tablelist::insertMlElem 1429# 1430# Inserts the given message widget and auxiliary object (image or window) into 1431# the text widget w, just before the character position specified by index. 1432# The object will follow the message widget if alignment is "right", and will 1433# precede it otherwise. 1434#------------------------------------------------------------------------------ 1435proc tablelist::insertMlElem {w index msgScript aux auxType alignment} { 1436 set index [$w index $index] 1437 set padY [expr {[$w cget -spacing1] == 0}] 1438 1439 if {$auxType == 0} { ;# no image or window 1440 $w window create $index -pady $padY -create $msgScript 1441 } elseif {[string compare $alignment "right"] == 0} { 1442 if {$auxType == 1} { ;# image 1443 set aux [lreplace $aux 4 4 e] 1444 $w window create $index -padx 1 -pady $padY -create $aux 1445 } else { ;# window 1446 if {$auxType == 2} { ;# static width 1447 place $aux.w -anchor ne -relwidth "" -relx 1.0 1448 } else { ;# dynamic width 1449 place $aux.w -anchor ne -relwidth 1.0 -relx 1.0 1450 } 1451 $w window create $index -padx 1 -pady $padY -window $aux 1452 } 1453 $w window create $index -pady $padY -create $msgScript 1454 } else { 1455 $w window create $index -pady $padY -create $msgScript 1456 if {$auxType == 1} { ;# image 1457 set aux [lreplace $aux 4 4 w] 1458 $w window create $index -padx 1 -pady $padY -create $aux 1459 } else { ;# window 1460 if {$auxType == 2} { ;# static width 1461 place $aux.w -anchor nw -relwidth "" -relx 0.0 1462 } else { ;# dynamic width 1463 place $aux.w -anchor nw -relwidth 1.0 -relx 0.0 1464 } 1465 $w window create $index -padx 1 -pady $padY -window $aux 1466 } 1467 } 1468} 1469 1470#------------------------------------------------------------------------------ 1471# tablelist::updateCell 1472# 1473# Updates the contents of the text widget w starting at index1 and ending just 1474# before index2 by keeping the auxiliary object (image or window) (if any) and 1475# replacing only the text between the two character positions. 1476#------------------------------------------------------------------------------ 1477proc tablelist::updateCell {w index1 index2 text aux auxType auxWidth 1478 indent indentWidth alignment} { 1479 set tagNames [$w tag names $index2] 1480 if {[lsearch -exact $tagNames select] >= 0} { ;# selected 1481 $w tag add select $index1 $index2 1482 } 1483 1484 if {$indentWidth != 0} { 1485 if {[insertOrUpdateIndent $w $index1 $indent $indentWidth]} { 1486 set index2 $index2+1c 1487 } 1488 set index1 $index1+1c 1489 } 1490 1491 if {$auxWidth == 0} { ;# no image or window 1492 $w delete $index1 $index2 1493 $w insert $index1 $text 1494 } else { 1495 # 1496 # Check whether the image label or the frame containing a 1497 # window is mapped at the first or last position of the cell 1498 # 1499 if {$auxType == 1} { ;# image 1500 if {[setImgLabelWidth $w $index1 $auxWidth]} { 1501 set auxFound 1 1502 $w delete $index1+1c $index2 1503 } elseif {[setImgLabelWidth $w $index2-1c $auxWidth]} { 1504 set auxFound 1 1505 $w delete $index1 $index2-1c 1506 } else { 1507 set auxFound 0 1508 $w delete $index1 $index2 1509 } 1510 } else { ;# window 1511 if {[$aux cget -width] != $auxWidth} { 1512 $aux configure -width $auxWidth 1513 } 1514 1515 if {[string compare [lindex [$w dump -window $index1] 1] \ 1516 $aux] == 0} { 1517 set auxFound 1 1518 $w delete $index1+1c $index2 1519 } elseif {[string compare [lindex [$w dump -window $index2-1c] 1] \ 1520 $aux] == 0} { 1521 set auxFound 1 1522 $w delete $index1 $index2-1c 1523 } else { 1524 set auxFound 0 1525 $w delete $index1 $index2 1526 } 1527 } 1528 1529 if {$auxFound} { 1530 # 1531 # Adjust the aux. window and insert the text 1532 # 1533 if {[string compare $alignment "right"] == 0} { 1534 if {$auxType == 1} { ;# image 1535 setImgLabelAnchor $w $index1 e 1536 } else { ;# window 1537 if {$auxType == 2} { ;# static width 1538 place $aux.w -anchor ne -relwidth "" -relx 1.0 1539 } else { ;# dynamic width 1540 place $aux.w -anchor ne -relwidth 1.0 -relx 1.0 1541 } 1542 } 1543 set index $index1 1544 } else { 1545 if {$auxType == 1} { ;# image 1546 setImgLabelAnchor $w $index1 w 1547 } else { ;# window 1548 if {$auxType == 2} { ;# static width 1549 place $aux.w -anchor nw -relwidth "" -relx 0.0 1550 } else { ;# dynamic width 1551 place $aux.w -anchor nw -relwidth 1.0 -relx 0.0 1552 } 1553 } 1554 set index $index1+1c 1555 } 1556 $w insert $index $text 1557 } else { 1558 # 1559 # Insert the text and the aux. window 1560 # 1561 if {$auxType == 1} { ;# image 1562 set aux [lreplace $aux end end $auxWidth] 1563 } else { ;# window 1564 if {[$aux cget -width] != $auxWidth} { 1565 $aux configure -width $auxWidth 1566 } 1567 } 1568 insertElem $w $index1 $text $aux $auxType $alignment 1569 } 1570 } 1571} 1572 1573#------------------------------------------------------------------------------ 1574# tablelist::updateMlCell 1575# 1576# Updates the contents of the text widget w starting at index1 and ending just 1577# before index2 by keeping the auxiliary object (image or window) (if any) and 1578# replacing only the multiline text between the two character positions. 1579#------------------------------------------------------------------------------ 1580proc tablelist::updateMlCell {w index1 index2 msgScript aux auxType auxWidth 1581 indent indentWidth alignment} { 1582 set tagNames [$w tag names $index2] 1583 if {[lsearch -exact $tagNames select] >= 0} { ;# selected 1584 $w tag add select $index1 $index2 1585 } 1586 1587 if {$indentWidth != 0} { 1588 if {[insertOrUpdateIndent $w $index1 $indent $indentWidth]} { 1589 set index2 $index2+1c 1590 } 1591 set index1 $index1+1c 1592 } 1593 1594 if {$auxWidth == 0} { ;# no image or window 1595 set areEqual [$w compare $index1 == $index2] 1596 $w delete $index1+1c $index2 1597 set padY [expr {[$w cget -spacing1] == 0}] 1598 if {[catch {$w window cget $index1 -create} script] == 0 && 1599 [string match "::tablelist::displayText*" $script]} { 1600 $w window configure $index1 -pady $padY -create $msgScript 1601 1602 set path [lindex [$w dump -window $index1] 1] 1603 if {[string compare $path ""] != 0 && 1604 [string compare [winfo class $path] "Message"] == 0} { 1605 eval $msgScript 1606 } 1607 } else { 1608 if {!$areEqual} { 1609 $w delete $index1 1610 } 1611 $w window create $index1 -pady $padY -create $msgScript 1612 } 1613 } else { 1614 # 1615 # Check whether the image label or the frame containing a 1616 # window is mapped at the first or last position of the cell 1617 # 1618 $w mark set index2Mark $index2 1619 if {$auxType == 1} { ;# image 1620 if {[setImgLabelWidth $w $index1 $auxWidth]} { 1621 set auxFound 1 1622 if {[string compare $alignment "right"] == 0} { 1623 $w delete $index1+1c $index2 1624 } 1625 } elseif {[setImgLabelWidth $w $index2-1c $auxWidth]} { 1626 set auxFound 1 1627 if {[string compare $alignment "right"] != 0} { 1628 $w delete $index1 $index2-1c 1629 } 1630 } else { 1631 set auxFound 0 1632 $w delete $index1 $index2 1633 } 1634 } else { ;# window 1635 if {[$aux cget -width] != $auxWidth} { 1636 $aux configure -width $auxWidth 1637 } 1638 1639 if {[string compare [lindex [$w dump -window $index1] 1] \ 1640 $aux] == 0} { 1641 set auxFound 1 1642 if {[string compare $alignment "right"] == 0} { 1643 $w delete $index1+1c $index2 1644 } 1645 } elseif {[string compare [lindex [$w dump -window $index2-1c] 1] \ 1646 $aux] == 0} { 1647 set auxFound 1 1648 if {[string compare $alignment "right"] != 0} { 1649 $w delete $index1 $index2-1c 1650 } 1651 } else { 1652 set auxFound 0 1653 $w delete $index1 $index2 1654 } 1655 } 1656 1657 if {$auxFound} { 1658 # 1659 # Adjust the aux. window and insert the message widget 1660 # 1661 if {[string compare $alignment "right"] == 0} { 1662 if {$auxType == 1} { ;# image 1663 setImgLabelAnchor $w index2Mark-1c e 1664 } else { ;# window 1665 if {$auxType == 2} { ;# static width 1666 place $aux.w -anchor ne -relwidth "" -relx 1.0 1667 } else { ;# dynamic width 1668 place $aux.w -anchor ne -relwidth 1.0 -relx 1.0 1669 } 1670 } 1671 set index index2Mark-2c 1672 } else { 1673 if {$auxType == 1} { ;# image 1674 setImgLabelAnchor $w $index1 w 1675 } else { ;# window 1676 if {$auxType == 2} { ;# static width 1677 place $aux.w -anchor nw -relwidth "" -relx 0.0 1678 } else { ;# dynamic width 1679 place $aux.w -anchor nw -relwidth 1.0 -relx 0.0 1680 } 1681 } 1682 set index $index1+1c 1683 } 1684 1685 set padY [expr {[$w cget -spacing1] == 0}] 1686 if {[catch {$w window cget $index -create} script] == 0 && 1687 [string match "::tablelist::displayText*" $script]} { 1688 $w window configure $index -pady $padY -create $msgScript 1689 1690 set path [lindex [$w dump -window $index] 1] 1691 if {[string compare $path ""] != 0 && 1692 [string compare [winfo class $path] "Message"] == 0} { 1693 eval $msgScript 1694 } 1695 } elseif {[string compare $alignment "right"] == 0} { 1696 $w window create index2Mark-1c -pady $padY -create $msgScript 1697 $w delete $index1 index2Mark-2c 1698 } else { 1699 $w window create $index1+1c -pady $padY -create $msgScript 1700 $w delete $index1+2c index2Mark 1701 } 1702 } else { 1703 # 1704 # Insert the message and aux. windows 1705 # 1706 if {$auxType == 1} { ;# image 1707 set aux [lreplace $aux end end $auxWidth] 1708 } else { ;# window 1709 if {[$aux cget -width] != $auxWidth} { 1710 $aux configure -width $auxWidth 1711 } 1712 } 1713 insertMlElem $w $index1 $msgScript $aux $auxType $alignment 1714 } 1715 } 1716} 1717 1718#------------------------------------------------------------------------------ 1719# tablelist::setImgLabelWidth 1720# 1721# Sets the width of the image label embedded into the text widget w at the 1722# given index to the specified value. 1723#------------------------------------------------------------------------------ 1724proc tablelist::setImgLabelWidth {w index width} { 1725 if {[catch {$w window cget $index -create} script] == 0 && 1726 [string match "::tablelist::displayImage *" $script]} { 1727 if {$width != [lindex $script end]} { 1728 set padY [expr {[$w cget -spacing1] == 0}] 1729 set script [lreplace $script end end $width] 1730 $w window configure $index -pady $padY -create $script 1731 1732 set path [lindex [$w dump -window $index] 1] 1733 if {[string compare $path ""] != 0} { 1734 $path configure -width $width 1735 } 1736 } 1737 1738 return 1 1739 } else { 1740 return 0 1741 } 1742} 1743 1744#------------------------------------------------------------------------------ 1745# tablelist::setImgLabelAnchor 1746# 1747# Sets the anchor of the image label embedded into the text widget w at the 1748# given index to the specified value. 1749#------------------------------------------------------------------------------ 1750proc tablelist::setImgLabelAnchor {w index anchor} { 1751 set script [$w window cget $index -create] 1752 if {[string compare $anchor [lindex $script 4]] != 0} { 1753 set padY [expr {[$w cget -spacing1] == 0}] 1754 set script [lreplace $script 4 4 $anchor] 1755 $w window configure $index -pady $padY -create $script 1756 1757 set path [lindex [$w dump -window $index] 1] 1758 if {[string compare $path ""] != 0} { 1759 $path configure -anchor $anchor 1760 } 1761 } 1762} 1763 1764#------------------------------------------------------------------------------ 1765# tablelist::appendComplexElem 1766# 1767# Adjusts the given text and the width of the auxiliary object (image or 1768# window) corresponding to the specified cell of the tablelist widget win, and 1769# inserts the text and the auxiliary object (if any) just before the newline 1770# character at the end of the specified line of the tablelist's body. 1771#------------------------------------------------------------------------------ 1772proc tablelist::appendComplexElem {win key row col text pixels alignment 1773 snipStr cellFont cellTags line} { 1774 # 1775 # Adjust the cell text and the image or window width 1776 # 1777 set multiline [string match "*\n*" $text] 1778 upvar ::tablelist::ns${win}::data data 1779 if {$pixels == 0} { ;# convention: dynamic width 1780 if {$data($col-maxPixels) > 0} { 1781 if {$data($col-reqPixels) > $data($col-maxPixels)} { 1782 set pixels $data($col-maxPixels) 1783 } 1784 } 1785 } 1786 set aux [getAuxData $win $key $col auxType auxWidth $pixels] 1787 set indent [getIndentData $win $key $col indentWidth] 1788 set maxTextWidth $pixels 1789 if {$pixels != 0} { 1790 incr pixels $data($col-delta) 1791 set maxTextWidth [getMaxTextWidth $pixels $auxWidth $indentWidth] 1792 1793 if {$data($col-wrap) && !$multiline} { 1794 if {[font measure $cellFont -displayof $win $text] > \ 1795 $maxTextWidth} { 1796 set multiline 1 1797 } 1798 } 1799 } 1800 variable snipSides 1801 set snipSide $snipSides($alignment,$data($col-changesnipside)) 1802 if {$multiline} { 1803 set list [split $text "\n"] 1804 if {$data($col-wrap)} { 1805 set snipSide "" 1806 } 1807 adjustMlElem $win list auxWidth indentWidth $cellFont $pixels \ 1808 $snipSide $snipStr 1809 set msgScript [list ::tablelist::displayText $win $key $col \ 1810 [join $list "\n"] $cellFont $maxTextWidth $alignment] 1811 } else { 1812 adjustElem $win text auxWidth indentWidth $cellFont $pixels \ 1813 $snipSide $snipStr 1814 } 1815 1816 # 1817 # Insert the text and the auxiliary object (if any) just before the newline 1818 # 1819 set w $data(body) 1820 set idx [$w index $line.end] 1821 if {$auxWidth == 0} { ;# no image or window 1822 if {$multiline} { 1823 $w insert $line.end "\t\t" $cellTags 1824 set padY [expr {[$w cget -spacing1] == 0}] 1825 $w window create $line.end-1c -pady $padY -create $msgScript 1826 } else { 1827 $w insert $line.end "\t$text\t" $cellTags 1828 } 1829 } else { 1830 $w insert $line.end "\t\t" $cellTags 1831 if {$auxType == 1} { ;# image 1832 # 1833 # Update the creation script for the image label 1834 # 1835 set aux [lreplace $aux end end $auxWidth] 1836 } else { ;# window 1837 # 1838 # Create a frame and evaluate the script that 1839 # creates a child window within the frame 1840 # 1841 tk::frame $aux -borderwidth 0 -class TablelistWindow -container 0 \ 1842 -height $data($key,$col-reqHeight) \ 1843 -highlightthickness 0 -relief flat \ 1844 -takefocus 0 -width $auxWidth 1845 catch {$aux configure -padx 0 -pady 0} 1846 bindtags $aux [linsert [bindtags $aux] 1 \ 1847 $data(bodyTag) TablelistBody] 1848 uplevel #0 $data($key,$col-window) [list $win $row $col $aux.w] 1849 } 1850 if {$multiline} { 1851 insertMlElem $w $line.end-1c $msgScript $aux $auxType $alignment 1852 } else { 1853 insertElem $w $line.end-1c $text $aux $auxType $alignment 1854 } 1855 } 1856 1857 # 1858 # Insert the indentation image, if any 1859 # 1860 if {$indentWidth != 0} { 1861 insertOrUpdateIndent $w $idx+1c $indent $indentWidth 1862 } 1863} 1864 1865#------------------------------------------------------------------------------ 1866# tablelist::makeColFontAndTagLists 1867# 1868# Builds the lists data(colFontList) of the column fonts and data(colTagsList) 1869# of the column tag names for the tablelist widget win. 1870#------------------------------------------------------------------------------ 1871proc tablelist::makeColFontAndTagLists win { 1872 upvar ::tablelist::ns${win}::data data 1873 set widgetFont $data(-font) 1874 set data(colFontList) {} 1875 set data(colTagsList) {} 1876 set data(hasColTags) 0 1877 set viewable [winfo viewable $win] 1878 variable canElide 1879 1880 for {set col 0} {$col < $data(colCount)} {incr col} { 1881 set tagNames {} 1882 1883 if {[info exists data($col-font)]} { 1884 lappend data(colFontList) $data($col-font) 1885 lappend tagNames col-font-$data($col-font) 1886 set data(hasColTags) 1 1887 } else { 1888 lappend data(colFontList) $widgetFont 1889 } 1890 1891 foreach opt {-background -foreground} { 1892 if {[info exists data($col$opt)]} { 1893 lappend tagNames col$opt-$data($col$opt) 1894 set data(hasColTags) 1 1895 } 1896 } 1897 1898 if {$viewable && $data($col-hide) && $canElide} { 1899 lappend tagNames hiddenCol 1900 set data(hasColTags) 1 1901 } 1902 1903 lappend data(colTagsList) $tagNames 1904 } 1905} 1906 1907#------------------------------------------------------------------------------ 1908# tablelist::makeSortAndArrowColLists 1909# 1910# Builds the lists data(sortColList) of the sort columns and data(arrowColList) 1911# of the arrow columns for the tablelist widget win. 1912#------------------------------------------------------------------------------ 1913proc tablelist::makeSortAndArrowColLists win { 1914 upvar ::tablelist::ns${win}::data data 1915 set data(sortColList) {} 1916 set data(arrowColList) {} 1917 1918 # 1919 # Build a list of {col sortRank} pairs and sort it based on sortRank 1920 # 1921 set pairList {} 1922 for {set col 0} {$col < $data(colCount)} {incr col} { 1923 if {$data($col-sortRank) > 0} { 1924 lappend pairList [list $col $data($col-sortRank)] 1925 } 1926 } 1927 set pairList [lsort -integer -index 1 $pairList] 1928 1929 # 1930 # Build data(sortColList) and data(arrowColList), and update 1931 # the sort ranks to have values from 1 to [llength $pairList] 1932 # 1933 set sortRank 1 1934 foreach pair $pairList { 1935 set col [lindex $pair 0] 1936 lappend data(sortColList) $col 1937 set data($col-sortRank) $sortRank 1938 if {$sortRank < 10 && $data(-showarrow) && $data($col-showarrow)} { 1939 lappend data(arrowColList) $col 1940 configCanvas $win $col 1941 raiseArrow $win $col 1942 } 1943 incr sortRank 1944 } 1945 1946 # 1947 # Special handling for the "aqua" theme if Cocoa is being used: 1948 # Deselect all header labels and select that of the main sort column 1949 # 1950 variable usingTile 1951 if {$usingTile && [string compare [getCurrentTheme] "aqua"] == 0 && 1952 [lsearch -exact [winfo server .] "AppKit"] >= 0} { ;# using Cocoa 1953 for {set col 0} {$col < $data(colCount)} {incr col} { 1954 configLabel $data(hdrTxtFrLbl)$col -selected 0 1955 } 1956 1957 if {[llength $data(sortColList)] != 0} { 1958 set col [lindex $data(sortColList) 0] 1959 configLabel $data(hdrTxtFrLbl)$col -selected 1 1960 } 1961 } 1962} 1963 1964#------------------------------------------------------------------------------ 1965# tablelist::setupColumns 1966# 1967# Updates the value of the -colums configuration option for the tablelist 1968# widget win by using the width, title, and alignment specifications given in 1969# the columns argument, and creates the corresponding label (and separator) 1970# widgets if createLabels is true. 1971#------------------------------------------------------------------------------ 1972proc tablelist::setupColumns {win columns createLabels} { 1973 variable usingTile 1974 variable configSpecs 1975 variable configOpts 1976 variable alignments 1977 upvar ::tablelist::ns${win}::data data 1978 1979 set argCount [llength $columns] 1980 set colConfigVals {} 1981 1982 # 1983 # Check the syntax of columns before performing any changes 1984 # 1985 for {set n 0} {$n < $argCount} {incr n} { 1986 # 1987 # Get the column width 1988 # 1989 set width [lindex $columns $n] 1990 set width [format "%d" $width] ;# integer check with error message 1991 1992 # 1993 # Get the column title 1994 # 1995 if {[incr n] == $argCount} { 1996 return -code error "column title missing" 1997 } 1998 set title [lindex $columns $n] 1999 2000 # 2001 # Get the column alignment 2002 # 2003 set alignment left 2004 if {[incr n] < $argCount} { 2005 set next [lindex $columns $n] 2006 if {[catch {format "%d" $next}] == 0} { ;# integer check 2007 incr n -1 2008 } else { 2009 set alignment [mwutil::fullOpt "alignment" $next $alignments] 2010 } 2011 } 2012 2013 # 2014 # Append the properly formatted values of width, 2015 # title, and alignment to the list colConfigVals 2016 # 2017 lappend colConfigVals $width $title $alignment 2018 } 2019 2020 # 2021 # Save the value of colConfigVals in data(-columns) 2022 # 2023 set data(-columns) $colConfigVals 2024 2025 # 2026 # Delete the labels, canvases, and separators if requested 2027 # 2028 if {$createLabels} { 2029 foreach w [winfo children $data(hdrTxtFr)] { 2030 destroy $w 2031 } 2032 foreach w [winfo children $win] { 2033 if {[regexp {^sep[0-9]+$} [winfo name $w]]} { 2034 destroy $w 2035 } 2036 } 2037 set data(fmtCmdFlagList) {} 2038 set data(hiddenColCount) 0 2039 } 2040 2041 # 2042 # Build the list data(colList), and create 2043 # the labels and canvases if requested 2044 # 2045 regexp {^(flat|sunken)([0-9]+)x([0-9]+)$} $data(-arrowstyle) \ 2046 dummy arrowRelief arrowWidth arrowHeight 2047 set widgetFont $data(-font) 2048 set oldColCount $data(colCount) 2049 set data(colList) {} 2050 set data(colCount) 0 2051 set data(lastCol) -1 2052 set col 0 2053 foreach {width title alignment} $data(-columns) { 2054 # 2055 # Append the width in pixels and the 2056 # alignment to the list data(colList) 2057 # 2058 if {$width > 0} { ;# convention: width in characters 2059 set pixels [charsToPixels $win $widgetFont $width] 2060 set data($col-lastStaticWidth) $pixels 2061 } elseif {$width < 0} { ;# convention: width in pixels 2062 set pixels [expr {(-1)*$width}] 2063 set data($col-lastStaticWidth) $pixels 2064 } else { ;# convention: dynamic width 2065 set pixels 0 2066 } 2067 lappend data(colList) $pixels $alignment 2068 incr data(colCount) 2069 set data(lastCol) $col 2070 2071 if {$createLabels} { 2072 set data($col-elide) 0 2073 foreach {name val} {delta 0 lastStaticWidth 0 maxPixels 0 2074 sortOrder "" sortRank 0 isSnipped 0 2075 changesnipside 0 editable 0 editwindow entry 2076 hide 0 maxwidth 0 resizable 1 showarrow 1 2077 showlinenumbers 0 sortmode ascii wrap 0} { 2078 if {![info exists data($col-$name)]} { 2079 set data($col-$name) $val 2080 } 2081 } 2082 lappend data(fmtCmdFlagList) [info exists data($col-formatcommand)] 2083 incr data(hiddenColCount) $data($col-hide) 2084 2085 # 2086 # Create the label 2087 # 2088 set w $data(hdrTxtFrLbl)$col 2089 if {$usingTile} { 2090 ttk::label $w -style TablelistHeader.TLabel -image "" \ 2091 -padding {1 1 1 1} -takefocus 0 -text "" \ 2092 -textvariable "" -underline -1 -wraplength 0 2093 } else { 2094 tk::label $w -bitmap "" -highlightthickness 0 -image "" \ 2095 -takefocus 0 -text "" -textvariable "" \ 2096 -underline -1 -wraplength 0 2097 } 2098 2099 # 2100 # Apply to it the current configuration options 2101 # 2102 foreach opt $configOpts { 2103 set optGrp [lindex $configSpecs($opt) 2] 2104 if {[string compare $optGrp "l"] == 0} { 2105 set optTail [string range $opt 6 end] 2106 if {[info exists data($col$opt)]} { 2107 configLabel $w -$optTail $data($col$opt) 2108 } else { 2109 configLabel $w -$optTail $data($opt) 2110 } 2111 } elseif {[string compare $optGrp "c"] == 0} { 2112 configLabel $w $opt $data($opt) 2113 } 2114 } 2115 catch {configLabel $w -state $data(-state)} 2116 2117 # 2118 # Replace the binding tag (T)Label with $data(labelTag) and 2119 # TablelistLabel in the list of binding tags of the label 2120 # 2121 bindtags $w [lreplace [bindtags $w] 1 1 \ 2122 $data(labelTag) TablelistLabel] 2123 2124 # 2125 # Create a canvas containing the sort arrows 2126 # 2127 set w $data(hdrTxtFrCanv)$col 2128 canvas $w -borderwidth 0 -highlightthickness 0 \ 2129 -relief flat -takefocus 0 2130 createArrows $w $arrowWidth $arrowHeight $arrowRelief 2131 2132 # 2133 # Apply to it the current configuration options 2134 # 2135 foreach opt $configOpts { 2136 if {[string compare [lindex $configSpecs($opt) 2] "c"] == 0} { 2137 $w configure $opt $data($opt) 2138 } 2139 } 2140 2141 # 2142 # Replace the binding tag Canvas with $data(labelTag) and 2143 # TablelistArrow in the list of binding tags of the canvas 2144 # 2145 bindtags $w [lreplace [bindtags $w] 1 1 \ 2146 $data(labelTag) TablelistArrow] 2147 2148 if {[info exists data($col-labelimage)]} { 2149 doColConfig $col $win -labelimage $data($col-labelimage) 2150 } 2151 } 2152 2153 # 2154 # Configure the edit window if present 2155 # 2156 if {$col == $data(editCol) && 2157 [string compare [winfo class $data(bodyFrEd)] "Mentry"] != 0} { 2158 catch {$data(bodyFrEd) configure -justify $alignment} 2159 } 2160 2161 incr col 2162 } 2163 set data(hasFmtCmds) [expr {[lsearch -exact $data(fmtCmdFlagList) 1] >= 0}] 2164 2165 # 2166 # Clean up the data and attributes associated with the deleted columns 2167 # 2168 for {set col $data(colCount)} {$col < $oldColCount} {incr col} { 2169 deleteColData $win $col 2170 deleteColAttribs $win $col 2171 } 2172 2173 # 2174 # Update data(-treecolumn) and data(treeCol) if needed 2175 # 2176 if {$createLabels} { 2177 set treeCol $data(-treecolumn) 2178 adjustColIndex $win treeCol 2179 set data(treeCol) $treeCol 2180 if {$data(colCount) != 0} { 2181 set data(-treecolumn) $treeCol 2182 } 2183 } 2184 2185 # 2186 # Create the separators if needed 2187 # 2188 if {$createLabels && $data(-showseparators)} { 2189 createSeps $win 2190 } 2191} 2192 2193#------------------------------------------------------------------------------ 2194# tablelist::createSeps 2195# 2196# Creates and manages the separators in the tablelist widget win. 2197#------------------------------------------------------------------------------ 2198proc tablelist::createSeps win { 2199 set sepX [getSepX] 2200 variable usingTile 2201 upvar ::tablelist::ns${win}::data data 2202 for {set col 0} {$col < $data(colCount)} {incr col} { 2203 # 2204 # Create the col'th separator and attach it to 2205 # the right edge of the col'th header label 2206 # 2207 set w $data(sep)$col 2208 if {$usingTile} { 2209 ttk::separator $w -style Seps$win.TSeparator \ 2210 -cursor $data(-cursor) -orient vertical \ 2211 -takefocus 0 2212 } else { 2213 tk::frame $w -background $data(-background) -borderwidth 1 \ 2214 -container 0 -cursor $data(-cursor) \ 2215 -highlightthickness 0 -relief sunken \ 2216 -takefocus 0 -width 2 2217 } 2218 place $w -in $data(hdrTxtFrLbl)$col -anchor ne -bordermode outside \ 2219 -relx 1.0 -x $sepX 2220 2221 # 2222 # Replace the binding tag TSeparator or Frame with $data(bodyTag) 2223 # and TablelistBody in the list of binding tags of the separator 2224 # 2225 bindtags $w [lreplace [bindtags $w] 1 1 $data(bodyTag) TablelistBody] 2226 } 2227 2228 adjustSepsWhenIdle $win 2229} 2230 2231#------------------------------------------------------------------------------ 2232# tablelist::adjustSepsWhenIdle 2233# 2234# Arranges for the height and vertical position of each separator in the 2235# tablelist widget win to be adjusted at idle time. 2236#------------------------------------------------------------------------------ 2237proc tablelist::adjustSepsWhenIdle win { 2238 upvar ::tablelist::ns${win}::data data 2239 if {[info exists data(sepsId)]} { 2240 return "" 2241 } 2242 2243 set data(sepsId) [after idle [list tablelist::adjustSeps $win]] 2244} 2245 2246#------------------------------------------------------------------------------ 2247# tablelist::adjustSeps 2248# 2249# Adjusts the height and vertical position of each separator in the tablelist 2250# widget win. 2251#------------------------------------------------------------------------------ 2252proc tablelist::adjustSeps win { 2253 upvar ::tablelist::ns${win}::data data 2254 if {[info exists data(sepsId)]} { 2255 after cancel $data(sepsId) 2256 unset data(sepsId) 2257 } 2258 2259 # 2260 # Get the height to be applied to the separators 2261 # 2262 set w $data(body) 2263 set textIdx [$w index @0,$data(btmY)] 2264 set dlineinfo [$w dlineinfo $textIdx] 2265 if {$data(itemCount) == 0 || [string compare $dlineinfo ""] == 0} { 2266 set sepHeight 1 2267 } else { 2268 foreach {x y width height baselinePos} $dlineinfo {} 2269 set sepHeight [expr {$y + $height}] 2270 } 2271 2272 # 2273 # Set the height of the main separator (if any) and attach the 2274 # latter to the right edge of the last non-hidden title column 2275 # 2276 set startCol [expr {$data(-titlecolumns) - 1}] 2277 if {$startCol > $data(lastCol)} { 2278 set startCol $data(lastCol) 2279 } 2280 for {set col $startCol} {$col >= 0} {incr col -1} { 2281 if {!$data($col-hide)} { 2282 break 2283 } 2284 } 2285 set w $data(sep) 2286 if {$col < 0} { 2287 if {[winfo exists $w]} { 2288 place forget $w 2289 } 2290 } else { 2291 place $w -in $data(hdrTxtFrLbl)$col -anchor ne -bordermode outside \ 2292 -height [expr {$sepHeight + [winfo height $data(hdr)] - 1}] \ 2293 -relx 1.0 -x [getSepX] -y 1 2294 if {!$data(-showlabels)} { 2295 place configure $w -y 2 2296 } 2297 raise $w 2298 } 2299 2300 # 2301 # Set the height and vertical position of each separator 2302 # 2303 variable usingTile 2304 if {$data(-showlabels)} { 2305 set relY 1.0 2306 if {$usingTile} { 2307 set y 0 2308 } else { 2309 incr sepHeight 2310 set y -1 2311 } 2312 } else { 2313 set relY 0.0 2314 set y 2 2315 } 2316 foreach w [winfo children $win] { 2317 if {[regexp {^sep[0-9]+$} [winfo name $w]]} { 2318 place configure $w -height $sepHeight -rely $relY -y $y 2319 } 2320 } 2321} 2322 2323#------------------------------------------------------------------------------ 2324# tablelist::getSepX 2325# 2326# Returns the value of the -x option to be used when placing a separator 2327# relative to the corresponding header label, with -anchor ne. 2328#------------------------------------------------------------------------------ 2329proc tablelist::getSepX {} { 2330 set x 1 2331 variable usingTile 2332 if {$usingTile} { 2333 set currentTheme [getCurrentTheme] 2334 variable xpStyle 2335 if {([string compare $currentTheme "aqua"] == 0) || 2336 ([string compare $currentTheme "xpnative"] == 0 && $xpStyle)} { 2337 set x 0 2338 } elseif {[string compare $currentTheme "tileqt"] == 0 && 2339 [string compare [string tolower [tileqt_currentThemeName]] \ 2340 "qtcurve"] == 0} { 2341 set x 2 2342 } 2343 } 2344 2345 return $x 2346} 2347 2348#------------------------------------------------------------------------------ 2349# tablelist::adjustColumns 2350# 2351# Applies some configuration options to the labels of the tablelist widget win, 2352# places them in the header frame, computes and sets the tab stops for the body 2353# text widget, and adjusts the width and height of the header frame. The 2354# whichWidths argument specifies the dynamic-width columns or labels whose 2355# widths are to be computed when performing these operations. The stretchCols 2356# argument specifies whether to stretch the stretchable columns. 2357#------------------------------------------------------------------------------ 2358proc tablelist::adjustColumns {win whichWidths stretchCols} { 2359 set compAllColWidths [expr {[string compare $whichWidths "allCols"] == 0}] 2360 set compAllLabelWidths \ 2361 [expr {[string compare $whichWidths "allLabels"] == 0}] 2362 2363 variable usingTile 2364 set usingAquaTheme \ 2365 [expr {$usingTile && [string compare [getCurrentTheme] "aqua"] == 0}] 2366 2367 # 2368 # Configure the labels and compute the positions of 2369 # the tab stops to be set in the body text widget 2370 # 2371 upvar ::tablelist::ns${win}::data data 2372 set data(hdrPixels) 0 2373 variable canElide 2374 set tabs {} 2375 set col 0 2376 set x 0 2377 foreach {pixels alignment} $data(colList) { 2378 set w $data(hdrTxtFrLbl)$col 2379 if {$data($col-hide) && !$canElide} { 2380 place forget $w 2381 incr col 2382 continue 2383 } 2384 2385 # 2386 # Adjust the col'th label 2387 # 2388 if {[info exists data($col-labelalign)]} { 2389 set labelAlignment $data($col-labelalign) 2390 } else { 2391 set labelAlignment $alignment 2392 } 2393 if {$pixels != 0} { ;# convention: static width 2394 incr pixels $data($col-delta) 2395 } 2396 adjustLabel $win $col $pixels $labelAlignment 2397 2398 if {$pixels == 0} { ;# convention: dynamic width 2399 # 2400 # Compute the column or label width if requested 2401 # 2402 if {$compAllColWidths || [lsearch -exact $whichWidths $col] >= 0} { 2403 computeColWidth $win $col 2404 } elseif {$compAllLabelWidths || 2405 [lsearch -exact $whichWidths l$col] >= 0} { 2406 computeLabelWidth $win $col 2407 } 2408 2409 set pixels $data($col-reqPixels) 2410 if {$data($col-maxPixels) > 0 && $pixels > $data($col-maxPixels)} { 2411 set pixels $data($col-maxPixels) 2412 incr pixels $data($col-delta) 2413 adjustLabel $win $col $pixels $labelAlignment 2414 } else { 2415 incr pixels $data($col-delta) 2416 } 2417 } 2418 2419 if {$col == $data(editCol) && 2420 ![string match "*Checkbutton" [winfo class $data(bodyFrEd)]]} { 2421 adjustEditWindow $win $pixels 2422 } 2423 2424 set canvas $data(hdrTxtFrCanv)$col 2425 if {[lsearch -exact $data(arrowColList) $col] >= 0 && 2426 !$data($col-elide) && !$data($col-hide)} { 2427 # 2428 # Place the canvas to the left side of the label if the 2429 # latter is right-justified and to its right side otherwise 2430 # 2431 set y 0 2432 if {([winfo reqheight $w] - [winfo reqheight $canvas]) % 2 == 0 && 2433 $data(arrowHeight) == 5} { 2434 set y -1 2435 } 2436 if {[string compare $labelAlignment "right"] == 0} { 2437 place $canvas -in $w -anchor w -bordermode outside \ 2438 -relx 0.0 -x $data(charWidth) -rely 0.49 -y $y 2439 } else { 2440 place $canvas -in $w -anchor e -bordermode outside \ 2441 -relx 1.0 -x -$data(charWidth) -rely 0.49 -y $y 2442 } 2443 raise $canvas 2444 } else { 2445 place forget $canvas 2446 } 2447 2448 # 2449 # Place the label in the header frame 2450 # 2451 if {$data($col-elide) || $data($col-hide)} { 2452 foreach l [getSublabels $w] { 2453 place forget $l 2454 } 2455 place $w -x [expr {$x - 1}] -relheight 1.0 -width 1 2456 lower $w 2457 } else { 2458 set labelPixels [expr {$pixels + 2*$data(charWidth)}] 2459 if {$usingAquaTheme && $col < $data(lastCol)} { 2460 incr labelPixels 2461 } 2462 place $w -x $x -relheight 1.0 -width $labelPixels 2463 } 2464 2465 # 2466 # Append a tab stop and the alignment to the tabs list 2467 # 2468 if {!$data($col-elide) && !$data($col-hide)} { 2469 incr x $data(charWidth) 2470 switch $alignment { 2471 left { 2472 lappend tabs $x left 2473 incr x $pixels 2474 } 2475 right { 2476 incr x $pixels 2477 lappend tabs $x right 2478 } 2479 center { 2480 lappend tabs [expr {$x + $pixels/2}] center 2481 incr x $pixels 2482 } 2483 } 2484 incr x $data(charWidth) 2485 lappend tabs $x left 2486 } 2487 2488 incr col 2489 } 2490 if {$usingAquaTheme} { 2491 place $data(hdrLbl) -x [expr {$x - 1}] 2492 } else { 2493 place $data(hdrLbl) -x $x 2494 } 2495 2496 # 2497 # Apply the value of tabs to the body text widget 2498 # 2499 if {[info exists data(colBeingResized)]} { 2500 $data(body) tag configure visibleLines -tabs $tabs 2501 } else { 2502 $data(body) configure -tabs $tabs 2503 } 2504 2505 # 2506 # Adjust the width and height of the frames data(hdrTxtFr) and data(hdr) 2507 # 2508 set data(hdrPixels) $x 2509 $data(hdrTxtFr) configure -width $data(hdrPixels) 2510 if {$data(-width) <= 0} { 2511 if {$stretchCols} { 2512 $data(hdr) configure -width $data(hdrPixels) 2513 $data(lb) configure -width \ 2514 [expr {$data(hdrPixels) / $data(charWidth)}] 2515 } 2516 } else { 2517 $data(hdr) configure -width 0 2518 } 2519 adjustHeaderHeight $win 2520 2521 # 2522 # Stretch the stretchable columns if requested, and update 2523 # the scrolled column offset and the horizontal scrollbar 2524 # 2525 if {$stretchCols} { 2526 stretchColumnsWhenIdle $win 2527 } 2528 if {![info exists data(colBeingResized)]} { 2529 updateScrlColOffsetWhenIdle $win 2530 } 2531 updateHScrlbarWhenIdle $win 2532} 2533 2534#------------------------------------------------------------------------------ 2535# tablelist::adjustLabel 2536# 2537# Applies some configuration options to the col'th label of the tablelist 2538# widget win as well as to the label's sublabels (if any), and places the 2539# sublabels. 2540#------------------------------------------------------------------------------ 2541proc tablelist::adjustLabel {win col pixels alignment} { 2542 # 2543 # Apply some configuration options to the label and its sublabels (if any) 2544 # 2545 upvar ::tablelist::ns${win}::data data 2546 set w $data(hdrTxtFrLbl)$col 2547 variable anchors 2548 set anchor $anchors($alignment) 2549 set borderWidth [winfo pixels $w [$w cget -borderwidth]] 2550 if {$borderWidth < 0} { 2551 set borderWidth 0 2552 } 2553 set padX [expr {$data(charWidth) - $borderWidth}] 2554 configLabel $w -anchor $anchor -justify $alignment -padx $padX 2555 if {[info exists data($col-labelimage)]} { 2556 set imageWidth [image width $data($col-labelimage)] 2557 $w-tl configure -anchor $anchor -justify $alignment 2558 } else { 2559 set imageWidth 0 2560 } 2561 2562 # 2563 # Make room for the canvas displaying an up- or down-arrow if needed 2564 # 2565 set title [lindex $data(-columns) [expr {3*$col + 1}]] 2566 set labelFont [$w cget -font] 2567 if {[lsearch -exact $data(arrowColList) $col] >= 0} { 2568 set spaceWidth [font measure $labelFont -displayof $w " "] 2569 set canvas $data(hdrTxtFrCanv)$col 2570 set canvasWidth $data(arrowWidth) 2571 if {[llength $data(arrowColList)] > 1} { 2572 incr canvasWidth 6 2573 $canvas itemconfigure sortRank \ 2574 -image sortRank$data($col-sortRank)$win 2575 } 2576 $canvas configure -width $canvasWidth 2577 set spaces " " 2578 set n 2 2579 while {$n*$spaceWidth < $canvasWidth + $data(charWidth)} { 2580 append spaces " " 2581 incr n 2582 } 2583 set spacePixels [expr {$n * $spaceWidth}] 2584 } else { 2585 set spaces "" 2586 set spacePixels 0 2587 } 2588 2589 set data($col-isSnipped) 0 2590 if {$pixels == 0} { ;# convention: dynamic width 2591 # 2592 # Set the label text 2593 # 2594 if {$imageWidth == 0} { ;# no image 2595 if {[string compare $title ""] == 0} { 2596 set text $spaces 2597 } else { 2598 set lines {} 2599 foreach line [split $title "\n"] { 2600 if {[string compare $alignment "right"] == 0} { 2601 lappend lines $spaces$line 2602 } else { 2603 lappend lines $line$spaces 2604 } 2605 } 2606 set text [join $lines "\n"] 2607 } 2608 $w configure -text $text 2609 } elseif {[string compare $title ""] == 0} { ;# image w/o text 2610 $w configure -text "" 2611 set text $spaces 2612 $w-tl configure -text $text 2613 $w-il configure -width $imageWidth 2614 } else { ;# both image and text 2615 $w configure -text "" 2616 set lines {} 2617 foreach line [split $title "\n"] { 2618 if {[string compare $alignment "right"] == 0} { 2619 lappend lines "$spaces$line " 2620 } else { 2621 lappend lines " $line$spaces" 2622 } 2623 } 2624 set text [join $lines "\n"] 2625 $w-tl configure -text $text 2626 $w-il configure -width $imageWidth 2627 } 2628 } else { 2629 # 2630 # Clip each line of title according to pixels and alignment 2631 # 2632 set lessPixels [expr {$pixels - $spacePixels}] 2633 variable snipSides 2634 set snipSide $snipSides($alignment,0) 2635 if {$imageWidth == 0} { ;# no image 2636 if {[string compare $title ""] == 0} { 2637 set text $spaces 2638 } else { 2639 set lines {} 2640 foreach line [split $title "\n"] { 2641 set lineSav $line 2642 set line [strRange $win $line $labelFont \ 2643 $lessPixels $snipSide $data(-snipstring)] 2644 if {[string compare $line $lineSav] != 0} { 2645 set data($col-isSnipped) 1 2646 } 2647 if {[string compare $alignment "right"] == 0} { 2648 lappend lines $spaces$line 2649 } else { 2650 lappend lines $line$spaces 2651 } 2652 } 2653 set text [join $lines "\n"] 2654 } 2655 $w configure -text $text 2656 } elseif {[string compare $title ""] == 0} { ;# image w/o text 2657 $w configure -text "" 2658 if {$imageWidth + $spacePixels <= $pixels} { 2659 set text $spaces 2660 $w-tl configure -text $text 2661 $w-il configure -width $imageWidth 2662 } elseif {$spacePixels < $pixels} { 2663 set text $spaces 2664 $w-tl configure -text $text 2665 $w-il configure -width [expr {$pixels - $spacePixels}] 2666 } else { 2667 set imageWidth 0 ;# can't disp. the image 2668 set text "" 2669 } 2670 } else { ;# both image and text 2671 $w configure -text "" 2672 set gap [font measure $labelFont -displayof $win " "] 2673 if {$imageWidth + $gap + $spacePixels <= $pixels} { 2674 incr lessPixels -[expr {$imageWidth + $gap}] 2675 set lines {} 2676 foreach line [split $title "\n"] { 2677 set lineSav $line 2678 set line [strRange $win $line $labelFont \ 2679 $lessPixels $snipSide $data(-snipstring)] 2680 if {[string compare $line $lineSav] != 0} { 2681 set data($col-isSnipped) 1 2682 } 2683 if {[string compare $alignment "right"] == 0} { 2684 lappend lines "$spaces$line " 2685 } else { 2686 lappend lines " $line$spaces" 2687 } 2688 } 2689 set text [join $lines "\n"] 2690 $w-tl configure -text $text 2691 $w-il configure -width $imageWidth 2692 } elseif {$imageWidth + $spacePixels <= $pixels} { 2693 set data($col-isSnipped) 1 2694 set text $spaces ;# can't display the orig. text 2695 $w-tl configure -text $text 2696 $w-il configure -width $imageWidth 2697 } elseif {$spacePixels < $pixels} { 2698 set data($col-isSnipped) 1 2699 set text $spaces ;# can't display the orig. text 2700 $w-tl configure -text $text 2701 $w-il configure -width [expr {$pixels - $spacePixels}] 2702 } else { 2703 set data($col-isSnipped) 1 2704 set imageWidth 0 ;# can't display the image 2705 set text "" ;# can't display the text 2706 } 2707 } 2708 } 2709 2710 # 2711 # Place the label's sublabels (if any) 2712 # 2713 if {$imageWidth == 0} { 2714 if {[info exists data($col-labelimage)]} { 2715 place forget $w-il 2716 place forget $w-tl 2717 } 2718 } else { 2719 if {[string compare $text ""] == 0} { 2720 place forget $w-tl 2721 } 2722 2723 set margin $data(charWidth) 2724 variable usingTile 2725 switch $alignment { 2726 left { 2727 place $w-il -in $w -anchor w -bordermode outside \ 2728 -relx 0.0 -x $margin -rely 0.49 2729 if {[string compare $text ""] != 0} { 2730 if {$usingTile} { 2731 set padding [$w cget -padding] 2732 lset padding 0 [expr {$padX + [winfo reqwidth $w-il]}] 2733 $w configure -padding $padding -text $text 2734 } else { 2735 set textX [expr {$margin + [winfo reqwidth $w-il]}] 2736 place $w-tl -in $w -anchor w -bordermode outside \ 2737 -relx 0.0 -x $textX -rely 0.49 2738 } 2739 } 2740 } 2741 2742 right { 2743 place $w-il -in $w -anchor e -bordermode outside \ 2744 -relx 1.0 -x -$margin -rely 0.49 2745 if {[string compare $text ""] != 0} { 2746 if {$usingTile} { 2747 set padding [$w cget -padding] 2748 lset padding 2 [expr {$padX + [winfo reqwidth $w-il]}] 2749 $w configure -padding $padding -text $text 2750 } else { 2751 set textX [expr {-$margin - [winfo reqwidth $w-il]}] 2752 place $w-tl -in $w -anchor e -bordermode outside \ 2753 -relx 1.0 -x $textX -rely 0.49 2754 } 2755 } 2756 } 2757 2758 center { 2759 if {[string compare $text ""] == 0} { 2760 place $w-il -in $w -anchor center -relx 0.5 -x 0 -rely 0.49 2761 } else { 2762 set reqWidth [expr {[winfo reqwidth $w-il] + 2763 [winfo reqwidth $w-tl]}] 2764 set iX [expr {-$reqWidth/2}] 2765 place $w-il -in $w -anchor w -relx 0.5 -x $iX -rely 0.49 2766 if {$usingTile} { 2767 set padding [$w cget -padding] 2768 lset padding 0 [expr {$padX + [winfo reqwidth $w-il]}] 2769 $w configure -padding $padding -text $text 2770 } else { 2771 set tX [expr {$reqWidth + $iX}] 2772 place $w-tl -in $w -anchor e -relx 0.5 -x $tX -rely 0.49 2773 } 2774 } 2775 } 2776 } 2777 } 2778} 2779 2780#------------------------------------------------------------------------------ 2781# tablelist::computeColWidth 2782# 2783# Computes the width of the col'th column of the tablelist widget win to be just 2784# large enough to hold all the elements of the column (including its label). 2785#------------------------------------------------------------------------------ 2786proc tablelist::computeColWidth {win col} { 2787 upvar ::tablelist::ns${win}::data data 2788 set fmtCmdFlag [lindex $data(fmtCmdFlagList) $col] 2789 set data($col-elemWidth) 0 2790 set data($col-widestCount) 0 2791 2792 # 2793 # Column elements 2794 # 2795 set row -1 2796 foreach item $data(itemList) { 2797 incr row 2798 2799 if {$col >= [llength $item] - 1} { 2800 continue 2801 } 2802 2803 set key [lindex $item end] 2804 if {[info exists data($key-hide)]} { 2805 continue 2806 } 2807 2808 set text [lindex $item $col] 2809 if {$fmtCmdFlag} { 2810 set text [formatElem $win $key $row $col $text] 2811 } 2812 set text [strToDispStr $text] 2813 getAuxData $win $key $col auxType auxWidth 2814 getIndentData $win $key $col indentWidth 2815 set cellFont [getCellFont $win $key $col] 2816 set elemWidth [getElemWidth $win $text $auxWidth $indentWidth $cellFont] 2817 if {$elemWidth == $data($col-elemWidth)} { 2818 incr data($col-widestCount) 2819 } elseif {$elemWidth > $data($col-elemWidth)} { 2820 set data($col-elemWidth) $elemWidth 2821 set data($col-widestCount) 1 2822 } 2823 } 2824 set data($col-reqPixels) $data($col-elemWidth) 2825 2826 # 2827 # Column label 2828 # 2829 computeLabelWidth $win $col 2830} 2831 2832#------------------------------------------------------------------------------ 2833# tablelist::computeLabelWidth 2834# 2835# Computes the width of the col'th label of the tablelist widget win and 2836# adjusts the column's width accordingly. 2837#------------------------------------------------------------------------------ 2838proc tablelist::computeLabelWidth {win col} { 2839 upvar ::tablelist::ns${win}::data data 2840 set w $data(hdrTxtFrLbl)$col 2841 if {[info exists data($col-labelimage)]} { 2842 set netLabelWidth \ 2843 [expr {[winfo reqwidth $w-il] + [winfo reqwidth $w-tl]}] 2844 } else { ;# no image 2845 set netLabelWidth [expr {[winfo reqwidth $w] - 2*$data(charWidth)}] 2846 } 2847 2848 if {$netLabelWidth < $data($col-elemWidth)} { 2849 set data($col-reqPixels) $data($col-elemWidth) 2850 } else { 2851 set data($col-reqPixels) $netLabelWidth 2852 } 2853} 2854 2855#------------------------------------------------------------------------------ 2856# tablelist::adjustHeaderHeight 2857# 2858# Sets the height of the header frame of the tablelist widget win to the max. 2859# height of its children. 2860#------------------------------------------------------------------------------ 2861proc tablelist::adjustHeaderHeight win { 2862 # 2863 # Compute the max. label height 2864 # 2865 upvar ::tablelist::ns${win}::data data 2866 set maxLabelHeight [winfo reqheight $data(hdrLbl)] 2867 for {set col 0} {$col < $data(colCount)} {incr col} { 2868 set w $data(hdrTxtFrLbl)$col 2869 if {[string compare [winfo manager $w] ""] == 0} { 2870 continue 2871 } 2872 2873 set reqHeight [winfo reqheight $w] 2874 if {$reqHeight > $maxLabelHeight} { 2875 set maxLabelHeight $reqHeight 2876 } 2877 2878 foreach l [getSublabels $w] { 2879 if {[string compare [winfo manager $l] ""] == 0} { 2880 continue 2881 } 2882 2883 set borderWidth [winfo pixels $w [$w cget -borderwidth]] 2884 if {$borderWidth < 0} { 2885 set borderWidth 0 2886 } 2887 set reqHeight [expr {[winfo reqheight $l] + 2*$borderWidth}] 2888 if {$reqHeight > $maxLabelHeight} { 2889 set maxLabelHeight $reqHeight 2890 } 2891 } 2892 } 2893 2894 # 2895 # Set the height of the header frame and adjust the separators 2896 # 2897 $data(hdrTxtFr) configure -height $maxLabelHeight 2898 if {$data(-showlabels)} { 2899 $data(hdr) configure -height $maxLabelHeight 2900 place configure $data(hdrTxt) -y 0 2901 place configure $data(hdrLbl) -y 0 2902 } else { 2903 $data(hdr) configure -height 1 2904 place configure $data(hdrTxt) -y -1 2905 place configure $data(hdrLbl) -y -1 2906 } 2907 adjustSepsWhenIdle $win 2908} 2909 2910#------------------------------------------------------------------------------ 2911# tablelist::stretchColumnsWhenIdle 2912# 2913# Arranges for the stretchable columns of the tablelist widget win to be 2914# stretched at idle time. 2915#------------------------------------------------------------------------------ 2916proc tablelist::stretchColumnsWhenIdle win { 2917 upvar ::tablelist::ns${win}::data data 2918 if {[info exists data(stretchId)]} { 2919 return "" 2920 } 2921 2922 set data(stretchId) [after idle [list tablelist::stretchColumns $win -1]] 2923} 2924 2925#------------------------------------------------------------------------------ 2926# tablelist::stretchColumns 2927# 2928# Stretches the stretchable columns to fill the tablelist window win 2929# horizontally. The colOfFixedDelta argument specifies the column for which 2930# the stretching is to be made using a precomputed amount of pixels. 2931#------------------------------------------------------------------------------ 2932proc tablelist::stretchColumns {win colOfFixedDelta} { 2933 upvar ::tablelist::ns${win}::data data 2934 if {[info exists data(stretchId)]} { 2935 after cancel $data(stretchId) 2936 unset data(stretchId) 2937 } 2938 2939 set forceAdjust $data(forceAdjust) 2940 set data(forceAdjust) 0 2941 2942 if {$data(hdrPixels) == 0 || $data(-width) <= 0} { 2943 return "" 2944 } 2945 2946 # 2947 # Get the list data(stretchableCols) of the 2948 # numerical indices of the stretchable columns 2949 # 2950 set data(stretchableCols) {} 2951 if {[string compare $data(-stretch) "all"] == 0} { 2952 for {set col 0} {$col < $data(colCount)} {incr col} { 2953 lappend data(stretchableCols) $col 2954 } 2955 } else { 2956 foreach col $data(-stretch) { 2957 lappend data(stretchableCols) [colIndex $win $col 0] 2958 } 2959 } 2960 2961 # 2962 # Compute the total number data(delta) of pixels by which the 2963 # columns are to be stretched and the total amount 2964 # data(stretchablePixels) of stretchable column widths in pixels 2965 # 2966 set data(delta) [winfo width $data(hdr)] 2967 set data(stretchablePixels) 0 2968 set lastColToStretch -1 2969 set col 0 2970 foreach {pixels alignment} $data(colList) { 2971 if {$data($col-hide)} { 2972 incr col 2973 continue 2974 } 2975 2976 if {$pixels == 0} { ;# convention: dynamic width 2977 set pixels $data($col-reqPixels) 2978 if {$data($col-maxPixels) > 0} { 2979 if {$pixels > $data($col-maxPixels)} { 2980 set pixels $data($col-maxPixels) 2981 } 2982 } 2983 } 2984 incr data(delta) -[expr {$pixels + 2*$data(charWidth)}] 2985 if {[lsearch -exact $data(stretchableCols) $col] >= 0} { 2986 incr data(stretchablePixels) $pixels 2987 set lastColToStretch $col 2988 } 2989 2990 incr col 2991 } 2992 if {$data(delta) < 0} { 2993 set delta 0 2994 } else { 2995 set delta $data(delta) 2996 } 2997 if {$data(stretchablePixels) == 0 && !$forceAdjust} { 2998 return "" 2999 } 3000 3001 # 3002 # Distribute the value of delta to the stretchable 3003 # columns, proportionally to their widths in pixels 3004 # 3005 set rest $delta 3006 set col 0 3007 foreach {pixels alignment} $data(colList) { 3008 if {$data($col-hide) || 3009 [lsearch -exact $data(stretchableCols) $col] < 0} { 3010 set data($col-delta) 0 3011 } else { 3012 set oldDelta $data($col-delta) 3013 if {$pixels == 0} { ;# convention: dynamic width 3014 set dynamic 1 3015 set pixels $data($col-reqPixels) 3016 if {$data($col-maxPixels) > 0} { 3017 if {$pixels > $data($col-maxPixels)} { 3018 set pixels $data($col-maxPixels) 3019 set dynamic 0 3020 } 3021 } 3022 } else { 3023 set dynamic 0 3024 } 3025 if {$data(stretchablePixels) == 0} { 3026 set data($col-delta) 0 3027 } else { 3028 if {$col != $colOfFixedDelta} { 3029 set data($col-delta) \ 3030 [expr {$delta*$pixels/$data(stretchablePixels)}] 3031 } 3032 incr rest -$data($col-delta) 3033 } 3034 if {$col == $lastColToStretch} { 3035 incr data($col-delta) $rest 3036 } 3037 if {!$dynamic && $data($col-delta) != $oldDelta} { 3038 redisplayColWhenIdle $win $col 3039 } 3040 } 3041 3042 incr col 3043 } 3044 3045 # 3046 # Adjust the columns 3047 # 3048 adjustColumns $win {} 0 3049} 3050 3051#------------------------------------------------------------------------------ 3052# tablelist::moveActiveTag 3053# 3054# Moves the "active" tag to the line or cell that displays the active item or 3055# element of the tablelist widget win in its body text child. 3056#------------------------------------------------------------------------------ 3057proc tablelist::moveActiveTag win { 3058 upvar ::tablelist::ns${win}::data data 3059 set w $data(body) 3060 $w tag remove active 1.0 end 3061 3062 if {$data(itemCount) == 0 || $data(colCount) == 0} { 3063 return "" 3064 } 3065 3066 set activeLine [expr {$data(activeRow) + 1}] 3067 set activeCol $data(activeCol) 3068 if {[string compare $data(-selecttype) "row"] == 0} { 3069 $w tag add active $activeLine.0 $activeLine.end 3070 updateColors $win $activeLine.0 $activeLine.end 3071 } elseif {$activeLine > 0 && !$data($activeCol-hide)} { 3072 findTabs $win $activeLine $activeCol $activeCol tabIdx1 tabIdx2 3073 $w tag add active $tabIdx1 $tabIdx2+1c 3074 updateColors $win $tabIdx1 $tabIdx2+1c 3075 } 3076} 3077 3078#------------------------------------------------------------------------------ 3079# tablelist::updateColorsWhenIdle 3080# 3081# Arranges for the background and foreground colors of the label, frame, and 3082# message widgets containing the currently visible images and multiline 3083# elements of the tablelist widget win to be updated at idle time. 3084#------------------------------------------------------------------------------ 3085proc tablelist::updateColorsWhenIdle win { 3086 upvar ::tablelist::ns${win}::data data 3087 if {[info exists data(colorId)]} { 3088 return "" 3089 } 3090 3091 set data(colorId) [after idle [list tablelist::updateColors $win]] 3092} 3093 3094#------------------------------------------------------------------------------ 3095# tablelist::updateColors 3096# 3097# Updates the background and foreground colors of the label, frame, and message 3098# widgets containing the currently visible images, embedded windows, and 3099# multiline elements of the tablelist widget win. 3100#------------------------------------------------------------------------------ 3101proc tablelist::updateColors {win {fromTextIdx ""} {toTextIdx ""}} { 3102 upvar ::tablelist::ns${win}::data data 3103 set w $data(body) 3104 3105 if {[string compare $fromTextIdx ""] == 0} { 3106 set fromTextIdx "[$w index @0,0] linestart" 3107 set toTextIdx "[$w index @0,$data(btmY)] lineend" 3108 set updateAll 1 3109 3110 if {[info exists data(colorId)]} { 3111 after cancel $data(colorId) 3112 unset data(colorId) 3113 } 3114 } else { 3115 set updateAll 0 3116 } 3117 3118 if {$data(itemCount) == 0 || $data(colCount) == 0} { 3119 return "" 3120 } 3121 3122 if {$updateAll && $data(isDisabled)} { 3123 $w tag add disabled $fromTextIdx $toTextIdx 3124 } 3125 3126 foreach {dummy path textIdx} [$w dump -window $fromTextIdx $toTextIdx] { 3127 if {[string compare $path ""] == 0} { 3128 continue 3129 } 3130 3131 set class [winfo class $path] 3132 set isLabel [expr {[string compare $class "Label"] == 0}] 3133 set isTblWin [expr {[string compare $class "TablelistWindow"] == 0}] 3134 set isMessage [expr {[string compare $class "Message"] == 0}] 3135 if {!$isLabel && !$isTblWin && !$isMessage} { 3136 continue 3137 } 3138 3139 set name [winfo name $path] 3140 foreach {key col} [split [string range $name 4 end] ","] {} 3141 if {[info exists data($key-hide)]} { 3142 continue 3143 } 3144 3145 if {$updateAll} { 3146 set tagNames [$w tag names $textIdx] 3147 set selected [expr {[lsearch -exact $tagNames select] >= 0}] 3148 } 3149 3150 # 3151 # If the widget is an indentation label then 3152 # conditionally remove the "active" and "select" 3153 # tags from its text position and the preceding one 3154 # 3155 if {[string compare $path $w.ind_$key,$col] == 0 && 3156 $data(protectIndents)} { 3157 set fromTextIdx [$w index $textIdx-1c] 3158 set toTextIdx [$w index $textIdx+1c] 3159 3160 $w tag remove active $fromTextIdx $toTextIdx 3161 3162 if {$updateAll && $selected} { 3163 $w tag remove select $fromTextIdx $toTextIdx 3164 set selected 0 3165 3166 foreach optTail {background foreground} { 3167 set opt -select$optTail 3168 foreach name [list $col$opt $key$opt $key,$col$opt] \ 3169 level [list col row cell] { 3170 if {[info exists data($name)]} { 3171 $w tag remove $level$opt-$data($name) \ 3172 $fromTextIdx $toTextIdx 3173 } 3174 } 3175 3176 foreach name [list $col-$optTail $key-$optTail \ 3177 $key,$col-$optTail] \ 3178 level [list col row cell] { 3179 if {[info exists data($name)]} { 3180 $w tag add $level-$optTail-$data($name) \ 3181 $fromTextIdx $toTextIdx 3182 } 3183 } 3184 } 3185 } 3186 } 3187 3188 if {!$updateAll} { 3189 continue 3190 } 3191 3192 # 3193 # Set the widget's background and foreground 3194 # colors to those of the containing cell 3195 # 3196 if {$data(isDisabled)} { 3197 set bg $data(-background) 3198 set fg $data(-disabledforeground) 3199 } elseif {$selected} { 3200 if {[info exists data($key,$col-selectbackground)]} { 3201 set bg $data($key,$col-selectbackground) 3202 } elseif {[info exists data($key-selectbackground)]} { 3203 set bg $data($key-selectbackground) 3204 } elseif {[info exists data($col-selectbackground)]} { 3205 set bg $data($col-selectbackground) 3206 } else { 3207 set bg $data(-selectbackground) 3208 } 3209 3210 if {$isMessage} { 3211 if {[info exists data($key,$col-selectforeground)]} { 3212 set fg $data($key,$col-selectforeground) 3213 } elseif {[info exists data($key-selectforeground)]} { 3214 set fg $data($key-selectforeground) 3215 } elseif {[info exists data($col-selectforeground)]} { 3216 set fg $data($col-selectforeground) 3217 } else { 3218 set fg $data(-selectforeground) 3219 } 3220 } 3221 } else { 3222 if {[info exists data($key,$col-background)]} { 3223 set bg $data($key,$col-background) 3224 } elseif {[info exists data($key-background)]} { 3225 set bg $data($key-background) 3226 } elseif {[lsearch -exact $tagNames stripe] < 0 || 3227 [string compare $data(-stripebackground) ""] == 0} { 3228 if {[info exists data($col-background)]} { 3229 set bg $data($col-background) 3230 } else { 3231 set bg $data(-background) 3232 } 3233 } else { 3234 set bg $data(-stripebackground) 3235 } 3236 3237 if {$isMessage} { 3238 if {[info exists data($key,$col-foreground)]} { 3239 set fg $data($key,$col-foreground) 3240 } elseif {[info exists data($key-foreground)]} { 3241 set fg $data($key-foreground) 3242 } elseif {[lsearch -exact $tagNames stripe] < 0 || 3243 [string compare $data(-stripeforeground) ""] == 0} { 3244 if {[info exists data($col-foreground)]} { 3245 set fg $data($col-foreground) 3246 } else { 3247 set fg $data(-foreground) 3248 } 3249 } else { 3250 set fg $data(-stripeforeground) 3251 } 3252 } 3253 } 3254 if {[string compare [$path cget -background] $bg] != 0} { 3255 $path configure -background $bg 3256 } 3257 if {$isMessage && [string compare [$path cget -foreground] $fg] != 0} { 3258 $path configure -foreground $fg 3259 } 3260 } 3261} 3262 3263#------------------------------------------------------------------------------ 3264# tablelist::updateScrlColOffsetWhenIdle 3265# 3266# Arranges for the scrolled column offset of the tablelist widget win to be 3267# updated at idle time. 3268#------------------------------------------------------------------------------ 3269proc tablelist::updateScrlColOffsetWhenIdle win { 3270 upvar ::tablelist::ns${win}::data data 3271 if {[info exists data(offsetId)]} { 3272 return "" 3273 } 3274 3275 set data(offsetId) [after idle [list tablelist::updateScrlColOffset $win]] 3276} 3277 3278#------------------------------------------------------------------------------ 3279# tablelist::updateScrlColOffset 3280# 3281# Updates the scrolled column offset of the tablelist widget win to fit into 3282# the allowed range. 3283#------------------------------------------------------------------------------ 3284proc tablelist::updateScrlColOffset win { 3285 upvar ::tablelist::ns${win}::data data 3286 if {[info exists data(offsetId)]} { 3287 after cancel $data(offsetId) 3288 unset data(offsetId) 3289 } 3290 3291 set maxScrlColOffset [getMaxScrlColOffset $win] 3292 if {$data(scrlColOffset) > $maxScrlColOffset} { 3293 set data(scrlColOffset) $maxScrlColOffset 3294 adjustElidedTextWhenIdle $win 3295 } 3296} 3297 3298#------------------------------------------------------------------------------ 3299# tablelist::updateHScrlbarWhenIdle 3300# 3301# Arranges for the horizontal scrollbar associated with the tablelist widget 3302# win to be updated at idle time. 3303#------------------------------------------------------------------------------ 3304proc tablelist::updateHScrlbarWhenIdle win { 3305 upvar ::tablelist::ns${win}::data data 3306 if {[info exists data(hScrlbarId)]} { 3307 return "" 3308 } 3309 3310 set data(hScrlbarId) [after idle [list tablelist::updateHScrlbar $win]] 3311} 3312 3313#------------------------------------------------------------------------------ 3314# tablelist::updateHScrlbar 3315# 3316# Updates the horizontal scrollbar associated with the tablelist widget win by 3317# invoking the command specified as the value of the -xscrollcommand option. 3318#------------------------------------------------------------------------------ 3319proc tablelist::updateHScrlbar win { 3320 upvar ::tablelist::ns${win}::data data 3321 if {[info exists data(hScrlbarId)]} { 3322 after cancel $data(hScrlbarId) 3323 unset data(hScrlbarId) 3324 } 3325 3326 if {$data(-titlecolumns) > 0 && 3327 [string compare $data(-xscrollcommand) ""] != 0} { 3328 eval $data(-xscrollcommand) [xviewSubCmd $win {}] 3329 } 3330} 3331 3332#------------------------------------------------------------------------------ 3333# tablelist::updateVScrlbarWhenIdle 3334# 3335# Arranges for the vertical scrollbar associated with the tablelist widget win 3336# to be updated at idle time. 3337#------------------------------------------------------------------------------ 3338proc tablelist::updateVScrlbarWhenIdle win { 3339 upvar ::tablelist::ns${win}::data data 3340 if {[info exists data(vScrlbarId)]} { 3341 return "" 3342 } 3343 3344 set data(vScrlbarId) [after idle [list tablelist::updateVScrlbar $win]] 3345} 3346 3347#------------------------------------------------------------------------------ 3348# tablelist::updateVScrlbar 3349# 3350# Updates the vertical scrollbar associated with the tablelist widget win by 3351# invoking the command specified as the value of the -yscrollcommand option. 3352#------------------------------------------------------------------------------ 3353proc tablelist::updateVScrlbar win { 3354 upvar ::tablelist::ns${win}::data data 3355 if {[info exists data(vScrlbarId)]} { 3356 after cancel $data(vScrlbarId) 3357 unset data(vScrlbarId) 3358 } 3359 3360 if {[string compare $data(-yscrollcommand) ""] != 0} { 3361 eval $data(-yscrollcommand) [yviewSubCmd $win {}] 3362 } 3363 3364 if {[winfo viewable $win] && ![info exists data(colBeingResized)]} { 3365 forceRedrawDelayed $win 3366 3367 variable winSys 3368 if {[string compare $winSys "aqua"] == 0} { 3369 # 3370 # Work around a Tk bug on Mac OS X Aqua 3371 # 3372 if {[winfo exists $data(bodyFr)]} { 3373 lower $data(bodyFr) 3374 raise $data(bodyFr) 3375 } 3376 } 3377 } 3378 3379 if {$data(winCount) == 0 && $::tk_version < 8.5} { 3380 purgeWidgets $win 3381 } 3382} 3383 3384#------------------------------------------------------------------------------ 3385# tablelist::forceRedrawDelayed 3386# 3387# Arranges for the tablelist widget win to be redrawn 500 ms second later. 3388#------------------------------------------------------------------------------ 3389proc tablelist::forceRedrawDelayed win { 3390 upvar ::tablelist::ns${win}::data data 3391 if {[info exists data(redrawId)]} { 3392 return "" 3393 } 3394 3395 set data(redrawId) [after 500 [list tablelist::forceRedraw $win]] 3396} 3397 3398#------------------------------------------------------------------------------ 3399# tablelist::forceRedraw 3400# 3401# Enforces a redraw of the tablelist widget win. 3402#------------------------------------------------------------------------------ 3403proc tablelist::forceRedraw win { 3404 upvar ::tablelist::ns${win}::data data 3405 if {[info exists data(redrawId)]} { 3406 after cancel $data(redrawId) 3407 unset data(redrawId) 3408 } 3409 3410 set w $data(body) 3411 set fromTextIdx "[$w index @0,0] linestart" 3412 set toTextIdx "[$w index @0,$data(btmY)] lineend" 3413 $w tag add redraw $fromTextIdx $toTextIdx 3414 $w tag remove redraw $fromTextIdx $toTextIdx 3415} 3416 3417#------------------------------------------------------------------------------ 3418# tablelist::purgeWidgets 3419# 3420# Destroys those label widgets containing embedded images and those message 3421# widgets containing multiline elements that are outside the currently visible 3422# range of lines of the body of the tablelist widget win. 3423#------------------------------------------------------------------------------ 3424proc tablelist::purgeWidgets win { 3425 upvar ::tablelist::ns${win}::data data 3426 set w $data(body) 3427 foreach path [$w window names] { 3428 set class [winfo class $path] 3429 if {[string compare $class "Label"] == 0 || 3430 [string compare $class "Message"] == 0} { 3431 set widgets($path) 1 3432 } 3433 } 3434 3435 set fromTextIdx "[$w index @0,0] linestart" 3436 set toTextIdx "[$w index @0,$data(btmY)] lineend" 3437 foreach {dummy path textIdx} [$w dump -window $fromTextIdx $toTextIdx] { 3438 set widgets($path) 0 3439 } 3440 3441 foreach path [array names widgets] { 3442 if {$widgets($path)} { 3443 destroy $path 3444 } 3445 } 3446} 3447 3448#------------------------------------------------------------------------------ 3449# tablelist::adjustElidedTextWhenIdle 3450# 3451# Arranges for the elided text ranges of the body text child of the tablelist 3452# widget win to be updated at idle time. 3453#------------------------------------------------------------------------------ 3454proc tablelist::adjustElidedTextWhenIdle win { 3455 upvar ::tablelist::ns${win}::data data 3456 if {[info exists data(elidedId)]} { 3457 return "" 3458 } 3459 3460 set data(elidedId) [after idle [list tablelist::adjustElidedText $win]] 3461} 3462 3463#------------------------------------------------------------------------------ 3464# tablelist::adjustElidedText 3465# 3466# Updates the elided text ranges of the body text child of the tablelist widget 3467# win. 3468#------------------------------------------------------------------------------ 3469proc tablelist::adjustElidedText win { 3470 upvar ::tablelist::ns${win}::data data 3471 if {[info exists data(elidedId)]} { 3472 after cancel $data(elidedId) 3473 unset data(elidedId) 3474 } 3475 3476 if {$data(itemCount) == 0 || [info exists data(dispId)]} { 3477 return "" 3478 } 3479 3480 # 3481 # Remove the "hiddenCol" tag 3482 # 3483 set w $data(body) 3484 $w tag remove hiddenCol 1.0 end 3485 3486 # 3487 # Add the "hiddenCol" tag to the contents of the hidden 3488 # columns from the top to the bottom window line 3489 # 3490 variable canElide 3491 if {$canElide && $data(hiddenColCount) > 0 && $data(itemCount) > 0} { 3492 set topLine [expr {int([$w index @0,0])}] 3493 set btmLine [expr {int([$w index @0,$data(btmY)])}] 3494 for {set line $topLine; set row [expr {$line - 1}]} \ 3495 {$line <= $btmLine} {set row $line; incr line} { 3496 set key [lindex $data(keyList) $row] 3497 if {[info exists data($key-hide)]} { 3498 continue 3499 } 3500 3501 set textIdx1 $line.0 3502 for {set col 0; set count 0} \ 3503 {$col < $data(colCount) && $count < $data(hiddenColCount)} \ 3504 {incr col} { 3505 set textIdx2 \ 3506 [$w search -elide "\t" $textIdx1+1c $line.end]+1c 3507 if {[string compare $textIdx2 "+1c"] == 0} { 3508 break 3509 } 3510 if {$data($col-hide)} { 3511 incr count 3512 $w tag add hiddenCol $textIdx1 $textIdx2 3513 } 3514 set textIdx1 $textIdx2 3515 } 3516 3517 # 3518 # Update btmLine because it may 3519 # change due to the "hiddenCol" tag 3520 # 3521 set btmLine [expr {int([$w index @0,$data(btmY)])}] 3522 } 3523 3524 if {[lindex [$w yview] 1] == 1} { 3525 for {set line $btmLine; set row [expr {$line - 1}]} \ 3526 {$line >= $topLine} {set line $row; incr row -1} { 3527 set key [lindex $data(keyList) $row] 3528 if {[info exists data($key-hide)]} { 3529 continue 3530 } 3531 3532 set textIdx1 $line.0 3533 for {set col 0; set count 0} \ 3534 {$col < $data(colCount) && $count < $data(hiddenColCount)} \ 3535 {incr col} { 3536 set textIdx2 \ 3537 [$w search -elide "\t" $textIdx1+1c $line.end]+1c 3538 if {[string compare $textIdx2 "+1c"] == 0} { 3539 break 3540 } 3541 if {$data($col-hide)} { 3542 incr count 3543 $w tag add hiddenCol $textIdx1 $textIdx2 3544 } 3545 set textIdx1 $textIdx2 3546 } 3547 3548 # 3549 # Update topLine because it may 3550 # change due to the "hiddenCol" tag 3551 # 3552 set topLine [expr {int([$w index @0,0])}] 3553 } 3554 } 3555 } 3556 3557 if {$data(-titlecolumns) == 0} { 3558 return "" 3559 } 3560 3561 # 3562 # Remove the "elidedCol" tag 3563 # 3564 $w tag remove elidedCol 1.0 end 3565 for {set col 0} {$col < $data(colCount)} {incr col} { 3566 set data($col-elide) 0 3567 } 3568 3569 if {$data(scrlColOffset) == 0} { 3570 adjustColumns $win {} 0 3571 return "" 3572 } 3573 3574 # 3575 # Find max. $data(scrlColOffset) non-hidden columns with indices >= 3576 # $data(-titlecolumns) and retain the first and last of these indices 3577 # 3578 set firstCol $data(-titlecolumns) 3579 while {$firstCol < $data(colCount) && $data($firstCol-hide)} { 3580 incr firstCol 3581 } 3582 if {$firstCol >= $data(colCount)} { 3583 return "" 3584 } 3585 set lastCol $firstCol 3586 set nonHiddenCount 1 3587 while {$nonHiddenCount < $data(scrlColOffset) && 3588 $lastCol < $data(colCount)} { 3589 incr lastCol 3590 if {!$data($lastCol-hide)} { 3591 incr nonHiddenCount 3592 } 3593 } 3594 3595 # 3596 # Add the "elidedCol" tag to the contents of these 3597 # columns from the top to the bottom window line 3598 # 3599 if {$data(itemCount) > 0} { 3600 set topLine [expr {int([$w index @0,0])}] 3601 set btmLine [expr {int([$w index @0,$data(btmY)])}] 3602 for {set line $topLine; set row [expr {$line - 1}]} \ 3603 {$line <= $btmLine} {set row $line; incr line} { 3604 set key [lindex $data(keyList) $row] 3605 if {![info exists data($key-hide)]} { 3606 if {[findTabs $win $line $firstCol $lastCol tabIdx1 tabIdx2]} { 3607 $w tag add elidedCol $tabIdx1 $tabIdx2+1c 3608 } 3609 } 3610 3611 # 3612 # Update btmLine because it may 3613 # change due to the "elidedCol" tag 3614 # 3615 set btmLine [expr {int([$w index @0,$data(btmY)])}] 3616 } 3617 3618 if {[lindex [$w yview] 1] == 1} { 3619 for {set line $btmLine; set row [expr {$line - 1}]} \ 3620 {$line >= $topLine} {set line $row; incr row -1} { 3621 set key [lindex $data(keyList) $row] 3622 if {![info exists data($key-hide)]} { 3623 if {[findTabs $win $line $firstCol $lastCol \ 3624 tabIdx1 tabIdx2]} { 3625 $w tag add elidedCol $tabIdx1 $tabIdx2+1c 3626 } 3627 } 3628 3629 # 3630 # Update topLine because it may 3631 # change due to the "elidedCol" tag 3632 # 3633 set topLine [expr {int([$w index @0,0])}] 3634 } 3635 } 3636 } 3637 3638 # 3639 # Adjust the columns 3640 # 3641 for {set col $firstCol} {$col <= $lastCol} {incr col} { 3642 set data($col-elide) 1 3643 } 3644 adjustColumns $win {} 0 3645} 3646 3647#------------------------------------------------------------------------------ 3648# tablelist::redisplayWhenIdle 3649# 3650# Arranges for the items of the tablelist widget win to be redisplayed at idle 3651# time. 3652#------------------------------------------------------------------------------ 3653proc tablelist::redisplayWhenIdle win { 3654 upvar ::tablelist::ns${win}::data data 3655 if {[info exists data(redispId)] || $data(itemCount) == 0} { 3656 return "" 3657 } 3658 3659 set data(redispId) [after idle [list tablelist::redisplay $win]] 3660 3661 # 3662 # Cancel the execution of all delayed redisplayCol commands 3663 # 3664 foreach name [array names data *-redispId] { 3665 after cancel $data($name) 3666 unset data($name) 3667 } 3668} 3669 3670#------------------------------------------------------------------------------ 3671# tablelist::redisplay 3672# 3673# Redisplays the items of the tablelist widget win. 3674#------------------------------------------------------------------------------ 3675proc tablelist::redisplay {win {getSelCells 1} {selCells {}}} { 3676 upvar ::tablelist::ns${win}::data data 3677 if {[info exists data(redispId)]} { 3678 after cancel $data(redispId) 3679 unset data(redispId) 3680 } 3681 3682 # 3683 # Save the indices of the selected cells 3684 # 3685 if {$getSelCells} { 3686 set selCells [curCellSelection $win] 3687 } 3688 3689 # 3690 # Save some data of the edit window if present 3691 # 3692 if {[set editCol $data(editCol)] >= 0} { 3693 set editRow $data(editRow) 3694 saveEditData $win 3695 } 3696 3697 set w $data(body) 3698 set snipStr $data(-snipstring) 3699 set rowTagRefCount $data(rowTagRefCount) 3700 set cellTagRefCount $data(cellTagRefCount) 3701 set isSimple [expr {$data(imgCount) == 0 && $data(winCount) == 0 && 3702 $data(indentCount) == 0}] 3703 set padY [expr {[$w cget -spacing1] == 0}] 3704 variable canElide 3705 variable snipSides 3706 set newItemList {} 3707 set row 0 3708 set line 1 3709 foreach item $data(itemList) { 3710 # 3711 # Empty the line, clip the elements if necessary, 3712 # and insert them with the corresponding tags 3713 # 3714 $w delete $line.0 $line.end 3715 set keyIdx [expr {[llength $item] - 1}] 3716 set key [lindex $item end] 3717 if {$rowTagRefCount == 0} { 3718 set hasRowFont 0 3719 } else { 3720 set hasRowFont [info exists data($key-font)] 3721 } 3722 set newItem {} 3723 set col 0 3724 if {$isSimple} { 3725 set insertArgs {} 3726 set multilineData {} 3727 foreach fmtCmdFlag $data(fmtCmdFlagList) \ 3728 colFont $data(colFontList) \ 3729 colTags $data(colTagsList) \ 3730 {pixels alignment} $data(colList) { 3731 if {$col < $keyIdx} { 3732 set text [lindex $item $col] 3733 } else { 3734 set text "" 3735 } 3736 lappend newItem $text 3737 3738 if {$data($col-hide) && !$canElide} { 3739 incr col 3740 continue 3741 } 3742 3743 if {$fmtCmdFlag} { 3744 set text [formatElem $win $key $row $col $text] 3745 } 3746 set text [strToDispStr $text] 3747 3748 # 3749 # Build the list of tags to be applied to the cell 3750 # 3751 if {$hasRowFont} { 3752 set cellFont $data($key-font) 3753 } else { 3754 set cellFont $colFont 3755 } 3756 set cellTags $colTags 3757 if {$cellTagRefCount != 0} { 3758 if {[info exists data($key,$col-font)]} { 3759 set cellFont $data($key,$col-font) 3760 lappend cellTags cell-font-$data($key,$col-font) 3761 } 3762 foreach opt {-background -foreground} { 3763 if {[info exists data($key,$col$opt)]} { 3764 lappend cellTags cell$opt-$data($key,$col$opt) 3765 } 3766 } 3767 } 3768 3769 # 3770 # Clip the element if necessary 3771 # 3772 set multiline [string match "*\n*" $text] 3773 if {$pixels == 0} { ;# convention: dynamic width 3774 if {$data($col-maxPixels) > 0} { 3775 if {$data($col-reqPixels) > $data($col-maxPixels)} { 3776 set pixels $data($col-maxPixels) 3777 } 3778 } 3779 } 3780 if {$pixels != 0} { 3781 incr pixels $data($col-delta) 3782 3783 if {$data($col-wrap) && !$multiline} { 3784 if {[font measure $cellFont -displayof $win $text] > 3785 $pixels} { 3786 set multiline 1 3787 } 3788 } 3789 3790 set snipSide \ 3791 $snipSides($alignment,$data($col-changesnipside)) 3792 if {$multiline} { 3793 set list [split $text "\n"] 3794 if {$data($col-wrap)} { 3795 set snipSide "" 3796 } 3797 set text [joinList $win $list $cellFont \ 3798 $pixels $snipSide $snipStr] 3799 } else { 3800 set text [strRange $win $text $cellFont \ 3801 $pixels $snipSide $snipStr] 3802 } 3803 } 3804 3805 if {$multiline} { 3806 lappend insertArgs "\t\t" $cellTags 3807 lappend multilineData $col $text $cellFont $alignment 3808 } else { 3809 lappend insertArgs "\t$text\t" $cellTags 3810 } 3811 3812 incr col 3813 } 3814 3815 # 3816 # Insert the item into the body text widget 3817 # 3818 if {[llength $insertArgs] != 0} { 3819 eval [list $w insert $line.0] $insertArgs 3820 } 3821 3822 # 3823 # Embed the message widgets displaying multiline elements 3824 # 3825 foreach {col text font alignment} $multilineData { 3826 if {[findTabs $win $line $col $col tabIdx1 tabIdx2]} { 3827 set msgScript [list ::tablelist::displayText $win $key \ 3828 $col $text $font $pixels $alignment] 3829 $w window create $tabIdx2 -pady $padY -create $msgScript 3830 } 3831 } 3832 3833 } else { 3834 foreach fmtCmdFlag $data(fmtCmdFlagList) \ 3835 colFont $data(colFontList) \ 3836 colTags $data(colTagsList) \ 3837 {pixels alignment} $data(colList) { 3838 if {$col < $keyIdx} { 3839 set text [lindex $item $col] 3840 } else { 3841 set text "" 3842 } 3843 lappend newItem $text 3844 3845 if {$data($col-hide) && !$canElide} { 3846 incr col 3847 continue 3848 } 3849 3850 if {$fmtCmdFlag} { 3851 set text [formatElem $win $key $row $col $text] 3852 } 3853 set text [strToDispStr $text] 3854 3855 # 3856 # Build the list of tags to be applied to the cell 3857 # 3858 if {$hasRowFont} { 3859 set cellFont $data($key-font) 3860 } else { 3861 set cellFont $colFont 3862 } 3863 set cellTags $colTags 3864 if {$cellTagRefCount != 0} { 3865 if {[info exists data($key,$col-font)]} { 3866 set cellFont $data($key,$col-font) 3867 lappend cellTags cell-font-$data($key,$col-font) 3868 } 3869 foreach opt {-background -foreground} { 3870 if {[info exists data($key,$col$opt)]} { 3871 lappend cellTags cell$opt-$data($key,$col$opt) 3872 } 3873 } 3874 } 3875 3876 # 3877 # Insert the text and the label or window 3878 # (if any) into the body text widget 3879 # 3880 appendComplexElem $win $key $row $col $text $pixels \ 3881 $alignment $snipStr $cellFont $cellTags $line 3882 3883 incr col 3884 } 3885 } 3886 3887 if {$rowTagRefCount != 0} { 3888 foreach opt {-background -foreground -font} { 3889 if {[info exists data($key$opt)]} { 3890 $w tag add row$opt-$data($key$opt) $line.0 $line.end 3891 } 3892 } 3893 } 3894 3895 if {[info exists data($key-hide)]} { 3896 $w tag add hiddenRow $line.0 $line.end+1c 3897 } 3898 3899 lappend newItem $key 3900 lappend newItemList $newItem 3901 3902 set row $line 3903 incr line 3904 } 3905 3906 set data(itemList) $newItemList 3907 3908 # 3909 # Select the cells that were selected before 3910 # 3911 foreach cellIdx $selCells { 3912 scan $cellIdx "%d,%d" row col 3913 if {$col < $data(colCount)} { 3914 cellSelection $win set $row $col $row $col 3915 } 3916 } 3917 3918 # 3919 # Adjust the elided text and restore the stripes in the body text widget 3920 # 3921 adjustElidedText $win 3922 makeStripes $win 3923 3924 # 3925 # Restore the edit window if it was present before 3926 # 3927 if {$editCol >= 0} { 3928 doEditCell $win $editRow $editCol 1 3929 } 3930} 3931 3932#------------------------------------------------------------------------------ 3933# tablelist::redisplayColWhenIdle 3934# 3935# Arranges for the elements of the col'th column of the tablelist widget win to 3936# be redisplayed at idle time. 3937#------------------------------------------------------------------------------ 3938proc tablelist::redisplayColWhenIdle {win col} { 3939 upvar ::tablelist::ns${win}::data data 3940 if {[info exists data($col-redispId)] || [info exists data(redispId)] || 3941 $data(itemCount) == 0} { 3942 return "" 3943 } 3944 3945 set data($col-redispId) \ 3946 [after idle [list tablelist::redisplayCol $win $col 0 end]] 3947} 3948 3949#------------------------------------------------------------------------------ 3950# tablelist::redisplayCol 3951# 3952# Redisplays the elements of the col'th column of the tablelist widget win, in 3953# the range specified by first and last. 3954#------------------------------------------------------------------------------ 3955proc tablelist::redisplayCol {win col first last} { 3956 upvar ::tablelist::ns${win}::data data 3957 set allRows [expr {$first == 0 && [string compare $last "end"] == 0}] 3958 if {$allRows && [info exists data($col-redispId)]} { 3959 after cancel $data($col-redispId) 3960 unset data($col-redispId) 3961 } 3962 3963 if {$data(itemCount) == 0 || $first < 0 || 3964 $col > $data(lastCol) || $data($col-hide)} { 3965 return "" 3966 } 3967 if {[string compare $last "end"] == 0} { 3968 set last $data(lastRow) 3969 } 3970 3971 displayItems $win 3972 set fmtCmdFlag [lindex $data(fmtCmdFlagList) $col] 3973 set colFont [lindex $data(colFontList) $col] 3974 set snipStr $data(-snipstring) 3975 3976 set w $data(body) 3977 set pixels [lindex $data(colList) [expr {2*$col}]] 3978 if {$pixels == 0} { ;# convention: dynamic width 3979 if {$data($col-maxPixels) > 0} { 3980 if {$data($col-reqPixels) > $data($col-maxPixels)} { 3981 set pixels $data($col-maxPixels) 3982 } 3983 } 3984 } 3985 if {$pixels != 0} { 3986 incr pixels $data($col-delta) 3987 } 3988 set alignment [lindex $data(colList) [expr {2*$col + 1}]] 3989 variable snipSides 3990 set snipSide $snipSides($alignment,$data($col-changesnipside)) 3991 3992 for {set row $first; set line [expr {$first + 1}]} {$row <= $last} \ 3993 {set row $line; incr line} { 3994 if {$row == $data(editRow) && $col == $data(editCol)} { 3995 continue 3996 } 3997 3998 set item [lindex $data(itemList) $row] 3999 set key [lindex $item end] 4000 if {!$allRows && [info exists data($key-hide)]} { 4001 continue 4002 } 4003 4004 # 4005 # Adjust the cell text and the image or window width 4006 # 4007 set text [lindex $item $col] 4008 if {$fmtCmdFlag} { 4009 set text [formatElem $win $key $row $col $text] 4010 } 4011 set text [strToDispStr $text] 4012 set multiline [string match "*\n*" $text] 4013 set aux [getAuxData $win $key $col auxType auxWidth $pixels] 4014 set indent [getIndentData $win $key $col indentWidth] 4015 set maxTextWidth $pixels 4016 if {[info exists data($key,$col-font)]} { 4017 set cellFont $data($key,$col-font) 4018 } elseif {[info exists data($key-font)]} { 4019 set cellFont $data($key-font) 4020 } else { 4021 set cellFont $colFont 4022 } 4023 if {$pixels != 0} { 4024 set maxTextWidth [getMaxTextWidth $pixels $auxWidth $indentWidth] 4025 4026 if {$data($col-wrap) && !$multiline} { 4027 if {[font measure $cellFont -displayof $win $text] > 4028 $maxTextWidth} { 4029 set multiline 1 4030 } 4031 } 4032 } 4033 if {$multiline} { 4034 set list [split $text "\n"] 4035 if {$data($col-wrap)} { 4036 set snipSide "" 4037 } 4038 adjustMlElem $win list auxWidth indentWidth $cellFont \ 4039 $pixels $snipSide $snipStr 4040 set msgScript [list ::tablelist::displayText $win $key $col \ 4041 [join $list "\n"] $cellFont $maxTextWidth $alignment] 4042 } else { 4043 adjustElem $win text auxWidth indentWidth $cellFont \ 4044 $pixels $snipSide $snipStr 4045 } 4046 4047 # 4048 # Update the text widget's contents between the two tabs 4049 # 4050 if {[findTabs $win $line $col $col tabIdx1 tabIdx2]} { 4051 if {$multiline} { 4052 updateMlCell $w $tabIdx1+1c $tabIdx2 $msgScript $aux $auxType \ 4053 $auxWidth $indent $indentWidth $alignment 4054 } else { 4055 updateCell $w $tabIdx1+1c $tabIdx2 $text $aux $auxType \ 4056 $auxWidth $indent $indentWidth $alignment 4057 } 4058 } 4059 } 4060} 4061 4062#------------------------------------------------------------------------------ 4063# tablelist::makeStripesWhenIdle 4064# 4065# Arranges for the stripes in the body of the tablelist widget win to be 4066# redrawn at idle time. 4067#------------------------------------------------------------------------------ 4068proc tablelist::makeStripesWhenIdle win { 4069 upvar ::tablelist::ns${win}::data data 4070 if {[info exists data(stripesId)] || $data(itemCount) == 0} { 4071 return "" 4072 } 4073 4074 set data(stripesId) [after idle [list tablelist::makeStripes $win]] 4075} 4076 4077#------------------------------------------------------------------------------ 4078# tablelist::makeStripes 4079# 4080# Redraws the stripes in the body of the tablelist widget win. 4081#------------------------------------------------------------------------------ 4082proc tablelist::makeStripes win { 4083 upvar ::tablelist::ns${win}::data data 4084 if {[info exists data(stripesId)]} { 4085 after cancel $data(stripesId) 4086 unset data(stripesId) 4087 } 4088 4089 if {[info exists data(dispId)]} { 4090 return "" 4091 } 4092 4093 set w $data(body) 4094 $w tag remove stripe 1.0 end 4095 if {[string compare $data(-stripebackground) ""] != 0 || 4096 [string compare $data(-stripeforeground) ""] != 0} { 4097 set count 0 4098 set inStripe 0 4099 for {set row 0; set line 1} {$row < $data(itemCount)} \ 4100 {set row $line; incr line} { 4101 set key [lindex $data(keyList) $row] 4102 if {![info exists data($key-hide)]} { 4103 if {$inStripe} { 4104 $w tag add stripe $line.0 $line.end 4105 } 4106 4107 if {[incr count] == $data(-stripeheight)} { 4108 set count 0 4109 set inStripe [expr {!$inStripe}] 4110 } 4111 } 4112 } 4113 } 4114 4115 updateColors $win 4116} 4117 4118#------------------------------------------------------------------------------ 4119# tablelist::showLineNumbersWhenIdle 4120# 4121# Arranges for the line numbers in the tablelist widget win to be redisplayed 4122# at idle time. 4123#------------------------------------------------------------------------------ 4124proc tablelist::showLineNumbersWhenIdle win { 4125 upvar ::tablelist::ns${win}::data data 4126 if {[info exists data(lineNumsId)] || $data(itemCount) == 0} { 4127 return "" 4128 } 4129 4130 set data(lineNumsId) [after idle [list tablelist::showLineNumbers $win]] 4131} 4132 4133#------------------------------------------------------------------------------ 4134# tablelist::showLineNumbers 4135# 4136# Redisplays the line numbers (if any) in the tablelist widget win. 4137#------------------------------------------------------------------------------ 4138proc tablelist::showLineNumbers win { 4139 upvar ::tablelist::ns${win}::data data 4140 if {[info exists data(lineNumsId)]} { 4141 after cancel $data(lineNumsId) 4142 unset data(lineNumsId) 4143 } 4144 4145 # 4146 # Update the item list 4147 # 4148 set colIdxList {} 4149 for {set col 0} {$col < $data(colCount)} {incr col} { 4150 if {!$data($col-showlinenumbers)} { 4151 continue 4152 } 4153 4154 lappend colIdxList $col 4155 4156 set newItemList {} 4157 set line 1 4158 foreach item $data(itemList) { 4159 set item [lreplace $item $col $col $line] 4160 lappend newItemList $item 4161 set key [lindex $item end] 4162 if {![info exists data($key-hide)]} { 4163 incr line 4164 } 4165 } 4166 set data(itemList) $newItemList 4167 4168 redisplayColWhenIdle $win $col 4169 } 4170 4171 if {[llength $colIdxList] == 0} { 4172 return "" 4173 } 4174 4175 # 4176 # Update the list variable if present 4177 # 4178 condUpdateListVar $win 4179 4180 # 4181 # Adjust the columns 4182 # 4183 adjustColumns $win $colIdxList 1 4184 return "" 4185} 4186 4187#------------------------------------------------------------------------------ 4188# tablelist::updateViewWhenIdle 4189# 4190# Arranges for the visible part of the tablelist widget win to be updated 4191# at idle time. 4192#------------------------------------------------------------------------------ 4193proc tablelist::updateViewWhenIdle win { 4194 upvar ::tablelist::ns${win}::data data 4195 if {[info exists data(viewId)]} { 4196 return "" 4197 } 4198 4199 set data(viewId) [after idle [list tablelist::updateView $win]] 4200} 4201 4202#------------------------------------------------------------------------------ 4203# tablelist::updateView 4204# 4205# Updates the visible part of the tablelist widget win. 4206#------------------------------------------------------------------------------ 4207proc tablelist::updateView win { 4208 upvar ::tablelist::ns${win}::data data 4209 if {[info exists data(viewId)]} { 4210 after cancel $data(viewId) 4211 unset data(viewId) 4212 } 4213 4214 adjustElidedText $win 4215 updateColors $win 4216 adjustSeps $win 4217 updateVScrlbar $win 4218} 4219 4220#------------------------------------------------------------------------------ 4221# tablelist::destroyWidgets 4222# 4223# Destroys a list of widgets embedded into the tablelist widget win. 4224#------------------------------------------------------------------------------ 4225proc tablelist::destroyWidgets win { 4226 upvar ::tablelist::ns${win}::data data 4227 set destroyId [lindex $data(destroyIdList) 0] 4228 4229 eval destroy $data(widgets-$destroyId) 4230 4231 set data(destroyIdList) [lrange $data(destroyIdList) 1 end] 4232 unset data(widgets-$destroyId) 4233} 4234 4235#------------------------------------------------------------------------------ 4236# tablelist::synchronize 4237# 4238# This procedure is invoked either as an idle callback after the list variable 4239# associated with the tablelist widget win was written, or directly, upon 4240# execution of some widget commands. It makes sure that the content of the 4241# widget is synchronized with the value of the list variable. 4242#------------------------------------------------------------------------------ 4243proc tablelist::synchronize win { 4244 # 4245 # Nothing to do if the list variable was not written 4246 # 4247 upvar ::tablelist::ns${win}::data data 4248 if {![info exists data(syncId)]} { 4249 return "" 4250 } 4251 4252 # 4253 # Here we are in the case that the procedure was scheduled for 4254 # execution at idle time. However, it might have been invoked 4255 # directly, before the idle time occured; in this case we should 4256 # cancel the execution of the previously scheduled idle callback. 4257 # 4258 after cancel $data(syncId) ;# no harm if data(syncId) is no longer valid 4259 unset data(syncId) 4260 4261 upvar #0 $data(-listvariable) var 4262 set newCount [llength $var] 4263 if {$newCount < $data(itemCount)} { 4264 # 4265 # Delete the items with indices >= newCount from the widget 4266 # 4267 set updateCount $newCount 4268 deleteRows $win $newCount $data(lastRow) 0 4269 } elseif {$newCount > $data(itemCount)} { 4270 # 4271 # Insert the items of var with indices 4272 # >= data(itemCount) into the widget 4273 # 4274 set updateCount $data(itemCount) 4275 insertRows $win $data(itemCount) [lrange $var $data(itemCount) end] 0 \ 4276 root $data(itemCount) 4277 } else { 4278 set updateCount $newCount 4279 } 4280 4281 # 4282 # Update the first updateCount items of the internal list 4283 # 4284 set itemsChanged 0 4285 for {set row 0} {$row < $updateCount} {incr row} { 4286 set oldItem [lindex $data(itemList) $row] 4287 set newItem [adjustItem [lindex $var $row] $data(colCount)] 4288 lappend newItem [lindex $oldItem end] 4289 4290 if {[string compare $oldItem $newItem] != 0} { 4291 set data(itemList) [lreplace $data(itemList) $row $row $newItem] 4292 set itemsChanged 1 4293 } 4294 } 4295 4296 # 4297 # If necessary, adjust the columns and make sure 4298 # that the items will be redisplayed at idle time 4299 # 4300 if {$itemsChanged} { 4301 adjustColumns $win allCols 1 4302 redisplayWhenIdle $win 4303 showLineNumbersWhenIdle $win 4304 updateViewWhenIdle $win 4305 } 4306} 4307 4308#------------------------------------------------------------------------------ 4309# tablelist::getSublabels 4310# 4311# Returns the list of the existing sublabels $w-il and $w-tl associated with 4312# the label widget w. 4313#------------------------------------------------------------------------------ 4314proc tablelist::getSublabels w { 4315 set lst {} 4316 foreach lbl [list $w-il $w-tl] { 4317 if {[winfo exists $lbl]} { 4318 lappend lst $lbl 4319 } 4320 } 4321 4322 return $lst 4323} 4324 4325#------------------------------------------------------------------------------ 4326# tablelist::parseLabelPath 4327# 4328# Extracts the path name of the tablelist widget as well as the column number 4329# from the path name w of a header label. 4330#------------------------------------------------------------------------------ 4331proc tablelist::parseLabelPath {w winName colName} { 4332 upvar $winName win $colName col 4333 return [regexp {^(\..+)\.hdr\.t\.f\.l([0-9]+)$} $w dummy win col] 4334} 4335 4336#------------------------------------------------------------------------------ 4337# tablelist::configLabel 4338# 4339# This procedure configures the label widget w according to the options and 4340# their values given in args. It is needed for label widgets with sublabels. 4341#------------------------------------------------------------------------------ 4342proc tablelist::configLabel {w args} { 4343 foreach {opt val} $args { 4344 switch -- $opt { 4345 -active { 4346 if {[string compare [winfo class $w] "TLabel"] == 0} { 4347 if {![$w instate selected]} { 4348 set state [expr {$val ? "active" : "!active"}] 4349 $w state $state 4350 if {$val} { 4351 variable themeDefaults 4352 set bg $themeDefaults(-labelactiveBg) 4353 } else { 4354 set bg [$w cget -background] 4355 } 4356 foreach l [getSublabels $w] { 4357 $l configure -background $bg 4358 } 4359 } 4360 } else { 4361 set state [expr {$val ? "active" : "normal"}] 4362 catch { 4363 $w configure -state $state 4364 foreach l [getSublabels $w] { 4365 $l configure -state $state 4366 } 4367 } 4368 } 4369 4370 parseLabelPath $w win col 4371 upvar ::tablelist::ns${win}::data data 4372 if {[lsearch -exact $data(arrowColList) $col] >= 0} { 4373 configCanvas $win $col 4374 } 4375 } 4376 4377 -activebackground - 4378 -activeforeground - 4379 -disabledforeground - 4380 -cursor { 4381 $w configure $opt $val 4382 foreach l [getSublabels $w] { 4383 $l configure $opt $val 4384 } 4385 } 4386 4387 -background - 4388 -foreground - 4389 -font { 4390 if {[string compare $val ""] == 0 && 4391 [string compare [winfo class $w] "TLabel"] == 0} { 4392 variable themeDefaults 4393 set val $themeDefaults(-label[string range $opt 1 end]) 4394 } 4395 $w configure $opt $val 4396 foreach l [getSublabels $w] { 4397 $l configure $opt $val 4398 } 4399 } 4400 4401 -padx { 4402 if {[string compare [winfo class $w] "TLabel"] == 0} { 4403 set padding [$w cget -padding] 4404 $w configure -padding \ 4405 [list $val [lindex $padding 1] $val [lindex $padding 3]] 4406 } else { 4407 $w configure $opt $val 4408 } 4409 } 4410 4411 -pady { 4412 if {[string compare [winfo class $w] "TLabel"] == 0} { 4413 set val [winfo pixels $w $val] 4414 set padding [$w cget -padding] 4415 $w configure -padding \ 4416 [list [lindex $padding 0] $val [lindex $padding 2] $val] 4417 } else { 4418 $w configure $opt $val 4419 } 4420 } 4421 4422 -pressed { 4423 if {[string compare [winfo class $w] "TLabel"] == 0} { 4424 set state [expr {$val ? "pressed" : "!pressed"}] 4425 $w state $state 4426 variable themeDefaults 4427 if {$val} { 4428 if {[$w instate selected]} { 4429 set bg $themeDefaults(-labelselectedpressedBg) 4430 } else { 4431 set bg $themeDefaults(-labelpressedBg) 4432 } 4433 } else { 4434 if {[$w instate selected]} { 4435 set bg $themeDefaults(-labelselectedBg) 4436 } elseif {[$w instate active]} { 4437 set bg $themeDefaults(-labelactiveBg) 4438 } else { 4439 set bg [$w cget -background] 4440 } 4441 } 4442 foreach l [getSublabels $w] { 4443 $l configure -background $bg 4444 } 4445 4446 parseLabelPath $w win col 4447 upvar ::tablelist::ns${win}::data data 4448 if {[lsearch -exact $data(arrowColList) $col] >= 0} { 4449 configCanvas $win $col 4450 } 4451 } 4452 } 4453 4454 -selected { 4455 if {[string compare [winfo class $w] "TLabel"] == 0} { 4456 set state [expr {$val ? "selected" : "!selected"}] 4457 $w state $state 4458 variable themeDefaults 4459 if {$val} { 4460 if {[$w instate pressed]} { 4461 set bg $themeDefaults(-labelselectedpressedBg) 4462 } else { 4463 set bg $themeDefaults(-labelselectedBg) 4464 } 4465 } else { 4466 if {[$w instate pressed]} { 4467 set bg $themeDefaults(-labelpressedBg) 4468 } else { 4469 set bg [$w cget -background] 4470 } 4471 } 4472 foreach l [getSublabels $w] { 4473 $l configure -background $bg 4474 } 4475 4476 parseLabelPath $w win col 4477 upvar ::tablelist::ns${win}::data data 4478 if {[lsearch -exact $data(arrowColList) $col] >= 0} { 4479 configCanvas $win $col 4480 } 4481 } 4482 } 4483 4484 -state { 4485 $w configure $opt $val 4486 if {[string compare [winfo class $w] "TLabel"] == 0} { 4487 if {[string compare $val "disabled"] == 0} { 4488 variable themeDefaults 4489 set bg $themeDefaults(-labeldisabledBg) 4490 } else { 4491 set bg [$w cget -background] 4492 } 4493 foreach l [getSublabels $w] { 4494 $l configure -background $bg 4495 } 4496 } else { 4497 foreach l [getSublabels $w] { 4498 $l configure $opt $val 4499 } 4500 } 4501 } 4502 4503 default { 4504 if {[string compare $val [$w cget $opt]] != 0} { 4505 $w configure $opt $val 4506 } 4507 } 4508 } 4509 } 4510} 4511 4512#------------------------------------------------------------------------------ 4513# tablelist::createArrows 4514# 4515# Creates two arrows in the canvas w. 4516#------------------------------------------------------------------------------ 4517proc tablelist::createArrows {w width height relief} { 4518 if {$height < 6} { 4519 set wHeight 6 4520 set y 1 4521 } else { 4522 set wHeight $height 4523 set y 0 4524 } 4525 4526 $w configure -width $width -height $wHeight 4527 4528 # 4529 # Delete any existing arrow image items from 4530 # the canvas and the corresponding images 4531 # 4532 foreach shape {triangleUp darkLineUp lightLineUp 4533 triangleDn darkLineDn lightLineDn} { 4534 $w delete $shape 4535 catch {image delete $shape$w} 4536 } 4537 4538 # 4539 # Create the arrow images and canvas image items 4540 # corresponding to the procedure's arguments 4541 # 4542 $relief${width}x${height}Arrows $w 4543 foreach shape {triangleUp darkLineUp lightLineUp 4544 triangleDn darkLineDn lightLineDn} { 4545 catch {$w create image 0 $y -anchor nw -image $shape$w -tags $shape} 4546 } 4547 4548 # 4549 # Create the sort rank image item 4550 # 4551 $w delete sortRank 4552 set x [expr {$width + 2}] 4553 set y [expr {$wHeight - 6}] 4554 $w create image $x $y -anchor nw -tags sortRank 4555} 4556 4557#------------------------------------------------------------------------------ 4558# tablelist::configCanvas 4559# 4560# Sets the background color of the canvas displaying an up- or down-arrow for 4561# the given column, and fills the two arrows contained in the canvas. 4562#------------------------------------------------------------------------------ 4563proc tablelist::configCanvas {win col} { 4564 upvar ::tablelist::ns${win}::data data 4565 set w $data(hdrTxtFrLbl)$col 4566 set labelBg [$w cget -background] 4567 set labelFg [$w cget -foreground] 4568 4569 if {[string compare [winfo class $w] "TLabel"] == 0} { 4570 variable themeDefaults 4571 if {[$w instate disabled]} { 4572 set labelBg $themeDefaults(-labeldisabledBg) 4573 set labelFg $themeDefaults(-labeldisabledFg) 4574 } elseif {![$win instate background]} { 4575 foreach state {active pressed selected} { 4576 $w instate $state { 4577 set labelBg $themeDefaults(-label${state}Bg) 4578 set labelFg $themeDefaults(-label${state}Fg) 4579 } 4580 if {[$w instate selected] && [$w instate pressed]} { 4581 set labelBg $themeDefaults(-labelselectedpressedBg) 4582 set labelFg $themeDefaults(-labelselectedpressedFg) 4583 } 4584 } 4585 } 4586 } else { 4587 catch { 4588 set state [$w cget -state] 4589 variable winSys 4590 if {[string compare $state "disabled"] == 0} { 4591 set labelFg [$w cget -disabledforeground] 4592 } elseif {[string compare $state "active"] == 0 && 4593 [string compare $winSys "classic"] != 0 && 4594 [string compare $winSys "aqua"] != 0} { 4595 set labelBg [$w cget -activebackground] 4596 set labelFg [$w cget -activeforeground] 4597 } 4598 } 4599 } 4600 4601 set w $data(hdrTxtFrCanv)$col 4602 $w configure -background $labelBg 4603 sortRank$data($col-sortRank)$win configure -foreground $labelFg 4604 4605 if {$data(isDisabled)} { 4606 fillArrows $w $data(-arrowdisabledcolor) $data(-arrowstyle) 4607 } else { 4608 fillArrows $w $data(-arrowcolor) $data(-arrowstyle) 4609 } 4610} 4611 4612#------------------------------------------------------------------------------ 4613# tablelist::fillArrows 4614# 4615# Fills the two arrows contained in the canvas w with the given color, or with 4616# the background color of the canvas if color is an empty string. Also fills 4617# the arrow's borders (if any) with the corresponding 3-D shadow colors. 4618#------------------------------------------------------------------------------ 4619proc tablelist::fillArrows {w color arrowStyle} { 4620 set bgColor [$w cget -background] 4621 if {[string compare $color ""] == 0} { 4622 set color $bgColor 4623 } 4624 4625 getShadows $w $color darkColor lightColor 4626 4627 foreach dir {Up Dn} { 4628 triangle$dir$w configure -foreground $color -background $bgColor 4629 if {[string match "sunken*" $arrowStyle]} { 4630 darkLine$dir$w configure -foreground $darkColor 4631 lightLine$dir$w configure -foreground $lightColor 4632 } 4633 } 4634} 4635 4636#------------------------------------------------------------------------------ 4637# tablelist::getShadows 4638# 4639# Computes the shadow colors for a 3-D border from a given (background) color. 4640# This is the Tcl-counterpart of the function TkpGetShadows() in the Tk 4641# distribution file unix/tkUnix3d.c. 4642#------------------------------------------------------------------------------ 4643proc tablelist::getShadows {w color darkColorName lightColorName} { 4644 upvar $darkColorName darkColor $lightColorName lightColor 4645 4646 set rgb [winfo rgb $w $color] 4647 foreach {r g b} $rgb {} 4648 set maxIntens [lindex [winfo rgb $w white] 0] 4649 4650 # 4651 # Compute the dark shadow color 4652 # 4653 if {[string compare $::tk_patchLevel "8.3.1"] >= 0 && 4654 $r*0.5*$r + $g*1.0*$g + $b*0.28*$b < $maxIntens*0.05*$maxIntens} { 4655 # 4656 # The background is already very dark: make the dark 4657 # color a little lighter than the background by increasing 4658 # each color component 1/4th of the way to $maxIntens 4659 # 4660 foreach comp $rgb { 4661 lappend darkRGB [expr {($maxIntens + 3*$comp)/4}] 4662 } 4663 } else { 4664 # 4665 # Compute the dark color by cutting 40% from 4666 # each of the background color components. 4667 # 4668 foreach comp $rgb { 4669 lappend darkRGB [expr {60*$comp/100}] 4670 } 4671 } 4672 set darkColor [eval format "#%04x%04x%04x" $darkRGB] 4673 4674 # 4675 # Compute the light shadow color 4676 # 4677 if {[string compare $::tk_patchLevel "8.3.1"] >= 0 && 4678 $g > $maxIntens*0.95} { 4679 # 4680 # The background is already very bright: make the 4681 # light color a little darker than the background 4682 # by reducing each color component by 10% 4683 # 4684 foreach comp $rgb { 4685 lappend lightRGB [expr {90*$comp/100}] 4686 } 4687 } else { 4688 # 4689 # Compute the light color by boosting each background 4690 # color component by 40% or half-way to white, whichever 4691 # is greater (the first approach works better for 4692 # unsaturated colors, the second for saturated ones) 4693 # 4694 foreach comp $rgb { 4695 set comp1 [expr {140*$comp/100}] 4696 if {$comp1 > $maxIntens} { 4697 set comp1 $maxIntens 4698 } 4699 set comp2 [expr {($maxIntens + $comp)/2}] 4700 lappend lightRGB [expr {($comp1 > $comp2) ? $comp1 : $comp2}] 4701 } 4702 } 4703 set lightColor [eval format "#%04x%04x%04x" $lightRGB] 4704} 4705 4706#------------------------------------------------------------------------------ 4707# tablelist::raiseArrow 4708# 4709# Raises one of the two arrows contained in the canvas associated with the 4710# given column of the tablelist widget win. 4711#------------------------------------------------------------------------------ 4712proc tablelist::raiseArrow {win col} { 4713 upvar ::tablelist::ns${win}::data data 4714 set w $data(hdrTxtFrCanv)$col 4715 variable directions 4716 set dir $directions($data(-incrarrowtype),$data($col-sortOrder)) 4717 4718 $w raise triangle$dir 4719 $w raise darkLine$dir 4720 $w raise lightLine$dir 4721} 4722 4723#------------------------------------------------------------------------------ 4724# tablelist::isHdrTxtFrXPosVisible 4725# 4726# Checks whether the given x position in the header text child of the tablelist 4727# widget win is visible. 4728#------------------------------------------------------------------------------ 4729proc tablelist::isHdrTxtFrXPosVisible {win x} { 4730 upvar ::tablelist::ns${win}::data data 4731 foreach {fraction1 fraction2} [$data(hdrTxt) xview] {} 4732 return [expr {$x >= $fraction1 * $data(hdrPixels) && 4733 $x < $fraction2 * $data(hdrPixels)}] 4734} 4735 4736#------------------------------------------------------------------------------ 4737# tablelist::getScrlContentWidth 4738# 4739# Returns the total width of the non-hidden scrollable columns of the tablelist 4740# widget win, in the specified range. 4741#------------------------------------------------------------------------------ 4742proc tablelist::getScrlContentWidth {win scrlColOffset lastCol} { 4743 upvar ::tablelist::ns${win}::data data 4744 set scrlContentWidth 0 4745 set nonHiddenCount 0 4746 for {set col $data(-titlecolumns)} {$col <= $lastCol} {incr col} { 4747 if {!$data($col-hide) && [incr nonHiddenCount] > $scrlColOffset} { 4748 incr scrlContentWidth [colWidth $win $col -total] 4749 } 4750 } 4751 4752 return $scrlContentWidth 4753} 4754 4755#------------------------------------------------------------------------------ 4756# tablelist::getScrlWindowWidth 4757# 4758# Returns the number of pixels obtained by subtracting the widths of the non- 4759# hidden title columns from the width of the header frame of the tablelist 4760# widget win. 4761#------------------------------------------------------------------------------ 4762proc tablelist::getScrlWindowWidth win { 4763 upvar ::tablelist::ns${win}::data data 4764 set scrlWindowWidth [winfo width $data(hdr)] 4765 for {set col 0} {$col < $data(-titlecolumns) && $col < $data(colCount)} \ 4766 {incr col} { 4767 if {!$data($col-hide)} { 4768 incr scrlWindowWidth -[colWidth $win $col -total] 4769 } 4770 } 4771 4772 return $scrlWindowWidth 4773} 4774 4775#------------------------------------------------------------------------------ 4776# tablelist::getMaxScrlColOffset 4777# 4778# Returns the max. scrolled column offset of the tablelist widget win. 4779#------------------------------------------------------------------------------ 4780proc tablelist::getMaxScrlColOffset win { 4781 # 4782 # Get the number of non-hidden scrollable columns 4783 # 4784 upvar ::tablelist::ns${win}::data data 4785 set maxScrlColOffset 0 4786 for {set col $data(-titlecolumns)} {$col < $data(colCount)} {incr col} { 4787 if {!$data($col-hide)} { 4788 incr maxScrlColOffset 4789 } 4790 } 4791 4792 # 4793 # Decrement maxScrlColOffset while the total width of the 4794 # non-hidden scrollable columns starting with this offset 4795 # is less than the width of the window's scrollable part 4796 # 4797 set scrlWindowWidth [getScrlWindowWidth $win] 4798 if {$scrlWindowWidth > 0} { 4799 while {$maxScrlColOffset > 0} { 4800 incr maxScrlColOffset -1 4801 set scrlContentWidth \ 4802 [getScrlContentWidth $win $maxScrlColOffset $data(lastCol)] 4803 if {$scrlContentWidth == $scrlWindowWidth} { 4804 break 4805 } elseif {$scrlContentWidth > $scrlWindowWidth} { 4806 incr maxScrlColOffset 4807 break 4808 } 4809 } 4810 } 4811 4812 return $maxScrlColOffset 4813} 4814 4815#------------------------------------------------------------------------------ 4816# tablelist::changeScrlColOffset 4817# 4818# Changes the scrolled column offset of the tablelist widget win. 4819#------------------------------------------------------------------------------ 4820proc tablelist::changeScrlColOffset {win scrlColOffset} { 4821 # 4822 # Make sure the offset is non-negative and no 4823 # greater than the max. scrolled column offset 4824 # 4825 if {$scrlColOffset < 0} { 4826 set scrlColOffset 0 4827 } else { 4828 set maxScrlColOffset [getMaxScrlColOffset $win] 4829 if {$scrlColOffset > $maxScrlColOffset} { 4830 set scrlColOffset $maxScrlColOffset 4831 } 4832 } 4833 4834 # 4835 # Update data(scrlColOffset) and adjust the 4836 # elided text in the tablelist's body if necessary 4837 # 4838 upvar ::tablelist::ns${win}::data data 4839 if {$scrlColOffset != $data(scrlColOffset)} { 4840 set data(scrlColOffset) $scrlColOffset 4841 adjustElidedText $win 4842 } 4843} 4844 4845#------------------------------------------------------------------------------ 4846# tablelist::scrlXOffsetToColOffset 4847# 4848# Returns the scrolled column offset of the tablelist widget win, corresponding 4849# to the desired x offset. 4850#------------------------------------------------------------------------------ 4851proc tablelist::scrlXOffsetToColOffset {win scrlXOffset} { 4852 upvar ::tablelist::ns${win}::data data 4853 set scrlColOffset 0 4854 set scrlContentWidth 0 4855 for {set col $data(-titlecolumns)} {$col < $data(colCount)} {incr col} { 4856 if {$data($col-hide)} { 4857 continue 4858 } 4859 4860 incr scrlContentWidth [colWidth $win $col -total] 4861 if {$scrlContentWidth > $scrlXOffset} { 4862 break 4863 } else { 4864 incr scrlColOffset 4865 } 4866 } 4867 4868 return $scrlColOffset 4869} 4870 4871#------------------------------------------------------------------------------ 4872# tablelist::scrlColOffsetToXOffset 4873# 4874# Returns the x offset corresponding to the specified scrolled column offset of 4875# the tablelist widget win. 4876#------------------------------------------------------------------------------ 4877proc tablelist::scrlColOffsetToXOffset {win scrlColOffset} { 4878 upvar ::tablelist::ns${win}::data data 4879 set scrlXOffset 0 4880 set nonHiddenCount 0 4881 for {set col $data(-titlecolumns)} {$col < $data(colCount)} {incr col} { 4882 if {$data($col-hide)} { 4883 continue 4884 } 4885 4886 if {[incr nonHiddenCount] > $scrlColOffset} { 4887 break 4888 } else { 4889 incr scrlXOffset [colWidth $win $col -total] 4890 } 4891 } 4892 4893 return $scrlXOffset 4894} 4895 4896#------------------------------------------------------------------------------ 4897# tablelist::getNonHiddenRowCount 4898# 4899# Returns the number of non-hidden rows of the tablelist widget win in the 4900# specified range. 4901#------------------------------------------------------------------------------ 4902proc tablelist::getNonHiddenRowCount {win first last} { 4903 upvar ::tablelist::ns${win}::data data 4904 if {$data(hiddenRowCount) == 0} { 4905 return [expr {$last - $first + 1}] 4906 } else { 4907 set count 0 4908 for {set row $first} {$row <= $last} {incr row} { 4909 set key [lindex $data(keyList) $row] 4910 if {![info exists data($key-hide)]} { 4911 incr count 4912 } 4913 } 4914 } 4915 4916 return $count 4917} 4918 4919#------------------------------------------------------------------------------ 4920# tablelist::nonHiddenRowOffsetToRowIndex 4921# 4922# Returns the row index corresponding to the given non-hidden row offset in the 4923# tablelist widget win. 4924#------------------------------------------------------------------------------ 4925proc tablelist::nonHiddenRowOffsetToRowIndex {win offset} { 4926 upvar ::tablelist::ns${win}::data data 4927 if {$data(hiddenRowCount) == 0} { 4928 return $offset 4929 } else { 4930 # 4931 # Rebuild the list data(nonHiddenRowList) of the row 4932 # indices indicating the non-hidden rows if needed 4933 # 4934 if {[lindex $data(nonHiddenRowList) 0] == -1} { 4935 set data(nonHiddenRowList) {} 4936 for {set row 0} {$row < $data(itemCount)} {incr row} { 4937 set key [lindex $data(keyList) $row] 4938 if {![info exists data($key-hide)]} { 4939 lappend data(nonHiddenRowList) $row 4940 } 4941 } 4942 } 4943 4944 set nonHiddenCount [llength $data(nonHiddenRowList)] 4945 if {$nonHiddenCount == 0} { 4946 return 0 4947 } else { 4948 if {$offset >= $nonHiddenCount} { 4949 set offset [expr {$nonHiddenCount - 1}] 4950 } 4951 if {$offset < 0} { 4952 set offset 0 4953 } 4954 return [lindex $data(nonHiddenRowList) $offset] 4955 } 4956 } 4957} 4958