# entry.tcl --
#
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
# @(#) $Id: ctk.shar,v 1.50 1996/01/15 14:47:16 andrewm Exp andrewm $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1995 Cleveland Clinic Foundation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------
# Standard Motif bindings:
bind Entry <Left> {
tkEntrySetCursor %W [expr [%W index insert] - 1]
}
bind Entry <Right> {
tkEntrySetCursor %W [expr [%W index insert] + 1]
}
bind Entry <Home> {
tkEntrySetCursor %W 0
}
bind Entry <End> {
tkEntrySetCursor %W end
}
bind Entry <Delete> {
if [%W selection present] {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
bind Entry <BackSpace> {
tkEntryBackspace %W
}
bind Entry <Select> {
%W selection from insert
}
bind Entry <Return> {
focus [tk_focusNext %W]
}
bind Entry <KeyPress> {
if [tkEntryInsert %W %A] break
}
# 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, and Tab.
bind Entry <Alt-KeyPress> {# nothing}
bind Entry <Meta-KeyPress> {# nothing}
bind Entry <Control-KeyPress> {# nothing}
bind Entry <Escape> {# nothing}
bind Entry <KP_Enter> {# nothing}
bind Entry <Tab> {# nothing}
bind Entry <Insert> {
catch {tkEntryInsert %W [selection get -displayof %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)
#
# Results:
# Returns 1 if text is inserted, 0 otherwise.
#proc tkEntryInsert {w s} { -- implemented in C -- }
# 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 { -- implemented in 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
}