Glade-Perl
view release on metacpan or search on metacpan
Glade/PerlUI.pm view on Meta::CPAN
'Gnome::MessageBox',
'Gnome::PropertyBox',
'Gtk::ColorSelectionDialog',
'Gtk::Dialog',
'Gtk::FileSelection',
'Gtk::FontSelectionDialog',
'Gtk::InputDialog',
);
$toplevel_widgets = join(' ',
'Gnome::About',
'Gnome::App',
'Gnome::Dialog',
'Gnome::MessageBox',
'Gnome::PropertyBox',
'Gtk::Dialog',
'Gtk::InputDialog',
'Gtk::Window',
);
$composite_widgets = join(' ',
'Gnome::Entry',
'Gnome::FileEntry',
'Gnome::NumberEntry',
'Gnome::PixmapEntry',
'Gtk::Combo',
);
$gnome_widgets = join( " ",
'GnomeAbout',
'GnomeApp',
'GnomeAppBar',
'GnomeCalculator',
'GnomeColorPicker',
'GnomeDateEdit',
'GnomeDialog',
'GnomeDock',
'GnomeDockItem',
'GnomeDruid',
'GnomeDruidPageFinish',
'GnomeDruidPageStandard',
'GnomeDruidPageStart',
'GnomeEntry',
'GnomeFileEntry',
'GnomeFontPicker',
'GnomeHRef',
'GnomeIconEntry',
'GnomeIconList',
'GnomeIconSelection',
'GnomeLess',
'GnomeMessageBox',
'GnomeNumberEntry',
'GnomePaperSelector',
'GnomePixmap',
'GnomePixmapEntry',
'GnomePropertyBox',
'GnomeSpell',
'GtkCalendar', # In Gtk after CVS-19990914
'GtkClock',
'GtkDial',
'GtkPixmapMenuItem',
);
$gnome_db_widgets = join( " ",
'GnomeDbGrid',
'GnomeDbList',
'GnomeDbCombo',
'GnomeDbReport',
'GnomeDbError',
'GnomeDbLogin',
'GnomeDbBrowser',
'GnomeDbErrorDlg',
'GnomeDbLoginDlg',
);
#===============================================================================
#=========== Version utilities ============
#===============================================================================
sub my_gtk_perl_can_do {
my ($class, $action) = @_;
my $depends = $gtk_perl_depends->{$action} || '';
my $cant_do = $gtk_perl_cant_do->{$action} || '';
unless ($depends or $cant_do) {
# There is no required/cant_do information for $action
return 1;
}
my ($cpan, $cvs);
my $check = $action;
# Check that we have at least the minimum required
$check = $gtk_perl_depends->{$depends} || $depends;
if ($check and $check > $Glade_Perl->glade2perl->my_gtk_perl) {
$cpan = $gtk_perl_depends->{'LATEST_CPAN'};
$cpan = $gtk_perl_depends->{$cpan} if $gtk_perl_depends->{$cpan};
if ($check > $cpan) {
# We need a CVS version
if ($check > $gtk_perl_depends->{'LATEST_CVS'}) {
# The CVS version can't even do it yet
$Glade_Perl->diag_print(1,
"warn Gtk-Perl dated %s cannot do '%s' (properly)".
" and neither can the CVS version !!!",
$Glade_Perl->glade2perl->my_gtk_perl, $action);
} else {
# We need a new CVS version
$Glade_Perl->diag_print(1,
"warn Gtk-Perl dated %s cannot do '%s' (properly)".
" we need CVS module 'gnome-perl' after %s",
$Glade_Perl->glade2perl->my_gtk_perl, $action, $check);
}
} else {
# We need a new CPAN version
$Glade_Perl->diag_print(1,
"warn Gtk-Perl version %s cannot do '%s' (properly)".
" we need CPAN version %s or CVS module 'gnome-perl' after %s",
$Glade_Perl->glade2perl->my_gtk_perl, $action,
$gtk_perl_depends->{$action}, $check);
}
return undef;
}
Glade/PerlUI.pm view on Meta::CPAN
}";
eval $expr;
}
}
unless ($depth) {
# We are the Application level (above all toplevel windows)
return $childname;
} elsif ($proto->{name}) {
# We are the bottom widget in the branch of the proto tree
return $proto->{name};
} elsif ($childname) {
# We are somewhere in the middle of the tree
return $childname;
} else {
# What has happened?
die 'error $me - failed to return anything';
}
}
#===============================================================================
#=========== Utilities to build UI ============
#===============================================================================
sub internal_pack_widget {
my ($class, $parentname, $childname, $proto, $depth) = @_;
my $me = "$class->internal_pack_widget";
my $refpar;
# When we add/pack/append we do it to ${current_form}->{$parentname}
# rather than $widgets->{$parentname} so that we are sure that everything
# is packed in the right order and we can check for duplicate names
my $refwid = (ref $widgets->{$childname} );
my $child_type;
my $postpone_show;
if ($current_form && eval "exists ${current_form}\{'$childname'}") {
die sprintf(("\nerror %s - There is already a widget called ".
"'%s' constructed and packed - I will not overwrite it !"),
$me, $childname);
}
if (" $dialogs $toplevel_widgets " =~ m/ $refwid /) {
# We are a window so don't have a parent to pack into
$Glade_Perl->diag_print (4, "%s- Constructing a toplevel component ".
"(window/dialog) '%s'", $indent, $childname);
# $child_type = $widgets->{$childname}->type;
# if (' toplevel dialog '=~ m/ $child_type /) {
# Add a default delete_event signal connection
$class->add_to_UI($depth,
"${current_form}\{'tooltips'} = new Gtk::Tooltips;" );
$class->add_to_UI($depth,
"${current_form}\{'accelgroup'} = new Gtk::AccelGroup;" );
$class->add_to_UI( $depth,
"${current_form}\{'accelgroup'}->attach(\$widgets->{'$childname'} );" );
# } else {
# die "\nerror F$me $indent- This is a $child_type type Window".
# " - what should I do?";
# }
$postpone_show = 1;
} else {
# We probably have a parent to pack into somehow
eval "\$refpar = (ref ${current_form}\{'$parentname'})||'UNDEFINED !!';";
unless (eval "exists ${current_form}\{'$parentname'}") {
if ($Glade_Perl->source->quick_gen or 'Gtk::Menu' eq $refwid) {
# We are a popup menu so we don't have a root window
# $class->add_to_UI( $depth, "${first_form}->popup_enable;" );
$class->add_to_UI($depth,
"${current_form}\{'tooltips'} = new Gtk::Tooltips;" );
$class->add_to_UI($depth,
"${current_form}\{'accelgroup'} = new Gtk::AccelGroup;" );
$class->add_to_UI( $depth,
"${current_form}\{'accelgroup'}->attach(\$widgets->{'$childname'} );" );
$postpone_show = 1;
} else {
die sprintf(("\nerror %s - Unable to find a widget called '%s' - ".
"I can not pack widget '%s' into a non-existant widget!"),
$me, $parentname, $childname);
}
}
if ($postpone_show) {
# Do nothing
#---------------------------------------
} elsif (" $composite_widgets " =~ m/ $refpar /) {
# We do not need to do anything for this widget
#---------------------------------------
} elsif (eval "${current_form}\{'$parentname'}->can(".
"'query_child_packing')") {# and !defined $proto->{'child_name'}) {
# We have a '$refpar' widget '$parentname' that can query_child_packing
my $ignore = $class->use_par($proto, 'child_name', $DEFAULT, '' );
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->add(".
"\$widgets->{'$childname'} );");
#---------------------------------------
} elsif (' Gtk::CList ' =~ m/ $refpar /) {
$child_type = $class->use_par($proto, 'child_name', $DEFAULT, '' );
if ($child_type eq 'CList:title') {
# We are a CList column widget (title widget)
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->set_column_widget(".
"$CList_column, \$widgets->{'$childname'} );" );
$CList_column++;
} else {
$Glade_Perl->diag_print (1,
"error I don't know what to do with %s element %s",
$refpar, $child_type);
}
#---------------------------------------
} elsif (' Gtk::CTree ' =~ m/ $refpar /) {
$child_type = $class->use_par($proto, 'child_name', $DEFAULT, '' );
if ($child_type eq 'CTree:title') {
# We are a CTree column widget (title widget)
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->set_column_widget(".
"$CTree_column, \$widgets->{'$childname'} );" );
$CTree_column++;
} else {
$Glade_Perl->diag_print (1,
"error I don't know what to do with %s element %s".
$refpar, $child_type);
}
#---------------------------------------
} elsif (' Gtk::Layout ' =~ m/ $refpar /) {
# $Glade_Perl->diag_print(2, $proto);
my $x = $class->use_par($proto, 'x');
my $y = $class->use_par($proto, 'y');
# my $width = $class->use_par($proto, 'width');
# my $height = $class->use_par($proto, 'height');
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->put(".
"\$widgets->{'$childname'}, $x, $y);" );
#---------------------------------------
} elsif (' Gtk::MenuBar Gtk::Menu ' =~ m/ $refpar /) {
# We are a menuitem
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->append(".
"\$widgets->{'$childname'} );" );
#---------------------------------------
} elsif (' Gtk::MenuItem Gtk::PixmapMenuItem ' =~ m/ $refpar /) {
# We are a menu for a meuitem
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->set_submenu(".
"\$widgets->{'$childname'} );" );
$postpone_show = 1;
#---------------------------------------
} elsif (' Gtk::OptionMenu ' =~ m/ $refpar /) {
# We are a menu for an optionmenu
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->set_menu(".
"\$widgets->{'$childname'} );" );
$postpone_show = 1;
#---------------------------------------
} elsif (' Gtk::Notebook ' =~ m/ $refpar /) {
$child_type = $class->use_par($proto, 'child_name', $DEFAULT, '' );
if ($child_type eq 'Notebook:tab') {
# We are a notebook tab widget (eg label) so we can add the
# previous notebook page with ourself as the label
unless ($nb->{$parentname}{'panes'}[$nb->{$parentname}{'tab'}]) {
$Glade_Perl->diag_print (1, "warn There is no widget on the ".
"notebook page linked to notebook tab '%s' - ".
"a Placeholder label was used instead",
$childname);
my $message = sprintf(S_("This is a message generated by %s\n\n".
"No widget was specified for the page linked to\n".
"notebook tab \"%s\"\n\n".
"You should probably use Glade to create one"),
$PACKAGE, $childname);
$class->add_to_UI( $depth,
"${current_form}\{'Placeholder_label'} = ".
"new Gtk::Label('$message');");
$class->add_to_UI( $depth,
"${current_form}\{'Placeholder_label'}->show;");
$nb->{$parentname}{'panes'}[$nb->{$parentname}{'tab'}] =
'Placeholder_label';
}
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->append_page(".
"${current_form}\{'$nb->{$parentname}{'panes'}[$nb->{$parentname}{'tab'}]'}, ".
"\$widgets->{'$childname'} );" );
$nb->{$parentname}{'tab'}++;
} else {
# We are a notebook page so just store for adding later
# when we get the tab widget
push @{$nb->{$parentname}{'panes'}}, $childname;
$nb->{$parentname}{'pane'}++;
}
#---------------------------------------
} elsif (' Gtk::Packer ' =~ m/ $refpar /) {
my $anchor = $class->use_par($proto->{'child'}, 'anchor', $LOOKUP, 'center', 'DONT_UNDEF');
my $side = $class->use_par($proto->{'child'}, 'side', $LOOKUP, 'top', 'DONT_UNDEF');
my $expand = $class->use_par($proto->{'child'}, 'expand', $BOOL, 'False', 'DONT_UNDEF');
my $xfill = $class->use_par($proto->{'child'}, 'xfill', $BOOL, 'False', 'DONT_UNDEF');
my $yfill = $class->use_par($proto->{'child'}, 'yfill', $BOOL, 'False', 'DONT_UNDEF');
my $use_default = $class->use_par($proto->{'child'}, 'use_default', $BOOL,'True', 'DONT_UNDEF');
my $options = "";
if ($expand) {
$options .= "'expand', ";
}
$xfill && ($options .= "'fill_x', ");
$yfill && ($options .= "'fill_y', ");
$options =~ s/, $//;
if ($options) {$options = "[$options]";} else {$options = "[]";}
if ($use_default) {
Glade/PerlUI.pm view on Meta::CPAN
push @yoptions, 'shrink' if $class->use_par($proto->{'child'}, 'yshrink', $BOOL, 'False');
if (scalar @xoptions) {$xoptions = "['".join("', '", @xoptions)."']"} else {$xoptions = '[]'};
if (scalar @yoptions) {$yoptions = "['".join("', '", @yoptions)."']"} else {$yoptions = '[]'};
my $xpad = $class->use_par($proto->{'child'}, 'xpad', $DEFAULT, 0 );
my $ypad = $class->use_par($proto->{'child'}, 'ypad', $DEFAULT, 0 );
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->attach(".
"\$widgets->{'$childname'}, ".
"$left_attach, $right_attach, $top_attach, $bottom_attach, ".
"$xoptions, $yoptions, $xpad, $ypad );" );
#---------------------------------------
} elsif (' Gtk::Toolbar ' =~ m/ $refpar /) {
# FIXME - toolbar buttons with a removed label don't have a child_name
# but can have a sub-widget. allow for this
# test all possibilities
# Untested possibilities
# 4 Other type of widget
my $tooltip = $class->use_par($proto, 'tooltip', $DEFAULT, '' );
if (eval "$current_form\{'$parentname'}{'tooltips'}" &&
!$tooltip &&
(' Gtk::VSeparator Gtk::HSeparator Gtk::Combo Gtk::Label ' !~ / $refwid /)) {
$Glade_Perl->diag_print (1,
"warn Toolbar '%s' is expecting ".
"a tooltip but you have not set one for %s '%s'",
$parentname, $refwid, $childname);
}
if ($proto->{'child'}{'new_group'} && $proto->{'child'}{'new_group'} eq 'True') {
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->append_space;" );
}
# We must have a widget already constructed
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->append_widget(".
"\$widgets->{'$childname'}, _('$tooltip'), '' );" );
#---------------------------------------
} elsif (" Gnome::App "=~ m/ $refpar /) {
my $type = $class->use_par($proto, 'child_name', $DEFAULT, '' );
if (' Gnome::AppBar ' =~ m/ $refwid /) {
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->set_statusbar(".
"\$widgets->{'$childname'} );" );
} elsif (' GnomeApp:appbar ' =~ m/ $type /) {
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->set_statusbar(".
"\$widgets->{'$childname'} );" );
} elsif (' Gnome::Dock ' =~ m/ $refwid /) {
# FIXME why have I commented this out? Is it because Gnome::Dock should not
# be constructed within a Gnome::App - add Gnome::DockItems by using method
# Gnome::App::add_docked() or Gnome::App::add_dock_item() instead?
# $class->add_to_UI( $depth,
# "${current_form}\{'$parentname'}->set_contents(".
# "\$widgets->{'$childname'} );" );
} elsif (' Gtk::MenuBar ' =~ m/ $refwid /) {
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->set_menus(".
"\$widgets->{'$childname'} );" );
} else {
$Glade_Perl->diag_print (1,
"error Don't know how to pack %s %s (type '%s') - what should I do?",
$refwid, "${current_form}\{'${childname}'}{'child_name'}", $type);
}
#---------------------------------------
} elsif (" Gnome::Dock "=~ m/ $refpar /) {
# We are a Gnome::DockItem
my $placement= $class->use_par($proto, 'placement', $LOOKUP, 'top' );
my $band = $class->use_par($proto, 'band', $DEFAULT, 0 );
my $position = $class->use_par($proto, 'position', $DEFAULT, 0 );
my $offset = $class->use_par($proto, 'offset', $DEFAULT, 0 );
my $in_new_band = $class->use_par($proto, 'in_new_band', $DEFAULT, 0 );
# 'Usage: Gnome::Dock::add_item(dock, item, placement, band_num, position, offset, in_new_band)
# Actually should be Gnome::App->add_docked() or
# Gnome::App->add_dock_item() if this widget is in a Gnome::App
# I quote Damon 20000301 on glade-devel list
# I think it was OK to treat dock items as children of the dock.
# A GnomeDock could be used in other places besides a GnomeApp (though
# I don't think Glade supports that completely at the moment).
# I also had to think about GnomeDockBands, but I decided to skip those
# in the output since they are created and destroyed automatically
# and can't be manipulated independantly.
#
# I think you're right in that libglade shouldn't create a GnomeDock inside
# a GnomeApp, and should be adding the dock items via the GnomeApp's
# GnomeDockLayout, e.g. using gnome_app_add_docked() or gnome_app_add_dock_item().
if (" Gnome::DockItem " =~/ $refwid /) {
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->add_item(".
"\$widgets->{'$childname'}, '$placement', $band, ".
"$position, $offset, $in_new_band );" );
} else {
# We are not a dock_item - just using set_contents
undef $proto->{'child_name'};
$class->add_to_UI( $depth,
"${current_window}->set_contents(".
"\$widgets->{'$childname'} );" );
}
#---------------------------------------
} elsif (" Gnome::Druid "=~ m/ $refpar /) {
# We are a Gnome::DruidPage of some sort
$class->add_to_UI( $depth,
"${current_form}\{'$parentname'}->append_page(".
"\$widgets->{'$childname'} );" );
if (' Gnome::DruidPageStart ' =~ / $refwid /) {
$class->add_to_UI( $depth, "${current_form}\{'$parentname'}->".
"set_page(\$widgets->{'$childname'});" );
}
#---------------------------------------
} elsif (" $dialogs "=~ m/ $refpar /) {
( run in 1.636 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )