#
# Utilities for widget implementations.
#

### Focus management.
#
# See also: #1516479
#

## ttk::takefocus --
#	This is the default value of the "-takefocus" option
#	for ttk::* widgets that participate in keyboard navigation.
#
# NOTES:
#	tk::FocusOK (called by tk_focusNext) tests [winfo viewable]
#	if -takefocus is 1, empty, or missing; but not if it's a
#	script prefix, so we have to check that here as well.
#
#
proc ttk::takefocus {w} {
 expr {[$w instate !disabled] && [winfo viewable $w]}
}

## ttk::GuessTakeFocus --
#	This routine is called as a fallback for widgets
#	with a missing or empty -takefocus option.
#
#	It implements the same heuristics as tk::FocusOK.
#
proc ttk::GuessTakeFocus {w} {
 # Don't traverse to widgets with '-state disabled':
 #
 if {![catch {$w cget -state} state] && $state eq "disabled"} {
	return 0
 }

 # Allow traversal to widgets with explicit key or focus bindings:
 #
 if {[regexp {Key|Focus} [concat [bind $w] [bind [winfo class $w]]]]} {
	return 1;
 }

 # Default is nontraversable:
 #
 return 0;
}

## ttk::traverseTo $w --
# 	Set the keyboard focus to the specified window.
#
proc ttk::traverseTo {w} {
 set focus [focus]
 if {$focus ne ""} {
	event generate $focus <<TraverseOut>>
 }
 focus $w
 event generate $w <<TraverseIn>>
}

## ttk::clickToFocus $w --
#	Utility routine, used in <ButtonPress-1> bindings --
#	Assign keyboard focus to the specified widget if -takefocus is enabled.
#
proc ttk::clickToFocus {w} {
 if {[ttk::takesFocus $w]} { focus $w }
}

## ttk::takesFocus w --
#	Test if the widget can take keyboard focus.
#
#	See the description of the -takefocus option in options(n)
#	for details.
#
proc ttk::takesFocus {w} {
 if {![winfo viewable $w]} {
 	return 0
 } elseif {[catch {$w cget -takefocus} takefocus]} {
	return [GuessTakeFocus $w]
 } else {
	switch -- $takefocus {
	 "" { return [GuessTakeFocus $w] }
	 0 { return 0 }
	 1 { return 1 }
	 default {
		return [expr {[uplevel #0 $takefocus [list $w]] == 1}]
	 }
	}
 }
}

## ttk::focusFirst $w --
#	Return the first descendant of $w, in preorder traversal order,
#	that can take keyboard focus, "" if none do.
#
# See also: tk_focusNext
#

proc ttk::focusFirst {w} {
 if {[ttk::takesFocus $w]} {
	return $w
 }
 foreach child [winfo children $w] {
	if {[set c [ttk::focusFirst $child]] ne ""} {
	 return $c
	}
 }
 return ""
}

### Grabs.
#
# Rules:
#	Each call to [grabWindow $w] or [globalGrab $w] must be
#	matched with a call to [releaseGrab $w] in LIFO order.
#
#	Do not call [grabWindow $w] for a window that currently
#	appears on the grab stack.
#
#	See #1239190 and #1411983 for more discussion.
#
namespace eval ttk {
 variable Grab 		;# map: window name -> grab token

 # grab token details:
 #	Two-element list containing:
 #	1) a script to evaluate to restore the previous grab (if any);
 #	2) a script to evaluate to restore the focus (if any)
}

## SaveGrab --
#	Record current grab and focus windows.
#
proc ttk::SaveGrab {w} {
 variable Grab

 if {[info exists Grab($w)]} {
	# $w is already on the grab stack.
	# This should not happen, but bail out in case it does anyway:
	#
	return
 }

 set restoreGrab [set restoreFocus ""]

 set grabbed [grab current $w]
 if {[winfo exists $grabbed]} {
 	switch [grab status $grabbed] {
	 global { set restoreGrab [list grab -global $grabbed] }
	 local { set restoreGrab [list grab $grabbed] }
	 none { ;# grab window is really in a different interp }
	}
 }

 set focus [focus]
 if {$focus ne ""} {
 	set restoreFocus [list focus -force $focus]
 }

 set Grab($w) [list $restoreGrab $restoreFocus]
}

## RestoreGrab --
#	Restore previous grab and focus windows.
#	If called more than once without an intervening [SaveGrab $w],
#	does nothing.
#
proc ttk::RestoreGrab {w} {
 variable Grab

 if {![info exists Grab($w)]} {	# Ignore
	return;
 }

 # The previous grab/focus window may have been destroyed,
 # unmapped, or some other abnormal condition; ignore any errors.
 #
 foreach script $Grab($w) {
	catch $script
 }

 unset Grab($w)
}

## ttk::grabWindow $w --
#	Records the current focus and grab windows, sets an application-modal
#	grab on window $w.
#
proc ttk::grabWindow {w} {
 SaveGrab $w
 grab $w
}

## ttk::globalGrab $w --
#	Same as grabWindow, but sets a global grab on $w.
#
proc ttk::globalGrab {w} {
 SaveGrab $w
 grab -global $w
}

## ttk::releaseGrab --
#	Release the grab previously set by [ttk::grabWindow]
#	or [ttk::globalGrab].
#
proc ttk::releaseGrab {w} {
 grab release $w
 RestoreGrab $w
}

### Auto-repeat.
#
# NOTE: repeating widgets do not have -repeatdelay
# or -repeatinterval resources as in standard Tk;
# instead a single set of settings is applied application-wide.
# (TODO: make this user-configurable)
#
# (@@@ Windows seems to use something like 500/50 milliseconds
# @@@ for -repeatdelay/-repeatinterval)
#

namespace eval ttk {
 variable Repeat
 array set Repeat {
	delay		300
	interval	100
	timer		{}
	script		{}
 }
}

## ttk::Repeatedly --
#	Begin auto-repeat.
#
proc ttk::Repeatedly {args} {
 variable Repeat
 after cancel $Repeat(timer)
 set script [uplevel 1 [list namespace code $args]]
 set Repeat(script) $script
 uplevel #0 $script
 set Repeat(timer) [after $Repeat(delay) ttk::Repeat]
}

## Repeat --
#	Continue auto-repeat
#
proc ttk::Repeat {} {
 variable Repeat
 uplevel #0 $Repeat(script)
 set Repeat(timer) [after $Repeat(interval) ttk::Repeat]
}

## ttk::CancelRepeat --
#	Halt auto-repeat.
#
proc ttk::CancelRepeat {} {
 variable Repeat
 after cancel $Repeat(timer)
}

### Bindings.
#

## ttk::copyBindings $from $to --
#	Utility routine; copies bindings from one bindtag onto another.
#
proc ttk::copyBindings {from to} {
 foreach event [bind $from] {
	bind $to $event [bind $from $event]
 }
}

### Mousewheel bindings.
#
# Platform inconsistencies:
#
# On X11, the server typically maps the mouse wheel to Button4 and Button5.
#
# On OSX, Tk generates sensible values for the %D field in <MouseWheel> events.
#
# On Windows, %D must be scaled by a factor of 120.
# In addition, Tk redirects mousewheel events to the window with
# keyboard focus instead of sending them to the window under the pointer.
# We do not attempt to fix that here, see also TIP#171.
#
# OSX conventionally uses Shift+MouseWheel for horizontal scrolling,
# and Option+MouseWheel for accelerated scrolling.
#
# The Shift+MouseWheel behavior is not conventional on Windows or most
# X11 toolkits, but it's useful.
#
# MouseWheel scrolling is accelerated on X11, which is conventional
# for Tk and appears to be conventional for other toolkits (although
# Gtk+ and Qt do not appear to use as large a factor).
#

## ttk::bindMouseWheel $bindtag $command...
#	Adds basic mousewheel support to $bindtag.
#	$command will be passed one additional argument
#	specifying the mousewheel direction (-1: up, +1: down).
#

proc ttk::bindMouseWheel {bindtag callback} {
 switch -- [tk windowingsystem] {
	x11 {
	 bind $bindtag <ButtonPress-4> "$callback -1"
	 bind $bindtag <ButtonPress-5> "$callback +1"
	}
	win32 {
	 bind $bindtag <MouseWheel> [append callback { [expr {-(%D/120)}]}]
	}
	aqua {
	 bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ]
	}
 }
}

## Mousewheel bindings for standard scrollable widgets.
#
# Usage: [ttk::copyBindings TtkScrollable $bindtag]
#
# $bindtag should be for a widget that supports the
# standard scrollbar protocol.
#

switch -- [tk windowingsystem] {
 x11 {
	bind TtkScrollable <ButtonPress-4> { %W yview scroll -5 units }
	bind TtkScrollable <ButtonPress-5> { %W yview scroll 5 units }
	bind TtkScrollable <Shift-ButtonPress-4> { %W xview scroll -5 units }
	bind TtkScrollable <Shift-ButtonPress-5> { %W xview scroll 5 units }
 }
 win32 {
	bind TtkScrollable <MouseWheel> \
	 { %W yview scroll [expr {-(%D/120)}] units }
	bind TtkScrollable <Shift-MouseWheel> \
	 { %W xview scroll [expr {-(%D/120)}] units }
 }
 aqua {
	bind TtkScrollable <MouseWheel> \
	 { %W yview scroll [expr {-(%D)}] units }
	bind TtkScrollable <Shift-MouseWheel> \
	 { %W xview scroll [expr {-(%D)}] units }
	bind TtkScrollable <Option-MouseWheel> \
	 { %W yview scroll [expr {-10*(%D)}] units }
	bind TtkScrollable <Shift-Option-MouseWheel> \
	 { %W xview scroll [expr {-10*(%D)}] units }
 }
}

#*EOF*