1#============================================================================== 2# Contains the implementation of interactive cell editing in tablelist widgets. 3# 4# Structure of the module: 5# - Namespace initialization 6# - Public procedures related to interactive cell editing 7# - Private procedures implementing the interactive cell editing 8# - Private procedures used in bindings related to interactive cell editing 9# 10# Copyright (c) 2003-2010 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) 11#============================================================================== 12 13# 14# Namespace initialization 15# ======================== 16# 17 18namespace eval tablelist { 19 # 20 # Register the Tk core widgets entry, text, checkbutton, 21 # and spinbox for interactive cell editing 22 # 23 proc addTkCoreWidgets {} { 24 set name entry 25 array set ::tablelist::editWin [list \ 26 $name-creationCmd "$name %W -width 0" \ 27 $name-putValueCmd "%W delete 0 end; %W insert 0 %T" \ 28 $name-getValueCmd "%W get" \ 29 $name-putTextCmd "%W delete 0 end; %W insert 0 %T" \ 30 $name-getTextCmd "%W get" \ 31 $name-putListCmd "" \ 32 $name-getListCmd "" \ 33 $name-selectCmd "" \ 34 $name-invokeCmd "" \ 35 $name-fontOpt -font \ 36 $name-useFormat 1 \ 37 $name-useReqWidth 0 \ 38 $name-usePadX 0 \ 39 $name-isEntryLike 1 \ 40 $name-focusWin %W \ 41 $name-reservedKeys {Left Right} \ 42 ] 43 44 set name text 45 array set ::tablelist::editWin [list \ 46 $name-creationCmd "$name %W -padx 2 -pady 2 -wrap none" \ 47 $name-putValueCmd "%W delete 1.0 end; %W insert 1.0 %T" \ 48 $name-getValueCmd "%W get 1.0 end-1c" \ 49 $name-putTextCmd "%W delete 1.0 end; %W insert 1.0 %T" \ 50 $name-getTextCmd "%W get 1.0 end-1c" \ 51 $name-putListCmd "" \ 52 $name-getListCmd "" \ 53 $name-selectCmd "" \ 54 $name-invokeCmd "" \ 55 $name-fontOpt -font \ 56 $name-useFormat 1 \ 57 $name-useReqWidth 0 \ 58 $name-usePadX 0 \ 59 $name-isEntryLike 1 \ 60 $name-focusWin %W \ 61 $name-reservedKeys {Left Right Up Down Prior Next 62 Control-Home Control-End Meta-b Meta-f 63 Control-p Control-n Meta-less Meta-greater} \ 64 ] 65 66 set name checkbutton 67 array set ::tablelist::editWin [list \ 68 $name-creationCmd "createCheckbutton %W" \ 69 $name-putValueCmd {set [%W cget -variable] %T} \ 70 $name-getValueCmd {set [%W cget -variable]} \ 71 $name-putTextCmd {set [%W cget -variable] %T} \ 72 $name-getTextCmd {set [%W cget -variable]} \ 73 $name-putListCmd "" \ 74 $name-getListCmd "" \ 75 $name-selectCmd "" \ 76 $name-invokeCmd "%W invoke" \ 77 $name-fontOpt "" \ 78 $name-useFormat 0 \ 79 $name-useReqWidth 1 \ 80 $name-usePadX 0 \ 81 $name-isEntryLike 0 \ 82 $name-focusWin %W \ 83 $name-reservedKeys {} \ 84 ] 85 86 if {$::tk_version < 8.4} { 87 return "" 88 } 89 90 set name spinbox 91 array set ::tablelist::editWin [list \ 92 $name-creationCmd "$name %W -width 0" \ 93 $name-putValueCmd "%W delete 0 end; %W insert 0 %T" \ 94 $name-getValueCmd "%W get" \ 95 $name-putTextCmd "%W delete 0 end; %W insert 0 %T" \ 96 $name-getTextCmd "%W get" \ 97 $name-putListCmd "" \ 98 $name-getListCmd "" \ 99 $name-selectCmd "" \ 100 $name-invokeCmd "" \ 101 $name-fontOpt -font \ 102 $name-useFormat 1 \ 103 $name-useReqWidth 0 \ 104 $name-usePadX 1 \ 105 $name-isEntryLike 1 \ 106 $name-focusWin %W \ 107 $name-reservedKeys {Left Right Up Down} \ 108 ] 109 } 110 addTkCoreWidgets 111 112 # 113 # Register the tile widgets ttk::entry, ttk::spinbox, 114 # ttk::combobox, and ttk::checkbutton for interactive cell editing 115 # 116 proc addTileWidgets {} { 117 set name ttk::entry 118 array set ::tablelist::editWin [list \ 119 $name-creationCmd "createTileEntry %W" \ 120 $name-putValueCmd "%W delete 0 end; %W insert 0 %T" \ 121 $name-getValueCmd "%W get" \ 122 $name-putTextCmd "%W delete 0 end; %W insert 0 %T" \ 123 $name-getTextCmd "%W get" \ 124 $name-putListCmd "" \ 125 $name-getListCmd "" \ 126 $name-selectCmd "" \ 127 $name-invokeCmd "" \ 128 $name-fontOpt -font \ 129 $name-useFormat 1 \ 130 $name-useReqWidth 0 \ 131 $name-usePadX 0 \ 132 $name-isEntryLike 1 \ 133 $name-focusWin %W \ 134 $name-reservedKeys {Left Right} \ 135 ] 136 137 set name ttk::spinbox 138 array set ::tablelist::editWin [list \ 139 $name-creationCmd "createTileSpinbox %W" \ 140 $name-putValueCmd "%W delete 0 end; %W insert 0 %T" \ 141 $name-getValueCmd "%W get" \ 142 $name-putTextCmd "%W delete 0 end; %W insert 0 %T" \ 143 $name-getTextCmd "%W get" \ 144 $name-putListCmd "" \ 145 $name-getListCmd "" \ 146 $name-selectCmd "" \ 147 $name-invokeCmd "" \ 148 $name-fontOpt -font \ 149 $name-useFormat 1 \ 150 $name-useReqWidth 0 \ 151 $name-usePadX 1 \ 152 $name-isEntryLike 1 \ 153 $name-focusWin %W \ 154 $name-reservedKeys {Left Right Up Down} \ 155 ] 156 157 set name ttk::combobox 158 array set ::tablelist::editWin [list \ 159 $name-creationCmd "createTileCombobox %W" \ 160 $name-putValueCmd "%W set %T" \ 161 $name-getValueCmd "%W get" \ 162 $name-putTextCmd "%W set %T" \ 163 $name-getTextCmd "%W get" \ 164 $name-putListCmd "" \ 165 $name-getListCmd "" \ 166 $name-selectCmd "" \ 167 $name-invokeCmd "event generate %W <Down>" \ 168 $name-fontOpt -font \ 169 $name-useFormat 1 \ 170 $name-useReqWidth 0 \ 171 $name-usePadX 1 \ 172 $name-isEntryLike 1 \ 173 $name-focusWin %W \ 174 $name-reservedKeys {Left Right Up Down} \ 175 ] 176 177 set name ttk::checkbutton 178 array set ::tablelist::editWin [list \ 179 $name-creationCmd "createTileCheckbutton %W" \ 180 $name-putValueCmd {set [%W cget -variable] %T} \ 181 $name-getValueCmd {set [%W cget -variable]} \ 182 $name-putTextCmd {set [%W cget -variable] %T} \ 183 $name-getTextCmd {set [%W cget -variable]} \ 184 $name-putListCmd "" \ 185 $name-getListCmd "" \ 186 $name-selectCmd "" \ 187 $name-invokeCmd {%W instate !pressed {%W invoke}} \ 188 $name-fontOpt "" \ 189 $name-useFormat 0 \ 190 $name-useReqWidth 1 \ 191 $name-usePadX 0 \ 192 $name-isEntryLike 0 \ 193 $name-focusWin %W \ 194 $name-reservedKeys {} \ 195 ] 196 } 197 if {$::tk_version >= 8.4 && [llength [package versions tile]] > 0} { 198 addTileWidgets 199 } 200} 201 202# 203# Public procedures related to interactive cell editing 204# ===================================================== 205# 206 207#------------------------------------------------------------------------------ 208# tablelist::addBWidgetEntry 209# 210# Registers the Entry widget from the BWidget package for interactive cell 211# editing. 212#------------------------------------------------------------------------------ 213proc tablelist::addBWidgetEntry {{name Entry}} { 214 checkEditWinName $name 215 216 array set ::tablelist::editWin [list \ 217 $name-creationCmd "Entry %W -width 0" \ 218 $name-putValueCmd "%W delete 0 end; %W insert 0 %T" \ 219 $name-getValueCmd "%W get" \ 220 $name-putTextCmd "%W delete 0 end; %W insert 0 %T" \ 221 $name-getTextCmd "%W get" \ 222 $name-putListCmd "" \ 223 $name-getListCmd "" \ 224 $name-selectCmd "" \ 225 $name-invokeCmd "" \ 226 $name-fontOpt -font \ 227 $name-useFormat 1 \ 228 $name-useReqWidth 0 \ 229 $name-usePadX 0 \ 230 $name-isEntryLike 1 \ 231 $name-focusWin %W \ 232 $name-reservedKeys {Left Right} \ 233 ] 234 235 return $name 236} 237 238#------------------------------------------------------------------------------ 239# tablelist::addBWidgetSpinBox 240# 241# Registers the SpinBox widget from the BWidget package for interactive cell 242# editing. 243#------------------------------------------------------------------------------ 244proc tablelist::addBWidgetSpinBox {{name SpinBox}} { 245 checkEditWinName $name 246 247 array set ::tablelist::editWin [list \ 248 $name-creationCmd "SpinBox %W -editable 1 -width 0" \ 249 $name-putValueCmd "%W configure -text %T" \ 250 $name-getValueCmd "%W cget -text" \ 251 $name-putTextCmd "%W configure -text %T" \ 252 $name-getTextCmd "%W cget -text" \ 253 $name-putListCmd "" \ 254 $name-getListCmd "" \ 255 $name-selectCmd "" \ 256 $name-invokeCmd "" \ 257 $name-fontOpt -font \ 258 $name-useFormat 1 \ 259 $name-useReqWidth 0 \ 260 $name-usePadX 1 \ 261 $name-isEntryLike 1 \ 262 $name-focusWin %W.e \ 263 $name-reservedKeys {Left Right Up Down Prior Next} \ 264 ] 265 266 return $name 267} 268 269#------------------------------------------------------------------------------ 270# tablelist::addBWidgetComboBox 271# 272# Registers the ComboBox widget from the BWidget package for interactive cell 273# editing. 274#------------------------------------------------------------------------------ 275proc tablelist::addBWidgetComboBox {{name ComboBox}} { 276 checkEditWinName $name 277 278 array set ::tablelist::editWin [list \ 279 $name-creationCmd "ComboBox %W -editable 1 -width 0" \ 280 $name-putValueCmd "%W configure -text %T" \ 281 $name-getValueCmd "%W cget -text" \ 282 $name-putTextCmd "%W configure -text %T" \ 283 $name-getTextCmd "%W cget -text" \ 284 $name-putListCmd "" \ 285 $name-getListCmd "" \ 286 $name-selectCmd "" \ 287 $name-invokeCmd "%W.a invoke" \ 288 $name-fontOpt -font \ 289 $name-useFormat 1 \ 290 $name-useReqWidth 0 \ 291 $name-usePadX 1 \ 292 $name-isEntryLike 1 \ 293 $name-focusWin %W.e \ 294 $name-reservedKeys {Left Right Up Down} \ 295 ] 296 297 return $name 298} 299 300#------------------------------------------------------------------------------ 301# tablelist::addIncrEntryfield 302# 303# Registers the entryfield widget from the Iwidgets package for interactive 304# cell editing. 305#------------------------------------------------------------------------------ 306proc tablelist::addIncrEntryfield {{name entryfield}} { 307 checkEditWinName $name 308 309 array set ::tablelist::editWin [list \ 310 $name-creationCmd "iwidgets::entryfield %W -width 0" \ 311 $name-putValueCmd "%W clear; %W insert 0 %T" \ 312 $name-getValueCmd "%W get" \ 313 $name-putTextCmd "%W clear; %W insert 0 %T" \ 314 $name-getTextCmd "%W get" \ 315 $name-putListCmd "" \ 316 $name-getListCmd "" \ 317 $name-selectCmd "" \ 318 $name-invokeCmd "" \ 319 $name-fontOpt -textfont \ 320 $name-useFormat 1 \ 321 $name-useReqWidth 0 \ 322 $name-usePadX 0 \ 323 $name-isEntryLike 1 \ 324 $name-focusWin {[%W component entry]} \ 325 $name-reservedKeys {Left Right} \ 326 ] 327 328 return $name 329} 330 331#------------------------------------------------------------------------------ 332# tablelist::addIncrDateTimeWidget 333# 334# Registers the datefield, dateentry, timefield, or timeentry widget from the 335# Iwidgets package, with or without the -clicks option for its get subcommand, 336# for interactive cell editing. 337#------------------------------------------------------------------------------ 338proc tablelist::addIncrDateTimeWidget {widgetType args} { 339 if {![regexp {^(datefield|dateentry|timefield|timeentry)$} $widgetType]} { 340 return -code error \ 341 "bad widget type \"$widgetType\": must be\ 342 datefield, dateentry, timefield, or timeentry" 343 } 344 345 switch [llength $args] { 346 0 { 347 set useClicks 0 348 set name $widgetType 349 } 350 351 1 { 352 set arg [lindex $args 0] 353 if {[string compare $arg "-seconds"] == 0} { 354 set useClicks 1 355 set name $widgetType 356 } else { 357 set useClicks 0 358 set name $arg 359 } 360 } 361 362 2 { 363 set arg0 [lindex $args 0] 364 if {[string compare $arg0 "-seconds"] != 0} { 365 return -code error "bad option \"$arg0\": must be -seconds" 366 } 367 368 set useClicks 1 369 set name [lindex $args 1] 370 } 371 372 default { 373 mwutil::wrongNumArgs "addIncrDateTimeWidget\ 374 datefield|dateentry|timefield|timeentry\ 375 ?-seconds? ?name?" 376 } 377 } 378 checkEditWinName $name 379 380 array set ::tablelist::editWin [list \ 381 $name-creationCmd "iwidgets::$widgetType %W" \ 382 $name-putValueCmd "%W show %T" \ 383 $name-getValueCmd "%W get" \ 384 $name-putTextCmd "%W show %T" \ 385 $name-getTextCmd "%W get" \ 386 $name-putListCmd "" \ 387 $name-getListCmd "" \ 388 $name-selectCmd "" \ 389 $name-invokeCmd "" \ 390 $name-fontOpt -textfont \ 391 $name-useReqWidth 1 \ 392 $name-usePadX [string match "*entry" $widgetType] \ 393 $name-useFormat 1 \ 394 $name-isEntryLike 1 \ 395 $name-reservedKeys {Left Right Up Down} \ 396 ] 397 if {$useClicks} { 398 lappend ::tablelist::editWin($name-getValueCmd) -clicks 399 set ::tablelist::editWin($name-useFormat) 0 400 } 401 if {[string match "date*" $widgetType]} { 402 set ::tablelist::editWin($name-focusWin) {[%W component date]} 403 } else { 404 set ::tablelist::editWin($name-focusWin) {[%W component time]} 405 } 406 407 return $name 408} 409 410#------------------------------------------------------------------------------ 411# tablelist::addIncrSpinner 412# 413# Registers the spinner widget from the Iwidgets package for interactive cell 414# editing. 415#------------------------------------------------------------------------------ 416proc tablelist::addIncrSpinner {{name spinner}} { 417 checkEditWinName $name 418 419 array set ::tablelist::editWin [list \ 420 $name-creationCmd "iwidgets::spinner %W -width 0" \ 421 $name-putValueCmd "%W clear; %W insert 0 %T" \ 422 $name-getValueCmd "%W get" \ 423 $name-putTextCmd "%W clear; %W insert 0 %T" \ 424 $name-getTextCmd "%W get" \ 425 $name-putListCmd "" \ 426 $name-getListCmd "" \ 427 $name-selectCmd "" \ 428 $name-invokeCmd "" \ 429 $name-fontOpt -textfont \ 430 $name-useFormat 1 \ 431 $name-useReqWidth 0 \ 432 $name-usePadX 1 \ 433 $name-isEntryLike 1 \ 434 $name-focusWin {[%W component entry]} \ 435 $name-reservedKeys {Left Right} \ 436 ] 437 438 return $name 439} 440 441#------------------------------------------------------------------------------ 442# tablelist::addIncrSpinint 443# 444# Registers the spinint widget from the Iwidgets package for interactive cell 445# editing. 446#------------------------------------------------------------------------------ 447proc tablelist::addIncrSpinint {{name spinint}} { 448 checkEditWinName $name 449 450 array set ::tablelist::editWin [list \ 451 $name-creationCmd "iwidgets::spinint %W -width 0" \ 452 $name-putValueCmd "%W clear; %W insert 0 %T" \ 453 $name-getValueCmd "%W get" \ 454 $name-putTextCmd "%W clear; %W insert 0 %T" \ 455 $name-getTextCmd "%W get" \ 456 $name-putListCmd "" \ 457 $name-getListCmd "" \ 458 $name-selectCmd "" \ 459 $name-invokeCmd "" \ 460 $name-fontOpt -textfont \ 461 $name-useFormat 1 \ 462 $name-useReqWidth 0 \ 463 $name-usePadX 1 \ 464 $name-isEntryLike 1 \ 465 $name-focusWin {[%W component entry]} \ 466 $name-reservedKeys {Left Right} \ 467 ] 468 469 return $name 470} 471 472#------------------------------------------------------------------------------ 473# tablelist::addIncrCombobox 474# 475# Registers the combobox widget from the Iwidgets package for interactive cell 476# editing. 477#------------------------------------------------------------------------------ 478proc tablelist::addIncrCombobox {{name combobox}} { 479 checkEditWinName $name 480 481 array set ::tablelist::editWin [list \ 482 $name-creationCmd "createIncrCombobox %W" \ 483 $name-putValueCmd "%W clear entry; %W insert entry 0 %T" \ 484 $name-getValueCmd "%W get" \ 485 $name-putTextCmd "%W clear entry; %W insert entry 0 %T" \ 486 $name-getTextCmd "%W get" \ 487 $name-putListCmd {eval [list %W insert list end] %L} \ 488 $name-getListCmd "%W component list get 0 end" \ 489 $name-selectCmd "%W selection set %I" \ 490 $name-invokeCmd "%W invoke" \ 491 $name-fontOpt -textfont \ 492 $name-useFormat 1 \ 493 $name-useReqWidth 0 \ 494 $name-usePadX 1 \ 495 $name-isEntryLike 1 \ 496 $name-focusWin {[%W component entry]} \ 497 $name-reservedKeys {Left Right Up Down Control-p Control-n} \ 498 ] 499 500 return $name 501} 502 503#------------------------------------------------------------------------------ 504# tablelist::addOakleyCombobox 505# 506# Registers Bryan Oakley's combobox widget for interactive cell editing. 507#------------------------------------------------------------------------------ 508proc tablelist::addOakleyCombobox {{name combobox}} { 509 checkEditWinName $name 510 511 array set ::tablelist::editWin [list \ 512 $name-creationCmd "createOakleyCombobox %W" \ 513 $name-putValueCmd "%W delete 0 end; %W insert 0 %T" \ 514 $name-getValueCmd "%W get" \ 515 $name-putTextCmd "%W delete 0 end; %W insert 0 %T" \ 516 $name-getTextCmd "%W get" \ 517 $name-putListCmd {eval [list %W list insert end] %L} \ 518 $name-getListCmd "%W list get 0 end" \ 519 $name-selectCmd "%W select %I" \ 520 $name-invokeCmd "%W open" \ 521 $name-fontOpt -font \ 522 $name-useFormat 1 \ 523 $name-useReqWidth 0 \ 524 $name-usePadX 1 \ 525 $name-isEntryLike 1 \ 526 $name-focusWin %W.entry \ 527 $name-reservedKeys {Left Right Up Down Prior Next} \ 528 ] 529 530 # 531 # Patch the ::combobox::UpdateVisualAttributes procedure to make sure it 532 # won't change the background and trough colors of the vertical scrollbar 533 # 534 catch {combobox::combobox} ;# enforces the evaluation of "combobox.tcl" 535 if {[catch {rename ::combobox::UpdateVisualAttributes \ 536 ::combobox::_UpdateVisualAttributes}] == 0} { 537 proc ::combobox::UpdateVisualAttributes w { 538 set vsbBackground [$w.top.vsb cget -background] 539 set vsbTroughColor [$w.top.vsb cget -troughcolor] 540 541 ::combobox::_UpdateVisualAttributes $w 542 543 $w.top.vsb configure -background $vsbBackground 544 $w.top.vsb configure -troughcolor $vsbTroughColor 545 } 546 } 547 548 return $name 549} 550 551#------------------------------------------------------------------------------ 552# tablelist::addDateMentry 553# 554# Registers the widget created by the mentry::dateMentry command from the 555# Mentry package, with a given format and separator and with or without the 556# "-gmt 1" option for the mentry::putClockVal and mentry::getClockVal commands, 557# for interactive cell editing. 558#------------------------------------------------------------------------------ 559proc tablelist::addDateMentry {fmt sep args} { 560 # 561 # Parse the fmt argument 562 # 563 if {![regexp {^([dmyY])([dmyY])([dmyY])$} $fmt dummy \ 564 fields(0) fields(1) fields(2)]} { 565 return -code error \ 566 "bad format \"$fmt\": must be a string of length 3,\ 567 consisting of the letters d, m, and y or Y" 568 } 569 570 # 571 # Check whether all the three date components are represented in fmt 572 # 573 for {set n 0} {$n < 3} {incr n} { 574 set lfields($n) [string tolower $fields($n)] 575 } 576 if {[string compare $lfields(0) $lfields(1)] == 0 || 577 [string compare $lfields(0) $lfields(2)] == 0 || 578 [string compare $lfields(1) $lfields(2)] == 0} { 579 return -code error \ 580 "bad format \"$fmt\": must have unique components for the\ 581 day, month, and year" 582 } 583 584 # 585 # Parse the remaining arguments (if any) 586 # 587 switch [llength $args] { 588 0 { 589 set useGMT 0 590 set name dateMentry 591 } 592 593 1 { 594 set arg [lindex $args 0] 595 if {[string compare $arg "-gmt"] == 0} { 596 set useGMT 1 597 set name dateMentry 598 } else { 599 set useGMT 0 600 set name $arg 601 } 602 } 603 604 2 { 605 set arg0 [lindex $args 0] 606 if {[string compare $arg0 "-gmt"] != 0} { 607 return -code error "bad option \"$arg0\": must be -gmt" 608 } 609 610 set useGMT 1 611 set name [lindex $args 1] 612 } 613 614 default { 615 mwutil::wrongNumArgs "addDateMentry format separator ?-gmt? ?name?" 616 } 617 } 618 checkEditWinName $name 619 620 array set ::tablelist::editWin [list \ 621 $name-creationCmd [list mentry::dateMentry %W $fmt $sep] \ 622 $name-putValueCmd "mentry::putClockVal %T %W -gmt $useGMT" \ 623 $name-getValueCmd "mentry::getClockVal %W -gmt $useGMT" \ 624 $name-putTextCmd "" \ 625 $name-getTextCmd "%W getstring" \ 626 $name-putListCmd {eval [list %W put 0] %L} \ 627 $name-getListCmd "%W getlist" \ 628 $name-selectCmd "" \ 629 $name-invokeCmd "" \ 630 $name-fontOpt -font \ 631 $name-useFormat 0 \ 632 $name-useReqWidth 1 \ 633 $name-usePadX 1 \ 634 $name-isEntryLike 1 \ 635 $name-focusWin "" \ 636 $name-reservedKeys {Left Right Up Down Prior Next} \ 637 ] 638 639 return $name 640} 641 642#------------------------------------------------------------------------------ 643# tablelist::addTimeMentry 644# 645# Registers the widget created by the mentry::timeMentry command from the 646# Mentry package, with a given format and separator and with or without the 647# "-gmt 1" option for the mentry::putClockVal and mentry::getClockVal commands, 648# for interactive cell editing. 649#------------------------------------------------------------------------------ 650proc tablelist::addTimeMentry {fmt sep args} { 651 # 652 # Parse the fmt argument 653 # 654 if {![regexp {^(H|I)(M)(S?)$} $fmt dummy fields(0) fields(1) fields(2)]} { 655 return -code error \ 656 "bad format \"$fmt\": must be a string of length 2 or 3\ 657 starting with H or I, followed by M and optionally by S" 658 } 659 660 # 661 # Parse the remaining arguments (if any) 662 # 663 switch [llength $args] { 664 0 { 665 set useGMT 0 666 set name timeMentry 667 } 668 669 1 { 670 set arg [lindex $args 0] 671 if {[string compare $arg "-gmt"] == 0} { 672 set useGMT 1 673 set name timeMentry 674 } else { 675 set useGMT 0 676 set name $arg 677 } 678 } 679 680 2 { 681 set arg0 [lindex $args 0] 682 if {[string compare $arg0 "-gmt"] != 0} { 683 return -code error "bad option \"$arg0\": must be -gmt" 684 } 685 686 set useGMT 1 687 set name [lindex $args 1] 688 } 689 690 default { 691 mwutil::wrongNumArgs "addTimeMentry format separator ?-gmt? ?name?" 692 } 693 } 694 checkEditWinName $name 695 696 array set ::tablelist::editWin [list \ 697 $name-creationCmd [list mentry::timeMentry %W $fmt $sep] \ 698 $name-putValueCmd "mentry::putClockVal %T %W -gmt $useGMT" \ 699 $name-getValueCmd "mentry::getClockVal %W -gmt $useGMT" \ 700 $name-putTextCmd "" \ 701 $name-getTextCmd "%W getstring" \ 702 $name-putListCmd {eval [list %W put 0] %L} \ 703 $name-getListCmd "%W getlist" \ 704 $name-selectCmd "" \ 705 $name-invokeCmd "" \ 706 $name-fontOpt -font \ 707 $name-useFormat 0 \ 708 $name-useReqWidth 1 \ 709 $name-usePadX 1 \ 710 $name-isEntryLike 1 \ 711 $name-focusWin "" \ 712 $name-reservedKeys {Left Right Up Down Prior Next} \ 713 ] 714 715 return $name 716} 717 718#------------------------------------------------------------------------------ 719# tablelist::addDateTimeMentry 720# 721# Registers the widget created by the mentry::dateTimeMentry command from the 722# Mentry package, with a given format and given separators and with or without 723# the "-gmt 1" option for the mentry::putClockVal and mentry::getClockVal 724# commands, for interactive cell editing. 725#------------------------------------------------------------------------------ 726proc tablelist::addDateTimeMentry {fmt dateSep timeSep args} { 727 # 728 # Parse the fmt argument 729 # 730 if {![regexp {^([dmyY])([dmyY])([dmyY])(H|I)(M)(S?)$} $fmt dummy \ 731 fields(0) fields(1) fields(2) fields(3) fields(4) fields(5)]} { 732 return -code error \ 733 "bad format \"$fmt\": must be a string of length 5 or 6,\ 734 with the first 3 characters consisting of the letters d, m,\ 735 and y or Y, followed by H or I, then M, and optionally by S" 736 } 737 738 # 739 # Check whether all the three date components are represented in fmt 740 # 741 for {set n 0} {$n < 3} {incr n} { 742 set lfields($n) [string tolower $fields($n)] 743 } 744 if {[string compare $lfields(0) $lfields(1)] == 0 || 745 [string compare $lfields(0) $lfields(2)] == 0 || 746 [string compare $lfields(1) $lfields(2)] == 0} { 747 return -code error \ 748 "bad format \"$fmt\": must have unique components for the\ 749 day, month, and year" 750 } 751 752 # 753 # Parse the remaining arguments (if any) 754 # 755 switch [llength $args] { 756 0 { 757 set useGMT 0 758 set name dateTimeMentry 759 } 760 761 1 { 762 set arg [lindex $args 0] 763 if {[string compare $arg "-gmt"] == 0} { 764 set useGMT 1 765 set name dateTimeMentry 766 } else { 767 set useGMT 0 768 set name $arg 769 } 770 } 771 772 2 { 773 set arg0 [lindex $args 0] 774 if {[string compare $arg0 "-gmt"] != 0} { 775 return -code error "bad option \"$arg0\": must be -gmt" 776 } 777 778 set useGMT 1 779 set name [lindex $args 1] 780 } 781 782 default { 783 mwutil::wrongNumArgs "addDateTimeMentry format dateSeparator\ 784 timeSeparator ?-gmt? ?name?" 785 } 786 } 787 checkEditWinName $name 788 789 array set ::tablelist::editWin [list \ 790 $name-creationCmd [list mentry::dateTimeMentry %W $fmt \ 791 $dateSep $timeSep] \ 792 $name-putValueCmd "mentry::putClockVal %T %W -gmt $useGMT" \ 793 $name-getValueCmd "mentry::getClockVal %W -gmt $useGMT" \ 794 $name-putTextCmd "" \ 795 $name-getTextCmd "%W getstring" \ 796 $name-putListCmd {eval [list %W put 0] %L} \ 797 $name-getListCmd "%W getlist" \ 798 $name-selectCmd "" \ 799 $name-invokeCmd "" \ 800 $name-fontOpt -font \ 801 $name-useFormat 0 \ 802 $name-useReqWidth 1 \ 803 $name-usePadX 1 \ 804 $name-isEntryLike 1 \ 805 $name-focusWin "" \ 806 $name-reservedKeys {Left Right Up Down Prior Next} \ 807 ] 808 809 return $name 810} 811 812#------------------------------------------------------------------------------ 813# tablelist::addFixedPointMentry 814# 815# Registers the widget created by the mentry::fixedPointMentry command from the 816# Mentry package, with a given number of characters before and a given number 817# of digits after the decimal point, with or without the -comma option, for 818# interactive cell editing. 819#------------------------------------------------------------------------------ 820proc tablelist::addFixedPointMentry {cnt1 cnt2 args} { 821 # 822 # Check the arguments cnt1 and cnt2 823 # 824 if {[catch {format %d $cnt1}] != 0 || $cnt1 <= 0} { 825 return -code error "expected positive integer but got \"$cnt1\"" 826 } 827 if {[catch {format %d $cnt2}] != 0 || $cnt2 <= 0} { 828 return -code error "expected positive integer but got \"$cnt2\"" 829 } 830 831 # 832 # Parse the remaining arguments (if any) 833 # 834 switch [llength $args] { 835 0 { 836 set useComma 0 837 set name fixedPointMentry_$cnt1.$cnt2 838 } 839 840 1 { 841 set arg [lindex $args 0] 842 if {[string compare $arg "-comma"] == 0} { 843 set useComma 1 844 set name fixedPointMentry_$cnt1,$cnt2 845 } else { 846 set useComma 0 847 set name $arg 848 } 849 } 850 851 2 { 852 set arg0 [lindex $args 0] 853 if {[string compare $arg0 "-comma"] != 0} { 854 return -code error "bad option \"$arg0\": must be -comma" 855 } 856 857 set useComma 1 858 set name [lindex $args 1] 859 } 860 861 default { 862 mwutil::wrongNumArgs "addFixedPointMentry count1 count2\ 863 ?-comma? ?name?" 864 } 865 } 866 checkEditWinName $name 867 868 array set ::tablelist::editWin [list \ 869 $name-creationCmd [list mentry::fixedPointMentry %W $cnt1 $cnt2] \ 870 $name-putValueCmd "mentry::putReal %T %W" \ 871 $name-getValueCmd "mentry::getReal %W" \ 872 $name-putTextCmd "" \ 873 $name-getTextCmd "%W getstring" \ 874 $name-putListCmd {eval [list %W put 0] %L} \ 875 $name-getListCmd "%W getlist" \ 876 $name-selectCmd "" \ 877 $name-invokeCmd "" \ 878 $name-fontOpt -font \ 879 $name-useFormat 0 \ 880 $name-useReqWidth 1 \ 881 $name-usePadX 1 \ 882 $name-isEntryLike 1 \ 883 $name-focusWin "" \ 884 $name-reservedKeys {Left Right} \ 885 ] 886 if {$useComma} { 887 lappend ::tablelist::editWin($name-creationCmd) -comma 888 } 889 890 return $name 891} 892 893#------------------------------------------------------------------------------ 894# tablelist::addIPAddrMentry 895# 896# Registers the widget created by the mentry::ipAddrMentry command from the 897# Mentry package for interactive cell editing. 898#------------------------------------------------------------------------------ 899proc tablelist::addIPAddrMentry {{name ipAddrMentry}} { 900 checkEditWinName $name 901 902 array set ::tablelist::editWin [list \ 903 $name-creationCmd "mentry::ipAddrMentry %W" \ 904 $name-putValueCmd "mentry::putIPAddr %T %W" \ 905 $name-getValueCmd "mentry::getIPAddr %W" \ 906 $name-putTextCmd "" \ 907 $name-getTextCmd "%W getstring" \ 908 $name-putListCmd {eval [list %W put 0] %L} \ 909 $name-getListCmd "%W getlist" \ 910 $name-selectCmd "" \ 911 $name-invokeCmd "" \ 912 $name-fontOpt -font \ 913 $name-useFormat 0 \ 914 $name-useReqWidth 1 \ 915 $name-usePadX 1 \ 916 $name-isEntryLike 1 \ 917 $name-focusWin "" \ 918 $name-reservedKeys {Left Right Up Down Prior Next} \ 919 ] 920 921 return $name 922} 923 924#------------------------------------------------------------------------------ 925# tablelist::addIPv6AddrMentry 926# 927# Registers the widget created by the mentry::ipv6AddrMentry command from the 928# Mentry package for interactive cell editing. 929#------------------------------------------------------------------------------ 930proc tablelist::addIPv6AddrMentry {{name ipv6AddrMentry}} { 931 checkEditWinName $name 932 933 array set ::tablelist::editWin [list \ 934 $name-creationCmd "mentry::ipv6AddrMentry %W" \ 935 $name-putValueCmd "mentry::putIPv6Addr %T %W" \ 936 $name-getValueCmd "mentry::getIPv6Addr %W" \ 937 $name-putTextCmd "" \ 938 $name-getTextCmd "%W getstring" \ 939 $name-putListCmd {eval [list %W put 0] %L} \ 940 $name-getListCmd "%W getlist" \ 941 $name-selectCmd "" \ 942 $name-invokeCmd "" \ 943 $name-fontOpt -font \ 944 $name-useFormat 0 \ 945 $name-useReqWidth 1 \ 946 $name-usePadX 1 \ 947 $name-isEntryLike 1 \ 948 $name-focusWin "" \ 949 $name-reservedKeys {Left Right Up Down Prior Next} \ 950 ] 951 952 return $name 953} 954 955# 956# Private procedures implementing the interactive cell editing 957# ============================================================ 958# 959 960#------------------------------------------------------------------------------ 961# tablelist::checkEditWinName 962# 963# Generates an error if the given edit window name is one of "entry", "text", 964# "spinbox", "checkbutton", "ttk::entry", "ttk::spinbox", "ttk::combobox", or 965# "ttk::checkbutton". 966#------------------------------------------------------------------------------ 967proc tablelist::checkEditWinName name { 968 if {[regexp {^(entry|text|spinbox|checkbutton)$} $name]} { 969 return -code error \ 970 "edit window name \"$name\" is reserved for Tk $name widgets" 971 } 972 973 if {[regexp {^ttk::(entry|spinbox|combobox|checkbutton)$} $name]} { 974 return -code error \ 975 "edit window name \"$name\" is reserved for tile $name widgets" 976 } 977} 978 979#------------------------------------------------------------------------------ 980# tablelist::createCheckbutton 981# 982# Creates a checkbutton widget with the given path name for interactive cell 983# editing in a tablelist widget. 984#------------------------------------------------------------------------------ 985proc tablelist::createCheckbutton {w args} { 986 variable winSys 987 switch $winSys { 988 x11 { 989 variable checkedImg 990 variable uncheckedImg 991 if {![info exists checkedImg]} { 992 createCheckbuttonImgs 993 } 994 995 checkbutton $w -borderwidth 2 -indicatoron 0 -image $uncheckedImg \ 996 -selectimage $checkedImg -selectcolor "" 997 if {$::tk_version >= 8.4} { 998 $w configure -offrelief sunken 999 } 1000 pack $w 1001 } 1002 1003 win32 { 1004 checkbutton $w -borderwidth 0 -font {"MS Sans Serif" 8} \ 1005 -padx 0 -pady 0 1006 [winfo parent $w] configure -width 13 -height 13 1007 place $w -x -1 -y -1 1008 } 1009 1010 classic { 1011 checkbutton $w -borderwidth 0 -font "system" -padx 0 -pady 0 1012 [winfo parent $w] configure -width 16 -height 14 1013 place $w -x 0 -y -1 1014 } 1015 1016 aqua { 1017 checkbutton $w -borderwidth 0 -font "system" -padx 0 -pady 0 1018 [winfo parent $w] configure -width 16 -height 17 1019 place $w -x -3 -y -1 1020 } 1021 } 1022 1023 foreach {opt val} $args { 1024 switch -- $opt { 1025 -font {} 1026 -state { $w configure $opt $val } 1027 } 1028 } 1029 1030 set win [getTablelistPath $w] 1031 $w configure -variable ::tablelist::ns${win}::data(editText) 1032} 1033 1034#------------------------------------------------------------------------------ 1035# tablelist::createTileEntry 1036# 1037# Creates a tile entry widget with the given path name for interactive cell 1038# editing in a tablelist widget. 1039#------------------------------------------------------------------------------ 1040proc tablelist::createTileEntry {w args} { 1041 if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { 1042 package require tile 0.6 1043 } 1044 createTileAliases 1045 1046 # 1047 # The style of the tile entry widget should have -borderwidth 1048 # 2 and -padding 1. For those themes that don't honor the 1049 # -borderwidth 2 setting, set the padding to another value. 1050 # 1051 set win [getTablelistPath $w] 1052 switch [getCurrentTheme] { 1053 aqua { 1054 set padding {0 0 0 -1} 1055 } 1056 1057 tileqt { 1058 set padding 3 1059 } 1060 1061 xpnative { 1062 switch [winfo rgb . SystemHighlight] { 1063 "12593 27242 50629" - 1064 "37779 41120 28784" - 1065 "45746 46260 49087" - 1066 "13107 39321 65535" { set padding 2 } 1067 default { set padding 1 } 1068 } 1069 } 1070 1071 default { 1072 set padding 1 1073 } 1074 } 1075 styleConfig Tablelist.TEntry -borderwidth 2 -highlightthickness 0 \ 1076 -padding $padding 1077 1078 ttk::entry $w -style Tablelist.TEntry 1079 1080 foreach {opt val} $args { 1081 $w configure $opt $val 1082 } 1083} 1084 1085#------------------------------------------------------------------------------ 1086# tablelist::createTileSpinbox 1087# 1088# Creates a tile spinbox widget with the given path name for interactive cell 1089# editing in a tablelist widget. 1090#------------------------------------------------------------------------------ 1091proc tablelist::createTileSpinbox {w args} { 1092 if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { 1093 package require tile 0.8.3 1094 } 1095 createTileAliases 1096 1097 # 1098 # The style of the tile entry widget should have -borderwidth 1099 # 2 and -padding 1. For those themes that don't honor the 1100 # -borderwidth 2 setting, set the padding to another value. 1101 # 1102 set win [getTablelistPath $w] 1103 switch [getCurrentTheme] { 1104 aqua { 1105 set padding {0 0 0 -1} 1106 } 1107 1108 tileqt { 1109 set padding 3 1110 } 1111 1112 vista { 1113 switch [winfo rgb . SystemHighlight] { 1114 "13107 39321 65535" { set padding 0 } 1115 default { set padding 1 } 1116 } 1117 } 1118 1119 xpnative { 1120 switch [winfo rgb . SystemHighlight] { 1121 "12593 27242 50629" - 1122 "37779 41120 28784" - 1123 "45746 46260 49087" - 1124 "13107 39321 65535" { set padding 2 } 1125 default { set padding 1 } 1126 } 1127 } 1128 1129 default { 1130 set padding 1 1131 } 1132 } 1133 styleConfig Tablelist.TSpinbox -borderwidth 2 -highlightthickness 0 \ 1134 -padding $padding 1135 1136 ttk::spinbox $w -style Tablelist.TSpinbox 1137 1138 foreach {opt val} $args { 1139 $w configure $opt $val 1140 } 1141} 1142 1143#------------------------------------------------------------------------------ 1144# tablelist::createTileCombobox 1145# 1146# Creates a tile combobox widget with the given path name for interactive cell 1147# editing in a tablelist widget. 1148#------------------------------------------------------------------------------ 1149proc tablelist::createTileCombobox {w args} { 1150 if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { 1151 package require tile 0.6 1152 } 1153 createTileAliases 1154 1155 set win [getTablelistPath $w] 1156 if {[string compare [getCurrentTheme] "aqua"] == 0} { 1157 styleConfig Tablelist.TCombobox -borderwidth 2 -padding {0 0 0 -1} 1158 } else { 1159 styleConfig Tablelist.TCombobox -borderwidth 2 -padding 1 1160 } 1161 1162 ttk::combobox $w -style Tablelist.TCombobox 1163 1164 foreach {opt val} $args { 1165 $w configure $opt $val 1166 } 1167} 1168 1169#------------------------------------------------------------------------------ 1170# tablelist::createTileCheckbutton 1171# 1172# Creates a tile checkbutton widget with the given path name for interactive 1173# cell editing in a tablelist widget. 1174#------------------------------------------------------------------------------ 1175proc tablelist::createTileCheckbutton {w args} { 1176 if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { 1177 package require tile 0.6 1178 } 1179 createTileAliases 1180 1181 # 1182 # Define the checkbutton layout; use catch to suppress 1183 # the error message in case the layout already exists 1184 # 1185 set currentTheme [getCurrentTheme] 1186 if {[string compare $currentTheme "aqua"] == 0} { 1187 catch { style layout Tablelist.TCheckbutton { Checkbutton.button } } 1188 } else { 1189 catch { style layout Tablelist.TCheckbutton { Checkbutton.indicator } } 1190 styleConfig Tablelist.TCheckbutton -indicatormargin 0 1191 } 1192 1193 set win [getTablelistPath $w] 1194 ttk::checkbutton $w -style Tablelist.TCheckbutton \ 1195 -variable ::tablelist::ns${win}::data(editText) 1196 1197 foreach {opt val} $args { 1198 switch -- $opt { 1199 -font {} 1200 -state { $w configure $opt $val } 1201 } 1202 } 1203 1204 # 1205 # Adjust the dimensions of the tile checkbutton's parent 1206 # and manage the checkbutton, depending on the current theme 1207 # 1208 switch $currentTheme { 1209 aqua { 1210 [winfo parent $w] configure -width 16 -height 17 1211 place $w -x -3 -y -2 1212 } 1213 1214 Aquativo { 1215 [winfo parent $w] configure -width 14 -height 14 1216 place $w -x -1 -y -1 1217 } 1218 1219 blue - 1220 vista - 1221 winxpblue { 1222 set height [winfo reqheight $w] 1223 [winfo parent $w] configure -width $height -height $height 1224 place $w -x 0 1225 } 1226 1227 keramik - 1228 keramik_alt { 1229 [winfo parent $w] configure -width 16 -height 16 1230 place $w -x -1 -y -1 1231 } 1232 1233 plastik { 1234 [winfo parent $w] configure -width 15 -height 15 1235 place $w -x -2 -y 1 1236 } 1237 1238 sriv - 1239 srivlg { 1240 [winfo parent $w] configure -width 15 -height 16 1241 place $w -x -1 1242 } 1243 1244 tileqt { 1245 switch -- [string tolower [tileqt_currentThemeName]] { 1246 acqua { 1247 [winfo parent $w] configure -width 17 -height 18 1248 place $w -x -1 -y -2 1249 } 1250 kde_xp { 1251 [winfo parent $w] configure -width 13 -height 13 1252 place $w -x 0 1253 } 1254 keramik - 1255 thinkeramik { 1256 [winfo parent $w] configure -width 16 -height 16 1257 place $w -x 0 1258 } 1259 default { 1260 set height [winfo reqheight $w] 1261 [winfo parent $w] configure -width $height -height $height 1262 place $w -x 0 1263 } 1264 } 1265 } 1266 1267 winnative { 1268 set height [winfo reqheight $w] 1269 [winfo parent $w] configure -width $height -height $height 1270 place $w -x -2 1271 } 1272 1273 xpnative { 1274 set height [winfo reqheight $w] 1275 [winfo parent $w] configure -width $height -height $height 1276 if {[info exists tile::patchlevel] && 1277 [string compare $tile::patchlevel "0.8.0"] < 0} { 1278 place $w -x -2 1279 } else { 1280 place $w -x 0 1281 } 1282 } 1283 1284 default { 1285 pack $w 1286 } 1287 } 1288} 1289 1290#------------------------------------------------------------------------------ 1291# tablelist::createIncrCombobox 1292# 1293# Creates an [incr Widgets] combobox with the given path name for interactive 1294# cell editing in a tablelist widget. 1295#------------------------------------------------------------------------------ 1296proc tablelist::createIncrCombobox {w args} { 1297 eval [list iwidgets::combobox $w -dropdown 1 -editable 1 -width 0] $args 1298 1299 # 1300 # Make sure that the entry component will receive the input focus 1301 # whenever the list component (a scrolledlistbox widget) gets unmapped 1302 # 1303 bind [$w component list] <Unmap> +[list focus [$w component entry]] 1304} 1305 1306#------------------------------------------------------------------------------ 1307# tablelist::createOakleyCombobox 1308# 1309# Creates an Oakley combobox widget with the given path name for interactive 1310# cell editing in a tablelist widget. 1311#------------------------------------------------------------------------------ 1312proc tablelist::createOakleyCombobox {w args} { 1313 eval [list combobox::combobox $w -editable 1 -width 0] $args 1314 1315 # 1316 # Repack the widget's components, to make sure that the 1317 # button will remain visible when shrinking the combobox. 1318 # This patch is needed for combobox versions earlier than 2.3. 1319 # 1320 pack forget $w.entry $w.button 1321 pack $w.button -side right -fill y -expand 0 1322 pack $w.entry -side left -fill both -expand 1 1323} 1324 1325#------------------------------------------------------------------------------ 1326# tablelist::doEditCell 1327# 1328# Processes the tablelist editcell subcommand. cmd may be an empty string, 1329# condChangeSelection, or changeSelection. charPos stands for the character 1330# position component of the index in the body text widget of the character 1331# underneath the mouse cursor if this command was invoked by clicking mouse 1332# button 1 in the body of the tablelist widget. 1333#------------------------------------------------------------------------------ 1334proc tablelist::doEditCell {win row col restore {cmd ""} {charPos -1}} { 1335 upvar ::tablelist::ns${win}::data data 1336 if {$data(isDisabled) || [doRowCget $row $win -hide] || $data($col-hide) || 1337 ![isCellEditable $win $row $col]} { 1338 return "" 1339 } 1340 if {$data(editRow) == $row && $data(editCol) == $col} { 1341 return "" 1342 } 1343 set item [lindex $data(itemList) $row] 1344 set key [lindex $item end] 1345 getIndentData $win $key $col indentWidth 1346 set pixels [colWidth $win $col -stretched] 1347 if {$indentWidth >= $pixels} { 1348 return "" 1349 } 1350 if {$data(editRow) >= 0 && ![doFinishEditing $win]} { 1351 return "" 1352 } 1353 1354 # 1355 # Create a frame to be embedded into the tablelist's body, together with 1356 # a child of column-specific type; replace the binding tag Frame with 1357 # $data(editwinTag) and TablelistEdit in the frame's list of binding tags 1358 # 1359 seeCell $win $row $col 1360 set netRowHeight [lindex [bboxSubCmd $win $row] 3] 1361 set frameHeight [expr {$netRowHeight + 6}] ;# because of the -pady -3 below 1362 set f $data(bodyFr) 1363 tk::frame $f -borderwidth 0 -container 0 -height $frameHeight \ 1364 -highlightthickness 0 -relief flat -takefocus 0 1365 catch {$f configure -padx 0 -pady 0} 1366 bindtags $f [lreplace [bindtags $f] 1 1 $data(editwinTag) TablelistEdit] 1367 bind $f <Destroy> { 1368 array set tablelist::ns[winfo parent [winfo parent %W]]::data \ 1369 {editRow -1 editCol -1} 1370 if {[catch {tk::CancelRepeat}] != 0} { 1371 tkCancelRepeat 1372 } 1373 if {[catch {ttk::CancelRepeat}] != 0} { 1374 catch {tile::CancelRepeat} 1375 } 1376 } 1377 set name [getEditWindow $win $row $col] 1378 variable editWin 1379 set creationCmd [strMap {"%W" "$w"} $editWin($name-creationCmd)] 1380 append creationCmd { $editWin($name-fontOpt) [getCellFont $win $key $col]} \ 1381 { -state normal} 1382 set w $data(bodyFrEd) 1383 if {[catch {eval $creationCmd} result] != 0} { 1384 destroy $f 1385 return -code error $result 1386 } 1387 catch {$w configure -relief ridge} 1388 catch {$w configure -highlightthickness 0} 1389 clearTakefocusOpt $w 1390 set class [winfo class $w] 1391 set isCheckbtn [string match "*Checkbutton" $class] 1392 set isText [expr {[string compare $class "Text"] == 0}] 1393 set isMentry [expr {[string compare $class "Mentry"] == 0}] 1394 if {!$isCheckbtn} { 1395 catch {$w configure -borderwidth 2} 1396 } 1397 if {$isText && $data($col-wrap) && $::tk_version >= 8.5} { 1398 $w configure -wrap word 1399 } 1400 set alignment [lindex $data(colList) [expr {2*$col + 1}]] 1401 if {!$isText && !$isMentry} { 1402 catch {$w configure -justify $alignment} 1403 } 1404 1405 # 1406 # Replace the cell's contents between the two tabs with the above frame 1407 # 1408 array set data [list editKey $key editRow $row editCol $col] 1409 findTabs $win [expr {$row + 1}] $col $col tabIdx1 tabIdx2 1410 set b $data(body) 1411 getIndentData $win $data(editKey) $data(editCol) indentWidth 1412 if {$indentWidth == 0} { 1413 set textIdx [$b index $tabIdx1+1c] 1414 } else { 1415 $b mark set editIndentMark [$b index $tabIdx1+1c] 1416 set textIdx [$b index $tabIdx1+2c] 1417 } 1418 if {$isCheckbtn} { 1419 set editIdx $textIdx 1420 $b delete $editIdx $tabIdx2 1421 } else { 1422 getAuxData $win $data(editKey) $data(editCol) auxType auxWidth 1423 if {$auxWidth == 0} { ;# no image or window 1424 set editIdx $textIdx 1425 $b delete $editIdx $tabIdx2 1426 } elseif {[string compare $alignment "right"] == 0} { 1427 $b mark set editAuxMark $tabIdx2-1c 1428 set editIdx $textIdx 1429 $b delete $editIdx $tabIdx2-1c 1430 } else { 1431 $b mark set editAuxMark $textIdx 1432 set editIdx [$b index $textIdx+1c] 1433 $b delete $editIdx $tabIdx2 1434 } 1435 } 1436 $b window create $editIdx -padx -3 -pady -3 -window $f 1437 $b mark set editMark $editIdx 1438 1439 # 1440 # Insert the binding tags $data(editwinTag) and TablelistEdit 1441 # into the list of binding tags of some components 1442 # of w, just before the respective path names 1443 # 1444 if {$isMentry} { 1445 set compList [$w entries] 1446 } else { 1447 set comp [subst [strMap {"%W" "$w"} $editWin($name-focusWin)]] 1448 set compList [list $comp] 1449 set data(editFocus) $comp 1450 } 1451 foreach comp $compList { 1452 set bindTags [bindtags $comp] 1453 set idx [lsearch -exact $bindTags $comp] 1454 bindtags $comp [linsert $bindTags $idx $data(editwinTag) TablelistEdit] 1455 } 1456 1457 # 1458 # Restore or initialize some of the edit window's data 1459 # 1460 if {$restore} { 1461 restoreEditData $win 1462 } else { 1463 # 1464 # Put the cell's contents to the edit window 1465 # 1466 set data(canceled) 0 1467 set data(invoked) 0 1468 set text [lindex $item $col] 1469 if {$editWin($name-useFormat) && [lindex $data(fmtCmdFlagList) $col]} { 1470 set text [formatElem $win $key $row $col $text] 1471 } 1472 catch { 1473 eval [strMap {"%W" "$w" "%T" "$text"} $editWin($name-putValueCmd)] 1474 } 1475 if {[string compare $data(-editstartcommand) ""] != 0} { 1476 set text [uplevel #0 $data(-editstartcommand) \ 1477 [list $win $row $col $text]] 1478 if {$data(canceled)} { 1479 return "" 1480 } 1481 catch { 1482 eval [strMap {"%W" "$w" "%T" "$text"} \ 1483 $editWin($name-putValueCmd)] 1484 } 1485 } 1486 1487 # 1488 # Save the edit window's text 1489 # 1490 set data(origEditText) \ 1491 [eval [strMap {"%W" "$w"} $editWin($name-getTextCmd)]] 1492 set data(rejected) 0 1493 1494 if {[string compare $editWin($name-getListCmd) ""] != 0 && 1495 [string compare $editWin($name-selectCmd) ""] != 0} { 1496 # 1497 # Select the edit window's item corresponding to text 1498 # 1499 set itemList [eval [strMap {"%W" "$w"} $editWin($name-getListCmd)]] 1500 if {[set idx [lsearch -exact $itemList $text]] >= 0} { 1501 eval [strMap {"%W" "$w" "%I" "$idx"} $editWin($name-selectCmd)] 1502 } 1503 } 1504 1505 # 1506 # Evaluate the optional command passed as argument 1507 # 1508 if {[string compare $cmd ""] != 0} { 1509 eval [list $cmd $win $row $col] 1510 } 1511 1512 # 1513 # Set the focus and the insertion cursor 1514 # 1515 if {$charPos >= 0} { 1516 if {$isText || !$editWin($name-isEntryLike)} { 1517 focus $w 1518 } else { 1519 set hasAuxObject [expr { 1520 [info exists data($key,$col-image)] || 1521 [info exists data($key,$col-window)]}] 1522 if {[string compare $alignment "right"] == 0} { 1523 scan $tabIdx2 "%d.%d" line tabCharIdx2 1524 if {$isMentry} { 1525 set len [string length [$w getstring]] 1526 } else { 1527 set len [$comp index end] 1528 } 1529 set number [expr {$len - $tabCharIdx2 + $charPos}] 1530 if {$hasAuxObject} { 1531 incr number 2 1532 } 1533 } else { 1534 scan $tabIdx1 "%d.%d" line tabCharIdx1 1535 set number [expr {$charPos - $tabCharIdx1 - 1}] 1536 if {$hasAuxObject} { 1537 incr number -2 1538 } 1539 } 1540 if {$isMentry} { 1541 setMentryCursor $w $number 1542 } else { 1543 focus $comp 1544 $comp icursor $number 1545 } 1546 } 1547 } else { 1548 if {$isText || $isMentry || !$editWin($name-isEntryLike)} { 1549 focus $w 1550 } else { 1551 focus $comp 1552 $comp icursor end 1553 $comp selection range 0 end 1554 } 1555 } 1556 } 1557 1558 # 1559 # Adjust the frame's height 1560 # 1561 if {$isText} { 1562 if {[string compare [$w cget -wrap] "none"] == 0 || 1563 $::tk_version < 8.5} { 1564 scan [$w index end-1c] "%d" numLines 1565 $w configure -height $numLines 1566 $f configure -height [winfo reqheight $w] 1567 } else { 1568 bind $w <Configure> { 1569 %W configure -height [%W count -displaylines 1.0 end] 1570 [winfo parent %W] configure -height [winfo reqheight %W] 1571 } 1572 } 1573 if {[info exists ::wcb::version]} { 1574 wcb::cbappend $w after insert tablelist::adjustTextHeight 1575 wcb::cbappend $w after delete tablelist::adjustTextHeight 1576 } 1577 } elseif {!$isCheckbtn} { 1578 update idletasks 1579 if {![winfo exists $win]} { ;# because of update idletasks 1580 return "" 1581 } 1582 $f configure -height [winfo reqheight $w] 1583 } 1584 1585 # 1586 # Adjust the frame's width and paddings 1587 # 1588 if {!$isCheckbtn} { 1589 place $w -relwidth 1.0 -relheight 1.0 1590 adjustEditWindow $win $pixels 1591 update idletasks 1592 if {![winfo exists $win]} { ;# because of update idletasks 1593 return "" 1594 } 1595 } 1596 1597 updateViewWhenIdle $win 1598 return "" 1599} 1600 1601#------------------------------------------------------------------------------ 1602# tablelist::doCancelEditing 1603# 1604# Processes the tablelist cancelediting subcommand. Aborts the interactive 1605# cell editing and restores the cell's contents after destroying the edit 1606# window. 1607#------------------------------------------------------------------------------ 1608proc tablelist::doCancelEditing win { 1609 upvar ::tablelist::ns${win}::data data 1610 if {[set row $data(editRow)] < 0} { 1611 return "" 1612 } 1613 set col $data(editCol) 1614 1615 # 1616 # Invoke the command specified by the -editendcommand option if needed 1617 # 1618 if {$data(-forceeditendcommand) && 1619 [string compare $data(-editendcommand) ""] != 0} { 1620 uplevel #0 $data(-editendcommand) \ 1621 [list $win $row $col $data(origEditText)] 1622 } 1623 1624 if {[winfo exists $data(bodyFr)]} { 1625 destroy $data(bodyFr) 1626 set item [lindex $data(itemList) $row] 1627 set key [lindex $item end] 1628 foreach opt {-window -image} { 1629 if {[info exists data($key,$col$opt)]} { 1630 doCellConfig $row $col $win $opt $data($key,$col$opt) 1631 break 1632 } 1633 } 1634 doCellConfig $row $col $win -text [lindex $item $col] 1635 } 1636 1637 focus $data(body) 1638 set data(canceled) 1 1639 event generate $win <<TablelistCellRestored>> 1640 1641 updateViewWhenIdle $win 1642 return "" 1643} 1644 1645#------------------------------------------------------------------------------ 1646# tablelist::doFinishEditing 1647# 1648# Processes the tablelist finishediting subcommand. Invokes the command 1649# specified by the -editendcommand option if needed, and updates the element 1650# just edited after destroying the edit window if the latter's content was not 1651# rejected. Returns 1 on normal termination and 0 otherwise. 1652#------------------------------------------------------------------------------ 1653proc tablelist::doFinishEditing win { 1654 upvar ::tablelist::ns${win}::data data 1655 if {[set row $data(editRow)] < 0} { 1656 return 1 1657 } 1658 set col $data(editCol) 1659 1660 # 1661 # Get the edit window's text, and invoke the command 1662 # specified by the -editendcommand option if needed 1663 # 1664 set w $data(bodyFrEd) 1665 set name [getEditWindow $win $row $col] 1666 variable editWin 1667 set text [eval [strMap {"%W" "$w"} $editWin($name-getTextCmd)]] 1668 set item [lindex $data(itemList) $row] 1669 if {!$data(-forceeditendcommand) && 1670 [string compare $text $data(origEditText)] == 0} { 1671 set text [lindex $item $col] 1672 } else { 1673 if {[catch { 1674 eval [strMap {"%W" "$w"} $editWin($name-getValueCmd)] 1675 } text] != 0} { 1676 set data(rejected) 1 1677 } 1678 if {[string compare $data(-editendcommand) ""] != 0} { 1679 set text \ 1680 [uplevel #0 $data(-editendcommand) [list $win $row $col $text]] 1681 } 1682 } 1683 1684 # 1685 # Check whether the input was rejected (by the above "set data(rejected) 1" 1686 # statement or within the command specified by the -editendcommand option) 1687 # 1688 if {$data(rejected)} { 1689 if {[winfo exists $data(bodyFr)]} { 1690 seeCell $win $row $col 1691 if {[string compare [winfo class $w] "Mentry"] != 0} { 1692 focus $data(editFocus) 1693 } 1694 } else { 1695 focus $data(body) 1696 } 1697 1698 set data(rejected) 0 1699 set result 0 1700 } else { 1701 if {[winfo exists $data(bodyFr)]} { 1702 destroy $data(bodyFr) 1703 set key [lindex $item end] 1704 foreach opt {-window -image} { 1705 if {[info exists data($key,$col$opt)]} { 1706 doCellConfig $row $col $win $opt $data($key,$col$opt) 1707 break 1708 } 1709 } 1710 doCellConfig $row $col $win -text $text 1711 set result 1 1712 } else { 1713 set result 0 1714 } 1715 1716 focus $data(body) 1717 event generate $win <<TablelistCellUpdated>> 1718 } 1719 1720 update idletasks 1721 if {![winfo exists $win]} { ;# because of update idletasks 1722 return 0 1723 } 1724 1725 updateViewWhenIdle $win 1726 return $result 1727} 1728 1729#------------------------------------------------------------------------------ 1730# tablelist::clearTakefocusOpt 1731# 1732# Sets the -takefocus option of all members of the widget hierarchy starting 1733# with w to 0. 1734#------------------------------------------------------------------------------ 1735proc tablelist::clearTakefocusOpt w { 1736 catch {$w configure -takefocus 0} 1737 foreach c [winfo children $w] { 1738 clearTakefocusOpt $c 1739 } 1740} 1741 1742#------------------------------------------------------------------------------ 1743# tablelist::adjustTextHeight 1744# 1745# This procedure is an after-insert and after-delete callback asociated with a 1746# text widget used for interactive cell editing. It sets the height of the 1747# edit window to the number of lines currently contained in it. 1748#------------------------------------------------------------------------------ 1749proc tablelist::adjustTextHeight {w args} { 1750 if {$::tk_version < 8.5} { 1751 # 1752 # We can only count the logical lines (irrespective of wrapping) 1753 # 1754 scan [$w index end-1c] "%d" numLines 1755 } else { 1756 # 1757 # Count the display lines (taking into account the line wraps) 1758 # 1759 set numLines [$w count -displaylines 1.0 end] 1760 } 1761 $w configure -height $numLines 1762 1763 set path [wcb::pathname $w] 1764 [winfo parent $path] configure -height [winfo reqheight $path] 1765} 1766 1767#------------------------------------------------------------------------------ 1768# tablelist::setMentryCursor 1769# 1770# Sets the focus to the entry child of the mentry widget w that contains the 1771# global character position specified by number, and sets the insertion cursor 1772# in that entry to the relative character position corresponding to number. If 1773# that entry is not enabled then the procedure sets the focus to the last 1774# enabled entry child preceding the found one and sets the insertion cursor to 1775# its end. 1776#------------------------------------------------------------------------------ 1777proc tablelist::setMentryCursor {w number} { 1778 # 1779 # Find the entry child containing the given character 1780 # position; if the latter is contained in a label child 1781 # then take the entry immediately preceding that label 1782 # 1783 set entryIdx -1 1784 set childIdx 0 1785 set childCount [llength [$w cget -body]] 1786 foreach c [winfo children $w] { 1787 set class [winfo class $c] 1788 switch $class { 1789 Entry { 1790 set str [$c get] 1791 set entry $c 1792 incr entryIdx 1793 } 1794 Frame { 1795 set str [$c.e get] 1796 set entry $c.e 1797 incr entryIdx 1798 } 1799 Label { set str [$c cget -text] } 1800 } 1801 set len [string length $str] 1802 1803 if {$number < $len} { 1804 break 1805 } elseif {$childIdx < $childCount - 1} { 1806 incr number -$len 1807 } 1808 1809 incr childIdx 1810 } 1811 1812 # 1813 # If the entry's state is normal then set the focus to this entry and 1814 # the insertion cursor to the relative character position corresponding 1815 # to number; otherwise set the focus to the last enabled entry child 1816 # preceding the found one and set the insertion cursor to its end 1817 # 1818 switch $class { 1819 Entry - 1820 Frame { set relIdx $number } 1821 Label { set relIdx end } 1822 } 1823 if {[string compare [$entry cget -state] "normal"] == 0} { 1824 focus $entry 1825 $entry icursor $relIdx 1826 } else { 1827 for {incr entryIdx -1} {$entryIdx >= 0} {incr entryIdx -1} { 1828 set entry [$w entrypath $entryIdx] 1829 if {[string compare [$entry cget -state] "normal"] == 0} { 1830 focus $entry 1831 $entry icursor end 1832 return "" 1833 } 1834 } 1835 } 1836} 1837 1838#------------------------------------------------------------------------------ 1839# tablelist::adjustEditWindow 1840# 1841# Adjusts the width and the horizontal padding of the frame containing the edit 1842# window associated with the tablelist widget win. 1843#------------------------------------------------------------------------------ 1844proc tablelist::adjustEditWindow {win pixels} { 1845 # 1846 # Adjust the width of the auxiliary object (if any) 1847 # 1848 upvar ::tablelist::ns${win}::data data 1849 set indent [getIndentData $win $data(editKey) $data(editCol) indentWidth] 1850 set aux [getAuxData $win $data(editKey) $data(editCol) auxType auxWidth] 1851 if {$indentWidth >= $pixels} { 1852 set indentWidth $pixels 1853 set pixels 0 1854 set auxWidth 0 1855 } else { 1856 incr pixels -$indentWidth 1857 if {$auxWidth != 0} { ;# image or window 1858 if {$auxWidth + 5 <= $pixels} { 1859 incr auxWidth 5 1860 incr pixels -$auxWidth 1861 } elseif {$auxWidth <= $pixels} { 1862 set pixels 0 1863 } else { 1864 set auxWidth $pixels 1865 set pixels 0 1866 } 1867 } 1868 } 1869 1870 if {$indentWidth != 0} { 1871 insertOrUpdateIndent $data(body) editIndentMark $indent $indentWidth 1872 } 1873 if {$auxWidth != 0} { 1874 if {$auxType == 1} { ;# image 1875 setImgLabelWidth $data(body) editAuxMark $auxWidth 1876 } else { ;# window 1877 if {[winfo exists $aux] && [$aux cget -width] != $auxWidth} { 1878 $aux configure -width $auxWidth 1879 } 1880 } 1881 } 1882 1883 # 1884 # Compute an appropriate width and horizontal 1885 # padding for the frame containing the edit window 1886 # 1887 set name [getEditWindow $win $data(editRow) $data(editCol)] 1888 variable editWin 1889 if {$editWin($name-useReqWidth) && 1890 [set reqWidth [winfo reqwidth $data(bodyFrEd)]] <= 1891 $pixels + 2*$data(charWidth)} { 1892 set width $reqWidth 1893 set padX [expr {$reqWidth <= $pixels ? -3 : ($pixels - $reqWidth) / 2}] 1894 } else { 1895 if {$editWin($name-usePadX)} { 1896 set amount $data(charWidth) 1897 } else { 1898 switch -- $name { 1899 text { set amount 4 } 1900 ttk::entry { 1901 if {[string compare [getCurrentTheme] "aqua"] == 0} { 1902 set amount 5 1903 } else { 1904 set amount 3 1905 } 1906 } 1907 default { set amount 3 } 1908 } 1909 } 1910 set width [expr {$pixels + 2*$amount}] 1911 set padX -$amount 1912 } 1913 1914 $data(bodyFr) configure -width $width 1915 $data(body) window configure editMark -padx $padX 1916} 1917 1918#------------------------------------------------------------------------------ 1919# tablelist::setEditWinFont 1920# 1921# Sets the font of the edit window associated with the tablelist widget win to 1922# that of the cell currently being edited. 1923#------------------------------------------------------------------------------ 1924proc tablelist::setEditWinFont win { 1925 upvar ::tablelist::ns${win}::data data 1926 set name [getEditWindow $win $data(editRow) $data(editCol)] 1927 variable editWin 1928 if {[string compare $editWin($name-fontOpt) ""] == 0} { 1929 return "" 1930 } 1931 1932 set key [lindex $data(keyList) $data(editRow)] 1933 set cellFont [getCellFont $win $key $data(editCol)] 1934 $data(bodyFrEd) configure $editWin($name-fontOpt) $cellFont 1935 1936 $data(bodyFr) configure -height [winfo reqheight $data(bodyFrEd)] 1937} 1938 1939#------------------------------------------------------------------------------ 1940# tablelist::saveEditData 1941# 1942# Saves some data of the edit window associated with the tablelist widget win. 1943#------------------------------------------------------------------------------ 1944proc tablelist::saveEditData win { 1945 upvar ::tablelist::ns${win}::data data 1946 set w $data(bodyFrEd) 1947 set entry $data(editFocus) 1948 set class [winfo class $w] 1949 set isText [expr {[string compare $class "Text"] == 0}] 1950 set isMentry [expr {[string compare $class "Mentry"] == 0}] 1951 1952 # 1953 # Miscellaneous data 1954 # 1955 set name [getEditWindow $win $data(editRow) $data(editCol)] 1956 variable editWin 1957 set data(editText) [eval [strMap {"%W" "$w"} $editWin($name-getTextCmd)]] 1958 if {[string compare $editWin($name-getListCmd) ""] != 0} { 1959 set data(editList) \ 1960 [eval [strMap {"%W" "$w"} $editWin($name-getListCmd)]] 1961 } 1962 if {$isText} { 1963 set data(editPos) [$w index insert] 1964 set data(textSelRanges) [$w tag ranges sel] 1965 } elseif {$editWin($name-isEntryLike)} { 1966 set data(editPos) [$entry index insert] 1967 if {[set data(entryHadSel) [$entry selection present]]} { 1968 set data(entrySelFrom) [$entry index sel.first] 1969 set data(entrySelTo) [$entry index sel.last] 1970 } 1971 } 1972 set data(editHadFocus) \ 1973 [expr {[string compare [focus -lastfor $entry] $entry] == 0}] 1974 1975 # 1976 # Configuration options and widget callbacks 1977 # 1978 saveEditConfigOpts $w 1979 if {[info exists ::wcb::version] && 1980 $editWin($name-isEntryLike) && !$isMentry} { 1981 set wcbOptList {insert delete motion} 1982 if {$isText} { 1983 lappend wcbOptList selset selclear 1984 if {$::wcb::version >= 3.2} { 1985 lappend wcbOptList replace 1986 } 1987 } 1988 foreach when {before after} { 1989 foreach opt $wcbOptList { 1990 set data(entryCb-$when-$opt) \ 1991 [::wcb::callback $entry $when $opt] 1992 } 1993 } 1994 } 1995} 1996 1997#------------------------------------------------------------------------------ 1998# tablelist::saveEditConfigOpts 1999# 2000# Saves the non-default values of the configuration options of the edit window 2001# w associated with a tablelist widget, as well as those of its descendants. 2002#------------------------------------------------------------------------------ 2003proc tablelist::saveEditConfigOpts w { 2004 regexp {^(.+)\.body\.f\.(e.*)$} $w dummy win tail 2005 upvar ::tablelist::ns${win}::data data 2006 2007 foreach configSet [$w configure] { 2008 if {[llength $configSet] != 2} { 2009 set default [lindex $configSet 3] 2010 set current [lindex $configSet 4] 2011 if {[string compare $default $current] != 0} { 2012 set opt [lindex $configSet 0] 2013 set data($tail$opt) $current 2014 } 2015 } 2016 } 2017 2018 foreach c [winfo children $w] { 2019 saveEditConfigOpts $c 2020 } 2021} 2022 2023#------------------------------------------------------------------------------ 2024# tablelist::restoreEditData 2025# 2026# Restores some data of the edit window associated with the tablelist widget 2027# win. 2028#------------------------------------------------------------------------------ 2029proc tablelist::restoreEditData win { 2030 upvar ::tablelist::ns${win}::data data 2031 set w $data(bodyFrEd) 2032 set entry $data(editFocus) 2033 set class [winfo class $w] 2034 set isText [expr {[string compare $class "Text"] == 0}] 2035 set isMentry [expr {[string compare $class "Mentry"] == 0}] 2036 set isIncrDateTimeWidget [regexp {^(Date.+|Time.+)$} $class] 2037 2038 # 2039 # Miscellaneous data 2040 # 2041 set name [getEditWindow $win $data(editRow) $data(editCol)] 2042 variable editWin 2043 if {[string compare $editWin($name-putTextCmd) ""] != 0} { 2044 eval [strMap {"%W" "$w" "%T" "$data(editText)"} \ 2045 $editWin($name-putTextCmd)] 2046 } 2047 if {[string compare $editWin($name-putListCmd) ""] != 0 && 2048 [string compare $data(editList) ""] != 0} { 2049 eval [strMap {"%W" "$w" "%L" "$data(editList)"} \ 2050 $editWin($name-putListCmd)] 2051 } 2052 if {[string compare $editWin($name-selectCmd) ""] != 0 && 2053 [set idx [lsearch -exact $data(editList) $data(editText)]] >= 0} { 2054 eval [strMap {"%W" "$w" "%I" "$idx"} $editWin($name-selectCmd)] 2055 } 2056 if {$isText} { 2057 $w mark set insert $data(editPos) 2058 if {[llength $data(textSelRanges)] != 0} { 2059 eval [list $w tag add sel] $data(textSelRanges) 2060 } 2061 } elseif {$editWin($name-isEntryLike)} { 2062 $entry icursor $data(editPos) 2063 if {$data(entryHadSel)} { 2064 $entry selection range $data(entrySelFrom) $data(entrySelTo) 2065 } 2066 } 2067 if {$data(editHadFocus)} { 2068 focus $entry 2069 } 2070 2071 # 2072 # Configuration options and widget callbacks 2073 # 2074 restoreEditConfigOpts $w 2075 if {[info exists ::wcb::version] && 2076 $editWin($name-isEntryLike) && !$isMentry} { 2077 set wcbOptList {insert delete motion} 2078 if {$isText} { 2079 lappend wcbOptList selset selclear 2080 if {$::wcb::version >= 3.2} { 2081 lappend wcbOptList replace 2082 } 2083 } 2084 foreach when {before after} { 2085 foreach opt $wcbOptList { 2086 eval [list ::wcb::callback $entry $when $opt] \ 2087 $data(entryCb-$when-$opt) 2088 } 2089 } 2090 } 2091 2092 # 2093 # If the edit window is a datefield, dateentry, timefield, or timeentry 2094 # widget then restore its text here, because otherwise it would be 2095 # overridden when the above invocation of restoreEditConfigOpts sets 2096 # the widget's -format option. Note that this is a special case; in 2097 # general we must restore the text BEFORE the configuration options. 2098 # 2099 if {$isIncrDateTimeWidget} { 2100 eval [strMap {"%W" "$w" "%T" "$data(editText)"} \ 2101 $editWin($name-putTextCmd)] 2102 } 2103} 2104 2105#------------------------------------------------------------------------------ 2106# tablelist::restoreEditConfigOpts 2107# 2108# Restores the non-default values of the configuration options of the edit 2109# window w associated with a tablelist widget, as well as those of its 2110# descendants. 2111#------------------------------------------------------------------------------ 2112proc tablelist::restoreEditConfigOpts w { 2113 regexp {^(.+)\.body\.f\.(e.*)$} $w dummy win tail 2114 upvar ::tablelist::ns${win}::data data 2115 set isMentry [expr {[string compare [winfo class $w] "Mentry"] == 0}] 2116 2117 foreach name [array names data $tail-*] { 2118 set opt [string range $name [string last "-" $name] end] 2119 if {!$isMentry || [string compare $opt "-body"] != 0} { 2120 $w configure $opt $data($name) 2121 } 2122 unset data($name) 2123 } 2124 2125 foreach c [winfo children $w] { 2126 restoreEditConfigOpts $c 2127 } 2128} 2129 2130# 2131# Private procedures used in bindings related to interactive cell editing 2132# ======================================================================= 2133# 2134 2135#------------------------------------------------------------------------------ 2136# tablelist::defineTablelistEdit 2137# 2138# Defines the bindings for the binding tag TablelistEdit. 2139#------------------------------------------------------------------------------ 2140proc tablelist::defineTablelistEdit {} { 2141 # 2142 # Get the supported modifier keys in the set {Alt, Meta, Command} on 2143 # the current windowing system ("x11", "win32", "classic", or "aqua") 2144 # 2145 variable winSys 2146 switch $winSys { 2147 x11 { set modList {Alt Meta} } 2148 win32 { set modList {Alt} } 2149 classic - 2150 aqua { set modList {Command} } 2151 } 2152 2153 # 2154 # Define some bindings for the binding tag TablelistEdit 2155 # 2156 bind TablelistEdit <Button-1> { 2157 # 2158 # Very short left-clicks on the tablelist's body are sometimes 2159 # unexpectedly propagated to the edit window just created - make 2160 # sure they won't be handled by the latter's default bindings 2161 # 2162 if {%t - $tablelist::priv(releaseTime) < 100} { 2163 break 2164 } 2165 2166 set tablelist::priv(clicked) 1 2167 set tablelist::priv(clickedInEditWin) 1 2168 focus %W 2169 } 2170 bind TablelistEdit <ButtonRelease-1> { 2171 if {%t != 0} { ;# i.e., no generated event 2172 foreach {tablelist::W tablelist::x tablelist::y} \ 2173 [tablelist::convEventFields %W %x %y] {} 2174 2175 set tablelist::priv(x) "" 2176 set tablelist::priv(y) "" 2177 set tablelist::priv(clicked) 0 2178 after cancel $tablelist::priv(afterId) 2179 set tablelist::priv(afterId) "" 2180 set tablelist::priv(releaseTime) %t 2181 set tablelist::priv(releasedInEditWin) 1 2182 if {%t - $tablelist::priv(clickTime) < 300} { 2183 tablelist::moveOrActivate $tablelist::W \ 2184 $tablelist::priv(row) $tablelist::priv(col) 2185 } else { 2186 tablelist::moveOrActivate $tablelist::W \ 2187 [$tablelist::W nearest $tablelist::y] \ 2188 [$tablelist::W nearestcolumn $tablelist::x] 2189 } 2190 after 100 [list tablelist::condEvalInvokeCmd $tablelist::W] 2191 } 2192 } 2193 bind TablelistEdit <Control-i> { tablelist::insertChar %W "\t" } 2194 bind TablelistEdit <Control-j> { tablelist::insertChar %W "\n" } 2195 bind TablelistEdit <Escape> { tablelist::cancelEditing %W } 2196 foreach key {Return KP_Enter} { 2197 bind TablelistEdit <$key> { 2198 if {[string compare [winfo class %W] "Text"] == 0} { 2199 tablelist::insertChar %W "\n" 2200 } else { 2201 tablelist::finishEditing %W 2202 } 2203 } 2204 bind TablelistEdit <Control-$key> { 2205 tablelist::finishEditing %W 2206 } 2207 } 2208 bind TablelistEdit <Tab> { tablelist::goToNextPrevCell %W 1 } 2209 bind TablelistEdit <Shift-Tab> { tablelist::goToNextPrevCell %W -1 } 2210 bind TablelistEdit <<PrevWindow>> { tablelist::goToNextPrevCell %W -1 } 2211 foreach modifier $modList { 2212 bind TablelistEdit <$modifier-Left> { 2213 tablelist::goLeftRight %W -1 2214 } 2215 bind TablelistEdit <$modifier-Right> { 2216 tablelist::goLeftRight %W 1 2217 } 2218 bind TablelistEdit <$modifier-Up> { 2219 tablelist::goUpDown %W -1 2220 } 2221 bind TablelistEdit <$modifier-Down> { 2222 tablelist::goUpDown %W 1 2223 } 2224 bind TablelistEdit <$modifier-Prior> { 2225 tablelist::goToPriorNextPage %W -1 2226 } 2227 bind TablelistEdit <$modifier-Next> { 2228 tablelist::goToPriorNextPage %W 1 2229 } 2230 bind TablelistEdit <$modifier-Home> { 2231 tablelist::goToNextPrevCell %W 1 0 -1 2232 } 2233 bind TablelistEdit <$modifier-End> { 2234 tablelist::goToNextPrevCell %W -1 0 0 2235 } 2236 } 2237 foreach direction {Left Right} amount {-1 1} { 2238 bind TablelistEdit <$direction> [format { 2239 if {![tablelist::isKeyReserved %%W %%K]} { 2240 tablelist::goLeftRight %%W %d 2241 } 2242 } $amount] 2243 } 2244 foreach direction {Up Down} amount {-1 1} { 2245 bind TablelistEdit <$direction> [format { 2246 if {![tablelist::isKeyReserved %%W %%K]} { 2247 tablelist::goUpDown %%W %d 2248 } 2249 } $amount] 2250 } 2251 foreach page {Prior Next} amount {-1 1} { 2252 bind TablelistEdit <$page> [format { 2253 if {![tablelist::isKeyReserved %%W %%K]} { 2254 tablelist::goToPriorNextPage %%W %d 2255 } 2256 } $amount] 2257 } 2258 bind TablelistEdit <Control-Home> { 2259 if {![tablelist::isKeyReserved %W Control-Home]} { 2260 tablelist::goToNextPrevCell %W 1 0 -1 2261 } 2262 } 2263 bind TablelistEdit <Control-End> { 2264 if {![tablelist::isKeyReserved %W Control-End]} { 2265 tablelist::goToNextPrevCell %W -1 0 0 2266 } 2267 } 2268 foreach pattern {Tab Shift-Tab ISO_Left_Tab hpBackTab} { 2269 catch { 2270 foreach modifier {Control Meta} { 2271 bind TablelistEdit <$modifier-$pattern> [format { 2272 mwutil::processTraversal %%W Tablelist <%s> 2273 } $pattern] 2274 } 2275 } 2276 } 2277 bind TablelistEdit <FocusIn> { 2278 set tablelist::W [tablelist::getTablelistPath %W] 2279 set tablelist::ns${tablelist::W}::data(editFocus) %W 2280 } 2281 2282 # 2283 # Define some emacs-like key bindings for the binding tag TablelistEdit 2284 # 2285 foreach pattern {Meta-b Meta-f} amount {-1 1} { 2286 bind TablelistEdit <$pattern> [format { 2287 if {!$tk_strictMotif && ![tablelist::isKeyReserved %%W %s]} { 2288 tablelist::goLeftRight %%W %d 2289 } 2290 } $pattern $amount] 2291 } 2292 foreach pattern {Control-p Control-n} amount {-1 1} { 2293 bind TablelistEdit <$pattern> [format { 2294 if {!$tk_strictMotif && ![tablelist::isKeyReserved %%W %s]} { 2295 tablelist::goUpDown %%W %d 2296 } 2297 } $pattern $amount] 2298 } 2299 bind TablelistEdit <Meta-less> { 2300 if {!$tk_strictMotif && 2301 ![tablelist::isKeyReserved %W Meta-less]} { 2302 tablelist::goToNextPrevCell %W 1 0 -1 2303 } 2304 } 2305 bind TablelistEdit <Meta-greater> { 2306 if {!$tk_strictMotif && 2307 ![tablelist::isKeyReserved %W Meta-greater]} { 2308 tablelist::goToNextPrevCell %W -1 0 0 2309 } 2310 } 2311 2312 # 2313 # Define some bindings for the binding tag TablelistEdit that 2314 # propagate the mousewheel events to the tablelist's body 2315 # 2316 catch { 2317 bind TablelistEdit <MouseWheel> { 2318 if {![tablelist::hasMouseWheelBindings %W] && 2319 ![tablelist::isComboTopMapped %W]} { 2320 tablelist::genMouseWheelEvent \ 2321 [[tablelist::getTablelistPath %W] bodypath] %D 2322 } 2323 } 2324 bind TablelistEdit <Option-MouseWheel> { 2325 if {![tablelist::hasMouseWheelBindings %W] && 2326 ![tablelist::isComboTopMapped %W]} { 2327 tablelist::genOptionMouseWheelEvent \ 2328 [[tablelist::getTablelistPath %W] bodypath] %D 2329 } 2330 } 2331 } 2332 foreach detail {4 5} { 2333 bind TablelistEdit <Button-$detail> [format { 2334 if {![tablelist::hasMouseWheelBindings %%W] && 2335 ![tablelist::isComboTopMapped %%W]} { 2336 event generate \ 2337 [[tablelist::getTablelistPath %%W] bodypath] <Button-%s> 2338 } 2339 } $detail] 2340 } 2341} 2342 2343#------------------------------------------------------------------------------ 2344# tablelist::insertChar 2345# 2346# Inserts the string str ("\t" or "\n") into the entry-like widget w at the 2347# point of the insertion cursor. 2348#------------------------------------------------------------------------------ 2349proc tablelist::insertChar {w str} { 2350 set class [winfo class $w] 2351 if {[string compare $class "Text"] == 0} { 2352 if {[string compare $str "\n"] == 0} { 2353 eval [strMap {"%W" "$w"} [bind Text <Return>]] 2354 } else { 2355 eval [strMap {"%W" "$w"} [bind Text <Control-i>]] 2356 } 2357 return -code break "" 2358 } elseif {[regexp {^(T?Entry|TCombobox|T?Spinbox)$} $class]} { 2359 if {[string match "T*" $class]} { 2360 if {[string compare [info procs "::ttk::entry::Insert"] ""] != 0} { 2361 ttk::entry::Insert $w $str 2362 } else { 2363 tile::entry::Insert $w $str 2364 } 2365 } elseif {[string compare [info procs "::tk::EntryInsert"] ""] != 0} { 2366 tk::EntryInsert $w $str 2367 } else { 2368 tkEntryInsert $w $str 2369 } 2370 return -code break "" 2371 } 2372} 2373 2374#------------------------------------------------------------------------------ 2375# tablelist::cancelEditing 2376# 2377# Invokes the doCancelEditing procedure. 2378#------------------------------------------------------------------------------ 2379proc tablelist::cancelEditing w { 2380 if {[isComboTopMapped $w]} { 2381 return "" 2382 } 2383 2384 set win [getTablelistPath $w] 2385 upvar ::tablelist::ns${win}::data data 2386 if {[info exists data(sourceRow)]} { ;# move operation in progress 2387 return "" 2388 } 2389 2390 doCancelEditing $win 2391 return -code break "" 2392} 2393 2394#------------------------------------------------------------------------------ 2395# tablelist::finishEditing 2396# 2397# Invokes the doFinishEditing procedure. 2398#------------------------------------------------------------------------------ 2399proc tablelist::finishEditing w { 2400 if {[isComboTopMapped $w]} { 2401 return "" 2402 } 2403 2404 doFinishEditing [getTablelistPath $w] 2405 return -code break "" 2406} 2407 2408#------------------------------------------------------------------------------ 2409# tablelist::goToNextPrevCell 2410# 2411# Moves the edit window into the next or previous editable cell different from 2412# the one indicated by the given row and column, if there is such a cell. 2413#------------------------------------------------------------------------------ 2414proc tablelist::goToNextPrevCell {w amount args} { 2415 if {[isComboTopMapped $w]} { 2416 return "" 2417 } 2418 2419 set win [getTablelistPath $w] 2420 upvar ::tablelist::ns${win}::data data 2421 2422 if {[llength $args] == 0} { 2423 set row $data(editRow) 2424 set col $data(editCol) 2425 set cmd condChangeSelection 2426 } else { 2427 foreach {row col} $args {} 2428 set cmd changeSelection 2429 } 2430 2431 set oldRow $row 2432 set oldCol $col 2433 2434 while 1 { 2435 incr col $amount 2436 if {$col < 0} { 2437 incr row $amount 2438 if {$row < 0} { 2439 set row $data(lastRow) 2440 } 2441 set col $data(lastCol) 2442 } elseif {$col > $data(lastCol)} { 2443 incr row $amount 2444 if {$row > $data(lastRow)} { 2445 set row 0 2446 } 2447 set col 0 2448 } 2449 2450 if {$row == $oldRow && $col == $oldCol} { 2451 return -code break "" 2452 } elseif {![doRowCget $row $win -hide] && !$data($col-hide) && 2453 [isCellEditable $win $row $col]} { 2454 doEditCell $win $row $col 0 $cmd 2455 return -code break "" 2456 } 2457 } 2458} 2459 2460#------------------------------------------------------------------------------ 2461# tablelist::goLeftRight 2462# 2463# Moves the edit window into the previous or next editable cell of the current 2464# row if the cell being edited is not the first/last editable one within that 2465# row. 2466#------------------------------------------------------------------------------ 2467proc tablelist::goLeftRight {w amount} { 2468 if {[isComboTopMapped $w]} { 2469 return "" 2470 } 2471 2472 set win [getTablelistPath $w] 2473 upvar ::tablelist::ns${win}::data data 2474 2475 set row $data(editRow) 2476 set col $data(editCol) 2477 2478 while 1 { 2479 incr col $amount 2480 if {$col < 0 || $col > $data(lastCol)} { 2481 return -code break "" 2482 } elseif {!$data($col-hide) && [isCellEditable $win $row $col]} { 2483 doEditCell $win $row $col 0 condChangeSelection 2484 return -code break "" 2485 } 2486 } 2487} 2488 2489#------------------------------------------------------------------------------ 2490# tablelist::goUpDown 2491# 2492# Invokes the goToPrevNextLine procedure. 2493#------------------------------------------------------------------------------ 2494proc tablelist::goUpDown {w amount} { 2495 if {[isComboTopMapped $w]} { 2496 return "" 2497 } 2498 2499 set win [getTablelistPath $w] 2500 upvar ::tablelist::ns${win}::data data 2501 2502 goToPrevNextLine $w $amount $data(editRow) $data(editCol) \ 2503 condChangeSelection 2504 return -code break "" 2505} 2506 2507#------------------------------------------------------------------------------ 2508# tablelist::goToPrevNextLine 2509# 2510# Moves the edit window into the last or first editable cell that is located in 2511# the specified column and has a row index less/greater than the given one, if 2512# there is such a cell. 2513#------------------------------------------------------------------------------ 2514proc tablelist::goToPrevNextLine {w amount row col cmd} { 2515 set win [getTablelistPath $w] 2516 upvar ::tablelist::ns${win}::data data 2517 2518 while 1 { 2519 incr row $amount 2520 if {$row < 0 || $row > $data(lastRow)} { 2521 return 0 2522 } elseif {![doRowCget $row $win -hide] && 2523 [isCellEditable $win $row $col]} { 2524 doEditCell $win $row $col 0 $cmd 2525 return 1 2526 } 2527 } 2528} 2529 2530#------------------------------------------------------------------------------ 2531# tablelist::goToPriorNextPage 2532# 2533# Moves the edit window up or down by one page within the current column if the 2534# cell being edited is not the first/last editable one within that column. 2535#------------------------------------------------------------------------------ 2536proc tablelist::goToPriorNextPage {w amount} { 2537 if {[isComboTopMapped $w]} { 2538 return "" 2539 } 2540 2541 set win [getTablelistPath $w] 2542 upvar ::tablelist::ns${win}::data data 2543 2544 # 2545 # Check whether there is any non-hidden editable cell 2546 # above/below the current one, in the same column 2547 # 2548 set row $data(editRow) 2549 set col $data(editCol) 2550 while 1 { 2551 incr row $amount 2552 if {$row < 0 || $row > $data(lastRow)} { 2553 return -code break "" 2554 } elseif {![doRowCget $row $win -hide] && 2555 [isCellEditable $win $row $col]} { 2556 break 2557 } 2558 } 2559 2560 # 2561 # Scroll up/down the view by one page and get the corresponding row index 2562 # 2563 set row $data(editRow) 2564 seeRow $win $row 2565 set bbox [bboxSubCmd $win $row] 2566 yviewSubCmd $win [list scroll $amount pages] 2567 set newRow [rowIndex $win @0,[lindex $bbox 1] 0] 2568 2569 if {$amount < 0} { 2570 if {$newRow < $row} { 2571 if {![goToPrevNextLine $w -1 [expr {$newRow + 1}] $col \ 2572 changeSelection]} { 2573 goToPrevNextLine $w 1 $newRow $col changeSelection 2574 } 2575 } else { 2576 goToPrevNextLine $w 1 -1 $col changeSelection 2577 } 2578 } else { 2579 if {$newRow > $row} { 2580 if {![goToPrevNextLine $w 1 [expr {$newRow - 1}] $col \ 2581 changeSelection]} { 2582 goToPrevNextLine $w -1 $newRow $col changeSelection 2583 } 2584 } else { 2585 goToPrevNextLine $w -1 $data(itemCount) $col changeSelection 2586 } 2587 } 2588 2589 return -code break "" 2590} 2591 2592#------------------------------------------------------------------------------ 2593# tablelist::genMouseWheelEvent 2594# 2595# Generates a <MouseWheel> event with the given delta on the widget w. 2596#------------------------------------------------------------------------------ 2597proc tablelist::genMouseWheelEvent {w delta} { 2598 set focus [focus -displayof $w] 2599 focus $w 2600 event generate $w <MouseWheel> -delta $delta 2601 focus $focus 2602} 2603 2604#------------------------------------------------------------------------------ 2605# tablelist::genOptionMouseWheelEvent 2606# 2607# Generates an <Option-MouseWheel> event with the given delta on the widget w. 2608#------------------------------------------------------------------------------ 2609proc tablelist::genOptionMouseWheelEvent {w delta} { 2610 set focus [focus -displayof $w] 2611 focus $w 2612 event generate $w <Option-MouseWheel> -delta $delta 2613 focus $focus 2614} 2615 2616#------------------------------------------------------------------------------ 2617# tablelist::isKeyReserved 2618# 2619# Checks whether the given keysym is used in the standard binding scripts 2620# associated with the widget w, which is assumed to be the edit window or one 2621# of its descendants. 2622#------------------------------------------------------------------------------ 2623proc tablelist::isKeyReserved {w keySym} { 2624 set win [getTablelistPath $w] 2625 upvar ::tablelist::ns${win}::data data 2626 2627 set name [getEditWindow $win $data(editRow) $data(editCol)] 2628 variable editWin 2629 return [expr {[lsearch -exact $editWin($name-reservedKeys) $keySym] >= 0}] 2630} 2631 2632#------------------------------------------------------------------------------ 2633# tablelist::hasMouseWheelBindings 2634# 2635# Checks whether the given widget, which is assumed to be the edit window or 2636# one of its descendants, has mouse wheel bindings. 2637#------------------------------------------------------------------------------ 2638proc tablelist::hasMouseWheelBindings w { 2639 if {[string compare [winfo class $w] "TCombobox"] == 0} { 2640 return 1 2641 } else { 2642 set bindTags [bindtags $w] 2643 return [expr {([lsearch -exact $bindTags "MentryDateTime"] >= 0 || 2644 [lsearch -exact $bindTags "MentryMeridian"] >= 0 || 2645 [lsearch -exact $bindTags "MentryIPAddr"] >= 0) && 2646 ($mentry::version >= 3.2)}] 2647 } 2648} 2649 2650#------------------------------------------------------------------------------ 2651# tablelist::isComboTopMapped 2652# 2653# Checks whether the given widget is a component of an Oakley combobox having 2654# its toplevel child mapped. This is needed in our binding scripts to make 2655# sure that the interactive cell editing won't be terminated prematurely, 2656# because Bryan Oakley's combobox keeps the focus on its entry child even if 2657# its toplevel component is mapped. 2658#------------------------------------------------------------------------------ 2659proc tablelist::isComboTopMapped w { 2660 set par [winfo parent $w] 2661 if {[string compare [winfo class $par] "Combobox"] == 0 && 2662 [winfo exists $par.top] && [winfo ismapped $par.top]} { 2663 return 1 2664 } else { 2665 return 0 2666 } 2667} 2668