Skip to content

Commit c8b5ce5

Browse files
author
csaba
committed
* scripts/*.tcl: Added support for the platform-independent
 * scripts/mwutil/*.tcl: handling of mouse wheel events (TIP 474); updated the mwutil package to version 2.18, like in Tablelist6.12; updated the copyright information.
1 parent 2413db3 commit c8b5ce5

File tree

8 files changed

+85
-38
lines changed

8 files changed

+85
-38
lines changed

‎modules/mentry/scripts/mentryDateTime.tcl‎

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
#==============================================================================
22
# Contains the implementation of multi-entry widgets for date and time.
33
#
4-
# Copyright (c) 1999-2020 Csaba Nemethi (E-mail: [email protected])
4+
# Copyright (c) 1999-2021 Csaba Nemethi (E-mail: [email protected])
55
#==============================================================================
66

77
#
@@ -31,8 +31,18 @@ namespace eval mentry {
3131
bind MentryMeridian <Prior> { mentry::setMeridian %W "P" }
3232
bind MentryMeridian <Next> { mentry::setMeridian %W "A" }
3333
variable winSys
34-
if {[string compare $winSys "classic"] == 0 ||
35-
[string compare $winSys "aqua"] == 0} {
34+
variable uniformWheelSupport
35+
if {$uniformWheelSupport} {
36+
bind MentryDateTime <MouseWheel> {
37+
mentry::incrDateTimeComp %W \
38+
[expr {%D > 0 ? (%D + 119) / 120 : %D / 120}]
39+
}
40+
bind MentryDateTime <Option-MouseWheel> {
41+
mentry::incrDateTimeComp %W \
42+
[expr {%D > 0 ? (%D + 11) / 12 : %D / 12}]
43+
}
44+
} elseif {[string compare $winSys "classic"] == 0 ||
45+
[string compare $winSys "aqua"] == 0} {
3646
catch {
3747
bind MentryDateTime <MouseWheel> {
3848
mentry::incrDateTimeComp %W %D

‎modules/mentry/scripts/mentryFixedPoint.tcl‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
# Contains the implementation of a multi-entry widget for real numbers in
33
# fixed-point format.
44
#
5-
# Copyright (c) 1999-2020 Csaba Nemethi (E-mail: [email protected])
5+
# Copyright (c) 1999-2021 Csaba Nemethi (E-mail: [email protected])
66
#==============================================================================
77

88
#

‎modules/mentry/scripts/mentryIPAddr.tcl‎

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
#==============================================================================
22
# Contains the implementation of a multi-entry widget for IP addresses.
33
#
4-
# Copyright (c) 1999-2020 Csaba Nemethi (E-mail: [email protected])
4+
# Copyright (c) 1999-2021 Csaba Nemethi (E-mail: [email protected])
55
#==============================================================================
66

77
#
@@ -18,8 +18,18 @@ namespace eval mentry {
1818
bind MentryIPAddr <Prior> { mentry::incrIPAddrComp %W 10 }
1919
bind MentryIPAddr <Next> { mentry::incrIPAddrComp %W -10 }
2020
variable winSys
21-
if {[string compare $winSys "classic"] == 0 ||
22-
[string compare $winSys "aqua"] == 0} {
21+
variable uniformWheelSupport
22+
if {$uniformWheelSupport} {
23+
bind MentryIPAddr <MouseWheel> {
24+
mentry::incrIPAddrComp %W \
25+
[expr {%D > 0 ? (%D + 119) / 120 : %D / 120}]
26+
}
27+
bind MentryIPAddr <Option-MouseWheel> {
28+
mentry::incrIPAddrComp %W \
29+
[expr {%D > 0 ? (%D + 11) / 12 : %D / 12}]
30+
}
31+
} elseif {[string compare $winSys "classic"] == 0 ||
32+
[string compare $winSys "aqua"] == 0} {
2333
catch {
2434
bind MentryIPAddr <MouseWheel> {
2535
mentry::incrIPAddrComp %W %D

‎modules/mentry/scripts/mentryIPv6Addr.tcl‎

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
#==============================================================================
22
# Contains the implementation of a multi-entry widget for IPv6 addresses.
33
#
4-
# Copyright (c) 2009-2020 Csaba Nemethi (E-mail: [email protected])
4+
# Copyright (c) 2009-2021 Csaba Nemethi (E-mail: [email protected])
55
#==============================================================================
66

77
#
@@ -18,8 +18,18 @@ namespace eval mentry {
1818
bind MentryIPv6Addr <Prior> { mentry::incrIPv6AddrComp %W 10 }
1919
bind MentryIPv6Addr <Next> { mentry::incrIPv6AddrComp %W -10 }
2020
variable winSys
21-
if {[string compare $winSys "classic"] == 0 ||
22-
[string compare $winSys "aqua"] == 0} {
21+
variable uniformWheelSupport
22+
if {$uniformWheelSupport} {
23+
bind MentryIPv6Addr <MouseWheel> {
24+
mentry::incrIPv6AddrComp %W \
25+
[expr {%D > 0 ? (%D + 119) / 120 : %D / 120}]
26+
}
27+
bind MentryIPv6Addr <Option-MouseWheel> {
28+
mentry::incrIPv6AddrComp %W \
29+
[expr {%D > 0 ? (%D + 11) / 12 : %D / 12}]
30+
}
31+
} elseif {[string compare $winSys "classic"] == 0 ||
32+
[string compare $winSys "aqua"] == 0} {
2333
catch {
2434
bind MentryIPv6Addr <MouseWheel> {
2535
mentry::incrIPv6AddrComp %W %D

‎modules/mentry/scripts/mentryThemes.tcl‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
# - Private procedures related to tile themes
88
# - Private procedures related to global KDE configuration options
99
#
10-
# Copyright (c) 2006-2020 Csaba Nemethi (E-mail: [email protected])
10+
# Copyright (c) 2006-2021 Csaba Nemethi (E-mail: [email protected])
1111
#==============================================================================
1212

1313
#

‎modules/mentry/scripts/mentryWidget.tcl‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@
1111
# - Private procedures used in bindings
1212
# - Private utility procedures
1313
#
14-
# Copyright (c) 1999-2020 Csaba Nemethi (E-mail: [email protected])
14+
# Copyright (c) 1999-2021 Csaba Nemethi (E-mail: [email protected])
1515
#==============================================================================
1616

1717
#
@@ -89,6 +89,9 @@ namespace eval mentry {
8989
variable extendedAquaSupport \
9090
[expr {[lsearch -exact [image types] "nsimage"] >= 0}]
9191

92+
variable uniformWheelSupport [expr {$::tk_version >= 8.7 &&
93+
[package vcompare $::tk_patchLevel "8.7a4"] >= 0}]
94+
9295
#
9396
# The array configSpecs is used to handle configuration options. The
9497
# names of its elements are the configuration options for the Mentry widget
@@ -1624,10 +1627,7 @@ proc mentry::updateConfigSpecs win {
16241627
#------------------------------------------------------------------------------
16251628
proc mentry::handleAppearanceEvent {} {
16261629
variable appearanceId
1627-
if {[info exists appearanceId] } {
1628-
after cancel $appearanceId
1629-
unset appearanceId
1630-
}
1630+
unset appearanceId
16311631

16321632
variable currentTheme
16331633
if {[string compare $currentTheme "aqua"] != 0} {

‎modules/mentry/scripts/mwutil/mwutil.tcl‎

Lines changed: 37 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@
55
# - Namespace initialization
66
# - Public utility procedures
77
#
8-
# Copyright (c) 2000-2020 Csaba Nemethi (E-mail: [email protected])
8+
# Copyright (c) 2000-2021 Csaba Nemethi (E-mail: [email protected])
99
#==============================================================================
1010

1111
package require Tk 8
@@ -19,7 +19,7 @@ namespace eval mwutil {
1919
#
2020
# Public variables:
2121
#
22-
variable version 2.17
22+
variable version 2.18
2323
variable library
2424
if {$::tcl_version >= 8.4} {
2525
set library [file dirname [file normalize [info script]]]
@@ -35,8 +35,8 @@ namespace eval mwutil {
3535
configureWidget fullConfigOpt fullOpt enumOpts \
3636
configureSubCmd attribSubCmd hasattribSubCmd \
3737
unsetattribSubCmd getScrollInfo getScrollInfo2 \
38-
isScrollable hasFocus genMouseWheelEvent \
39-
windowingSystem currentTheme
38+
isScrollable scrollByUnits genMouseWheelEvent \
39+
hasFocus windowingSystem currentTheme
4040

4141
#
4242
# Make modified versions of the procedures tk_focusNext and
@@ -507,7 +507,9 @@ proc mwutil::getScrollInfo argList {
507507
wrongNumArgs "scroll number units|pages"
508508
}
509509

510-
set number [format "%d" [lindex $argList 1]]
510+
set number [lindex $argList 1]
511+
format "%f" $number ;# floating-point number check with error message
512+
set number [expr {int($number > 0 ? ceil($number) : floor($number))}]
511513
set what [lindex $argList 2]
512514
if {[string first $what "units"] == 0} {
513515
return [list scroll $number units]
@@ -545,7 +547,9 @@ proc mwutil::getScrollInfo2 {cmd argList} {
545547
wrongNumArgs "$cmd scroll number units|pages"
546548
}
547549

548-
set number [format "%d" [lindex $argList 1]]
550+
set number [lindex $argList 1]
551+
format "%f" $number ;# floating-point number check with error message
552+
set number [expr {int($number > 0 ? ceil($number) : floor($number))}]
549553
set what [lindex $argList 2]
550554
if {[string first $what "units"] == 0} {
551555
return [list scroll $number units]
@@ -577,21 +581,16 @@ proc mwutil::isScrollable {w axis} {
577581
}
578582

579583
#------------------------------------------------------------------------------
580-
# mwutil::hasFocus
584+
# mwutil::scrollByUnits
581585
#
582-
# Returns a boolean value indicating whether the focus window is (a descendant
583-
# of) the widget w and has the same toplevel.
584-
#------------------------------------------------------------------------------
585-
proc mwutil::hasFocus w {
586-
set focusWin [focus -displayof $w]
587-
if {[string length $focusWin] == 0} {
588-
return 0
589-
}
590-
591-
return [expr {
592-
([string compare $w "."] == 0 || [string first $w. $focusWin.] == 0) &&
593-
[string compare [winfo toplevel $w] [winfo toplevel $focusWin]] == 0
594-
}]
586+
# Scrolls the widget w along a given axis (x or y) by units. The number of
587+
# units is obtained by converting the fraction built from the last two
588+
# arguments to an integer, rounded away from 0.
589+
#------------------------------------------------------------------------------
590+
proc mwutil::scrollByUnits {w axis delta divisor} {
591+
set number [expr {$delta/$divisor}]
592+
set number [expr {int($number > 0 ? ceil($number) : floor($number))}]
593+
$w ${axis}view scroll $number units
595594
}
596595

597596
#------------------------------------------------------------------------------
@@ -617,6 +616,24 @@ proc mwutil::genMouseWheelEvent {w event rootX rootY delta} {
617616
}
618617
}
619618

619+
#------------------------------------------------------------------------------
620+
# mwutil::hasFocus
621+
#
622+
# Returns a boolean value indicating whether the focus window is (a descendant
623+
# of) the widget w and has the same toplevel.
624+
#------------------------------------------------------------------------------
625+
proc mwutil::hasFocus w {
626+
set focusWin [focus -displayof $w]
627+
if {[string length $focusWin] == 0} {
628+
return 0
629+
}
630+
631+
return [expr {
632+
([string compare $w "."] == 0 || [string first $w. $focusWin.] == 0) &&
633+
[string compare [winfo toplevel $w] [winfo toplevel $focusWin]] == 0
634+
}]
635+
}
636+
620637
#------------------------------------------------------------------------------
621638
# mwutil::windowingSystem
622639
#

‎modules/mentry/scripts/mwutil/pkgIndex.tcl‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
#==============================================================================
22
# mwutil package index file.
33
#
4-
# Copyright (c) 2020 Csaba Nemethi (E-mail: [email protected])
4+
# Copyright (c) 2020-2021 Csaba Nemethi (E-mail: [email protected])
55
#==============================================================================
66

7-
package ifneeded mwutil 2.17 [list source [file join $dir mwutil.tcl]]
7+
package ifneeded mwutil 2.18 [list source [file join $dir mwutil.tcl]]

0 commit comments

Comments
 (0)