create wrapper object mygtk2::MagicWindow which handles the {rwindow} vs {window} duality

1 files changed, 25 insertions, 5 deletions

diff --git a/perl-install/mygtk2.pm b/perl-install/mygtk2.pm
index 6b7811ab4..fd80472cc 100644
--- a/perl-install/mygtk2.pm
+++ b/perl-install/mygtk2.pm
@@ -49,7 +49,7 @@ sub gtkset {
     }
     my %opts = @_;
 
-    $class =~ s/^Gtk2::(Gdk::)?// or internal_error("gtkset unknown class $class");
+    $class =~ s/^(Gtk2|Gtk2::Gdk|mygtk2)::// or internal_error("gtkset unknown class $class");
     
     _gtk($w, $class, 'gtkset', \%opts);
 }
@@ -64,7 +64,7 @@ sub gtkadd {
 	internal_error("gtkadd $class: $r should be a string in @_");
     }
     my %opts = @_;
-    $class =~ s/^Gtk2::(Gdk::)?// or internal_error("gtkadd unknown class $class");
+    $class =~ s/^(Gtk2|Gtk2::Gdk|mygtk2)::// or internal_error("gtkadd unknown class $class");
     
     _gtk($w, $class, 'gtkadd', \%opts);
 }
@@ -475,16 +475,15 @@ sub _gtk__MagicWindow {
 		    child => gtknew('Frame', shadow_type => 'out', child => $::WizardTable),
 		});
 		$::WizardWindow = _create_Window($opts);
-		$::WizardWindow->show;
 	    }
 	} else {
 	    %$opts = ();
 	}
 
+	$w = $::WizardWindow;
 	gtkadd($::WizardTable, children_loose => [ $sub_child ]);
-	$w = $sub_child;
     }
-    $w;
+    bless { real_window => $w, child => $sub_child, pop_it => $pop_it }, 'mygtk2::MagicWindow';
 }
 
 sub _gtk__FileSelection {
@@ -608,6 +607,27 @@ sub _gtknew_handle_children {
     }
 }
 
+#- this magic function redirects method calls:
+#- * default is to redirect them to the {child}
+#- * if the {child} doesn't handle the method, we try with the {real_window}
+#-   (eg : add_accel_group set_position set_default_size
+#- * a few methods are handled specially
+my %for_real_window = map { $_ => 1 } qw(show);
+sub mygtk2::MagicWindow::AUTOLOAD {
+    my ($w, @args) = @_;
+
+    my ($meth) = $mygtk2::MagicWindow::AUTOLOAD =~ /mygtk2::MagicWindow::(.*)/;
+
+    my $s = $meth eq 'destroy' && $w->{pop_it} ||
+	    $for_real_window{$meth} || 
+            !$w->{child}->can($meth)
+	      ? 'real_window' : 'child';
+
+#-    warn "mygtk2::MagicWindow::$meth on $s (@args)\n";
+
+    $w->{$s}->$meth(@args);
+}
+
 sub _create_Window {
     my ($opts) = @_;