r39531 - in /branches/upstream/libcurses-ui-poe-perl/current: CHANGES MANIFEST MANIFEST.SKIP META.yml POE.pm POE.pm.orig examples/irc_client repro/ repro/rt19681/ repro/rt19681/antgel.pl t/session.t
antgel-guest at users.alioth.debian.org
antgel-guest at users.alioth.debian.org
Thu Jul 9 09:57:41 UTC 2009
Author: antgel-guest
Date: Thu Jul 9 09:57:33 2009
New Revision: 39531
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=39531
Log:
[svn-upgrade] Integrating new upstream version, libcurses-ui-poe-perl (0.035)
Added:
branches/upstream/libcurses-ui-poe-perl/current/POE.pm.orig
branches/upstream/libcurses-ui-poe-perl/current/repro/
branches/upstream/libcurses-ui-poe-perl/current/repro/rt19681/
branches/upstream/libcurses-ui-poe-perl/current/repro/rt19681/antgel.pl
Removed:
branches/upstream/libcurses-ui-poe-perl/current/t/session.t
Modified:
branches/upstream/libcurses-ui-poe-perl/current/CHANGES
branches/upstream/libcurses-ui-poe-perl/current/MANIFEST
branches/upstream/libcurses-ui-poe-perl/current/MANIFEST.SKIP
branches/upstream/libcurses-ui-poe-perl/current/META.yml
branches/upstream/libcurses-ui-poe-perl/current/POE.pm
branches/upstream/libcurses-ui-poe-perl/current/examples/irc_client
Modified: branches/upstream/libcurses-ui-poe-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcurses-ui-poe-perl/current/CHANGES?rev=39531&op=diff
==============================================================================
--- branches/upstream/libcurses-ui-poe-perl/current/CHANGES (original)
+++ branches/upstream/libcurses-ui-poe-perl/current/CHANGES Thu Jul 9 09:57:33 2009
@@ -1,3 +1,70 @@
+------------------------------------------------------------------------
+r96 | scott | 2009-04-17 20:18:19 -0700 (Fri, 17 Apr 2009) | 1 line
+
+Restructured Repository
+------------------------------------------------------------------------
+r69 | scott | 2008-05-06 14:20:49 -0700 (Tue, 06 May 2008) | 4 lines
+
+Fixed about menu and nicklist issues with quit
+ * quit wasn't removing users from the nicklist, fixed
+ * "About editor" label changed to "about"
+
+------------------------------------------------------------------------
+r68 | scott | 2008-05-06 12:49:23 -0700 (Tue, 06 May 2008) | 9 lines
+
+Various bug fixes for CuIRC...
+
+Client is almost usable now. Fixes include:
+ * TextEditor input widget stays in focus at all times
+ * Page up and page down actually scroll the main screen (although the scroll
+ gets reset on incoming message).
+ * /msg no longer crashes client (same with /kick).
+
+
+------------------------------------------------------------------------
+r67 | scott | 2008-05-04 15:30:03 -0700 (Sun, 04 May 2008) | 1 line
+
+Fixed IRC client example
+------------------------------------------------------------------------
+r66 | scott | 2008-05-04 11:27:23 -0700 (Sun, 04 May 2008) | 1 line
+
+Removed language tests -- dubious
+------------------------------------------------------------------------
+r65 | scott | 2008-05-03 23:10:55 -0700 (Sat, 03 May 2008) | 9 lines
+
+Finally, after hours and hours of futzing with it, I think I got
+Curses::UI::POE reasonably refactored.
+
+There is a bunch of commented out code that looks like it can be jettisoned,
+and I can't seem to find out the purpose of this "callbackmodalfocus" override,
+it seems nothing of this nature exists in Curses::UI.
+
+Fixed the tests, whoot.
+
+------------------------------------------------------------------------
+r64 | scott | 2008-05-03 17:32:00 -0700 (Sat, 03 May 2008) | 21 lines
+
+''Updated Tests and Major Refactor''
+This has been a major refactoring of Curses::UI::POE to make it a lot more
+palpable and easier to understand. I've fallen out of love with programming in
+a big hash-ref.
+
+Fixes:
+ * Migrated to a object-states and a more OO approach.
+ * Cleaned up the handling of modality so as to not be so dependent upon odd
+ hash references, and the like.
+ * Extended session interaction to allow Curses::UI::POE constructor to take
+ more POE::Session options, including:
+ * package_states
+ * object_states
+ * options
+ * args
+ * Updated tests so they're compatible with latest Curses::UI version...should
+ probably remove language tests.
+ * Updated session test so it does full regression to ensure session
+ integration works.
+ * Bumped version to 0.03
+
------------------------------------------------------------------------
r13 | scottmc | 2006-04-04 23:52:04 -0700 (Tue, 04 Apr 2006) | 3 lines
Modified: branches/upstream/libcurses-ui-poe-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcurses-ui-poe-perl/current/MANIFEST?rev=39531&op=diff
==============================================================================
--- branches/upstream/libcurses-ui-poe-perl/current/MANIFEST (original)
+++ branches/upstream/libcurses-ui-poe-perl/current/MANIFEST Thu Jul 9 09:57:33 2009
@@ -16,9 +16,10 @@
MANIFEST This list of files
MANIFEST.SKIP
POE.pm
+POE.pm.orig
+repro/rt19681/antgel.pl
t/base_classes.t
t/dialog_classes.t
-t/session.t
t/widget_classes.t
test.pl
META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libcurses-ui-poe-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcurses-ui-poe-perl/current/MANIFEST.SKIP?rev=39531&op=diff
==============================================================================
--- branches/upstream/libcurses-ui-poe-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libcurses-ui-poe-perl/current/MANIFEST.SKIP Thu Jul 9 09:57:33 2009
@@ -5,7 +5,7 @@
^Build$
^blib/
^Makefile$
-^POE-Component-Client-TCPMulti-
+^Curses-UI-POE
^MANIFEST.bak$
^pm_to_blib$
^Makefile.[a-z]+$
Modified: branches/upstream/libcurses-ui-poe-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcurses-ui-poe-perl/current/META.yml?rev=39531&op=diff
==============================================================================
--- branches/upstream/libcurses-ui-poe-perl/current/META.yml (original)
+++ branches/upstream/libcurses-ui-poe-perl/current/META.yml Thu Jul 9 09:57:33 2009
@@ -1,12 +1,15 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Curses-UI-POE
-version: 0.031
-version_from: POE.pm
-installdirs: site
-requires:
+--- #YAML:1.0
+name: Curses-UI-POE
+version: 0.035
+abstract: A subclass that forces Curses::UI to use POE
+license: ~
+author:
+ - Scott S. McCoy (tag at cpan.org)
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
Curses::UI: 0.93
POE: 0.11
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30_01
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: branches/upstream/libcurses-ui-poe-perl/current/POE.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcurses-ui-poe-perl/current/POE.pm?rev=39531&op=diff
==============================================================================
--- branches/upstream/libcurses-ui-poe-perl/current/POE.pm (original)
+++ branches/upstream/libcurses-ui-poe-perl/current/POE.pm Thu Jul 9 09:57:33 2009
@@ -23,7 +23,7 @@
# to our calling this unless somebody is being really, really bad.
BEGIN { run POE::Kernel }
-*VERSION = \0.031;
+*VERSION = \0.035;
our $VERSION;
use constant TOP => -1;
@@ -57,9 +57,8 @@
$self->{options} = \%options;
$self->{__start_callback} = delete $options{inline_states}{_start};
- delete $options{package_states}{_start};
-
- # Default so we don't get a warning about using undef as an array.
+ # Default so we don't get a warning about using undef
+ $options{package_states} ||= [];
$options{object_states} ||= [];
$options{inline_states} ||= {};
$options{options} ||= {};
@@ -68,10 +67,11 @@
( options => $options{options},
args => $options{args},
inline_states => $options{inline_states},
+ package_states => $options{package_states},
object_states => [
@{ $options{object_states} },
- $self, [ qw( _start keyin timer shutdown ) ]
+ $self, [ qw( _start init keyin timer shutdown ) ]
],
# This is to maintain backward compatibility.
@@ -83,7 +83,10 @@
return $self;
}
-sub _start {
+# Wait until the kernel actually starts before we muck with things.
+sub _start { $_[KERNEL]->yield("init") }
+
+sub init {
my ($self, $kernel) = @_[ OBJECT, KERNEL ];
$kernel->select(\*STDIN, "keyin");
@@ -97,6 +100,12 @@
# $self, although if we're not in a dialog $self is what this actually is.
set_read_timeout($modal_objects[TOP]);
+ # When gpm_mouse isn't enabled, sometimes there is extra garbage during
+ # startup. We ignore that garbage during construction, assuming that since
+ # the UI isn't rendered yet (we're still creating the root object!) the
+ # input must not matter.
+ $self->flushkeys;
+
# Unmask...
$self->{__start_callback}(@_)
if defined $self->{__start_callback};
@@ -119,31 +128,18 @@
sub keyin {
my ($self, $kernel) = @_[ OBJECT, KERNEL ];
- unless ($#modal_objects) {
- $self->do_one_event;
- }
- else {
- # dispatch the event to the top-most modal object, or the root.
- $self->do_one_event($modal_objects[TOP]);
-
-# I didn't originally do this here, I'm not quite sure what I'm up to...
-#
-# # If this is a callback modal focus widget, and we lost modal focus,
-# # execute the callback an clear the level in the stack.
-# $self->_clear_modal_callback
-# unless $modal_objects[TOP]->{-has_modal_focus};
-
-# This other wierdness seems unnecessary.
-# $top_object->root->do_one_event($top_object);
- }
-
-# This was a hack to make sure to pick up the extra events when things got out
-# of sync. I'm not sure if I need it. But let's try getting C::U::P working
-# first.
-# if (my $key = $self->get_key(0)) {
-# $self->feedkey($key) unless $key eq "-1";
-# $self->do_one_event;
-# }
+
+ until ((my $key = $self->get_key(0)) eq -1) {
+ $self->feedkey($key);
+
+ unless ($#modal_objects) {
+ $self->do_one_event;
+ }
+ else {
+ # dispatch the event to the top-most modal object, or the root.
+ $self->do_one_event($modal_objects[TOP]);
+ }
+ }
# Set the root cursor mode
unless ($self->{-no_output}) {
@@ -165,11 +161,6 @@
}
set_read_timeout($top_object);
-
-# Looks like older versions didn't support callbackmodalfocus, whatever that
-# is.
-# I'm not sure what the deal is with the callbackmodalfocus shit...
-# $self->_clear_modal_callback unless $top_object->{-has_modal_focus};
}
sub shutdown {
@@ -189,7 +180,48 @@
Curses::doupdate;
}
+
+
+ no warnings "redefine";
+
+ my $modalfocus = \&Curses::UI::Widget::modalfocus;
+
+ # Let modalfocus() be a reentrant into the POE Kernel. This is stackable,
+ # so it should not impact other behaviors, and POE keeps chugging along
+ # uneffected. This is a modal focus without a callback, this method does
+ # not return until the modal widget get's cleared out.
+ #
+ # This is done here so that ->dailog will still work as it did previously.
+ # until this is run. And just in case, we save the old modalfocus
+ # definition and redefine it later.
+ sub Curses::UI::Widget::modalfocus () {
+ my ($this) = @_;
+
+ # "Fake" focus for this object.
+ $this->{-has_modal_focus} = 1;
+ $this->focus;
+ $this->draw;
+
+ push @modal_objects, $this;
+ push @modal_callbacks, undef;
+
+ # This is reentrant into the POE::Kernel
+ while ( $this->{-has_modal_focus} ) {
+ $poe_kernel->loop_do_timeslice;
+ }
+
+ $this->{-focus} = 0;
+
+ pop @modal_callbacks;
+ pop @modal_objects;
+
+ return $this;
+ }
+
POE::Kernel->run;
+
+ # Replace previously defined method into the symbol table.
+ *{"Curses::UI::Widget::modalfocus"} = $modalfocus;
}
sub set_read_timeout {
@@ -241,33 +273,6 @@
return;
}
- # Let modalfocus() be a reentrant into the POE Kernel. This is stackable,
- # so it should not impact other behaviors, and POE keeps chugging along
- # uneffected. This is a modal focus without a callback, this method does
- # not return until the modal widget get's cleared out.
- sub Curses::UI::Widget::modalfocus () {
- my ($this) = @_;
-
- # "Fake" focus for this object.
- $this->{-has_modal_focus} = 1;
- $this->focus;
- $this->draw;
-
- push @modal_objects, $this;
- push @modal_callbacks, undef;
-
- # This is reentrant into the POE::Kernel
- while ( $this->{-has_modal_focus} ) {
- $poe_kernel->loop_do_timeslice;
- }
-
- $this->{-focus} = 0;
-
- pop @modal_callbacks;
- pop @modal_objects;
-
- return $this;
- }
}
=head1 NAME
@@ -359,9 +364,15 @@
=head1 BUGS
-None Known. Whoohoo!
-
-Find any? Send them to me! tag at cpan.org
+=over 2
+
+=item Dialogs before ->mainloop()
+
+Dialogs before Curses::UI::Mainloop
+
+=back
+
+Find more? Send them to me! tag at cpan.org
=head1 AUTHOR
@@ -385,44 +396,3 @@
=cut
1;
-
-__END__
-This is a block of no longer needed code. When I feel up to it,
-I will remove it.
-
-# The tempdialog does this modalfocus in Curses::UI::Widget which
-# starts a secondary event loop. I need to force use of POE.
-
-#sub tempdialog {
-# my $this = shift;
-# my $class = shift;
-# my %args = @_;
-#
-# my $id = "__window_$class";
-#
-# my $dialog = $this->add($id, $class, %args);
-#
-# $dialog->{-has_modal_focus} = 1;
-#
-# $dialog->focus;
-# $dialog->draw;
-#
-# # We loop ourself, this is a modial dialog..but its still gotta multitask.
-# while ( $dialog->{-has_modal_focus} ) {
-# $poe_kernel->loop_do_timeslice;
-# }
-#
-# my $return = $dialog->get;
-#
-# $dialog->{-focus} = 0;
-#
-# $this->delete($id);
-# $this->root->focus(undef, 1);
-#
-# return $return;
-#}
-
-# This is null prototyped only to match the Curses::UI::Widget
-# subroutine it replaces...it SHOULDN'T be prototyped at all
-# since it is a method.
-
Added: branches/upstream/libcurses-ui-poe-perl/current/POE.pm.orig
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcurses-ui-poe-perl/current/POE.pm.orig?rev=39531&op=file
==============================================================================
--- branches/upstream/libcurses-ui-poe-perl/current/POE.pm.orig (added)
+++ branches/upstream/libcurses-ui-poe-perl/current/POE.pm.orig Thu Jul 9 09:57:33 2009
@@ -1,0 +1,410 @@
+# Copyright 2003 by Scott McCoy. All rights reserved. Released under
+# the same terms as Perl itself.
+#
+# Portions Copyright 2003 by Rocco Caputo. All rights reserved. Released
+# under the same terms as Perl itself.
+#
+# Portions Copyright 2001-2003 by Maurice Makaay and/or Marcus
+# Thiesen. Released under the same terms as Perl itself.
+
+# Good luck. Send the author feedback. Thanks for trying it. :)
+package Curses::UI::POE;
+
+use warnings FATAL => "all";
+use strict;
+
+use POE;
+use POSIX qw( fcntl_h );
+use base qw( Curses::UI );
+use Curses::UI::Widget;
+
+# Force POE::Kernel to have ran...stops my warnings...
+# We do it in a BEGIN so there can be no sessions prior
+# to our calling this unless somebody is being really, really bad.
+BEGIN { run POE::Kernel }
+
+*VERSION = \0.033;
+our $VERSION;
+
+use constant TOP => -1;
+
+sub import {
+ my $caller = caller;
+
+ no strict "refs";
+
+ *{ $caller . "::MainLoop" } = \&MainLoop;
+ eval "package $caller; use POE;";
+}
+
+# XXX We assume that there will never be two Curses::UI::POE sessions.
+my @modal_objects;
+my @modal_callbacks;
+
+# The session needed to make curses run in POE.
+sub new {
+ my ($type, %options) = @_;
+ my $self = &Curses::UI::new(@_);
+# my $self = bless Curses::UI->new, $type;
+# my $self = bless &Curses::UI::new(@_), $type;
+
+ # I have to do this here, because if our first order of business is a
+ # dialog then the _start event will be too late. This self reference is
+ # just so we can stack and peel onto the list of modal objects, and get to
+ # ourselves when we reach the top.
+ push @modal_objects, $self;
+
+ $self->{options} = \%options;
+ $self->{__start_callback} = delete $options{inline_states}{_start};
+
+ # Default so we don't get a warning about using undef
+ $options{package_states} ||= [];
+ $options{object_states} ||= [];
+ $options{inline_states} ||= {};
+ $options{options} ||= {};
+
+ POE::Session->create
+ ( options => $options{options},
+ args => $options{args},
+ inline_states => $options{inline_states},
+ package_states => $options{package_states},
+
+ object_states => [
+ @{ $options{object_states} },
+ $self, [ qw( _start init keyin timer shutdown ) ]
+ ],
+
+ # This is to maintain backward compatibility.
+ heap => $self );
+
+ # Copy the no-output option
+ $self->{-no_output} = $options{-no_output} || 0;
+
+ return $self;
+}
+
+# Wait until the kernel actually starts before we muck with things.
+sub _start { $_[KERNEL]->yield("init") }
+
+sub init {
+ my ($self, $kernel) = @_[ OBJECT, KERNEL ];
+
+ $kernel->select(\*STDIN, "keyin");
+
+ # Turn blocking back on for STDIN. Some Curses
+ # implementations don't deal well with non-blocking STDIN.
+ my $flags = fcntl STDIN, F_GETFL, 0 or die $!;
+ fcntl STDIN, F_SETFL, $flags & ~O_NONBLOCK or die $!;
+
+ # If we're in a dialog, then the TOP modal object is more appropriate than
+ # $self, although if we're not in a dialog $self is what this actually is.
+ set_read_timeout($modal_objects[TOP]);
+
+ # Unmask...
+ $self->{__start_callback}(@_)
+ if defined $self->{__start_callback};
+}
+
+sub _clear_modal_callback {
+ my ($self) = @_;
+
+ my $top = pop @modal_objects;
+
+ # Reset focus
+ $top->{-focus} = 0;
+
+ # Dispatch callback.
+ my $args = pop @modal_callbacks;
+ my $sub = shift @$args;
+ &{$sub}(@$args);
+}
+
+sub keyin {
+ my ($self, $kernel) = @_[ OBJECT, KERNEL ];
+
+ unless ($#modal_objects) {
+ $self->do_one_event;
+ }
+ else {
+ # dispatch the event to the top-most modal object, or the root.
+ $self->do_one_event($modal_objects[TOP]);
+
+# I didn't originally do this here, I'm not quite sure what I'm up to...
+#
+# # If this is a callback modal focus widget, and we lost modal focus,
+# # execute the callback an clear the level in the stack.
+# $self->_clear_modal_callback
+# unless $modal_objects[TOP]->{-has_modal_focus};
+
+# This other wierdness seems unnecessary.
+# $top_object->root->do_one_event($top_object);
+ }
+
+ # This is a while so it will cycle and attempt to read in any key events...
+ # There appears to be some kind of gpm related bug which occurs under
+ # certain situations (rt #19681, #25021)
+ while (my $key = $self->get_key(0)) {
+ $self->feedkey($key) unless $key eq "-1";
+ $self->do_one_event;
+ }
+
+ # Set the root cursor mode
+ unless ($self->{-no_output}) {
+ Curses::curs_set($self->{-cursor_mode});
+ }
+}
+
+sub timer {
+ my ($self) = @_;
+
+ # dispatch the event to the top-most modal object, or the root.
+ my $top_object = $modal_objects[TOP];
+
+ $top_object->do_timer;
+
+ # Set the root cursor mode.
+ unless ($self->{-no_output}) {
+ Curses::curs_set($self->{-cursor_mode});
+ }
+
+ set_read_timeout($top_object);
+
+# Looks like older versions didn't support callbackmodalfocus, whatever that
+# is.
+# I'm not sure what the deal is with the callbackmodalfocus shit...
+# $self->_clear_modal_callback unless $top_object->{-has_modal_focus};
+}
+
+sub shutdown {
+ my ($kernel) = $_[ KERNEL ];
+
+ # Unselect stdin
+ $kernel->select(\*STDIN);
+}
+
+sub mainloop {
+ my ($this) = @_;
+
+ unless ($this->{-no_output}) {
+ $this->focus(undef, 1);
+ $this->draw;
+
+ Curses::doupdate;
+ }
+
+
+
+ no warnings "redefine";
+
+ my $modalfocus = \&Curses::UI::Widget::modalfocus;
+
+ # Let modalfocus() be a reentrant into the POE Kernel. This is stackable,
+ # so it should not impact other behaviors, and POE keeps chugging along
+ # uneffected. This is a modal focus without a callback, this method does
+ # not return until the modal widget get's cleared out.
+ #
+ # This is done here so that ->dailog will still work as it did previously.
+ # until this is run. And just in case, we save the old modalfocus
+ # definition and redefine it later.
+ sub Curses::UI::Widget::modalfocus () {
+ my ($this) = @_;
+
+ # "Fake" focus for this object.
+ $this->{-has_modal_focus} = 1;
+ $this->focus;
+ $this->draw;
+
+ push @modal_objects, $this;
+ push @modal_callbacks, undef;
+
+ # This is reentrant into the POE::Kernel
+ while ( $this->{-has_modal_focus} ) {
+ $poe_kernel->loop_do_timeslice;
+ }
+
+ $this->{-focus} = 0;
+
+ pop @modal_callbacks;
+ pop @modal_objects;
+
+ return $this;
+ }
+
+ POE::Kernel->run;
+
+ # Replace previously defined method into the symbol table.
+ *{"Curses::UI::Widget::modalfocus"} = $modalfocus;
+}
+
+sub set_read_timeout {
+ my $this = shift;
+
+ my $new_timeout = -1;
+
+ while (my ($id, $config) = each %{$this->{-timers}}) {
+ next unless $config->{-enabled};
+
+ $new_timeout = $config->{-time}
+ unless $new_timeout != -1 and
+ $new_timeout < $config->{-time};
+ }
+
+ $poe_kernel->delay(timer => $new_timeout) if $new_timeout >= 0;
+
+ # Force the read timeout to be 0, so Curses::UI polls.
+ $this->{-read_timeout} = 0;
+
+ return $this;
+}
+
+{
+ no warnings "redefine";
+ # None of this work's if POE isn't running...
+ # Redefine the callbackmodalfocus to ensure that callbacks and objects make
+ # it on to our own private stack.
+ sub Curses::UI::Widget::callbackmodalfocus {
+ my ($this, $cb) = @_;
+
+ # "Fake" focus for this object.
+ $this->{-has_modal_focus} = 1;
+ $this->focus;
+ $this->draw;
+
+ push @modal_objects, $this;
+
+ if (defined $cb) {
+ # They need a callback, so register it.
+ push @modal_callbacks, $cb;
+ } else {
+ # Push a null callback.
+ push @modal_callbacks, [sub { }];
+ }
+
+ # We assume our callers are going to return immediately back to the
+ # main event loop, so we don't need a recursive call.
+ return;
+ }
+
+}
+
+=head1 NAME
+
+Curses::UI::POE - A subclass makes Curses::UI POE Friendly.
+
+=head1 SYNOPSIS
+
+ use Curses::UI::POE;
+
+ my $cui = new Curses::UI::POE inline_states => {
+ _start => sub {
+ $_[HEAP]->dialog("Hello!");
+ },
+
+ _stop => sub {
+ $_[HEAP]->dialog("Good bye!");
+ },
+ };
+
+ $cui->mainloop
+
+=head1 INTRODUCTION
+
+This is a subclass for Curses::UI that enables it to work with POE.
+It is designed to simply slide over Curses::UI. Keeping the API the
+same and simply forcing Curses::UI to do all of its event handling
+via POE, instead of internal to itself. This allows you to use POE
+behind the scenes for things like networking clients, without Curses::UI
+breaking your programs' functionality.
+
+=head1 ADDITIONS
+
+This is a list of distinct changes between the Curses::UI API, and the
+Curses::UI::POE API. They should all be non-obstructive additions only,
+keeping Curses::UI::POE a drop-in replacement for Curses::UI.
+
+=head2 Constructor Options
+
+=over 2
+
+=item inline_states
+
+The inline_states constructor option allows insertion of inline states
+into the Curses::UI::POE controlling session. Since Curses::UI::POE is
+implimented with a small session I figured it may be useful provide the
+ability to the controlling session for all POE to Interface interaction.
+
+While Curses::UI events are still seamlessly forced to use POE, this allows
+you to use it for a little bit more, such as catching responses from another
+POE component that should be directly connected with output. (See the IRC
+client example).
+
+In this controlling session, however, the heap is predefined as the root
+Curses::UI object, which is a hash reference. In the Curses::UI object,
+all private data is indexed by a key begining with "-". So if you wish
+to use the heap to store other data, simply dont use the "-" hash index
+prefix to avoid conflicts.
+
+=back
+
+=head1 TIMERS
+
+The undocumented Curses::UI timers ($cui->timer) will still work, and
+they will be translated into POE delays. I would suggest not using them,
+however, as POE's internal alarms and delays are far more robust.
+
+=head1 DIALOGS
+
+The Curses::UI::POE dialog methods contain thier own miniature event loop,
+similar to the way Curses::UI's dialog methods worked. However instead
+of blocking and polling on readkeys, it incites its own custom miniature
+POE Event loop until the dialog has completed, and then its result is
+returned as per the Curses::UI specifications.
+
+=head1 MODALITY
+
+Curses::UI::POE builds its own internal modality structure. This allows
+Curses::UI to manage it, and POE to issue the (hopefully correct) events.
+To do this it uses its own custom (smaller) event loop, which is reentrant
+into the POE::Loop in use (In this case, usually POE::Loop::Select). This
+way there can be several recursed layers of event loops, forcing focus on
+the current modal widget, without stopping other POE::Sessions from running.
+
+=head1 SEE ALSO
+
+L<POE>, L<Curses::UI>. Use of this module requires understanding of both
+the Curses::UI widget set and the POE Framework.
+
+=head1 BUGS
+
+=over 2
+
+=item Dialogs before ->mainloop()
+
+Dialogs before Curses::UI::Mainloop
+
+=back
+
+Find more? Send them to me! tag at cpan.org
+
+=head1 AUTHOR
+
+=over 2
+
+=item Rocco Caputo (rcaputo at cpan.org)
+
+Rocco has helped in an astronomical number of ways. He helped me work out
+a number of issues (including how to do this in the first place) and atleast
+half the code if not more came from his fingertips.
+
+=head1 MAINTAINER
+
+=item Scott McCoy (tag at cpan.org)
+
+This was my stupid idea. I also got to maintain it, although the original
+code (some of which may or may not still exist) came from Rocco.
+
+=back
+
+=cut
+
+1;
Modified: branches/upstream/libcurses-ui-poe-perl/current/examples/irc_client
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcurses-ui-poe-perl/current/examples/irc_client?rev=39531&op=diff
==============================================================================
--- branches/upstream/libcurses-ui-poe-perl/current/examples/irc_client (original)
+++ branches/upstream/libcurses-ui-poe-perl/current/examples/irc_client Thu Jul 9 09:57:33 2009
@@ -7,13 +7,14 @@
use POE qw( Component::IRC );
use Curses::UI::POE;
+use Carp;
my $Curses;
$Curses = new Curses::UI::POE inline_states => {
_start => sub {
$_[HEAP]->{irc} =
- POE::Component::IRC->spawn();
+ POE::Component::IRC->spawn( alias => "IRC" );
# Even if we dont use all events, it shouldn't create an error since
# POE::Component::IRC politely (as well as inefficiently) routes all of
@@ -21,12 +22,18 @@
# don't exist will quietly be ignored...since this is an irc client
# efficiency *really* isn't a big issue here.
- $_[KERNEL]->yield(register => "all");
+ $_[KERNEL]->post(IRC => register => "all");
},
irc_connected => sub {
- printf "Connected to %s", $_[SENDER]->get_heap->server_name();
+ my $server_name = $_[ SENDER ]->get_heap->server_name;
+ unless (defined $server_name) {
+ print "Connected...";
+ }
+ else {
+ print "Connected to %s", $server_name;
+ }
},
irc_snotice => sub {
@@ -65,6 +72,8 @@
my ($nick, $hostmask) = ($_[ARG0] =~ m/([^!]+)!(\S+)/);
printf "--- %s (%s) quit \"%s\"", $nick, $hostmask, $_[ARG1];
+
+ $Curses->dropnick($nick);
},
irc_part => sub {
@@ -102,6 +111,17 @@
tie *CURWIN, "IRC::Output", $Curses;
select CURWIN;
+
+
+open LOG, ">>", "cuirc-debug.log";
+
+# Try to put errors in the window...
+$SIG{"__DIE__"} = sub {
+ print LOG $_[0];
+};
+$SIG{"__WARN__"} = sub {
+ print LOG $_[0];
+};
print "Welcome to Curses::UI::POE's IRC example";
@@ -115,6 +135,8 @@
use POE;
use POSIX qw( strftime cuserid );
use Curses;
+use Carp qw( carp );
+use constant KEY_TAB => "\t";
my @nicks;
@@ -163,6 +185,11 @@
my $object = shift;
my ($viewer, $curses) = @$object{qw( -viewer -curses )};
+
+ # XXX Hack: Just ignore bunk requests for now...
+ if (grep !defined $_, @_) {
+ carp "Attempt to print undefined value";
+ }
push @Channel, sprintf shift, @_;
@@ -192,7 +219,7 @@
},
{ -label => 'Help',
-submenu => [
- { -label => 'About editor', -value => \&about_dialog }
+ { -label => 'about', -value => \&about_dialog }
]
},
]
@@ -258,6 +285,14 @@
-singleline => 1,
);
+ my $set_editor_focus = sub {
+ $editor->focus;
+ $editor->draw;
+ };
+
+ $nicks->onFocus($set_editor_focus);
+ $viewer->onFocus($set_editor_focus);
+ $menu->onFocus($set_editor_focus);
my (%Channel, $Current, @History);
my ($CurCon, $CurrentChannel);
@@ -271,8 +306,8 @@
printf "Sending Connect EVENT for %s:%s", $server, $port;
- $_[KERNEL]->yield
- ( connect => {
+ $poe_kernel->post
+ ( IRC => connect => {
Nick => cuserid,
Server => $server,
Port => $port,
@@ -290,21 +325,21 @@
}
else {
$Channel{$Join} = 1;
- $_[KERNEL]->yield( join => $Join );
+ $poe_kernel->post( IRC => join => $Join );
$CurrentChannel = $Join;
}
},
- nick => sub { $_[KERNEL]->yield( nick => $_[1] ) },
- kick => sub { $_[KERNEL]->yield( kick => $_[1..$#_] ) },
- msg => sub { $_[KERNEL]->yield( privmsg => $_[1..$#_] ) },
+ nick => sub { $poe_kernel->post( IRC => nick => $_[1] ) },
+ kick => sub { $poe_kernel->post( IRC => kick => @_[1..$#_] ) },
+ msg => sub { $poe_kernel->post( IRC => privmsg => @_[1..$#_] ) },
quote => sub {
- $_[KERNEL]->yield( sl => join " ", @_[1..$#_] );
+ $poe_kernel->post( IRC => sl => join " ", @_[1..$#_] );
},
quit => sub {
- $_[KERNEL]->yield( quit => join " ", @_[1..$#_] );
+ $poe_kernel->post( IRC => quit => join " ", @_[1..$#_] );
print "Have a nice day";
exit;
@@ -331,7 +366,7 @@
}
else {
if ($CurrentChannel) {
- $_[KERNEL]->yield( privmsg => $CurrentChannel, $line );
+ $poe_kernel->post( IRC => privmsg => $CurrentChannel, $line );
print "> $line";
}
else {
@@ -339,6 +374,23 @@
}
}
}, KEY_ENTER;
+
+ set_binding $editor sub {
+ # Do nothing...overload the lose-focus event.
+ }, KEY_TAB, KEY_BTAB;
+
+ # Why doesn't this work?
+ set_binding $editor sub {
+ warn "Calling \$viewer->cursor_pageup";
+ $viewer->cursor_pageup;
+ $viewer->draw;
+ }, KEY_PPAGE;
+
+ set_binding $editor sub {
+ warn "Calling \$viewer->cursor_pagedown";
+ $viewer->cursor_pagedown;
+ $viewer->draw;
+ }, KEY_NPAGE;
set_binding $editor sub { shift->text($History[--$Current]) }, KEY_UP;
set_binding $editor sub {
@@ -346,6 +398,10 @@
if ($Current > @History) { shift->text("") }
else { shift->text( $History[$Current] ) }
}, KEY_DOWN;
+
+ # Focus on the editor.
+ $editor->focus;
+ $editor->draw;
$_[-1] = bless {
-curses => $curses,
Added: branches/upstream/libcurses-ui-poe-perl/current/repro/rt19681/antgel.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcurses-ui-poe-perl/current/repro/rt19681/antgel.pl?rev=39531&op=file
==============================================================================
--- branches/upstream/libcurses-ui-poe-perl/current/repro/rt19681/antgel.pl (added)
+++ branches/upstream/libcurses-ui-poe-perl/current/repro/rt19681/antgel.pl Thu Jul 9 09:57:33 2009
@@ -1,0 +1,82 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Toolkit;
+
+# Create the UI
+use Curses::UI;
+use Curses::UI::POE;
+
+my $cui = new Curses::UI::POE(-debug => 0);
+my $win = $cui->add('window_id',
+ 'Window',
+ -border => 1
+ );
+
+my $label = $win->add('label',
+ 'Label',
+ -text => 'Press c to calculate or s to sleep.',
+ -width => 70,
+ #-y => 10
+ );
+$label->draw;
+
+my $input_label = $win->add('inputlabel',
+ 'Label',
+ -text => '',
+ -width => 70,
+ -y => 1
+ );
+$input_label->draw;
+
+$cui->set_binding(sub {exit(0)}, "q");
+$cui->set_binding(\&calculate, "c");
+$cui->set_binding(\&do_sleep, "s");
+$cui->set_binding(\&update_input, "1");
+$cui->set_binding(\&update_input, "2");
+$cui->set_binding(\&update_input, "3");
+$cui->set_binding(\&update_input, "4");
+$cui->set_binding(\&update_input, "5");
+$cui->set_binding(\&update_input, "6");
+$cui->set_binding(\&update_input, "7");
+$cui->set_binding(\&update_input, "8");
+$cui->set_binding(\&update_input, "9");
+$cui->set_binding(\&update_input, "0");
+
+$cui->mainloop;
+
+sub calculate {
+ $label->text('Starting calculate');
+ $label->draw;
+
+ my $number_to_add = 50000;
+ my $value = 0;
+ for (my $c = 0; $c < $number_to_add; $c++) {
+ $value += $number_to_add;
+ $label->text("Calculated $value");
+ $label->draw;
+ }
+
+ $label->text('Finished calculate');
+}
+sub do_sleep {
+ $label->text('Starting sleep');
+ $label->draw;
+
+ sleep 5;
+
+ $label->text('Finished sleep');
+}
+
+sub update_input {
+ shift;
+ my $key = shift;
+# print STDERR "Pressed $key\n";
+ my $old_text = $input_label->text;
+ $input_label->text($old_text . $key);
+ $input_label->draw;
+}
More information about the Pkg-perl-cvs-commits
mailing list