Tk Source Code

Changes On Branch bug-011706ec42
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch bug-011706ec42 Excluding Merge-Ins

This is equivalent to a diff from 192eb2f0 to 17c4cb5e

2016-05-20
15:31
Fixed [011706ec42] for the scrollbar case check-in: b79e2703 user: fvogel tags: core-8-6-branch
2016-05-18
10:14
Fixed [011706ec42] for the scrollbar case. Closed-Leaf check-in: 17c4cb5e user: fvogel tags: bug-011706ec42
2016-05-17
20:36
Added (currently failing) test case scrollbar-11.1 - Note that it will only fail on x11 and on aqua, not on Win because on Windows there is no binding of <2> for the Scrollbar class check-in: a59d8940 user: fvogel tags: bug-011706ec42
2016-05-03
17:12
Fixed [011706ec42] - tk::ButtonInvoke safety bug check-in: 97a5e9f8 user: fvogel tags: core-8-6-branch
2016-05-02
20:21
Merged core-8-6-branch check-in: d6726948 user: fvogel tags: bug-011706ec42
20:20
merge mark check-in: 99e15097 user: fvogel tags: trunk
20:16
Fixed Americano-British English (American English selected) check-in: 192eb2f0 user: fvogel tags: core-8-6-branch
2016-05-01
19:51
Fixed [b362182e45] - Generation of virtual events through Tk_HandleEvent is unsafe check-in: 047d31f2 user: fvogel tags: core-8-6-branch

Changes to library/button.tcl.

593
594
595
596
597
598
599
600
601
602
603



604








605


606
607
608
609
610
611
612
# The procedure below is called when a button is invoked through
# the keyboard.  It simulate a press of the button via the mouse.
#
# Arguments:
# w -		The name of the widget.

proc ::tk::ButtonInvoke w {
    if {[$w cget -state] ne "disabled"} {
	set oldRelief [$w cget -relief]
	set oldState [$w cget -state]
	$w configure -state active -relief sunken



	update idletasks








	after 100


	$w configure -state $oldState -relief $oldRelief
	uplevel #0 [list $w invoke]
    }
}

# ::tk::ButtonAutoInvoke --
#







|



>
>
>
|
>
>
>
>
>
>
>
>
|
>
>







593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
# The procedure below is called when a button is invoked through
# the keyboard.  It simulate a press of the button via the mouse.
#
# Arguments:
# w -		The name of the widget.

proc ::tk::ButtonInvoke w {
    if {[winfo exists $w] && [$w cget -state] ne "disabled"} {
	set oldRelief [$w cget -relief]
	set oldState [$w cget -state]
	$w configure -state active -relief sunken
	after 100 [list ::tk::ButtonInvokeEnd $w $oldState $oldRelief]
    }
}

# ::tk::ButtonInvokeEnd --
# The procedure below is called after a button is invoked through
# the keyboard.  It simulate a release of the button via the mouse.
#
# Arguments:
# w -         The name of the widget.
# oldState -  Old state to be set back.
# oldRelief - Old relief to be set back.

proc ::tk::ButtonInvokeEnd {w oldState oldRelief} {
    if {[winfo exists $w]} {
	$w configure -state $oldState -relief $oldRelief
	uplevel #0 [list $w invoke]
    }
}

# ::tk::ButtonAutoInvoke --
#

Changes to library/scrlbar.tcl.

426
427
428
429
430
431
432



433
434
435
436
437
438
439
440
441
442
443
444
445

446
447
448

449
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	Mouse coordinates within the widget.

proc ::tk::ScrollButton2Down {w x y} {
    variable ::tk::Priv



    set element [$w identify $x $y]
    if {[string match {arrow[12]} $element]} {
	ScrollButtonDown $w $x $y
	return
    }
    ScrollToPos $w [$w fraction $x $y]
    set Priv(relief) [$w cget -activerelief]

    # Need the "update idletasks" below so that the widget calls us
    # back to reset the actual scrollbar position before we start the
    # slider drag.

    update idletasks

    $w configure -activerelief sunken
    $w activate slider
    ScrollStartDrag $w $x $y

}







>
>
>













>
|
|
|
>

426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	Mouse coordinates within the widget.

proc ::tk::ScrollButton2Down {w x y} {
    variable ::tk::Priv
    if {![winfo exists $w]} {
        return
    }
    set element [$w identify $x $y]
    if {[string match {arrow[12]} $element]} {
	ScrollButtonDown $w $x $y
	return
    }
    ScrollToPos $w [$w fraction $x $y]
    set Priv(relief) [$w cget -activerelief]

    # Need the "update idletasks" below so that the widget calls us
    # back to reset the actual scrollbar position before we start the
    # slider drag.

    update idletasks
    if {[winfo exists $w]} {
        $w configure -activerelief sunken
        $w activate slider
        ScrollStartDrag $w $x $y
    }
}

Changes to tests/button.test.

3903
3904
3905
3906
3907
3908
3909


















3910
3911
3912
3913
3914
3915
3916
# With -height, height should not be affected by text change
	lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}]
# A one line text should be as high as -height 1
	lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}]
} -cleanup {
    destroy .a .b .c
} -result {1 1 1} 



















imageFinish
cleanupTests
return

# Local variables:
# mode: tcl







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
# With -height, height should not be affected by text change
	lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}]
# A one line text should be as high as -height 1
	lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}]
} -cleanup {
    destroy .a .b .c
} -result {1 1 1} 

test button-14.1 {bug fix: [011706ec42] tk::ButtonInvoke unsafe wrt widget destruction} -body {
    proc destroy_button {} {
        if {[winfo exists .top.b]} {
            destroy .top.b
        }
    }
    toplevel .top
    button .top.b -text Foo -command destroy_button
    bind .top.b <space> destroy_button
    pack .top.b
    focus -force .top.b
    update
    event generate .top.b <space>
    update  ; # shall not trigger error  invalid command name ".top.b"
} -cleanup {
    destroy .top.b .top
} -result {} 

imageFinish
cleanupTests
return

# Local variables:
# mode: tcl

Changes to tests/scrollbar.test.

657
658
659
660
661
662
663





































664
665
666
667
668
669
670
    focus -force .s
    event generate .s <Shift-MouseWheel> -delta -120
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {1.4}






































catch {destroy .s}
catch {destroy .t}

# cleanup
cleanupTests
return







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
    focus -force .s
    event generate .s <Shift-MouseWheel> -delta -120
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {1.4}

test scrollbar-11.1 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destruction} -body {
    proc destroy_scrollbar {} {
        if {[winfo exists .top.s]} {
            destroy .top.s
        }
    }
    toplevel .top
    scrollbar .top.s
    bind .top.s <2> {destroy_scrollbar}
    pack .top.s
    focus -force .top.s
    update
    event generate .top.s <2>
    update  ; # shall not trigger error  invalid command name ".top.s"
} -cleanup {
    destroy .top.s .top
} -result {} 
test scrollbar-11.2 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destruction} -body {
    proc destroy_scrollbar {{y 0}} {
        if {[winfo exists .top.s]} {
            destroy .top.s
        }
    }
    toplevel .top
    wm minsize .top 50 400
    update
    scrollbar .top.s
    bind .top.s <2> {after idle destroy_scrollbar}
    pack .top.s -expand true -fill y
    focus -force .top.s
    update
    event generate .top.s <2> -x 2 -y [expr {[winfo height .top.s] / 2}]
    update  ; # shall not trigger error  invalid command name ".top.s"
} -cleanup {
    destroy .top.s .top
} -result {} 

catch {destroy .s}
catch {destroy .t}

# cleanup
cleanupTests
return