view release on metacpan or  search on metacpan

lib/AnyEvent/Impl/Tk.pm  view on Meta::CPAN

END { undef $mw }

sub io {
   my (undef, %arg) = @_;

   # work around these bugs in Tk:
   # - removing a callback will destroy other callbacks
   # - removing a callback might crash
   # - adding a callback might destroy other callbacks
   # - only one callback per fh
   # - only one callback per fh/poll combination
   my ($fh, $tk) = AnyEvent::_dupfh $arg{poll}, $arg{fh}, "readable", "writable";

   $mw->fileevent ($fh, $tk => $arg{cb});

   bless [$fh, $tk], "AnyEvent::Impl::Tk::io"
}

sub AnyEvent::Impl::Tk::io::DESTROY {
   my ($fh, $tk) = @{$_[0]};

   # work around another bug: watchers don't get removed when
   # the fh is closed, contrary to documentation. also, trying
   # to unregister a read callback will make it impossible
   # to remove the write callback.
   # if your program segfaults here then you need to destroy
   # your watchers before program exit. sorry, no way around
   # that.
   $mw->fileevent ($fh, $tk => "");
}

sub timer {
   my (undef, %arg) = @_;
   
   my $after = $arg{after} < 0 ? 0 : $arg{after} * 1000;
   my $cb = $arg{cb};
   my $id;

   if ($arg{interval}) {
      my $ival = $arg{interval} * 1000;
      my $rcb = sub {
         $id = Tk::after $mw, $ival, [$_[0], $_[0]];
         &$cb;
      };
      $id = Tk::after $mw, $after, [$rcb, $rcb];
   } else {
      # tk blesses $cb, thus the extra indirection
      $id = Tk::after $mw, $after, sub { &$cb };
   }

   bless \\$id, "AnyEvent::Impl::Tk::after"
}

sub idle {
   my (undef, %arg) = @_;

   my $cb = $arg{cb};
   my $id;
   my $rcb = sub {
      # in their endless stupidity, they decided to give repeating idle watchers
      # strictly higher priority than timers :/
      $id = Tk::after $mw, 0 => [sub {
         $id = Tk::after $mw, idle => [$_[0], $_[0]];
      }, $_[0]];
      &$cb;
   };

   $id = Tk::after $mw, idle => [$rcb, $rcb];
   bless \\$id, "AnyEvent::Impl::Tk::after"
}

sub AnyEvent::Impl::Tk::after::DESTROY {
   Tk::after $mw, cancel => $${$_[0]};
}

#sub loop {
#   Tk::MainLoop;
#}

sub _poll {
   Tk::DoOneEvent (0);
}

sub AnyEvent::CondVar::Base::_wait {
   Tk::DoOneEvent (0) until exists $_[0]{_ae_sent};
}

=head1 SEE ALSO

L<AnyEvent>, L<Tk>.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://anyevent.schmorp.de

=cut

1