Check-in [23505fa586]
Not logged in

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

Overview
Comment:update scrollutil to version 1.4
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 23505fa586252903bf93a2c0483c795e9236de16
User & Date: chw 2020-01-11 12:26:24
Context
2020-01-13
16:27
add selected tcl upstream changes check-in: 944800d6ea user: chw tags: trunk
2020-01-11
12:26
update scrollutil to version 1.4 check-in: 23505fa586 user: chw tags: trunk
2020-01-10
20:10
add tcl upstream changes check-in: 74dd374960 user: chw tags: trunk
Changes

Changes to assets/tklib0.6/scrollutil/CHANGES.txt.

1
2



























3
4
5
6
7
8
9
What is new in Scrollutil 1.3?
------------------------------




























1. The scrollarea widget of the Scrollutil_tile package now uses
   ttk::scrollbar widgets on Mac OS X, too, provided that the Tk release
   is 8.6.10 or later.

2. Improvements related to the scrollsync widget.

|

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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
What is new in Scrollutil 1.4?
------------------------------

1. Added the commands "scrollutil::getscrollarea" and
   "scrollutil::getscrollsync", designed to query the scrollarea and
   scrollsync, respectively containing a given widget.

2. Added the command "scrollutil::addMouseWheelSupport", which can be
   used, e.g., to add mouse wheel support to canvas widgets (thanks to
   Julian H J Loaring for his proposal) and to restore the "old-school"
   mouse wheel event handling for text widgets, which performs scrolling
   by lines and characters rather than pixels.

3. Scrollutil now automatically creates mouse wheel event class bindings
   for the ttk::scrollbar widget (thanks to Harald Oehlmann for his
   proposal and discussions on this subject).

4. If a widget that is embedded into a scrollarea is passed to
   "scrollutil::adaptWheelEventHandling", then this command gets
   automatically invoked for the scrollbars of that scrollarea, too.

5. Added the missing pieces of code related to the bindings for
   horizontal scrolling with the aid of mouse buttons 6 and 7 in Tk
   8.7.a3 or later on X11.

6. Several improvements in the demo scripts and documentation.

What was new in Scrollutil 1.3?
-------------------------------

1. The scrollarea widget of the Scrollutil_tile package now uses
   ttk::scrollbar widgets on Mac OS X, too, provided that the Tk release
   is 8.6.10 or later.

2. Improvements related to the scrollsync widget.

Changes to assets/tklib0.6/scrollutil/COPYRIGHT.txt.

1
2
3
4
5
6
7
8
9
10
Scrolling utilities package Scrollutil 1.3
Copyright (c) 2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)

This library is free software; you can use, modify, and redistribute it
for any purpose, provided that existing copyright notices are retained
in all copies and that this notice is included verbatim in any
distributions.

This software is distributed WITHOUT ANY WARRANTY; without even the
implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|








1
2
3
4
5
6
7
8
9
10
Scrolling utilities package Scrollutil 1.4
Copyright (c) 2019-2020  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)

This library is free software; you can use, modify, and redistribute it
for any purpose, provided that existing copyright notices are retained
in all copies and that this notice is included verbatim in any
distributions.

This software is distributed WITHOUT ANY WARRANTY; without even the
implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

Changes to assets/tklib0.6/scrollutil/ChangeLog.





































1
2
3
4
5
6
7




































2019-12-12  Csaba Nemethi <csaba.nemethi@t-online.de>

	* ../../examples/scrollutil/SyncListboxes.tcl: Minor improvement.

2019-12-11  Csaba Nemethi <csaba.nemethi@t-online.de>

	* doc/*.png: Updated.
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
2020-01-10  Csaba Nemethi <csaba.nemethi@t-online.de>

	* README.txt: Updated the version number.

2020-01-07  Csaba Nemethi <csaba.nemethi@t-online.de>

	* *.tcl:         Bumped the version number to 1.4; updated the copyright
	* COPYRIGHT.txt: information.

	* CHANGES.txt: Updated to reflect the changes.
	* README.txt:

	* scripts/scrollarea.tcl: Added the command "scrollutil::getscrollarea";
	  updated the copyright information.

	* scripts/scrollsync.tcl: Added the command "scrollutil::getscrollsync";
	  updated the copyright information.

	* scripts/wheelEvent.tcl: Added the command
	  "scrollutil::addMouseWheelSupport; created mouse wheel event class
	  bindings for the ttk::scrollbar widget; automatically invoking
	  "scrollutil::adaptWheelEventHandling" for the scrollbars of the
	  scrollarea whose widget was passed to this command; added the missing
	  pieces of code related to the bindings for mouse buttons 6 and 7 in
	  Tk 8.7.a3 or later on X11; updated the copyright information.

	* scripts/mwutil.tcl:          Minor improvemets; updated the copyright
	* scripts/scrollableframe.tcl: information.

	* scripts/tclIndex: Newly generated.

	* doc/*.html: Updated to reflect the changes; several improvements.

	* ../../examples/scrollutil/*: Minor improvements; updated the copyright
	  information.

2019-12-12  Csaba Nemethi <csaba.nemethi@t-online.de>

	* ../../examples/scrollutil/SyncListboxes.tcl: Minor improvement.

2019-12-11  Csaba Nemethi <csaba.nemethi@t-online.de>

	* doc/*.png: Updated.

Changes to assets/tklib0.6/scrollutil/README.txt.

12
13
14
15
16
17
18



19
20
21
22
23
24
25
..
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
..
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

Scrollutil is a library package for Tcl/Tk versions 8.0 or higher,
written in pure Tcl/Tk code.  It contains:

  - the implementation of the "scrollarea", "scrollsync", and
    "scrollableframe" mega-widgets, including a general utility module
    for mega-widgets;



  - commands for user-friendly mouse wheel event handling in scrollable
    widget containers like scrollutil::scrollableframe, BWidget
    ScrollableFrame, and iwidgets::scrolledframe.  These commands
    require Tcl/Tk versions 8.4 or higher on X11 and Mac OS X and Tk
    8.6b2 or later on Windows;
  - demo scripts illustrating the use of the Scrollutil package in
    connection with various scrollable widgets and the above-mentioned
................................................................................
How to Get It?
--------------

Scrollutil is available for free download from the Web page

    https://www.nemethi.de

The distribution file is "scrollutil1.3.tar.gz" for UNIX and
"scrollutil1_3.zip" for Windows.  These files contain the same
information, except for the additional carriage return character
preceding the linefeed at the end of each line in the text files for
Windows.

Scrollutil is also included in tklib, which has the address

    https://core.tcl.tk/tklib
................................................................................
Install the package as a subdirectory of one of the directories given
by the "auto_path" variable.  For example, you can install it as a
directory at the same level as the Tcl and Tk script libraries.  The
locations of these library directories are given by the "tcl_library"
and "tk_library" variables, respectively.

To install Scrollutil on UNIX, "cd" to the desired directory and unpack
the distribution file "scrollutil1.3.tar.gz":

    gunzip -c scrollutil1.3.tar.gz | tar -xf -

On most UNIX systems this can be replaced with

    tar -zxf scrollutil1.3.tar.gz

Both commands will create a directory named "scrollutil1.3", with the
subdirectories "demos", "doc", and "scripts".

On Windows, use WinZip or some other program capable of unpacking the
distribution file "scrollutil1_3.zip" into the directory
"scrollutil1.3", with the subdirectories "demos", "doc", and "scripts".

How to Use It?
--------------

The Scrollutil distribution provides two packages, called Scrollutil and
Scrollutil_tile.  The main difference between the two is that
Scrollutil_tile enables the tile-based, theme-specific appearance of







>
>
>







 







|
|







 







|

|



|

|



|
|







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
..
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
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

Scrollutil is a library package for Tcl/Tk versions 8.0 or higher,
written in pure Tcl/Tk code.  It contains:

  - the implementation of the "scrollarea", "scrollsync", and
    "scrollableframe" mega-widgets, including a general utility module
    for mega-widgets;
  - the command "scrollutil::addMouseWheelSupport", which creates mouse
    wheel event bindings for a given binding tag.  This command requires
    Tcl/Tk 8.4 or later;
  - commands for user-friendly mouse wheel event handling in scrollable
    widget containers like scrollutil::scrollableframe, BWidget
    ScrollableFrame, and iwidgets::scrolledframe.  These commands
    require Tcl/Tk versions 8.4 or higher on X11 and Mac OS X and Tk
    8.6b2 or later on Windows;
  - demo scripts illustrating the use of the Scrollutil package in
    connection with various scrollable widgets and the above-mentioned
................................................................................
How to Get It?
--------------

Scrollutil is available for free download from the Web page

    https://www.nemethi.de

The distribution file is "scrollutil1.4.tar.gz" for UNIX and
"scrollutil1_4.zip" for Windows.  These files contain the same
information, except for the additional carriage return character
preceding the linefeed at the end of each line in the text files for
Windows.

Scrollutil is also included in tklib, which has the address

    https://core.tcl.tk/tklib
................................................................................
Install the package as a subdirectory of one of the directories given
by the "auto_path" variable.  For example, you can install it as a
directory at the same level as the Tcl and Tk script libraries.  The
locations of these library directories are given by the "tcl_library"
and "tk_library" variables, respectively.

To install Scrollutil on UNIX, "cd" to the desired directory and unpack
the distribution file "scrollutil1.4.tar.gz":

    gunzip -c scrollutil1.4.tar.gz | tar -xf -

On most UNIX systems this can be replaced with

    tar -zxf scrollutil1.4.tar.gz

Both commands will create a directory named "scrollutil1.4", with the
subdirectories "demos", "doc", and "scripts".

On Windows, use WinZip or some other program capable of unpacking the
distribution file "scrollutil1_4.zip" into the directory
"scrollutil1.4", with the subdirectories "demos", "doc", and "scripts".

How to Use It?
--------------

The Scrollutil distribution provides two packages, called Scrollutil and
Scrollutil_tile.  The main difference between the two is that
Scrollutil_tile enables the tile-based, theme-specific appearance of

Changes to assets/tklib0.6/scrollutil/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
#==============================================================================
# Scrollutil and Scrollutil_tile package index file.
#
# Copyright (c) 2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Regular packages:
#
package ifneeded scrollutil         1.3 \
	[list source [file join $dir scrollutil.tcl]]
package ifneeded scrollutil_tile    1.3 \
	[list source [file join $dir scrollutil_tile.tcl]]

#
# Aliases:
#
package ifneeded Scrollutil         1.3 \
	[list package require -exact scrollutil      1.3]
package ifneeded Scrollutil_tile    1.3 \
	[list package require -exact scrollutil_tile 1.3]

#
# Code common to all packages:
#
package ifneeded scrollutil::common 1.3 \
	[list source [file join $dir scrollutilCommon.tcl]]



|





|

|





|
|
|
|




|

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
#==============================================================================
# Scrollutil and Scrollutil_tile package index file.
#
# Copyright (c) 2019-2020  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Regular packages:
#
package ifneeded scrollutil         1.4 \
	[list source [file join $dir scrollutil.tcl]]
package ifneeded scrollutil_tile    1.4 \
	[list source [file join $dir scrollutil_tile.tcl]]

#
# Aliases:
#
package ifneeded Scrollutil         1.4 \
	[list package require -exact scrollutil      1.4]
package ifneeded Scrollutil_tile    1.4 \
	[list package require -exact scrollutil_tile 1.4]

#
# Code common to all packages:
#
package ifneeded scrollutil::common 1.4 \
	[list source [file join $dir scrollutilCommon.tcl]]

Changes to assets/tklib0.6/scrollutil/scripts/mwutil.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#==============================================================================
# Contains utility procedures for mega-widgets.
#
# Structure of the module:
#   - Namespace initialization
#   - Public utility procedures
#
# Copyright (c) 2000-2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

package require Tk 8

#
# Namespace initialization
# ========================







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#==============================================================================
# Contains utility procedures for mega-widgets.
#
# Structure of the module:
#   - Namespace initialization
#   - Public utility procedures
#
# Copyright (c) 2000-2020  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

package require Tk 8

#
# Namespace initialization
# ========================

Changes to assets/tklib0.6/scrollutil/scripts/scrollableframe.tcl.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
#   - Namespace initialization
#   - Private procedure creating the default bindings
#   - Public procedure creating a new scrollableframe widget
#   - Private configuration procedures
#   - Private procedures implementing the scrollableframe widget command
#   - Private procedures used in bindings
#
# Copyright (c) 2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................
	return -code error "bad window path name \"$w\""
    }

    upvar ::scrollutil::ns${win}::data data
    set cf $data(cf)
    if {[string first $cf. $w] != 0} {
	return -code error \
	    "widget \"$w\" is not a descendant of the content frame of \"$win\""
    }
    if {[string compare [winfo toplevel $w] [winfo toplevel $win]] != 0} {
	return -code error \
	    "widgets \"$w\" and \"$win\" have different toplevels"
    }
    if {[string length [winfo manager $w]] == 0} {
	return -code error \
	    "widget \"$w\" is not managed by any geometry manager"
    }

    #
    # Parse the optional argument
    #
    if {$argCount == 1} {
	set xSide w







|







 







|


|
<


<
|







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
517
518
519
520
521
522
523
524
525
526
527

528
529

530
531
532
533
534
535
536
537
#   - Namespace initialization
#   - Private procedure creating the default bindings
#   - Public procedure creating a new scrollableframe widget
#   - Private configuration procedures
#   - Private procedures implementing the scrollableframe widget command
#   - Private procedures used in bindings
#
# Copyright (c) 2019-2020  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................
	return -code error "bad window path name \"$w\""
    }

    upvar ::scrollutil::ns${win}::data data
    set cf $data(cf)
    if {[string first $cf. $w] != 0} {
	return -code error \
	    "widget $w is not a descendant of the content frame of $win"
    }
    if {[string compare [winfo toplevel $w] [winfo toplevel $win]] != 0} {
	return -code error "widgets $w and $win have different toplevels"

    }
    if {[string length [winfo manager $w]] == 0} {

	return -code error "widget $w is not managed by any geometry manager"
    }

    #
    # Parse the optional argument
    #
    if {$argCount == 1} {
	set xSide w

Changes to assets/tklib0.6/scrollutil/scripts/scrollarea.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
...
246
247
248
249
250
251
252



















253
254
255
256
257
258
259
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
...
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
...
446
447
448
449
450
451
452






453
454
455
456

457
458
459
460
461
462
463
464
465
466
467
468
469
470
...
679
680
681
682
683
684
685
686
687
688
689

690

691
692
693
694
695
696
697
#==============================================================================
# Contains the implementation of the scrollarea widget.
#
# Structure of the module:
#   - Namespace initialization
#   - Private procedure creating the default bindings
#   - Public procedure creating a new scrollarea widget
#   - Private configuration procedures
#   - Private procedures implementing the scrollarea widget command
#   - Private callback procedures
#   - Private procedures used in bindings
#   - Private utility procedures
#
# Copyright (c) 2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................

    bind WidgetOfScrollarea <Destroy> {
	scrollutil::sa::onWidgetOfScrollareaDestroy %W
    }
}

#
# Public procedure creating a new scrollarea widget
# =================================================
#

#------------------------------------------------------------------------------
# scrollutil::scrollarea
#
# Creates a new scrollarea widget whose name is specified as the first command-
# line argument, and configures it according to the options and their values
................................................................................
    #
    rename ::$win sa::$win
    interp alias {} ::$win {} scrollutil::sa::scrollareaWidgetCmd $win

    return $win
}




















#
# Private configuration procedures
# ================================
#

#------------------------------------------------------------------------------
# scrollutil::sa::doConfig
................................................................................
		-xscrollbarmode {
		    variable scrollbarModes
		    set val \
			[mwutil::fullOpt "scrollbar mode" $val $scrollbarModes]
		    if {[string compare $val "none"] != 0 &&
			[winfo exists $data(widget)]} {
			if {![mwutil::isScrollable $data(widget) x]} {
			    return -code error "\"$data(widget)\" fails to\
				support horizontal scrolling"
			}
		    }
		    set data($opt) $val

		    set tagList [bindtags $win.hsb]
		    set idx [lsearch -exact $tagList "DynamicHScrollbar"]
................................................................................
		-yscrollbarmode {
		    variable scrollbarModes
		    set val \
			[mwutil::fullOpt "scrollbar mode" $val $scrollbarModes]
		    if {[string compare $val "none"] != 0 &&
			[winfo exists $data(widget)]} {
			if {![mwutil::isScrollable $data(widget) y]} {
			    return -code error "\"$data(widget)\" fails to\
				support vertical scrolling"
			}
		    }
		    set data($opt) $val

		    switch $val {
			static	{ showVScrollbar $win }
................................................................................
# Processes the scrollarea setwidget subcommmand.
#------------------------------------------------------------------------------
proc scrollutil::sa::setwidgetSubCmd {win widget} {
    variable scrollareaArr
    upvar ::scrollutil::ns${win}::data data

    if {[winfo exists $widget]} {






	if {[string compare $data(-xscrollbarmode) "none"] != 0} {
	    if {![mwutil::isScrollable $widget x]} {
		return -code error "\"$widget\" fails to support horizontal\
		    scrolling"

	    }
	}

	if {[string compare $data(-yscrollbarmode) "none"] != 0} {
	    if {![mwutil::isScrollable $widget y]} {
		return -code error "\"$widget\" fails to support vertical\
		    scrolling"
	    }
	}
    } elseif {[string length $widget] != 0} {
	return -code error "bad window path name \"$widget\""
    }

    set oldWidget $data(widget)
................................................................................
}

#------------------------------------------------------------------------------
# scrollutil::sa::onWidgetOfScrollareaDestroy
#------------------------------------------------------------------------------
proc scrollutil::sa::onWidgetOfScrollareaDestroy widget {
    variable scrollareaArr
    set win $scrollareaArr($widget)
    unset scrollareaArr($widget)

    if {[winfo exists $win] &&

	[string compare [winfo class $win] "Scrollarea"] == 0} {

	::$win setwidget ""
    }
}

#------------------------------------------------------------------------------
# scrollutil::sa::onHeaderHeightChanged
#------------------------------------------------------------------------------






|






|







 







|
|







 







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







 







|







 







|







 







>
>
>
>
>
>


|
<
>





|
|







 







|
|
|
<
>
|
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
...
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
...
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
...
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
...
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480

481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
...
704
705
706
707
708
709
710
711
712
713

714
715
716
717
718
719
720
721
722
723
#==============================================================================
# Contains the implementation of the scrollarea widget.
#
# Structure of the module:
#   - Namespace initialization
#   - Private procedure creating the default bindings
#   - Public procedures creating or quering a scrollarea widget
#   - Private configuration procedures
#   - Private procedures implementing the scrollarea widget command
#   - Private callback procedures
#   - Private procedures used in bindings
#   - Private utility procedures
#
# Copyright (c) 2019-2020  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................

    bind WidgetOfScrollarea <Destroy> {
	scrollutil::sa::onWidgetOfScrollareaDestroy %W
    }
}

#
# Public procedures creating or quering a scrollarea widget
# =========================================================
#

#------------------------------------------------------------------------------
# scrollutil::scrollarea
#
# Creates a new scrollarea widget whose name is specified as the first command-
# line argument, and configures it according to the options and their values
................................................................................
    #
    rename ::$win sa::$win
    interp alias {} ::$win {} scrollutil::sa::scrollareaWidgetCmd $win

    return $win
}

#------------------------------------------------------------------------------
# scrollutil::getscrollarea
#
# Queries the scrollarea into which a given widget is embedded via the
# scrollarea's setwidget subcommand.
#------------------------------------------------------------------------------
proc scrollutil::getscrollarea widget {
    variable sa::scrollareaArr
    if {[info exists scrollareaArr($widget)]} {
	set win $scrollareaArr($widget)
	if {[winfo exists $win] &&
	    [string compare [winfo class $win] "Scrollarea"] == 0} {
	    return $win
	}
    }

    return ""
}

#
# Private configuration procedures
# ================================
#

#------------------------------------------------------------------------------
# scrollutil::sa::doConfig
................................................................................
		-xscrollbarmode {
		    variable scrollbarModes
		    set val \
			[mwutil::fullOpt "scrollbar mode" $val $scrollbarModes]
		    if {[string compare $val "none"] != 0 &&
			[winfo exists $data(widget)]} {
			if {![mwutil::isScrollable $data(widget) x]} {
			    return -code error "widget $data(widget) fails to\
				support horizontal scrolling"
			}
		    }
		    set data($opt) $val

		    set tagList [bindtags $win.hsb]
		    set idx [lsearch -exact $tagList "DynamicHScrollbar"]
................................................................................
		-yscrollbarmode {
		    variable scrollbarModes
		    set val \
			[mwutil::fullOpt "scrollbar mode" $val $scrollbarModes]
		    if {[string compare $val "none"] != 0 &&
			[winfo exists $data(widget)]} {
			if {![mwutil::isScrollable $data(widget) y]} {
			    return -code error "widget $data(widget) fails to\
				support vertical scrolling"
			}
		    }
		    set data($opt) $val

		    switch $val {
			static	{ showVScrollbar $win }
................................................................................
# Processes the scrollarea setwidget subcommmand.
#------------------------------------------------------------------------------
proc scrollutil::sa::setwidgetSubCmd {win widget} {
    variable scrollareaArr
    upvar ::scrollutil::ns${win}::data data

    if {[winfo exists $widget]} {
	set sa [::scrollutil::getscrollarea $widget]
	if {[string length $sa] != 0 && [string compare $sa $win] != 0} {
	    return -code error \
		"widget $widget already in another scrollarea $sa"
	}

	if {[string compare $data(-xscrollbarmode) "none"] != 0} {
	    if {![mwutil::isScrollable $widget x]} {
		return -code error \

		    "widget $widget fails to support horizontal scrolling"
	    }
	}

	if {[string compare $data(-yscrollbarmode) "none"] != 0} {
	    if {![mwutil::isScrollable $widget y]} {
		return -code error \
		    "widget $widget fails to support vertical scrolling"
	    }
	}
    } elseif {[string length $widget] != 0} {
	return -code error "bad window path name \"$widget\""
    }

    set oldWidget $data(widget)
................................................................................
}

#------------------------------------------------------------------------------
# scrollutil::sa::onWidgetOfScrollareaDestroy
#------------------------------------------------------------------------------
proc scrollutil::sa::onWidgetOfScrollareaDestroy widget {
    variable scrollareaArr
    if {[info exists scrollareaArr($widget)]} {
	unset scrollareaArr($widget)
    }


    set win [::scrollutil::getscrollarea $widget]
    if {[string length $win] != 0} {
	::$win setwidget ""
    }
}

#------------------------------------------------------------------------------
# scrollutil::sa::onHeaderHeightChanged
#------------------------------------------------------------------------------

Changes to assets/tklib0.6/scrollutil/scripts/scrollsync.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
...
202
203
204
205
206
207
208



















209
210
211
212
213
214
215
...
330
331
332
333
334
335
336





337
338
339
340
341
342
343
...
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521


522
523
524
525
526
527
528
529
530
531
532
533
534
#==============================================================================
# Contains the implementation of the scrollsync widget.
#
# Structure of the module:
#   - Namespace initialization
#   - Private procedure creating the default bindings
#   - Public procedure creating a new scrollsync widget
#   - Private configuration procedures
#   - Private procedures implementing the scrollsync widget command
#   - Private callback procedure
#   - Private procedures used in bindings
#   - Private utility procedures
#
# Copyright (c) 2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................

    bind WidgetOfScrollsync <Destroy> {
	scrollutil::ss::onWidgetOfScrollsyncDestroy %W
    }
}

#
# Public procedure creating a new scrollsync widget
# =================================================
#

#------------------------------------------------------------------------------
# scrollutil::scrollsync
#
# Creates a new scrollsync widget whose name is specified as the first command-
# line argument, and configures it according to the options and their values
................................................................................
    # one and create an alias of the original name for a new widget procedure
    #
    rename ::$win ss::$win
    interp alias {} ::$win {} scrollutil::ss::scrollsyncWidgetCmd $win

    return $win
}




















#
# Private configuration procedures
# ================================
#

#------------------------------------------------------------------------------
................................................................................
# Processes the scrollsync setwidgets subcommmand.
#------------------------------------------------------------------------------
proc scrollutil::ss::setwidgetsSubCmd {win widgetList} {
    foreach w $widgetList {
	if {![winfo exists $w]} {
	    return -code error "bad window path name \"$w\""
	}





    }

    variable scrollsyncArr
    variable xViewArr
    variable yViewArr
    upvar ::scrollutil::ns${win}::data data

................................................................................
}

#------------------------------------------------------------------------------
# scrollutil::ss::onWidgetOfScrollsyncDestroy
#------------------------------------------------------------------------------
proc scrollutil::ss::onWidgetOfScrollsyncDestroy widget {
    variable scrollsyncArr
    variable xViewArr
    variable yViewArr

    set win $scrollsyncArr($widget)
    unset scrollsyncArr($widget)
    if {[info exists xViewArr($widget)]} {
	unset xViewArr($widget)
    }


    if {[info exists yViewArr($widget)]} {
	unset yViewArr($widget)
    }

    if {[winfo exists $win] &&
	[string compare [winfo class $win] "Scrollsync"] == 0} {
	set widgetList [::$win widgets]
	set idx [lsearch -exact $widgetList $widget]
	::$win setwidgets [lreplace $widgetList $idx $idx]
    }
}

#






|






|







 







|
|







 







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







 







>
>
>
>
>







 







|
|
|
|
|



>
>




|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
...
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
...
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
...
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
#==============================================================================
# Contains the implementation of the scrollsync widget.
#
# Structure of the module:
#   - Namespace initialization
#   - Private procedure creating the default bindings
#   - Public procedures creating or quering a scrollsync widget
#   - Private configuration procedures
#   - Private procedures implementing the scrollsync widget command
#   - Private callback procedure
#   - Private procedures used in bindings
#   - Private utility procedures
#
# Copyright (c) 2019-2020  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Namespace initialization
# ========================
#

................................................................................

    bind WidgetOfScrollsync <Destroy> {
	scrollutil::ss::onWidgetOfScrollsyncDestroy %W
    }
}

#
# Public procedures creating or quering a scrollsync widget
# =========================================================
#

#------------------------------------------------------------------------------
# scrollutil::scrollsync
#
# Creates a new scrollsync widget whose name is specified as the first command-
# line argument, and configures it according to the options and their values
................................................................................
    # one and create an alias of the original name for a new widget procedure
    #
    rename ::$win ss::$win
    interp alias {} ::$win {} scrollutil::ss::scrollsyncWidgetCmd $win

    return $win
}

#------------------------------------------------------------------------------
# scrollutil::getscrollsync
#
# Queries the scrollsync into which a given widget is embedded via the
# scrollsync's setwidgets subcommand.
#------------------------------------------------------------------------------
proc scrollutil::getscrollsync widget {
    variable ss::scrollsyncArr
    if {[info exists scrollsyncArr($widget)]} {
	set win $scrollsyncArr($widget)
	if {[winfo exists $win] &&
	    [string compare [winfo class $win] "Scrollsync"] == 0} {
	    return $win
	}
    }

    return ""
}

#
# Private configuration procedures
# ================================
#

#------------------------------------------------------------------------------
................................................................................
# Processes the scrollsync setwidgets subcommmand.
#------------------------------------------------------------------------------
proc scrollutil::ss::setwidgetsSubCmd {win widgetList} {
    foreach w $widgetList {
	if {![winfo exists $w]} {
	    return -code error "bad window path name \"$w\""
	}

	set ss [::scrollutil::getscrollsync $w]
	if {[string length $ss] != 0 && [string compare $ss $win] != 0} {
	    return -code error "widget $w already in another scrollsync $ss"
	}
    }

    variable scrollsyncArr
    variable xViewArr
    variable yViewArr
    upvar ::scrollutil::ns${win}::data data

................................................................................
}

#------------------------------------------------------------------------------
# scrollutil::ss::onWidgetOfScrollsyncDestroy
#------------------------------------------------------------------------------
proc scrollutil::ss::onWidgetOfScrollsyncDestroy widget {
    variable scrollsyncArr
    if {[info exists scrollsyncArr($widget)]} {
	unset scrollsyncArr($widget)
    }

    variable xViewArr
    if {[info exists xViewArr($widget)]} {
	unset xViewArr($widget)
    }

    variable yViewArr
    if {[info exists yViewArr($widget)]} {
	unset yViewArr($widget)
    }

    set win [::scrollutil::getscrollsync $widget]
    if {[string length $win] != 0} {
	set widgetList [::$win widgets]
	set idx [lsearch -exact $widgetList $widget]
	::$win setwidgets [lreplace $widgetList $idx $idx]
    }
}

#

Changes to assets/tklib0.6/scrollutil/scripts/tclIndex.

32
33
34
35
36
37
38

39
40
41
42
43
44
45
46

47


48
49
50

51
52
53
54
55
56
57
..
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
107
108

109
110
111
set auto_index(::scrollutil::sf::createBindings) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::scrollableframe) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::doConfig) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::doCget) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::updateHorizPlaceOpts) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::updateVertPlaceOpts) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::scrollableframeWidgetCmd) [list source [file join $dir scrollableframe.tcl]]

set auto_index(::scrollutil::sf::seeSubCmd) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::xviewSubCmd) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::yviewSubCmd) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::roundUp) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::roundDn) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::roundUpOrDn) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::applyOffset) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::onScrollableframeConfigure) [list source [file join $dir scrollableframe.tcl]]

set auto_index(::scrollutil::sf::onScrollableContentConfigure) [list source [file join $dir scrollableframe.tcl]]


set auto_index(::scrollutil::sa::extendConfigSpecs) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::createBindings) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::scrollarea) [list source [file join $dir scrollarea.tcl]]

set auto_index(::scrollutil::sa::doConfig) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::doCget) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::scrollareaWidgetCmd) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::setwidgetSubCmd) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::setHScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::setVScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::onScrollareaConfigure) [list source [file join $dir scrollarea.tcl]]
................................................................................
set auto_index(::scrollutil::sa::showHScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::hideHScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::updateHScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::showVScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::hideVScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::updateVScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::unlockScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrolledframe::scrolledframe) [list source [file join $dir scrolledframe_ulis_kjn.tcl]]
set auto_index(::scrolledframe::dispatch) [list source [file join $dir scrolledframe_ulis_kjn.tcl]]
set auto_index(::scrolledframe::config) [list source [file join $dir scrolledframe_ulis_kjn.tcl]]
set auto_index(::scrolledframe::resize) [list source [file join $dir scrolledframe_ulis_kjn.tcl]]
set auto_index(::scrolledframe::xset) [list source [file join $dir scrolledframe_ulis_kjn.tcl]]
set auto_index(::scrolledframe::yset) [list source [file join $dir scrolledframe_ulis_kjn.tcl]]
set auto_index(::scrolledframe::xview) [list source [file join $dir scrolledframe_ulis_kjn.tcl]]
set auto_index(::scrolledframe::yview) [list source [file join $dir scrolledframe_ulis_kjn.tcl]]
set auto_index(::ScrollableFrame::create) [list source [file join $dir scrollframe.tcl]]
set auto_index(::ScrollableFrame::configure) [list source [file join $dir scrollframe.tcl]]
set auto_index(::ScrollableFrame::cget) [list source [file join $dir scrollframe.tcl]]
set auto_index(::ScrollableFrame::getframe) [list source [file join $dir scrollframe.tcl]]
set auto_index(::ScrollableFrame::see) [list source [file join $dir scrollframe.tcl]]
set auto_index(::ScrollableFrame::xview) [list source [file join $dir scrollframe.tcl]]
set auto_index(::ScrollableFrame::yview) [list source [file join $dir scrollframe.tcl]]
set auto_index(::ScrollableFrame::_resize) [list source [file join $dir scrollframe.tcl]]
set auto_index(::ScrollableFrame::_max) [list source [file join $dir scrollframe.tcl]]
set auto_index(::ScrollableFrame::_frameConfigure) [list source [file join $dir scrollframe.tcl]]
set auto_index(::scrollutil::ss::extendConfigSpecs) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::createBindings) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::scrollsync) [list source [file join $dir scrollsync.tcl]]

set auto_index(::scrollutil::ss::doConfig) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::doCget) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::scrollsyncWidgetCmd) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::setwidgetsSubCmd) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::viewSubCmd) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::scrollCmd) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::updateMasterWidgets) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::onWidgetOfScrollsyncDestroy) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::sortScrollableList) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::compareViews) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::unlockView) [list source [file join $dir scrollsync.tcl]]


set auto_index(::scrollutil::createWheelEventBindings) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::enableScrollingByWheel) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::adaptWheelEventHandling) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::setFocusCheckWindow) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::focusCheckWindow) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::hasFocus) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::isCompatible) [list source [file join $dir wheelEvent.tcl]]

set auto_index(::scrollutil::scrollByUnits) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::mayScroll) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::onScrlWidgetContDestroy) [list source [file join $dir wheelEvent.tcl]]







>







|
>
|
>
>



>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<



>











>
>







>



32
33
34
35
36
37
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
..
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
set auto_index(::scrollutil::sf::createBindings) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::scrollableframe) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::doConfig) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::doCget) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::updateHorizPlaceOpts) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::updateVertPlaceOpts) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::scrollableframeWidgetCmd) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::scanSubCmd) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::seeSubCmd) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::xviewSubCmd) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::yviewSubCmd) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::roundUp) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::roundDn) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::roundUpOrDn) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::applyOffset) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::onScrollableframeMfConfigure) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::onScrollableframeCfConfigure) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::onButton1) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::onB1Motion) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sf::onButtonRelease1) [list source [file join $dir scrollableframe.tcl]]
set auto_index(::scrollutil::sa::extendConfigSpecs) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::createBindings) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::scrollarea) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::getscrollarea) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::doConfig) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::doCget) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::scrollareaWidgetCmd) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::setwidgetSubCmd) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::setHScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::setVScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::onScrollareaConfigure) [list source [file join $dir scrollarea.tcl]]
................................................................................
set auto_index(::scrollutil::sa::showHScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::hideHScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::updateHScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::showVScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::hideVScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::updateVScrollbar) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::unlockScrollbar) [list source [file join $dir scrollarea.tcl]]


















set auto_index(::scrollutil::ss::extendConfigSpecs) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::createBindings) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::scrollsync) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::getscrollsync) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::doConfig) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::doCget) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::scrollsyncWidgetCmd) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::setwidgetsSubCmd) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::viewSubCmd) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::scrollCmd) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::updateMasterWidgets) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::onWidgetOfScrollsyncDestroy) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::sortScrollableList) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::compareViews) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::ss::unlockView) [list source [file join $dir scrollsync.tcl]]
set auto_index(::scrollutil::createBindings) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::addMouseWheelSupport) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::createWheelEventBindings) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::enableScrollingByWheel) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::adaptWheelEventHandling) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::setFocusCheckWindow) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::focusCheckWindow) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::hasFocus) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::isCompatible) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::comparePaths) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::scrollByUnits) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::mayScroll) [list source [file join $dir wheelEvent.tcl]]
set auto_index(::scrollutil::onScrlWidgetContDestroy) [list source [file join $dir wheelEvent.tcl]]

Changes to assets/tklib0.6/scrollutil/scripts/wheelEvent.tcl.

1
2

3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
















30
31





32
33
34

35
36
37
38
39
40


41
42










43
44
45
46
47
48
49
..
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
...
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
...
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
...
185
186
187
188
189
190
191





192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
...
245
246
247
248
249
250
251
252




253
254
255
256
257
258
259
...
275
276
277
278
279
280
281









282
283
284
285
286
287
288
...
289
290
291
292
293
294
295





296
297
298
299
300
301
302
...
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
...
337
338
339
340
341
342
343





344
345
346
347
348
349
350
...
389
390
391
392
393
394
395
396

397

398
399
400
401
402
403
404
#==============================================================================
# Contains procedures for mouse wheel event handling in scrollable widget

# containers like BWidget ScrollableFrame and iwidgets::scrolledframe.  Tested
# also with the scrolledframe::scrolledframe command of the Scrolledframe
# package by Maurice Bredelet (ulis) and its optimized and enhanced version
# contributed by Keith Nash, as well as with the sframe command implemented by
# Paul Walton (see https://wiki.tcl-lang.org/page/A+scrolled+frame).
#
# Structure of the module:
#   - Namespace initialization

#   - Public procedures
#   - Private procedures
#
# Copyright (c) 2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

if {[string compare $tcl_platform(platform) "windows"] == 0} {
    package require Tk 8.6b2
} else {
    package require Tk 8.4
}

#
# Namespace initialization
# ========================
#

namespace eval scrollutil {

    #
















    # Mouse wheel event bindings for the binding
    # tags "WheeleventRedir" and "WheeleventBreak":





    #
    set eventList [list <MouseWheel> <Shift-MouseWheel>]
    switch [tk windowingsystem] {

	aqua {
	    lappend eventList <Option-MouseWheel> <Shift-Option-MouseWheel>
	}
	x11 {
	    lappend eventList <Button-4> <Button-5> \
			      <Shift-Button-4> <Shift-Button-5>


	}
    }










    foreach event $eventList {
	if {[string match <*Button-?> $event]} {
	    bind WheeleventRedir $event [format {
		if {![scrollutil::hasFocus %%W] ||
		    ![scrollutil::isCompatible %s %%W]} {
		    event generate [winfo toplevel %%W] %s \
			  -rootx %%X -rooty %%Y
................................................................................
		    break
		}
	    } $event $event]
	}

	bind WheeleventBreak $event { break }
    }
    unset eventList event


    #
    # The list of scrollable widget containers that are
    # registered for scrolling by the mouse wheel event
    # bindings created by the createWheelEventBindings command:


    #
    variable scrlWidgetContList {}



    #
    # <Destroy> event binding for the binding tag "ScrlWidgetCont":
    #
    bind ScrlWidgetCont <Destroy> {
	scrollutil::onScrlWidgetContDestroy %W













    }

    #
    # <Destroy> event binding for the binding tag "WheeleventWidget":



    #
    bind WheeleventWidget <Destroy> {
	unset -nocomplain scrollutil::focusCheckWinArr(%W)





    }
}





#
# Public procedures
# =================




#


















































#------------------------------------------------------------------------------
# scrollutil::createWheelEventBindings
#
# Usage: scrollutil::createWheelEventBindings ?tag tag ...?
#
# Creates mouse wheel event bindings for the specified binding tags such that
................................................................................
# scrollable widget containers then these events will trigger a scrolling of
# that widget container.  In case of several nested registered scrollable
# widget containers fulfilling this condition the innermost one will be
# scrolled.  Each tag argument must be "all" or the path name of an existing
# toplevel widget.
#------------------------------------------------------------------------------
proc scrollutil::createWheelEventBindings args {
    set winSys [tk windowingsystem]




    foreach tag $args {
	if {[string match .* $tag]} {
	    if {![winfo exists $tag]} {
		return -code error "bad window path name \"$tag\""
	    }

	    if {[winfo toplevel $tag] ne $tag} {
		return -code error "\"$tag\" is not a toplevel widget"
	    }
	} elseif {$tag ne "all"} {
	    return -code error "unsupported tag \"$tag\": must be \"all\" or\
		the path name of an existing toplevel widget"
	}

	if {$winSys eq "aqua"} {
	    bind $tag <MouseWheel> {
		scrollutil::scrollByUnits %W %X %Y y [expr {-(%D)}]
	    }
	    bind $tag <Option-MouseWheel> {
................................................................................
	    bind $tag <Shift-MouseWheel> {
		scrollutil::scrollByUnits %W %X %Y x [expr {-(%D)}]
	    }
	    bind $tag <Shift-Option-MouseWheel> {
		scrollutil::scrollByUnits %W %X %Y x [expr {-10 * (%D)}]
	    }
	} else {
	    #
	    # Earlier versions used [expr {-(%D/120) * 4}] for the units
	    # computation.  For %D = 110 the result was 0, while for %D = -110
	    # it was 4 -- NOK!  In the improved computation below the
	    # rounding works the same for both positive and negative %D values:
	    # for %D = 110 the result is -4 and for %D = -110 it is 4 -- OK.
	    #
	    bind $tag <MouseWheel> {
		scrollutil::scrollByUnits %W %X %Y y \
		    [expr {%D >= 0 ? (-%D) / 30 : (-(%D) + 29) / 30}]
	    }
	    bind $tag <Shift-MouseWheel> {
		scrollutil::scrollByUnits %W %X %Y x \
		    [expr {%D >= 0 ? (-%D) / 30 : (-(%D) + 29) / 30}]
................................................................................
# Usage: scrollutil::enableScrollingByWheel ?scrlWidgetCont scrlWidgetCont ...?
#
# Adds the specified scrollable widget containers to the internal list of
# widget containers that are registered for scrolling by the mouse wheel event
# bindings created by the createWheelEventBindings command.
#------------------------------------------------------------------------------
proc scrollutil::enableScrollingByWheel args {





    variable scrlWidgetContList
    foreach swc $args {
	if {![winfo exists $swc]} {
	    return -code error "bad window path name \"$swc\""
	}

	if {[catch {$swc xview scroll 0 units}] != 0} {
	    return -code error "\"$swc\" fails to support horizontal scrolling\
		by units"
	}

	if {[catch {$swc yview scroll 0 units}] != 0} {
	    return -code error "\"$swc\" fails to support vertical scrolling\
		by units"
	}

	if {[lsearch -exact $scrlWidgetContList $swc] >= 0} {
	    continue
	}

	lappend scrlWidgetContList $swc
................................................................................
#
#       - If the focus is outside the window [focusCheckWindow $widget] then
#         the event will be redirected to the containing toplevel window via
#         event generate rather than being handled by the binding script
#         associated with the above-mentioned tag.
#------------------------------------------------------------------------------
proc scrollutil::adaptWheelEventHandling args {
    set winSys [tk windowingsystem]




    foreach w $args {
	if {![winfo exists $w]} {
	    return -code error "bad window path name \"$w\""
	}

	set wTop [winfo toplevel $w]
	if {[winfo class $w] eq "Tablelist"} {
................................................................................

		set tagIdx [lsearch -exact $tagList $tag]
		bindtags $w [lreplace $tagList $tagIdx $tagIdx \
			     WheeleventRedir $tag WheeleventBreak]
		break
	    }
	}









    }
}

#------------------------------------------------------------------------------
# scrollutil::setFocusCheckWindow
#
# Usage: scrollutil::setFocusCheckWindow widget ?widget ...? otherWidget
................................................................................
#
# For each widget argument, the command sets the associated "focus check
# window" to otherWidget.  This is the window to be used instead of the widget
# when checking whether the focus is on/inside or outside that window.  It must
# be an ancestor of or identical to widget.
#------------------------------------------------------------------------------
proc scrollutil::setFocusCheckWindow args {





    set argCount [llength $args]
    if {$argCount < 2} {
	return -code error "wrong # args: should be\
	    \"scrollutil::setFocusCheckWindow widget ?widget ...? otherWidget\""
    }

    foreach w $args {
................................................................................
    foreach w $args {
	if {$n == $argCount - 1} {
	    return ""
	}

	if {[string first $w2. $w.] != 0} {
	    return -code error \
		"\"$w2\" is neither an ancestor of nor is identical to \"$w\""
	}

	set focusCheckWinArr($w) $w2

	set tagList [bindtags $w]
	if {[lsearch -exact $tagList "WheeleventWidget"] < 0} {
	    bindtags $w [linsert $tagList 1 WheeleventWidget]
................................................................................
#
# Returns the "focus check window" associated with widget.  This is the window
# that is used instead of the widget when checking whether the focus is
# on/inside or outside that window.  If the command setFocusCheckWindow was not
# invoked for widget then the return value is widget itself.
#------------------------------------------------------------------------------
proc scrollutil::focusCheckWindow w {





    if {![winfo exists $w]} {
	return -code error "bad window path name \"$w\""
    }

    variable focusCheckWinArr
    return [expr {[info exists focusCheckWinArr($w)] ?
		  $focusCheckWinArr($w) : $w}]
................................................................................
    set idx [lsearch -exact $tagList "WheeleventRedir"]
    set tag [lindex $tagList [incr idx]]
    if {[bind $tag $event] eq ""} {
	return 0
    } elseif {[string match "*Scrollbar" [winfo class $w]]} {
	set orient [$w cget -orient]
	return [expr {
	    ($orient eq "horizontal" &&  [string match "<Shift-*>" $event]) ||

	    ($orient eq "vertical"   && ![string match "<Shift-*>" $event])

	}]
    } else {
	return 1
    }
}

#------------------------------------------------------------------------------

|
>
|
|
|
|
|



>



|


<
<
<
|
<







>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
>
>
>
>
>
|

<
>






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







 







<

>
|
|
|
<
>
>
|
<
|
>
>
|
<
|
<
<
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
<
>
>
>
|
<
<
>
>
>
>
>
|
|
>
>
>
>
|
|
<
<
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
>
>
>
>







|


|
|







 







<
<
<
<
<
<
<







 







>
>
>
>
>







|
|



|
|







 







|
>
>
>
>







 







>
>
>
>
>
>
>
>
>







 







>
>
>
>
>







 







|







 







>
>
>
>
>







 







|
>
|
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18



19

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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
..
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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
...
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
...
239
240
241
242
243
244
245







246
247
248
249
250
251
252
...
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
...
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
...
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
...
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
...
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
...
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
...
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
#==============================================================================
# Contains procedures related to mouse wheel event handling in scrollable
# widgets and scrollable widget containers like scrollutil::scrollableframe,
# BWidget ScrollableFrame, and iwidgets::scrolledframe.  Tested also with the
# scrolledframe::scrolledframe command of the Scrolledframe package by Maurice
# Bredelet (ulis) and its optimized and enhanced version contributed by Keith
# Nash, as well as with the sframe command implemented by Paul Walton (see
# https://wiki.tcl-lang.org/ page/A+scrolled+frame).
#
# Structure of the module:
#   - Namespace initialization
#   - Private procedure creating mouse wheel event and <Destroy> bindings
#   - Public procedures
#   - Private procedures
#
# Copyright (c) 2019-2020  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================




package require Tk 8.4


#
# Namespace initialization
# ========================
#

namespace eval scrollutil {
    variable winSys [tk windowingsystem]

    #
    # The list of scrollable widget containers that are
    # registered for scrolling by the mouse wheel event
    # bindings created by the createWheelEventBindings command:
    #
    variable scrlWidgetContList {}
}

#
# 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 ""
    }

    foreach event $eventList {
	if {[string match <*Button-?> $event]} {
	    bind WheeleventRedir $event [format {
		if {![scrollutil::hasFocus %%W] ||
		    ![scrollutil::isCompatible %s %%W]} {
		    event generate [winfo toplevel %%W] %s \
			  -rootx %%X -rooty %%Y
................................................................................
		    break
		}
	    } $event $event]
	}

	bind WheeleventBreak $event { break }
    }


    bind ScrlWidgetCont <Destroy> { scrollutil::onScrlWidgetContDestroy %W }

    bind WheeleventWidget <Destroy> {
	unset -nocomplain scrollutil::focusCheckWinArr(%W)

    }
}


#
# Public procedures
# =================
#




#------------------------------------------------------------------------------
# scrollutil::addMouseWheelSupport
#
# Usage: scrollutil::addMouseWheelSupport tag ?(xy|x|y)?
#
# Creates mouse wheel event bindings for the specified binding tag and optional
# axes, which must be "xy" (the default), "x", or "y".
#------------------------------------------------------------------------------
proc scrollutil::addMouseWheelSupport {tag {axes "xy"}} {
    set isWindow [string match .* $tag]
    if {$isWindow} {
	if {![winfo exists $tag]} {
	    return -code error "bad window path name \"$tag\""
	}
    }


    if {$axes ne "xy" && $axes ne "x" && $axes ne "y"} {
	return -code error "bad axes \"$axes\": must be xy, x, or y"
    }



    if {$isWindow} {
	if {[string first "x" $axes] >= 0 &&
	    [catch {$tag xview scroll 0 units}] != 0} {
	    return -code error \
		"widget $tag fails to support horizontal scrolling by units"
	}

	if {[string first "y" $axes] >= 0 &&
	    [catch {$tag yview scroll 0 units}] != 0} {
	    return -code error \
		"widget $tag fails to support vertical scrolling by units"
	}



	set tail "; break"
    } else {
	set tail ""
    }

    variable winSys

    if {[string first "y" $axes] >= 0} {
	if {$winSys eq "aqua"} {
	    bind $tag <MouseWheel> \
		[format {%%W yview scroll [expr {-(%%D)}] units%s} $tail]
	    bind $tag <Option-MouseWheel> \
		[format {%%W yview scroll [expr {-10 * (%%D)}] units%s} $tail]
	} else {
	    bind $tag <MouseWheel> \
		[format {%%W yview scroll [expr {%%D >= 0 ?\
			 (-%%D) / 30 : (-(%%D) + 29) / 30}] units%s} $tail]

	    if {$winSys eq "x11"} {
		bind $tag <Button-4> \
		    [format {%%W yview scroll -5 units%s} $tail]
		bind $tag <Button-5> \
		    [format {%%W yview scroll  5 units%s} $tail]
	    }
	}
    }

    if {[string first "x" $axes] >= 0} {
	if {$winSys eq "aqua"} {
	    bind $tag <Shift-MouseWheel> \
		[format {%%W xview scroll [expr {-(%%D)}] units%s} $tail]
	    bind $tag <Shift-Option-MouseWheel> \
		[format {%%W xview scroll [expr {-10 * (%%D)}] units%s} $tail]
	} else {
	    bind $tag <Shift-MouseWheel> \
		[format {%%W xview scroll [expr {%%D >= 0 ?\
			 (-%%D) / 30 : (-(%%D) + 29) / 30}] units%s} $tail]

	    if {$winSys eq "x11"} {
		bind $tag <Shift-Button-4> \
		    [format {%%W xview scroll -5 units%s} $tail]
		bind $tag <Shift-Button-5> \
		    [format {%%W xview scroll  5 units%s} $tail]

		if {[package vcompare $::tk_patchLevel "8.7a3"] >= 0} {
		    bind $tag <Button-6> \
			[format {%%W xview scroll -5 units%s} $tail]
		    bind $tag <Button-7> \
			[format {%%W xview scroll  5 units%s} $tail]
		}
	    }
	}
    }
}

#------------------------------------------------------------------------------
# scrollutil::createWheelEventBindings
#
# Usage: scrollutil::createWheelEventBindings ?tag tag ...?
#
# Creates mouse wheel event bindings for the specified binding tags such that
................................................................................
# scrollable widget containers then these events will trigger a scrolling of
# that widget container.  In case of several nested registered scrollable
# widget containers fulfilling this condition the innermost one will be
# scrolled.  Each tag argument must be "all" or the path name of an existing
# toplevel widget.
#------------------------------------------------------------------------------
proc scrollutil::createWheelEventBindings args {
    variable winSys
    if {$winSys eq "win32"} {
	package require Tk 8.6b2
    }

    foreach tag $args {
	if {[string match .* $tag]} {
	    if {![winfo exists $tag]} {
		return -code error "bad window path name \"$tag\""
	    }

	    if {[winfo toplevel $tag] ne $tag} {
		return -code error "$tag is not a toplevel widget"
	    }
	} elseif {$tag ne "all"} {
	    return -code error "unsupported tag \"$tag\": must be all or the\
		path name of an existing toplevel widget"
	}

	if {$winSys eq "aqua"} {
	    bind $tag <MouseWheel> {
		scrollutil::scrollByUnits %W %X %Y y [expr {-(%D)}]
	    }
	    bind $tag <Option-MouseWheel> {
................................................................................
	    bind $tag <Shift-MouseWheel> {
		scrollutil::scrollByUnits %W %X %Y x [expr {-(%D)}]
	    }
	    bind $tag <Shift-Option-MouseWheel> {
		scrollutil::scrollByUnits %W %X %Y x [expr {-10 * (%D)}]
	    }
	} else {







	    bind $tag <MouseWheel> {
		scrollutil::scrollByUnits %W %X %Y y \
		    [expr {%D >= 0 ? (-%D) / 30 : (-(%D) + 29) / 30}]
	    }
	    bind $tag <Shift-MouseWheel> {
		scrollutil::scrollByUnits %W %X %Y x \
		    [expr {%D >= 0 ? (-%D) / 30 : (-(%D) + 29) / 30}]
................................................................................
# Usage: scrollutil::enableScrollingByWheel ?scrlWidgetCont scrlWidgetCont ...?
#
# Adds the specified scrollable widget containers to the internal list of
# widget containers that are registered for scrolling by the mouse wheel event
# bindings created by the createWheelEventBindings command.
#------------------------------------------------------------------------------
proc scrollutil::enableScrollingByWheel args {
    variable winSys
    if {$winSys eq "win32"} {
	package require Tk 8.6b2
    }

    variable scrlWidgetContList
    foreach swc $args {
	if {![winfo exists $swc]} {
	    return -code error "bad window path name \"$swc\""
	}

	if {[catch {$swc xview scroll 0 units}] != 0} {
	    return -code error \
		"widget $swc fails to support horizontal scrolling by units"
	}

	if {[catch {$swc yview scroll 0 units}] != 0} {
	    return -code error \
		"widget $swc fails to support vertical scrolling by units"
	}

	if {[lsearch -exact $scrlWidgetContList $swc] >= 0} {
	    continue
	}

	lappend scrlWidgetContList $swc
................................................................................
#
#       - If the focus is outside the window [focusCheckWindow $widget] then
#         the event will be redirected to the containing toplevel window via
#         event generate rather than being handled by the binding script
#         associated with the above-mentioned tag.
#------------------------------------------------------------------------------
proc scrollutil::adaptWheelEventHandling args {
    variable winSys
    if {$winSys eq "win32"} {
	package require Tk 8.6b2
    }

    foreach w $args {
	if {![winfo exists $w]} {
	    return -code error "bad window path name \"$w\""
	}

	set wTop [winfo toplevel $w]
	if {[winfo class $w] eq "Tablelist"} {
................................................................................

		set tagIdx [lsearch -exact $tagList $tag]
		bindtags $w [lreplace $tagList $tagIdx $tagIdx \
			     WheeleventRedir $tag WheeleventBreak]
		break
	    }
	}

	#
	# If $w is embedded into a scrollarea then invoke this
	# procedure for the scrollbars of that scrollarea, too
	#
	set sa [getscrollarea $w]
	if {$sa ne ""} {
	    adaptWheelEventHandling $sa.hsb $sa.vsb
	}
    }
}

#------------------------------------------------------------------------------
# scrollutil::setFocusCheckWindow
#
# Usage: scrollutil::setFocusCheckWindow widget ?widget ...? otherWidget
................................................................................
#
# For each widget argument, the command sets the associated "focus check
# window" to otherWidget.  This is the window to be used instead of the widget
# when checking whether the focus is on/inside or outside that window.  It must
# be an ancestor of or identical to widget.
#------------------------------------------------------------------------------
proc scrollutil::setFocusCheckWindow args {
    variable winSys
    if {$winSys eq "win32"} {
	package require Tk 8.6b2
    }

    set argCount [llength $args]
    if {$argCount < 2} {
	return -code error "wrong # args: should be\
	    \"scrollutil::setFocusCheckWindow widget ?widget ...? otherWidget\""
    }

    foreach w $args {
................................................................................
    foreach w $args {
	if {$n == $argCount - 1} {
	    return ""
	}

	if {[string first $w2. $w.] != 0} {
	    return -code error \
		"widget $w2 is neither an ancestor of nor is identical to $w"
	}

	set focusCheckWinArr($w) $w2

	set tagList [bindtags $w]
	if {[lsearch -exact $tagList "WheeleventWidget"] < 0} {
	    bindtags $w [linsert $tagList 1 WheeleventWidget]
................................................................................
#
# Returns the "focus check window" associated with widget.  This is the window
# that is used instead of the widget when checking whether the focus is
# on/inside or outside that window.  If the command setFocusCheckWindow was not
# invoked for widget then the return value is widget itself.
#------------------------------------------------------------------------------
proc scrollutil::focusCheckWindow w {
    variable winSys
    if {$winSys eq "win32"} {
	package require Tk 8.6b2
    }

    if {![winfo exists $w]} {
	return -code error "bad window path name \"$w\""
    }

    variable focusCheckWinArr
    return [expr {[info exists focusCheckWinArr($w)] ?
		  $focusCheckWinArr($w) : $w}]
................................................................................
    set idx [lsearch -exact $tagList "WheeleventRedir"]
    set tag [lindex $tagList [incr idx]]
    if {[bind $tag $event] eq ""} {
	return 0
    } elseif {[string match "*Scrollbar" [winfo class $w]]} {
	set orient [$w cget -orient]
	return [expr {
	    ($orient eq "horizontal" &&  ([string match {<Shift-*>} $event] \
	     || [string match {<Button-[67]>} $event])) ||
	    ($orient eq "vertical"   && !([string match {<Shift-*>} $event] \
	     || [string match {<Button-[67]>} $event]))
	}]
    } else {
	return 1
    }
}

#------------------------------------------------------------------------------

Changes to assets/tklib0.6/scrollutil/scrollutil.tcl.

1
2
3
4
5
6
7
8
9
10
11
12

13
14
15



#==============================================================================
# Main Scrollutil package module.
#
# Copyright (c) 2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

package require -exact scrollutil::common 1.3

package provide scrollutil $::scrollutil::version
package provide Scrollutil $::scrollutil::version

::scrollutil::useTile 0

::scrollutil::sa::createBindings
::scrollutil::ss::createBindings
::scrollutil::sf::createBindings






|


|





>



>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#==============================================================================
# Main Scrollutil package module.
#
# Copyright (c) 2019-2020  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

package require -exact scrollutil::common 1.4

package provide scrollutil $::scrollutil::version
package provide Scrollutil $::scrollutil::version

::scrollutil::useTile 0

::scrollutil::sa::createBindings
::scrollutil::ss::createBindings
::scrollutil::sf::createBindings
if {[package vcompare $::tk_version "8.4"] >= 0} {
    ::scrollutil::createBindings
}

Changes to assets/tklib0.6/scrollutil/scrollutilCommon.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26





27
28
29
30

31
32
33
34
35
36
37
38
39
#==============================================================================
# Main Scrollutil and Scrollutil_tile package module.
#
# Copyright (c) 2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

package require Tk 8

namespace eval ::scrollutil {
    #
    # Public variables:
    #
    variable version	1.3
    variable library
    if {$::tcl_version >= 8.4} {
	set library	[file dirname [file normalize [info script]]]
    } else {
	set library	[file dirname [info script]] ;# no "file normalize" yet
    }

    #
    # Creates a new scrollarea/scrollsync/scrollableframe widget:
    #
    namespace export	scrollarea scrollsync scrollableframe

    #





    # Public procedures for mouse wheel event
    # handling in scrollable widget containers:
    #
    namespace export	createWheelEventBindings enableScrollingByWheel \

			adaptWheelEventHandling setFocusCheckWindow \
			focusCheckWindow
}

package provide scrollutil::common $::scrollutil::version

#
# The following procedure, invoked in "scrollutil.tcl" and
# "scrollutil_tile.tcl", sets the variable ::scrollutil::usingTile to the given



|








|













>
>
>
>
>
|
|

<
>
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42
43
44
#==============================================================================
# Main Scrollutil and Scrollutil_tile package module.
#
# Copyright (c) 2019-2020  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

package require Tk 8

namespace eval ::scrollutil {
    #
    # Public variables:
    #
    variable version	1.4
    variable library
    if {$::tcl_version >= 8.4} {
	set library	[file dirname [file normalize [info script]]]
    } else {
	set library	[file dirname [info script]] ;# no "file normalize" yet
    }

    #
    # Creates a new scrollarea/scrollsync/scrollableframe widget:
    #
    namespace export	scrollarea scrollsync scrollableframe

    #
    # Queries the scrollarea/scrollsync to which a given widget belongs:
    #
    namespace export	getscrollarea getscrollsync

    #
    # Public procedures for mouse wheel event handling in
    # scrollable widgets and scrollable widget containers:
    #

    namespace export	addMouseWheelSupport createWheelEventBindings \
			enableScrollingByWheel adaptWheelEventHandling \
			setFocusCheckWindow focusCheckWindow
}

package provide scrollutil::common $::scrollutil::version

#
# The following procedure, invoked in "scrollutil.tcl" and
# "scrollutil_tile.tcl", sets the variable ::scrollutil::usingTile to the given

Changes to assets/tklib0.6/scrollutil/scrollutil_tile.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

17
18
19



#==============================================================================
# Main Scrollutil_tile package module.
#
# Copyright (c) 2019  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

package require Tk 8.4
if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} {
    package require tile 0.6
}
package require -exact scrollutil::common 1.3

package provide scrollutil_tile $::scrollutil::version
package provide Scrollutil_tile $::scrollutil::version

::scrollutil::useTile 1

::scrollutil::sa::createBindings
::scrollutil::ss::createBindings
::scrollutil::sf::createBindings






|






|





>



>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#==============================================================================
# Main Scrollutil_tile package module.
#
# Copyright (c) 2019-2020  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

package require Tk 8.4
if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} {
    package require tile 0.6
}
package require -exact scrollutil::common 1.4

package provide scrollutil_tile $::scrollutil::version
package provide Scrollutil_tile $::scrollutil::version

::scrollutil::useTile 1

::scrollutil::sa::createBindings
::scrollutil::ss::createBindings
::scrollutil::sf::createBindings
if {[package vcompare $::tk_version "8.4"] >= 0} {
    ::scrollutil::createBindings
}