summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorhobbs <hobbs>2000-05-29 01:43:13 (GMT)
committerhobbs <hobbs>2000-05-29 01:43:13 (GMT)
commitabcf7507cc5ab608bb75d22bbb408ee6bc5f0b1a (patch)
tree8e72919b463211e30307b0e8eb87f7a28e578327 /library
parentf78e5fa2c3172a6d7f3ee6e4d77819d9c16b48d1 (diff)
downloadtk-abcf7507cc5ab608bb75d22bbb408ee6bc5f0b1a.zip
tk-abcf7507cc5ab608bb75d22bbb408ee6bc5f0b1a.tar.gz
tk-abcf7507cc5ab608bb75d22bbb408ee6bc5f0b1a.tar.bz2
* doc/spinbox.n: (new file) docs for spinbox widget
* generic/tkInt.h: added Tk_SpinboxObjCmd declaration * generic/tkEntry.c: added 'spinbox' widget - an extension of the entry widget type. * generic/tkWindow.c: added 'spinbox' to core Tk commands * library/spinbox.tcl: (new file) binding and helper procs for spinbox * library/tk.tcl: added spinbox.tcl to list of files to source * tests/entry.test: updated changed error messages * tests/spinbox.test: (new file) test suite for spinbox
Diffstat (limited to 'library')
-rw-r--r--library/entry.tcl6
-rw-r--r--library/spinbox.tcl746
-rw-r--r--library/tk.tcl3
3 files changed, 751 insertions, 4 deletions
diff --git a/library/entry.tcl b/library/entry.tcl
index a46561e..b44eaad 100644
--- a/library/entry.tcl
+++ b/library/entry.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
-# RCS: @(#) $Id: entry.tcl,v 1.12 2000/05/14 20:45:38 ericm Exp $
+# RCS: @(#) $Id: entry.tcl,v 1.13 2000/05/29 01:43:14 hobbs Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -336,7 +336,7 @@ proc tkEntryButton1 {w x} {
set tkPriv(pressX) $x
$w icursor [tkEntryClosestGap $w $x]
$w selection from insert
- if {[string compare [$w cget -state] "disabled"]} {focus $w}
+ if {[string compare "disabled" [$w cget -state]]} {focus $w}
}
# tkEntryMouseSelect --
@@ -406,7 +406,7 @@ proc tkEntryPaste {w x} {
$w icursor [tkEntryClosestGap $w $x]
catch {$w insert insert [selection get -displayof $w]}
- if {[string equal [$w cget -state] "normal"]} {focus $w}
+ if {[string compare "disabled" [$w cget -state]]} {focus $w}
}
# tkEntryAutoScan --
diff --git a/library/spinbox.tcl b/library/spinbox.tcl
new file mode 100644
index 0000000..b93479b
--- /dev/null
+++ b/library/spinbox.tcl
@@ -0,0 +1,746 @@
+# spinbox.tcl --
+#
+# This file defines the default bindings for Tk spinbox widgets and provides
+# procedures that help in implementing those bindings.
+#
+# RCS: @(#) $Id: spinbox.tcl,v 1.1 2000/05/29 01:43:15 hobbs 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 tkPriv 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} tkPriv(data)]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $tkPriv(data)
+ %W delete sel.first sel.last
+ unset tkPriv(data)
+ }
+}
+bind Spinbox <<Copy>> {
+ if {![catch {::tk::spinbox::GetSelection %W} tkPriv(data)]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $tkPriv(data)
+ unset tkPriv(data)
+ }
+}
+bind Spinbox <<Paste>> {
+ global tcl_platform
+ catch {
+ if {[string compare $tcl_platform(platform) "unix"]} {
+ catch {
+ %W delete sel.first sel.last
+ }
+ }
+ %W insert insert [selection get -displayof %W -selection CLIPBOARD]
+ ::tk::spinbox::SeeInsert %W
+ }
+}
+bind Spinbox <<Clear>> {
+ %W delete sel.first sel.last
+}
+bind Spinbox <<PasteSelection>> {
+ if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
+ ::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 tkPriv(selectMode) word
+ ::tk::spinbox::MouseSelect %W %x sel.first
+}
+bind Spinbox <Triple-1> {
+ set tkPriv(selectMode) line
+ ::tk::spinbox::MouseSelect %W %x 0
+}
+bind Spinbox <Shift-1> {
+ set tkPriv(selectMode) char
+ %W selection adjust @%x
+}
+bind Spinbox <Double-Shift-1> {
+ set tkPriv(selectMode) word
+ ::tk::spinbox::MouseSelect %W %x
+}
+bind Spinbox <Triple-Shift-1> {
+ set tkPriv(selectMode) line
+ ::tk::spinbox::MouseSelect %W %x
+}
+bind Spinbox <B1-Leave> {
+ set tkPriv(x) %x
+ ::tk::spinbox::AutoScan %W
+}
+bind Spinbox <B1-Enter> {
+ tkCancelRepeat
+}
+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::spinbox::SetCursor %W [expr {[%W index insert] - 1}]
+}
+bind Spinbox <Right> {
+ ::tk::spinbox::SetCursor %W [expr {[%W index insert] + 1}]
+}
+bind Spinbox <Shift-Left> {
+ ::tk::spinbox::KeySelect %W [expr {[%W index insert] - 1}]
+ ::tk::spinbox::SeeInsert %W
+}
+bind Spinbox <Shift-Right> {
+ ::tk::spinbox::KeySelect %W [expr {[%W index insert] + 1}]
+ ::tk::spinbox::SeeInsert %W
+}
+bind Spinbox <Control-Left> {
+ ::tk::spinbox::SetCursor %W [::tk::spinbox::PreviousWord %W insert]
+}
+bind Spinbox <Control-Right> {
+ ::tk::spinbox::SetCursor %W [::tk::spinbox::NextWord %W insert]
+}
+bind Spinbox <Shift-Control-Left> {
+ ::tk::spinbox::KeySelect %W [::tk::spinbox::PreviousWord %W insert]
+ ::tk::spinbox::SeeInsert %W
+}
+bind Spinbox <Shift-Control-Right> {
+ ::tk::spinbox::KeySelect %W [::tk::spinbox::NextWord %W insert]
+ ::tk::spinbox::SeeInsert %W
+}
+bind Spinbox <Home> {
+ ::tk::spinbox::SetCursor %W 0
+}
+bind Spinbox <Shift-Home> {
+ ::tk::spinbox::KeySelect %W 0
+ ::tk::spinbox::SeeInsert %W
+}
+bind Spinbox <End> {
+ ::tk::spinbox::SetCursor %W end
+}
+bind Spinbox <Shift-End> {
+ ::tk::spinbox::KeySelect %W end
+ ::tk::spinbox::SeeInsert %W
+}
+
+bind Spinbox <Delete> {
+ if {[%W selection present]} {
+ %W delete sel.first sel.last
+ } else {
+ %W delete insert
+ }
+}
+bind Spinbox <BackSpace> {
+ ::tk::spinbox::Backspace %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::spinbox::Insert %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 $tcl_platform(platform) "macintosh"]} {
+ 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::spinbox::Insert %W [selection get -displayof %W]}
+ }
+}
+
+# Additional emacs-like bindings:
+
+bind Spinbox <Control-a> {
+ if {!$tk_strictMotif} {
+ ::tk::spinbox::SetCursor %W 0
+ }
+}
+bind Spinbox <Control-b> {
+ if {!$tk_strictMotif} {
+ ::tk::spinbox::SetCursor %W [expr {[%W index insert] - 1}]
+ }
+}
+bind Spinbox <Control-d> {
+ if {!$tk_strictMotif} {
+ %W delete insert
+ }
+}
+bind Spinbox <Control-e> {
+ if {!$tk_strictMotif} {
+ ::tk::spinbox::SetCursor %W end
+ }
+}
+bind Spinbox <Control-f> {
+ if {!$tk_strictMotif} {
+ ::tk::spinbox::SetCursor %W [expr {[%W index insert] + 1}]
+ }
+}
+bind Spinbox <Control-h> {
+ if {!$tk_strictMotif} {
+ ::tk::spinbox::Backspace %W
+ }
+}
+bind Spinbox <Control-k> {
+ if {!$tk_strictMotif} {
+ %W delete insert end
+ }
+}
+bind Spinbox <Control-t> {
+ if {!$tk_strictMotif} {
+ ::tk::spinbox::Transpose %W
+ }
+}
+bind Spinbox <Meta-b> {
+ if {!$tk_strictMotif} {
+ ::tk::spinbox::SetCursor %W [::tk::spinbox::PreviousWord %W insert]
+ }
+}
+bind Spinbox <Meta-d> {
+ if {!$tk_strictMotif} {
+ %W delete insert [::tk::spinbox::NextWord %W insert]
+ }
+}
+bind Spinbox <Meta-f> {
+ if {!$tk_strictMotif} {
+ ::tk::spinbox::SetCursor %W [::tk::spinbox::NextWord %W insert]
+ }
+}
+bind Spinbox <Meta-BackSpace> {
+ if {!$tk_strictMotif} {
+ %W delete [::tk::spinbox::PreviousWord %W insert] insert
+ }
+}
+bind Spinbox <Meta-Delete> {
+ if {!$tk_strictMotif} {
+ %W delete [::tk::spinbox::PreviousWord %W insert] insert
+ }
+}
+
+# A few additional bindings of my own.
+
+bind Spinbox <2> {
+ if {!$tk_strictMotif} {
+ %W scan mark %x
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(mouseMoved) 0
+ }
+}
+bind Spinbox <B2-Motion> {
+ if {!$tk_strictMotif} {
+ if {abs(%x-$tkPriv(x)) > 2} {
+ set tkPriv(mouseMoved) 1
+ }
+ %W scan dragto %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} {
+ global tkPriv
+
+ if {![info exists tkPriv(outsideElement)]} {
+ $w invoke $elem
+ incr tkPriv(repeated)
+ }
+ set delay [$w cget -repeatinterval]
+ if {$delay > 0} {
+ set tkPriv(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} {
+ global tkPriv
+
+ # 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 tkPriv(element) [$w identify $x $y]
+ if {$tkPriv(element) eq ""} {
+ set tkPriv(element) "entry"
+ }
+
+ switch -exact $tkPriv(element) {
+ "buttonup" - "buttondown" {
+ if {[string compare "disabled" [$w cget -state]]} {
+ $w selection element $tkPriv(element)
+ set tkPriv(repeated) 0
+ set tkPriv(relief) [$w cget -$tkPriv(element)relief]
+ after cancel $tkPriv(afterId)
+ set delay [$w cget -repeatdelay]
+ if {$delay > 0} {
+ set tkPriv(afterId) [after $delay \
+ [list ::tk::spinbox::Invoke $w $tkPriv(element)]]
+ }
+ if {[info exists tkPriv(outsideElement)]} {
+ unset tkPriv(outsideElement)
+ }
+ }
+ }
+ "entry" {
+ set tkPriv(selectMode) char
+ set tkPriv(mouseMoved) 0
+ set tkPriv(pressX) $x
+ $w icursor [::tk::spinbox::ClosestGap $w $x]
+ $w selection from insert
+ if {[string compare "disabled" [$w cget -state]]} {focus $w}
+ $w selection clear
+ }
+ default {
+ return -code error "unknown spinbox element \"$tkPriv(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} {
+ global tkPriv
+
+ tkCancelRepeat
+
+ # tkPriv(relief) may not exist if the ButtonUp is not paired with
+ # a preceding ButtonDown
+ if {[info exists tkPriv(element)] && [info exists tkPriv(relief)] && \
+ [string match "button*" $tkPriv(element)]} {
+ if {[info exists tkPriv(repeated)] && !$tkPriv(repeated)} {
+ $w invoke $tkPriv(element)
+ }
+ $w configure -$tkPriv(element)relief $tkPriv(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 {}}} {
+ global tkPriv
+
+ if {[string compare "entry" $tkPriv(element)]} {
+ if {[string compare "none" $tkPriv(element)] && \
+ [string compare "ignore" $cursor]} {
+ $w selection element none
+ $w invoke $tkPriv(element)
+ $w selection element $tkPriv(element)
+ }
+ return
+ }
+ set cur [::tk::spinbox::ClosestGap $w $x]
+ set anchor [$w index anchor]
+ if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {
+ set tkPriv(mouseMoved) 1
+ }
+ switch $tkPriv(selectMode) {
+ char {
+ if {$tkPriv(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 {[string compare $cursor {}] && [string compare $cursor "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} {
+ global tkPriv
+
+ $w icursor [::tk::spinbox::ClosestGap $w $x]
+ catch {$w insert insert [selection get -displayof $w]}
+ 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} {
+ global tkPriv
+
+ if {![info exists tkPriv(element)]} {
+ set tkPriv(element) [$w identify $x $y]
+ }
+
+ set tkPriv(x) $x
+ if {[string equal "entry" $tkPriv(element)]} {
+ ::tk::spinbox::MouseSelect $w $x ignore
+ } elseif {[string compare [$w identify $x $y] $tkPriv(element)]} {
+ if {![info exists tkPriv(outsideElement)]} {
+ # We've wandered out of the spin button
+ # setting outside element will cause ::tk::spinbox::Invoke to
+ # loop without doing anything
+ set tkPriv(outsideElement) ""
+ $w selection element none
+ }
+ } elseif {[info exists tkPriv(outsideElement)]} {
+ unset tkPriv(outsideElement)
+ $w selection element $tkPriv(element)
+ }
+}
+
+# ::tk::spinbox::AutoScan --
+# This procedure is invoked when the mouse leaves an spinbox window
+# with button 1 down. It scrolls the window left or right,
+# depending on where the mouse is, and reschedules itself as an
+# "after" command so that the window continues to scroll until the
+# mouse moves back into the window or the mouse button is released.
+#
+# Arguments:
+# w - The spinbox window.
+
+proc ::tk::spinbox::AutoScan {w} {
+ global tkPriv
+
+ set x $tkPriv(x)
+ if {$x >= [winfo width $w]} {
+ $w xview scroll 2 units
+ ::tk::spinbox::MouseSelect $w $x ignore
+ } elseif {$x < 0} {
+ $w xview scroll -2 units
+ ::tk::spinbox::MouseSelect $w $x ignore
+ }
+ set tkPriv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]]
+}
+
+# ::tk::spinbox::KeySelect --
+# This procedure is invoked when stroking out selections using the
+# keyboard. It moves the cursor to a new position, then extends
+# the selection to that position.
+#
+# Arguments:
+# w - The spinbox window.
+# new - A new position for the insertion cursor (the cursor hasn't
+# actually been moved to this position yet).
+
+proc ::tk::spinbox::KeySelect {w new} {
+ if {![$w selection present]} {
+ $w selection from insert
+ $w selection to $new
+ } else {
+ $w selection adjust $new
+ }
+ $w icursor $new
+}
+
+# ::tk::spinbox::Insert --
+# Insert a string into an spinbox at the point of the insertion cursor.
+# If there is a selection in the spinbox, and it covers the point of the
+# insertion cursor, then delete the selection before inserting.
+#
+# Arguments:
+# w - The spinbox window in which to insert the string
+# s - The string to insert (usually just a single character)
+
+proc ::tk::spinbox::Insert {w s} {
+ if {$s == ""} {
+ return
+ }
+ catch {
+ set insert [$w index insert]
+ if {([$w index sel.first] <= $insert) \
+ && ([$w index sel.last] >= $insert)} {
+ $w delete sel.first sel.last
+ }
+ }
+ $w insert insert $s
+ ::tk::spinbox::SeeInsert $w
+}
+
+# ::tk::spinbox::Backspace --
+# Backspace over the character just before the insertion cursor.
+# If backspacing would move the cursor off the left edge of the
+# window, reposition the cursor at about the middle of the window.
+#
+# Arguments:
+# w - The spinbox window in which to backspace.
+
+proc ::tk::spinbox::Backspace w {
+ if {[$w selection present]} {
+ $w delete sel.first sel.last
+ } else {
+ set x [expr {[$w index insert] - 1}]
+ if {$x >= 0} {$w delete $x}
+ if {[$w index @0] >= [$w index insert]} {
+ set range [$w xview]
+ set left [lindex $range 0]
+ set right [lindex $range 1]
+ $w xview moveto [expr {$left - ($right - $left)/2.0}]
+ }
+ }
+}
+
+# ::tk::spinbox::SeeInsert --
+# Make sure that the insertion cursor is visible in the spinbox window.
+# If not, adjust the view so that it is.
+#
+# Arguments:
+# w - The spinbox window.
+
+proc ::tk::spinbox::SeeInsert w {
+ set c [$w index insert]
+ if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
+ $w xview $c
+ }
+}
+
+# ::tk::spinbox::SetCursor -
+# Move the insertion cursor to a given position in an spinbox. Also
+# clears the selection, if there is one in the spinbox, and makes sure
+# that the insertion cursor is visible.
+#
+# Arguments:
+# w - The spinbox window.
+# pos - The desired new position for the cursor in the window.
+
+proc ::tk::spinbox::SetCursor {w pos} {
+ $w icursor $pos
+ $w selection clear
+ ::tk::spinbox::SeeInsert $w
+}
+
+# ::tk::spinbox::Transpose -
+# This procedure implements the "transpose" function for spinbox widgets.
+# It tranposes the characters on either side of the insertion cursor,
+# unless the cursor is at the end of the line. In this case it
+# transposes the two characters to the left of the cursor. In either
+# case, the cursor ends up to the right of the transposed characters.
+#
+# Arguments:
+# w - The spinbox window.
+
+proc ::tk::spinbox::Transpose w {
+ set i [$w index insert]
+ if {$i < [$w index end]} {
+ incr i
+ }
+ set first [expr {$i-2}]
+ if {$first < 0} {
+ return
+ }
+ set data [$w get]
+ set new [string index $data [expr {$i-1}]][string index $data $first]
+ $w delete $first $i
+ $w insert insert $new
+ ::tk::spinbox::SeeInsert $w
+}
+
+# ::tk::spinbox::NextWord --
+# Returns the index of the next word position after a given position in the
+# spinbox. The next word is platform dependent and may be either the next
+# end-of-word position or the next start-of-word position after the next
+# end-of-word position.
+#
+# Arguments:
+# w - The spinbox window in which the cursor is to move.
+# start - Position at which to start search.
+
+if {[string equal $tcl_platform(platform) "windows"]} {
+ proc ::tk::spinbox::NextWord {w start} {
+ set pos [tcl_endOfWord [$w get] [$w index $start]]
+ if {$pos >= 0} {
+ set pos [tcl_startOfNextWord [$w get] $pos]
+ }
+ if {$pos < 0} {
+ return end
+ }
+ return $pos
+ }
+} else {
+ proc ::tk::spinbox::NextWord {w start} {
+ set pos [tcl_endOfWord [$w get] [$w index $start]]
+ if {$pos < 0} {
+ return end
+ }
+ return $pos
+ }
+}
+
+# ::tk::spinbox::PreviousWord --
+#
+# Returns the index of the previous word position before a given
+# position in the spinbox.
+#
+# Arguments:
+# w - The spinbox window in which the cursor is to move.
+# start - Position at which to start search.
+
+proc ::tk::spinbox::PreviousWord {w start} {
+ set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
+ if {$pos < 0} {
+ return 0
+ }
+ return $pos
+}
+
+# ::tk::spinbox::GetSelection --
+#
+# Returns the selected text of the spinbox.
+#
+# Arguments:
+# w - The spinbox window from which the text to get
+
+proc ::tk::spinbox::GetSelection {w} {
+ return [string range [$w get] [$w index sel.first] \
+ [expr {[$w index sel.last] - 1}]]
+}
diff --git a/library/tk.tcl b/library/tk.tcl
index cdf52ac..12ac1ba 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,7 +3,7 @@
# Initialization script normally executed in the interpreter for each
# Tk-based application. Arranges class bindings for widgets.
#
-# RCS: @(#) $Id: tk.tcl,v 1.21 2000/05/03 00:18:36 hobbs Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.22 2000/05/29 01:43:15 hobbs Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -313,6 +313,7 @@ if {[string compare $tcl_platform(platform) "macintosh"] && \
source [file join $tk_library menu.tcl]
source [file join $tk_library scale.tcl]
source [file join $tk_library scrlbar.tcl]
+ source [file join $tk_library spinbox.tcl]
source [file join $tk_library text.tcl]
}