home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _8e053d5b45f071aeee0bee9e53c39b2f < prev    next >
Encoding:
Text File  |  2004-04-13  |  29.8 KB  |  1,598 lines
  1.  
  2. # TODO:
  3. #
  4. #    o How to get into state 's0' 'b0' so cursor keys start
  5. #      working (compare with Tk/Widget  XYscrollBind
  6. #    o the options -browsecmd and -command callback are not
  7. #      not implemented (as in Tix)
  8. #    o privateData 'state' used only once (check again Grid.tcl)
  9. #    o FloatEntry 'sometimes not activeted immediately on selection
  10. #    o check also Leave Binding. Looks like entry does get unpost'ed
  11.  
  12. package Tk::TixGrid;
  13.  
  14. BEGIN
  15.   {
  16.     use vars '$DEBUG';
  17.     $DEBUG = (defined($ENV{USER}) and $ENV{USER} eq 'ach') ? 1 : 0;
  18.     print STDERR "tixGrid: debug = $DEBUG\n" if $DEBUG;
  19.   }
  20.  
  21. use strict;
  22. use vars qw($VERSION);
  23. $VERSION = '3.023'; # $Id: //depot/Tk8/TixGrid/TixGrid.pm#23 $
  24.  
  25. use Tk qw(Ev $XS_VERSION);
  26. use Tk::Widget;
  27. use Carp;
  28.  
  29. carp "\n".__PACKAGE__.' is deprecated' unless defined($Test::ntest);
  30.  
  31. use base  'Tk::Widget';
  32.  
  33. Construct Tk::Widget 'TixGrid';
  34.  
  35. bootstrap Tk::TixGrid;
  36.  
  37. sub Tk_cmd { \&Tk::tixGrid }
  38.  
  39. sub Tk::Widget::SrclTixGrid { shift->Scrolled('TixGrid' => @_) }
  40.  
  41. Tk::Methods qw(anchor bdtype delete entrycget entryconfigure format index
  42.                move set size unset xview yview
  43.                to_list_commands dragsite dropsite geometryinfo info
  44.                nearest selection sort );
  45.  
  46. # edit subcommand is special. It justs invokes tcl code:
  47. #
  48. #    edit set x y  ->   tixGrid:EditCell $w, x, y
  49. #    edit apply    -> tixGrid:EditApply
  50.  
  51. # xxx Create an edit sub?
  52. # sub edit { .... }
  53.  
  54. sub editSet
  55.   {
  56.     die "wrong args. Should be \$w->editSet(x,y)\n" unless @_ == 3;
  57.     my ($w, $x, $y) = @_;
  58.     $w->EditCell($x, $y);
  59.   }
  60.  
  61. sub editApply
  62.   {
  63.     die "wrong args. Should be \$w->editApply()\n" unless @_ == 1;
  64.     my ($w) = @_;
  65.     $w->EditApply()
  66.   }
  67.  
  68. use Tk::Submethods
  69.         (
  70.         'anchor'    => [ qw(get    set) ],
  71.         'delete'    => [ qw(column row) ],
  72.         'info'        => [ qw(bbox  exists anchor) ],
  73.         'move'        => [ qw(column row) ],
  74.         'selection'    => [ qw(adjust clear  includes set) ],
  75.         'size'        => [ qw(column row) ],
  76.         'format'    => [ qw(grid   border) ],
  77.         );
  78.  
  79. ####################################################
  80. ##
  81. ## For button 2 scrolling. So TixGrid has 'standard'
  82. ## standard scrolling interface
  83. ##
  84.  
  85. #sub scanMark
  86. #  {
  87. #    die "wrong # args: \$w->scanMark(x,y)\n" unless @_ == 3;
  88. #    my ($w) = @_;
  89. #    $w->{__scanMarkXY__} = [ @_[1,2] ];
  90. #    return "";
  91. #  }
  92. #
  93. #sub scanDragto
  94. #  {
  95. #    die "wrong # args: \$w->scanDragto(x,y)\n" unless @_ == 3;
  96. #    my ($w, $x, $y) = @_;
  97. #    my ($ox, $oy) = @{ $w->{__scanMarkXY__} };
  98. #
  99. #  #...
  100. #
  101. #    return "";
  102. #  }
  103.  
  104. ### end button 2 scrolling stuff ####################
  105.  
  106.  
  107. # Grid.tcl --
  108. #
  109. #     This file defines the default bindings for Tix Grid widgets.
  110. #
  111. # Copyright (c) 1996, Expert Interface Technologies
  112. #
  113. # See the file "license.terms" for information on usage and redistribution
  114. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  115. #
  116. # Bindings translated to perl/Tk by Achim Bohnet <ach@mpe.mpg.de>
  117.  
  118. sub ClassInit
  119.   {
  120.     my ($class, $mw) = @_;
  121.     $class->SUPER::ClassInit($mw);
  122.  
  123.     $mw->XYscrollBind($class);
  124.  
  125.     ##
  126.     ## Button bindings
  127.     ##
  128.  
  129.     $mw->bind($class, '<ButtonPress-1>',    ['Button_1',        Ev('x'), Ev('y')]);
  130.     $mw->bind($class, '<Shift-ButtonPress-1>',    ['Shift_Button_1',    Ev('x'), Ev('y')]);
  131.     $mw->bind($class, '<Control-ButtonPress-1>',['Control_Button_1',    Ev('x'), Ev('y')]);
  132.     $mw->bind($class, '<ButtonRelease-1>',    ['ButtonRelease_1',    Ev('x'), Ev('y')]);
  133.     $mw->bind($class, '<Double-ButtonPress-1>', ['Double_1',        Ev('x'), Ev('y')]);
  134.     $mw->bind($class, '<B1-Motion>','Button_Motion');
  135.     $mw->bind($class, '<Control-B1-Motion>','Control_Button_Motion');
  136.     $mw->bind($class, '<B1-Leave>','Button_Leave');
  137.     $mw->bind($class, '<Double-ButtonPress-1>', ['Double_1',        Ev('x'), Ev('y')]);
  138.     $mw->bind($class, '<B1-Enter>',        ['B1_Enter',        Ev('x'), Ev('y')]);
  139.     $mw->bind($class, '<Control-B1-Leave>','Control_Button_Leave');
  140.     $mw->bind($class, '<Control-B1-Enter>',    ['Control_B1_Enter',    Ev('x'), Ev('y')]);
  141.  
  142.     ##
  143.     ## Keyboard bindings
  144.     ##
  145.  
  146.     $mw->bind($class, '<Up>',        ['DirKey',    'up'    ]);
  147.     $mw->bind($class, '<Down>',        ['DirKey',    'down'    ]);
  148.     $mw->bind($class, '<Left>',        ['DirKey',    'left'    ]);
  149.     $mw->bind($class, '<Right>',    ['DirKey',    'right'    ]);
  150.  
  151.     $mw->PriorNextBind($class);
  152.  
  153.     $mw->bind($class, '<Return>',    'Return');
  154.     $mw->bind($class, '<space>',    'Space'    );
  155.  
  156.     return $class;
  157.   }
  158.  
  159. #----------------------------------------------------------------------
  160. #
  161. #
  162. #             Mouse bindings
  163. #
  164. #
  165. #----------------------------------------------------------------------
  166.  
  167. sub Button_1
  168.   {
  169.     my $w = shift;
  170.  
  171.     return if $w->cget('-state') eq 'disabled';
  172.     $w->SetFocus;
  173.     $w->ChgState(@_,
  174.         [
  175.         '0'=>'1',
  176.         ]
  177.          );
  178.   }
  179.  
  180. sub Shift_Button_1
  181.   {
  182.     my $w = shift;
  183.  
  184.     return if $w->cget('-state') eq 'disabled';
  185.     $w->SetFocus;
  186.  
  187. #    $w->ChgState(@_,
  188. #        [
  189. #        ]
  190. #        );
  191.   }
  192.  
  193. sub Control_Button_1
  194.   {
  195.     my $w = shift;
  196.  
  197.     return if $w->cget('-state') eq 'disabled';
  198.     $w->SetFocus;
  199.  
  200.     $w->ChgState(@_,
  201.         [
  202.         's0'    => 's1',
  203.         'b0'    => 'b1',
  204.         'm0'    => 'm1',
  205.         'e0'    => 'e10',
  206.         ]
  207.          );
  208.   }
  209.  
  210. sub ButtonRelease_1
  211.   {
  212.     shift->ChgState(@_,
  213.         [
  214.         '2'    => '5',
  215.         '4'    => '3',
  216.         ]
  217.         );
  218.   }
  219.  
  220. sub B1_Motion
  221.   {
  222.     shift->ChgState(@_,
  223.         [
  224.         '2'    => '4',
  225.         '4'    => '4',
  226.         ]
  227.         );
  228.   }
  229.  
  230.  
  231. sub Control_B1_Motion
  232.   {
  233.     shift->ChgState(@_,
  234.         [
  235.         's2'    => 's4',
  236.         's4'    => 's4',
  237.         'b2'    => 'b4',
  238.         'b4'    => 'b4',
  239.         'm2'    => 'm4',
  240.         'm5'    => 'm4',
  241.         ]
  242.         );
  243.   }
  244.  
  245.  
  246. sub Double_1
  247.   {
  248.     shift->ChgState(@_,
  249.         [
  250.         's0'    => 's7',
  251.         'b0'    => 'b7',
  252.         ]
  253.         );
  254.   }
  255.  
  256.  
  257. sub B1_Leave
  258.   {
  259.     shift->ChgState(@_,
  260.         [
  261.         's2'    => 's5',
  262.         's4'    => 's5',
  263.         'b2'    => 'b5',
  264.         'b4'    => 'b5',
  265.         'm2'    => 'm8',
  266.         'm5'    => 'm8',
  267.         'e2'    => 'e8',
  268.         'e5'    => 'e8',
  269.         ]
  270.         );
  271.   }
  272.  
  273.  
  274. sub B1_Enter
  275.   {
  276.     shift->ChgState(@_,
  277.         [
  278.         's5'    => 's4',
  279.         's6'    => 's4',
  280.         'b5'    => 'b4',
  281.         'b6'    => 'b4',
  282.         'm8'    => 'm4',
  283.         'm9'    => 'm4',
  284.         'e8'    => 'e4',
  285.         'e9'    => 'e4',
  286.         ]
  287.         );
  288.   }
  289.  
  290.  
  291. sub Control_B1_Leave
  292.   {
  293.     shift->ChgState(@_,
  294.         [
  295.         's2'    => 's5',
  296.         's4'    => 's5',
  297.         'b2'    => 'b5',
  298.         'b4'    => 'b5',
  299.         'm2'    => 'm8',
  300.         'm5'    => 'm8',
  301.         ]
  302.         );
  303.   }
  304.  
  305.  
  306. sub Control_B1_Enter
  307.   {
  308.     shift->ChgState(@_,
  309.         [
  310.         's5'    => 's4',
  311.         's6'    => 's4',
  312.         'b5'    => 'b4',
  313.         'b6'    => 'b4',
  314.         'm8'    => 'm4',
  315.         'm9'    => 'm4',
  316.         ]
  317.         );
  318.   }
  319.  
  320.  
  321. sub AutoScan
  322.   {
  323.     shift->ChgState(@_,
  324.         [
  325.         's5'    => 's9',
  326.         's6'    => 's9',
  327.         'b5'    => 'b9',
  328.         'b6'    => 'b9',
  329.         'm8'    => 'm9',
  330.         'm9'    => 'm9',
  331.         'e8'    => 'm9',
  332.         'e9'    => 'm9',
  333.         ]
  334.         );
  335.   }
  336.  
  337. #----------------------------------------------------------------------
  338. #
  339. #
  340. #             Key bindings
  341. #
  342. #
  343. #----------------------------------------------------------------------
  344.  
  345. sub DirKey
  346.   {
  347.     my ($w, $key) = @_;
  348.  
  349.     return if $w->cget('-state') eq 'disabled';
  350.  
  351. print STDERR "$w->DirKey($key)\n" if $DEBUG;
  352.     $w->ChgState($key,
  353.         [
  354.         's0'    => 's8',
  355.         'b0'    => 'b8',
  356.         ]
  357.         );
  358.   }
  359.  
  360.  
  361. sub Return
  362.   {
  363.     my ($w) = @_;
  364.  
  365.     return if $w->cget('-state') eq 'disabled';
  366.  
  367.     $w->ChgState(
  368.         [
  369.         's0'    => 's9',
  370.         'b0'    => 'b9',
  371.         ]
  372.         );
  373.   }
  374.  
  375.  
  376. sub Space
  377.   {
  378.     my ($w) = @_;
  379.  
  380.     return if $w->cget('-state') eq 'disabled';
  381.  
  382.     $w->ChgState(
  383.         [
  384.         's0'    => 's10',
  385.         'b0'    => 'b10',
  386.         ]
  387.         );
  388.   }
  389.  
  390.  
  391. #----------------------------------------------------------------------
  392. #
  393. #            STATE MANIPULATION
  394. #
  395. #
  396. #----------------------------------------------------------------------
  397.  
  398. sub GetState
  399.   {
  400.     my ($w) = @_;
  401.     my $data = $w->privateData();
  402.     $data->{state} = 0 unless exists $data->{state};
  403.     return $data->{state};
  404. }
  405.  
  406. sub Button_Motion
  407. {
  408.  my $w = shift;
  409.  my $Ev = $w->XEvent;
  410.  $Tk::x =  $Ev->x;
  411.  $Tk::y =  $Ev->y;
  412.  $Tk::X =  $Ev->X;
  413.  $Tk::Y =  $Ev->Y;
  414.  $w->B1_Motion($Tk::x, $Tk::y);
  415. }
  416.  
  417.  
  418. sub Control_Button_Motion
  419. {
  420.  my $w = shift;
  421.  my $Ev = $w->XEvent;
  422.  $Tk::x =  $Ev->x;
  423.  $Tk::y =  $Ev->y;
  424.  $Tk::X =  $Ev->X;
  425.  $Tk::Y =  $Ev->Y;
  426.  $w->Control_B1_Motion($Tk::x, $Tk::y);
  427. }
  428.  
  429.  
  430. sub Button_Leave
  431. {
  432.  my $w = shift;
  433.  my $Ev = $w->XEvent;
  434.  $Tk::x =  $Ev->x;
  435.  $Tk::y =  $Ev->y;
  436.  $Tk::X =  $Ev->X;
  437.  $Tk::Y =  $Ev->Y;
  438.  $w->B1_Leave();
  439. }
  440.  
  441.  
  442. sub Control_Button_Leave
  443. {
  444.  my $w = shift;
  445.  my $Ev = $w->XEvent;
  446.  $Tk::x =  $Ev->x;
  447.  $Tk::y =  $Ev->y;
  448.  $Tk::X =  $Ev->X;
  449.  $Tk::Y =  $Ev->Y;
  450.  $w->Control_B1_Leave();
  451. }
  452.  
  453.  
  454. sub SetState
  455.   {
  456.     my ($w, $state) = @_;
  457.     $w->privateData()->{state} = $state;
  458.   }
  459.  
  460. sub GoState
  461.   {
  462.     my ($w, $state) = (shift, shift);
  463.     print STDERR 'Gostate:  ', $w->GetState, " --> $state, " if $DEBUG;
  464.     $w->SetState($state);
  465.     my $method = "GoState_$state";
  466.  
  467.     print STDERR 'args=(', join(',',@_), ')'.
  468.     "\t(",$w->cget('-selectmode').
  469.     ',',$w->cget('-selectunit').")\n" if $DEBUG;
  470.  
  471.     if (0)
  472.       {
  473.     $@ = '';
  474.     %@ = ();         # Workaround to prevent spurious loss of $@
  475.     eval { $w->$method(@_) };
  476.     print STDERR "Error Gostate: '$state': ", $@ if $@;
  477.     return undef;
  478.       }
  479.  
  480.     $w->$method(@_);
  481.     return undef
  482.   }
  483.  
  484. ##
  485. ## ChgState is a fancy case statement
  486. ##
  487.  
  488. sub ChgState
  489.   {
  490.     my $w   = shift;
  491.     my $map = pop;
  492.     print STDERR 'ChgState(', join(',',@_,'['), join(',',@$map,),'])  ' if $DEBUG;
  493.     my $state = $w->GetState;
  494.  
  495.     my ($match, $to);
  496.     while (@$map)
  497.       {
  498.         $match = shift @$map;
  499.         $to    = shift @$map;
  500.         if ($match eq $state)
  501.           {
  502.         print STDERR "$state --> $to \n" if $DEBUG;
  503.         $w->GoState($to, @_);
  504.         return;
  505.       }
  506.       }
  507.     print STDERR "*no* chg for $state\n" if $DEBUG;
  508.   }
  509.  
  510.  
  511. #----------------------------------------------------------------------
  512. #           SELECTION ROUTINES
  513. #----------------------------------------------------------------------
  514.  
  515. #proc tixGrid:SelectSingle {w ent} {
  516. #    $w selection set [lindex $ent 0] [lindex $ent 1]
  517. #    tixGrid:CallBrowseCmd $w $ent
  518. #}
  519.  
  520. sub SelectSingle
  521.   {
  522.     my ($w, $n1, $n2) = @_;
  523.     $w->selection('set', $n1, $n2);
  524.     #FIX: -options -browsecmd not implemented jet
  525.     #$w->Callback('-browsecmd' => $n1, $n2);
  526.   }
  527.  
  528. #----------------------------------------------------------------------
  529. #    SINGLE SELECTION
  530. #----------------------------------------------------------------------
  531.  
  532. sub GoState_0
  533.   {
  534.     my ($w) = @_;
  535.     my $list = $w->privateData()->{list};
  536.     return unless defined $list;
  537.  
  538.     foreach my $cmd (@$list)
  539.       {
  540.         # XXX should do more something like $w->Callback'('__pending_cmds__');
  541.     eval $cmd;        # XXX why in tcl in global context (binding?)
  542.       }
  543.     undef(@$list);         # XXX should really delete? Maybe on needed in TCL
  544.   }
  545.  
  546. # XXXX how to translate global context
  547. #      what does unset
  548. #proc tixGrid:GoState-0 {w} {
  549. #    set list $w:_list
  550. #    global $list
  551. #
  552. #    if [info exists $list] {
  553. #    foreach cmd [set $list] {
  554. #        uplevel #0 $cmd
  555. #    }
  556. #    if [info exists $list] {
  557. #        unset $list
  558. #    }
  559. #    }
  560. #}
  561.  
  562. sub GoState_1
  563.    {
  564.      my ($w, $x, $y) = @_;
  565.  
  566.      my @ent = $w->mynearest($x,$y);
  567.      if (@ent)
  568.        {
  569.          $w->SetAnchor(@ent);
  570.        }
  571.      $w->CheckEdit;
  572.      $w->selection('clear', 0, 0, 'max', 'max');
  573.  
  574.      if ($w->cget('-selectmode') ne 'single')
  575.        {
  576.          $w->SelectSingle(@ent);
  577.        }
  578.      $w->GoState(2);
  579.    }
  580.  
  581. sub GoState_2
  582.   {
  583.     my ($w) = @_;
  584.   }
  585.  
  586. sub GoState_3
  587.    {
  588.      my ($w, $x, $y) = @_;
  589.  
  590.      my @ent = $w->mynearest($x,$y);
  591.      if (@ent)
  592.        {
  593.          $w->SelectSingle(@ent);
  594.        }
  595.      $w->GoState(0);
  596.  
  597.    }
  598.  
  599. sub GoState_4
  600.   {
  601.     my ($w, $x, $y) = @_;
  602.  
  603.     my (@ent) = $w->mynearest($x,$y);
  604.     my $mode = $w->cget('-selectmode');
  605.  
  606.     if ($mode eq 'single')
  607.       {
  608.     $w->SetAnchor(@ent);
  609.       }
  610.     elsif ($mode eq 'browse')
  611.       {
  612.     $w->SetAnchor(@ent);
  613.     $w->selection('clear', 0, 0, 'max', 'max');
  614.     $w->SelectSingle(@ent);
  615.       }
  616.     elsif ($mode eq 'multiple' ||
  617.        $mode eq 'extended')
  618.       {
  619.     my (@anchor) = $w->anchor('get');
  620.     $w->selection('adjust', @anchor[0,1], @ent[0,1]);
  621.       }
  622.   }
  623.  
  624. sub GoState_5
  625.    {
  626.      my ($w, $x, $y) = @_;
  627.  
  628.      my @ent = $w->mynearest($x,$y);
  629.      if (@ent)
  630.        {
  631.          $w->SelectSingle(@ent);
  632.          $w->SetEdit(@ent);
  633.        }
  634.      $w->GoState(0);
  635.  
  636.    }
  637.  
  638. ##############################################
  639. # BUG xxx
  640. #    return scalar instead of errors
  641.  
  642. sub mynearest   { shift->split_s2a('nearest', @_); }
  643. sub myanchorGet { shift->split_s2a('anchor', 'get', @_); }
  644.  
  645. sub split_s2a
  646.   {
  647.     my $w = shift;
  648.     my $method = shift;
  649.     my @ent = $w->$method(@_);
  650.     if (@ent == 1)
  651.       {
  652. my $tmp = $ent[0];
  653.         @ent = split(/ /, $ent[0]) if @ent == 1;
  654. print STDERR join('|',"$method splitted '$tmp' =>",@ent,"\n") if $DEBUG;
  655.       }
  656.     else
  657.       {
  658. #print STDERR join("|","$method splitted is okay :",@ent,"\n") if $DEBUG;
  659.       }
  660.     return @ent;
  661.   }
  662.  
  663. ##############################################
  664.  
  665.  
  666. sub GoState_s5
  667.   {
  668.     shift->StartScan();
  669.   }
  670.  
  671.  
  672. sub GoState_s6
  673.   {
  674.     shift->DoScan();
  675.   }
  676.  
  677.  
  678. sub GoState_s7
  679.   {
  680.     my ($w, $x, $y) = @_;
  681.  
  682.     my @ent = $w->mynearest($x, $y);
  683.     if (@ent)
  684.       {
  685.         $w->selection('clear');
  686.     $w->selection('set', @ent);
  687.     $w->Callback('-command' => @ent);
  688.       }
  689.     $w->GoState('s0');
  690.   }
  691.  
  692.  
  693. sub GoState_s8
  694.   {
  695.     my ($w, $key) = @_;
  696.  
  697.     ## BUGS ....
  698.     ## - anchor is bad, only bbox, exists8
  699.     ## - looks like anchor is 1-dim: set anchor 0
  700.     ## - method see unknown  (even when defined with Tk::Method)
  701.  
  702.     my (@anchor) = $w->info('anchor');
  703.     if (@anchor)
  704.       {
  705.         @anchor = ();
  706.       }
  707.     else
  708.       {
  709.         @anchor = $w->info($key, @anchor);
  710.       }
  711.  
  712.     $w->anchor('set', @anchor);
  713.     $w->see(@anchor);
  714.  
  715.     $w->GoState('s0');
  716.   }
  717.  
  718. #proc tixGrid:GoState-s8 {w key} {
  719. #    set anchor [$w info anchor]
  720. #
  721. #    if {$anchor == ""} {
  722. #    set anchor 0
  723. #    } else {
  724. #    set anchor [$w info $key $anchor]
  725. #    }
  726. #
  727. #    $w anchor set $anchor
  728. #    $w see $anchor
  729. #    tixGrid:GoState s0 $w
  730. #}
  731.  
  732.  
  733. sub GoState_s9
  734.   {
  735.     my ($w, $key) = @_;
  736.  
  737. #print STDERR "GoState_s9 is not implemented\n";
  738.  
  739.     my (@anchor) = $w->info('anchor');
  740.     unless (@anchor)
  741.       {
  742.         @anchor = ();
  743.         $w->anchor('set', @anchor);
  744.         $w->see(@anchor);
  745.       }
  746.  
  747.     unless ($w->info('anchor'))
  748.       {
  749.         # ! may not have any elements
  750.         #
  751.         $w->Callback('-command' => $w->info('anchor'));
  752.         $w->selection('clear');
  753.         $w->selection('set', @anchor);
  754.       }
  755.  
  756.       $w->GoState('s0');
  757.   }
  758.  
  759.  
  760. sub GoState_s10
  761.   {
  762.     my ($w, $key) = @_;
  763.  
  764.     my (@anchor) = $w->info('anchor');
  765.     if (@anchor)
  766.       {
  767.         @anchor = ();
  768.         $w->anchor('set', @anchor);
  769.         $w->see(@anchor);
  770.       }
  771.  
  772.     unless ($w->info('anchor'))
  773.       {
  774.         # ! may not have any elements
  775.         #
  776.         $w->Callback('-browsecmd' => $w->info('anchor'));
  777.         $w->selection('clear');
  778.         $w->selection('set', @anchor);
  779.       }
  780.  
  781.     $w->GoState('s0');
  782.   }
  783.  
  784.  
  785. #----------------------------------------------------------------------
  786. #    BROWSE SELECTION
  787. #----------------------------------------------------------------------
  788.  
  789. sub GoState_b0
  790.   {
  791.     my ($w) = @_;
  792.   }
  793.  
  794. sub GoState_b1
  795.   {
  796.     my ($w, $x, $y) = @_;
  797.  
  798.     my (@ent) = $w->mynearest($x, $y);
  799.     if (@ent)
  800.       {
  801.     $w->anchor('set', @ent);
  802.     $w->selection('clear');
  803.     $w->selection('set', @ent);
  804.     $w->Callback('-browsecmd' => @ent);
  805.       }
  806.  
  807.     $w->GoState('b2');
  808.   }
  809.  
  810. sub GoState_b2
  811.   {
  812.     my ($w) = @_;
  813.   }
  814.  
  815. sub GoState_b3
  816.   {
  817.     my ($w) = @_;
  818.  
  819.     my (@ent) = $w->info('anchor');
  820.     if (@ent)
  821.       {
  822.     $w->selection('clear');
  823.     $w->selection('set', @ent);
  824.     $w->selection('set', @ent);
  825.     $w->Callback('-browsecmd' => @ent);
  826.       }
  827.  
  828.     $w->GoState('b0');
  829.   }
  830.  
  831.  
  832. sub GoState_b4
  833.   {
  834.     my ($w, $x, $y) = @_;
  835.  
  836.     my (@ent) = $w->mynearest($x, $y);
  837.     if (@ent)
  838.       {
  839.     $w->anchor('set', @ent);
  840.     $w->selection('clear');
  841.     $w->selection('set', @ent);
  842.     $w->Callback('-browsecmd' => @ent);
  843.       }
  844.   }
  845.  
  846.  
  847. sub GoState_b5 { shift->StartScan(); }
  848.  
  849.  
  850. sub GoState_b6 { shift->DoScan(); }
  851.  
  852.  
  853. sub GoState_b7
  854.   {
  855.      my ($w, $x, $y) = @_;
  856.  
  857.      my (@ent) = $w->mynearest($x, $y);
  858.      if (@ent)
  859.        {
  860.          $w->selection('clear');
  861.      $w->selection('set', @ent);
  862.          $w->Callback('-command' => @ent);
  863.        }
  864.      $w->GoState('b0');
  865.   }
  866.  
  867.  
  868. sub GoState_b8
  869.   {
  870.     my ($w, $key) = @_;
  871.  
  872.     my (@anchor) = $w->info('anchor');
  873.     if (@anchor)
  874.       {
  875.     @anchor = $w->info('key', @anchor);
  876.       }
  877.     else
  878.       {
  879.         @anchor = (0,0);   # ?????
  880.       }
  881.  
  882.     $w->anchor('set', @anchor);
  883.     $w->selection('clear');
  884.     $w->selection('set', @anchor);
  885.     $w->see(@anchor);
  886.  
  887.     $w->Callback('-browsecmd' => @anchor);
  888.     $w->GoState('b0');
  889.   }
  890.  
  891.  
  892. sub GoState_b9
  893.   {
  894.     my ($w) = @_;
  895.  
  896.     my (@anchor) =  $w->info('anchor');
  897.     unless (@anchor)
  898.       {
  899.     @anchor = (0,0);
  900.         $w->anchor('set', @anchor);
  901.     $w->see(@anchor);
  902.       }
  903.  
  904.     if ($w->info('anchor'))
  905.       {
  906.     # ! may not have any elements
  907.     #
  908.     $w->Callback('-command' => $w->info('anchor'));
  909.     $w->selection('clear');
  910.     $w->selection('set', @anchor);
  911.       }
  912.  
  913.     $w->GoState('b0');
  914.   }
  915.  
  916.  
  917. sub GoState_b10
  918.   {
  919.     my ($w) = @_;
  920.  
  921.     my (@anchor) =  $w->info('anchor');
  922.     unless (@anchor)
  923.       {
  924.     @anchor = (0,0);
  925.         $w->anchor('set', @anchor);
  926.     $w->see(@anchor);
  927.       }
  928.  
  929.     if ($w->info('anchor'))
  930.       {
  931.     # ! may not have any elements
  932.     #
  933.     $w->Callback('-browsecmd' => $w->info('anchor'));
  934.     $w->selection('clear');
  935.     $w->selection('set', @anchor);
  936.       }
  937.  
  938.     $w->GoState('b0');
  939.   }
  940.  
  941. #----------------------------------------------------------------------
  942. #    MULTIPLE SELECTION
  943. #----------------------------------------------------------------------
  944.  
  945.  
  946. sub GoState_m0
  947.   {
  948.     my ($w) = @_;
  949.   }
  950.  
  951. sub GoState_m1
  952.   {
  953.     my ($w, $x, $y) = @_;
  954.  
  955.     my (@ent) = $w->mynearest($x,$y);
  956.     if (@ent)
  957.       {
  958.     $w->anchor('set', @ent);
  959.     $w->selection('clear');
  960.     $w->selection('set', @ent);
  961.     $w->Callback('-browsecmd' => @ent);
  962.       }
  963.  
  964.     $w->GoState('m2');
  965.   }
  966.  
  967. sub GoState_m2
  968.   {
  969.     my ($w) = @_;
  970.   }
  971.  
  972. sub GoState_m3
  973.   {
  974.     my ($w) = @_;
  975.  
  976.     my (@ent) = $w->info('anchor');
  977.     if (@ent)
  978.       {
  979.     $w->Callback('-browsecmd' => @ent);
  980.       }
  981.  
  982.     $w->GoState('m0');
  983.   }
  984.  
  985.  
  986. sub GoState_m4
  987.   {
  988.     my ($w, $x, $y) = @_;
  989.  
  990.     my (@from) = $w->info('anchor');
  991.     my (@to)   = $w->mynearest($x, $y);
  992.     if (@to)
  993.       {
  994.     $w->selection('clear');
  995.     $w->selection('set', @from, @to);
  996.     $w->Callback('-browsecmd' => @to);
  997.       }
  998.     $w->GoState('m5');
  999.   }
  1000.  
  1001. sub GoState_m5
  1002.   {
  1003.     my ($w) = @_;
  1004.   }
  1005.  
  1006. sub GoState_m6
  1007.   {
  1008.     my ($w, $x, $y) = @_;
  1009.  
  1010.     my (@ent)   = $w->mynearest($x, $y);
  1011.     if (@ent)
  1012.       {
  1013.     $w->Callback('-browsecmd' => @ent);
  1014.       }
  1015.     $w->GoState('m0');
  1016.   }
  1017.  
  1018. sub GoState_m7
  1019.   {
  1020.     my ($w, $x, $y) = @_;
  1021.  
  1022.     my (@from) = $w->info('anchor');
  1023.     my (@to)   = $w->mynearest($x, $y);
  1024.     unless (@from)
  1025.       {
  1026.     @from = @to;
  1027.     $w->anchor('set', @from);
  1028.       }
  1029.     if (@to)
  1030.       {
  1031.     $w->selection('clear');
  1032.     $w->selection('set', @from, @to);
  1033.     $w->Callback('-browsecmd' => @to);
  1034.       }
  1035.     $w->GoState('m5');
  1036.   }
  1037.  
  1038.  
  1039. sub GoState_m8 { shift->StartScan() }
  1040.  
  1041.  
  1042. sub GoState_m9 { shift->DoScan() }
  1043.  
  1044.  
  1045. sub GoState_xm7
  1046.   {
  1047.     my ($w, $x, $y) = @_;
  1048.  
  1049.     my (@ent)   = $w->mynearest($x, $y);
  1050.     if (@ent)
  1051.       {
  1052.     $w->selection('clear');
  1053.     $w->selection('set', @ent);
  1054.     $w->Callback('-browsecmd' => @ent);
  1055.       }
  1056.     $w->GoState('m0');
  1057.   }
  1058.  
  1059. #----------------------------------------------------------------------
  1060. #    EXTENDED SELECTION
  1061. #----------------------------------------------------------------------
  1062.  
  1063. sub GoState_e0
  1064.   {
  1065.     my ($w) = @_;
  1066.   }
  1067.  
  1068. sub GoState_e1
  1069.   {
  1070.     my ($w, $x, $y) = @_;
  1071.     my (@ent) = $w->mynearest($x, $y);
  1072.     if (@ent)
  1073.       {
  1074.     $w->anchor('set', @ent);
  1075.     $w->selection('clear');
  1076.     $w->selection('set', @ent);
  1077.     $w->Callback('-browsecmd' => @ent);
  1078.       }
  1079.     $w->GoState('e2');
  1080.   }
  1081.  
  1082.  
  1083. sub GoState_e2
  1084.   {
  1085.     my ($w) = @_;
  1086.   }
  1087.  
  1088. sub GoState_e3
  1089.   {
  1090.     my ($w) = @_;
  1091.  
  1092.     my (@ent) = $w->info('anchor');
  1093.     if (@ent)
  1094.       {
  1095.         $w->Callback('-browsecmd' => @ent);
  1096.       }
  1097.     $w->GoState('e0');
  1098.   }
  1099.  
  1100. sub GoState_e4
  1101.   {
  1102.     my ($w, $x, $y) = @_;
  1103.  
  1104.     my (@from) = $w->info('anchor');
  1105.     my (@to)   = $w->mynearest($x, $y);
  1106.     if (@to)
  1107.       {
  1108.         $w->selection('clear');
  1109.         $w->selection('set', @from, @to);
  1110.         $w->Callback('-browsecmd' => @to);
  1111.       }
  1112.     $w->GoState('e5');
  1113.   }
  1114.  
  1115. sub GoState_e5
  1116.   {
  1117.     my ($w) = @_;
  1118.   }
  1119.  
  1120. sub GoState_e6
  1121.   {
  1122.     my ($w, $x, $y) = @_;
  1123.  
  1124.     my (@ent)   = $w->mynearest($x, $y);
  1125.     if (@ent)
  1126.       {
  1127.         $w->Callback('-browsecmd' => @ent);
  1128.       }
  1129.     $w->GoState('e0');
  1130.   }
  1131.  
  1132. sub GoState_e7
  1133.   {
  1134.     my ($w, $x, $y) = @_;
  1135.  
  1136.     my (@from) = $w->info('anchor');
  1137.     my (@to)   = $w->mynearest($x, $y);
  1138.     unless (@from)
  1139.       {
  1140.         @from = @to;
  1141.         $w->anchor('set', @from);
  1142.       }
  1143.     if (@to)
  1144.       {
  1145.         $w->selection('clear');
  1146.         $w->selection('set', @from, @to);
  1147.         $w->Callback('-browsecmd' => @to);
  1148.       }
  1149.     $w->GoState('e5');
  1150.   }
  1151.  
  1152. sub GoState_e8 { shift->StartScan(); }
  1153.  
  1154. sub GoState_e9 { shift->DoScan(); }
  1155.  
  1156. sub GoState_e10
  1157.   {
  1158.     my ($w, $x, $y) = @_;
  1159.  
  1160.     my (@ent)   = $w->mynearest($x, $y);
  1161.     if (@ent)
  1162.       {
  1163.     if ($w->info('anchor'))
  1164.       {
  1165.         $w->anchor('set', @ent);
  1166.       }
  1167.     if ($w->selection('includes', @ent))
  1168.       {
  1169.         $w->selection('clear', @ent);
  1170.       }
  1171.     else
  1172.       {
  1173.         $w->selection('set', @ent);
  1174.       }
  1175.     $w->Callback('-browsecmd' => @ent);
  1176.       }
  1177.     $w->GoState('e2');
  1178.   }
  1179.  
  1180. sub GoState_xe7
  1181.   {
  1182.     my ($w, $x, $y) = @_;
  1183.  
  1184.     my (@ent) = $w->mynearest($x, $y);
  1185.     if (@ent)
  1186.       {
  1187.         $w->selection('clear');
  1188.         $w->selection('set', @ent);
  1189.         $w->Callback('-command' => @ent);
  1190.       }
  1191.     $w->GoState('e0');
  1192.   }
  1193.  
  1194.  
  1195. #----------------------------------------------------------------------
  1196. #    HODGE PODGE
  1197. #----------------------------------------------------------------------
  1198.  
  1199. sub GoState_12
  1200.   {
  1201.     my ($w, $x, $y) = @_;
  1202.  
  1203.     $w->CancelRepeat;        # xxx  will not work
  1204.     $w->GoState(5, $x, $y);
  1205.   }
  1206. #proc tixGrid:GoState-12 {w x y} {
  1207. #    tkCancelRepeat
  1208. #    tixGrid:GoState 5 $w $x $y
  1209. #}
  1210.  
  1211. sub GoState_13
  1212.   {
  1213.     # FIX:  a) $ent or @ent, b) 13 is never called!!? same in Grid.tcl
  1214.     my ($w, @ent, @oldEnt) = @_;
  1215.  
  1216.     my $data = $w->MainWindow->privateData('Tix');
  1217.     $data->{indicator} = \@ent;
  1218.     $data->{oldEntry}  = \@oldEnt;
  1219.     $w->IndicatorCmd('<Arm>', @ent);
  1220.   }
  1221. #    set tkPriv(tix,oldEnt)    $oldEnt
  1222. #    tixGrid:IndicatorCmd $w <Arm> $ent
  1223. #}
  1224.  
  1225. sub GoState_14
  1226.   {
  1227.     my ($w, $x, $y) = @_;
  1228.  
  1229.     my $data = $w->MainWindow->privateData('Tix');
  1230.     if ($w->InsideArmedIndicator($x, $y))
  1231.       {
  1232.     $w->anchor('set', @{ $data->{indicator} });
  1233.     $w->selection('clear');
  1234.     $w->selection('set', @{ $data->{indicator} });
  1235.     $w->IndicatorCmd('<Activate>', @{ $data->{indicator} });
  1236.       }
  1237.     else
  1238.       {
  1239.     $w->IndicatorCmd('<Disarm>', @{ $data->{indicator} });
  1240.       }
  1241.     delete($data->{indicator});
  1242.     $w->GoState(0);
  1243.   }
  1244.  
  1245. sub GoState_16
  1246.   {
  1247.     my ($w, @ent) = @_;
  1248.  
  1249.     return unless (@ent);
  1250.     if ($w->cget('-selectmode') ne 'single')
  1251.       {
  1252.     $w->Select(@ent);
  1253.     $w->Browse(@ent);
  1254.       }
  1255.   }
  1256.  
  1257. sub GoState_18
  1258.   {
  1259.     my ($w) = @_;
  1260.  
  1261.     $w->CancelRepeat;    ## xxx
  1262.     $w->GoState(6, $Tk::x, $Tk::y);
  1263.   }
  1264.  
  1265. sub GoState_20
  1266.   {
  1267.     my ($w, $x, $y) = @_;
  1268.  
  1269.     my $data = $w->MainWindow->privateData('Tix');
  1270.     if ($w->InsideArmedIndicator($x, $y))
  1271.       {
  1272.     $w->IndicatorCmd('<Arm>', $data->{'indicator'});
  1273.       }
  1274.     else
  1275.       {
  1276.     $w->GoState(21, $x, $y);
  1277.       }
  1278.   }
  1279.  
  1280. sub GoState_21
  1281.   {
  1282.     my ($w, $x, $y) = @_;
  1283.  
  1284.     my $data = $w->MainWindow->privateData('Tix');
  1285.     unless ($w->InsideArmedIndicator($x, $y))
  1286.       {
  1287.     $w->IndicatorCmd('<Disarm>', $data->{'indicator'});
  1288.       }
  1289.     else
  1290.       {
  1291.     $w->GoState(20, $x, $y);
  1292.       }
  1293.   }
  1294.  
  1295. sub GoState_22
  1296.   {
  1297.     my ($w) = @_;
  1298.     my $data = $w->MainWindow->privateData('Tix');
  1299.     if (@{ $data->{oldEntry} })
  1300.       {
  1301.     $w->anchor('set', @{ $data->{oldEntry} });
  1302.       }
  1303.     else
  1304.       {
  1305.     $w->anchor('clear');
  1306.       }
  1307.     $w->GoState(0);
  1308.   }
  1309.  
  1310.  
  1311. #----------------------------------------------------------------------
  1312. #            callback actions
  1313. #----------------------------------------------------------------------
  1314.  
  1315. sub SetAnchor
  1316.   {
  1317.     my ($w, @ent) = @_;
  1318.  
  1319.     if (@ent)
  1320.       {
  1321.     $w->anchor('set', @ent);
  1322. #    $w->see(@ent);
  1323.       }
  1324.   }
  1325.  
  1326. # xxx check @ent of @$ent
  1327. sub Select
  1328.   {
  1329.     my ($w, @ent) = @_;
  1330.     $w->selection('clear');
  1331.     $w->selection('set', @ent)
  1332.   }
  1333.  
  1334. # xxx check new After handling
  1335. sub StartScan
  1336.   {
  1337.     my ($w) = @_;
  1338.     $Tk::afterId = $w->after(50, [AutoScan, $w]);
  1339.   }
  1340.  
  1341. sub DoScan
  1342.   {
  1343.     my ($w) = @_;
  1344.     my $x = $Tk::x;
  1345.     my $y = $Tk::y;
  1346.     my $X = $Tk::X;
  1347.     my $Y = $Tk::Y;
  1348.  
  1349.     my $out = 0;
  1350.     if ($y >= $w->height)
  1351.       {
  1352.     $w->yview('scroll', 1, 'units');
  1353.     $out = 1;
  1354.       }
  1355.     if ($y < 0)
  1356.       {
  1357.     $w->yview('scroll', -1, 'units');
  1358.     $out = 1;
  1359.       }
  1360.     if ($x >= $w->width)
  1361.       {
  1362.     $w->xview('scroll', 2, 'units');
  1363.     $out = 1;
  1364.       }
  1365.     if ($x < 0)
  1366.       {
  1367.     $w->xview('scroll', -2, 'units');
  1368.     $out = 1;
  1369.       }
  1370.     if ($out)
  1371.       {
  1372.     $Tk::afterId = $w->after(50, ['AutoScan', $w]);
  1373.       }
  1374.   }
  1375.  
  1376.  
  1377. #proc tixGrid:CallBrowseCmd {w ent} {
  1378. #    return
  1379. #
  1380. #    set browsecmd [$w cget -browsecmd]
  1381. #    if {$browsecmd != ""} {
  1382. #    set bind(specs) {%V}
  1383. #    set bind(%V)    $ent
  1384. #
  1385. #    tixEvalCmdBinding $w $browsecmd bind $ent
  1386. #    }
  1387. #}
  1388.  
  1389. #proc tixGrid:CallCommand {w ent} {
  1390. #    set command [$w cget -command]
  1391. #    if {$command != ""} {
  1392. #    set bind(specs) {%V}
  1393. #    set bind(%V)    $ent
  1394. #
  1395. #    tixEvalCmdBinding $w $command bind $ent
  1396. #    }
  1397. #}
  1398.  
  1399. # tixGrid:EditCell --
  1400. #
  1401. #    This command is called when "$w edit set $x $y" is called. It causes
  1402. #    an SetEdit call when the grid's state is 0.
  1403. #
  1404.  
  1405. sub EditCell
  1406.   {
  1407.     my ($w, $x, $y) = @_;
  1408.     my $list = $w->privateData()->{'list'};
  1409.     if ($w->GetState == 0)
  1410.       {
  1411.     $w->SetEdit($x, $y);    # xxx really correct ? once 2, once 4 args?
  1412.       }
  1413.     else
  1414.       {
  1415.     push(@$list, [ $w, 'SetEdit', $x, $y]);
  1416.       }
  1417.   }
  1418. #proc tixGrid:EditCell {w x y} {
  1419. #    set list $w:_list
  1420. #    global $list
  1421. #
  1422. #    case [tixGrid:GetState $w] {
  1423. #    {0} {
  1424. #        tixGrid:SetEdit $w [list $x $y]
  1425. #           }
  1426. #    default {
  1427. #        lappend $list [list tixGrid:SetEdit $w [list $x $y]]
  1428. #    }
  1429. #    }
  1430. #}
  1431.  
  1432.  
  1433. # tixGrid:EditApply --
  1434. #
  1435. #    This command is called when "$w edit apply $x $y" is called. It causes
  1436. #    an CheckEdit call when the grid's state is 0.
  1437. #
  1438.  
  1439. sub EditApply
  1440.   {
  1441.     my ($w) = @_;
  1442.     my $list = $w->privateData()->{'list'};
  1443.     if ($w->GetState eq 0)
  1444.       {
  1445.     $w->CheckEdit;    # xxx really correct ? once 2, once 4 args?
  1446.       }
  1447.     else
  1448.       {
  1449.     push(@$list, $w->CheckEdit);
  1450.       }
  1451.   }
  1452. #proc tixGrid:EditApply {w} {
  1453. #    set list $w:_list
  1454. #    global $list
  1455. #
  1456. #    case [tixGrid:GetState $w] {
  1457. #    {0} {
  1458. #        tixGrid:CheckEdit $w
  1459. #           }
  1460. #    default {
  1461. #        lappend $list [list tixGrid:CheckEdit $w]
  1462. #    }
  1463. #    }
  1464. #}
  1465.  
  1466. # tixGrid:CheckEdit --
  1467. #
  1468. #    This procedure is called when the user sets the focus on a cell.
  1469. #    If another cell is being edited, apply the changes of that cell.
  1470. #
  1471.  
  1472. sub CheckEdit
  1473.   {
  1474.     my ($w) = @_;
  1475.     my $edit = $w->privateData->{editentry};
  1476.     if (Tk::Exists($edit))
  1477.       {
  1478.         # If it -command is not empty, it is being used for another cell.
  1479.         # Invoke it so that the other cell can be updated.
  1480.         #
  1481.         if (defined  $edit->cget('-command'))
  1482.           {
  1483.             $edit->invoke;    # xxx no args??
  1484.           }
  1485.       }
  1486.   }
  1487.  
  1488. sub SetFocus
  1489.   {
  1490.     my ($w) = @_;
  1491.     if ($w->cget('-takefocus'))
  1492.       {
  1493. $w->focus;
  1494. #    # xxx translation of if ![string match $w.* [focus -displayof $w]] {
  1495. #    my $hasfocus = $w->focus(-displayof => $w)->pathname;
  1496. #    my $pathname = $w->pathname;
  1497. #        if ($hasfocus =~ /\Q$pathname\E.*/)
  1498. #      {
  1499. #        $w->focus
  1500. #      }
  1501.       }
  1502.   }
  1503.  
  1504.  
  1505. # tixGrid:SetEdit --
  1506. #
  1507. #    Puts a floatentry on top of an editable entry.
  1508. #
  1509.  
  1510. sub SetEdit
  1511.   {
  1512.     my ($w, $px, $py) = @_;
  1513.  
  1514.     $w->CheckEdit;
  1515.  
  1516.     my $efc = $w->cget('-editnotifycmd');
  1517.     return unless ( defined($efc) && length($efc) );
  1518.  
  1519.     unless ($w->Callback('-editnotifycmd' => $px, $py))
  1520.       {
  1521.     print STDERR "editnotifycmd not defined or returned false\n";
  1522.         return;
  1523.       }
  1524.  
  1525.     my $oldvalue;
  1526.     if ($w->info('exists', $px, $py))
  1527.       {
  1528.     # if entry doesn't support -text option. Can't edit it.
  1529.     #
  1530.     # If the application wants to force editing of an entry, it could
  1531.     # delete or replace the entry in the editnotifyCmd procedure.
  1532.     #
  1533.     Tk::catch { $oldvalue = $w->entrycget($px, $py, '-text'); };
  1534.         if ($@)
  1535.           {
  1536.         return;
  1537.       }
  1538.       }
  1539.     else
  1540.       {
  1541.     $oldvalue = '';
  1542.       }
  1543.  
  1544.     my @bbox = $w->info('bbox', $px, $py);
  1545.  
  1546.     my $edit = $w->privateData()->{__EDIT__};
  1547.     unless (Tk::Exists($edit))
  1548.       {
  1549.         require Tk::FloatEntry;
  1550.         $edit = $w->FloatEntry();
  1551.     $w->privateData()->{__EDIT__} = $edit;
  1552.       }
  1553.     $edit->configure(-command=>[\&DoneEdit, $w,  $px, $py]);
  1554.     $edit->post(@bbox);
  1555.     $edit->configure(-value=>$oldvalue);
  1556. }
  1557.  
  1558.  
  1559. sub DoneEdit
  1560.   {
  1561.     my ($w, $x, $y, @args) = @_;
  1562.  
  1563.     my $edit = $w->privateData()->{__EDIT__};
  1564.     $edit->configure(-command=>undef);
  1565.     $edit->unpost;
  1566.  
  1567.     # FIX xxx
  1568.     # set value [tixEvent value]
  1569.     my $value = $edit->get;
  1570.     if ($w->info('exists', $x, $y))
  1571.       {
  1572.     Tk::catch { $w->entryconfigure($x, $y, -text=>$value) };
  1573.         if ($@)
  1574.       {
  1575.         return
  1576.       }
  1577.       }
  1578.     elsif ( length($value) )
  1579.       {
  1580.     # This needs to be catch'ed because the default itemtype may
  1581.     # not support the -text option
  1582.     #
  1583.     Tk::catch { $w->set($x,$y,-text $value); };
  1584.         if ($@)
  1585.           {
  1586.         return;
  1587.           }
  1588.       }
  1589.     else
  1590.       {
  1591.     return;
  1592.       }
  1593.     $w->Callback('-editdonecmd' => $x, $y);
  1594.   }
  1595.  
  1596. 1;
  1597. __END__
  1598.