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.

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

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.

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

How to Install It?
------------------

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

#==============================================================================
# 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]]

#==============================================================================
# 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
# ========================

#==============================================================================
# Contains the implementation of the scrollableframe widget.
#
# Structure of the module:
#   - 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

#==============================================================================
# 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
#------------------------------------------------------------------------------

#==============================================================================
# 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]
    }
}

#

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::updateScrollbars) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::onDynamicHScrollbarMap) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::onWidgetOfScrollareaDestroy) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::onHeaderHeightChanged) [list source [file join $dir scrollarea.tcl]]
set auto_index(::scrollutil::sa::onTitleColsWidthChanged) [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]]

#==============================================================================
# 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
# if the widget under the pointer is (a descendant of) one of the registered
# 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> {
		scrollutil::scrollByUnits %W %X %Y y [expr {-10 * (%D)}]
	    }

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

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

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

#==============================================================================
# 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

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

If the option value is successfully modified to the new value, the function
returns \fBTCL_OK\fR.
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
unrecognized.
If \fInewValue\fR specifies a value for the option that
is not supported or if a system call error occurs,
the function should leave an error message in the result
of \fIinterp\fR if \fIinterp\fR is not NULL. The
function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
.PP
This value can be retrieved with \fBTcl_ChannelSetOptionProc\fR, which returns
a pointer to the function.
.SS GETOPTIONPROC
.PP

.PP
These procedures are intended for access to the multiple interpreter
facility from inside C programs. They enable managing multiple interpreters
in a hierarchical relationship, and the management of aliases, commands
that when invoked in one interpreter execute a command in another
interpreter. The return value for those procedures that return an \fBint\fR
is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
then the interpreter's result contains an error message.
.PP
\fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR.
It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which
allows \fIinterp\fR to manipulate the new slave.
If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
code has access to all the Tcl commands.
If it is \fB1\fR, the command creates a

\fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR.
If no such slave interpreter exists, \fBNULL\fR is returned.
.PP
\fBTcl_GetMaster\fR returns a pointer to the master interpreter of
\fIinterp\fR. If \fIinterp\fR has no master (it is a
top-level interpreter) then \fBNULL\fR is returned.
.PP
\fBTcl_GetInterpPath\fR stores in the result of \fIaskingInterp\fR
the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR;
\fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation
of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fBTCL_ERROR\fR is returned and an error message is stored as the
result of \fIaskingInterp\fR.
.PP
\fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in
\fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
to be invoked in \fItargetInterp\fR. The arguments specified by the strings
contained in \fIargv\fR are always prepended to any arguments supplied in the
invocation of \fIslaveCmd\fR and passed to \fItargetCmd\fR.
This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if

strings.
.PP
\fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from
the set of hidden commands to the set of exposed commands, putting
it under the name
\fIcmdName\fR.
\fIHiddenCmdName\fR must be the name of an existing hidden
command, or the operation will return \fBTCL_ERROR\fR and
leave an error message as the result of \fIinterp\fR.
If an exposed command named \fIcmdName\fR already exists,
the operation returns \fBTCL_ERROR\fR and leaves an error message as
the result of \fIinterp\fR.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in any
script evaluation mechanism will again succeed.
.PP
\fBTcl_HideCommand\fR moves the command named \fIcmdName\fR from the set of
exposed commands to the set of hidden commands, under the name
\fIhiddenCmdName\fR.
\fICmdName\fR must be the name of an existing exposed
command, or the operation will return \fBTCL_ERROR\fR and leave an error
message as the result of \fIinterp\fR.
Currently both \fIcmdName\fR and \fIhiddenCmdName\fR must not contain
namespace qualifiers, or the operation will return \fBTCL_ERROR\fR and
leave an error message as the result of \fIinterp\fR.
The \fICmdName\fR will be looked up in the global namespace, and not
relative to the current namespace, even if the current namespace is not the
global one.
If a hidden command whose name is \fIhiddenCmdName\fR already
exists, the operation also returns \fBTCL_ERROR\fR and an error
message is left as the result of \fIinterp\fR.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in
any script evaluation mechanism will fail.
.PP
For a description of the Tcl interface to multiple interpreters, see
\fIinterp(n)\fR.
.SH "SEE ALSO"
interp

.SH KEYWORDS
alias, command, exposed commands, hidden commands, interpreter, invoke,
master, slave

same formatting rules are also used by the built-in Tcl command
\fBformat\fR.
.PP
In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted
error message to the standard error file of the process, and then
calls \fBabort\fR to terminate the process.  \fBTcl_Panic\fR does not
return. On Windows, when a debugger is running, the formatted error
message is sent to the debugger instead. If the windows executable
does not have a stderr channel (e.g. \fBwish.exe\fR), then a
system dialog box is used to display the panic message.
.PP
\fBTcl_SetPanicProc\fR may be used to modify the behavior of
\fBTcl_Panic\fR.  The \fIpanicProc\fR argument should match the
type \fBTcl_PanicProc\fR:
.PP

	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
	    break;
#endif
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = !mp_iszero(&big2);
	    mp_clear(&big2);
	    break;
	}

	switch (type1) {
	case TCL_NUMBER_LONG:
	    l1 = *((const long *)ptr1);

	case INST_SUB:
	    mp_sub(&big1, &big2, &bigResult);
	    break;
	case INST_MULT:
	    mp_mul(&big1, &big2, &bigResult);
	    break;
	case INST_DIV:
	    if (mp_iszero(&big2)) {
		mp_clear(&big1);
		mp_clear(&big2);
		mp_clear(&bigResult);
		return DIVIDED_BY_ZERO;
	    }
	    mp_init(&bigRemainder);
	    mp_div(&big1, &big2, &bigResult, &bigRemainder);
	    /* TODO: internals intrusion */
	    if (!mp_iszero(&bigRemainder)
		    && (bigRemainder.sign != big2.sign)) {
		/*
		 * Convert to Tcl's integer division rules.
		 */

		mp_sub_d(&bigResult, 1, &bigResult);
		mp_add(&bigRemainder, &big2, &bigRemainder);

void
Tcl_TransferResult(
    Tcl_Interp *sourceInterp,	/* Interp whose result and return options
				 * should be moved to the target interp.
				 * After moving result, this interp's result
				 * is reset. */
    int code,			/* The return code value active in
				 * sourceInterp. Controls how the return options
				 * dictionary is retrieved from sourceInterp,
				 * same as in Tcl_GetReturnOptions, to then be
				 * transferred to targetInterp. */
    Tcl_Interp *targetInterp)	/* Interp where result and return options
				 * should be stored. If source and target are
				 * the same, nothing is done. */
{
    Interp *tiPtr = (Interp *) targetInterp;
    Interp *siPtr = (Interp *) sourceInterp;

    if (sourceInterp == targetInterp) {

 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath.h"
#include <float.h>
#include <math.h>





#ifdef _WIN32



#define copysign _copysign

#endif

/*
 * Define KILL_OCTAL to suppress interpretation of numbers with leading zero
 * as octal. (Ceterum censeo: numeros octonarios delendos esse.)
 */

	    }
	    break;

	case ZERO:
	case DECIMAL:
	    significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1,
		    &significandWide, &significandBig, significandOverflow);
	    if (!significandOverflow && (significandWide > MOST_BITS+signum)) {
		significandOverflow = 1;
		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
	    }
	returnInteger:
	    if (!significandOverflow) {
		if (significandWide >
			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {

	     * to whether 'significandOverflow' is set. The desired floating
	     * point value is significand * 10**k, where
	     * k = numTrailZeros+exponent-numDigitsAfterDp.
	     */

	    objPtr->typePtr = &tclDoubleType;
	    if (exponentSignum) {
		/*
		 * At this point exponent>=0, so the following calculation
		 * cannot underflow.
		 */
		exponent = -exponent;
	    }

	    /*
	     * Adjust the exponent for the number of trailing zeros that
	     * have not been accumulated, and the number of digits after

		if (exponent + numTrailZeros < LONG_MIN + numDigitsAfterDp) {
		    exponent = LONG_MIN;
		} else {
		    exponent = exponent + numTrailZeros - numDigitsAfterDp;
		}
	    }

	    /*
	     * The desired number is now significandWide * 10**exponent
	     * or significandBig * 10**exponent, depending on whether
	     * the significand has overflowed a wide int.
	     */
	    if (!significandOverflow) {
		objPtr->internalRep.doubleValue = MakeLowPrecisionDouble(
			signum, significandWide, numSigDigs, exponent);

	    }
	    objPtr->typePtr = &tclDoubleType;
	    break;

#ifdef IEEE_FLOATING_POINT
	case sNAN:
	case sNANFINISH:
	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
	    objPtr->typePtr = &tclDoubleType;
	    break;
#endif
	case INITIAL:
	    /* This case only to silence compiler warning. */
	    Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
	}

	if (M5 - 1 > M2) {
	    M2 = M5 - 1;
	}
    }

    /*
     * Compute twoMv as 2*M*v, where v is the approximate value.
     * This is done by bit-whacking to calculate 2**(M2+1)*significand,
     * and then multiplying by 5**M5.
     */

    msb = binExponent + M2;	/* 1008 */
    nDigits = msb / MP_DIGIT_BIT + 1;
    mp_init_size(&twoMv, nDigits);
    i = (msb % MP_DIGIT_BIT + 1);

    for (i=0; i<=8; ++i) {
	if ((M5 + exponent) & (1 << i)) {
	    mp_mul(&twoMd, pow5+i, &twoMd);
	}
    }
    mp_mul_2d(&twoMd, M2+exponent+1, &twoMd);

    /*
     * Now let twoMd = twoMd - twoMv, the difference between the exact and
     * approximate values.
     */

    mp_sub(&twoMd, &twoMv, &twoMd);

    /*

	if ((rteSigWide & 1) == 0) {
	    mp_clear(&twoMd);
	    mp_clear(&twoMv);
	    return approxResult;
	}
    }

    /*
     * Reduce the numerator and denominator of the corrector term so that
     * they will fit in the floating point precision.
     */
    shift = mp_count_bits(&twoMv) - FP_PRECISION - 1;
    if (shift > 0) {
	mp_div_2d(&twoMv, shift, &twoMv, NULL);
	mp_div_2d(&twoMd, shift, &twoMd, NULL);

    /*
     * Initialize table of powers of 10 expressed as wide integers.
     */

    maxpow10_wide = (int)
	    floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));
    pow10_wide = (Tcl_WideUInt *)
	    ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
    u = 1;
    for (i = 0; i < maxpow10_wide; ++i) {
	pow10_wide[i] = u;
	u *= 10;
    }
    pow10_wide[i] = u;

	    if (shift > 0) {
		mp_mul_2d(a, shift, &b);
	    } else if (shift < 0) {
		mp_int d;
		mp_init(&d);
		mp_div_2d(a, -shift, &b, &d);
		exact = mp_iszero(&d);
		mp_clear(&d);
	    } else {
		mp_copy(a, &b);
	    }
	    if (!exact) {
		mp_add_d(&b, 1, &b);
	    }

    }
    leaktest {[foo new] destroy}
} -cleanup {
    foo destroy
} -result 0
test oo-0.9 {various types of presence of the TclOO package} {
    list [lsearch -nocase -all -inline [package names] tcloo] \
	[package present TclOO] [expr {$::oo::patchlevel in [package versions TclOO]}]
} [list TclOO $::oo::patchlevel 1]

test oo-1.1 {basic test of OO functionality: no classes} {
    set result {}
    lappend result [oo::object create foo]
    lappend result [oo::objdefine foo {
	method bar args {
	    global result

fi

    DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)"

    if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then

        LIB_SUFFIX=${SHARED_LIB_SUFFIX}
        MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
        if test "${SHLIB_SUFFIX}" = ".dll"; then

            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;'
            DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"

else

	SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'])
    AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [
	UNSHARED_LIB_SUFFIX='${VERSION}.a'])
    DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)"

    AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [
        LIB_SUFFIX=${SHARED_LIB_SUFFIX}
        MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
        AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [
            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;'
            DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
        ], [
            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
        ])
    ], [

    TclpSetInterfaces();
}

const char *
Tcl_GetEncodingNameFromEnvironment(
    Tcl_DString *bufPtr)
{
    UINT acp = GetACP();

    Tcl_DStringInit(bufPtr);
    if (acp == CP_UTF8) {
	Tcl_DStringAppend(bufPtr, "utf-8", 5);
    } else {
	Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
	wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
	Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
    }
    return Tcl_DStringValue(bufPtr);
}

const char *
TclpGetUserName(
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * the name of user. */