head	1.3;
access;
symbols
	core-8-5-9:1.3.2.2
	core-8-5-branch:1.3.0.2
	macosx-cocoa-merge:1.3
	macosx-cocoa-premerge:1.3
	macosx-carbon-freeze:1.3
	core-8-6-b1:1.3;
locks; strict;
comment	@# @;


1.3
date	2008.12.07.21.24.12;	author jenglish;	state Exp;
branches
	1.3.2.1;
next	1.2;

1.2
date	2008.12.07.18.42.55;	author jenglish;	state Exp;
branches;
next	1.1;

1.1
date	2008.11.01.15.34.24;	author patthoyts;	state Exp;
branches;
next	;

1.3.2.1
date	2008.12.07.21.24.12;	author hobbs;	state dead;
branches;
next	1.3.2.2;

1.3.2.2
date	2010.08.26.02.06.10;	author hobbs;	state Exp;
branches;
next	;


desc
@@


1.3
log
@ttk::spinbox: Add cross-platform MouseWheel bindings.
Factored out [ttk::bindMouseWheel] procedure.
@
text
@#
# $Id: spinbox.tcl,v 1.2 2008/12/07 18:42:55 jenglish Exp $
#
# ttk::spinbox bindings
#

namespace eval ttk::spinbox { }

### Spinbox bindings.
#
# Duplicate the Entry bindings, override if needed:
#

ttk::copyBindings TEntry TSpinbox

bind TSpinbox <Motion>			{ ttk::spinbox::Motion %W %x %y }
bind TSpinbox <ButtonPress-1> 		{ ttk::spinbox::Press %W %x %y }
bind TSpinbox <ButtonRelease-1> 	{ ttk::spinbox::Release %W }
bind TSpinbox <Double-Button-1> 	{ ttk::spinbox::DoubleClick %W %x %y }
bind TSpinbox <Triple-Button-1> 	{} ;# disable TEntry triple-click

bind TSpinbox <KeyPress-Up>		{ event generate %W <<Increment>> }
bind TSpinbox <KeyPress-Down> 		{ event generate %W <<Decrement>> }

bind TSpinbox <<Increment>>		{ ttk::spinbox::Spin %W +1 }
bind TSpinbox <<Decrement>> 		{ ttk::spinbox::Spin %W -1 }

ttk::bindMouseWheel TSpinbox 		[list ttk::spinbox::MouseWheel %W]

## Motion --
#	Sets cursor.
#
proc ttk::spinbox::Motion {w x y} {
    if {   [$w identify $x $y] eq "textarea"
        && [$w instate {!readonly !disabled}]
    } {
	ttk::setCursor $w text
    } else {
	ttk::setCursor $w ""
    }
}

## Press --
#
proc ttk::spinbox::Press {w x y} {
    if {[$w instate disabled]} { return }
    focus $w
    switch -glob -- [$w identify $x $y] {
        *textarea	{ ttk::entry::Press $w $x }
	*rightarrow	-
        *uparrow 	{ ttk::Repeatedly event generate $w <<Increment>> }
	*leftarrow	-
        *downarrow	{ ttk::Repeatedly event generate $w <<Decrement>> }
	*spinbutton {
	    if {$y * 2 >= [winfo height $w]} {
	    	set event <<Decrement>>
	    } else {
	    	set event <<Increment>>
	    }
	    ttk::Repeatedly event generate $w $event
	}
    }
}

## DoubleClick --
#	Select all if over the text area; otherwise same as Press.
#
proc ttk::spinbox::DoubleClick {w x y} {
    if {[$w instate disabled]} { return }

    switch -glob -- [$w identify $x $y] {
        *textarea	{ SelectAll $w }
	*		{ Press $w $x $y }
    }
}

proc ttk::spinbox::Release {w} {
    ttk::CancelRepeat
}

## MouseWheel --
#	Mousewheel callback.  Turn these into <<Increment>> (-1, up)
# 	or <<Decrement> (+1, down) events.
#
proc ttk::spinbox::MouseWheel {w dir} {
    if {$dir < 0} {
	event generate $w <<Increment>>
    } else {
	event generate $w <<Decrement>>
    }
}

## SelectAll --
#	Select widget contents.
#
proc ttk::spinbox::SelectAll {w} {
    $w selection range 0 end
    $w icursor end
}

## Limit --
#	Limit $v to lie between $min and $max
#
proc ttk::spinbox::Limit {v min max} {
    if {$v < $min} { return $min }
    if {$v > $max} { return $max }
    return $v
}

## Wrap --
#	Adjust $v to lie between $min and $max, wrapping if out of bounds.
#
proc ttk::spinbox::Wrap {v min max} {
    if {$v < $min} { return $max }
    if {$v > $max} { return $min }
    return $v
}

## Adjust --
#	Limit or wrap spinbox value depending on -wrap.
#
proc ttk::spinbox::Adjust {w v min max} {
    if {[$w cget -wrap]} {
	return [Wrap $v $min $max]
    } else  {
	return [Limit $v $min $max]
    }
}

## Spin --
#	Handle <<Increment>> and <<Decrement>> events.
#	If -values is specified, cycle through the list.
#	Otherwise cycle through numeric range based on
#	-from, -to, and -increment.
#
proc ttk::spinbox::Spin {w dir} {
    set nvalues [llength [set values [$w cget -values]]]
    set value [$w get]
    if {$nvalues} {
	set current [lsearch -exact $values $value]
	set index [Adjust $w [expr {$current + $dir}] 0 [expr {$nvalues - 1}]]
	$w set [lindex $values $index]
    } else {
        if {[catch {
    	    set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}]
	}]} {
	    set v [$w cget -from]
	}
	$w set [FormatValue $w [Adjust $w $v [$w cget -from] [$w cget -to]]]
    }
    SelectAll $w
    uplevel #0 [$w cget -command]
}

## FormatValue --
#	Reformat numeric value based on -format.
#
proc ttk::spinbox::FormatValue {w val} {
    set fmt [$w cget -format]
    if {$fmt eq ""} {
	# Try to guess a suitable -format based on -increment.
	set delta [expr {abs([$w cget -increment])}]
        if {0 < $delta && $delta < 1} {
	    # NB: This guesses wrong if -increment has more than 1
	    # significant digit itself, e.g., -increment 0.25
	    set nsd [expr {int(ceil(-log10($delta)))}]
	    set fmt "%.${nsd}f"
	} else {
	    set fmt "%.0f"
	}
    }
    return [format $fmt $val]
}

#*EOF*
@


1.3.2.1
log
@file spinbox.tcl was added on branch core-8-5-branch on 2010-08-26 02:06:10 +0000
@
text
@d1 175
@


1.3.2.2
log
@        Major backport of 8.6 Ttk for 8.5.9.  Most changes were only being
        committed to head (8.6), although they could apply for 8.5 as well.
        This re-sync makes future work easier to maintain and adds some
        useful work for 8.5 users. Notable changes:
        - Lots of code cleanup
        - Some bug fixes never backported
        - Addition of ttk::spinbox
        - minor color changes
        - Improved Vista/7 styling
        - Move to tile version 0.8.6 (pseudo-package)
        - ABI and API compatible (even $w identify)
        - minor new features (extended $w identify)
@
text
@a0 175
#
# $Id: spinbox.tcl,v 1.3 2008/12/07 21:24:12 jenglish Exp $
#
# ttk::spinbox bindings
#

namespace eval ttk::spinbox { }

### Spinbox bindings.
#
# Duplicate the Entry bindings, override if needed:
#

ttk::copyBindings TEntry TSpinbox

bind TSpinbox <Motion>			{ ttk::spinbox::Motion %W %x %y }
bind TSpinbox <ButtonPress-1> 		{ ttk::spinbox::Press %W %x %y }
bind TSpinbox <ButtonRelease-1> 	{ ttk::spinbox::Release %W }
bind TSpinbox <Double-Button-1> 	{ ttk::spinbox::DoubleClick %W %x %y }
bind TSpinbox <Triple-Button-1> 	{} ;# disable TEntry triple-click

bind TSpinbox <KeyPress-Up>		{ event generate %W <<Increment>> }
bind TSpinbox <KeyPress-Down> 		{ event generate %W <<Decrement>> }

bind TSpinbox <<Increment>>		{ ttk::spinbox::Spin %W +1 }
bind TSpinbox <<Decrement>> 		{ ttk::spinbox::Spin %W -1 }

ttk::bindMouseWheel TSpinbox 		[list ttk::spinbox::MouseWheel %W]

## Motion --
#	Sets cursor.
#
proc ttk::spinbox::Motion {w x y} {
    if {   [$w identify $x $y] eq "textarea"
        && [$w instate {!readonly !disabled}]
    } {
	ttk::setCursor $w text
    } else {
	ttk::setCursor $w ""
    }
}

## Press --
#
proc ttk::spinbox::Press {w x y} {
    if {[$w instate disabled]} { return }
    focus $w
    switch -glob -- [$w identify $x $y] {
        *textarea	{ ttk::entry::Press $w $x }
	*rightarrow	-
        *uparrow 	{ ttk::Repeatedly event generate $w <<Increment>> }
	*leftarrow	-
        *downarrow	{ ttk::Repeatedly event generate $w <<Decrement>> }
	*spinbutton {
	    if {$y * 2 >= [winfo height $w]} {
	    	set event <<Decrement>>
	    } else {
	    	set event <<Increment>>
	    }
	    ttk::Repeatedly event generate $w $event
	}
    }
}

## DoubleClick --
#	Select all if over the text area; otherwise same as Press.
#
proc ttk::spinbox::DoubleClick {w x y} {
    if {[$w instate disabled]} { return }

    switch -glob -- [$w identify $x $y] {
        *textarea	{ SelectAll $w }
	*		{ Press $w $x $y }
    }
}

proc ttk::spinbox::Release {w} {
    ttk::CancelRepeat
}

## MouseWheel --
#	Mousewheel callback.  Turn these into <<Increment>> (-1, up)
# 	or <<Decrement> (+1, down) events.
#
proc ttk::spinbox::MouseWheel {w dir} {
    if {$dir < 0} {
	event generate $w <<Increment>>
    } else {
	event generate $w <<Decrement>>
    }
}

## SelectAll --
#	Select widget contents.
#
proc ttk::spinbox::SelectAll {w} {
    $w selection range 0 end
    $w icursor end
}

## Limit --
#	Limit $v to lie between $min and $max
#
proc ttk::spinbox::Limit {v min max} {
    if {$v < $min} { return $min }
    if {$v > $max} { return $max }
    return $v
}

## Wrap --
#	Adjust $v to lie between $min and $max, wrapping if out of bounds.
#
proc ttk::spinbox::Wrap {v min max} {
    if {$v < $min} { return $max }
    if {$v > $max} { return $min }
    return $v
}

## Adjust --
#	Limit or wrap spinbox value depending on -wrap.
#
proc ttk::spinbox::Adjust {w v min max} {
    if {[$w cget -wrap]} {
	return [Wrap $v $min $max]
    } else  {
	return [Limit $v $min $max]
    }
}

## Spin --
#	Handle <<Increment>> and <<Decrement>> events.
#	If -values is specified, cycle through the list.
#	Otherwise cycle through numeric range based on
#	-from, -to, and -increment.
#
proc ttk::spinbox::Spin {w dir} {
    set nvalues [llength [set values [$w cget -values]]]
    set value [$w get]
    if {$nvalues} {
	set current [lsearch -exact $values $value]
	set index [Adjust $w [expr {$current + $dir}] 0 [expr {$nvalues - 1}]]
	$w set [lindex $values $index]
    } else {
        if {[catch {
    	    set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}]
	}]} {
	    set v [$w cget -from]
	}
	$w set [FormatValue $w [Adjust $w $v [$w cget -from] [$w cget -to]]]
    }
    SelectAll $w
    uplevel #0 [$w cget -command]
}

## FormatValue --
#	Reformat numeric value based on -format.
#
proc ttk::spinbox::FormatValue {w val} {
    set fmt [$w cget -format]
    if {$fmt eq ""} {
	# Try to guess a suitable -format based on -increment.
	set delta [expr {abs([$w cget -increment])}]
        if {0 < $delta && $delta < 1} {
	    # NB: This guesses wrong if -increment has more than 1
	    # significant digit itself, e.g., -increment 0.25
	    set nsd [expr {int(ceil(-log10($delta)))}]
	    set fmt "%.${nsd}f"
	} else {
	    set fmt "%.0f"
	}
    }
    return [format $fmt $val]
}

#*EOF*
@


1.2
log
@Add native aqua elements for ttk::spinbox [Bug 2219588].
Moved most spinbox "business logic" out of ttkEntry.c into Tcl bindings.
Minor spinbox appearance improvements in clam theme.
@
text
@d2 1
a2 1
# $Id$
d22 2
a23 2
bind TSpinbox <KeyPress-Up>		{ ttk::spinbox::Spin %W +1 }
bind TSpinbox <KeyPress-Down> 		{ ttk::spinbox::Spin %W -1 }
d28 1
a28 3

# @@@@@@ x-plat
bind TSpinbox <MouseWheel> { ttk::spinbox::Spin %W [expr {%D/-120}] }
d35 1
a35 1
        && [$w instate {!readonly !disabled}] 
d54 1
a54 1
	*spinbutton { 
d65 1
a65 1
## DoubleClick -- 
d81 15
d101 3
d110 3
d119 3
d130 6
d155 3
d164 1
a164 1
	    # NB: This guesses wrong if -increment has more than 1 
@


1.1
log
@Implemented the themed spinbox widget ttk::spinbox.
@
text
@d4 1
a4 1
# Tile widget set: spinbox bindings.
a5 4
#

namespace eval ttk::spinbox {
    variable Values	;# Values($cb) is -listvariable of listbox widget
d7 1
a7 3
    variable State
    set State(entryPress) 0
}
d16 8
a23 2
bind TSpinbox <Double-Button-1> {ttk::spinbox::Select %W %x %y word}
bind TSpinbox <Triple-Button-1> {ttk::spinbox::Select %W %x %y line}
d25 2
a26 5
bind TSpinbox <ButtonPress-1> { ttk::spinbox::Press %W %x %y }
bind TSpinbox <ButtonRelease-1> { ttk::spinbox::Release %W %x %y }
bind TSpinbox <MouseWheel> {ttk::spinbox::Change %W [expr {%D/-120}] line}
bind TSpinbox <Up> {ttk::spinbox::Change %W +[%W cget -increment] line}
bind TSpinbox <Down> {ttk::spinbox::Change %W -[%W cget -increment] line}
d29 18
a48 3
    variable State
    set State(xPress) $x
    set State(yPress) $y
d51 13
a63 12
        *uparrow {
            ttk::Repeatedly Change $w +[$w cget -increment] line
        }
        *downarrow {
            ttk::Repeatedly Change $w -[$w cget -increment] line
        }
        *textarea {
            set State(entryPress) [$w instate !readonly]
            if {$State(entryPress)} {
                ttk::entry::Press $w $x
            }
        }
d67 13
a79 3
proc ttk::spinbox::Release {w x y} {
    variable State
    unset -nocomplain State(xPress) State(yPress)
d83 32
a114 14
proc ttk::spinbox::Change {w n units} {
    if {[set vlen [llength [$w cget -values]]] != 0} {
        set index [expr {[$w current] + $n}]
        if {[catch {$w current $index}]} {
            if {[$w cget -wrap]} {
                if {$index == -1} {
                    set index [llength [$w cget -values]]
                    incr index -1
                } else {
                    set index 0
                }
                $w current $index
            }
        }
d116 6
a121 16
        if {![catch {expr {[$w get] + $n}} v]} {
            if {$v < [$w cget -from]} {
                if {[$w cget -wrap]} {
                    set v [$w cget -to]
                } else {
                    set v [$w cget -from]
                }
            } elseif {$v > [$w cget -to]} {
                if {[$w cget -wrap]} {
                    set v [$w cget -from]
                } else {
                    set v [$w cget -to]
                }
            }
            $w set $v
        }
d123 1
a123 4
    ::ttk::entry::Select $w 0 $units

    # Run -command callback:
    #
a124 1

d127 13
a139 17
# Spinbox double-click on the arrows needs interception, otherwise
# pass to the TEntry handler
proc ttk::spinbox::Select {w x y mode} {
    if {[$w instate disabled]} { return }
    variable State
    set State(xPress) $x
    set State(yPress) $y
    switch -glob -- [$w identify $x $y] {
        *uparrow {
            ttk::Repeatedly Change $w +[$w cget -increment] units
        }
        *downarrow {
            ttk::Repeatedly Change $w -[$w cget -increment] units
        }
        *textarea { 
            return [::ttk::entry::Select $w $x $mode]
        }
d141 1
a141 1
    return -code continue
@

