Прога / tina-2.5.2 / tcl / lib / tk8.3 / entry

# entry.tcl --
#
# 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.11.2.1 2001/04/04 07:57:17 hobbs 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 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
#-------------------------------------------------------------------------

#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------
bind Entry <<Cut>> {
if {![catch {tkEntryGetSelection %W} tkPriv(data)]} {
clipboard clear -displayof %W
clipboard append -displayof %W $tkPriv(data)
%W delete sel.first sel.last
unset tkPriv(data)
}
}
bind Entry <<Copy>> {
if {![catch {tkEntryGetSelection %W} tkPriv(data)]} {
clipboard clear -displayof %W
clipboard append -displayof %W $tkPriv(data)
unset tkPriv(data)
}
}
bind Entry <<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]
tkEntrySeeInsert %W
}
}
bind Entry <<Clear>> {
%W delete sel.first sel.last
}
bind Entry <<PasteSelection>> {
if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
tkEntryPaste %W %x
}
}

# Standard Motif bindings:

bind Entry <1> {
tkEntryButton1 %W %x
%W selection clear
}
bind Entry <B1-Motion> {
set tkPriv(x) %x
tkEntryMouseSelect %W %x
}
bind Entry <Double-1> {
set tkPriv(selectMode) word
tkEntryMouseSelect %W %x
catch {%W icursor sel.first}
}
bind Entry <Triple-1> {
set tkPriv(selectMode) line
tkEntryMouseSelect %W %x
%W icursor 0
}
bind Entry <Shift-1> {
set tkPriv(selectMode) char
%W selection adjust @%x
}
bind Entry <Double-Shift-1> {
set tkPriv(selectMode) word
tkEntryMouseSelect %W %x
}
bind Entry <Triple-Shift-1> {
set tkPriv(selectMode) line
tkEntryMouseSelect %W %x
}
bind Entry <B1-Leave> {
set tkPriv(x) %x
tkEntryAutoScan %W
}
bind Entry <B1-Enter> {
tkCancelRepeat
}
bind Entry <ButtonRelease-1> {
tkCancelRepeat
}
bind Entry <Control-1> {
%W icursor @%x
}

bind Entry <Left> {
tkEntrySetCursor %W [expr {[%W index insert] - 1}]
}
bind Entry <Right> {
tkEntrySetCursor %W [expr {[%W index insert] + 1}]
}
bind Entry <Shift-Left> {
tkEntryKeySelect %W [expr {[%W index insert] - 1}]
tkEntrySeeInsert %W
}
bind Entry <Shift-Right> {
tkEntryKeySelect %W [expr {[%W index insert] + 1}]
tkEntrySeeInsert %W
}
bind Entry <Control-Left> {
tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
}
bind Entry <Control-Right> {
tkEntrySetCursor %W [tkEntryNextWord %W insert]
}
bind Entry <Shift-Control-Left> {
tkEntryKeySelect %W [tkEntryPreviousWord %W insert]
tkEntrySeeInsert %W
}
bind Entry <Shift-Control-Right> {
tkEntryKeySelect %W [tkEntryNextWord %W insert]
tkEntrySeeInsert %W
}
bind Entry <Home> {
tkEntrySetCursor %W 0
}
bind Entry <Shift-Home> {
tkEntryKeySelect %W 0
tkEntrySeeInsert %W
}
bind Entry <End> {
tkEntrySetCursor %W end
}
bind Entry <Shift-End> {
tkEntryKeySelect %W end
tkEntrySeeInsert %W
}

bind Entry <Delete> {
if {[%W selection present]} {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
bind Entry <BackSpace> {
tkEntryBackspace %W
}

bind Entry <Control-space> {
%W selection from insert
}
bind Entry <Select> {
%W selection from insert
}
bind Entry <Control-Shift-space> {
%W selection adjust insert
}
bind Entry <Shift-Select> {
%W selection adjust insert
}
bind Entry <Control-slash> {
%W selection range 0 end
}
bind Entry <Control-backslash> {
%W selection clear
}
bind Entry <KeyPress> {
tkEntryInsert %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 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 $tcl_platform(platform) "macintosh"]} {
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"]} {
bind Entry <Insert> {
catch {tkEntryInsert %W [selection get -displayof %W]}
}
}

# Additional emacs-like bindings:

bind Entry <Control-a> {
if {!$tk_strictMotif} {
tkEntrySetCursor %W 0
}
}
bind Entry <Control-b> {
if {!$tk_strictMotif} {
tkEntrySetCursor %W [expr {[%W index insert] - 1}]
}
}
bind Entry <Control-d> {
if {!$tk_strictMotif} {
%W delete insert
}
}
bind Entry <Control-e> {
if {!$tk_strictMotif} {
tkEntrySetCursor %W end
}
}
bind Entry <Control-f> {
if {!$tk_strictMotif} {
tkEntrySetCursor %W [expr {[%W index insert] + 1}]
}
}
bind Entry <Control-h> {
if {!$tk_strictMotif} {
tkEntryBackspace %W
}
}
bind Entry <Control-k> {
if {!$tk_strictMotif} {
%W delete insert end
}
}
bind Entry <Control-t> {
if {!$tk_strictMotif} {
tkEntryTranspose %W
}
}
bind Entry <Meta-b> {
if {!$tk_strictMotif} {
tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
}
}
bind Entry <Meta-d> {
if {!$tk_strictMotif} {
%W delete insert [tkEntryNextWord %W insert]
}
}
bind Entry <Meta-f> {
if {!$tk_strictMotif} {
tkEntrySetCursor %W [tkEntryNextWord %W insert]
}
}
bind Entry <Meta-BackSpace> {
if {!$tk_strictMotif} {
%W delete [tkEntryPreviousWord %W insert] insert
}
}
bind Entry <Meta-Delete> {
if {!$tk_strictMotif} {
%W delete [tkEntryPreviousWord %W insert] insert
}
}

# A few additional bindings of my own.

bind Entry <2> {
if {!$tk_strictMotif} {
%W scan mark %x
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(mouseMoved) 0
}
}
bind Entry <B2-Motion> {
if {!$tk_strictMotif} {
if {abs(%x-$tkPriv(x)) > 2} {
set tkPriv(mouseMoved) 1
}
%W scan dragto %x
}
}

# tkEntryClosestGap --
# 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 entry window.
# x - X-coordinate within the window.

proc tkEntryClosestGap {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
}

# tkEntryButton1 --
# 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.
#
# Arguments:
# w - The entry window in which the button was pressed.
# x - The x-coordinate of the button press.

proc tkEntryButton1 {w x} {
global tkPriv

set tkPriv(selectMode) char
set tkPriv(mouseMoved) 0
set tkPriv(pressX) $x
$w icursor [tkEntryClosestGap $w $x]
$w selection from insert
if {[string compare "disabled" [$w cget -state]]} {focus $w}
}

# tkEntryMouseSelect --
# 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 entry window in which the button was pressed.
# x - The x-coordinate of the mouse.

proc tkEntryMouseSelect {w x} {
global tkPriv

set cur [tkEntryClosestGap $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 {$tkPriv(mouseMoved)} {
$w icursor $cur
}
update idletasks
}

# tkEntryPaste --
# 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 entry window.
# x - X position of the mouse.

proc tkEntryPaste {w x} {
global tkPriv

$w icursor [tkEntryClosestGap $w $x]
catch {$w insert insert [selection get -displayof $w]}
if {[string compare "disabled" [$w cget -state]]} {focus $w}
}

# tkEntryAutoScan --
# 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.
#
# Arguments:
# w - The entry window.

proc tkEntryAutoScan {w} {
global tkPriv
set x $tkPriv(x)
if {![winfo exists $w]} return
if {$x >= [winfo width $w]} {
$w xview scroll 2 units
tkEntryMouseSelect $w $x
} elseif {$x < 0} {
$w xview scroll -2 units
tkEntryMouseSelect $w $x
}
set tkPriv(afterId) [after 50 [list tkEntryAutoScan $w]]
}

# tkEntryKeySelect --
# 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 entry window.
# new - A new position for the insertion cursor (the cursor hasn't
# actually been moved to this position yet).

proc tkEntryKeySelect {w new} {
if {![$w selection present]} {
$w selection from insert
$w selection to $new
} else {
$w selection adjust $new
}
$w icursor $new
}

# tkEntryInsert --
# 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.
#
# Arguments:
# w - The entry window in which to insert the string
# s - The string to insert (usually just a single character)

proc tkEntryInsert {w s} {
if {[string equal $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
tkEntrySeeInsert $w
}

# tkEntryBackspace --
# 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 entry window in which to backspace.

proc tkEntryBackspace 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}]
}
}
}

# tkEntrySeeInsert --
# Make sure that the insertion cursor is visible in the entry window.
# If not, adjust the view so that it is.
#
# Arguments:
# w - The entry window.

proc tkEntrySeeInsert w {
set c [$w index insert]
if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
$w xview $c
}
}

# tkEntrySetCursor -
# 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.
#
# Arguments:
# w - The entry window.
# pos - The desired new position for the cursor in the window.

proc tkEntrySetCursor {w pos} {
$w icursor $pos
$w selection clear
tkEntrySeeInsert $w
}

# tkEntryTranspose -
# 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.
#
# Arguments:
# w - The entry window.

proc tkEntryTranspose w {
set i [$w index insert]
if {$i < [$w index end]} {
incr i
}
set first [expr {$i-2}]
if {$first < 0} {
return
}
set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first]
$w delete $first $i
$w insert insert $new
tkEntrySeeInsert $w
}

# tkEntryNextWord --
# 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
# end-of-word position.
#
# Arguments:
# 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 tkEntryNextWord {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 tkEntryNextWord {w start} {
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos < 0} {
return end
}
return $pos
}
}

# tkEntryPreviousWord --
#
# Returns the index of the previous word position before a given
# position in the entry.
#
# Arguments:
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.

proc tkEntryPreviousWord {w start} {
set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
if {$pos < 0} {
return 0
}
return $pos
}
# tkEntryGetSelection --
#
# Returns the selected text of the entry with respect to the -show option.
#
# Arguments:
# w - The entry window from which the text to get

proc tkEntryGetSelection {w} {
set entryString [string range [$w get] [$w index sel.first] \
[expr {[$w index sel.last] - 1}]]
if {[string compare [$w cget -show] ""]} {
regsub -all . $entryString [string index [$w cget -show] 0] entryString
}
return $entryString
}