summaryrefslogtreecommitdiffstats
path: root/perl-install/mygtk2.pm
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2005-01-11 12:04:36 +0000
committerPascal Rigaux <pixel@mandriva.com>2005-01-11 12:04:36 +0000
commitcb0324afb913eb2ed79fe767fab304815718ed92 (patch)
tree6edc115b60bf5540abc4e670514fa8b995f31084 /perl-install/mygtk2.pm
parent3f5927e124ed87f2990fc8d235d1fa62e6bdacc1 (diff)
downloaddrakx-backup-do-not-use-cb0324afb913eb2ed79fe767fab304815718ed92.tar
drakx-backup-do-not-use-cb0324afb913eb2ed79fe767fab304815718ed92.tar.gz
drakx-backup-do-not-use-cb0324afb913eb2ed79fe767fab304815718ed92.tar.bz2
drakx-backup-do-not-use-cb0324afb913eb2ed79fe767fab304815718ed92.tar.xz
drakx-backup-do-not-use-cb0324afb913eb2ed79fe767fab304815718ed92.zip
mygtk2::_gtk() takes an hash ref to allow checking the resulting hash
Diffstat (limited to 'perl-install/mygtk2.pm')
-rw-r--r--perl-install/mygtk2.pm34
1 files changed, 19 insertions, 15 deletions
diff --git a/perl-install/mygtk2.pm b/perl-install/mygtk2.pm
index 0bc5a37e1..d2b1340aa 100644
--- a/perl-install/mygtk2.pm
+++ b/perl-install/mygtk2.pm
@@ -34,7 +34,8 @@ sub gtknew {
if (my $r = find { ref $_->[0] } group_by2(@_)) {
internal_error("gtknew $class: $r should be a string in @_");
}
- _gtk(undef, $class, 'gtknew', @_);
+ my %opts = @_;
+ _gtk(undef, $class, 'gtknew', \%opts);
}
sub gtkset {
@@ -46,9 +47,11 @@ sub gtkset {
if (my $r = find { ref $_->[0] } group_by2(@_)) {
internal_error("gtkset $class: $r should be a string in @_");
}
+ my %opts = @_;
+
$class =~ s/^Gtk2::(Gdk::)?// or internal_error("gtkset unknown class $class");
- _gtk($w, $class, 'gtkset', @_);
+ _gtk($w, $class, 'gtkset', \%opts);
}
sub gtkadd {
@@ -60,9 +63,10 @@ sub gtkadd {
if (my $r = find { ref $_->[0] } group_by2(@_)) {
internal_error("gtkadd $class: $r should be a string in @_");
}
+ my %opts = @_;
$class =~ s/^Gtk2::(Gdk::)?// or internal_error("gtkadd unknown class $class");
- _gtk('gtkadd', $w, $class, @_);
+ _gtk('gtkadd', $w, $class, \%opts);
}
@@ -89,30 +93,30 @@ sub gtkval_modify {
my $global_tooltips;
sub _gtk {
- my ($w, $class, $action, %opts) = @_;
+ my ($w, $class, $action, $opts) = @_;
if (my $f = $mygtk2::{"_gtk__$class"}) {
- $w = $f->($w, \%opts, $class, $action);
+ $w = $f->($w, $opts, $class, $action);
} else {
internal_error("$action $class: unknown class");
}
- $w->set_size_request(delete $opts{width} || -1, delete $opts{height} || -1) if exists $opts{width} || exists $opts{height};
- if (my $position = delete $opts{position}) {
+ $w->set_size_request(delete $opts->{width} || -1, delete $opts->{height} || -1) if exists $opts->{width} || exists $opts->{height};
+ if (my $position = delete $opts->{position}) {
$w->set_uposition($position->[0], $position->[1]);
}
- $w->set_name(delete $opts{widget_name}) if exists $opts{widget_name};
- $w->can_focus(delete $opts{can_focus}) if exists $opts{can_focus};
- $w->can_default(delete $opts{can_default}) if exists $opts{can_default};
- $w->grab_focus if delete $opts{grab_focus};
- (delete $opts{size_group})->add_widget($w) if $opts{size_group};
- if (my $tip = delete $opts{tip}) {
+ $w->set_name(delete $opts->{widget_name}) if exists $opts->{widget_name};
+ $w->can_focus(delete $opts->{can_focus}) if exists $opts->{can_focus};
+ $w->can_default(delete $opts->{can_default}) if exists $opts->{can_default};
+ $w->grab_focus if delete $opts->{grab_focus};
+ (delete $opts->{size_group})->add_widget($w) if $opts->{size_group};
+ if (my $tip = delete $opts->{tip}) {
$global_tooltips ||= Gtk2::Tooltips->new;
$global_tooltips->set_tip($w, $tip);
}
- if (%opts && !$opts{allow_unknown_options}) {
- internal_error("$action $class: unknown option(s) " . join(', ', keys %opts));
+ if (%$opts && !$opts->{allow_unknown_options}) {
+ internal_error("$action $class: unknown option(s) " . join(', ', keys %$opts));
}
$w;
}