In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/7d76264217df3933754d722dc21cd67d80e35df9?hp=8dcc3739b1b464070001663b48ec4983f18a178b>
- Log ----------------------------------------------------------------- commit 7d76264217df3933754d722dc21cd67d80e35df9 Author: Father Chrysostomos <[email protected]> Date: Sun Jan 29 20:54:15 2012 -0800 Update MANIFEST M MANIFEST commit 5055469f0315119bcbc40bd74a9254e55dab3d29 Author: Father Chrysostomos <[email protected]> Date: Sun Jan 29 20:50:02 2012 -0800 Increase $Term::ReadLine::VERSION to 1.08 M dist/Term-ReadLine/lib/Term/ReadLine.pm commit 5bdfa3000e7c17acf02c6f8cb928f24989f2c532 Author: Father Chrysostomos <[email protected]> Date: Sun Jan 29 20:48:15 2012 -0800 Add Darin McBride to AUTHORS M AUTHORS commit b60dd40238e682dc3d405c6f6d0e42572cca27f2 Author: Darin McBride <[email protected]> Date: Sun Jan 29 20:45:44 2012 -0800 [perl #108470] Make Term::ReadLine use AE if available Term::ReadLine only allows the Tk event loop to be called during a readline call. This should be updated to use AnyEvent which will still work with Tk, as well as any other event loop the user may need. With this patch, T::RL now uses AnyEvent if it is loaded, falling back to Tk otherwise; so the Tk mode won't be affected. T::RL::Stub has its own get_line. This does not honour the tkRunning flag at all. If I remove it, it's fine. This patch does so. M dist/Term-ReadLine/lib/Term/ReadLine.pm A dist/Term-ReadLine/t/AE.t A dist/Term-ReadLine/t/AETk.t A dist/Term-ReadLine/t/Tk.t ----------------------------------------------------------------------- Summary of changes: AUTHORS | 1 + MANIFEST | 3 + dist/Term-ReadLine/lib/Term/ReadLine.pm | 84 ++++++++++++++++++++---------- dist/Term-ReadLine/t/AE.t | 33 ++++++++++++ dist/Term-ReadLine/t/AETk.t | 42 +++++++++++++++ dist/Term-ReadLine/t/Tk.t | 42 +++++++++++++++ 6 files changed, 177 insertions(+), 28 deletions(-) create mode 100644 dist/Term-ReadLine/t/AE.t create mode 100644 dist/Term-ReadLine/t/AETk.t create mode 100644 dist/Term-ReadLine/t/Tk.t diff --git a/AUTHORS b/AUTHORS index 7d93d00..89ca1dd 100644 --- a/AUTHORS +++ b/AUTHORS @@ -254,6 +254,7 @@ Daniel S. Lewart <[email protected]> Daniel Yacob <[email protected]> Danny R. Faught <[email protected]> Danny Sadinoff <[email protected]> +Darin McBride <[email protected]> Darrell Kindred <[email protected]> Darrell Schiebel <[email protected]> Darren/Torin/Who Ever... <[email protected]> diff --git a/MANIFEST b/MANIFEST index 93524ba..5649557 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3467,7 +3467,10 @@ dist/Storable/t/weak.t Can Storable store weakrefs dist/Term-Complete/lib/Term/Complete.pm A command completion subroutine dist/Term-Complete/t/Complete.t See if Term::Complete works dist/Term-ReadLine/lib/Term/ReadLine.pm Stub readline library +dist/Term-ReadLine/t/AE.t See if Term::ReadLine works +dist/Term-ReadLine/t/AETk.t See if Term::ReadLine works dist/Term-ReadLine/t/ReadLine.t See if Term::ReadLine works +dist/Term-ReadLine/t/Tk.t See if Term::ReadLine works dist/Text-Abbrev/lib/Text/Abbrev.pm An abbreviation table builder dist/Text-Abbrev/t/Abbrev.t Test Text::Abbrev dist/Thread-Queue/lib/Thread/Queue.pm Thread-safe queues diff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm index 0121cdf..aead1cc 100644 --- a/dist/Term-ReadLine/lib/Term/ReadLine.pm +++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm @@ -111,8 +111,9 @@ additional methods: =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 @@ sub readline { 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) @@ -279,16 +279,16 @@ sub Attribs { {} } my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1); sub Features { \%features } -sub get_line { - my $self = shift; - my $in = $self->IN; - local ($/) = "\n"; - return scalar <$in>; -} +#sub get_line { +# my $self = shift; +# my $in = $self->IN; +# local ($/) = "\n"; +# return scalar <$in>; +#} package Term::ReadLine; # So late to allow the above code be defined? -our $VERSION = '1.07'; +our $VERSION = '1.08'; my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef; if ($which) { @@ -359,23 +359,51 @@ sub ornaments { 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. +#use Enbugger; Enbugger->stop; +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 +413,13 @@ sub tkRunning { 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>; diff --git a/dist/Term-ReadLine/t/AE.t b/dist/Term-ReadLine/t/AE.t new file mode 100644 index 0000000..d0515dc --- /dev/null +++ b/dist/Term-ReadLine/t/AE.t @@ -0,0 +1,33 @@ +#!perl + +use Test::More; + +eval "use AnyEvent; 1" or + plan skip_all => "AnyEvent is not installed."; + +# seeing as the entire point of this test is to test the event handler, +# we need to mock as little as possible. To keep things tightly controlled, +# we'll use the Stub directly. +BEGIN { + $ENV{PERL_RL} = 'Stub o=0'; +} +plan tests => 3; + +# need to delay this so that AE is loaded first. +require Term::ReadLine; +use File::Spec; + +my $t = Term::ReadLine->new('AE'); +ok($t, "Created object"); +is($t->ReadLine, 'Term::ReadLine::Stub', 'Correct type'); +$t->tkRunning(1); + +my $text = 'some text'; +my $T = $text . "\n"; +my $w = AE::timer(0,1,sub { +pass("Event loop called"); +exit 0; +}); + +my $result = $t->readline('Do not press enter>'); +fail("Should not get here."); diff --git a/dist/Term-ReadLine/t/AETk.t b/dist/Term-ReadLine/t/AETk.t new file mode 100644 index 0000000..9546a8c --- /dev/null +++ b/dist/Term-ReadLine/t/AETk.t @@ -0,0 +1,42 @@ +#!perl + +use Test::More; + +eval "use Tk; use AnyEvent; 1" or + plan skip_all => "AnyEvent and/or Tk is not installed."; + +# seeing as the entire point of this test is to test the event handler, +# we need to mock as little as possible. To keep things tightly controlled, +# we'll use the Stub directly. +BEGIN { + $ENV{PERL_RL} = 'Stub o=0'; + # ensure AE uses Tk. + $ENV{PERL_ANYEVENT_MODEL} = 'Tk'; +} + +eval { + use File::Spec; + my $mw = MainWindow->new(); $mw->withdraw(); + 1; +} or plan skip_all => "Tk can't start. DISPLAY not set?"; + +plan tests => 3; + +# need to delay this so that AE is loaded first. +require Term::ReadLine; +use File::Spec; + +my $t = Term::ReadLine->new('AE/Tk'); +ok($t, "Created object"); +is($t->ReadLine, 'Term::ReadLine::Stub', 'Correct type'); +$t->tkRunning(1); + +my $text = 'some text'; +my $T = $text . "\n"; +my $w = AE::timer(0,1,sub { +pass("Event loop called"); +exit 0; +}); + +my $result = $t->readline('Do not press enter>'); +fail("Should not get here."); diff --git a/dist/Term-ReadLine/t/Tk.t b/dist/Term-ReadLine/t/Tk.t new file mode 100644 index 0000000..e241224 --- /dev/null +++ b/dist/Term-ReadLine/t/Tk.t @@ -0,0 +1,42 @@ +#!perl + +use Test::More; + +eval "use Tk; 1" or + plan skip_all => "Tk is not installed."; + +# seeing as the entire point of this test is to test the event handler, +# we need to mock as little as possible. To keep things tightly controlled, +# we'll use the Stub directly. +BEGIN { + $ENV{PERL_RL} = 'Stub o=0'; +} + +my $mw; +eval { + use File::Spec; + $mw = MainWindow->new(); $mw->withdraw(); + 1; +} or plan skip_all => "Tk can't start. DISPLAY not set?"; + +# need to delay this so that Tk is loaded first. +require Term::ReadLine; + +plan tests => 3; + +my $t = Term::ReadLine->new('Tk'); +ok($t, "Created object"); +is($t->ReadLine, 'Term::ReadLine::Stub', 'Correct type'); +$t->tkRunning(1); + +my $text = 'some text'; +my $T = $text . "\n"; + +my $w = Tk::after($mw,0, + sub { + pass("Event loop called"); + exit 0; + }); + +my $result = $t->readline('Do not press enter>'); +fail("Should not get here."); -- Perl5 Master Repository
