# 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.21 2003/01/23 23:30:11 drh Exp $
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# 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:
# x, y - Last known mouse coordinates for scanning
# data - Used for Cut and Copy
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------
if {![catch {tk::EntryGetSelection %W
} tk::Priv(data
)]} {
clipboard clear
-displayof %W
clipboard append -displayof %W
$tk::Priv(data
)
%W delete sel.first sel.last
if {![catch {tk::EntryGetSelection %W
} tk::Priv(data
)]} {
clipboard clear
-displayof %W
clipboard append -displayof %W
$tk::Priv(data
)
if {[string compare
[tk windowingsystem
] "x11"]} {
%W delete sel.first sel.last
%W insert insert
[::tk::GetSelection %W CLIPBOARD
]
%W delete sel.first sel.last
bind Entry
<<PasteSelection
>> {
if {$tk_strictMotif ||
![info exists
tk::Priv(mouseMoved
)]
||
!$tk::Priv(mouseMoved
)} {
# Standard Motif bindings:
tk::EntryMouseSelect %W
%x
set tk::Priv(selectMode
) word
tk::EntryMouseSelect %W
%x
catch {%W icursor sel.last
}
set tk::Priv(selectMode
) line
tk::EntryMouseSelect %W
%x
catch {%W icursor sel.last
}
set tk::Priv(selectMode
) char
bind Entry
<Double-Shift-1
> {
set tk::Priv(selectMode
) word
tk::EntryMouseSelect %W
%x
bind Entry
<Triple-Shift-1
> {
set tk::Priv(selectMode
) line
tk::EntryMouseSelect %W
%x
bind Entry
<ButtonRelease-1
> {
tk::EntrySetCursor %W
[expr {[%W index insert
] - 1}]
tk::EntrySetCursor %W
[expr {[%W index insert
] + 1}]
bind Entry
<Shift-Left
> {
tk::EntryKeySelect %W
[expr {[%W index insert
] - 1}]
bind Entry
<Shift-Right
> {
tk::EntryKeySelect %W
[expr {[%W index insert
] + 1}]
bind Entry
<Control-Left
> {
tk::EntrySetCursor %W
[tk::EntryPreviousWord %W insert
]
bind Entry
<Control-Right
> {
tk::EntrySetCursor %W
[tk::EntryNextWord %W insert
]
bind Entry
<Shift-Control-Left
> {
tk::EntryKeySelect %W
[tk::EntryPreviousWord %W insert
]
bind Entry
<Shift-Control-Right
> {
tk::EntryKeySelect %W
[tk::EntryNextWord %W insert
]
bind Entry
<Shift-Home
> {
tk::EntrySetCursor %W end
tk::EntryKeySelect %W end
if {[%W
selection present
]} {
%W delete sel.first sel.last
bind Entry
<Control-space
> {
bind Entry
<Control-Shift-space
> {
%W
selection adjust insert
bind Entry
<Shift-Select
> {
%W
selection adjust insert
bind Entry
<Control-slash
> {
bind Entry
<Control-backslash
> {
# 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 Entry
<Alt-KeyPress
> {# nothing}
bind Entry
<Meta-KeyPress
> {# nothing}
bind Entry
<Control-KeyPress
> {# nothing}
bind Entry
<Escape
> {# nothing}
bind Entry
<Return
> {# nothing}
bind Entry
<KP_Enter
> {# nothing}
bind Entry
<Tab
> {# nothing}
if {[string equal
[tk windowingsystem
] "classic"]
||
[string equal
[tk windowingsystem
] "aqua"]} {
bind Entry
<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"]} {
catch {tk::EntryInsert %W
[::tk::GetSelection %W PRIMARY
]}
# Additional emacs-like bindings:
tk::EntrySetCursor %W
[expr {[%W index insert
] - 1}]
tk::EntrySetCursor %W end
tk::EntrySetCursor %W
[expr {[%W index insert
] + 1}]
tk::EntrySetCursor %W
[tk::EntryPreviousWord %W insert
]
%W delete insert
[tk::EntryNextWord %W insert
]
tk::EntrySetCursor %W
[tk::EntryNextWord %W insert
]
bind Entry
<Meta-BackSpace
> {
%W delete
[tk::EntryPreviousWord %W insert
] insert
bind Entry
<Meta-Delete
> {
%W delete
[tk::EntryPreviousWord %W insert
] insert
# A few additional bindings of my own.
::tk::EntryScanMark %W
%x
::tk::EntryScanDrag %W
%x
# ::tk::EntryClosestGap --
# 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.
# x - X-coordinate within the window.
proc ::tk::EntryClosestGap {w x
} {
if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
# This procedure is invoked to handle button-1 presses in entry
# widgets. It moves the insertion cursor, sets the selection anchor,
# and claims the input focus.
# w - The entry window in which the button was pressed.
# x - The x-coordinate of the button press.
proc ::tk::EntryButton1 {w x
} {
set Priv
(selectMode
) char
$w icursor
[EntryClosestGap
$w $x]
if {[string compare
"disabled" [$w cget
-state]]} {focus $w}
# ::tk::EntryMouseSelect --
# 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.
# w - The entry window in which the button was pressed.
# x - The x-coordinate of the mouse.
proc ::tk::EntryMouseSelect {w x
} {
set cur
[EntryClosestGap
$w $x]
set anchor
[$w index anchor
]
if {($cur != $anchor) ||
(abs
($Priv(pressX
) - $x) >= 3)} {
switch $Priv(selectMode
) {
$w selection range
$cur $anchor
} elseif
{$cur > $anchor} {
$w selection range
$anchor $cur
if {$cur < [$w index anchor
]} {
set before
[tcl_wordBreakBefore [$w get
] $cur]
set after [tcl_wordBreakAfter [$w get
] [expr {$anchor-1}]]
set before
[tcl_wordBreakBefore [$w get
] $anchor]
set after [tcl_wordBreakAfter [$w get
] [expr {$cur - 1}]]
$w selection range
$before $after
# This procedure sets the insertion cursor to the current mouse position,
# pastes the selection there, and sets the focus to the window.
# x - X position of the mouse.
proc ::tk::EntryPaste {w x
} {
$w icursor
[EntryClosestGap
$w $x]
catch {$w insert insert
[::tk::GetSelection $w PRIMARY
]}
if {[string compare
"disabled" [$w cget
-state]]} {focus $w}
# This procedure is invoked when the mouse leaves an entry 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.
proc ::tk::EntryAutoScan {w
} {
if {![winfo exists
$w]} return
if {$x >= [winfo width
$w]} {
set Priv
(afterId
) [after 50 [list tk::EntryAutoScan $w]]
# ::tk::EntryKeySelect --
# 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.
# new - A new position for the insertion cursor (the cursor hasn't
# actually been moved to this position yet).
proc ::tk::EntryKeySelect {w new
} {
if {![$w selection present
]} {
# Insert a string into an entry at the point of the insertion cursor.
# If there is a selection in the entry, and it covers the point of the
# insertion cursor, then delete the selection before inserting.
# w - The entry window in which to insert the string
# s - The string to insert (usually just a single character)
proc ::tk::EntryInsert {w s
} {
if {[string equal
$s ""]} {
set insert
[$w index insert
]
if {([$w index sel.first
] <= $insert)
&& ([$w index sel.last
] >= $insert)} {
$w delete sel.first sel.last
# ::tk::EntryBackspace --
# 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.
# w - The entry window in which to backspace.
proc ::tk::EntryBackspace w
{
if {[$w selection present
]} {
$w delete sel.first sel.last
set x
[expr {[$w index insert
] - 1}]
if {$x >= 0} {$w delete
$x}
if {[$w index
@0] >= [$w index insert
]} {
set left
[lindex $range 0]
set right
[lindex $range 1]
$w xview moveto
[expr {$left - ($right - $left)/2.0}]
# ::tk::EntrySeeInsert --
# Make sure that the insertion cursor is visible in the entry window.
# If not, adjust the view so that it is.
proc ::tk::EntrySeeInsert w
{
if {($c < [$w index
@0]) ||
($c > [$w index
@[winfo width
$w]])} {
# Move the insertion cursor to a given position in an entry. Also
# clears the selection, if there is one in the entry, and makes sure
# that the insertion cursor is visible.
# pos - The desired new position for the cursor in the window.
proc ::tk::EntrySetCursor {w pos
} {
# This procedure implements the "transpose" function for entry 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.
proc ::tk::EntryTranspose w
{
if {$i < [$w index end
]} {
set new
[string index
$data [expr {$i-1}]][string index
$data $first]
# Returns the index of the next word position after a given position in the
# entry. 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
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.
if {[string equal
$tcl_platform(platform
) "windows"]} {
proc ::tk::EntryNextWord {w start
} {
set pos
[tcl_endOfWord [$w get
] [$w index
$start]]
set pos
[tcl_startOfNextWord [$w get
] $pos]
proc ::tk::EntryNextWord {w start
} {
set pos
[tcl_endOfWord [$w get
] [$w index
$start]]
# ::tk::EntryPreviousWord --
# Returns the index of the previous word position before a given
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.
proc ::tk::EntryPreviousWord {w start
} {
set pos
[tcl_startOfPreviousWord [$w get
] [$w index
$start]]
# Marks the start of a possible scan drag operation
# w - The entry window from which the text to get
# x - x location on screen
proc ::tk::EntryScanMark {w x
} {
set ::tk::Priv(y
) 0 ; # not used
set ::tk::Priv(mouseMoved
) 0
# Marks the start of a possible scan drag operation
# w - The entry window from which the text to get
# x - x location on screen
proc ::tk::EntryScanDrag {w x
} {
# Make sure these exist, as some weird situations can trigger the
# motion binding without the initial press. [Bug #220269]
if {![info exists
::tk::Priv(x
)]} { set ::tk::Priv(x
) $x }
if {abs
($x-$::tk::Priv(x
)) > 2} {
set ::tk::Priv(mouseMoved
) 1
# ::tk::EntryGetSelection --
# Returns the selected text of the entry with respect to the -show option.
# w - The entry window from which the text to get
proc ::tk::EntryGetSelection {w
} {
set entryString
[string range
[$w get
] [$w index sel.first
] \
[expr {[$w index sel.last
] - 1}]]
if {[string compare
[$w cget
-show] ""]} {
return [string repeat
[string index
[$w cget
-show] 0] \
[string length
$entryString]]