summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--perl-install/mygtk2.pm30
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) = @_;