Tk Source Code

Changes On Branch tip-563-scrollbar-scrollwheel
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki
Patch Unified Diff

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

Changes In Branch tip-563-scrollbar-scrollwheel Excluding Merge-Ins

This is equivalent to a diff from bd5761b5 to 205591d1

2020-02-24
20:35
Merge Tip #563: MouseWheel for horizontal scrollbar check-in: 2fd8b8cc user: oehhar tags: trunk
20:28
Add tests for scrollwheel on scrollbar: no shift horizontal and for ttk::scrollbar Closed-Leaf check-in: 205591d1 user: oehhar tags: tip-563-scrollbar-scrollwheel
2020-02-14
10:22
Merge 8.6 check-in: 41f71271 user: jan.nijtmans tags: trunk
2020-02-13
21:54
Merge trunk check-in: ba74bd6b user: jan.nijtmans tags: death-to-dbgx
21:53
Merge trunk check-in: b6b7fe41 user: jan.nijtmans tags: tip-563-scrollbar-scrollwheel
21:52
Merge trunk check-in: 566a9c6f user: jan.nijtmans tags: keysym-unicode
21:37
Merge trunk check-in: deb52fe8 user: jan.nijtmans tags: cplusplus
21:10
Merge 8.6 check-in: bd5761b5 user: jan.nijtmans tags: trunk
21:02
Fix travis build. Revise usage of TCLDIR check-in: bc5dbac2 user: jan.nijtmans tags: core-8-6-branch
2020-02-12
20:33
Merge 8.6 check-in: 19c1a7ac user: jan.nijtmans tags: trunk

Changes to library/scrlbar.tcl.
︙︙
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

bind Scrollbar <<LineEnd>> {
    tk::ScrollToPos %W 1
}
}

if {[tk windowingsystem] eq "aqua"} {
    bind Scrollbar <MouseWheel> {
	tk::ScrollByUnits %W v [expr {-(%D)}]
    }
    bind Scrollbar <Option-MouseWheel> {
	tk::ScrollByUnits %W v [expr {-10 * (%D)}]
    }
    bind Scrollbar <Shift-MouseWheel> {
	tk::ScrollByUnits %W h [expr {-(%D)}]
    }
    bind Scrollbar <Shift-Option-MouseWheel> {
	tk::ScrollByUnits %W h [expr {-10 * (%D)}]
    }
} else {
    # We must make sure that positive and negative movements are rounded
    # equally to integers, avoiding the problem that
    #     (int)1/30 = 0,
    # but
    #     (int)-1/30 = -1
    # The following code ensure equal +/- behaviour.
    bind Scrollbar <MouseWheel> {
	if {%D >= 0} {
	    tk::ScrollByUnits %W v [expr {-%D/30}]
	} else {
	    tk::ScrollByUnits %W v [expr {(29-%D)/30}]
	}
    }
    bind Scrollbar <Shift-MouseWheel> {
	if {%D >= 0} {
	    tk::ScrollByUnits %W h [expr {-%D/30}]
	} else {
	    tk::ScrollByUnits %W h [expr {(29-%D)/30}]
	}
    }
}

if {[tk windowingsystem] eq "x11"} {
    bind Scrollbar <Button-4> {tk::ScrollByUnits %W v -5}
    bind Scrollbar <Button-5> {tk::ScrollByUnits %W v 5}
    bind Scrollbar <Shift-Button-4> {tk::ScrollByUnits %W h -5}
    bind Scrollbar <Shift-Button-5> {tk::ScrollByUnits %W h 5}
    bind Scrollbar <Button-6> {tk::ScrollByUnits %W h -5}
    bind Scrollbar <Button-7> {tk::ScrollByUnits %W h 5}
}

# tk::ScrollButtonDown --
# This procedure is invoked when a button is pressed in a scrollbar.
# It changes the way the scrollbar is displayed and takes actions
# depending on where the mouse is.
#








|


<
<
<
|
<
<
<










<
<
<
<
<
<
<
|

|





|
|
<
<
|
|








127
128
129
130
131
132
133
134
135
136



137



138
139
140
141
142
143
144
145
146
147







148
149
150
151
152
153
154
155
156
157


158
159
160
161
162
163
164
165
166

bind Scrollbar <<LineEnd>> {
    tk::ScrollToPos %W 1
}
}

if {[tk windowingsystem] eq "aqua"} {
    bind Scrollbar <MouseWheel> {
	tk::ScrollByUnits %W hv [expr {-(%D)}]
    }
    bind Scrollbar <Option-MouseWheel> {



	tk::ScrollByUnits %W hv [expr {-10 * (%D)}]



    }
} else {
    # We must make sure that positive and negative movements are rounded
    # equally to integers, avoiding the problem that
    #     (int)1/30 = 0,
    # but
    #     (int)-1/30 = -1
    # The following code ensure equal +/- behaviour.
    bind Scrollbar <MouseWheel> {
	if {%D >= 0} {







	    tk::ScrollByUnits %W hv [expr {-%D/30}]
	} else {
	    tk::ScrollByUnits %W hv [expr {(29-%D)/30}]
	}
    }
}

if {[tk windowingsystem] eq "x11"} {
    bind Scrollbar <Button-4> {tk::ScrollByUnits %W hv -5}
    bind Scrollbar <Button-5> {tk::ScrollByUnits %W hv 5}


    bind Scrollbar <Button-6> {tk::ScrollByUnits %W hv -5}
    bind Scrollbar <Button-7> {tk::ScrollByUnits %W hv 5}
}

# tk::ScrollButtonDown --
# This procedure is invoked when a button is pressed in a scrollbar.
# It changes the way the scrollbar is displayed and takes actions
# depending on where the mouse is.
#
︙︙
Changes to library/ttk/scrollbar.tcl.
︙︙
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

bind TScrollbar <B2-Motion>		{ ttk::scrollbar::Drag %W %x %y }
bind TScrollbar <ButtonRelease-2>	{ ttk::scrollbar::Release %W %x %y }

# Redirect scrollwheel bindings to the scrollbar widget
#
# The shift-bindings scroll left/right (not up/down)
# if a widget has both possibilities
set eventList [list <MouseWheel> <Shift-MouseWheel>]
switch [tk windowingsystem] {
    aqua {
        lappend eventList <Option-MouseWheel> <Shift-Option-MouseWheel>
    }
    x11 {
        lappend eventList <Button-4> <Button-5> <Button-6> <Button-7>\
                <Shift-Button-4> <Shift-Button-5>
    }
}
foreach event $eventList {
    bind TScrollbar $event [bind Scrollbar $event]
}
unset eventList event









|


|


|
<








17
18
19
20
21
22
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37

bind TScrollbar <B2-Motion>		{ ttk::scrollbar::Drag %W %x %y }
bind TScrollbar <ButtonRelease-2>	{ ttk::scrollbar::Release %W %x %y }

# Redirect scrollwheel bindings to the scrollbar widget
#
# The shift-bindings scroll left/right (not up/down)
# if a widget has both possibilities
set eventList [list <MouseWheel>]
switch [tk windowingsystem] {
    aqua {
        lappend eventList <Option-MouseWheel>
    }
    x11 {
        lappend eventList <Button-4> <Button-5> <Button-6> <Button-7>

    }
}
foreach event $eventList {
    bind TScrollbar $event [bind Scrollbar $event]
}
unset eventList event
︙︙
Changes to tests/scrollbar.test.
︙︙
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741




























742
743
744
745
746
747
748

    event generate .s <MouseWheel> -delta -4
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {5.0}

test scrollbar-10.2.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
    pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
    update
    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-10.2.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
    pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
    update
    focus -force .s
    event generate .s <Shift-MouseWheel> -delta -4
    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]} {








|













|










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








710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776

    event generate .s <MouseWheel> -delta -4
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {5.0}

test scrollbar-10.2.1 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
    pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
    update
    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-10.2.2 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {aqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
    pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
    update
    focus -force .s
    event generate .s <Shift-MouseWheel> -delta -4
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {1.4}
test scrollbar-10.2.3 {<MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
    pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
    update
    focus -force .s
    event generate .s <MouseWheel> -delta -120
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {1.4}
test scrollbar-10.2.4 {<MouseWheel> event on horizontal scrollbar} -constraints {aqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
    pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
    update
    focus -force .s
    event generate .s <MouseWheel> -delta -4
    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]} {
︙︙
Changes to tests/ttk/scrollbar.test.
︙︙
65
66
67
68
69
70
71






















































































72
73
74
75
76
77
78

    .tsb configure -orient horizontal
    pack .tsb -side bottom -anchor s -expand 1 -fill x
    wm geometry . 200x200
    update
    set w [winfo width .tsb] ; set h [winfo height .tsb]
    expr {$h < $w}
} -result 1























































































#
# Scale tests:
#

test scale-1.0 "Self-destruction" -body {
    trace variable v w { destroy .s ;# }








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








65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164

    .tsb configure -orient horizontal
    pack .tsb -side bottom -anchor s -expand 1 -fill x
    wm geometry . 200x200
    update
    set w [winfo width .tsb] ; set h [winfo height .tsb]
    expr {$h < $w}
} -result 1

test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -yscrollcommand {.s set}] -side left
    for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"}
    pack [ttk::scrollbar .s -command {.t yview}] -fill y -expand 1 -side left
    update
    focus -force .s
    event generate .s <MouseWheel> -delta -120
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {5.0}
test scrollbar-10.1.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -yscrollcommand {.s set}] -side left
    for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"}
    pack [ttk::scrollbar .s -command {.t yview}] -fill y -expand 1 -side left
    update
    focus -force .s
    event generate .s <MouseWheel> -delta -4
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {5.0}

test scrollbar-10.2.1 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
    pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
    update
    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-10.2.2 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {aqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
    pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
    update
    focus -force .s
    event generate .s <Shift-MouseWheel> -delta -4
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {1.4}
test scrollbar-10.2.3 {<MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
    pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
    update
    focus -force .s
    event generate .s <MouseWheel> -delta -120
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {1.4}
test scrollbar-10.2.4 {<MouseWheel> event on horizontal scrollbar} -constraints {aqua} -setup {
    destroy .t .s
} -body {
    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
    pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
    update
    focus -force .s
    event generate .s <MouseWheel> -delta -4
    after 200 {set eventprocessed 1} ; vwait eventprocessed
    .t index @0,0
} -cleanup {
    destroy .t .s
} -result {1.4}

#
# Scale tests:
#

test scale-1.0 "Self-destruction" -body {
    trace variable v w { destroy .s ;# }
︙︙
This page was generated in about 0.025s by Fossil 2.26 [1b55133f9e] 2024-12-19 19:33:17