From: matthewt <matthewt@03d0b0b2-0e1a-0410-a411-fdb2f4bd65d7>
Date: Tue, 12 Aug 2008 18:53:50 +0000 (+0000)
Subject: make widget stuff manglable
X-Git-Tag: v0.002000~231
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3c28d596b414a9d98d9f60b69d2bb4811fbafc8;p=catagits%2FReaction.git

make widget stuff manglable
---

diff --git a/lib/Reaction/UI/WidgetClass.pm b/lib/Reaction/UI/WidgetClass.pm
index b1c88c0..0b3e62f 100644
--- a/lib/Reaction/UI/WidgetClass.pm
+++ b/lib/Reaction/UI/WidgetClass.pm
@@ -95,6 +95,10 @@ override exports_for_package => sub {
         qq{$_="${text}"};
       } keys %$attrs);
     },
+    implements => sub {
+      my ($name, $sub) = @_;
+      $package->meta->add_method($name, $sub);
+    },
   );
 };
 override default_base => sub { ('Reaction::UI::Widget') };
diff --git a/script/rclass_back_to_moose.pl b/script/rclass_back_to_moose.pl
index d22700d..c34392e 100644
--- a/script/rclass_back_to_moose.pl
+++ b/script/rclass_back_to_moose.pl
@@ -48,9 +48,10 @@ sub sq { # short for 'strip quotes'
 }
 
 sub filtered_body {
+  my $is_widget = m/WidgetClass/;
   local $_ = $_{body};
   s/^  //g;
-  s/^\s*implements *(\S+).*?{/"sub ${\sq $1} {"/ge;
+  s/^\s*implements *(\S+).*?{/"sub ${\sq $1} {"/ge unless $is_widget;
   s/^\s*does/with/g;
   s/^\s*overrides/override/g;
   $_;