view release on metacpan or  search on metacpan

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);
            }

#---------------------------------------