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