home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / Entry / ClassInit.al < prev    next >
Encoding:
Text File  |  1997-08-10  |  9.3 KB  |  317 lines
  1. # NOTE: Derived from ..\blib\lib\Tk\Entry.pm.  Changes made here will be lost.
  2. package Tk::Entry;
  3.  
  4. #
  5. # Bind --
  6. # This procedure is invoked the first time the mouse enters an
  7. # entry widget or an entry widget receives the input focus. It creates
  8. # all of the class bindings for entries.
  9. #
  10. # Arguments:
  11. # event - Indicates which event caused the procedure to be invoked
  12. # (Enter or FocusIn). It is used so that we can carry out
  13. # the functions of that event in addition to setting up
  14. # bindings.
  15. sub ClassInit
  16. {
  17.  my ($class,$mw) = @_;
  18.  # Standard Motif bindings:
  19.  $mw->bind($class,"<1>",
  20.              sub
  21.              {
  22.               my $w = shift;
  23.               my $Ev = $w->XEvent;
  24.               $w->Button1($Ev->x);
  25.               $w->SelectionClear;
  26.              });
  27.  
  28.  $mw->bind($class,"<B1-Motion>",['MouseSelect',Ev("x")]);
  29.  
  30.  $mw->bind($class,"<Double-1>",
  31.              sub
  32.              {
  33.               my $w = shift;
  34.               my $Ev = $w->XEvent;
  35.               $Tk::selectMode = "word";
  36.               $w->MouseSelect($Ev->x);
  37.               eval {local $SIG{__DIE__}; $w->icursor("sel.first") }
  38.              } ) ;
  39.  $mw->bind($class,"<Triple-1>",
  40.              sub
  41.              {
  42.               my $w = shift;
  43.               my $Ev = $w->XEvent;
  44.               $Tk::selectMode = "line";
  45.               $w->MouseSelect($Ev->x);
  46.               $w->icursor(0)
  47.              } ) ;
  48.  $mw->bind($class,"<Shift-1>",
  49.              sub
  50.              {
  51.               my $w = shift;
  52.               my $Ev = $w->XEvent;
  53.               $Tk::selectMode = "char";
  54.               $w->selection("adjust","@" . $Ev->x)
  55.              } ) ;
  56.  $mw->bind($class,"<Double-Shift-1>",
  57.              sub
  58.              {
  59.               my $w = shift;
  60.               my $Ev = $w->XEvent;
  61.               $Tk::selectMode = "word";
  62.               $w->MouseSelect($Ev->x)
  63.              } ) ;
  64.  $mw->bind($class,"<Triple-Shift-1>",
  65.              sub
  66.              {
  67.               my $w = shift;
  68.               my $Ev = $w->XEvent;
  69.               $Tk::selectMode = "line";
  70.               $w->MouseSelect($Ev->x)
  71.              } ) ;
  72.  $mw->bind($class,"<B1-Leave>",['AutoScan',Ev("x")]);
  73.  $mw->bind($class,"<B1-Enter>",'CancelRepeat');
  74.  $mw->bind($class,"<ButtonRelease-1>",'CancelRepeat');
  75.  $mw->bind($class,"<Control-1>",
  76.              sub
  77.              {
  78.               my $w = shift;
  79.               my $Ev = $w->XEvent;
  80.               $w->icursor("@" . $Ev->x)
  81.              } ) ;
  82.  $mw->bind($class,"<Left>",
  83.              sub
  84.              {
  85.               my $w = shift;
  86.               $w->SetCursor($w->index("insert")-1)
  87.              } ) ;
  88.  $mw->bind($class,"<Right>",
  89.              sub
  90.              {
  91.               my $w = shift;
  92.               $w->SetCursor($w->index("insert")+1)
  93.              } ) ;
  94.  $mw->bind($class,"<Shift-Left>",
  95.              sub
  96.              {
  97.               my $w = shift;
  98.               $w->KeySelect($w->index("insert")-1);
  99.              } ) ;
  100.  $mw->bind($class,"<Shift-Right>",
  101.              sub
  102.              {
  103.               my $w = shift;
  104.               $w->KeySelect($w->index("insert")+1);
  105.              } ) ;
  106.  $mw->bind($class,"<Control-Left>",
  107.              sub
  108.              {
  109.               my $w = shift;
  110.               $w->SetCursor($w->wordstart)
  111.              } ) ;
  112.  $mw->bind($class,"<Control-Right>",
  113.              sub
  114.              {
  115.               my $w = shift;
  116.               $w->SetCursor($w->wordend)
  117.              } ) ;
  118.  $mw->bind($class,"<Shift-Control-Left>",
  119.              sub
  120.              {
  121.               my $w = shift;
  122.               my $Ev = $w->XEvent;
  123.               $w->KeySelect($w->wordstart) ;
  124.              } ) ;
  125.  $mw->bind($class,"<Shift-Control-Right>",
  126.              sub
  127.              {
  128.               my $w = shift;
  129.               $w->KeySelect($w->wordend) ;
  130.              } ) ;
  131.  $mw->bind($class,"<Home>",['SetCursor',0]);
  132.  $mw->bind($class,"<Shift-Home>",
  133.              sub
  134.              {
  135.               my $w = shift;
  136.               $w->KeySelect(0);
  137.              } ) ;
  138.  $mw->bind($class,"<End>",['SetCursor',"end"]);
  139.  $mw->bind($class,"<Shift-End>",
  140.              sub
  141.              {
  142.               my $w = shift;
  143.               $w->KeySelect("end");
  144.              } ) ;
  145.  $mw->bind($class,"<Delete>",
  146.              sub
  147.              {
  148.               my $w = shift;
  149.               if ($w->selection("present"))
  150.                {
  151.                 $w->deleteSelected
  152.                }
  153.               else
  154.                {
  155.                 $w->delete("insert")
  156.                }
  157.              } ) ;
  158.  
  159.  $mw->bind($class,"<BackSpace>","Backspace");
  160.  
  161.  $mw->bind($class,"<Control-space>",
  162.              sub
  163.              {
  164.               my $w = shift;
  165.               $w->selection("from","insert")
  166.              } ) ;
  167.  $mw->bind($class,"<Select>",
  168.              sub
  169.              {
  170.               my $w = shift;
  171.               $w->selection("from","insert")
  172.              } ) ;
  173.  $mw->bind($class,"<Control-Shift-space>",
  174.              sub
  175.              {
  176.               my $w = shift;
  177.               $w->selection("adjust","insert")
  178.              } ) ;
  179.  $mw->bind($class,"<Shift-Select>",
  180.              sub
  181.              {
  182.               my $w = shift;
  183.               $w->selection("adjust","insert")
  184.              } ) ;
  185.  $mw->bind($class,"<Control-slash>",
  186.              sub
  187.              {
  188.               my $w = shift;
  189.               $w->selection("range",0,"end")
  190.              } ) ;
  191.  $mw->bind($class,"<Control-backslash>",'SelectionClear');
  192.  
  193.  $class->clipboardKeysyms($mw,"F16","F20","F18");
  194.  
  195.  $mw->bind($class,"<KeyPress>", ['Insert',Ev(A)]);
  196.  
  197.  # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  198.  # Otherwise, if a widget binding for one of these is defined, the
  199.  # <KeyPress> class binding will also fire and insert the character,
  200.  # which is wrong.  Ditto for Escape, Return, and Tab.
  201.  
  202.  $mw->bind($class,'<Alt-KeyPress>' ,'NoOp');
  203.  $mw->bind($class,'<Meta-KeyPress>' ,'NoOp');
  204.  $mw->bind($class,'<Control-KeyPress>' ,'NoOp');
  205.  $mw->bind($class,'<Escape>' ,'NoOp');
  206.  $mw->bind($class,'<Return>' ,'NoOp');
  207.  $mw->bind($class,'<Tab>' ,'NoOp');
  208.  
  209.  $mw->bind($class,"<Insert>",
  210.              sub
  211.              {
  212.               my $w = shift;
  213.               eval {local $SIG{__DIE__}; $w->Insert($w->SelectionGet)}
  214.              } ) ;
  215.  # Additional emacs-like bindings:
  216.  if (!$Tk::strictMotif)
  217.   {
  218.    $mw->bind($class,"<Control-a>",['SetCursor',0]);
  219.    $mw->bind($class,"<Control-b>",
  220.                sub
  221.                {
  222.                 my $w = shift;
  223.                 $w->SetCursor($w->index("insert")-1)
  224.                } ) ;
  225.    $mw->bind($class,"<Control-d>",['delete','insert']);
  226.    $mw->bind($class,"<Control-e>",['SetCursor',"end"]);
  227.    $mw->bind($class,"<Control-f>",
  228.                sub
  229.                {
  230.                 my $w = shift;
  231.                 $w->SetCursor($w->index("insert")+1)
  232.                } ) ;
  233.    $mw->bind($class,"<Control-h>","Backspace");
  234.    $mw->bind($class,"<Control-k>",["delete","insert","end"]);
  235.  
  236.    $mw->bind($class,"<Control-t>",'Transpose');
  237.  
  238.    $mw->bind($class,"<Meta-b>",['SetCursor',Ev('wordstart')]);
  239.    $mw->bind($class,"<Meta-d>",
  240.                sub
  241.                {
  242.                 my $w = shift;
  243.                 $w->delete("insert",$w->wordend)
  244.                } ) ;
  245.    $mw->bind($class,"<Meta-f>",
  246.                sub
  247.                {
  248.                 my $w = shift;
  249.                 $w->SetCursor($w->wordend)
  250.                } ) ;
  251.    $mw->bind($class,"<Meta-BackSpace>",
  252.                sub
  253.                {
  254.                 my $w = shift;
  255.                 $w->delete($w->wordstart ,"insert")
  256.                } ) ;
  257.    $class->clipboardKeysyms($mw,"Meta-w","Control-w","Control-y");
  258.    # A few additional bindings of my own.
  259.    $mw->bind($class,"<Control-v>",
  260.                sub
  261.                {
  262.                 my $w = shift;
  263.                 my $Ev = $w->XEvent;
  264.                 eval
  265.                  {local $SIG{__DIE__};
  266.                   $w->insert("insert",$w->SelectionGet);
  267.                   $w->SeeInsert;
  268.                  }
  269.                } ) ;
  270.    $mw->bind($class,"<Control-w>",
  271.                sub
  272.                {
  273.                 my $w = shift;
  274.                 my $Ev = $w->XEvent;
  275.                 $w->delete($w->wordstart ,"insert")
  276.                } ) ;
  277.    $mw->bind($class,"<2>",
  278.                sub
  279.                {
  280.                 my $w = shift;
  281.                 my $Ev = $w->XEvent;
  282.                 $w->scan("mark",$Ev->x);
  283.                 $Tk::x = $Ev->x;
  284.                 $Tk::y = $Ev->y;
  285.                 $Tk::mouseMoved = 0
  286.                } ) ;
  287.    $mw->bind($class,"<B2-Motion>",
  288.                sub
  289.                {
  290.                 my $w = shift;
  291.                 my $Ev = $w->XEvent;
  292.                 if (abs(($Ev->x-$Tk::x)) > 2)
  293.                  {
  294.                   $Tk::mouseMoved = 1
  295.                  }
  296.                 $w->scan("dragto",$Ev->x)
  297.                } ) ;
  298.    $mw->bind($class,"<ButtonRelease-2>",
  299.                sub
  300.                {
  301.                 my $w = shift;
  302.                 my $Ev = $w->XEvent;
  303.                 if (!$Tk::mouseMoved)
  304.                  {
  305.                   eval
  306.                    {local $SIG{__DIE__};
  307.                     $w->insert("insert",$w->SelectionGet);
  308.                     $w->SeeInsert;
  309.                    }
  310.                  }
  311.                } )
  312.   }
  313.  return $class;
  314. }
  315.  
  316. 1;
  317.