view release on metacpan or  search on metacpan

Entry/Entry.pm  view on Meta::CPAN

 my ($class,$mw) = @_;

 $class->SUPER::ClassInit($mw);

 # <<Cut>>, <<Copy>> and <<Paste>> defined in Tk::Clipboard
 $mw->bind($class,'<<Clear>>' => sub {
	       my $w = shift;
	       $w->delete("sel.first", "sel.last");
	   });
 $mw->bind($class,'<<PasteSelection>>' => [sub {
	       my($w, $x) = @_;
	       # XXX logic in Tcl/Tk version screwed up?
	       if (!$Tk::strictMotif && !$Tk::mouseMoved) {
		   $w->Paste($x);
	       }
	   }, Ev('x')]);

 # Standard Motif bindings:
 # The <Escape> binding is different from the Tcl/Tk version:
 $mw->bind($class,'<Escape>','selectionClear');

 $mw->bind($class,'<1>',['Button1',Ev('x'),Ev('y')]);
 $mw->bind($class,'<ButtonRelease-1>',['Button1Release',Ev('x'),Ev('y')]);
 $mw->bind($class,'<B1-Motion>',['Motion',Ev('x'),Ev('y')]);

 $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,'<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');
 if ($mw->windowingsystem =~ /^(?:classic|aqua)$/)
  {
   $mw->bind($class,'<Command-KeyPress>', 'NoOp');
  }

 # 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::platform ne 'MSWin32')
  {
   $mw->bind($class,'<Insert>','InsertSelection');
  }

 if (!$Tk::strictMotif)
  {
   # 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');

   # XXX The original Tcl/Tk bindings use NextWord/PreviousWord instead
   $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']);
   $mw->bind($class,'<Meta-Delete>',['delete',Ev(['wordstart']),'insert']);

   # A few additional bindings from John Ousterhout.
# XXX conflicts with <<Copy>>:  $mw->bind($class,'<Control-w>',['delete',Ev(['wordstart']),'insert']);
   $mw->bind($class,'<2>','Button_2');
   $mw->bind($class,'<B2-Motion>','B2_Motion');
# XXX superseded by <<PasteSelection>>: $mw->bind($class,'<ButtonRelease-2>','ButtonRelease_2');
  }
 return $class;
}


sub Shift_1
{
 my $w = shift;
 my $Ev = $w->XEvent;