view release on metacpan or  search on metacpan

Glade/PerlUI.pm  view on Meta::CPAN

        $Glade_Perl->diag_print(1, 
            "warn  Gtk-Perl dated %s cannot do '%s' (properly)".
            " although older and newer versions may",
            $Glade_Perl->glade2perl->my_gtk_perl, $action);
        return undef;
    }
    return undef;
}

sub my_gnome_libs_can_do {
    my ($class, $action) = @_;
    my $depends = $gnome_libs_depends->{$action};
    unless ($depends and $depends gt $Glade_Perl->glade2perl->my_gnome_libs) {
        # There is no specified version or ours is sufficient
        return 1;
    }
    if ($depends ge 19990914) {
        # We need a CVS version
        if ($depends gt 29990000) {
            # The CVS version can't even do it yet
            $Glade_Perl->diag_print(1, 
                "warn  gnome_libs version %s cannot do '%s' (properly)".
                " and neither can the CVS version !!!",
                $Glade_Perl->glade2perl->my_gnome_libs, $action);
        } else {
            # We need a new CVS version
            $Glade_Perl->diag_print(1, 
                "warn  gnome_libs version %s cannot do '%s' (properly)".
                " we need CVS module 'gnome-libs' after %s",
                $Glade_Perl->glade2perl->my_gnome_libs, $action, $depends);
        }
    } else {
        # We need a new released version
        $Glade_Perl->diag_print(1, 
            "warn  gnome_libs version %s cannot do '%s' (properly)".
            " we need version %s",
            $Glade_Perl->glade2perl->my_gnome_libs, $action, $depends);
    }
    return undef;
}

#===============================================================================
#=========== Utilities to construct UI                              ============
#===============================================================================
sub use_par {
    my ($class, $proto, $key, $request, $default, $dont_undef) = @_;
    my $me = "$class->use_par";

    my $type;
    my $self = $proto->{$key};
    unless (defined $self) {
        if (defined $default) {
            $self = $default;
#            $Glade_Perl->diag_print (8, "$indent- No value in proto->{'$key'} ".
#                "so using DEFAULT of '$default' in $me");
        } else {
            # We have no value and no default to use so bail out here
            $Glade_Perl->diag_print (1, "error No value in supplied ".
                "%s and NO default was supplied in ".
                "%s called from %s line %s",
                "$proto->{'name'}\->{'$key'}", $me, (caller)[0], (caller)[2] );
            return undef;
        }
    } else {
        # We have a value to use
#        $Glade_Perl->diag_print (8, "$indent- Value supplied in ".
#            "proto->{'$key'} was '$self'");
    }
    # We must have some sort of value to use by now
    unless ($request) {
        # Nothing to do, we are already $proto->{$key} so
        # just drop through to undef the supplied prot->{$key}
#        $Glade_Perl->diag_print(8, "I have used par->{'$key'} => '$self' in $me");
        
    } elsif ($request eq $DEFAULT) {
        # Nothing to do, we are already $proto->{$key} (or default) so
        # just drop through to undef the supplied prot->{$key}
#        $Glade_Perl->diag_print(8, "I have converted '$key' from ".
#            ($proto->{$key} || 'undef')." to default ('$self') in $me");
        
    } elsif ($request == $LOOKUP) {
        return '' unless $self;
        
        my $lookup;
        # make an effort to convert from Gtk to Gtk-Perl constant/enum name
        if ($self =~ /^GNOME/) {
            $lookup = Glade::PerlUIExtra->lookup($self);

        } else {
            $lookup = Glade::PerlUIGtk->lookup($self);
        }
        unless ($lookup) {
            if (defined $default) {
                $Glade_Perl->diag_print(2, 
                    "warn  Unable to lookup '%s' using default of '%s'",
                    $self, $default);
                $self = $default;
            } else {
                $Glade_Perl->diag_print(1, 
                    "error Unable to lookup '%s' and no default",
                    $self);
            }
        } else {
            $self = $lookup;
        }
            
#        $Glade_Perl->diag_print(8, "$indent- I have converted '$key' from '".
#            ($proto->{$key} || $default)."' to '$self' (LOOKUP) in $me");

    } elsif ($request == $BOOL) {
        # Now convert whatever we have ended up with to a BOOL
        # undef becomes 0 (== false)
        $type = $self;
        $self = ('*true*y*yes*on*1*' =~ m/\*$self\*/i) ? '1' : '0';
#        $Glade_Perl->diag_print(8, "$indent- I have converted proto->{'$key'} ".
#            "from '$type' to $self (BOOL) in $me");

    } elsif ($request == $KEYSYM) {
        $self =~ s/GDK_//;
## If you have an old version of Gtk-Perl that doesn't have Gtk::Keysyms
## use the next line instead of the Gtk::Keysyms{$self} line below it