Tk Source Code

Changes On Branch tip-563-scrollbar-scrollwheel
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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    127   bind Scrollbar <<LineEnd>> {
   128    128       tk::ScrollToPos %W 1
   129    129   }
   130    130   }
   131    131   
   132    132   if {[tk windowingsystem] eq "aqua"} {
   133    133       bind Scrollbar <MouseWheel> {
   134         -	tk::ScrollByUnits %W v [expr {-(%D)}]
          134  +	tk::ScrollByUnits %W hv [expr {-(%D)}]
   135    135       }
   136    136       bind Scrollbar <Option-MouseWheel> {
   137         -	tk::ScrollByUnits %W v [expr {-10 * (%D)}]
   138         -    }
   139         -    bind Scrollbar <Shift-MouseWheel> {
   140         -	tk::ScrollByUnits %W h [expr {-(%D)}]
   141         -    }
   142         -    bind Scrollbar <Shift-Option-MouseWheel> {
   143         -	tk::ScrollByUnits %W h [expr {-10 * (%D)}]
          137  +	tk::ScrollByUnits %W hv [expr {-10 * (%D)}]
   144    138       }
   145    139   } else {
   146    140       # We must make sure that positive and negative movements are rounded
   147    141       # equally to integers, avoiding the problem that
   148    142       #     (int)1/30 = 0,
   149    143       # but
   150    144       #     (int)-1/30 = -1
   151    145       # The following code ensure equal +/- behaviour.
   152    146       bind Scrollbar <MouseWheel> {
   153    147   	if {%D >= 0} {
   154         -	    tk::ScrollByUnits %W v [expr {-%D/30}]
          148  +	    tk::ScrollByUnits %W hv [expr {-%D/30}]
   155    149   	} else {
   156         -	    tk::ScrollByUnits %W v [expr {(29-%D)/30}]
   157         -	}
   158         -    }
   159         -    bind Scrollbar <Shift-MouseWheel> {
   160         -	if {%D >= 0} {
   161         -	    tk::ScrollByUnits %W h [expr {-%D/30}]
   162         -	} else {
   163         -	    tk::ScrollByUnits %W h [expr {(29-%D)/30}]
          150  +	    tk::ScrollByUnits %W hv [expr {(29-%D)/30}]
   164    151   	}
   165    152       }
   166    153   }
   167    154   
   168    155   if {[tk windowingsystem] eq "x11"} {
   169         -    bind Scrollbar <Button-4> {tk::ScrollByUnits %W v -5}
   170         -    bind Scrollbar <Button-5> {tk::ScrollByUnits %W v 5}
   171         -    bind Scrollbar <Shift-Button-4> {tk::ScrollByUnits %W h -5}
   172         -    bind Scrollbar <Shift-Button-5> {tk::ScrollByUnits %W h 5}
   173         -    bind Scrollbar <Button-6> {tk::ScrollByUnits %W h -5}
   174         -    bind Scrollbar <Button-7> {tk::ScrollByUnits %W h 5}
          156  +    bind Scrollbar <Button-4> {tk::ScrollByUnits %W hv -5}
          157  +    bind Scrollbar <Button-5> {tk::ScrollByUnits %W hv 5}
          158  +    bind Scrollbar <Button-6> {tk::ScrollByUnits %W hv -5}
          159  +    bind Scrollbar <Button-7> {tk::ScrollByUnits %W hv 5}
   175    160   }
   176    161   
   177    162   # tk::ScrollButtonDown --
   178    163   # This procedure is invoked when a button is pressed in a scrollbar.
   179    164   # It changes the way the scrollbar is displayed and takes actions
   180    165   # depending on where the mouse is.
   181    166   #

Changes to library/ttk/scrollbar.tcl.

    17     17   bind TScrollbar <B2-Motion>		{ ttk::scrollbar::Drag %W %x %y }
    18     18   bind TScrollbar <ButtonRelease-2>	{ ttk::scrollbar::Release %W %x %y }
    19     19   
    20     20   # Redirect scrollwheel bindings to the scrollbar widget
    21     21   #
    22     22   # The shift-bindings scroll left/right (not up/down)
    23     23   # if a widget has both possibilities
    24         -set eventList [list <MouseWheel> <Shift-MouseWheel>]
           24  +set eventList [list <MouseWheel>]
    25     25   switch [tk windowingsystem] {
    26     26       aqua {
    27         -        lappend eventList <Option-MouseWheel> <Shift-Option-MouseWheel>
           27  +        lappend eventList <Option-MouseWheel>
    28     28       }
    29     29       x11 {
    30         -        lappend eventList <Button-4> <Button-5> <Button-6> <Button-7>\
    31         -                <Shift-Button-4> <Shift-Button-5>
           30  +        lappend eventList <Button-4> <Button-5> <Button-6> <Button-7>
    32     31       }
    33     32   }
    34     33   foreach event $eventList {
    35     34       bind TScrollbar $event [bind Scrollbar $event]
    36     35   }
    37     36   unset eventList event
    38     37   

Changes to tests/scrollbar.test.

   710    710       event generate .s <MouseWheel> -delta -4
   711    711       after 200 {set eventprocessed 1} ; vwait eventprocessed
   712    712       .t index @0,0
   713    713   } -cleanup {
   714    714       destroy .t .s
   715    715   } -result {5.0}
   716    716   
   717         -test scrollbar-10.2.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} -setup {
          717  +test scrollbar-10.2.1 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup {
   718    718       destroy .t .s
   719    719   } -body {
   720    720       pack [text .t -xscrollcommand {.s set} -wrap none] -side top
   721    721       for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
   722    722       pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
   723    723       update
   724    724       focus -force .s
   725    725       event generate .s <Shift-MouseWheel> -delta -120
   726    726       after 200 {set eventprocessed 1} ; vwait eventprocessed
   727    727       .t index @0,0
   728    728   } -cleanup {
   729    729       destroy .t .s
   730    730   } -result {1.4}
   731         -test scrollbar-10.2.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -setup {
          731  +test scrollbar-10.2.2 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {aqua} -setup {
   732    732       destroy .t .s
   733    733   } -body {
   734    734       pack [text .t -xscrollcommand {.s set} -wrap none] -side top
   735    735       for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
   736    736       pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
   737    737       update
   738    738       focus -force .s
   739    739       event generate .s <Shift-MouseWheel> -delta -4
   740    740       after 200 {set eventprocessed 1} ; vwait eventprocessed
   741    741       .t index @0,0
          742  +} -cleanup {
          743  +    destroy .t .s
          744  +} -result {1.4}
          745  +test scrollbar-10.2.3 {<MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup {
          746  +    destroy .t .s
          747  +} -body {
          748  +    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
          749  +    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
          750  +    pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
          751  +    update
          752  +    focus -force .s
          753  +    event generate .s <MouseWheel> -delta -120
          754  +    after 200 {set eventprocessed 1} ; vwait eventprocessed
          755  +    .t index @0,0
          756  +} -cleanup {
          757  +    destroy .t .s
          758  +} -result {1.4}
          759  +test scrollbar-10.2.4 {<MouseWheel> event on horizontal scrollbar} -constraints {aqua} -setup {
          760  +    destroy .t .s
          761  +} -body {
          762  +    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
          763  +    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
          764  +    pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
          765  +    update
          766  +    focus -force .s
          767  +    event generate .s <MouseWheel> -delta -4
          768  +    after 200 {set eventprocessed 1} ; vwait eventprocessed
          769  +    .t index @0,0
   742    770   } -cleanup {
   743    771       destroy .t .s
   744    772   } -result {1.4}
   745    773   
   746    774   test scrollbar-11.1 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destruction} -body {
   747    775       proc destroy_scrollbar {} {
   748    776           if {[winfo exists .top.s]} {

Changes to tests/ttk/scrollbar.test.

    65     65       .tsb configure -orient horizontal
    66     66       pack .tsb -side bottom -anchor s -expand 1 -fill x
    67     67       wm geometry . 200x200
    68     68       update
    69     69       set w [winfo width .tsb] ; set h [winfo height .tsb]
    70     70       expr {$h < $w}
    71     71   } -result 1
           72  +
           73  +test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} -setup {
           74  +    destroy .t .s
           75  +} -body {
           76  +    pack [text .t -yscrollcommand {.s set}] -side left
           77  +    for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"}
           78  +    pack [ttk::scrollbar .s -command {.t yview}] -fill y -expand 1 -side left
           79  +    update
           80  +    focus -force .s
           81  +    event generate .s <MouseWheel> -delta -120
           82  +    after 200 {set eventprocessed 1} ; vwait eventprocessed
           83  +    .t index @0,0
           84  +} -cleanup {
           85  +    destroy .t .s
           86  +} -result {5.0}
           87  +test scrollbar-10.1.2 {<MouseWheel> event on scrollbar} -constraints {aqua} -setup {
           88  +    destroy .t .s
           89  +} -body {
           90  +    pack [text .t -yscrollcommand {.s set}] -side left
           91  +    for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"}
           92  +    pack [ttk::scrollbar .s -command {.t yview}] -fill y -expand 1 -side left
           93  +    update
           94  +    focus -force .s
           95  +    event generate .s <MouseWheel> -delta -4
           96  +    after 200 {set eventprocessed 1} ; vwait eventprocessed
           97  +    .t index @0,0
           98  +} -cleanup {
           99  +    destroy .t .s
          100  +} -result {5.0}
          101  +
          102  +test scrollbar-10.2.1 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup {
          103  +    destroy .t .s
          104  +} -body {
          105  +    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
          106  +    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
          107  +    pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
          108  +    update
          109  +    focus -force .s
          110  +    event generate .s <Shift-MouseWheel> -delta -120
          111  +    after 200 {set eventprocessed 1} ; vwait eventprocessed
          112  +    .t index @0,0
          113  +} -cleanup {
          114  +    destroy .t .s
          115  +} -result {1.4}
          116  +test scrollbar-10.2.2 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {aqua} -setup {
          117  +    destroy .t .s
          118  +} -body {
          119  +    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
          120  +    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
          121  +    pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
          122  +    update
          123  +    focus -force .s
          124  +    event generate .s <Shift-MouseWheel> -delta -4
          125  +    after 200 {set eventprocessed 1} ; vwait eventprocessed
          126  +    .t index @0,0
          127  +} -cleanup {
          128  +    destroy .t .s
          129  +} -result {1.4}
          130  +test scrollbar-10.2.3 {<MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup {
          131  +    destroy .t .s
          132  +} -body {
          133  +    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
          134  +    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
          135  +    pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
          136  +    update
          137  +    focus -force .s
          138  +    event generate .s <MouseWheel> -delta -120
          139  +    after 200 {set eventprocessed 1} ; vwait eventprocessed
          140  +    .t index @0,0
          141  +} -cleanup {
          142  +    destroy .t .s
          143  +} -result {1.4}
          144  +test scrollbar-10.2.4 {<MouseWheel> event on horizontal scrollbar} -constraints {aqua} -setup {
          145  +    destroy .t .s
          146  +} -body {
          147  +    pack [text .t -xscrollcommand {.s set} -wrap none] -side top
          148  +    for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
          149  +    pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
          150  +    update
          151  +    focus -force .s
          152  +    event generate .s <MouseWheel> -delta -4
          153  +    after 200 {set eventprocessed 1} ; vwait eventprocessed
          154  +    .t index @0,0
          155  +} -cleanup {
          156  +    destroy .t .s
          157  +} -result {1.4}
    72    158   
    73    159   #
    74    160   # Scale tests:
    75    161   #
    76    162   
    77    163   test scale-1.0 "Self-destruction" -body {
    78    164       trace variable v w { destroy .s ;# }