home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / TixGrid.pm < prev    next >
Encoding:
Perl POD Document  |  2004-06-01  |  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 = sprintf '4.%03d', q$Revision: #9 $ =~ /\D(\d+)\s*$/;
  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.                dragsite dropsite geometryinfo info
  44.                nearest see selection sort );
  45.  
  46. use Tk::Submethods
  47.         (
  48.         'anchor'    => [ qw(get    set) ],
  49.         'delete'    => [ qw(column row) ],
  50.         'info'        => [ qw(bbox  exists anchor) ],
  51.         'move'        => [ qw(column row) ],
  52.         'selection'    => [ qw(adjust clear  includes set) ],
  53.         'size'        => [ qw(column row) ],
  54.         'format'    => [ qw(grid   border) ],
  55.         );
  56.  
  57. # edit subcommand is special. It justs invokes tcl code:
  58. #
  59. #    edit set x y  ->   tixGrid:EditCell $w, x, y
  60. #    edit apply    -> tixGrid:EditApply
  61.  
  62. # xxx Create an edit sub?
  63. # sub edit { .... }
  64.  
  65. sub editSet
  66.   {
  67.     die "wrong args. Should be \$w->editSet(x,y)\n" unless @_ == 3;
  68.     my ($w, $x, $y) = @_;
  69.     $w->EditCell($x, $y);
  70.   }
  71.  
  72. sub editApply
  73.   {
  74.     die "wrong args. Should be \$w->editApply()\n" unless @_ == 1;
  75.     my ($w) = @_;
  76.     $w->EditApply()
  77.   }
  78.  
  79.  
  80. ####################################################
  81. ##
  82. ## For button 2 scrolling. So TixGrid has 'standard'
  83. ## standard scrolling interface
  84. ##
  85.  
  86. #sub scanMark
  87. #  {
  88. #    die "wrong # args: \$w->scanMark(x,y)\n" unless @_ == 3;
  89. #    my ($w) = @_;
  90. #    $w->{__scanMarkXY__} = [ @_[1,2] ];
  91. #    return "";
  92. #  }
  93. #
  94. #sub scanDragto
  95. #  {
  96. #    die "wrong # args: \$w->scanDragto(x,y)\n" unless @_ == 3;
  97. #    my ($w, $x, $y) = @_;
  98. #    my ($ox, $oy) = @{ $w->{__scanMarkXY__} };
  99. #
  100. #  #...
  101. #
  102. #    return "";
  103. #  }
  104.  
  105. ### end button 2 scrolling stuff ####################
  106.  
  107.  
  108. # Grid.tcl --
  109. #
  110. #     This file defines the default bindings for Tix Grid widgets.
  111. #
  112. # Copyright (c) 1996, Expert Interface Technologies
  113. #
  114. # See the file "license.terms" for information on usage and redistribution
  115. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  116. #
  117. # Bindings translated to perl/Tk by Achim Bohnet <ach@mpe.mpg.de>
  118.  
  119. sub ClassInit
  120.   {
  121.     my ($class, $mw) = @_;
  122.     $class->SUPER::ClassInit($mw);
  123.  
  124.     $mw->XYscrollBind($class);
  125.  
  126.     ##
  127.     ## Button bindings
  128.     ##
  129.  
  130.     $mw->bind($class, '<ButtonPress-1>',    ['Button_1',        Ev('x'), Ev('y')]);
  131.     $mw->bind($class, '<Shift-ButtonPress-1>',    ['Shift_Button_1',    Ev('x'), Ev('y')]);
  132.     $mw->bind($class, '<Control-ButtonPress-1>',['Control_Button_1',    Ev('x'), Ev('y')]);
  133.     $mw->bind($class, '<ButtonRelease-1>',    ['ButtonRelease_1',    Ev('x'), Ev('y')]);
  134.     $mw->bind($class, '<Double-ButtonPress-1>', ['Double_1',        Ev('x'), Ev('y')]);
  135.     $mw->bind($class, '<B1-Motion>','Button_Motion');
  136.     $mw->bind($class, '<Control-B1-Motion>','Control_Button_Motion');
  137.     $mw->bind($class, '<B1-Leave>','Button_Leave');
  138.     $mw->bind($class, '<Double-ButtonPress-1>', ['Double_1',        Ev('x'), Ev('y')]);
  139.     $mw->bind($class, '<B1-Enter>',        ['B1_Enter',        Ev('x'), Ev('y')]);
  140.     $mw->bind($class, '<Control-B1-Leave>','Control_Button_Leave');
  141.     $mw->bind($class, '<Control-B1-Enter>',    ['Control_B1_Enter',    Ev('x'), Ev('y')]);
  142.  
  143.     ##
  144.     ## Keyboard bindings
  145.     ##
  146.  
  147.     $mw->bind($class, '<Up>',        ['DirKey',    'up'    ]);
  148.     $mw->bind($class, '<Down>',        ['DirKey',    'down'    ]);
  149.     $mw->bind($class, '<Left>',        ['DirKey',    'left'    ]);
  150.     $mw->bind($class, '<Right>',    ['DirKey',    'right'    ]);
  151.  
  152.     $mw->PriorNextBind($class);
  153.  
  154.     $mw->bind($class, '<Return>',    'Return');
  155.     $mw->bind($class, '<space>',    'Space'    );
  156.  
  157.     return $class;
  158.   }
  159.  
  160. #----------------------------------------------------------------------
  161. #
  162. #
  163. #             Mouse bindings
  164. #
  165. #
  166. #----------------------------------------------------------------------
  167.  
  168. sub Button_1
  169.   {
  170.     my $w = shift;
  171.  
  172.     return if $w->cget('-state') eq 'disabled';
  173.     $w->SetFocus;
  174.     $w->ChgState(@_,
  175.         [
  176.         '0'=>'1',
  177.         ]
  178.          );
  179.   }
  180.  
  181. sub Shift_Button_1
  182.   {
  183.     my $w = shift;
  184.  
  185.     return if $w->cget('-state') eq 'disabled';
  186.     $w->SetFocus;
  187.  
  188. #    $w->ChgState(@_,
  189. #        [
  190. #        ]
  191. #        );
  192.   }
  193.  
  194. sub Control_Button_1
  195.   {
  196.     my $w = shift;
  197.  
  198.     return if $w->cget('-state') eq 'disabled';
  199.     $w->SetFocus;
  200.  
  201.     $w->ChgState(@_,
  202.         [
  203.         's0'    => 's1',
  204.         'b0'    => 'b1',
  205.         'm0'    => 'm1',
  206.         'e0'    => 'e10',
  207.         ]
  208.          );
  209.   }
  210.  
  211. sub ButtonRelease_1
  212.   {
  213.     shift->ChgState(@_,
  214.         [
  215.         '2'    => '5',
  216.         '4'    => '3',
  217.         ]
  218.         );
  219.   }
  220.  
  221. sub B1_Motion
  222.   {
  223.     shift->ChgState(@_,
  224.         [
  225.         '2'    => '4',
  226.         '4'    => '4',
  227.         ]
  228.         );
  229.   }
  230.  
  231.  
  232. sub Control_B1_Motion
  233.   {
  234.     shift->ChgState(@_,
  235.         [
  236.         's2'    => 's4',
  237.         's4'    => 's4',
  238.         'b2'    => 'b4',
  239.         'b4'    => 'b4',
  240.         'm2'    => 'm4',
  241.         'm5'    => 'm4',
  242.         ]
  243.         );
  244.   }
  245.  
  246.  
  247. sub Double_1
  248.   {
  249.     shift->ChgState(@_,
  250.         [
  251.         's0'    => 's7',
  252.         'b0'    => 'b7',
  253.         ]
  254.         );
  255.   }
  256.  
  257.  
  258. sub B1_Leave
  259.   {
  260.     shift->ChgState(@_,
  261.         [
  262.         's2'    => 's5',
  263.         's4'    => 's5',
  264.         'b2'    => 'b5',
  265.         'b4'    => 'b5',
  266.         'm2'    => 'm8',
  267.         'm5'    => 'm8',
  268.         'e2'    => 'e8',
  269.         'e5'    => 'e8',
  270.         ]
  271.         );
  272.   }
  273.  
  274.  
  275. sub B1_Enter
  276.   {
  277.     shift->ChgState(@_,
  278.         [
  279.         's5'    => 's4',
  280.         's6'    => 's4',
  281.         'b5'    => 'b4',
  282.         'b6'    => 'b4',
  283.         'm8'    => 'm4',
  284.         'm9'    => 'm4',
  285.         'e8'    => 'e4',
  286.         'e9'    => 'e4',
  287.         ]
  288.         );
  289.   }
  290.  
  291.  
  292. sub Control_B1_Leave
  293.   {
  294.     shift->ChgState(@_,
  295.         [
  296.         's2'    => 's5',
  297.         's4'    => 's5',
  298.         'b2'    => 'b5',
  299.         'b4'    => 'b5',
  300.         'm2'    => 'm8',
  301.         'm5'    => 'm8',
  302.         ]
  303.         );
  304.   }
  305.  
  306.  
  307. sub Control_B1_Enter
  308.   {
  309.     shift->ChgState(@_,
  310.         [
  311.         's5'    => 's4',
  312.         's6'    => 's4',
  313.         'b5'    => 'b4',
  314.         'b6'    => 'b4',
  315.         'm8'    => 'm4',
  316.         'm9'    => 'm4',
  317.         ]
  318.         );
  319.   }
  320.  
  321.  
  322. sub AutoScan
  323.   {
  324.     shift->ChgState(@_,
  325.         [
  326.         's5'    => 's9',
  327.         's6'    => 's9',
  328.         'b5'    => 'b9',
  329.         'b6'    => 'b9',
  330.         'm8'    => 'm9',
  331.         'm9'    => 'm9',
  332.         'e8'    => 'm9',
  333.         'e9'    => 'm9',
  334.         ]
  335.         );
  336.   }
  337.  
  338. #----------------------------------------------------------------------
  339. #
  340. #
  341. #             Key bindings
  342. #
  343. #
  344. #----------------------------------------------------------------------
  345.  
  346. sub DirKey
  347.   {
  348.     my ($w, $key) = @_;
  349.  
  350.     return if $w->cget('-state') eq 'disabled';
  351.  
  352. print STDERR "$w->DirKey($key)\n" if $DEBUG;
  353.     $w->ChgState($key,
  354.         [
  355.         's0'    => 's8',
  356.         'b0'    => 'b8',
  357.         ]
  358.         );
  359.   }
  360.  
  361.  
  362. sub Return
  363.   {
  364.     my ($w) = @_;
  365.  
  366.     return if $w->cget('-state') eq 'disabled';
  367.  
  368.     $w->ChgState(
  369.         [
  370.         's0'    => 's9',
  371.         'b0'    => 'b9',
  372.         ]
  373.         );
  374.   }
  375.  
  376.  
  377. sub Space
  378.   {
  379.     my ($w) = @_;
  380.  
  381.     return if $w->cget('-state') eq 'disabled';
  382.  
  383.     $w->ChgState(
  384.         [
  385.         's0'    => 's10',
  386.         'b0'    => 'b10',
  387.         ]
  388.         );
  389.   }
  390.  
  391.  
  392. #----------------------------------------------------------------------
  393. #
  394. #            STATE MANIPULATION
  395. #
  396. #
  397. #----------------------------------------------------------------------
  398.  
  399. sub GetState
  400.   {
  401.     my ($w) = @_;
  402.     my $data = $w->privateData();
  403.     $data->{state} = 0 unless exists $data->{state};
  404.     return $data->{state};
  405. }
  406.  
  407. sub Button_Motion
  408. {
  409.  my $w = shift;
  410.  my $Ev = $w->XEvent;
  411.  $Tk::x =  $Ev->x;
  412.  $Tk::y =  $Ev->y;
  413.  $Tk::X =  $Ev->X;
  414.  $Tk::Y =  $Ev->Y;
  415.  $w->B1_Motion($Tk::x, $Tk::y);
  416. }
  417.  
  418.  
  419. sub Control_Button_Motion
  420. {
  421.  my $w = shift;
  422.  my $Ev = $w->XEvent;
  423.  $Tk::x =  $Ev->x;
  424.  $Tk::y =  $Ev->y;
  425.  $Tk::X =  $Ev->X;
  426.  $Tk::Y =  $Ev->Y;
  427.  $w->Control_B1_Motion($Tk::x, $Tk::y);
  428. }
  429.  
  430.  
  431. sub Button_Leave
  432. {
  433.  my $w = shift;
  434.  my $Ev = $w->XEvent;
  435.  $Tk::x =  $Ev->x;
  436.  $Tk::y =  $Ev->y;
  437.  $Tk::X =  $Ev->X;
  438.  $Tk::Y =  $Ev->Y;
  439.  $w->B1_Leave();
  440. }
  441.  
  442.  
  443. sub Control_Button_Leave
  444. {
  445.  my $w = shift;
  446.  my $Ev = $w->XEvent;
  447.  $Tk::x =  $Ev->x;
  448.  $Tk::y =  $Ev->y;
  449.  $Tk::X =  $Ev->X;
  450.  $Tk::Y =  $Ev->Y;
  451.  $w->Control_B1_Leave();
  452. }
  453.  
  454.  
  455. sub SetState
  456.   {
  457.     my ($w, $state) = @_;
  458.     $w->privateData()->{state} = $state;
  459.   }
  460.  
  461. sub GoState
  462.   {
  463.     my ($w, $state) = (shift, shift);
  464.     print STDERR 'Gostate:  ', $w->GetState, " --> $state, " if $DEBUG;
  465.     $w->SetState($state);
  466.     my $method = "GoState_$state";
  467.  
  468.     print STDERR 'args=(', join(',',@_), ')'.
  469.     "\t(",$w->cget('-selectmode').
  470.     ',',$w->cget('-selectunit').")\n" if $DEBUG;
  471.  
  472.     if (0)
  473.       {
  474.     $@ = '';
  475.     %@ = ();         # Workaround to prevent spurious loss of $@
  476.     eval { $w->$method(@_) };
  477.     print STDERR "Error Gostate: '$state': ", $@ if $@;
  478.     return undef;
  479.       }
  480.  
  481.     $w->$method(@_);
  482.     return undef
  483.   }
  484.  
  485. ##
  486. ## ChgState is a fancy case statement
  487. ##
  488.  
  489. sub ChgState
  490.   {
  491.     my $w   = shift;
  492.     my $map = pop;
  493.     print STDERR 'ChgState(', join(',',@_,'['), join(',',@$map,),'])  ' if $DEBUG;
  494.     my $state = $w->GetState;
  495.  
  496.     my ($match, $to);
  497.     while (@$map)
  498.       {
  499.         $match = shift @$map;
  500.         $to    = shift @$map;
  501.         if ($match eq $state)
  502.           {
  503.         print STDERR "$state --> $to \n" if $DEBUG;
  504.         $w->GoState($to, @_);
  505.         return;
  506.       }
  507.       }
  508.     print STDERR "*no* chg for $state\n" if $DEBUG;
  509.   }
  510.  
  511.  
  512. #----------------------------------------------------------------------
  513. #           SELECTION ROUTINES
  514. #----------------------------------------------------------------------
  515.  
  516. #proc tixGrid:SelectSingle {w ent} {
  517. #    $w selection set [lindex $ent 0] [lindex $ent 1]
  518. #    tixGrid:CallBrowseCmd $w $ent
  519. #}
  520.  
  521. sub SelectSingle
  522.   {
  523.     my ($w, $n1, $n2) = @_;
  524.     $w->selection('set', $n1, $n2);
  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.