1# Copyright (C) 1987-2015 by Jeffery P. Hansen 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License along 14# with this program; if not, write to the Free Software Foundation, Inc., 15# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 16# 17# Last edit by hansen on Sun Jan 18 15:10:19 2009 18# 19 20# 21# If we run this file standalone, enter test mode. 22# 23if {![info exists tkg_progName]} { 24 set spreadsheet_test 1 25 source "misc.tcl" 26 source "dropbox.tcl" 27} else { 28 set spreadsheet_test 0 29} 30 31############################################################################# 32# 33# Public methods for SpreadSheet 34# size w Get number of rows 35# getselection w Get list of selected rows 36# setselection w idx Set selected item 37# see w idx Make sure the item idx is selected 38# clearselection w Clear the selection 39# get w p Get row at the specified position 40# put w p item Put a row at a specified position 41# getcell w p c Get cell at the specified position 42# putcell w p c item Put cell at the specified position 43# insert w p item Insert a row at a specified position 44# delete w items Delete an item 45# create w options Create a new spreadsheet 46# addcolumn w options Add a column 47# flush w Deletes all items 48# entryValue Value of cell that is being entered 49# 50namespace eval SpreadSheet { 51 variable parms 52 variable focusSave 53 variable cell 54 variable lastclick 0 55 variable dragspot "" 56 variable asActive 0 57 variable asEvent "" 58 variable asSpeed 250 59 variable entryValue 60 61 proc shift {v d} { 62 set L {} 63 64 foreach e $v { 65 lappend L [expr $e + $d] 66 } 67 68 return $L 69 } 70 71 72 # 73 # Map a physical row to the effective data row 74 # 75 proc getEffectiveRow {w r} { 76 variable parms 77 set P $parms($w:position) 78 return [expr $r + $P - 1] 79 } 80 81 # 82 # Map an effective data row to a physical row 83 # 84 proc getPhysicalRow {w r} { 85 variable parms 86 set P $parms($w:position) 87 return [expr $r - $P + 1] 88 } 89 90 # 91 # Show the current selection assuming all cells are painted the unselected color 92 # 93 proc show_selection {w} { 94 variable parms 95 variable cell 96 97 set P $parms($w:position) 98 set Rmax $parms($w:height) 99 set Cmax [llength $parms($w:colwidth)] 100 101 if { $parms($w:grab) } { 102 set color $parms($w:grabcolor) 103 } else { 104 set color $parms($w:selectcolor) 105 } 106 107 108 109 foreach er $parms($w:selection) { 110 set r [expr $er - $P + 1] 111 if { $r > 0 && $r < $Rmax } { 112 for { set c 0 } { $c < $Cmax } { incr c } { 113 $w.c${r}_$c configure -bg $color 114 } 115 } 116 } 117 } 118 119 # 120 # Add a new row to the selection. 121 # 122 proc addto_selection {w er} { 123 variable parms 124 125 # 126 # If row is already selected, then do nothing 127 # 128 if { [lsearch $parms($w:selection) $er] >= 0 } { 129 } 130 131 set P $parms($w:position) 132 set Rmax $parms($w:height) 133 set Cmax [llength $parms($w:colwidth)] 134 135 # 136 # If requested row is not in current data range, then do nothing 137 # 138 if { $er < 0 || $er >= $parms($w:numrows) } { 139 return 140 } 141 142 if { $parms($w:selectmode) == "single" } { 143 clearselection $w 144 set parms($w:selection) $er 145 } else { 146 lappend parms($w:selection) $er 147 } 148 149 150 set r [expr $er - $P + 1] 151 if { $r > 0 && $r < $Rmax } { 152 for { set c 0 } { $c < $Cmax } { incr c } { 153 $w.c${r}_$c configure -bg $parms($w:selectcolor) 154 } 155 } 156 } 157 158 proc advanceEntry {w K r c} { 159 variable parms 160 161 clearEntrySelect $w 162 163 set Rmax $parms($w:height) 164 set er [getEffectiveRow $w $r] 165 166 switch $K { 167 Tab { 168 while {1} { 169 incr c 170 if { $c >= [llength $parms($w:colwidth)] } { 171 set c 0 172 if {[expr $r + 1] >= $Rmax } { 173 SpreadSheet::yview $w scroll 1 unit 174 update 175 } else { 176 incr r 177 } 178 } 179 if {![entrySelect $w $r $c] } { break } 180 } 181 } 182 Up { 183 if { $er == 0 } { 184 entrySelect $w $r $c 185 } else { 186 if { $r > 1 } { 187 incr r -1 188 entrySelect $w $r $c 189 } else { 190 clearEntrySelect $w 191 incr parms($w:position) -1 192 repaint $w 193 entrySelect $w $r $c 194 } 195 } 196 } 197 Down { 198 if { $er >= $parms($w:numrows) } { 199 entrySelect $w $r $c 200 } else { 201 if { [expr $r + 1] < $parms($w:height) } { 202 incr r 203 entrySelect $w $r $c 204 } else { 205 clearEntrySelect $w 206 incr parms($w:position) 207 repaint $w 208 entrySelect $w $r $c 209 } 210 } 211 } 212 } 213 } 214 215 ############################################################################# 216 # 217 # Select a cell for entry. Returns 1 if this is an entry that should be 218 # skipped by the tab key 219 # 220 proc entrySelect {w r c} { 221 variable parms 222 variable cell 223 variable focusSave 224 225 set focusSave($w) [focus] 226# puts "entrySelect focus=$focusSave($w) takefocus=[$focusSave($w) cget -takefocus]" 227 228 229 clearselection $w 230 231 if { $r >= $parms($w:height) } { return 0 } 232 233 set er [getEffectiveRow $w $r] 234 235 if { $parms($w:entrycommand) != ""} { 236 if { $er == $parms($w:numrows) } { 237# focus is not working correctly 238# set er $parms($w:numrows) 239# set r [getPhysicalRow $w $er] 240 241 if {[$parms($w:entrycommand) canappend $w $er $c ""]} { 242 incr parms($w:numrows) 243 set xx [$parms($w:entrycommand) initentry $w $er $c ""] 244 put $w $er $xx 245 repaint $w 246 247 if {![$parms($w:entrycommand) canenter $w $er $c $cell($w:$er:$c)]} { 248 set c 0 249 while {![$parms($w:entrycommand) canenter $w $er $c $cell($w:$er:$c)]} { incr c } 250 } 251 } 252 } elseif { $er < $parms($w:numrows) } { 253 if {![$parms($w:entrycommand) canenter $w $er $c $cell($w:$er:$c)]} { 254 return 1 255 } 256 } 257 } 258 259 if { $er >= $parms($w:numrows) } { return 0 } 260 261 set width [lindex $parms($w:colwidth) $c] 262 addto_selection $w $er 263 264 destroy $w.c${r}_$c 265 266 set SpreadSheet::entryValue $SpreadSheet::cell($w:$er:$c) 267 268 set widget_ok 0 269 if { $parms($w:entrycommand) != ""} { 270 if { [$parms($w:entrycommand) entrywidget $w $r $c $w.c${r}_$c $width SpreadSheet::entryValue] != 0 } { 271 set widget_ok 1 272 } 273 } 274 if { !$widget_ok } { 275 entry $w.c${r}_$c -bd 1 -relief sunken -width $width 276 update 277 $w.c${r}_$c configure -bg $parms($w:selectcolor) -textvariable SpreadSheet::entryValue -highlightthickness 1 278 update 279 280 focus $w.c${r}_$c 281 $w.c${r}_$c icursor end 282 $w.c${r}_$c selection range 0 end 283 } 284 285 bind $w.c${r}_$c <Destroy> "SpreadSheet::clearEntrySelect $w" 286 287 tabBindings $w.c${r}_$c $w $r $c 288 289 grid $w.c${r}_$c -row $r -column $c -ipadx 0 -ipady 0 -sticky ew 290 update 291 set parms($w:entryselection) [list $r $c] 292 293 return 0 294 } 295 296 ############################################################################# 297 # 298 # End entering data into a cell 299 # 300 proc clearEntrySelect {w} { 301 variable parms 302 variable cell 303 variable focusSave 304 305 if { $parms($w:entryselection) == "" } { return } 306 307 set r [lindex $parms($w:entryselection) 0] 308 set c [lindex $parms($w:entryselection) 1] 309 set er [getEffectiveRow $w $r] 310 311 set width [lindex $parms($w:colwidth) $c] 312 313 if { $parms($w:entrycommand) != ""} { 314 set cell($w:$er:$c) [$parms($w:entrycommand) close $w $r $c $SpreadSheet::entryValue] 315 } else { 316 set cell($w:$er:$c) $SpreadSheet::entryValue 317 } 318 $parms($w:entrycommand) closenotify $w 319 320 # 321 # Unbind the deletion call to this function. 322 # 323# puts "clearEntrySelect lastfor=[focus -lastfor .]" 324 bind $w.c${r}_$c <Destroy> "" 325 destroy $w.c${r}_$c 326# puts "clearEntrySelect focus=[focus]" 327 328 # 329 # Try to restore the focus 330 # 331 catch { 332 focus $focusSave($w) 333# puts "clearEntrySelect refocus=[focus]" 334 } 335 336 337 338 # 339 # We may have called this function on a destroy event in which case the following 340 # code will fail. 341 # 342 catch { 343 label $w.c${r}_$c -bd 1 -relief raised -width $width \ 344 -bg $parms($w:entrycolor) -anchor w -text $SpreadSheet::cell($w:$er:$c) 345 grid $w.c${r}_$c -row $r -column $c -ipadx 1 -ipady 1 -sticky ew 346 setBindings $w $r $c 347 } 348 349 set parms($w:entryselection) "" 350 } 351 352 353 proc size {w} { 354 variable parms 355 return $parms($w:numrows) 356 } 357 358 proc setselection {w sel} { 359 variable parms 360 361 set parms($w:selection) $sel 362 reqRepaint $w setselction 363 } 364 365 # 366 # Make sure that entry idx is in the visible range 367 # 368 proc see {w idx} { 369 variable parms 370 371 set Rmax [expr $parms($w:height) - 1] 372 set P $parms($w:position) 373 374 if {$idx < $P} { 375 # Index is above top of visible range 376 set parms($w:position) $idx 377 reqRepaint $w see-1 378 } elseif { [expr $idx - $P + 1] >= $Rmax } { 379 # Index is below bottom of visible range 380 381 set pos [expr $idx - $Rmax + 1] 382 383 if {[expr [winfo y $w.c${Rmax}_0] + [winfo height $w.c${Rmax}_0]] > [winfo height $w] } { 384 if {$pos < $Rmax} { 385 incr pos 386 } 387 } 388 389 set parms($w:position) $pos 390 reqRepaint $w see-2 391 } 392 393 } 394 395 proc getselection {w} { 396 variable parms 397 return $parms($w:selection) 398 } 399 400 proc clearselection {w} { 401 variable parms 402 variable cell 403 404 set P $parms($w:position) 405 set Rmax $parms($w:height) 406 set Cmax [llength $parms($w:colwidth)] 407 408 clearEntrySelect $w 409 410 foreach er $parms($w:selection) { 411 set r [expr $er - $P + 1] 412 if { $r > 0 && $r < $Rmax } { 413 for { set c 0 } { $c < $Cmax } { incr c } { 414 $w.c${r}_$c configure -bg $parms($w:entrycolor) 415 } 416 } 417 } 418 set parms($w:selection) "" 419 } 420 421 422 proc reqRepaint {w args} { 423 variable parms 424 425# puts "reqRepaint $w $args" 426 427 if { !$parms($w:updatepending) } { 428 set parms($w:updatepending) 1 429 after idle "SpreadSheet::repaint $w" 430 } 431 } 432 433 434 ############################################################################# 435 # 436 # Repaint the display from the stored cell data. 437 # 438 proc repaint {w} { 439 variable parms 440 variable cell 441 442 443 set parms($w:updatepending) 0 444 445 set P $parms($w:position) 446 set Rmax $parms($w:height) 447 set N $parms($w:numrows) 448 set Cmax [llength $parms($w:colwidth)] 449 set types $parms($w:types) 450 451# puts "repaint $w [winfo width $w]x[winfo height $w] Rmax=$Rmax" 452 453 for { set r 1 } { $r < $Rmax } { incr r } { 454 for { set c 0 } { $c < $Cmax } { incr c } { 455 set er [expr $r + $P - 1] 456 457 if {$er < $N} { 458 set text $cell($w:$er:$c) 459 } else { 460 set text "" 461 } 462 catch { 463 set type [lindex $types $c] 464 465 if {$type == "image" } { 466 $w.c${r}_$c configure -image $text -bg $parms($w:entrycolor) -anchor center 467 } else { 468 $w.c${r}_$c configure -text $text -bg $parms($w:entrycolor) 469 } 470 471 } 472 } 473 } 474 show_selection $w 475 476 if { $parms($w:yscrollcommand) != "" } { 477 set N $parms($w:numrows) 478 479 set start [expr ($P+0.0)/($N+1.0)] 480 set stop [expr ($P + $Rmax+0.0)/($N+1.0)] 481 482 eval "$parms($w:yscrollcommand) $start $stop" 483 } 484 } 485 486 proc yview {w args} { 487 variable parms 488 489 set cmd [lindex $args 0] 490 set n [lindex $args 1] 491 492 set P $parms($w:position) 493 set Rmax $parms($w:height) 494 set N $parms($w:numrows) 495 496 clearEntrySelect $w 497 498 if {$cmd == "moveto" } { 499 set P [expr int($N*$n)] 500 } elseif {$cmd == "scroll" } { 501 set P [expr int($P + $n)] 502 } 503 504 if { $P < 0 } { set P 0 } 505 if { $P >= $N } { set P $N } 506 set parms($w:position) $P 507 reqRepaint $w yview 508 } 509 510 # 511 # Delete items 512 # 513 proc delete {w args} { 514 variable parms 515 variable cell 516 517 set dlist {} 518 foreach ilist $args { 519 foreach item $ilist { 520 lappend dlist $item 521 } 522 } 523 set dlist [lsort -integer $dlist] 524 set first [lindex $dlist 0] 525 526 if { [llength $dlist] == 0 } { return } 527 528 set Cmax [llength $parms($w:colwidth)] 529 530 set dst_r [lindex $dlist 0] 531 set src_r [expr $dst_r + 1] 532 set N $parms($w:numrows) 533 534 set Dcount 1 535 536 while { $src_r < $N } { 537 if { [lsearch $dlist $src_r] >= 0 } { 538 incr src_r 539 incr Dcount 540 continue 541 } 542 543 for { set c 0 } { $c < $Cmax } { incr c } { 544 set cell($w:$dst_r:$c) $cell($w:$src_r:$c) 545 } 546 incr dst_r 547 incr src_r 548 } 549 550 incr parms($w:numrows) [expr -$Dcount] 551 clearselection $w 552 if { $first < [size $w] } { 553 setselection $w $first 554 } 555 reqRepaint $w delete 556 557 catch { $parms($w:entrycommand) deletenotify $w } 558 } 559 560 proc flush {w} { 561 variable parms 562 563 clearselection $w 564 set parms($w:numrows) 0 565 reqRepaint $w flush 566 } 567 568 569 # 570 # Get item at a postion 571 # 572 proc get {w er} { 573 variable parms 574 variable cell 575 576 set Cmax [llength $parms($w:colwidth)] 577 578 set L {} 579 for { set c 0 } { $c < $Cmax } { incr c } { 580 lappend L $cell($w:$er:$c) 581 } 582 return $L 583 } 584 585 # 586 # Get a single cell 587 # 588 proc getcell {w er c} { 589 variable cell 590 591 return $cell($w:$er:$c) 592 } 593 594 595 # 596 # Put item at a postion 597 # 598 proc put {w er item} { 599 variable parms 600 variable cell 601 602 set Cmax [llength $parms($w:colwidth)] 603 604 for { set c 0 } { $c < $Cmax } { incr c } { 605 set cell($w:$er:$c) [lindex $item $c] 606 } 607 reqRepaint $w put 608 } 609 610 # 611 # Put a single cell 612 # 613 proc putcell {w pos c item} { 614 variable cell 615 variable parms 616 617 if {$pos=="end"} { 618 set pos $parms($w:numrows) 619 } 620 621 set cell($w:$pos:$c) $item 622 reqRepaint $w putcell 623 } 624 625 # 626 # Add an item to the spreadsheet 627 # 628 proc insert {w pos value} { 629 variable parms 630 variable cell 631 632 if {$pos=="end"} { 633 set pos $parms($w:numrows) 634 } 635 636 set Cmax [llength $parms($w:colwidth)] 637 638 for { set r $parms($w:numrows) } { $r > $pos } { incr r -1 } { 639 for { set c 0 } { $c < $Cmax } { incr c } { 640 set cell($w:$r:$c) $cell($w:[expr $r - 1]:$c) 641 } 642 } 643 644 for { set c 0 } { $c < $Cmax } { incr c } { 645 set cell($w:$pos:$c) [lindex $value $c] 646 } 647 incr parms($w:numrows) 648 649 reqRepaint $w insert 650 } 651 652 proc grabMotion {w r c} { 653 variable parms 654 655 set er_delta [expr $r - [lindex $parms($w:mousedown) 0]] 656 657 658 if { $er_delta == 0 } { 659 return 660 } 661 662 663 set selection [getselection $w] 664# puts "grabMotion $w : $parms($w:mousedown) : $r $c sel=$selection" 665 666 set N $parms($w:numrows) 667 set min_er [vmin $selection] 668 set max_er [vmax $selection] 669 670 671 if { [expr $min_er + $er_delta] < 0 } { set er_delta [expr -$min_er]} 672 if { [expr $max_er + $er_delta+1] >= $N } { set er_delta [expr $N-$max_er-1]} 673 674 # puts "sel=[list $selection] min=$min_er max=$max_er delta=$er_delta" 675 676 set newselection [shift $selection $er_delta] 677 678 679 set min_er [min [expr $min_er + $er_delta] $min_er] 680 set max_er [max [expr $max_er + $er_delta] $max_er] 681 682 set SI {} 683 set NSI {} 684 for {set xr $min_er } { $xr <= $max_er } { incr xr } { 685 if {[lsearch $selection $xr] < 0} { 686 lappend NSI [get $w $xr] 687 } else { 688 lappend SI [get $w $xr] 689 } 690 } 691 692 for {set xr $min_er } { $xr <= $max_er } { incr xr } { 693 if {[lsearch $newselection $xr] < 0} { 694 put $w $xr [lindex $NSI 0] 695 set NSI [lrange $NSI 1 end] 696 } else { 697 put $w $xr [lindex $SI 0] 698 set SI [lrange $SI 1 end] 699 } 700 } 701 702 set parms($w:selection) $newselection 703 set parms($w:mousedown) [list $r $c] 704 705 catch { $parms($w:entrycommand) reorder $w } 706 707 reqRepaint $w grabMotion 708 } 709 710 proc speedMap {d} { 711 if { $d > 40} { 712 return 50 713 } else { 714 return [expr int(250-(40-$d)*200.0/40.0-50)] 715 } 716 } 717 718 proc doAutoScroll {w} { 719 variable asEvent 720 variable asActive 721 variable asSpeed 722 variable asX 723 variable asY 724 variable parms 725 726 set H $parms($w:numrows) 727 set P $parms($w:position) 728 729 if { $asActive < 0} { 730 if {$P < [expr $H-1]} { 731 incr parms($w:position) 732 reqRepaint $w autoScroll 733 seeB1Motion $w $asX $asY -autoscroll 734 } 735 } else { 736 if {$P > 0} { 737 incr parms($w:position) -1 738 reqRepaint $w autoScroll 739 seeB1Motion $w $asX $asY -autoscroll 740 } 741 } 742 743 set asEvent [after $asSpeed "SpreadSheet::doAutoScroll $w"] 744 } 745 746 proc checkAutoScroll {w X Y args} { 747 variable asEvent 748 variable asActive 749 variable asX 750 variable asY 751 variable asSpeed 752 753 set asX $X 754 set asY $Y 755 756 set cancel 0 757 if {[lsearch $args -cancel] >= 0} { set cancel 1 } 758 759 760 set asc 0 761 set rootY [winfo rooty $w] 762 set height [winfo height $w] 763 if { $Y < [expr $rootY + 40]} { 764 set asY [max $Y 1] 765 set asc 1 766 767 set asSpeed [speedMap [expr $rootY + 40 - $Y]] 768 } elseif { $Y > [expr $rootY + $height - 20]} { 769 set asY [min $Y [expr $rootY + $height - 1]] 770 set asc -1 771 772 set asSpeed [speedMap [expr $Y - ($rootY + $height - 20)]] 773 } 774 775 # 776 # Check for event cancelation 777 # 778 if {$cancel || $asc == 0 || ($asActive != 0 && $asc != $asActive)} { 779 if {$asEvent != ""} { 780 after cancel $asEvent 781 } 782 set asEvent "" 783 set asActive 0 784 return 785 } 786 787 set asActive $asc 788 if { $asEvent == "" } { 789 set asEvent [after 500 "SpreadSheet::doAutoScroll $w"] 790 } 791 } 792 793 # 794 # See press of B1 795 # 796 proc seeB1Press {w r c s X Y} { 797 variable parms 798 variable lastclick 799 variable dragspot 800 801 set dragspot "" 802 803 checkAutoScroll $w $X $Y 804 805 if { $s != 0 } { 806 clearselection $w 807 set parms($w:mousedown) {} 808 } 809 810 if {![catch { set clicktime [clock clicks -milliseconds] }]} { 811 if { $lastclick != 0 && [expr $clicktime - $lastclick] < 350} { 812 seeB1Double $w $r $c 813 set lastclick 0 814 return 815 } else { 816 set lastclick $clicktime 817 } 818 } 819 820 set er [getEffectiveRow $w $r] 821 822 if { [lsearch [getselection $w] $er] >= 0 } { 823 set parms($w:mousedown) [list $er $c] 824 set parms($w:grab) 1 825 clearEntrySelect $w 826 show_selection $w 827 return 828 } 829 830 clearselection $w 831 832 set P $parms($w:position) 833 set Rmax $parms($w:height) 834 set Cmax [llength $parms($w:colwidth)] 835 836 set direct_move 0 837 if { $parms($w:selectmode) == "single" 838 || ($parms($w:selectmode) == "shift-multiple" && $s == 0) } { 839 set direct_move 1 840 } 841 842 if { $er >= 0 && $er < $parms($w:numrows) } { 843 set parms($w:mousedown) [list $er $c] 844 addto_selection $w $er 845 846 if {!$parms($w:grab) && $direct_move} { 847 set parms($w:mousedown) [list $er $c] 848 set parms($w:grab) 1 849 clearEntrySelect $w 850 show_selection $w 851 } 852 853 return 854 } 855 856 set parms($w:mousedown) {} 857 } 858 859 proc seeB1Motion {w X Y args} { 860 variable parms 861 variable dragspot 862 863 # 864 # -autoscroll flag means we are being called from within autoscroll and should avoid 865 # a recursive call. 866 # 867 if {[lsearch $args -autoscroll] < 0 } { 868 checkAutoScroll $w $X $Y 869 } 870 871 set W [winfo containing $X $Y] 872 if { [scan $W $w.c%d_%d r c] != 2} { 873 catch { $parms($w:entrycommand) dragout zoom } 874 return 875 } 876 877 if {[llength $parms($w:mousedown)] == 0} {return } 878 879 set er [getEffectiveRow $w $r] 880 881 if { $parms($w:dragcommand) != "" } { 882 if { $dragspot == "" } { 883 set dragspot [list $X $Y] 884 } else { 885 set dsX [lindex $dragspot 0] 886 set dsY [lindex $dragspot 1] 887 888 set delta [expr ($X-$dsX)*($X-$dsX) + ($Y-$dsY)*($Y-$dsY)] 889 890 if { $delta > 7 } { 891 set er [getselection $w] 892 if {[llength $er] == 1 } { 893 $parms($w:dragcommand) $w $er 894 } 895 set dragspot "" 896 } 897 } 898 return 899 } 900 901 902 if { $parms($w:grab) } { 903 if { $parms($w:dograb) } { 904 grabMotion $w $er $c 905 } 906 return 907 } 908 909 910 set P $parms($w:position) 911 set Rmax $parms($w:height) 912 set Cmax [llength $parms($w:colwidth)] 913 914 set br [lindex $parms($w:mousedown) 0] 915 916 if { $er < $br } { 917 set x $er 918 set er $br 919 set br $x 920 } 921 922 clearselection $w 923 for { set xr $br } { $xr <= $er } { incr xr } { 924 addto_selection $w $xr 925 } 926 } 927 928 proc seeB1Release {w X Y} { 929 variable parms 930 variable dragspot 931 932 set dragspot "" 933 934# focus $w 935 936 if { $parms($w:grab) } { 937 set parms($w:mousedown) "" 938 set parms($w:grab) 0 939 show_selection $w 940 return 941 } 942 seeB1Motion $w $X $Y 943 checkAutoScroll $w 0 0 -cancel 944 } 945 946 proc seeB1Double {w r c } { 947 variable parms 948 variable dragspot 949 950 set dragspot "" 951 952 checkAutoScroll $w 0 0 -cancel 953 954 955 set er [getEffectiveRow $w $r] 956 catch { $parms($w:entrycommand) doublePress $w $er $c } 957 entrySelect $w $r $c 958 } 959 960 proc seeB3Press {w r c s X Y} { 961 variable parms 962 variable lastclick 963 variable dragspot 964 965 set dragspot "" 966 967 # 968 # The double calls to seeB1Press cause the selected item to be shown as grabbed. 969 # we clear lastclick so that it will not be treated as a double click. 970 # 971 seeB1Press $w $r $c $s $X $Y 972 set lastclick 0 973 seeB1Press $w $r $c $s $X $Y 974 checkAutoScroll $w 0 0 -cancel 975 976 catch { $parms($w:entrycommand) rightclick $w } 977 set parms($w:mousedown) "" 978 set parms($w:grab) 0 979 } 980 981 ############################################################################# 982 # 983 # Send a request to delete an entry to the entry manager. 984 # 985 proc requestDelete {w args} { 986 variable parms 987 988 catch { $parms($w:entrycommand) delete $w } 989 } 990 991 ############################################################################# 992 # 993 # Set bindings on cells that are not active for entry 994 # 995 proc setBindings {w r c} { 996 bind $w.c${r}_$c <1> "SpreadSheet::seeB1Press $w $r $c %s %X %Y" 997 bind $w.c${r}_$c <3> "SpreadSheet::seeB3Press $w $r $c %s %X %Y" 998 bind $w.c${r}_$c <B1-Motion> "SpreadSheet::seeB1Motion $w %X %Y" 999 bind $w.c${r}_$c <ButtonRelease-1> "SpreadSheet::seeB1Release $w %X %Y" 1000# bind $w.c${r}_$c <Double-ButtonPress-1> "SpreadSheet::seeB1Double $w $r $c" 1001 } 1002 1003 ############################################################################# 1004 # 1005 # Set bindings on cells that are active for entry 1006 # 1007 proc tabBindings {W w r c} { 1008 bindtags $W [ldelete [bindtags $W] all] 1009 bind $W <Tab> "SpreadSheet::advanceEntry $w %K $r $c" 1010 bind $W <Escape> "SpreadSheet::clearEntrySelect $w; SpreadSheet::reqRepaint $w tab-escape" 1011 bind $W <Return> "SpreadSheet::clearEntrySelect $w; SpreadSheet::reqRepaint $w tab-return" 1012# bind $W <Up> "SpreadSheet::advanceEntry $w %K $r $c" 1013# bind $W <Down> "SpreadSheet::advanceEntry $w %K $r $c" 1014# bind $W <KeyPress> { puts "KeyPress %K" } 1015 } 1016 1017 1018 # 1019 # Add a spreadsheet column 1020 # 1021 proc addcolumn {w args} { 1022 variable parms 1023 variable cell 1024 1025 set width 5 1026 set header "" 1027 set type text 1028 parseargs $args {-width -header -type} 1029 1030 set c [llength $parms($w:colwidth)] 1031 1032 lappend parms($w:colwidth) $width 1033 lappend parms($w:headers) $header 1034 lappend parms($w:types) $type 1035 1036 1037 if {$parms($w:expandcol) == $c} { 1038 grid columnconfigure $w $c -weight 1 1039 } 1040 1041 # column header 1042 label $w.h${c} -bd 1 -relief raised -width $width -bg $parms($w:headercolor) -text $header -font dialogBigExpFont -takefocus 0 1043 grid $w.h${c} -row 0 -column $c -ipadx 1 -ipady 1 -sticky ew 1044 1045 # column rows 1046 for {set r 1 } {$r < $parms($w:height) } {incr r } { 1047 label $w.c${r}_$c -bd 1 -relief raised -width $width -bg $parms($w:entrycolor) -anchor w -takefocus 0 1048 grid $w.c${r}_$c -row $r -column $c -ipadx 1 -ipady 1 -sticky ew 1049 set cell($w:$r:$c) "" 1050 setBindings $w $r $c 1051 } 1052 } 1053 1054 proc reduceSize {w new_height} { 1055 variable parms 1056 1057# puts "reduceSize $w $new_height" 1058 1059 set Ncol [llength $parms($w:colwidth)] 1060 set height $parms($w:height) 1061 for { set r $new_height } { $r < $height } { incr r } { 1062# puts " delrow - $r" 1063 for { set c 0} { $c < $Ncol } { incr c } { 1064 destroy $w.c${r}_$c 1065 } 1066 } 1067 set parms($w:height) $new_height 1068 } 1069 1070 proc expandSize {w H} { 1071 variable parms 1072 1073 set Ncol [llength $parms($w:colwidth)] 1074 1075 set H [winfo reqheight [winfo parent $w]] 1076# puts "expandSize $w $H" 1077 1078 set rowHeight [winfo height $w.h0] 1079 1080 for {set r $parms($w:height) } {[expr $r*$rowHeight] < $H } {incr r } { 1081# puts " addrow - $r" 1082 for { set c 0} { $c < $Ncol } { incr c } { 1083 set width [lindex $parms($w:colwidth) $c] 1084 label $w.c${r}_$c -bd 1 -relief raised -width $width -bg $parms($w:entrycolor) -anchor w 1085 grid $w.c${r}_$c -row $r -column $c -ipadx 1 -ipady 1 -sticky ew 1086 set cell($w:$r:$c) "" 1087 setBindings $w $r $c 1088 } 1089 } 1090# puts "set parms($w:height) [expr $r + 1]" 1091 set parms($w:height) $r 1092 } 1093 1094 proc updateSize {w} { 1095 variable parms 1096 1097 set W [winfo width $w] 1098 set H [winfo height $w] 1099 1100# puts "SpreadSheet::updateSize $w $W $H" 1101 1102 if { $parms($w:resize) } { 1103 set new_height 0 1104 1105 set height $parms($w:height) 1106 1107 set new_height 10000000 1108 for { set r 1 } { $r < $height } { incr r } { 1109 if { [winfo y $w.c${r}_0] > $H } { 1110 set new_height $r 1111 break 1112 } 1113 } 1114 1115 if {$new_height < $height } { 1116 reduceSize $w $new_height 1117 } else { 1118 expandSize $w $H 1119 } 1120 1121 } 1122 1123 1124 SpreadSheet::reqRepaint $w updateSize 1125 } 1126 1127 ############################################################################# 1128 # 1129 # Configure a SpreadSheet widget (arguments given in list) 1130 # 1131 proc configurev {w argv} { 1132 variable parms 1133 1134# puts "SpreadSheet::configurev $w $argv" 1135 1136 set optlist {-height -headercolor -entrycolor -selectcolor -command -statecommand 1137 -bd -relief -yscrollcommand -grabcolor -entrycommand -expandcol -selectmode 1138 -dograb -dragcommand -resize} 1139 1140 parseargs $argv $optlist 1141 1142 foreach o $optlist { 1143 scan $o "-%s" var 1144 1145 if {[info exists $var]} { 1146 set parms($w:$var) [set $var] 1147 } 1148 } 1149 } 1150 1151 ############################################################################# 1152 # 1153 # Configure a SpreadSheet widget (arguments on command line) 1154 # 1155 proc configure {w args} { 1156 configurev $w $args 1157 } 1158 1159 1160 ############################################################################# 1161 # 1162 # SpreadSheet::init $w $argv 1163 # 1164 # Initialize the options of a spreadsheet 1165 # 1166 proc init {w} { 1167 variable parms 1168 variable cell 1169 1170 1171 set parms($w:mousedown) {} 1172 set parms($w:colwidth) {} 1173 set parms($w:position) 0 1174 set parms($w:numrows) 0 1175 set parms($w:grab) 0 1176 set parms($w:selection) "" 1177 set parms($w:entryselection) "" 1178 set parms($w:updatepending) 0 1179 set parms($w:headers) {} 1180 set parms($w:types) {} 1181 set parms($w:repaintpending) "" 1182 set parms($w:dograb) 1 1183 set parms($w:height) 1 1184 set parms($w:headercolor) [option get $w SpreadSheet.headerColor {}] 1185 set parms($w:entrycolor) [option get $w SpreadSheet.entryColor {}] 1186 set parms($w:selectcolor) [option get $w SpreadSheet.selectColor {}] 1187 set parms($w:grabcolor) [option get $w SpreadSheet.grabColor {}] 1188 set parms($w:entrycommand) "" 1189 set parms($w:command) "" 1190 set parms($w:statecommand) "" 1191 set parms($w:bd) 2 1192 set parms($w:relief) sunken 1193 set parms($w:yscrollcommand) "" 1194 set parms($w:expandcol) -1 1195 set parms($w:selectmode) [option get $w SpreadSheet.selectmode {}] 1196 set parms($w:dragcommand) "" 1197 set parms($w:resize) 0 1198 1199 set cell($w:0:0) "" 1200 } 1201 1202 ############################################################################# 1203 # 1204 # SpreadSheet::create $w [args...] 1205 # 1206 # Create a new spreadsheet. 1207 # 1208 proc create {w args} { 1209 variable parms 1210 1211 set p_repaintPending($w) 0 1212 1213 frame $w 1214 init $w 1215 configurev $w $args 1216 $w configure -bd $parms($w:bd) -relief $parms($w:relief) -takefocus 0 -width 10 -height 10 1217 1218 bind $w <Delete> "SpreadSheet::requestDelete $w" 1219 bind $w <Configure> "SpreadSheet::updateSize $w" 1220 } 1221 1222 proc tester {} { 1223 SpreadSheet::create .lb -bd 2 -relief sunken -yscrollcommand ".vb set" -height 15 -entrycommand entryManager 1224 scrollbar .vb -orient vertical -command "SpreadSheet::yview .lb" 1225 grid .lb -row 0 -column 0 -padx 20 -pady 20 1226 grid .vb -row 0 -column 1 -sticky ns 1227 SpreadSheet::addcolumn .lb -width 10 -header Fee 1228 SpreadSheet::addcolumn .lb -width 10 -header Fei 1229 SpreadSheet::addcolumn .lb -width 10 -header Foe 1230 SpreadSheet::addcolumn .lb -width 10 -header Fum 1231 1232 SpreadSheet::insert .lb end {1 5 6 7} 1233 SpreadSheet::insert .lb end {2 12 18 99} 1234 SpreadSheet::insert .lb end {3 8 77 120} 1235 SpreadSheet::insert .lb end {4 12 18 35} 1236 SpreadSheet::insert .lb end {5 87 423 72} 1237 SpreadSheet::insert .lb end {6 786 72 281} 1238 SpreadSheet::insert .lb end {7 76 7823 76} 1239 SpreadSheet::insert .lb end {8 76 1289 89} 1240 SpreadSheet::insert .lb end {9 5 2013 1283} 1241 SpreadSheet::insert .lb end {10 12 12 123123} 1242 SpreadSheet::insert .lb end {11 123 87 28} 1243 SpreadSheet::insert .lb end {12 12783 765 123} 1244 SpreadSheet::insert .lb end {13 783 65 223} 1245 SpreadSheet::insert .lb end {14 183 76 129} 1246 SpreadSheet::insert .lb end {15 273 75 121} 1247 SpreadSheet::insert .lb end {16 1273 865 103} 1248 SpreadSheet::insert .lb end {17 1783 965 183} 1249 } 1250} 1251 1252if { $spreadsheet_test } { 1253 SpreadSheet::tester 1254} 1255 1256 1257# 1258# entryManager canenter w r c data see if we can enter data at (r,c) 1259# entryManager entrywidget w r c W width var create special widget at (r,c) or return 0 for default 1260# entryManager close w r c data close the entry widget on a cell and do a trandormation on the data 1261# entryManager canappend w r c data can we append a row at (r,c) 1262# entryManager initentry w r c if appending, get initial row values 1263# 1264proc entryManager {cmd args} { 1265 switch $cmd { 1266 canenter { 1267 set c [lindex $args 2] 1268 return [expr $c != 2 ] 1269 } 1270 entrywidget { 1271 set w [lindex $args 0] 1272 set r [lindex $args 1] 1273 set c [lindex $args 2] 1274 set W [lindex $args 3] 1275 set width [lindex $args 4] 1276 set variable [lindex $args 5] 1277 if { $c == 3 } { 1278 Dropbox::new $W -variable $variable -width [expr $width - 3] -bd 1 -highlightthickness 0 1279 Dropbox::itemadd $W "one" 1280 Dropbox::itemadd $W "two" 1281 Dropbox::itemadd $W "three" 1282 Dropbox::itemadd $W "four" 1283 1284 return 1 1285 } 1286 } 1287 close { 1288 set data [lindex $args 3] 1289 return [string tolower $data] 1290 } 1291 canappend { 1292 set c [lindex $args 2] 1293 return [expr $c != 2 ] 1294 } 1295 initentry { 1296 return {0 0 0 0} 1297 } 1298 } 1299 return 0 1300} 1301