+++ /dev/null
-# 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.
-#
-# 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>> {
- 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
- }
-}
-
-bind Spinbox <<TraverseIn>> {
- %W selection range 0 end
- %W icursor end
-}
-
-# 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> {
- ::tk::spinbox::ArrowPress %W %x %y
- set tk::Priv(selectMode) word
- ::tk::spinbox::MouseSelect %W %x sel.first
-}
-bind Spinbox <Triple-1> {
- ::tk::spinbox::ArrowPress %W %x %y
- 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 <<PrevLine>> {
- %W invoke buttonup
-}
-bind Spinbox <<NextLine>> {
- %W invoke buttondown
-}
-
-bind Spinbox <<PrevChar>> {
- ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
-}
-bind Spinbox <<NextChar>> {
- ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
-}
-bind Spinbox <<SelectPrevChar>> {
- ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
- ::tk::EntrySeeInsert %W
-}
-bind Spinbox <<SelectNextChar>> {
- ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
- ::tk::EntrySeeInsert %W
-}
-bind Spinbox <<PrevWord>> {
- ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
-}
-bind Spinbox <<NextWord>> {
- ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
-}
-bind Spinbox <<SelectPrevWord>> {
- ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert]
- ::tk::EntrySeeInsert %W
-}
-bind Spinbox <<SelectNextWord>> {
- ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert]
- ::tk::EntrySeeInsert %W
-}
-bind Spinbox <<LineStart>> {
- ::tk::EntrySetCursor %W 0
-}
-bind Spinbox <<SelectLineStart>> {
- ::tk::EntryKeySelect %W 0
- ::tk::EntrySeeInsert %W
-}
-bind Spinbox <<LineEnd>> {
- ::tk::EntrySetCursor %W end
-}
-bind Spinbox <<SelectLineEnd>> {
- ::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 <<SelectAll>> {
- %W selection range 0 end
-}
-bind Spinbox <<SelectNone>> {
- %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}
-bind Spinbox <Prior> {# nothing}
-bind Spinbox <Next> {# nothing}
-if {[tk windowingsystem] eq "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 {[tk windowingsystem] ne "win32"} {
- bind Spinbox <Insert> {
- catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
- }
-}
-
-# Additional emacs-like bindings:
-
-bind Spinbox <Control-d> {
- if {!$tk_strictMotif} {
- %W delete insert
- }
-}
-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 {![winfo exists $w]} {
- return
- }
-
- 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::ArrowPress --
-# This procedure is invoked to handle button-1 presses in buttonup
-# or buttondown elements of spinbox widgets.
-#
-# Arguments:
-# w - The spinbox window in which the button was pressed.
-# x - The x-coordinate of the button press.
-# y - The y-coordinate of the button press.
-
-proc ::tk::spinbox::ArrowPress {w x y} {
- variable ::tk::Priv
-
- if {[$w cget -state] ne "disabled" && \
- [string match "button*" $Priv(element)]} {
- $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)
- }
- }
-}
-
-# ::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.
-# y - The y-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" {
- ::tk::spinbox::ArrowPress $w $x $y
- }
- "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 -errorcode {TK SPINBOX UNKNOWN_ELEMENT} \
- "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.
-# y - The y-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 {"disabled" eq [$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.
-# x - The x-coordinate of the mouse.
-# y - The y-coordinate of the mouse.
-
-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)
- $w selection element $Priv(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} {
- variable ::tk::Priv
-
- set x $Priv(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 Priv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]]
-}
-
-# ::tk::spinbox::GetSelection --
-#
-# Returns the selected text of the spinbox. Differs from entry in that
-# a spinbox has no -show option to obscure contents.
-#
-# 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}]]
-}
OSDN Git Service
