# Converted from entry.tcl --
# This file defines the default bindings for Tk entry widgets.
# @(#) entry.tcl 1.22 94/12/17 16:05:14
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved.
# This program is free software; you can redistribute it and/or
$VERSION = '3.037'; # $Id: //depot/Tk8/Entry/Entry.pm#37 $
# modify it under the same terms as Perl itself, subject
# to additional disclaimer in license.terms due to partial
# derivation from Tk4.0 sources.
use base qw(Tk::Clipboard Tk::Widget);
import Tk
qw(Ev $XS_VERSION);
Construct Tk::Widget 'Entry';
sub Tk_cmd { \&Tk::entry }
Tk::Methods('bbox','delete','get','icursor','index','insert','scan',
use Tk::Submethods ( 'selection' => [qw(clear range adjust present to from)],
'xview' => [qw(moveto scroll)],
$pos = $w->index('insert')-1 unless(defined $pos);
$string = substr($string,0,$pos);
my $anc = length $string;
$pos = $w->index('insert') unless(defined $pos);
$string = substr($string,$pos);
$string =~ s/^(?:((?=\s)\s*|(?=\S)\S*))//x;
return $w->index('insert')+$d;
# This procedure is invoked the first time the mouse enters an
# entry widget or an entry widget receives the input focus. It creates
# all of the class bindings for entries.
# event - Indicates which event caused the procedure to be invoked
# (Enter or FocusIn). It is used so that we can carry out
# the functions of that event in addition to setting up
$class->SUPER::ClassInit
($mw);
# Standard Motif bindings:
$mw->bind($class,'<Escape>','selectionClear');
$mw->bind($class,'<1>',['Button1',Ev
('x')]);
$mw->bind($class,'<B1-Motion>',['MouseSelect',Ev
('x')]);
$mw->bind($class,'<Double-1>',['MouseSelect',Ev
('x'),'word','sel.first']);
$mw->bind($class,'<Double-Shift-1>',['MouseSelect',Ev
('x'),'word']);
$mw->bind($class,'<Triple-1>',['MouseSelect',Ev
('x'),'line',0]);
$mw->bind($class,'<Triple-Shift-1>',['MouseSelect',Ev
('x'),'line']);
$mw->bind($class,'<Shift-1>','Shift_1');
$mw->bind($class,'<B1-Leave>',['AutoScan',Ev
('x')]);
$mw->bind($class,'<B1-Enter>','CancelRepeat');
$mw->bind($class,'<ButtonRelease-1>','CancelRepeat');
$mw->bind($class,'<Control-1>','Control_1');
$mw->bind($class,'<Left>', ['SetCursor',Ev
('deltainsert',-1)]);
$mw->bind($class,'<Right>',['SetCursor',Ev
('deltainsert',1)]);
$mw->bind($class,'<Shift-Left>',['KeySelect',Ev
('deltainsert',-1)]);
$mw->bind($class,'<Shift-Right>',['KeySelect',Ev
('deltainsert',1)]);
$mw->bind($class,'<Control-Left>',['SetCursor',Ev
(['wordstart'])]);
$mw->bind($class,'<Control-Right>',['SetCursor',Ev
(['wordend'])]);
$mw->bind($class,'<Shift-Control-Left>',['KeySelect',Ev
(['wordstart'])]);
$mw->bind($class,'<Shift-Control-Right>',['KeySelect',Ev
(['wordend'])]);
$mw->bind($class,'<Home>',['SetCursor',0]);
$mw->bind($class,'<Shift-Home>',['KeySelect',0]);
$mw->bind($class,'<End>',['SetCursor','end']);
$mw->bind($class,'<Shift-End>',['KeySelect','end']);
$mw->bind($class,'<Delete>','Delete');
$mw->bind($class,'<BackSpace>','Backspace');
$mw->bind($class,'<Control-space>',['selectionFrom','insert']);
$mw->bind($class,'<Select>',['selectionFrom','insert']);
$mw->bind($class,'<Control-Shift-space>',['selectionAdjust','insert']);
$mw->bind($class,'<Shift-Select>',['selectionAdjust','insert']);
$mw->bind($class,'<Control-slash>',['selectionRange',0,'end']);
$mw->bind($class,'<Control-backslash>','selectionClear');
# $class->clipboardOperations($mw,qw[Copy Cut Paste]);
$mw->bind($class,'<KeyPress>', ['Insert',Ev
('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 Return, and Tab.
$mw->bind($class,'<Alt-KeyPress>' ,'NoOp');
$mw->bind($class,'<Meta-KeyPress>' ,'NoOp');
$mw->bind($class,'<Control-KeyPress>' ,'NoOp');
$mw->bind($class,'<Return>' ,'NoOp');
$mw->bind($class,'<KP_Enter>' ,'NoOp');
$mw->bind($class,'<Tab>' ,'NoOp');
$mw->bind($class,'<Insert>','InsertSelection');
# Additional emacs-like bindings:
$mw->bind($class,'<Control-a>',['SetCursor',0]);
$mw->bind($class,'<Control-b>',['SetCursor',Ev
('deltainsert',-1)]);
$mw->bind($class,'<Control-d>',['delete','insert']);
$mw->bind($class,'<Control-e>',['SetCursor','end']);
$mw->bind($class,'<Control-f>',['SetCursor',Ev
('deltainsert',1)]);
$mw->bind($class,'<Control-h>','Backspace');
$mw->bind($class,'<Control-k>',['delete','insert','end']);
$mw->bind($class,'<Control-t>','Transpose');
$mw->bind($class,'<Meta-b>',['SetCursor',Ev
(['wordstart'])]);
$mw->bind($class,'<Meta-d>',['delete','insert',Ev
(['wordend'])]);
$mw->bind($class,'<Meta-f>',['SetCursor',Ev
(['wordend'])]);
$mw->bind($class,'<Meta-BackSpace>',['delete',Ev
(['wordstart']),'insert']);
# A few additional bindings from John Ousterhout.
$mw->bind($class,'<Control-w>',['delete',Ev
(['wordstart']),'insert']);
$mw->bind($class,'<2>','Button_2');
$mw->bind($class,'<B2-Motion>','B2_Motion');
$mw->bind($class,'<ButtonRelease-2>','ButtonRelease_2');
$Tk::selectMode
= 'char';
$w->selectionAdjust('@' . $Ev->x)
$w->icursor('@' . $Ev->x)
if ($w->selectionPresent)
eval {local $SIG{__DIE__
}; $w->Insert($w->SelectionGet)}
if (abs(($Ev->x-$Tk::x
)) > 2)
$w->scan('dragto',$Ev->x)
$w->insert('insert',$w->SelectionGet);
# 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.
$Tk::selectMode
= 'char';
$w->selectionFrom('@' . $x);
if ($w->cget('-state') eq 'normal')
# 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.
$Tk::selectMode
= shift if (@_);
my $cur = $w->index('@' . $x);
return unless defined $cur;
my $anchor = $w->index('anchor');
return unless defined $anchor;
if (($cur != $anchor) || (abs($Tk::pressX
- $x) >= 3))
my $mode = $Tk::selectMode
;
if ($cur < $w->index('anchor'))
$w->selectionRange($w->wordstart($cur),$w->wordend($anchor-1))
$w->selectionRange($w->wordstart($anchor),$w->wordend($cur))
$w->selectionRange(0,'end')
eval {local $SIG{__DIE__
}; $w->icursor($ipos) };
# 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.
# x - The x-coordinate of the mouse when it left the window.
$w->xview('scroll',2,'units')
$w->xview('scroll',-2,'units')
$w->RepeatId($w->after(50,['AutoScan',$w,$x]))
# 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).
if (!$w->selectionPresent)
$w->selectionFrom('insert');
$w->selectionAdjust($new)
# 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)
return unless (defined $s && $s ne '');
my $insert = $w->index('insert');
if ($w->index('sel.first') <= $insert && $w->index('sel.last') >= $insert)
# Backspace over the character just before the insertion cursor.
# w - The entry window in which to backspace.
if ($w->selectionPresent)
my $x = $w->index('insert')-1;
$w->delete($x) if ($x >= 0);
# Make sure that the insertion cursor is visible in the entry window.
# If not, adjust the view so that it is.
my $c = $w->index('insert');
# Probably a bug in your version of tcl/tk (I've not this problem
# when I test Entry in the widget demo for tcl/tk)
# index('\@0') give always 0. Consequence :
# if you make <Control-E> or <Control-F> view is adapted
# but with <Control-A> or <Control-B> view is not adapted
my $left = $w->index('@0');
while ($w->index('@' . $x) <= $c && $left < $c)
# 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.
# 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.
my $i = $w->index('insert');
$i++ if ($i < $w->index('end'));
my $new = substr($str,$i-1,1) . substr($str,$first,1);
$w->insert('insert',$new);
$w->selectionRange(0,'end');
return undef unless $w->selectionPresent;
my $show = $w->cget('-show');
$str = $show x
length($str) if (defined $show);
my $s = $w->index('sel.first');
my $e = $w->index('sel.last');
return substr($str,$s,$e+1-$s);