# spinbox.tcl --

#

# This file defines the default bindings for Tk spinbox widgets and provides

# procedures that help in implementing those bindings.  The spinbox builds

# off the entry widget, so it can reuse Entry bindings and procedures.

#

# RCS: @(#) $Id: spinbox.tcl,v 1.6 2002/08/31 06:12:28 das Exp $

#

# Copyright (c) 1992-1994 The Regents of the University of California.

# Copyright (c) 1994-1997 Sun Microsystems, Inc.

# Copyright (c) 1999-2000 Jeffrey Hobbs

# Copyright (c) 2000 Ajuba Solutions

#

# See the file "license.terms" for information on usage and redistribution

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#

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

# Elements of tk::Priv that are used in this file:

#

# afterId -		If non-null, it means that auto-scanning is underway

#			and it gives the "after" id for the next auto-scan

#			command to be executed.

# mouseMoved -		Non-zero means the mouse has moved a significant

#			amount since the button went down (so, for example,

#			start dragging out a selection).

# pressX -		X-coordinate at which the mouse button was pressed.

# selectMode -		The style of selection currently underway:

#			char, word, or line.

# x, y -		Last known mouse coordinates for scanning

#			and auto-scanning.

# data -		Used for Cut and Copy

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

# Initialize namespace

namespace eval ::tk::spinbox {}

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

# The code below creates the default class bindings for entries.

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

bind Spinbox <<Cut>> {

    if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {

	clipboard clear -displayof %W

	clipboard append -displayof %W $tk::Priv(data)

	%W delete sel.first sel.last

	unset tk::Priv(data)

    }

}

bind Spinbox <<Copy>> {

    if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {

	clipboard clear -displayof %W

	clipboard append -displayof %W $tk::Priv(data)

	unset tk::Priv(data)

    }

}

bind Spinbox <<Paste>> {

    global tcl_platform

    catch {

	if {[tk windowingsystem] ne "x11"} {

	    catch {

		%W delete sel.first sel.last

	    }

	}

	%W insert insert [::tk::GetSelection %W CLIPBOARD]

	::tk::EntrySeeInsert %W

    }

}

bind Spinbox <<Clear>> {

    %W delete sel.first sel.last

}

bind Spinbox <<PasteSelection>> {

    if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]

	|| !$tk::Priv(mouseMoved)} {

	::tk::spinbox::Paste %W %x

    }

}

# Standard Motif bindings:

bind Spinbox <1> {

    ::tk::spinbox::ButtonDown %W %x %y

}

bind Spinbox <B1-Motion> {

    ::tk::spinbox::Motion %W %x %y

}

bind Spinbox <Double-1> {

    set tk::Priv(selectMode) word

    ::tk::spinbox::MouseSelect %W %x sel.first

}

bind Spinbox <Triple-1> {

    set tk::Priv(selectMode) line

    ::tk::spinbox::MouseSelect %W %x 0

}

bind Spinbox <Shift-1> {

    set tk::Priv(selectMode) char

    %W selection adjust @%x

}

bind Spinbox <Double-Shift-1> {

    set tk::Priv(selectMode) word

    ::tk::spinbox::MouseSelect %W %x

}

bind Spinbox <Triple-Shift-1> {

    set tk::Priv(selectMode) line

    ::tk::spinbox::MouseSelect %W %x

}

bind Spinbox <B1-Leave> {

    set tk::Priv(x) %x

    ::tk::spinbox::AutoScan %W

}

bind Spinbox <B1-Enter> {

    tk::CancelRepeat

}

bind Spinbox <ButtonRelease-1> {

    ::tk::spinbox::ButtonUp %W %x %y

}

bind Spinbox <Control-1> {

    %W icursor @%x

}

bind Spinbox <Up> {

    %W invoke buttonup

}

bind Spinbox <Down> {

    %W invoke buttondown

}

bind Spinbox <Left> {

    ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]

}

bind Spinbox <Right> {

    ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]

}

bind Spinbox <Shift-Left> {

    ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}]

    ::tk::EntrySeeInsert %W

}

bind Spinbox <Shift-Right> {

    ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}]

    ::tk::EntrySeeInsert %W

}

bind Spinbox <Control-Left> {

    ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]

}

bind Spinbox <Control-Right> {

    ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]

}

bind Spinbox <Shift-Control-Left> {

    ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert]

    ::tk::EntrySeeInsert %W

}

bind Spinbox <Shift-Control-Right> {

    ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert]

    ::tk::EntrySeeInsert %W

}

bind Spinbox <Home> {

    ::tk::EntrySetCursor %W 0

}

bind Spinbox <Shift-Home> {

    ::tk::EntryKeySelect %W 0

    ::tk::EntrySeeInsert %W

}

bind Spinbox <End> {

    ::tk::EntrySetCursor %W end

}

bind Spinbox <Shift-End> {

    ::tk::EntryKeySelect %W end

    ::tk::EntrySeeInsert %W

}

bind Spinbox <Delete> {

    if {[%W selection present]} {

	%W delete sel.first sel.last

    } else {

	%W delete insert

    }

}

bind Spinbox <BackSpace> {

    ::tk::EntryBackspace %W

}

bind Spinbox <Control-space> {

    %W selection from insert

}

bind Spinbox <Select> {

    %W selection from insert

}

bind Spinbox <Control-Shift-space> {

    %W selection adjust insert

}

bind Spinbox <Shift-Select> {

    %W selection adjust insert

}

bind Spinbox <Control-slash> {

    %W selection range 0 end

}

bind Spinbox <Control-backslash> {

    %W selection clear

}

bind Spinbox <KeyPress> {

    ::tk::EntryInsert %W %A

}

# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.

# Otherwise, if a widget binding for one of these is defined, the

# <KeyPress> class binding will also fire and insert the character,

# which is wrong.  Ditto for Escape, Return, and Tab.

bind Spinbox <Alt-KeyPress> {# nothing}

bind Spinbox <Meta-KeyPress> {# nothing}

bind Spinbox <Control-KeyPress> {# nothing}

bind Spinbox <Escape> {# nothing}

bind Spinbox <Return> {# nothing}

bind Spinbox <KP_Enter> {# nothing}

bind Spinbox <Tab> {# nothing}

if {[string equal [tk windowingsystem] "classic"]

	|| [string equal [tk windowingsystem] "aqua"]} {

	bind Spinbox <Command-KeyPress> {# nothing}

}

# On Windows, paste is done using Shift-Insert.  Shift-Insert already

# generates the <<Paste>> event, so we don't need to do anything here.

if {[string compare $tcl_platform(platform) "windows"]} {

    bind Spinbox <Insert> {

	catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}

    }

}

# Additional emacs-like bindings:

bind Spinbox <Control-a> {

    if {!$tk_strictMotif} {

	::tk::EntrySetCursor %W 0

    }

}

bind Spinbox <Control-b> {

    if {!$tk_strictMotif} {

	::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]

    }

}

bind Spinbox <Control-d> {

    if {!$tk_strictMotif} {

	%W delete insert

    }

}

bind Spinbox <Control-e> {

    if {!$tk_strictMotif} {

	::tk::EntrySetCursor %W end

    }

}

bind Spinbox <Control-f> {

    if {!$tk_strictMotif} {

	::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]

    }

}

bind Spinbox <Control-h> {

    if {!$tk_strictMotif} {

	::tk::EntryBackspace %W

    }

}

bind Spinbox <Control-k> {

    if {!$tk_strictMotif} {

	%W delete insert end

    }

}

bind Spinbox <Control-t> {

    if {!$tk_strictMotif} {

	::tk::EntryTranspose %W

    }

}

bind Spinbox <Meta-b> {

    if {!$tk_strictMotif} {

	::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]

    }

}

bind Spinbox <Meta-d> {

    if {!$tk_strictMotif} {

	%W delete insert [::tk::EntryNextWord %W insert]

    }

}

bind Spinbox <Meta-f> {

    if {!$tk_strictMotif} {

	::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]

    }

}

bind Spinbox <Meta-BackSpace> {

    if {!$tk_strictMotif} {

	%W delete [::tk::EntryPreviousWord %W insert] insert

    }

}

bind Spinbox <Meta-Delete> {

    if {!$tk_strictMotif} {

	%W delete [::tk::EntryPreviousWord %W insert] insert

    }

}

# A few additional bindings of my own.

bind Spinbox <2> {

    if {!$tk_strictMotif} {

	::tk::EntryScanMark %W %x

    }

}

bind Spinbox <B2-Motion> {

    if {!$tk_strictMotif} {

	::tk::EntryScanDrag %W %x

    }

}

# ::tk::spinbox::Invoke --

# Invoke an element of the spinbox

#

# Arguments:

# w -		The spinbox window.

# elem -	Element to invoke

proc ::tk::spinbox::Invoke {w elem} {

    variable ::tk::Priv

    if {![info exists Priv(outsideElement)]} {

	$w invoke $elem

	incr Priv(repeated)

    }

    set delay [$w cget -repeatinterval]

    if {$delay > 0} {

	set Priv(afterId) [after $delay \

		[list ::tk::spinbox::Invoke $w $elem]]

    }

}

# ::tk::spinbox::ClosestGap --

# Given x and y coordinates, this procedure finds the closest boundary

# between characters to the given coordinates and returns the index

# of the character just after the boundary.

#

# Arguments:

# w -		The spinbox window.

# x -		X-coordinate within the window.

proc ::tk::spinbox::ClosestGap {w x} {

    set pos [$w index @$x]

    set bbox [$w bbox $pos]

    if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {

	return $pos

    }

    incr pos

}

# ::tk::spinbox::ButtonDown --

# This procedure is invoked to handle button-1 presses in spinbox

# widgets.  It moves the insertion cursor, sets the selection anchor,

# and claims the input focus.

#

# Arguments:

# w -		The spinbox window in which the button was pressed.

# x -		The x-coordinate of the button press.

proc ::tk::spinbox::ButtonDown {w x y} {

    variable ::tk::Priv

    # Get the element that was clicked in.  If we are not directly over

    # the spinbox, default to entry.  This is necessary for spinbox grabs.

    #

    set Priv(element) [$w identify $x $y]

    if {$Priv(element) eq ""} {

	set Priv(element) "entry"

    }

    switch -exact $Priv(element) {

	"buttonup" - "buttondown" {

	    if {"disabled" ne [$w cget -state]} {

		$w selection element $Priv(element)

		set Priv(repeated) 0

		set Priv(relief) [$w cget -$Priv(element)relief]

		catch {after cancel $Priv(afterId)}

		set delay [$w cget -repeatdelay]

		if {$delay > 0} {

		    set Priv(afterId) [after $delay \

			    [list ::tk::spinbox::Invoke $w $Priv(element)]]

		}

		if {[info exists Priv(outsideElement)]} {

		    unset Priv(outsideElement)

		}

	    }

	}

	"entry" {

	    set Priv(selectMode) char

	    set Priv(mouseMoved) 0

	    set Priv(pressX) $x

	    $w icursor [::tk::spinbox::ClosestGap $w $x]

	    $w selection from insert

	    if {"disabled" ne [$w cget -state]} {focus $w}

	    $w selection clear

	}

	default {

	    return -code error "unknown spinbox element \"$Priv(element)\""

	}

    }

}

# ::tk::spinbox::ButtonUp --

# This procedure is invoked to handle button-1 releases in spinbox

# widgets.

#

# Arguments:

# w -		The spinbox window in which the button was pressed.

# x -		The x-coordinate of the button press.

proc ::tk::spinbox::ButtonUp {w x y} {

    variable ::tk::Priv

    ::tk::CancelRepeat

    # Priv(relief) may not exist if the ButtonUp is not paired with

    # a preceding ButtonDown

    if {[info exists Priv(element)] && [info exists Priv(relief)] && \

	    [string match "button*" $Priv(element)]} {

	if {[info exists Priv(repeated)] && !$Priv(repeated)} {

	    $w invoke $Priv(element)

	}

	$w configure -$Priv(element)relief $Priv(relief)

	$w selection element none

    }

}

# ::tk::spinbox::MouseSelect --

# This procedure is invoked when dragging out a selection with

# the mouse.  Depending on the selection mode (character, word,

# line) it selects in different-sized units.  This procedure

# ignores mouse motions initially until the mouse has moved from

# one character to another or until there have been multiple clicks.

#

# Arguments:

# w -		The spinbox window in which the button was pressed.

# x -		The x-coordinate of the mouse.

# cursor -	optional place to set cursor.

proc ::tk::spinbox::MouseSelect {w x {cursor {}}} {

    variable ::tk::Priv

    if {$Priv(element) ne "entry"} {

	# The ButtonUp command triggered by ButtonRelease-1 handles

	# invoking one of the spinbuttons.

	return

    }

    set cur [::tk::spinbox::ClosestGap $w $x]

    set anchor [$w index anchor]

    if {($cur ne $anchor) || (abs($Priv(pressX) - $x) >= 3)} {

	set Priv(mouseMoved) 1

    }

    switch $Priv(selectMode) {

	char {

	    if {$Priv(mouseMoved)} {

		if {$cur < $anchor} {

		    $w selection range $cur $anchor

		} elseif {$cur > $anchor} {

		    $w selection range $anchor $cur

		} else {

		    $w selection clear

		}

	    }

	}

	word {

	    if {$cur < [$w index anchor]} {

		set before [tcl_wordBreakBefore [$w get] $cur]

		set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]

	    } else {

		set before [tcl_wordBreakBefore [$w get] $anchor]

		set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]

	    }

	    if {$before < 0} {

		set before 0

	    }

	    if {$after < 0} {

		set after end

	    }

	    $w selection range $before $after

	}

	line {

	    $w selection range 0 end

	}

    }

    if {$cursor ne {} && $cursor ne "ignore"} {

	catch {$w icursor $cursor}

    }

    update idletasks

}

# ::tk::spinbox::Paste --

# This procedure sets the insertion cursor to the current mouse position,

# pastes the selection there, and sets the focus to the window.

#

# Arguments:

# w -		The spinbox window.

# x -		X position of the mouse.

proc ::tk::spinbox::Paste {w x} {

    $w icursor [::tk::spinbox::ClosestGap $w $x]

    catch {$w insert insert [::tk::GetSelection $w PRIMARY]}

    if {[string equal "disabled" [$w cget -state]]} {focus $w}

}

# ::tk::spinbox::Motion --

# This procedure is invoked when the mouse moves in a spinbox window

# with button 1 down.

#

# Arguments:

# w -		The spinbox window.

proc ::tk::spinbox::Motion {w x y} {

    variable ::tk::Priv

    if {![info exists Priv(element)]} {

	set Priv(element) [$w identify $x $y]

    }

    set Priv(x) $x

    if {"entry" eq $Priv(element)} {

	::tk::spinbox::MouseSelect $w $x ignore

    } elseif {[$w identify $x $y] ne $Priv(element)} {

	if {![info exists Priv(outsideElement)]} {

	    # We've wandered out of the spin button

	    # setting outside element will cause ::tk::spinbox::Invoke to

	    # loop without doing anything

	    set Priv(outsideElement) ""

	    $w selection element none

	}

    } elseif {[info exists Priv(outsideElement)]} {

	unset Priv(outsideElement)