Tk Library Source Code

Check-in [ff86f0ffea]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki

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

Overview
Comment: * scripts/wheelEvent.tcl: Creating mouse wheel event class bindings for the Tk core scrollbar widget on Windows and X11, which are missing on these platforms when using a Tk version earlier than 8.6.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: ff86f0ffea7233918ffdb444b8ab870254bfa94df342ba754caf99985b8296c5
User & Date: csaba 2020-02-05 18:09:27.472
Context
2020-02-05
18:10
* scripts/tclIndex: Newly generated. check-in: f72a365dc0 user: csaba tags: trunk
18:09
* scripts/wheelEvent.tcl: Creating mouse wheel event class bindings for the Tk core scrollbar widget on Windows and X11, which are missing on these platforms when using a Tk version earlier than 8.6. check-in: ff86f0ffea user: csaba tags: trunk
18:08
* scripts/scrollarea.tcl: Improved the handling of the case that the scrollbar lock prevented a scrollbar of a scrollarea widget from being unmapped. check-in: bddf6d5624 user: csaba tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to modules/scrollutil/scripts/wheelEvent.tcl.
︙︙
38
39
40
41
42
43
44
45
46
47
48
49
50






























51
52
53
54
55
56
57
58
59
60
61
62
63
64
65




66
67
68
69
70
71
72

# Private procedure creating mouse wheel event and <Destroy> bindings
# ===================================================================
#

#------------------------------------------------------------------------------
# scrollutil::createBindings
#
# Creates mouse wheel event bindings for the binding tags TScrollbar,
# WheeleventRedir, and WheeleventBreak, as well as <Destroy> bindings for the
# binding tags ScrlWidgetCont and WheeleventWidget.
#------------------------------------------------------------------------------
proc scrollutil::createBindings {} {
    variable winSys































    set eventList [list <MouseWheel> <Shift-MouseWheel>]
    switch $winSys {
	aqua {
	    lappend eventList <Option-MouseWheel> <Shift-Option-MouseWheel>
	}
	x11 {
	    lappend eventList <Button-4> <Button-5> \
			      <Shift-Button-4> <Shift-Button-5>
	    if {[package vcompare $::tk_patchLevel "8.7a3"] >= 0} {
		lappend eventList <Button-6> <Button-7>
	    }
	}
    }





    foreach event $eventList {
	bind TScrollbar $event [bind Scrollbar $event]
    }

    if {$winSys eq "win32" && [package vcompare $::tk_patchLevel "8.6b2"] < 0} {
	return ""
    }








|
|
|



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















>
>
>
>








38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
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

# Private procedure creating mouse wheel event and <Destroy> bindings
# ===================================================================
#

#------------------------------------------------------------------------------
# scrollutil::createBindings
#
# Creates mouse wheel event bindings for the binding tags Scrollbar,
# TScrollbar, WheeleventRedir, and WheeleventBreak, as well as <Destroy>
# bindings for the binding tags ScrlWidgetCont and WheeleventWidget.
#------------------------------------------------------------------------------
proc scrollutil::createBindings {} {
    variable winSys

    #
    # On the windowing systems win32 and x11 there are no built-in
    # mouse wheel event bindings for the binding tag Scrollbar
    # if the Tk version is earlier than 8.6 -- create them here
    #
    if {$winSys eq "win32" || $winSys eq "x11"} {
	set scrollByUnits [expr {
	    [llength [info commands ::tk::ScrollByUnits]] == 0 ?
	    "tkScrollByUnits" : "tk::ScrollByUnits"}]

	bind Scrollbar <MouseWheel> [format {
	    %s %%W v [expr {%%D >= 0 ? (-%%D) / 30 : (-(%%D) + 29) / 30}]
	} $scrollByUnits]
	bind Scrollbar <Shift-MouseWheel> [format {
	    %s %%W h [expr {%%D >= 0 ? (-%%D) / 30 : (-(%%D) + 29) / 30}]
	} $scrollByUnits]

	if {$winSys eq "x11"} {
	    bind Scrollbar <Button-4>	    [list $scrollByUnits %W v -5]
	    bind Scrollbar <Button-5>	    [list $scrollByUnits %W v  5]
	    bind Scrollbar <Shift-Button-4> [list $scrollByUnits %W h -5]
	    bind Scrollbar <Shift-Button-5> [list $scrollByUnits %W h  5]

	    if {[package vcompare $::tk_patchLevel "8.7a3"] >= 0} {
		bind Scrollbar <Button-6>   [list $scrollByUnits %W h -5]
		bind Scrollbar <Button-7>   [list $scrollByUnits %W h  5]
	    }
	}
    }

    set eventList [list <MouseWheel> <Shift-MouseWheel>]
    switch $winSys {
	aqua {
	    lappend eventList <Option-MouseWheel> <Shift-Option-MouseWheel>
	}
	x11 {
	    lappend eventList <Button-4> <Button-5> \
			      <Shift-Button-4> <Shift-Button-5>
	    if {[package vcompare $::tk_patchLevel "8.7a3"] >= 0} {
		lappend eventList <Button-6> <Button-7>
	    }
	}
    }

    #
    # Copy the mouse wheel event bindings of the widget
    # class Scrollbar to the binding tag TScrollbar
    #
    foreach event $eventList {
	bind TScrollbar $event [bind Scrollbar $event]
    }

    if {$winSys eq "win32" && [package vcompare $::tk_patchLevel "8.6b2"] < 0} {
	return ""
    }
︙︙
This page was generated in about 0.014s by Fossil 2.26 [1205ec86cb] 2025-04-30 16:57:32