1#============================================================================== 2# Contains public and private procedures used in tablelist bindings. 3# 4# Structure of the module: 5# - Public helper procedures 6# - Binding tag Tablelist 7# - Binding tag TablelistWindow 8# - Binding tag TablelistBody 9# - Binding tags TablelistLabel, TablelistSubLabel, and TablelistArrow 10# 11# Copyright (c) 2000-2008 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) 12#============================================================================== 13 14# 15# Public helper procedures 16# ======================== 17# 18 19#------------------------------------------------------------------------------ 20# tablelist::getTablelistPath 21# 22# Gets the path name of the tablelist widget from the path name w of one of its 23# descendants. It is assumed that all of the ancestors of w exist (but w 24# itself needn't exist). 25#------------------------------------------------------------------------------ 26proc tablelist::getTablelistPath w { 27 return [mwutil::getAncestorByClass $w Tablelist] 28} 29 30#------------------------------------------------------------------------------ 31# tablelist::convEventFields 32# 33# Gets the path name of the tablelist widget and the x and y coordinates 34# relative to the latter from the path name w of one of its descendants and 35# from the x and y coordinates relative to the latter. 36#------------------------------------------------------------------------------ 37proc tablelist::convEventFields {w x y} { 38 return [mwutil::convEventFields $w $x $y Tablelist] 39} 40 41# 42# Binding tag Tablelist 43# ===================== 44# 45 46#------------------------------------------------------------------------------ 47# tablelist::addActiveTag 48# 49# This procedure is invoked when the tablelist widget win gains the keyboard 50# focus. It adds the "active" tag to the line or cell that displays the active 51# item or element of the widget in its body text child. 52#------------------------------------------------------------------------------ 53proc tablelist::addActiveTag win { 54 upvar ::tablelist::ns${win}::data data 55 set line [expr {$data(activeRow) + 1}] 56 set col $data(activeCol) 57 if {[string compare $data(-selecttype) "row"] == 0} { 58 $data(body) tag add active $line.0 $line.end 59 } elseif {$data(itemCount) > 0 && $data(colCount) > 0 && 60 $line > 0 && !$data($col-hide)} { 61 findTabs $win $line $col $col tabIdx1 tabIdx2 62 $data(body) tag add active $tabIdx1 $tabIdx2+1c 63 } 64 65 set data(ownsFocus) 1 66} 67 68#------------------------------------------------------------------------------ 69# tablelist::removeActiveTag 70# 71# This procedure is invoked when the tablelist widget win loses the keyboard 72# focus. It removes the "active" tag from the body text child of the widget. 73#------------------------------------------------------------------------------ 74proc tablelist::removeActiveTag win { 75 upvar ::tablelist::ns${win}::data data 76 $data(body) tag remove active 1.0 end 77 78 set data(ownsFocus) 0 79} 80 81#------------------------------------------------------------------------------ 82# tablelist::cleanup 83# 84# This procedure is invoked when the tablelist widget win is destroyed. It 85# executes some cleanup operations. 86#------------------------------------------------------------------------------ 87proc tablelist::cleanup win { 88 # 89 # Cancel the execution of all delayed adjustSeps, 90 # makeStripes, showLineNumbers, stretchColumns, updateColors, 91 # updateScrlColOffset, updateHScrlbar, updateVScrlbar, 92 # adjustElidedText, synchronize, displayItems, horizAutoScan, 93 # doCellConfig, redisplay, and redisplayCol commands 94 # 95 upvar ::tablelist::ns${win}::data data 96 foreach id {sepsId stripesId lineNumsId stretchId colorId offsetId \ 97 hScrlbarId vScrlbarId elidedId syncId dispId afterId 98 reconfigId} { 99 if {[info exists data($id)]} { 100 after cancel $data($id) 101 } 102 } 103 foreach name [array names data *redispId] { 104 after cancel $data($name) 105 } 106 107 # 108 # If there is a list variable associated with the 109 # widget then remove the trace set on this variable 110 # 111 if {$data(hasListVar) && [info exists $data(-listvariable)]} { 112 upvar #0 $data(-listvariable) var 113 trace vdelete var wu $data(listVarTraceCmd) 114 } 115 116 namespace delete ::tablelist::ns$win 117 catch {rename ::$win ""} 118} 119 120#------------------------------------------------------------------------------ 121# tablelist::updateConfigSpecs 122# 123# This procedure handles the virtual event <<ThemeChanged>> by updating the 124# theme-specific default values of some tablelist configuration options. 125#------------------------------------------------------------------------------ 126proc tablelist::updateConfigSpecs win { 127 # 128 # This might be an "after idle" callback; check whether the window exists 129 # 130 if {![winfo exists $win]} { 131 return "" 132 } 133 134 set currentTheme [getCurrentTheme] 135 upvar ::tablelist::ns${win}::data data 136 if {[string compare $currentTheme $data(currentTheme)] == 0} { 137 if {[string compare $currentTheme "tileqt"] == 0} { 138 set widgetStyle [tileqt_currentThemeName] 139 set colorScheme [getKdeConfigVal "KDE" "colorScheme"] 140 if {[string compare $widgetStyle $data(widgetStyle)] == 0 && 141 [string compare $colorScheme $data(colorScheme)] == 0} { 142 return "" 143 } 144 } else { 145 return "" 146 } 147 } 148 149 variable themeDefaults 150 variable configSpecs 151 152 # 153 # Populate the array tmp with values corresponding to the old theme 154 # and the array themeDefaults with values corresponding to the new one 155 # 156 array set tmp $data(themeDefaults) 157 setThemeDefaults 158 159 # 160 # Update the default values in the array configSpecs and 161 # set those configuration options whose values equal the old 162 # theme-specific defaults to the new theme-specific ones 163 # 164 foreach opt {-background -foreground -disabledforeground -stripebackground 165 -selectbackground -selectforeground -selectborderwidth -font 166 -labelbackground -labelforeground -labelfont 167 -labelborderwidth -labelpady 168 -arrowcolor -arrowdisabledcolor -arrowstyle} { 169 lset configSpecs($opt) 3 $themeDefaults($opt) 170 if {[string compare $data($opt) $tmp($opt)] == 0} { 171 doConfig $win $opt $themeDefaults($opt) 172 } 173 } 174 foreach opt {-background -foreground} { 175 doConfig $win $opt $data($opt) ;# sets the bg color of the separators 176 } 177 178 # 179 # Destroy and recreate the edit window if present 180 # 181 if {[set editCol $data(editCol)] >= 0} { 182 set editRow $data(editRow) 183 saveEditData $win 184 destroy $data(bodyFr) 185 doEditCell $win $editRow $editCol 1 186 } 187 188 # 189 # Destroy and recreate the embedded windows 190 # 191 if {$data(winCount) != 0} { 192 for {set row 0} {$row < $data(itemCount)} {incr row} { 193 for {set col 0} {$col < $data(colCount)} {incr col} { 194 set key [lindex [lindex $data(itemList) $row] end] 195 if {[info exists data($key,$col-window)]} { 196 set val $data($key,$col-window) 197 doCellConfig $row $col $win -window "" 198 doCellConfig $row $col $win -window $val 199 } 200 } 201 } 202 } 203 204 set data(currentTheme) $currentTheme 205 set data(themeDefaults) [array get themeDefaults] 206 if {[string compare $currentTheme "tileqt"] == 0} { 207 set data(widgetStyle) [tileqt_currentThemeName] 208 set data(colorScheme) [getKdeConfigVal "KDE" "colorScheme"] 209 } else { 210 set data(widgetStyle) "" 211 set data(colorScheme) "" 212 } 213} 214 215# 216# Binding tag TablelistWindow 217# =========================== 218# 219 220#------------------------------------------------------------------------------ 221# tablelist::cleanupWindow 222# 223# This procedure is invoked when a window aux embedded into a tablelist widget 224# is destroyed. It invokes the cleanup script associated with the cell 225# containing the window, if any. 226#------------------------------------------------------------------------------ 227proc tablelist::cleanupWindow aux { 228 regexp {^(.+)\.body\.f(k[0-9]+),([0-9]+)$} $aux dummy win key col 229 upvar ::tablelist::ns${win}::data data 230 if {[info exists data($key,$col-windowdestroy)]} { 231 set row [lsearch $data(itemList) "* $key"] 232 uplevel #0 $data($key,$col-windowdestroy) [list $win $row $col $aux.w] 233 } 234} 235 236# 237# Binding tag TablelistBody 238# ========================= 239# 240 241#------------------------------------------------------------------------------ 242# tablelist::defineTablelistBody 243# 244# Defines the bindings for the binding tag TablelistBody. 245#------------------------------------------------------------------------------ 246proc tablelist::defineTablelistBody {} { 247 variable priv 248 array set priv { 249 x "" 250 y "" 251 afterId "" 252 prevRow "" 253 prevCol "" 254 selection {} 255 clicked 0 256 clickTime 0 257 clickedInEditWin 0 258 } 259 260 foreach event {<Enter> <Motion> <Leave>} { 261 bind TablelistBody $event { 262 foreach {tablelist::W tablelist::x tablelist::y} \ 263 [tablelist::convEventFields %W %x %y] {} 264 265 tablelist::showOrHideTooltip $tablelist::W \ 266 $tablelist::x $tablelist::y %X %Y 267 } 268 } 269 bind TablelistBody <Button-1> { 270 if {[winfo exists %W]} { 271 foreach {tablelist::W tablelist::x tablelist::y} \ 272 [tablelist::convEventFields %W %x %y] {} 273 274 set tablelist::priv(x) $tablelist::x 275 set tablelist::priv(y) $tablelist::y 276 set tablelist::priv(row) [$tablelist::W nearest $tablelist::y] 277 set tablelist::priv(col) [$tablelist::W nearestcolumn $tablelist::x] 278 set tablelist::priv(clicked) 1 279 set tablelist::priv(clickTime) %t 280 set tablelist::priv(clickedInEditWin) 0 281 if {[$tablelist::W cget -setfocus] && 282 [string compare [$tablelist::W cget -state] "normal"] == 0} { 283 focus [$tablelist::W bodypath] 284 } 285 tablelist::condEditContainingCell $tablelist::W \ 286 $tablelist::x $tablelist::y 287 tablelist::condBeginMove $tablelist::W $tablelist::priv(row) 288 tablelist::beginSelect $tablelist::W \ 289 $tablelist::priv(row) $tablelist::priv(col) 290 } 291 } 292 bind TablelistBody <Double-Button-1> { 293 # Empty script 294 } 295 bind TablelistBody <B1-Motion> { 296 if {$tablelist::priv(clicked) && 297 %t - $tablelist::priv(clickTime) < 300} { 298 continue 299 } 300 foreach {tablelist::W tablelist::x tablelist::y} \ 301 [tablelist::convEventFields %W %x %y] {} 302 303 if {[string compare $tablelist::priv(x) ""] == 0 || 304 [string compare $tablelist::priv(y) ""] == 0} { 305 set tablelist::priv(x) $tablelist::x 306 set tablelist::priv(y) $tablelist::y 307 } 308 set tablelist::priv(prevX) $tablelist::priv(x) 309 set tablelist::priv(prevY) $tablelist::priv(y) 310 set tablelist::priv(x) $tablelist::x 311 set tablelist::priv(y) $tablelist::y 312 tablelist::condAutoScan $tablelist::W 313 tablelist::motion $tablelist::W \ 314 [$tablelist::W nearest $tablelist::y] \ 315 [$tablelist::W nearestcolumn $tablelist::x] 316 tablelist::condShowTarget $tablelist::W $tablelist::y 317 } 318 bind TablelistBody <ButtonRelease-1> { 319 foreach {tablelist::W tablelist::x tablelist::y} \ 320 [tablelist::convEventFields %W %x %y] {} 321 322 set tablelist::priv(x) "" 323 set tablelist::priv(y) "" 324 set tablelist::priv(clicked) 0 325 after cancel $tablelist::priv(afterId) 326 set tablelist::priv(afterId) "" 327 set tablelist::priv(releasedInEditWin) 0 328 if {$tablelist::priv(clicked) && 329 %t - $tablelist::priv(clickTime) < 300} { 330 tablelist::moveOrActivate $tablelist::W \ 331 $tablelist::priv(row) $tablelist::priv(col) 332 } else { 333 tablelist::moveOrActivate $tablelist::W \ 334 [$tablelist::W nearest $tablelist::y] \ 335 [$tablelist::W nearestcolumn $tablelist::x] 336 } 337 tablelist::condEvalInvokeCmd $tablelist::W 338 } 339 bind TablelistBody <Shift-Button-1> { 340 foreach {tablelist::W tablelist::x tablelist::y} \ 341 [tablelist::convEventFields %W %x %y] {} 342 343 tablelist::beginExtend $tablelist::W \ 344 [$tablelist::W nearest $tablelist::y] \ 345 [$tablelist::W nearestcolumn $tablelist::x] 346 } 347 bind TablelistBody <Control-Button-1> { 348 foreach {tablelist::W tablelist::x tablelist::y} \ 349 [tablelist::convEventFields %W %x %y] {} 350 351 tablelist::beginToggle $tablelist::W \ 352 [$tablelist::W nearest $tablelist::y] \ 353 [$tablelist::W nearestcolumn $tablelist::x] 354 } 355 356 bind TablelistBody <Return> { 357 tablelist::condEditActiveCell [tablelist::getTablelistPath %W] 358 } 359 bind TablelistBody <KP_Enter> { 360 tablelist::condEditActiveCell [tablelist::getTablelistPath %W] 361 } 362 bind TablelistBody <Tab> { 363 tablelist::nextPrevCell [tablelist::getTablelistPath %W] 1 364 } 365 bind TablelistBody <Shift-Tab> { 366 tablelist::nextPrevCell [tablelist::getTablelistPath %W] -1 367 } 368 bind TablelistBody <<PrevWindow>> { 369 tablelist::nextPrevCell [tablelist::getTablelistPath %W] -1 370 } 371 bind TablelistBody <Up> { 372 tablelist::upDown [tablelist::getTablelistPath %W] -1 373 } 374 bind TablelistBody <Down> { 375 tablelist::upDown [tablelist::getTablelistPath %W] 1 376 } 377 bind TablelistBody <Left> { 378 tablelist::leftRight [tablelist::getTablelistPath %W] -1 379 } 380 bind TablelistBody <Right> { 381 tablelist::leftRight [tablelist::getTablelistPath %W] 1 382 } 383 bind TablelistBody <Prior> { 384 tablelist::priorNext [tablelist::getTablelistPath %W] -1 385 } 386 bind TablelistBody <Next> { 387 tablelist::priorNext [tablelist::getTablelistPath %W] 1 388 } 389 bind TablelistBody <Home> { 390 tablelist::homeEnd [tablelist::getTablelistPath %W] Home 391 } 392 bind TablelistBody <End> { 393 tablelist::homeEnd [tablelist::getTablelistPath %W] End 394 } 395 bind TablelistBody <Control-Home> { 396 tablelist::firstLast [tablelist::getTablelistPath %W] first 397 } 398 bind TablelistBody <Control-End> { 399 tablelist::firstLast [tablelist::getTablelistPath %W] last 400 } 401 bind TablelistBody <Shift-Up> { 402 tablelist::extendUpDown [tablelist::getTablelistPath %W] -1 403 } 404 bind TablelistBody <Shift-Down> { 405 tablelist::extendUpDown [tablelist::getTablelistPath %W] 1 406 } 407 bind TablelistBody <Shift-Left> { 408 tablelist::extendLeftRight [tablelist::getTablelistPath %W] -1 409 } 410 bind TablelistBody <Shift-Right> { 411 tablelist::extendLeftRight [tablelist::getTablelistPath %W] 1 412 } 413 bind TablelistBody <Shift-Home> { 414 tablelist::extendToHomeEnd [tablelist::getTablelistPath %W] Home 415 } 416 bind TablelistBody <Shift-End> { 417 tablelist::extendToHomeEnd [tablelist::getTablelistPath %W] End 418 } 419 bind TablelistBody <Shift-Control-Home> { 420 tablelist::extendToFirstLast [tablelist::getTablelistPath %W] first 421 } 422 bind TablelistBody <Shift-Control-End> { 423 tablelist::extendToFirstLast [tablelist::getTablelistPath %W] last 424 } 425 bind TablelistBody <space> { 426 set tablelist::W [tablelist::getTablelistPath %W] 427 428 tablelist::beginSelect $tablelist::W \ 429 [$tablelist::W index active] [$tablelist::W columnindex active] 430 } 431 bind TablelistBody <Select> { 432 set tablelist::W [tablelist::getTablelistPath %W] 433 434 tablelist::beginSelect $tablelist::W \ 435 [$tablelist::W index active] [$tablelist::W columnindex active] 436 } 437 bind TablelistBody <Control-Shift-space> { 438 set tablelist::W [tablelist::getTablelistPath %W] 439 440 tablelist::beginExtend $tablelist::W \ 441 [$tablelist::W index active] [$tablelist::W columnindex active] 442 } 443 bind TablelistBody <Shift-Select> { 444 set tablelist::W [tablelist::getTablelistPath %W] 445 446 tablelist::beginExtend $tablelist::W \ 447 [$tablelist::W index active] [$tablelist::W columnindex active] 448 } 449 bind TablelistBody <Escape> { 450 tablelist::cancelSelection [tablelist::getTablelistPath %W] 451 } 452 bind TablelistBody <Control-slash> { 453 tablelist::selectAll [tablelist::getTablelistPath %W] 454 } 455 bind TablelistBody <Control-backslash> { 456 set tablelist::W [tablelist::getTablelistPath %W] 457 458 if {[string compare [$tablelist::W cget -selectmode] "browse"] != 0} { 459 $tablelist::W selection clear 0 end 460 event generate $tablelist::W <<TablelistSelect>> 461 } 462 } 463 foreach pattern {Tab Shift-Tab ISO_Left_Tab hpBackTab} { 464 catch { 465 foreach modifier {Control Meta} { 466 bind TablelistBody <$modifier-$pattern> [format { 467 mwutil::processTraversal %%W Tablelist <%s> 468 } $pattern] 469 } 470 } 471 } 472 473 variable winSys 474 if {[string compare $winSys "classic"] == 0 || 475 [string compare $winSys "aqua"] == 0} { 476 bind TablelistBody <MouseWheel> { 477 [tablelist::getTablelistPath %W] yview scroll [expr {-%D}] units 478 break 479 } 480 bind TablelistBody <Shift-MouseWheel> { 481 [tablelist::getTablelistPath %W] xview scroll [expr {-%D}] units 482 break 483 } 484 bind TablelistBody <Option-MouseWheel> { 485 [tablelist::getTablelistPath %W] yview scroll \ 486 [expr {-10 * %D}] units 487 break 488 } 489 bind TablelistBody <Shift-Option-MouseWheel> { 490 [tablelist::getTablelistPath %W] xview scroll \ 491 [expr {-10 * %D}] units 492 break 493 } 494 } else { 495 bind TablelistBody <MouseWheel> { 496 [tablelist::getTablelistPath %W] yview scroll \ 497 [expr {-(%D / 120) * 4}] units 498 break 499 } 500 bind TablelistBody <Shift-MouseWheel> { 501 [tablelist::getTablelistPath %W] xview scroll \ 502 [expr {-(%D / 120) * 4}] units 503 break 504 } 505 } 506 507 if {[string compare $winSys "x11"] == 0} { 508 bind TablelistBody <Button-4> { 509 if {!$tk_strictMotif} { 510 [tablelist::getTablelistPath %W] yview scroll -5 units 511 break 512 } 513 } 514 bind TablelistBody <Button-5> { 515 if {!$tk_strictMotif} { 516 [tablelist::getTablelistPath %W] yview scroll 5 units 517 break 518 } 519 } 520 bind TablelistBody <Shift-Button-4> { 521 if {!$tk_strictMotif} { 522 [tablelist::getTablelistPath %W] xview scroll -5 units 523 break 524 } 525 } 526 bind TablelistBody <Shift-Button-5> { 527 if {!$tk_strictMotif} { 528 [tablelist::getTablelistPath %W] xview scroll 5 units 529 break 530 } 531 } 532 } 533 534 foreach event {<<Copy>> <Control-Left> <Control-Right> 535 <Control-Prior> <Control-Next> <Button-2> <B2-Motion>} { 536 set script [strMap { 537 "%W" "$tablelist::W" "%x" "$tablelist::x" "%y" "$tablelist::y" 538 } [bind Listbox $event]] 539 540 if {[string compare $script ""] != 0} { 541 bind TablelistBody $event [format { 542 foreach {tablelist::W tablelist::x tablelist::y} \ 543 [tablelist::convEventFields %%W %%x %%y] {} 544 %s 545 } $script] 546 } 547 } 548} 549 550#------------------------------------------------------------------------------ 551# tablelist::showOrHideTooltip 552# 553# This procedure is invoked when the mouse pointer enters or leaves the body of 554# a tablelist widget win or one of its separators, or is moving within it. If 555# the pointer has crossed a cell boundary then the procedure removes the old 556# tooltip and displays the one corresponding to the new cell. 557#------------------------------------------------------------------------------ 558proc tablelist::showOrHideTooltip {win x y X Y} { 559 upvar ::tablelist::ns${win}::data data 560 if {[string compare $data(-tooltipaddcommand) ""] == 0 || 561 [string compare $data(-tooltipdelcommand) ""] == 0} { 562 return "" 563 } 564 565 # 566 # Get the containing cell from the coordinates relative to the parent 567 # 568 set row [containingRow $win $y] 569 set col [containingCol $win $x] 570 if {[string compare $row,$col $data(prevCell)] == 0} { 571 return "" 572 } 573 574 # 575 # Remove the old tooltip, if any. Then, if we are within a 576 # cell, display the new tooltip corresponding to that cell. 577 # 578 event generate $win <Leave> 579 catch {uplevel #0 $data(-tooltipdelcommand) [list $win]} 580 set data(prevCell) $row,$col 581 if {$row >= 0 && $col >= 0} { 582 set focus [focus -displayof $win] 583 if {[string compare $focus ""] == 0 || 584 [string first $win $focus] != 0 || 585 [string compare [winfo toplevel $focus] \ 586 [winfo toplevel $win]] == 0} { 587 uplevel #0 $data(-tooltipaddcommand) [list $win $row $col] 588 event generate $win <Enter> -rootx $X -rooty $Y 589 } 590 } 591} 592 593#------------------------------------------------------------------------------ 594# tablelist::condEditContainingCell 595# 596# This procedure is invoked when mouse button 1 is pressed in the body of a 597# tablelist widget win or in one of its separators. If the mouse click 598# occurred inside an editable cell and the latter is not already being edited, 599# then the procedure starts the interactive editing in that cell. Otherwise it 600# finishes a possibly active cell editing. 601#------------------------------------------------------------------------------ 602proc tablelist::condEditContainingCell {win x y} { 603 # 604 # Get the containing cell from the coordinates relative to the parent 605 # 606 set row [containingRow $win $y] 607 set col [containingCol $win $x] 608 609 upvar ::tablelist::ns${win}::data data 610 if {$row >= 0 && $col >= 0 && [isCellEditable $win $row $col]} { 611 # 612 # Get the coordinates relative to the 613 # tablelist body and invoke doEditCell 614 # 615 set w $data(body) 616 incr x -[winfo x $w] 617 incr y -[winfo y $w] 618 scan [$w index @$x,$y] "%d.%d" line charPos 619 doEditCell $win $row $col 0 "" $charPos 620 } else { 621 # 622 # Finish a possibly active cell editing 623 # 624 if {$data(editRow) >= 0} { 625 doFinishEditing $win 626 } 627 } 628} 629 630#------------------------------------------------------------------------------ 631# tablelist::condBeginMove 632# 633# This procedure is typically invoked on button-1 presses in the body of a 634# tablelist widget or in one of its separators. It begins the process of 635# moving the nearest row if the rows are movable and the selection mode is not 636# browse or extended. 637#------------------------------------------------------------------------------ 638proc tablelist::condBeginMove {win row} { 639 upvar ::tablelist::ns${win}::data data 640 if {$data(isDisabled) || !$data(-movablerows) || $data(itemCount) == 0 || 641 [string compare $data(-selectmode) "browse"] == 0 || 642 [string compare $data(-selectmode) "extended"] == 0} { 643 return "" 644 } 645 646 set data(sourceRow) $row 647 set data(targetRow) $row 648 649 set topWin [winfo toplevel $win] 650 set data(topEscBinding) [bind $topWin <Escape>] 651 bind $topWin <Escape> \ 652 [list tablelist::cancelMove [strMap {"%" "%%"} $win]] 653} 654 655#------------------------------------------------------------------------------ 656# tablelist::beginSelect 657# 658# This procedure is typically invoked on button-1 presses in the body of a 659# tablelist widget or in one of its separators. It begins the process of 660# making a selection in the widget. Its exact behavior depends on the 661# selection mode currently in effect for the widget. 662#------------------------------------------------------------------------------ 663proc tablelist::beginSelect {win row col} { 664 upvar ::tablelist::ns${win}::data data 665 switch $data(-selecttype) { 666 row { 667 if {[string compare $data(-selectmode) "multiple"] == 0} { 668 if {[::$win selection includes $row]} { 669 ::$win selection clear $row 670 } else { 671 ::$win selection set $row 672 } 673 } else { 674 ::$win selection clear 0 end 675 ::$win selection set $row 676 ::$win selection anchor $row 677 variable priv 678 set priv(selection) {} 679 set priv(prevRow) $row 680 } 681 } 682 683 cell { 684 if {[string compare $data(-selectmode) "multiple"] == 0} { 685 if {[::$win cellselection includes $row,$col]} { 686 ::$win cellselection clear $row,$col 687 } else { 688 ::$win cellselection set $row,$col 689 } 690 } else { 691 ::$win cellselection clear 0,0 end 692 ::$win cellselection set $row,$col 693 ::$win cellselection anchor $row,$col 694 variable priv 695 set priv(selection) {} 696 set priv(prevRow) $row 697 set priv(prevCol) $col 698 } 699 } 700 } 701 702 event generate $win <<TablelistSelect>> 703} 704 705#------------------------------------------------------------------------------ 706# tablelist::condAutoScan 707# 708# This procedure is invoked when the mouse leaves or enters the scrollable part 709# of a tablelist widget's body text child. It either invokes the autoScan 710# procedure or cancels its invocation as an "after" command. 711#------------------------------------------------------------------------------ 712proc tablelist::condAutoScan win { 713 variable priv 714 set w [::$win bodypath] 715 set wX [winfo x $w] 716 set wY [winfo y $w] 717 set wWidth [winfo width $w] 718 set wHeight [winfo height $w] 719 set x [expr {$priv(x) - $wX}] 720 set y [expr {$priv(y) - $wY}] 721 set prevX [expr {$priv(prevX) - $wX}] 722 set prevY [expr {$priv(prevY) - $wY}] 723 set minX [minScrollableX $win] 724 725 if {($y >= $wHeight && $prevY < $wHeight) || 726 ($y < 0 && $prevY >= 0) || 727 ($x >= $wWidth && $prevX < $wWidth) || 728 ($x < $minX && $prevX >= $minX)} { 729 if {[string compare $priv(afterId) ""] == 0} { 730 autoScan $win 731 } 732 } elseif {($y < $wHeight && $prevY >= $wHeight) || 733 ($y >= 0 && $prevY < 0) || 734 ($x < $wWidth && $prevX >= $wWidth) || 735 ($x >= $minX && $prevX < $minX)} { 736 after cancel $priv(afterId) 737 set priv(afterId) "" 738 } 739} 740 741#------------------------------------------------------------------------------ 742# tablelist::autoScan 743# 744# This procedure is invoked when the mouse leaves the scrollable part of a 745# tablelist widget's body text child. It scrolls the child up, down, left, or 746# right, depending on where the mouse left the scrollable part of the 747# tablelist's body, and reschedules itself as an "after" command so that the 748# child continues to scroll until the mouse moves back into the window or the 749# mouse button is released. 750#------------------------------------------------------------------------------ 751proc tablelist::autoScan win { 752 if {![winfo exists $win] || [string compare [::$win editwinpath] ""] != 0} { 753 return "" 754 } 755 756 upvar ::tablelist::ns${win}::data data 757 variable priv 758 set w [::$win bodypath] 759 set x [expr {$priv(x) - [winfo x $w]}] 760 set y [expr {$priv(y) - [winfo y $w]}] 761 set minX [minScrollableX $win] 762 763 if {$y >= [winfo height $w]} { 764 ::$win yview scroll 1 units 765 set ms 50 766 } elseif {$y < 0} { 767 ::$win yview scroll -1 units 768 set ms 50 769 } elseif {$x >= [winfo width $w]} { 770 if {$data(-titlecolumns) == 0} { 771 ::$win xview scroll 2 units 772 set ms 50 773 } else { 774 ::$win xview scroll 1 units 775 set ms 250 776 } 777 } elseif {$x < $minX} { 778 if {$data(-titlecolumns) == 0} { 779 ::$win xview scroll -2 units 780 set ms 50 781 } else { 782 ::$win xview scroll -1 units 783 set ms 250 784 } 785 } else { 786 return "" 787 } 788 789 motion $win [::$win nearest $priv(y)] [::$win nearestcolumn $priv(x)] 790 set priv(afterId) [after $ms [list tablelist::autoScan $win]] 791} 792 793#------------------------------------------------------------------------------ 794# tablelist::minScrollableX 795# 796# Returns the least x coordinate within the scrollable part of the body of the 797# tablelist widget win. 798#------------------------------------------------------------------------------ 799proc tablelist::minScrollableX win { 800 upvar ::tablelist::ns${win}::data data 801 if {$data(-titlecolumns) == 0} { 802 return 0 803 } else { 804 set sep [::$win separatorpath] 805 if {[winfo viewable $sep]} { 806 return [expr {[winfo x $sep] - [winfo x [::$win bodypath]] + 1}] 807 } else { 808 return 0 809 } 810 } 811} 812 813#------------------------------------------------------------------------------ 814# tablelist::motion 815# 816# This procedure is called to process mouse motion events in the body of a 817# tablelist widget or in one of its separators. while button 1 is down. It may 818# move or extend the selection, depending on the widget's selection mode. 819#------------------------------------------------------------------------------ 820proc tablelist::motion {win row col} { 821 upvar ::tablelist::ns${win}::data data 822 variable priv 823 switch $data(-selecttype) { 824 row { 825 if {$row == $priv(prevRow)} { 826 return "" 827 } 828 829 switch -- $data(-selectmode) { 830 browse { 831 ::$win selection clear 0 end 832 ::$win selection set $row 833 set priv(prevRow) $row 834 event generate $win <<TablelistSelect>> 835 } 836 extended { 837 if {[string compare $priv(prevRow) ""] != 0} { 838 ::$win selection clear anchor $priv(prevRow) 839 } 840 ::$win selection set anchor $row 841 set priv(prevRow) $row 842 event generate $win <<TablelistSelect>> 843 } 844 } 845 } 846 847 cell { 848 if {$row == $priv(prevRow) && $col == $priv(prevCol)} { 849 return "" 850 } 851 852 switch -- $data(-selectmode) { 853 browse { 854 ::$win cellselection clear 0,0 end 855 ::$win cellselection set $row,$col 856 set priv(prevRow) $row 857 set priv(prevCol) $col 858 event generate $win <<TablelistSelect>> 859 } 860 extended { 861 if {[string compare $priv(prevRow) ""] != 0 && 862 [string compare $priv(prevCol) ""] != 0} { 863 ::$win cellselection clear anchor \ 864 $priv(prevRow),$priv(prevCol) 865 } 866 ::$win cellselection set anchor $row,$col 867 set priv(prevRow) $row 868 set priv(prevCol) $col 869 event generate $win <<TablelistSelect>> 870 } 871 } 872 } 873 } 874} 875 876#------------------------------------------------------------------------------ 877# tablelist::condShowTarget 878# 879# This procedure is called to process mouse motion events in the body of a 880# tablelist widget or in one of its separators. while button 1 is down. It 881# visualizes the would-be target position of the clicked row if a move 882# operation is in progress. 883#------------------------------------------------------------------------------ 884proc tablelist::condShowTarget {win y} { 885 upvar ::tablelist::ns${win}::data data 886 if {![info exists data(sourceRow)]} { 887 return "" 888 } 889 890 set w $data(body) 891 incr y -[winfo y $w] 892 set textIdx [$w index @0,$y] 893 set row [expr {int($textIdx) - 1}] 894 set dlineinfo [$w dlineinfo $textIdx] 895 set lineY [lindex $dlineinfo 1] 896 set lineHeight [lindex $dlineinfo 3] 897 if {$y < $lineY + $lineHeight/2} { 898 set data(targetRow) $row 899 set gapY $lineY 900 } else { 901 set data(targetRow) [expr {$row + 1}] 902 set gapY [expr {$lineY + $lineHeight}] 903 } 904 905 if {$row == $data(sourceRow)} { 906 $w configure -cursor $data(-cursor) 907 place forget $data(rowGap) 908 } else { 909 $w configure -cursor $data(-movecursor) 910 place $data(rowGap) -anchor w -relwidth 1.0 -y $gapY 911 raise $data(rowGap) 912 } 913} 914 915#------------------------------------------------------------------------------ 916# tablelist::moveOrActivate 917# 918# This procedure is invoked whenever mouse button 1 is released in the body of 919# a tablelist widget or in one of its separators. It either moves the 920# previously clicked row before or after the one containing the mouse cursor, 921# or activates the given nearest item or element (depending on the widget's 922# selection type). 923#------------------------------------------------------------------------------ 924proc tablelist::moveOrActivate {win row col} { 925 # 926 # Return if both <Button-1> and <ButtonRelease-1> occurred in the 927 # temporary embedded widget used for interactive cell editing 928 # 929 variable priv 930 if {$priv(clickedInEditWin) && $priv(releasedInEditWin)} { 931 return "" 932 } 933 934 upvar ::tablelist::ns${win}::data data 935 if {[info exists data(sourceRow)]} { 936 set sourceRow $data(sourceRow) 937 unset data(sourceRow) 938 bind [winfo toplevel $win] <Escape> $data(topEscBinding) 939 $data(body) configure -cursor $data(-cursor) 940 place forget $data(rowGap) 941 942 if {$data(targetRow) != $sourceRow && 943 $data(targetRow) != $sourceRow + 1} { 944 ::$win move $sourceRow $data(targetRow) 945 event generate $win <<TablelistRowMoved>> 946 } 947 } else { 948 switch $data(-selecttype) { 949 row { ::$win activate $row } 950 cell { ::$win activatecell $row,$col } 951 } 952 } 953} 954 955#------------------------------------------------------------------------------ 956# tablelist::condEvalInvokeCmd 957# 958# This procedure is invoked when mouse button 1 is released in the body of a 959# tablelist widget win or in one of its separators. If interactive cell 960# editing is in progress in a column whose associated edit window has an invoke 961# command that hasn't yet been called in the current edit session, then the 962# procedure evaluates that command. 963#------------------------------------------------------------------------------ 964proc tablelist::condEvalInvokeCmd win { 965 upvar ::tablelist::ns${win}::data data 966 if {$data(editCol) < 0} { 967 return "" 968 } 969 970 variable editWin 971 set name [getEditWindow $win $data(editRow) $data(editCol)] 972 if {[string compare $editWin($name-invokeCmd) ""] == 0 || $data(invoked)} { 973 return "" 974 } 975 976 # 977 # Return if both <Button-1> and <ButtonRelease-1> occurred in the 978 # temporary embedded widget used for interactive cell editing 979 # 980 variable priv 981 if {$priv(clickedInEditWin) && $priv(releasedInEditWin)} { 982 return "" 983 } 984 985 # 986 # Return if the edit window is an editable combobox widgets 987 # 988 set w $data(bodyFrEd) 989 switch [winfo class $w] { 990 TCombobox { 991 if {[string compare [$w cget -state] "normal"] == 0} { 992 return "" 993 } 994 } 995 ComboBox - 996 Combobox { 997 if {[$w cget -editable]} { 998 return "" 999 } 1000 } 1001 } 1002 1003 # 1004 # Evaluate the edit window's invoke command 1005 # 1006 update 1007 eval [strMap {"%W" "$w"} $editWin($name-invokeCmd)] 1008 set data(invoked) 1 1009} 1010 1011#------------------------------------------------------------------------------ 1012# tablelist::cancelMove 1013# 1014# This procedure is invoked to process <Escape> events in the top-level window 1015# containing the tablelist widget win during a row move operation. It cancels 1016# the action in progress. 1017#------------------------------------------------------------------------------ 1018proc tablelist::cancelMove win { 1019 upvar ::tablelist::ns${win}::data data 1020 if {![info exists data(sourceRow)]} { 1021 return "" 1022 } 1023 1024 unset data(sourceRow) 1025 bind [winfo toplevel $win] <Escape> $data(topEscBinding) 1026 $data(body) configure -cursor $data(-cursor) 1027 place forget $data(rowGap) 1028} 1029 1030#------------------------------------------------------------------------------ 1031# tablelist::beginExtend 1032# 1033# This procedure is typically invoked on shift-button-1 presses in the body of 1034# a tablelist widget or in one of its separators. It begins the process of 1035# extending a selection in the widget. Its exact behavior depends on the 1036# selection mode currently in effect for the widget. 1037#------------------------------------------------------------------------------ 1038proc tablelist::beginExtend {win row col} { 1039 if {[string compare [::$win cget -selectmode] "extended"] != 0} { 1040 return "" 1041 } 1042 1043 if {[::$win selection includes anchor]} { 1044 motion $win $row $col 1045 } else { 1046 beginSelect $win $row $col 1047 } 1048} 1049 1050#------------------------------------------------------------------------------ 1051# tablelist::beginToggle 1052# 1053# This procedure is typically invoked on control-button-1 presses in the body 1054# of a tablelist widget or in one of its separators. It begins the process of 1055# toggling a selection in the widget. Its exact behavior depends on the 1056# selection mode currently in effect for the widget. 1057#------------------------------------------------------------------------------ 1058proc tablelist::beginToggle {win row col} { 1059 upvar ::tablelist::ns${win}::data data 1060 if {[string compare $data(-selectmode) "extended"] != 0} { 1061 return "" 1062 } 1063 1064 variable priv 1065 switch $data(-selecttype) { 1066 row { 1067 set priv(selection) [::$win curselection] 1068 set priv(prevRow) $row 1069 ::$win selection anchor $row 1070 if {[::$win selection includes $row]} { 1071 ::$win selection clear $row 1072 } else { 1073 ::$win selection set $row 1074 } 1075 } 1076 1077 cell { 1078 set priv(selection) [::$win curcellselection] 1079 set priv(prevRow) $row 1080 set priv(prevCol) $col 1081 ::$win cellselection anchor $row,$col 1082 if {[::$win cellselection includes $row,$col]} { 1083 ::$win cellselection clear $row,$col 1084 } else { 1085 ::$win cellselection set $row,$col 1086 } 1087 } 1088 } 1089 1090 event generate $win <<TablelistSelect>> 1091} 1092 1093#------------------------------------------------------------------------------ 1094# tablelist::condEditActiveCell 1095# 1096# This procedure is invoked whenever Return or KP_Enter is pressed in the body 1097# of a tablelist widget. If the selection type is cell and the active cell is 1098# editable then the procedure starts the interactive editing in that cell. 1099#------------------------------------------------------------------------------ 1100proc tablelist::condEditActiveCell win { 1101 upvar ::tablelist::ns${win}::data data 1102 if {[string compare $data(-selecttype) "cell"] != 0 || 1103 [firstVisibleRow $win] < 0 || [firstVisibleCol $win] < 0} { 1104 return "" 1105 } 1106 1107 set row $data(activeRow) 1108 set col $data(activeCol) 1109 if {[isCellEditable $win $row $col]} { 1110 doEditCell $win $row $col 0 1111 } 1112} 1113 1114#------------------------------------------------------------------------------ 1115# tablelist::nextPrevCell 1116# 1117# Does nothing unless the selection type is cell; in this case it moves the 1118# location cursor (active element) to the next or previous element, and changes 1119# the selection if we are in browse or extended selection mode. 1120#------------------------------------------------------------------------------ 1121proc tablelist::nextPrevCell {win amount} { 1122 upvar ::tablelist::ns${win}::data data 1123 switch $data(-selecttype) { 1124 row { 1125 # Nothing 1126 } 1127 1128 cell { 1129 if {$data(editRow) >= 0} { 1130 return -code break "" 1131 } 1132 1133 set row $data(activeRow) 1134 set col $data(activeCol) 1135 set oldRow $row 1136 set oldCol $col 1137 1138 while 1 { 1139 incr col $amount 1140 if {$col < 0} { 1141 incr row $amount 1142 if {$row < 0} { 1143 set row $data(lastRow) 1144 } 1145 set col $data(lastCol) 1146 } elseif {$col > $data(lastCol)} { 1147 incr row $amount 1148 if {$row > $data(lastRow)} { 1149 set row 0 1150 } 1151 set col 0 1152 } 1153 1154 if {$row == $oldRow && $col == $oldCol} { 1155 return -code break "" 1156 } elseif {![doRowCget $row $win -hide] && !$data($col-hide)} { 1157 condChangeSelection $win $row $col 1158 return -code break "" 1159 } 1160 } 1161 } 1162 } 1163} 1164 1165#------------------------------------------------------------------------------ 1166# tablelist::upDown 1167# 1168# Moves the location cursor (active item or element) up or down by one line, 1169# and changes the selection if we are in browse or extended selection mode. 1170#------------------------------------------------------------------------------ 1171proc tablelist::upDown {win amount} { 1172 upvar ::tablelist::ns${win}::data data 1173 if {$data(editRow) >= 0} { 1174 return "" 1175 } 1176 1177 switch $data(-selecttype) { 1178 row { 1179 set row $data(activeRow) 1180 set col -1 1181 } 1182 1183 cell { 1184 set row $data(activeRow) 1185 set col $data(activeCol) 1186 } 1187 } 1188 1189 while 1 { 1190 incr row $amount 1191 if {$row < 0 || $row > $data(lastRow)} { 1192 return "" 1193 } elseif {![doRowCget $row $win -hide]} { 1194 condChangeSelection $win $row $col 1195 return "" 1196 } 1197 } 1198} 1199 1200#------------------------------------------------------------------------------ 1201# tablelist::leftRight 1202# 1203# If the tablelist widget's selection type is "row" then this procedure scrolls 1204# the widget's view left or right by the width of the character "0". Otherwise 1205# it moves the location cursor (active element) left or right by one column, 1206# and changes the selection if we are in browse or extended selection mode. 1207#------------------------------------------------------------------------------ 1208proc tablelist::leftRight {win amount} { 1209 upvar ::tablelist::ns${win}::data data 1210 switch $data(-selecttype) { 1211 row { 1212 ::$win xview scroll $amount units 1213 } 1214 1215 cell { 1216 if {$data(editRow) >= 0} { 1217 return "" 1218 } 1219 1220 set row $data(activeRow) 1221 set col $data(activeCol) 1222 while 1 { 1223 incr col $amount 1224 if {$col < 0 || $col > $data(lastCol)} { 1225 return "" 1226 } elseif {!$data($col-hide)} { 1227 condChangeSelection $win $row $col 1228 return "" 1229 } 1230 } 1231 } 1232 } 1233} 1234 1235#------------------------------------------------------------------------------ 1236# tablelist::priorNext 1237# 1238# Scrolls the tablelist view up or down by one page. 1239#------------------------------------------------------------------------------ 1240proc tablelist::priorNext {win amount} { 1241 upvar ::tablelist::ns${win}::data data 1242 if {$data(editRow) >= 0} { 1243 return "" 1244 } 1245 1246 ::$win yview scroll $amount pages 1247 ::$win activate @0,0 1248} 1249 1250#------------------------------------------------------------------------------ 1251# tablelist::homeEnd 1252# 1253# If selecttype is row then the procedure scrolls the tablelist widget 1254# horizontally to its left or right edge. Otherwise it sets the location 1255# cursor (active element) to the first/last element of the active row, selects 1256# that element, and deselects everything else in the widget. 1257#------------------------------------------------------------------------------ 1258proc tablelist::homeEnd {win key} { 1259 upvar ::tablelist::ns${win}::data data 1260 switch $data(-selecttype) { 1261 row { 1262 switch $key { 1263 Home { ::$win xview moveto 0 } 1264 End { ::$win xview moveto 1 } 1265 } 1266 } 1267 1268 cell { 1269 set row $data(activeRow) 1270 switch $key { 1271 Home { set col [firstVisibleCol $win] } 1272 End { set col [ lastVisibleCol $win] } 1273 } 1274 changeSelection $win $row $col 1275 } 1276 } 1277} 1278 1279#------------------------------------------------------------------------------ 1280# tablelist::firstLast 1281# 1282# Sets the location cursor (active item or element) to the first/last item or 1283# element in the tablelist widget, selects that item or element, and deselects 1284# everything else in the widget. 1285#------------------------------------------------------------------------------ 1286proc tablelist::firstLast {win target} { 1287 switch $target { 1288 first { 1289 set row [firstVisibleRow $win] 1290 set col [firstVisibleCol $win] 1291 } 1292 1293 last { 1294 set row [lastVisibleRow $win] 1295 set col [lastVisibleCol $win] 1296 } 1297 } 1298 1299 changeSelection $win $row $col 1300} 1301 1302#------------------------------------------------------------------------------ 1303# tablelist::extendUpDown 1304# 1305# Does nothing unless we are in extended selection mode; in this case it moves 1306# the location cursor (active item or element) up or down by one line, and 1307# extends the selection to that point. 1308#------------------------------------------------------------------------------ 1309proc tablelist::extendUpDown {win amount} { 1310 upvar ::tablelist::ns${win}::data data 1311 if {[string compare $data(-selectmode) "extended"] != 0} { 1312 return "" 1313 } 1314 1315 switch $data(-selecttype) { 1316 row { 1317 set row $data(activeRow) 1318 while 1 { 1319 incr row $amount 1320 if {$row < 0 || $row > $data(lastRow)} { 1321 return "" 1322 } elseif {![doRowCget $row $win -hide]} { 1323 ::$win activate $row 1324 ::$win see active 1325 motion $win $data(activeRow) -1 1326 return "" 1327 } 1328 } 1329 } 1330 1331 cell { 1332 set row $data(activeRow) 1333 set col $data(activeCol) 1334 while 1 { 1335 incr row $amount 1336 if {$row < 0 || $row > $data(lastRow)} { 1337 return "" 1338 } elseif {![doRowCget $row $win -hide]} { 1339 ::$win activatecell $row,$col 1340 ::$win seecell active 1341 motion $win $data(activeRow) $data(activeCol) 1342 return "" 1343 } 1344 } 1345 } 1346 } 1347} 1348 1349#------------------------------------------------------------------------------ 1350# tablelist::extendLeftRight 1351# 1352# Does nothing unless we are in extended selection mode and the selection type 1353# is cell; in this case it moves the location cursor (active element) left or 1354# right by one column, and extends the selection to that point. 1355#------------------------------------------------------------------------------ 1356proc tablelist::extendLeftRight {win amount} { 1357 upvar ::tablelist::ns${win}::data data 1358 if {[string compare $data(-selectmode) "extended"] != 0} { 1359 return "" 1360 } 1361 1362 switch $data(-selecttype) { 1363 row { 1364 # Nothing 1365 } 1366 1367 cell { 1368 set row $data(activeRow) 1369 set col $data(activeCol) 1370 while 1 { 1371 incr col $amount 1372 if {$col < 0 || $col > $data(lastCol)} { 1373 return "" 1374 } elseif {!$data($col-hide)} { 1375 ::$win activatecell $row,$col 1376 ::$win seecell active 1377 motion $win $data(activeRow) $data(activeCol) 1378 return "" 1379 } 1380 } 1381 } 1382 } 1383} 1384 1385#------------------------------------------------------------------------------ 1386# tablelist::extendToHomeEnd 1387# 1388# Does nothing unless the selection mode is multiple or extended and the 1389# selection type is cell; in this case it moves the location cursor (active 1390# element) to the first/last element of the active row, and, if we are in 1391# extended mode, it extends the selection to that point. 1392#------------------------------------------------------------------------------ 1393proc tablelist::extendToHomeEnd {win key} { 1394 upvar ::tablelist::ns${win}::data data 1395 switch $data(-selecttype) { 1396 row { 1397 # Nothing 1398 } 1399 1400 cell { 1401 set row $data(activeRow) 1402 switch $key { 1403 Home { set col [firstVisibleCol $win] } 1404 End { set col [ lastVisibleCol $win] } 1405 } 1406 1407 switch -- $data(-selectmode) { 1408 multiple { 1409 ::$win activatecell $row,$col 1410 ::$win seecell $row,$col 1411 } 1412 extended { 1413 ::$win activatecell $row,$col 1414 ::$win seecell $row,$col 1415 if {[::$win selection includes anchor]} { 1416 motion $win $row $col 1417 } 1418 } 1419 } 1420 } 1421 } 1422} 1423 1424#------------------------------------------------------------------------------ 1425# tablelist::extendToFirstLast 1426# 1427# Does nothing unless the selection mode is multiple or extended; in this case 1428# it moves the location cursor (active item or element) to the first/last item 1429# or element in the tablelist widget, and, if we are in extended mode, it 1430# extends the selection to that point. 1431#------------------------------------------------------------------------------ 1432proc tablelist::extendToFirstLast {win target} { 1433 switch $target { 1434 first { 1435 set row [firstVisibleRow $win] 1436 set col [firstVisibleCol $win] 1437 } 1438 1439 last { 1440 set row [lastVisibleRow $win] 1441 set col [lastVisibleCol $win] 1442 } 1443 } 1444 1445 upvar ::tablelist::ns${win}::data data 1446 switch $data(-selecttype) { 1447 row { 1448 switch -- $data(-selectmode) { 1449 multiple { 1450 ::$win activate $row 1451 ::$win see $row 1452 } 1453 extended { 1454 ::$win activate $row 1455 ::$win see $row 1456 if {[::$win selection includes anchor]} { 1457 motion $win $row -1 1458 } 1459 } 1460 } 1461 } 1462 1463 cell { 1464 switch -- $data(-selectmode) { 1465 multiple { 1466 ::$win activatecell $row,$col 1467 ::$win seecell $row,$col 1468 } 1469 extended { 1470 ::$win activatecell $row,$col 1471 ::$win seecell $row,$col 1472 if {[::$win selection includes anchor]} { 1473 motion $win $row $col 1474 } 1475 } 1476 } 1477 } 1478 } 1479} 1480 1481#------------------------------------------------------------------------------ 1482# tablelist::cancelSelection 1483# 1484# This procedure is invoked to cancel an extended selection in progress. If 1485# there is an extended selection in progress, it restores all of the items or 1486# elements between the active one and the anchor to their previous selection 1487# state. 1488#------------------------------------------------------------------------------ 1489proc tablelist::cancelSelection win { 1490 upvar ::tablelist::ns${win}::data data 1491 if {[string compare $data(-selectmode) "extended"] != 0} { 1492 return "" 1493 } 1494 1495 variable priv 1496 switch $data(-selecttype) { 1497 row { 1498 set first $data(anchorRow) 1499 set last $priv(prevRow) 1500 if {[string compare $last ""] == 0} { 1501 return "" 1502 } 1503 1504 if {$last < $first} { 1505 set tmp $first 1506 set first $last 1507 set last $tmp 1508 } 1509 1510 ::$win selection clear $first $last 1511 for {set row $first} {$row <= $last} {incr row} { 1512 if {[lsearch -exact $priv(selection) $row] >= 0} { 1513 ::$win selection set $row 1514 } 1515 } 1516 event generate $win <<TablelistSelect>> 1517 } 1518 1519 cell { 1520 set firstRow $data(anchorRow) 1521 set firstCol $data(anchorCol) 1522 set lastRow $priv(prevRow) 1523 set lastCol $priv(prevCol) 1524 if {[string compare $lastRow ""] == 0 || 1525 [string compare $lastCol ""] == 0} { 1526 return "" 1527 } 1528 1529 if {$lastRow < $firstRow} { 1530 set tmp $firstRow 1531 set firstRow $lastRow 1532 set lastRow $tmp 1533 } 1534 if {$lastCol < $firstCol} { 1535 set tmp $firstCol 1536 set firstCol $lastCol 1537 set lastCol $tmp 1538 } 1539 1540 ::$win cellselection clear $firstRow,$firstCol $lastRow,$lastCol 1541 for {set row $firstRow} {$row <= $lastRow} {incr row} { 1542 for {set col $firstCol} {$col <= $lastCol} {incr col} { 1543 if {[lsearch -exact $priv(selection) $row,$col] >= 0} { 1544 ::$win cellselection set $row,$col 1545 } 1546 } 1547 } 1548 event generate $win <<TablelistSelect>> 1549 } 1550 } 1551} 1552 1553#------------------------------------------------------------------------------ 1554# tablelist::selectAll 1555# 1556# This procedure is invoked to handle the "select all" operation. For single 1557# and browse mode, it just selects the active item or element. Otherwise it 1558# selects everything in the widget. 1559#------------------------------------------------------------------------------ 1560proc tablelist::selectAll win { 1561 upvar ::tablelist::ns${win}::data data 1562 switch $data(-selecttype) { 1563 row { 1564 if {[string compare $data(-selectmode) "single"] == 0 || 1565 [string compare $data(-selectmode) "browse"] == 0} { 1566 ::$win selection clear 0 end 1567 ::$win selection set active 1568 } else { 1569 ::$win selection set 0 end 1570 } 1571 } 1572 1573 cell { 1574 if {[string compare $data(-selectmode) "single"] == 0 || 1575 [string compare $data(-selectmode) "browse"] == 0} { 1576 ::$win cellselection clear 0,0 end 1577 ::$win cellselection set active 1578 } else { 1579 ::$win cellselection set 0,0 end 1580 } 1581 } 1582 } 1583 1584 event generate $win <<TablelistSelect>> 1585} 1586 1587#------------------------------------------------------------------------------ 1588# tablelist::firstVisibleRow 1589# 1590# Returns the index of the first non-hidden row of the tablelist widget win. 1591#------------------------------------------------------------------------------ 1592proc tablelist::firstVisibleRow win { 1593 upvar ::tablelist::ns${win}::data data 1594 for {set row 0} {$row < $data(itemCount)} {incr row} { 1595 if {![doRowCget $row $win -hide]} { 1596 return $row 1597 } 1598 } 1599 1600 return -1 1601} 1602 1603#------------------------------------------------------------------------------ 1604# tablelist::lastVisibleRow 1605# 1606# Returns the index of the last non-hidden row of the tablelist widget win. 1607#------------------------------------------------------------------------------ 1608proc tablelist::lastVisibleRow win { 1609 upvar ::tablelist::ns${win}::data data 1610 for {set row $data(lastRow)} {$row >= 0} {incr row -1} { 1611 if {![doRowCget $row $win -hide]} { 1612 return $row 1613 } 1614 } 1615 1616 return -1 1617} 1618 1619#------------------------------------------------------------------------------ 1620# tablelist::firstVisibleCol 1621# 1622# Returns the index of the first non-hidden column of the tablelist widget win. 1623#------------------------------------------------------------------------------ 1624proc tablelist::firstVisibleCol win { 1625 upvar ::tablelist::ns${win}::data data 1626 for {set col 0} {$col < $data(colCount)} {incr col} { 1627 if {!$data($col-hide)} { 1628 return $col 1629 } 1630 } 1631 1632 return -1 1633} 1634 1635#------------------------------------------------------------------------------ 1636# tablelist::lastVisibleCol 1637# 1638# Returns the index of the last non-hidden column of the tablelist widget win. 1639#------------------------------------------------------------------------------ 1640proc tablelist::lastVisibleCol win { 1641 upvar ::tablelist::ns${win}::data data 1642 for {set col $data(lastCol)} {$col >= 0} {incr col -1} { 1643 if {!$data($col-hide)} { 1644 return $col 1645 } 1646 } 1647 1648 return -1 1649} 1650 1651#------------------------------------------------------------------------------ 1652# tablelist::condChangeSelection 1653# 1654# Activates the given item or element, and selects it exclusively if we are in 1655# browse or extended selection mode. 1656#------------------------------------------------------------------------------ 1657proc tablelist::condChangeSelection {win row col} { 1658 upvar ::tablelist::ns${win}::data data 1659 switch $data(-selecttype) { 1660 row { 1661 ::$win activate $row 1662 ::$win see active 1663 1664 switch -- $data(-selectmode) { 1665 browse { 1666 ::$win selection clear 0 end 1667 ::$win selection set active 1668 event generate $win <<TablelistSelect>> 1669 } 1670 extended { 1671 ::$win selection clear 0 end 1672 ::$win selection set active 1673 ::$win selection anchor active 1674 variable priv 1675 set priv(selection) {} 1676 set priv(prevRow) $data(activeRow) 1677 event generate $win <<TablelistSelect>> 1678 } 1679 } 1680 } 1681 1682 cell { 1683 ::$win activatecell $row,$col 1684 ::$win seecell active 1685 1686 switch -- $data(-selectmode) { 1687 browse { 1688 ::$win cellselection clear 0,0 end 1689 ::$win cellselection set active 1690 event generate $win <<TablelistSelect>> 1691 } 1692 extended { 1693 ::$win cellselection clear 0,0 end 1694 ::$win cellselection set active 1695 ::$win cellselection anchor active 1696 variable priv 1697 set priv(selection) {} 1698 set priv(prevRow) $data(activeRow) 1699 set priv(prevCol) $data(activeCol) 1700 event generate $win <<TablelistSelect>> 1701 } 1702 } 1703 } 1704 } 1705} 1706 1707#------------------------------------------------------------------------------ 1708# tablelist::changeSelection 1709# 1710# Activates the given item or element and selects it exclusively. 1711#------------------------------------------------------------------------------ 1712proc tablelist::changeSelection {win row col} { 1713 upvar ::tablelist::ns${win}::data data 1714 switch $data(-selecttype) { 1715 row { 1716 ::$win activate $row 1717 ::$win see active 1718 1719 ::$win selection clear 0 end 1720 ::$win selection set active 1721 } 1722 1723 cell { 1724 ::$win activatecell $row,$col 1725 ::$win seecell active 1726 1727 ::$win cellselection clear 0,0 end 1728 ::$win cellselection set active 1729 } 1730 } 1731 1732 event generate $win <<TablelistSelect>> 1733} 1734 1735# 1736# Binding tags TablelistLabel, TablelistSubLabel, and TablelistArrow 1737# ================================================================== 1738# 1739 1740#------------------------------------------------------------------------------ 1741# tablelist::defineTablelistSubLabel 1742# 1743# Defines the binding tag TablelistSubLabel (for sublabels of tablelist labels) 1744# to have the same events as TablelistLabel and the binding scripts obtained 1745# from those of TablelistLabel by replacing the widget %W with the containing 1746# label as well as the %x and %y fields with the corresponding coordinates 1747# relative to that label. 1748#------------------------------------------------------------------------------ 1749proc tablelist::defineTablelistSubLabel {} { 1750 foreach event [bind TablelistLabel] { 1751 set script [strMap { 1752 "%W" "$tablelist::W" "%x" "$tablelist::x" "%y" "$tablelist::y" 1753 } [bind TablelistLabel $event]] 1754 1755 bind TablelistSubLabel $event [format { 1756 set tablelist::W \ 1757 [string range %%W 0 [expr {[string length %%W] - 4}]] 1758 set tablelist::x \ 1759 [expr {%%x + [winfo x %%W] - [winfo x $tablelist::W]}] 1760 set tablelist::y \ 1761 [expr {%%y + [winfo y %%W] - [winfo y $tablelist::W]}] 1762 %s 1763 } $script] 1764 } 1765} 1766 1767#------------------------------------------------------------------------------ 1768# tablelist::defineTablelistArrow 1769# 1770# Defines the binding tag TablelistArrow (for sort arrows) to have the same 1771# events as TablelistLabel and the binding scripts obtained from those of 1772# TablelistLabel by replacing the widget %W with the containing label as well 1773# as the %x and %y fields with the corresponding coordinates relative to that 1774# label. 1775#------------------------------------------------------------------------------ 1776proc tablelist::defineTablelistArrow {} { 1777 foreach event [bind TablelistLabel] { 1778 set script [strMap { 1779 "%W" "$tablelist::W" "%x" "$tablelist::x" "%y" "$tablelist::y" 1780 } [bind TablelistLabel $event]] 1781 1782 bind TablelistArrow $event [format { 1783 set tablelist::W \ 1784 [winfo parent %%W].l[string range [winfo name %%W] 1 end] 1785 set tablelist::x \ 1786 [expr {%%x + [winfo x %%W] - [winfo x $tablelist::W]}] 1787 set tablelist::y \ 1788 [expr {%%y + [winfo y %%W] - [winfo y $tablelist::W]}] 1789 %s 1790 } $script] 1791 } 1792} 1793 1794#------------------------------------------------------------------------------ 1795# tablelist::labelEnter 1796# 1797# This procedure is invoked when the mouse pointer enters the header label w of 1798# a tablelist widget, or is moving within that label. It updates the cursor, 1799# displays the tooltip, and activates or deactivates the label, depending on 1800# whether the pointer is on its right border or not. 1801#------------------------------------------------------------------------------ 1802proc tablelist::labelEnter {w X Y x} { 1803 parseLabelPath $w win col 1804 upvar ::tablelist::ns${win}::data data 1805 configLabel $w -cursor $data(-cursor) 1806 1807 if {[string compare $data(-tooltipaddcommand) ""] != 0 && 1808 [string compare $data(-tooltipdelcommand) ""] != 0 && 1809 $col != $data(prevCol)} { 1810 # 1811 # Display the tooltip corresponding to this label 1812 # 1813 set data(prevCol) $col 1814 set focus [focus -displayof $win] 1815 if {[string compare $focus ""] == 0 || 1816 [string first $win $focus] != 0 || 1817 [string compare [winfo toplevel $focus] \ 1818 [winfo toplevel $win]] == 0} { 1819 uplevel #0 $data(-tooltipaddcommand) [list $win -1 $col] 1820 event generate $win <Enter> -rootx $X -rooty $Y 1821 } 1822 } 1823 1824 if {$data(isDisabled)} { 1825 return "" 1826 } 1827 1828 if {$x >= [winfo width $w] - 5} { 1829 set inResizeArea 1 1830 set col2 $col 1831 } elseif {$x < 5} { 1832 set X [expr {[winfo rootx $w] - 3}] 1833 set contW [winfo containing -displayof $w $X [winfo rooty $w]] 1834 set inResizeArea [parseLabelPath $contW dummy col2] 1835 } else { 1836 set inResizeArea 0 1837 } 1838 1839 if {$inResizeArea && $data(-resizablecolumns) && $data($col2-resizable)} { 1840 configLabel $w -cursor $data(-resizecursor) 1841 configLabel $w -active 0 1842 } else { 1843 configLabel $w -active 1 1844 } 1845} 1846 1847#------------------------------------------------------------------------------ 1848# tablelist::labelLeave 1849# 1850# This procedure is invoked when the mouse pointer leaves the header label w of 1851# a tablelist widget. It removes the tooltip and deactivates the label. 1852#------------------------------------------------------------------------------ 1853proc tablelist::labelLeave {w X x y} { 1854 parseLabelPath $w win col 1855 upvar ::tablelist::ns${win}::data data 1856 1857 # 1858 # The following code is needed because the event 1859 # can also occur in a widget placed into the label 1860 # 1861 set hdrX [winfo rootx $data(hdr)] 1862 if {$X >= $hdrX && $X < $hdrX + [winfo width $data(hdr)] && 1863 $x >= 1 && $x < [winfo width $w] - 1 && 1864 $y >= 0 && $y < [winfo height $w]} { 1865 return "" 1866 } 1867 1868 if {[string compare $data(-tooltipaddcommand) ""] != 0 && 1869 [string compare $data(-tooltipdelcommand) ""] != 0} { 1870 # 1871 # Remove the tooltip, if any 1872 # 1873 event generate $win <Leave> 1874 catch {uplevel #0 $data(-tooltipdelcommand) [list $win]} 1875 set data(prevCol) -1 1876 } 1877 1878 if {$data(isDisabled)} { 1879 return "" 1880 } 1881 1882 configLabel $w -active 0 1883} 1884 1885#------------------------------------------------------------------------------ 1886# tablelist::labelB1Down 1887# 1888# This procedure is invoked when mouse button 1 is pressed in the header label 1889# w of a tablelist widget. If the pointer is on the right border of the label 1890# then the procedure records its x-coordinate relative to the label, the width 1891# of the column, and some other data needed later. Otherwise it saves the 1892# label's relief so it can be restored later, and changes the relief to sunken. 1893#------------------------------------------------------------------------------ 1894proc tablelist::labelB1Down {w x shiftPressed} { 1895 parseLabelPath $w win col 1896 upvar ::tablelist::ns${win}::data data 1897 if {$data(isDisabled) || 1898 [info exists data(colBeingResized)]} { ;# resize operation in progress 1899 return "" 1900 } 1901 1902 set data(labelClicked) 1 1903 set data(X) [expr {[winfo rootx $w] + $x}] 1904 set data(shiftPressed) $shiftPressed 1905 1906 if {$x >= [winfo width $w] - 5} { 1907 set inResizeArea 1 1908 set col2 $col 1909 } elseif {$x < 5} { 1910 set X [expr {[winfo rootx $w] - 3}] 1911 set contW [winfo containing -displayof $w $X [winfo rooty $w]] 1912 set inResizeArea [parseLabelPath $contW dummy col2] 1913 } else { 1914 set inResizeArea 0 1915 } 1916 1917 if {$inResizeArea && $data(-resizablecolumns) && $data($col2-resizable)} { 1918 set data(colBeingResized) $col2 1919 1920 set w $data(body) 1921 set topTextIdx [$w index @0,0] 1922 set btmTextIdx [$w index @0,[expr {[winfo height $w] - 1}]] 1923 $w tag add visibleLines "$topTextIdx linestart" "$btmTextIdx lineend" 1924 set data(topRow) [expr {int($topTextIdx) - 1}] 1925 set data(btmRow) [expr {int($btmTextIdx) - 1}] 1926 1927 set w $data(hdrTxtFrLbl)$col2 1928 set labelWidth [winfo width $w] 1929 set data(oldStretchedColWidth) [expr {$labelWidth - 2*$data(charWidth)}] 1930 set data(oldColDelta) $data($col2-delta) 1931 set data(configColWidth) [lindex $data(-columns) [expr {3*$col2}]] 1932 1933 if {[lsearch -exact $data(arrowColList) $col2] >= 0} { 1934 set canvasWidth $data(arrowWidth) 1935 if {[llength $data(arrowColList)] > 1} { 1936 incr canvasWidth 6 1937 } 1938 set data(minColWidth) $canvasWidth 1939 } elseif {$data($col2-wrap)} { 1940 set data(minColWidth) $data(charWidth) 1941 } else { 1942 set data(minColWidth) 0 1943 } 1944 incr data(minColWidth) 1945 1946 set data(focus) [focus -displayof $win] 1947 set topWin [winfo toplevel $win] 1948 focus $topWin 1949 set data(topEscBinding) [bind $topWin <Escape>] 1950 bind $topWin <Escape> \ 1951 [list tablelist::escape [strMap {"%" "%%"} $win] $col2] 1952 } else { 1953 set data(inClickedLabel) 1 1954 set data(relief) [$w cget -relief] 1955 1956 if {[info exists data($col-labelcommand)] || 1957 [string compare $data(-labelcommand) ""] != 0} { 1958 set data(changeRelief) 1 1959 configLabel $w -relief sunken -pressed 1 1960 } else { 1961 set data(changeRelief) 0 1962 } 1963 1964 if {$data(-movablecolumns)} { 1965 set data(focus) [focus -displayof $win] 1966 set topWin [winfo toplevel $win] 1967 focus $topWin 1968 set data(topEscBinding) [bind $topWin <Escape>] 1969 bind $topWin <Escape> \ 1970 [list tablelist::escape [strMap {"%" "%%"} $win] $col] 1971 } 1972 } 1973} 1974 1975#------------------------------------------------------------------------------ 1976# tablelist::labelB1Motion 1977# 1978# This procedure is invoked to process mouse motion events in the header label 1979# w of a tablelist widget while button 1 is down. If this event occured during 1980# a column resize operation then the procedure computes the difference between 1981# the pointer's new x-coordinate relative to that label and the one recorded by 1982# the last invocation of labelB1Down, and adjusts the width of the 1983# corresponding column accordingly. Otherwise a horizontal scrolling is 1984# performed if needed, and the would-be target position of the clicked label is 1985# visualized if the columns are movable. 1986#------------------------------------------------------------------------------ 1987proc tablelist::labelB1Motion {w X x y} { 1988 parseLabelPath $w win col 1989 upvar ::tablelist::ns${win}::data data 1990 if {!$data(labelClicked)} { 1991 return "" 1992 } 1993 1994 if {[info exists data(colBeingResized)]} { ;# resize operation in progress 1995 set width [expr {$data(oldStretchedColWidth) + $X - $data(X)}] 1996 if {$width >= $data(minColWidth)} { 1997 set col $data(colBeingResized) 1998 set idx [expr {3*$col}] 1999 set data(-columns) [lreplace $data(-columns) $idx $idx -$width] 2000 set idx [expr {2*$col}] 2001 set data(colList) [lreplace $data(colList) $idx $idx $width] 2002 set data($col-lastStaticWidth) $width 2003 set data($col-delta) 0 2004 redisplayCol $win $col $data(topRow) $data(btmRow) 2005 2006 # 2007 # Handle the case that the bottom row has become 2008 # greater (due to the redisplayCol invocation) 2009 # 2010 set b $data(body) 2011 set btmY [expr {[winfo height $b] - 1}] 2012 set btmTextIdx [$b index @0,$btmY] 2013 set btmRow [expr {int($btmTextIdx) - 1}] 2014 while {$btmRow > $data(btmRow)} { 2015 $b tag add visibleLines [expr {double($data(btmRow) + 2)}] \ 2016 "$btmTextIdx lineend" 2017 incr data(btmRow) 2018 redisplayCol $win $col $data(btmRow) $btmRow 2019 set data(btmRow) $btmRow 2020 2021 set btmTextIdx [$b index @0,$btmY] 2022 set btmRow [expr {int($btmTextIdx) - 1}] 2023 } 2024 2025 # 2026 # Handle the case that the top row has become 2027 # less (due to the redisplayCol invocation) 2028 # 2029 set topTextIdx [$b index @0,0] 2030 set topRow [expr {int($topTextIdx) - 1}] 2031 while {$topRow < $data(topRow)} { 2032 $b tag add visibleLines "$topTextIdx linestart" \ 2033 "[expr {double($data(topRow))}] lineend" 2034 incr data(topRow) -1 2035 redisplayCol $win $col $topRow $data(topRow) 2036 set data(topRow) $topRow 2037 2038 set topTextIdx [$b index @0,0] 2039 set topRow [expr {int($topTextIdx) - 1}] 2040 } 2041 2042 adjustColumns $win {} 0 2043 adjustElidedText $win 2044 updateVScrlbarWhenIdle $win 2045 } 2046 } else { 2047 # 2048 # Scroll the window horizontally if needed 2049 # 2050 set hdrX [winfo rootx $data(hdr)] 2051 if {$data(-titlecolumns) == 0 || ![winfo viewable $data(sep)]} { 2052 set leftX $hdrX 2053 } else { 2054 set leftX [expr {[winfo rootx $data(sep)] + 1}] 2055 } 2056 set rightX [expr {$hdrX + [winfo width $data(hdr)]}] 2057 set scroll 0 2058 if {($X >= $rightX && $data(X) < $rightX) || 2059 ($X < $leftX && $data(X) >= $leftX)} { 2060 set scroll 1 2061 } elseif {($X < $rightX && $data(X) >= $rightX) || 2062 ($X >= $leftX && $data(X) < $leftX)} { 2063 after cancel $data(afterId) 2064 set data(afterId) "" 2065 } 2066 set data(X) $X 2067 if {$scroll} { 2068 horizAutoScan $win 2069 } 2070 2071 if {$x >= 1 && $x < [winfo width $w] - 1 && 2072 $y >= 0 && $y < [winfo height $w]} { 2073 # 2074 # The following code is needed because the event 2075 # can also occur in a widget placed into the label 2076 # 2077 set data(inClickedLabel) 1 2078 configLabel $w -cursor $data(-cursor) 2079 $data(hdrTxtFrCanv)$col configure -cursor $data(-cursor) 2080 if {$data(changeRelief)} { 2081 configLabel $w -relief sunken -pressed 1 2082 } 2083 2084 place forget $data(colGap) 2085 } else { 2086 # 2087 # The following code is needed because the event 2088 # can also occur in a widget placed into the label 2089 # 2090 set data(inClickedLabel) 0 2091 configLabel $w -relief $data(relief) -pressed 0 2092 2093 if {$data(-movablecolumns)} { 2094 # 2095 # Get the target column index 2096 # 2097 set contW [winfo containing -displayof $w $X [winfo rooty $w]] 2098 if {[parseLabelPath $contW dummy targetCol]} { 2099 set master $contW 2100 if {$X < [winfo rootx $contW] + [winfo width $contW]/2} { 2101 set relx 0.0 2102 } else { 2103 incr targetCol 2104 set relx 1.0 2105 } 2106 } elseif {[string compare $contW $data(colGap)] == 0} { 2107 set targetCol $data(targetCol) 2108 set master $data(master) 2109 set relx $data(relx) 2110 } elseif {$X >= $rightX || $X >= [winfo rootx $w]} { 2111 for {set targetCol $data(lastCol)} {$targetCol >= 0} \ 2112 {incr targetCol -1} { 2113 if {!$data($targetCol-hide)} { 2114 break 2115 } 2116 } 2117 incr targetCol 2118 set master $data(hdrTxtFr) 2119 set relx 1.0 2120 } else { 2121 for {set targetCol 0} {$targetCol < $data(colCount)} \ 2122 {incr targetCol} { 2123 if {!$data($targetCol-hide)} { 2124 break 2125 } 2126 } 2127 set master $data(hdrTxtFr) 2128 set relx 0.0 2129 } 2130 2131 # 2132 # Visualize the would-be target position 2133 # of the clicked label if appropriate 2134 # 2135 if {$data(-protecttitlecolumns) && 2136 (($col >= $data(-titlecolumns) && 2137 $targetCol < $data(-titlecolumns)) || 2138 ($col < $data(-titlecolumns) && 2139 $targetCol > $data(-titlecolumns)))} { 2140 set data(targetCol) -1 2141 configLabel $w -cursor $data(-cursor) 2142 $data(hdrTxtFrCanv)$col configure -cursor $data(-cursor) 2143 place forget $data(colGap) 2144 } else { 2145 set data(targetCol) $targetCol 2146 set data(master) $master 2147 set data(relx) $relx 2148 configLabel $w -cursor $data(-movecolumncursor) 2149 $data(hdrTxtFrCanv)$col configure -cursor \ 2150 $data(-movecolumncursor) 2151 place $data(colGap) -in $master -anchor n \ 2152 -bordermode outside \ 2153 -relheight 1.0 -relx $relx 2154 } 2155 } 2156 } 2157 } 2158} 2159 2160#------------------------------------------------------------------------------ 2161# tablelist::labelB1Enter 2162# 2163# This procedure is invoked when the mouse pointer enters the header label w of 2164# a tablelist widget while mouse button 1 is down. If the label was not 2165# previously clicked then nothing happens. Otherwise, if this event occured 2166# during a column resize operation then the procedure updates the mouse cursor 2167# accordingly. Otherwise it changes the label's relief to sunken. 2168#------------------------------------------------------------------------------ 2169proc tablelist::labelB1Enter w { 2170 parseLabelPath $w win col 2171 upvar ::tablelist::ns${win}::data data 2172 if {!$data(labelClicked)} { 2173 return "" 2174 } 2175 2176 configLabel $w -cursor $data(-cursor) 2177 2178 if {[info exists data(colBeingResized)]} { ;# resize operation in progress 2179 configLabel $w -cursor $data(-resizecursor) 2180 } else { 2181 set data(inClickedLabel) 1 2182 if {$data(changeRelief)} { 2183 configLabel $w -relief sunken -pressed 1 2184 } 2185 } 2186} 2187 2188#------------------------------------------------------------------------------ 2189# tablelist::labelB1Leave 2190# 2191# This procedure is invoked when the mouse pointer leaves the header label w of 2192# a tablelist widget while mouse button 1 is down. If the label was not 2193# previously clicked then nothing happens. Otherwise, if no column resize 2194# operation is in progress then the procedure restores the label's relief, and, 2195# if the columns are movable, then it changes the mouse cursor, too. 2196#------------------------------------------------------------------------------ 2197proc tablelist::labelB1Leave {w x y} { 2198 parseLabelPath $w win col 2199 upvar ::tablelist::ns${win}::data data 2200 if {!$data(labelClicked) || 2201 [info exists data(colBeingResized)]} { ;# resize operation in progress 2202 return "" 2203 } 2204 2205 # 2206 # The following code is needed because the event 2207 # can also occur in a widget placed into the label 2208 # 2209 if {$x >= 1 && $x < [winfo width $w] - 1 && 2210 $y >= 0 && $y < [winfo height $w]} { 2211 return "" 2212 } 2213 2214 set data(inClickedLabel) 0 2215 configLabel $w -relief $data(relief) -pressed 0 2216} 2217 2218#------------------------------------------------------------------------------ 2219# tablelist::labelB1Up 2220# 2221# This procedure is invoked when mouse button 1 is released, if it was 2222# previously clicked in a label of the tablelist widget win. If this event 2223# occured during a column resize operation then the procedure redisplays the 2224# column and stretches the stretchable columns. Otherwise, if the mouse button 2225# was released in the previously clicked label then the procedure restores the 2226# label's relief and invokes the command specified by the -labelcommand or 2227# -labelcommand2 configuration option, passing to it the widget name and the 2228# column number as arguments. Otherwise the column of the previously clicked 2229# label is moved before the column containing the mouse cursor or to its right, 2230# if the columns are movable. 2231#------------------------------------------------------------------------------ 2232proc tablelist::labelB1Up {w X} { 2233 parseLabelPath $w win col 2234 upvar ::tablelist::ns${win}::data data 2235 if {!$data(labelClicked)} { 2236 return "" 2237 } 2238 2239 if {[info exists data(colBeingResized)]} { ;# resize operation in progress 2240 configLabel $w -cursor $data(-cursor) 2241 if {[winfo exists $data(focus)]} { 2242 focus $data(focus) 2243 } 2244 bind [winfo toplevel $win] <Escape> $data(topEscBinding) 2245 set col $data(colBeingResized) 2246 if {$data(-width) <= 0} { 2247 $data(hdr) configure -width $data(hdrPixels) 2248 $data(lb) configure -width \ 2249 [expr {$data(hdrPixels) / $data(charWidth)}] 2250 } elseif {[info exists data(stretchableCols)] && 2251 [lsearch -exact $data(stretchableCols) $col] >= 0} { 2252 set oldColWidth \ 2253 [expr {$data(oldStretchedColWidth) - $data(oldColDelta)}] 2254 set stretchedColWidth \ 2255 [expr {$data(oldStretchedColWidth) + $X - $data(X)}] 2256 if {$oldColWidth < $data(stretchablePixels) && 2257 $stretchedColWidth >= $data(minColWidth) && 2258 $stretchedColWidth < $oldColWidth + $data(delta)} { 2259 # 2260 # Compute the new column width, using the following equations: 2261 # 2262 # $colWidth = $stretchedColWidth - $colDelta 2263 # $colDelta / $colWidth = 2264 # ($data(delta) - $colWidth + $oldColWidth) / 2265 # ($data(stretchablePixels) + $colWidth - $oldColWidth) 2266 # 2267 set colWidth [expr { 2268 $stretchedColWidth * 2269 ($data(stretchablePixels) - $oldColWidth) / 2270 ($data(stretchablePixels) + $data(delta) - 2271 $stretchedColWidth) 2272 }] 2273 if {$colWidth < 1} { 2274 set colWidth 1 2275 } 2276 set idx [expr {3*$col}] 2277 set data(-columns) \ 2278 [lreplace $data(-columns) $idx $idx -$colWidth] 2279 set idx [expr {2*$col}] 2280 set data(colList) [lreplace $data(colList) $idx $idx $colWidth] 2281 set data($col-delta) [expr {$stretchedColWidth - $colWidth}] 2282 } 2283 } 2284 unset data(colBeingResized) 2285 $data(body) tag delete visibleLines 1.0 end 2286 redisplayCol $win $col 0 end 2287 adjustColumns $win {} 0 2288 stretchColumns $win $col 2289 event generate $win <<TablelistColumnResized>> 2290 } else { 2291 if {[info exists data(X)]} { 2292 unset data(X) 2293 after cancel $data(afterId) 2294 set data(afterId) "" 2295 } 2296 if {$data(-movablecolumns)} { 2297 if {[winfo exists $data(focus)]} { 2298 focus $data(focus) 2299 } 2300 bind [winfo toplevel $win] <Escape> $data(topEscBinding) 2301 place forget $data(colGap) 2302 } 2303 2304 if {$data(inClickedLabel)} { 2305 configLabel $w -relief $data(relief) -pressed 0 2306 if {$data(shiftPressed)} { 2307 if {[info exists data($col-labelcommand2)]} { 2308 uplevel #0 $data($col-labelcommand2) [list $win $col] 2309 } elseif {[string compare $data(-labelcommand2) ""] != 0} { 2310 uplevel #0 $data(-labelcommand2) [list $win $col] 2311 } 2312 } else { 2313 if {[info exists data($col-labelcommand)]} { 2314 uplevel #0 $data($col-labelcommand) [list $win $col] 2315 } elseif {[string compare $data(-labelcommand) ""] != 0} { 2316 uplevel #0 $data(-labelcommand) [list $win $col] 2317 } 2318 } 2319 } elseif {$data(-movablecolumns)} { 2320 $data(hdrTxtFrCanv)$col configure -cursor $data(-cursor) 2321 if {[info exists data(targetCol)] && $data(targetCol) != -1 && 2322 $data(targetCol) != $col && $data(targetCol) != $col + 1} { 2323 moveCol $win $col $data(targetCol) 2324 event generate $win <<TablelistColumnMoved>> 2325 } 2326 } 2327 } 2328 2329 set data(labelClicked) 0 2330} 2331 2332#------------------------------------------------------------------------------ 2333# tablelist::labelB3Down 2334# 2335# This procedure is invoked when mouse button 3 is pressed in the header label 2336# w of a tablelist widget. If the Shift key was down when this event occured 2337# then the procedure restores the last static width of the given column; 2338# otherwise it configures the width of the given column to be just large enough 2339# to hold all the elements (including the label). 2340#------------------------------------------------------------------------------ 2341proc tablelist::labelB3Down {w shiftPressed} { 2342 parseLabelPath $w win col 2343 upvar ::tablelist::ns${win}::data data 2344 if {!$data(isDisabled) && 2345 $data(-resizablecolumns) && $data($col-resizable)} { 2346 if {$shiftPressed} { 2347 doColConfig $col $win -width -$data($col-lastStaticWidth) 2348 } else { 2349 doColConfig $col $win -width 0 2350 } 2351 event generate $win <<TablelistColumnResized>> 2352 } 2353} 2354 2355#------------------------------------------------------------------------------ 2356# tablelist::escape 2357# 2358# This procedure is invoked to process <Escape> events in the top-level window 2359# containing the tablelist widget win during a column resize or move operation. 2360# The procedure cancels the action in progress and, in case of column resizing, 2361# it restores the initial width of the respective column. 2362#------------------------------------------------------------------------------ 2363proc tablelist::escape {win col} { 2364 upvar ::tablelist::ns${win}::data data 2365 set w $data(hdrTxtFrLbl)$col 2366 if {[info exists data(colBeingResized)]} { ;# resize operation in progress 2367 configLabel $w -cursor $data(-cursor) 2368 update idletasks 2369 if {[winfo exists $data(focus)]} { 2370 focus $data(focus) 2371 } 2372 bind [winfo toplevel $win] <Escape> $data(topEscBinding) 2373 set data(labelClicked) 0 2374 set col $data(colBeingResized) 2375 set idx [expr {3*$col}] 2376 setupColumns $win [lreplace $data(-columns) $idx $idx \ 2377 $data(configColWidth)] 0 2378 redisplayCol $win $col $data(topRow) $data(btmRow) 2379 unset data(colBeingResized) 2380 $data(body) tag delete visibleLines 1.0 end 2381 adjustColumns $win {} 1 2382 } elseif {!$data(inClickedLabel)} { 2383 configLabel $w -cursor $data(-cursor) 2384 $data(hdrTxtFrCanv)$col configure -cursor $data(-cursor) 2385 if {[winfo exists $data(focus)]} { 2386 focus $data(focus) 2387 } 2388 bind [winfo toplevel $win] <Escape> $data(topEscBinding) 2389 place forget $data(colGap) 2390 if {[info exists data(X)]} { 2391 unset data(X) 2392 after cancel $data(afterId) 2393 set data(afterId) "" 2394 } 2395 set data(labelClicked) 0 2396 } 2397} 2398 2399#------------------------------------------------------------------------------ 2400# tablelist::horizAutoScan 2401# 2402# This procedure is invoked when the mouse leaves the scrollable part of a 2403# tablelist widget's header frame. It scrolls the header and reschedules 2404# itself as an after command so that the header continues to scroll until the 2405# mouse moves back into the window or the mouse button is released. 2406#------------------------------------------------------------------------------ 2407proc tablelist::horizAutoScan win { 2408 if {![winfo exists $win]} { 2409 return "" 2410 } 2411 2412 upvar ::tablelist::ns${win}::data data 2413 if {![info exists data(X)]} { 2414 return "" 2415 } 2416 2417 set X $data(X) 2418 set hdrX [winfo rootx $data(hdr)] 2419 if {$data(-titlecolumns) == 0 || ![winfo viewable $data(sep)]} { 2420 set leftX $hdrX 2421 } else { 2422 set leftX [expr {[winfo rootx $data(sep)] + 1}] 2423 } 2424 set rightX [expr {$hdrX + [winfo width $data(hdr)]}] 2425 if {$data(-titlecolumns) == 0} { 2426 set units 2 2427 set ms 50 2428 } else { 2429 set units 1 2430 set ms 250 2431 } 2432 2433 if {$X >= $rightX} { 2434 ::$win xview scroll $units units 2435 } elseif {$X < $leftX} { 2436 ::$win xview scroll -$units units 2437 } else { 2438 return "" 2439 } 2440 2441 set data(afterId) [after $ms [list tablelist::horizAutoScan $win]] 2442} 2443