Front page | perl.perl5.porters |
Postings from January 2012
On Tuesday January 17 2012 1:09:03 PM you wrote:
> Couldnât you detect whether Tk is installed without AnyEvent, and fall
> back to the old code in that case?
Yes. I guess the first question is whether anyone with the power/authority to
commit a change would be interested in it. I was providing the patch as much
as a possible tactic as to simply check if anyone was interested. Even this
patch likely requires some documentation changes (beyond that which is given
here):
diff -u -r Term-ReadLine-1.07.orig/lib/Term/ReadLine.pm Term-
ReadLine-1.07/lib/Term/ReadLine.pm
--- Term-ReadLine-1.07.orig/lib/Term/ReadLine.pm 2011-07-07
09:10:31.000000000 -0600
+++ Term-ReadLine-1.07/lib/Term/ReadLine.pm 2012-01-17 16:20:40.000000000
-0700
@@ -111,8 +111,9 @@
=item C<tkRunning>
-makes Tk event loop run when waiting for user input (i.e., during
-C<readline> method).
+makes an event loop run when waiting for user input (i.e., during
+C<readline> method). If AnyEvent is loaded, it is used, otherwise Tk
+is used.
=item C<ornaments>
@@ -176,8 +177,7 @@
my $prompt = shift;
print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2];
$self->register_Tk
- if not $Term::ReadLine::registered and $Term::ReadLine::toloop
- and defined &Tk::DoOneEvent;
+ if not $Term::ReadLine::registered and $Term::ReadLine::toloop;
#$str = scalar <$in>;
$str = $self->get_line;
utf8::upgrade($str)
@@ -359,23 +359,50 @@
package Term::ReadLine::Tk;
-our($count_handle, $count_DoOne, $count_loop);
-$count_handle = $count_DoOne = $count_loop = 0;
-
-our($giveup);
-sub handle {$giveup = 1; $count_handle++}
-
-sub Tk_loop {
- # Tk->tkwait('variable',\$giveup); # needs Widget
- $count_DoOne++, Tk::DoOneEvent(0) until $giveup;
- $count_loop++;
- $giveup = 0;
+# if AnyEvent is loaded, use it.
+if (defined &AE::cv)
+{
+ my ($cv, $fe);
+
+ # maintain old name for backward-compatibility
+ *AE_loop = *Tk_loop = sub {
+ my $self = shift;
+ $cv = AE::cv();
+ $cv->recv();
+ };
+
+ *register_AE = *register_Tk = sub {
+ my $self = shift;
+ $fe ||= AE::io($self->IN, 0, sub { $cv->send() });
+ };
+
+ # just because AE is loaded doesn't mean Tk isn't.
+ if (not defined &Tk::DoOneEvent)
+ {
+ # create the stub as some T::RL implementations still check
+ # this directly. This should eventually be removed.
+ *Tk::DoOneEvent = sub {
+ die "should not happen";
+ };
+ }
}
+else
+{
+ my ($giveup);
+
+ # technically, not AE, but maybe in the future the Tk-specific
+ # aspects will be removed.
+ *AE_loop = *Tk_loop = sub {
+ Tk::DoOneEvent(0) until $giveup;
+ $giveup = 0;
+ };
+
+ *register_AE = *register_Tk = sub {
+ my $self = shift;
+ $Term::ReadLine::registered++
+ or Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
+ };
-sub register_Tk {
- my $self = shift;
- $Term::ReadLine::registered++
- or Tk->fileevent($self->IN,'readable',\&handle);
}
sub tkRunning {
@@ -385,13 +412,13 @@
sub get_c {
my $self = shift;
- $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+ $self->Tk_loop if $Term::ReadLine::toloop;
return getc $self->IN;
}
sub get_line {
my $self = shift;
- $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+ $self->Tk_loop if $Term::ReadLine::toloop;
my $in = $self->IN;
local ($/) = "\n";
return scalar <$in>;