Changeset 65

Timestamp:

05/04/08 02:10:55 (8 months ago)

Author:

scott

Message:

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.

Location:

trunk/Curses-UI-POE

Files:

• POE.pm (modified) (5 diffs)
• examples/irc_client (modified) (7 diffs)
• t/session.t (modified) (2 diffs)

trunk/Curses-UI-POE/POE.pm

@@ -28 +28 @@
 
 use constant TOP => -1;
-use constant PARENT => -2;
-use constant ROOT => 0;
 
 sub import {
@@ -47 +45 @@
 sub new {
     my ($type, %options) = @_;
-    my $self = bless &Curses::UI::new(@_), $type;
-
-    $self->{modal_objects}      = \@modal_objects;
-    $self->{modal_callbacks}    = \@modal_callbacks;
+    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};
+
+    delete $options{package_states}{_start};
 
     # Default so we don't get a warning about using undef as an array.
     $options{object_states}   ||= [];
-    $options{package_states}  ||= [];
+    $options{inline_states}   ||= {};
     $options{options}         ||= {};
 
@@ -62 +69 @@
           args           => $options{args},
           inline_states  => $options{inline_states},
-          package_states => $options{package_states},
 
           object_states  => [
@@ -73 +79 @@
 
     # Copy the no-output option
-    $self->{-no_output} = $options{no_output} || 0;
-
+    $self->{-no_output} = $options{-no_output} || 0;
+
+    return $self;
+}
+
+sub _start {
+    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 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;
+#   }
+
+    # 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;
+    }
+
+    POE::Kernel->run;
+}
+
+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.
@@ -128 +269 @@
         return $this;
     }
-
-    return $self;
-}
-
-sub _start {
-    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 $!;
-
-    # 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.
-    $self->{modal_objects} = [ $self ];
-
-    set_read_timeout($self);
-
-    # Unmask...
-    $self->{options}{inline_states}{_start}(@_)
-        if (defined $self->{options}->{inline_states} &&
-            defined $self->{options}{inline_states}{_start});
-}
-
-sub _clear_modal_callback {
-    my ($self) = @_;
-
-    my $top_object = pop @{ $self->{_modal_objects} };
-
-    # Reset focus
-    $top_object->{-focus} = 0;
-
-    # Dispatch callback.
-    my @args = @{ pop @{ $self->{_modal_callbacks} } };
-    my ($sub) = shift @args;
-    &{$sub}(@args);
-}
-
-sub keyin {
-    my ($self, $kernel) = @_[ OBJECT, KERNEL ];
-
-    my $top_object = $self->{modal_objects}->[TOP];
-    # dispatch the event to the top-most modal object, or the root.
-    $top_object->root->do_one_event($top_object);
-
-    # Set the root cursor mode
-    Curses::curs_set($self->{-cursor_mode});
-
-    _clear_modal_callback($self) unless $top_object->{-has_modal_focus};
-}
-
-sub timer {
-    my ($self) = @_;
-
-    my $top_object = $self->{modal_objects}->[TOP];
-    # dispatch the event to the top-most modal object, or the root.
-    $top_object->do_timer;
-
-    # Set the root cursor mode.
-    Curses::curs_set($self->{-cursor_mode});
-
-    set_read_timeout($top_object);
-
-    _clear_modal_callback($self) unless $top_object->{-has_modal_focus};
-}
-
-sub shutdown {
-    my ($kernel) = $_[ KERNEL ];
-
-    # Unselect stdin
-    $kernel->select(\*STDIN);
-}
-
-sub MainLoop { 
-    # When does this even happen!?
-    # I need more comments!
-    my $root = $Curses::UI::rootobject;
-    die "MainLoop: Must create a curses UI object first." unless defined $root;
-
-    # If some how we didn't get our object into the rootobject...redefine that
-    # bad boy.
-    if (ref $root ne __PACKAGE__) {
-        $root = bless $root, __PACKAGE__;
-        $Curses::UI::rootobject = $root;
-    }
-
-    $root->mainloop;
-}
-
-sub mainloop {
-    my ($this) = @_;
-
-    $this->focus(undef, 1);
-    $this->draw;
-
-    Curses::doupdate;
-
-    run POE::Kernel;
-}
-
-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;
 }
 

trunk/Curses-UI-POE/examples/irc_client

@@ -13 +13 @@
 $Curses = new Curses::UI::POE inline_states => {
     _start => sub {
-        POE::Component::IRC->new("IRC");
+        $_[HEAP]->{irc} =
+            POE::Component::IRC->spawn();
 
         # Even if we dont use all events, it shouldn't create an error since
@@ -21 +22 @@
         # efficiency *really* isn't a big issue here.
 
-        $_[KERNEL]->post(IRC => register => "all");
+        $_[KERNEL]->yield(register => "all");
 
     },
 
     irc_connected => sub {
-        printf "Connected to %s", $_[ARG0];
+        printf "Connected to %s", $_[SENDER]->get_heap->server_name();
     },
 
@@ -40 +41 @@
         my ($nick) = ($_[ARG1] =~ m/^(\S+)/);
 
-        $_[KERNEL]->post( IRC => nick => sprintf "%s_", $nick );
+        $_[KERNEL]->yield( nick => sprintf "%s_", $nick );
 
         printf "--- %s in use, trying %s_", $nick, $nick;
@@ -112 +113 @@
 use warnings FATAL => "all";
 
+use POE;
 use POSIX qw( strftime cuserid );
 use Curses;
@@ -270 +272 @@
             printf "Sending Connect EVENT for %s:%s", $server, $port;
 
-            POE::Kernel->post
-                ( IRC => connect => {
+            $_[KERNEL]->yield
+                ( connect => {
                     Nick        => cuserid,
                     Server      => $server,
@@ -289 +291 @@
             else {
                 $Channel{$Join} = 1;
-                POE::Kernel->post( IRC => join => $Join );
+                $_[KERNEL]->yield( join => $Join );
                 $CurrentChannel = $Join;
             }
         },
 
-        nick => sub { POE::Kernel->post( IRC => nick => $_[1] ) },
-        kick => sub { POE::Kernel->post( IRC => kick => $_[1..$#_] ) },
-        msg  => sub { POE::Kernel->post( IRC => privmsg => $_[1..$#_] ) },
+        nick => sub { $_[KERNEL]->yield( nick => $_[1] ) },
+        kick => sub { $_[KERNEL]->yield( kick => $_[1..$#_] ) },
+        msg  => sub { $_[KERNEL]->yield( privmsg => $_[1..$#_] ) },
         
         quote => sub {
-            POE::Kernel->post( IRC => sl => join " ", @_[1..$#_] );
+            $_[KERNEL]->yield( sl => join " ", @_[1..$#_] );
         },
 
         quit => sub {
-            POE::Kernel->post( IRC => quit => join " ", @_[1..$#_] );
+            $_[KERNEL]->yield( quit => join " ", @_[1..$#_] );
 
             print "Have a nice day";
@@ -330 +332 @@
         else {
             if ($CurrentChannel) {
-                POE::Kernel->post( IRC => privmsg => $CurrentChannel, $line );
+                $_[KERNEL]->yield( privmsg => $CurrentChannel, $line );
                 print "> $line";
             }

trunk/Curses-UI-POE/t/session.t

@@ -8 +8 @@
 use Test::Simple tests => 4;
 
-# Trick Curses...
 BEGIN {
     open OLDERR, ">&", \*STDERR;
     open OLDOUT, ">&", \*STDOUT;
+
     open STDOUT, ">>", "/dev/null";
     open STDERR, ">>", "/dev/null";
 }
 
-#sub POE::Kernel::ASSERT_DEFAULT () { 1 }
 use Curses::UI::POE;
 
@@ -39 +38 @@
         open STDERR, ">>", "/dev/null";
     },
-};
+}, -no_output => 1; # Lotta good -no_output does..
 
 $cui->mainloop;