package Glade::PerlUI;
require 5.000; use strict 'vars', 'refs', 'subs';

# Copyright (c) 1999 Dermot Musgrove <dermot.musgrove@virgin.net>
#
# This library is released under the same conditions as Perl, that
# is, either of the following:
#
# a) the GNU General Public License as published by the Free
# Software Foundation; either version 1, or (at your option) any
# later version.
#
# b) the Artistic License.
#
# If you use this library in a commercial enterprise, you are invited,
# but not required, to pay what you feel is a reasonable fee to the
# author, who can be contacted at dermot.musgrove@virgin.net

BEGIN {
    use UNIVERSAL         qw( can );          # in lots of subs
    use Gtk               qw(  );             # Everywhere
# Comment out the line below if you have a really old version of Gtk-Perl
    use Gtk::Keysyms;
    use Glade::PerlSource qw( :VARS :METHODS );
    use Glade::PerlUIGtk  qw( :VARS );;
    use Glade::PerlUIExtra;
    use vars              qw( 
        @ISA 
        @EXPORT @EXPORT_OK %EXPORT_TAGS 
        $PACKAGE
        $VERSION
        @VARS @METHODS

        $gnome_libs_depends
        $perl_gtk_depends
        $concept_widgets
        $ignore_widgets
        $ignored_widgets
        $missing_widgets
        $cxx_properties
        );
    $PACKAGE =          __PACKAGE__;
    $VERSION        = q(0.54);

    $ignored_widgets = 0;
    $missing_widgets = 0;
    @METHODS =          qw(  );
    @VARS =             qw(
        $gnome_libs_depends
        $perl_gtk_depends
        $concept_widgets
        $ignore_widgets
        $ignored_widgets
        $missing_widgets
        $cxx_properties
        );
    # Tell interpreter who we are inheriting from
    @ISA            =   qw( Glade::PerlUIGtk Glade::PerlUIExtra );
    # These symbols (globals and functions) are always exported
    @EXPORT         =   qw(  );
    # Optionally exported package symbols (globals and functions)
    @EXPORT_OK    = ( @METHODS, @VARS );
    # Tags (groups of symbols) to export		
    %EXPORT_TAGS  = (
                        'METHODS' => [@METHODS] , 
                        'VARS'    => [@VARS]    
                    );
}

#===============================================================================
#=========== Constants and globals                                          ====
#===============================================================================
$ignore_widgets         = join (' ', 
    'Placeholder',
    'Custom',
    );
$cxx_properties    = join(' ',
    'cxx_separate_class',
    'cxx_separate_file',
    'cxx_use_heap',
    'cxx_visibility',
    );
my $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_libs_depends     = { 
    'MINIMUM REQUIREMENTS' => '1.0.08',
    'gtk_clock_new'         => '1.0.16',
    'GnomeDruid'            => '1.0.50',
    'GnomeDruidPageFinish'  => '1.0.50',
    'GnomeDruidPageStandard'=> '1.0.50',
    'GnomeDruidPageStart'   => '1.0.50',
    };
$perl_gtk_depends       = { 
    '0.6123'                => '19990818',
    '0.7000'                => '20000102',
    '0.7001'                => '20000123',
    '0.7002'                => '20000129',

#    'MINIMUM REQUIREMENTS'  => '0.7000',
    'MINIMUM REQUIREMENTS'  => '0.6123',
    'LATEST_CPAN'           => '0.7002',
    'LATEST_CVS'            => '20000414',
    # Those below don't work yet even in the latest CVS version
    'gtk_pixmap_menu_item'  => '20000410',
    # Those below work in the CVS version after 20000301
    'gnome_dialog_append_button' => '20000301',
    # Those below work in the CPAN version after 0.7002 (CVS after 20000129)
    'Gnome::UIInfo'     => '0.7002',
    # Those below work in the CPAN version after 0.7000 (CVS after 20000102)
    'Gtk::Packer->expand'=> '0.7000',
    # Those below work in the CVS version after 19991107
    'GnomeDruidPageStandard::vbox'
                        => '19991107',
    # Those below work in the CVS version after 19991025
    'GnomeDruid'        => '19991025',
    # Those below work in the CVS version after 19991001
    'gnome_iconlist_new_undef'  => '19991001',
    'gnome_stock_pixmap_widget' => '19991001',
    'gnome_stock_button' => '19991001',
    'gtk_colorselectiondialog_ok_button->child' => '19991001',
     # Those below work in the CVS version after 19990922
    'gnome_app_enable_layout_config'   => '19990922',
    'gtk_layout_undef'  => '19990922',
    'gtk_pixmap_set_build_insensitive' => '19990922',
     # Those below work in the CVS version after 19990920
    'GnomeApp'          => '19990920',
    'GnomeIconList'     => '19990920',
    'GnomeIconSelection'=> '19990920',
    'GnomeMessageBox'   => '19990920',
    'GnomePropertyBox'  => '19990920',
     # Those below work in the CVS version after 19990914
    'gdk_pixmap_colormap_create_from_xpm'       => '19990914',
    'GnomeAppBar'       => '19990914',
    'GnomeDock'         => '19990914',
    'GnomeDockItem'     => '19990914',
    'GnomeSpell'        => '19990914',
    'GnomeStock'        => '19990914',
    'GtkCalendar'       => '19990914',
    };
my $dialogs             = join(' ',
    'Gnome::About',
    'Gnome::App',
    'Gnome::Dialog',
    'Gnome::MessageBox',
    'Gnome::PropertyBox',
    'Gtk::ColorSelectionDialog',
    'Gtk::Dialog',
    'Gtk::FileSelection',
    'Gtk::FontSelectionDialog',
    'Gtk::InputDialog',
    );
my $composite_widgets   = join(' ',
    'Gnome::Entry',
    'Gnome::FileEntry',
    'Gnome::NumberEntry',
    'Gnome::PixmapEntry',
    'Gtk::Combo',
    );
my $toplevel_widgets    = join(' ',
    'Gnome::About',
    'Gnome::App',
    'Gnome::Dialog',
    'Gnome::MessageBox',
    'Gnome::PropertyBox',
    'Gtk::Dialog',
    'Gtk::InputDialog',
    'Gtk::Window',
    );
#===============================================================================
#=========== Version utilities                                      ============
#===============================================================================
sub my_perl_gtk_can_do {
    my ($class, $action) = @_;
    unless ($perl_gtk_depends->{$action}) { 
        # There is no required version for $action
        return 1;
    }
    my ($cpan, $cvs);
    my $options = $Glade_Perl->{'options'};
    my $check = $action;
    $check = $perl_gtk_depends->{$action};
    $check = $perl_gtk_depends->{$check} if $perl_gtk_depends->{$check};

    if ($check <= $options->my_perl_gtk) {
        # We can do required $action in our version
        return 1;

    } else {
        $cpan = $perl_gtk_depends->{'LATEST_CPAN'};
        $cpan = $perl_gtk_depends->{$cpan} if $perl_gtk_depends->{$cpan};
        if ($check > $cpan) {
            # We need a CVS version
            if ($check > $perl_gtk_depends->{'LATEST_CVS'}) {
                # The CVS version can't even do it yet
                $class->diag_print(1, 
                    "warn  Gtk-Perl dated %s cannot do '%s' (properly)".
                    " and neither can the CVS version !!!",
                $options->my_perl_gtk, $action);
                    
            } else {
                # We need a new CVS version
                $class->diag_print(1, 
                    "warn  Gtk-Perl dated %s cannot do '%s' (properly)".
                    " we need CVS module 'gnome-perl' after %s",
                    $options->my_perl_gtk, $action, $check);
            }

        } else {
            # We need a new CPAN version
            $class->diag_print(1, 
                "warn  Gtk-Perl version %s cannot do '%s' (properly)".
                " we need CPAN version %s or CVS module 'gnome-perl' after %s",
                $options->my_perl_gtk, $action, $perl_gtk_depends->{$action}, $check);
        }
        return undef;
    }
}

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

#===============================================================================
#=========== Utilities to construct UI                              ============
#===============================================================================
sub use_par {
    my ($class, $proto, $key, $request, $default, $dont_undef) = @_;
    my $me = "$class->use_par";
    my $options = $Glade_Perl->{'options'};
    my $type;
    my $self = $proto->{$key};
    unless (defined $self) {
        if (defined $default) {
            $self = $default;
#            $class->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
            $class->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
#        $class->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}
#        $class->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}
#        $class->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) {
                $class->diag_print(2, 
                    "warn  Unable to lookup '%s' using default of '%s'",
                    $self, $default);
                $self = $default;
            } else {
                $class->diag_print(1, 
                    "error Unable to lookup '%s' and no default",
                    $self);
            }
        } else {
            $self = $lookup;
        }
            
#        $class->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';
#        $class->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
#        $self = ord ($self );
        $self = $Gtk::Keysyms{$self};
#        $class->diag_print(8, "$indent- I have converted '$key' from ".
#            ($proto->{$key})." to '$self' (Gtk::Keysyms)in $me");
    } 
    # undef the parameter so that we can report any unused attributes later
    undef $proto->{$key} unless $dont_undef;
    # Backslash escape any single quotes (unless they are already backslashed)
    $self =~ s/(?!\\)(.)'/$1\\'/g;
    return $self;
}

sub Widget_from_Proto {
    my ($class, $parentname, $proto, $depth, $wh, $ch) = @_;
    my $me = "$class->Widget_from_Proto";
#$class->diag_print(2, $forms);
    my $typekey = $class->typeKey;
    my ($name, $widget_hierarchy, $class_hierarchy, $childname, $constructor, $window, $sig );
    my ($key, $dm, $self, $expr, $object, $refself, $packing );
    $parentname ||= "Top level application";
    if ($depth) {
        # We are a widget of some sort (toplevel window or child)
        unless ($proto->{name}) {
            $class->diag_print (2, 
                "You have supplied a proto without a name to %s", $me);
            $class->diag_print (2, $proto);
        } else {
            $name = $proto->{name};
        }
        if ($depth == 1) {
            $forms->{$name} = {};
            # We are a toplevel window so create a new hash and 
            # set $current_form with its name
            # All these back-slashes are really necessary as this string
            # is passed through so many others
            $current_form_name = "$name-\\\\\\\$instance";
            $current_form = "\$forms->{'$name'}";
            $current_data = "\$data->{'$name'}\{__DATA}";
            $current_name = $name;
            $current_window = "\$forms->{'$name'}\{'$name'}";
            $first_form ||= $name;

            if ($Glade_Perl->{'options'}->hierarchy =~ /^(widget|both)/) {
                $widget_hierarchy = "\$forms->{'$name'}{__WH}";
            }
            if ($Glade_Perl->{'options'}->hierarchy =~ /^(class|both)/) {
                $class_hierarchy = "\$forms->{'$name'}{__CH}";
            }

        } else {
            $widget_hierarchy = "$wh\{'$name'}" if $wh;
            $class_hierarchy  = "$ch\{'$proto->{class}'}{'$name'}" if $ch; 
        }
        $class->add_to_UI( $depth,  "#" );
        $class->add_to_UI( $depth,  "# ".S_("Construct a").
            " $proto->{class} '$name'");
        $constructor = "new_$proto->{class}";
        if ($class->can($constructor)) {
            # Construct the widget
            $expr =  "\$widgets->{'$name'} = ".
                "$class->$constructor('$parentname', \$proto, $depth );";
            eval $expr or 
                ($@ && die  "\nin $me\n\t".("while trying to eval").
                    " '$expr'\n\t".("FAILED with Eval error")." '$@'\n" );
            if ($widget_hierarchy) {
                # Add to form widget hierarchy
                $class->add_to_UI( $depth,  
                    "$widget_hierarchy\{__W} = $current_form\{'$name'};" );
#                    "\$class->W($widget_hierarchy, $current_form\{'$name'});" );
                if ($Glade_Perl->{'options'}->hierarchy =~ /order/) {
                    if ($depth > 1) {
                        $class->add_to_UI( $depth,  
                            "push \@{$wh\{__C}}, $current_form\{'$name'};" );
#                            "\$class->C($wh, $current_form\{'$name'});" );
                    }
                }
            }
            if ($class_hierarchy) {
                # Add to form class hierarchy
                $class->add_to_UI( $depth,  
                    "$class_hierarchy\{__W} = $current_form\{'$name'};" );
#                    "\$class->W($class_hierarchy, $current_form\{'$name'});" );
                if ($Glade_Perl->{'options'}->hierarchy =~ /order/) {
                    if ($depth > 1) {
                        $class->add_to_UI( $depth,  
                            "push \@{$ch\{__C}}, $current_form\{'$name'};" );
#                            "\$class->C($ch, $current_form\{'$name'});" );
                    }
                }
            }
        } else {
            die ("error")." $me\n\t".sprintf(
                ("I don't have a constructor called '%s'".
                "- I guess that it isn't written yet :-)\n"),
                "$class->$constructor");
        }
    } else {
        # We are a complete GTK-Interface - ie we are the application
        unless ($Glade_Perl->{'options'}->allow_gnome) {
            $ignore_widgets .= " $gnome_widgets";
        }
    }
    $self = $widgets->{$proto->{name}};
    $refself = ref $self;
    foreach $key (sort keys %{$proto}) {
        # Iterate through keys looking for sub widgets
        if (ref $proto->{$key} eq 'HASH') {
            # this is a ref to a sub hash so expand it
            $object = $proto->{$key}{$typekey};
            if ($object) {
                if ( $object eq 'widget') {
                    if ($class->my_perl_gtk_can_do($proto->{$key}{'class'})) {
                        unless (" $ignore_widgets " =~ / $proto->{$key}{'class'} /) {
                            # This is a real widget subhash so recurse to expand
                            $childname = $class->Widget_from_Proto( 
                                $proto->{name}, $proto->{$key}, $depth + 1, 
                                $widget_hierarchy, $class_hierarchy );
                            $class->set_child_packing(
                                $proto->{name}, $childname, $proto->{$key}, $depth+1 );
                            if ($class->diagnostics) {
                                # Check that we have used all widget properties
                                $class->check_for_unused_elements($proto->{$key} );
                            }

                        } else {
                            unless (" $gnome_widgets " =~ / $proto->{$key}{'class'} /) {
                                $class->diag_print(4, 
                                    "warn  %s widget ignored in %s", 
                                    $proto->{$key}{'class'}, $me);
                            } else {
                                $class->diag_print(1, "error %s widget ignored in %s", 
                                $proto->{$key}{'class'}, $me);
                            }
                            $ignored_widgets++;
                        }
                    }

                } elsif ($object eq 'signal') {
                    # we are a SIGNAL
                    $class->new_signal(
                        $proto->{name}, $proto->{$key}, $depth );

                } elsif ($object eq 'accelerator') {
                    # we are an ACCELERATOR
                    $class->new_accelerator(
                        $proto->{name}, $proto->{$key}, $depth );

                } elsif ($object eq 'style') {
                    # Perhaps should be in set_widget_properties
                    if ($current_form) {
                        $class->new_style(
                            $proto->{name}, $proto->{$key}, $depth );
                    }

                } elsif ($object eq 'project') {
                    # We rely on this appearing before the rest of the proto
                    # so that we know which files to write (if needed)
                    # It was dealt with in new_from_Glade so just ignore it

                } elsif ($object eq 'child') {
                    # Already dealt with above so just ignore it

                } else {
                    # I don't recognise it so do nothing but report it
                    $class->diag_print (1, "error Object '%s' not recognised ".
                        "or processed for %s '%s' by %s",
                        $object, $proto->{'class'}, $proto->{name}, $me);
                    $class->diag_print(1, $proto);
                }

#            } else {
#                # I don't recognise it so do nothing but report it
#                $class->diag_print (1, "error Undefined object for %s '%s' by $s".
#                    $proto->{'class'}, '$proto->{name}', $me );
#                $class->diag_print(1, $proto);
            }
        } elsif (ref $proto->{$key} eq 'ARRAY') {
            # We are a new type array of widgets so construct each in order
        }
    }
#================== Check this and TIDY it up
    if ($depth == 1) {
        # We are a toplevel window so now connect all signals
        if (eval "scalar(\@{${current_form}\{Signal_Strings}})") {
            # We have some signals to connect
            $class->add_to_UI( $depth,  "#" );
            $class->add_to_UI( $depth,  
                "# ".S_("Connect all signals now that widgets are constructed" ));
            $expr = "foreach \$sig (\@{${current_form}\{Signal_Strings}}) {
                eval \$sig;
            }";
            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
        $class->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 ('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 {
                $class->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 {
                $class->diag_print (1, 
                    "error I don't know what to do with %s element %s".
                    $refpar, $child_type);
            }

#---------------------------------------
        } elsif (' Gtk::Layout ' =~ m/ $refpar /) {
#            $class->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 ' =~ 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'}]) {
                    $class->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->diag_print(2, $proto);
                $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 /) {
#            $class->diag_print(2, $proto);
#            $class->diag_print(2, $proto->{'child'});
            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) {
                if ($class->my_perl_gtk_can_do('Gtk::Packer->expand')) {
                    $options .= "'expand', ";
                } else {
                    $options .= "'pack_expand', ";
                }
            }
            $xfill  && ($options .= "'fill_x', ");
            $yfill  && ($options .= "'fill_y', ");
            $options =~ s/, $//;
            if ($options) {$options = "[$options]";} else {$options = "[]";}
            if ($use_default) {
                $class->add_to_UI( $depth, 
                    "${current_form}\{'$parentname'}->add_defaults(".
                        "\$widgets->{'$childname'}, ".
                        "'$side', '$anchor', $options);" );
            } else {
                my $border_width = $class->use_par($proto->{'child'}, 'border_width', $DEFAULT, 0, 'DONT_UNDEF');
                my $xipad   = $class->use_par($proto->{'child'}, 'xipad',  $DEFAULT, 0, 'DONT_UNDEF');
                my $xpad    = $class->use_par($proto->{'child'}, 'xpad',   $DEFAULT, 0, 'DONT_UNDEF');
                my $yipad   = $class->use_par($proto->{'child'}, 'yipad',  $DEFAULT, 0, 'DONT_UNDEF');
                my $ypad    = $class->use_par($proto->{'child'}, 'ypad',   $DEFAULT, 0, 'DONT_UNDEF');
                $class->add_to_UI( $depth, 
                    "${current_form}\{'$parentname'}->add(".
                        "\$widgets->{'$childname'}, ".
                        "'$side', '$anchor', $options, $border_width, ".
                        "$xpad, $ypad, $xipad, $yipad);" );
            }
                      
#---------------------------------------
        } elsif (' Gtk::ScrolledWindow ' =~ m/ $refpar /) {
            if (' Gtk::CList Gtk::CTree Gtk::Text ' =~ m/ $refwid /) {
                # These handle their own scrolling and
                # Ctree/CList column labels stay fixed
                $class->add_to_UI( $depth, 
                    "${current_form}\{'$parentname'}->add(".
                        "\$widgets->{'$childname'} );" );

            } else {
                $class->add_to_UI( $depth, 
                    "${current_form}\{'$parentname'}->add_with_viewport(".
                        "\$widgets->{'$childname'} );" );
            }
            
#---------------------------------------
        } elsif (' Gtk::Table ' =~ m/ $refpar /) {
            # We are adding to a table so do the child packing
            my $left_attach =   $class->use_par($proto->{'child'}, 'left_attach'   );
            my $right_attach =  $class->use_par($proto->{'child'}, 'right_attach'  );
            my $top_attach =    $class->use_par($proto->{'child'}, 'top_attach'    );
            my $bottom_attach = $class->use_par($proto->{'child'}, 'bottom_attach' );

            my (@xoptions, @yoptions);
            my ($xoptions, $yoptions);
            push @xoptions, 'expand' if $class->use_par($proto->{'child'}, 'xexpand', $BOOL, 'True' );
            push @xoptions, 'fill'   if $class->use_par($proto->{'child'}, 'xfill',   $BOOL, 'True' );
            push @xoptions, 'shrink' if $class->use_par($proto->{'child'}, 'xshrink', $BOOL, 'False');
            push @yoptions, 'expand' if $class->use_par($proto->{'child'}, 'yexpand', $BOOL, 'True' );
            push @yoptions, 'fill'   if $class->use_par($proto->{'child'}, 'yfill',   $BOOL, 'True' );
            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 /)) {
                $class->diag_print (1, 
                    "warn  Toolbar '%s' is expecting ".
                    "a tooltip but you have not set one for %s '%s'",
                    $parentname, $refwid, $childname);
            }            
#use Data::Dumper;print Dumper($proto);
             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 {
                $class->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 /) {
            # We use a dialog->method to get a ref to our widget
#            my $ignore = $class->use_par($proto, 'label', $DEFAULT,  '' );
            my $type =  $class->use_par($proto, 'child_name' );
            $type =~ s/.*:(.*)/$1/;
            $class->add_to_UI( $depth, "\$widgets->{'$childname'} = ".
                "${current_form}\{'$parentname'}->$type;" );

#---------------------------------------
        } else {
            # We are not a special case
            $class->add_to_UI( $depth, "${current_form}\{'$parentname'}->add(".
                "\$widgets->{'$childname'} );" );
        }
    }
    unless ($postpone_show || !$class->use_par($proto, 'visible', $BOOL, 'True') ) {
#        $class->add_to_UI($depth, "\$widgets->{'$childname'}->realize( );" );
        $class->add_to_UI($depth, "\$widgets->{'$childname'}->show;" );
    }
# FINDME This is to remove
    $class->add_to_UI( $depth, 
        "${current_form}\{'$childname'} = \$widgets->{'$childname'};" );

    # Delete the $widget to show that it has been packed
    delete $widgets->{$childname};

    return;
}

sub set_child_packing {
    my ($class, $parentname, $childname, $proto, $depth) = @_;
    my $me = "$class->set_child_packing";
    if ($proto->{'child'} && eval "${current_form}\{'$parentname'}->can("."
        'set_child_packing')") {
        my ($refpar, $refwid);
        eval "\$refpar = ref ${current_form}\{'$parentname'}";
        eval "\$refwid = ref ${current_form}\{'$childname'}";
        unless (' Gtk::Packer ' =~ / $refpar /) {
            my $expand =   $class->use_par( $proto->{'child'}, 
                'expand', $BOOL, 'False' );
            my $fill =     $class->use_par( $proto->{'child'}, 
                'fill', $BOOL, 'True' );
            my $padding =  $class->use_par( $proto->{'child'}, 
                'padding', $BOOL, 'False' );
            my $pack =        $class->use_par( $proto->{'child'}, 
                'pack', $LOOKUP, 'start' );
            $class->add_to_UI( $depth,  
                "${current_form}\{'$parentname'}->set_child_packing(".
                    "${current_form}\{'$childname'}, ".
                    "$expand, $fill, $padding, '$pack' );" );
        }
    }
}

sub set_tooltip {
    my ($class, $parentname, $proto, $depth) = @_;
    my $me = "$class->set_tooltip";
    my $tooltip = $class->use_par($proto, 'tooltip', $DEFAULT, '');
    
# FIXME What do we do if tooltip is '' - set or not ?
    if ($tooltip ne '') {
        $class->add_to_UI( $depth, "${current_form}\{'tooltips'}->set_tip(".
            "${current_form}\{'$parentname'}, _('$tooltip' ));" );

    } elsif (!defined $proto->{name}) {
        $class->diag_print (1, 
            "error Could not set tooltip for unnamed %s", $proto->{'class'});

    } else {
        $class->diag_print(6, 
            "warn  No tooltip specified for widget '%s'", $proto->{name});
    }    
}

sub set_container_properties {
    my ($class, $parent, $name, $proto, $depth) = @_;
    my $me = "$class->set_container_properties";
    if ($proto->{'border_width'}) {
        if (eval "$current_form\{'$name'}->can('border_width')") {
            my $border_width  = $class->use_par($proto, 'border_width', $DEFAULT, 0);
            $class->add_to_UI( $depth, "$current_form\{'$name'}->border_width(".
                "$border_width );" );
        }
    }
}

sub set_range_properties {
    my ($class, $parent, $name, $proto, $depth) = @_;
    my $me = "$class->set_range_properties";
# FIXME - call this from range type widgets
# For use by HScale, VScale, HScrollbar, VScrollbar
#    my $name = $proto->{name};
    my $hvalue     = $class->use_par($proto, 'hvalue',     $DEFAULT, 0 );
    my $hlower     = $class->use_par($proto, 'hlower',     $DEFAULT, 0 );
    my $hupper     = $class->use_par($proto, 'hupper',     $DEFAULT, 0 );
    my $hstep      = $class->use_par($proto, 'hstep',      $DEFAULT, 0 );
    my $hpage      = $class->use_par($proto, 'hpage',      $DEFAULT, 0 );
    my $hpage_size = $class->use_par($proto, 'hpage_size', $DEFAULT, 0 );
    my $policy     = $class->use_par($proto, 'policy',     $LOOKUP );

    $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_update_policy(".
        "'$policy' );" );
}

sub set_misc_properties {
    my ($class, $parent, $name, $proto, $depth) = @_;
    my $me = "$class->set_alignment";
    # For use by Arrow, Image, Label, (TipsQuery), Pixmap
#    $class->diag_print(8, "Setting misc properties for '$name'");
    # Cater for all the usual properties (defaults not stored in XML file)
    return unless ($proto->{'xalign'} || $proto->{'yalign'} || $proto->{'xpad'} || $proto->{'ypad'});
    my $xalign = $class->use_par($proto, 'xalign', $DEFAULT, 0 );
    my $yalign = $class->use_par($proto, 'yalign', $DEFAULT, 0 );
    my $xpad   = $class->use_par($proto, 'xpad',   $DEFAULT, 0 );
    my $ypad   = $class->use_par($proto, 'ypad',   $DEFAULT, 0 );

    if ($xalign || $yalign) {
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->set_alignment(".
            "$xalign, $yalign );" );
    }
    if ($xpad || $ypad) {
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->set_padding(".
            "$xpad, $ypad );" );
    }
# FIXME - handle padding (width & height) properly
}

sub set_widget_properties {
    my ($class, $parent, $name, $proto, $depth) = @_;
    my $me = "$class->set_widget_properties";
    # For use by all widgets
    # Cater for all the usual properties (defaults not stored in XML file)
    my $can_default = $class->use_par($proto, 'can_default',$BOOL,      'False' );
    my $has_default = $class->use_par($proto, 'has_default',$BOOL,      'False' );
    my $can_focus   = $class->use_par($proto, 'can_focus',  $BOOL,      'False' );
    my $has_focus   = $class->use_par($proto, 'has_focus',  $BOOL,      'False' );
    my $extension_events = $class->use_par($proto, 'extension_events', $LOOKUP, '' );
    my $events      = $class->use_par($proto, 'events',     $DEFAULT,   0       );
    my ($work, @events);
    foreach $work (split(/\|/, $events)) {
        $work =~ s/\s*//g; # Trim off any whitespace
        $work = Glade::PerlUIGtk->lookup($work);
        push @events, $work;
    }
    $events = '';
    $events = join("', '", @events) if $#events >= 0;

    if ( (defined $proto->{'x'}) || (defined $proto->{'y'}) ) {
        my $x = $class->use_par($proto, 'x',  $DEFAULT, 0 );
        my $y = $class->use_par($proto, 'y',  $DEFAULT, 0 );
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->set_uposition(".
            "$x, $y );" );
    }
    if ( (defined $proto->{'width'}) || (defined $proto->{'height'}) ) {
        my $width  = $class->use_par($proto, 'width',  $DEFAULT, 0 );
        my $height = $class->use_par($proto, 'height', $DEFAULT, 0 );
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->set_usize(".
            "$width, $height );" );
    }
    if ( $proto->{'sensitive'} ) {
        my $sensitive = $class->use_par($proto, 'sensitive', $BOOL, 'True'  );
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->set_sensitive($sensitive);");
    }

    if ( $can_default ) {
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->can_default(".
            "$can_default );" );
    }
    if ( $can_focus ) {
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->can_focus(".
            "$can_focus );" );
    }
    if ($has_default) {
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->has_default(".
            "$has_default );" );
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->grab_default;");
    }
    if ( $has_focus ) {
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->has_focus(".
            "$has_focus );" );
    }
    if ( $extension_events ) {
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->set_extension_events(".
            "'$extension_events' );" );
    }
    if ( $events ) {
        $class->add_to_UI( $depth, "${current_form}\{'$name'}->set_events(".
            "['$events'] );" );
    }
}

sub set_window_properties {
    my ($class, $parent, $name, $proto, $depth) = @_;
    my $me = "$class->set_window_properties";
# For use by Window, (ColorSelectionDialog, Dialog (InputDialog), FileSelection)
    my $title        = $class->use_par($proto,'title',        $DEFAULT, '' );
    my $position     = $class->use_par($proto,'position',     $LOOKUP,  'mouse' );
    my $allow_grow   = $class->use_par($proto,'allow_grow',   $BOOL,    'True' );
    my $allow_shrink = $class->use_par($proto,'allow_shrink', $BOOL,    'True' );
    my $auto_shrink  = $class->use_par($proto,'auto_shrink',  $BOOL,    'False' );
    my $modal        = $class->use_par($proto,'modal',        $BOOL,    'False' );
    my $wmclass_name  = $class->use_par($proto, 'wmclass_name',  $DEFAULT, '' );
    my $wmclass_class = $class->use_par($proto, 'wmclass_class', $DEFAULT, '' );

    $class->add_to_UI( $depth, "\$widgets->{'$name'}->position('$position' );" );
    $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_policy(".
        "$allow_shrink, $allow_grow, $auto_shrink );" );
#    $class->add_to_UI( $depth, "\$widgets->{'$name'}->allow_shrink('$allow_shrink' );" );
#    $class->add_to_UI( $depth, "\$widgets->{'$name'}->allow_grow('$allow_grow' );" );
#    $class->add_to_UI( $depth, "\$widgets->{'$name'}->auto_shrink('$auto_shrink' );" );
    $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_modal($modal );" );
    if ( (defined $proto->{'width'}) || (defined $proto->{'height'}) ) {
        my $width  = $class->use_par($proto, 'width',  $DEFAULT, 0 );
        my $height = $class->use_par($proto, 'height', $DEFAULT, 0 );
        $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_usize(".
            "$width, $height );" );
    }
    if ( (defined $proto->{'default_width'}) || (defined $proto->{'default_height'}) ) {
        my $default_width  = $class->use_par($proto, 'default_width',  $DEFAULT, 0 );
        my $default_height = $class->use_par($proto, 'default_height', $DEFAULT, 0 );
        $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_default_size(".
            "$default_width, $default_height );" );
    }
    if ( (defined $proto->{'x'}) || (defined $proto->{'y'}) ) {
        my $x = $class->use_par($proto, 'x',  $DEFAULT, 0 );
        my $y = $class->use_par($proto, 'y',  $DEFAULT, 0 );
        $class->diag_print(1, "warn  Toplevel window uposition has been set ".
            "but breaks the window manager's placement policy, and is almost ".
            "certainly a bad idea. (Havoc Pennington)");
        $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_uposition(".
            "$x, $y );" );
    }
    if ($wmclass_name && $wmclass_class) {
        $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_wmclass(".
            "'$wmclass_name', '$wmclass_class' );" );
    }
    $class->add_to_UI( $depth,  "\$widgets->{'$name'}->realize;" );

	$widgets->{$name}->signal_connect("destroy" => \&Gtk::main_quit);
	$widgets->{$name}->signal_connect("delete_event" => \&Gtk::main_exit);

    $class->pack_widget($parent, $name, $proto, $depth );
}

sub pack_widget {
    my ($class, $parent, $name, $proto, $depth) = @_;
    my $me = "$class->pack_widget";

    $class->internal_pack_widget($parent, $name, $proto, $depth );
    $class->set_widget_properties($parent, $name, $proto, $depth);
    $class->set_container_properties($parent, $name, $proto, $depth);
    $class->set_tooltip($name, $proto, $depth );
}

sub new_accelerator {
    my ($class, $parentname, $proto, $depth, $gnome_frig) = @_;
    my $me = "$class->new_accelerator";
    my $mods = '[]';
    my $accel_flags = "['visible', 'locked']";
    my $key       = $class->use_par($proto, 'key',          $KEYSYM );
    my $modifiers = $class->use_par($proto, 'modifiers',    $DEFAULT, 0);
    my $signal    = $class->use_par($proto, 'signal');
    unless (defined $need_handlers->{$parentname}{$signal}) {
        $need_handlers->{$parentname}{$signal} = undef;
    }

# FIXME move this to use_par
#--------------------------------------
    # Turn GDK values into array of $LOOKUPs
    unless ($modifiers eq 0) {
        $modifiers =~ s/ *//g;
        $modifiers =~ s/GDK_//g;
        $mods = "['".lc(join ("', '", split(/\|/, $modifiers)))."']";
    }
#--------------------------------------

#  gtk_widget_add_accelerator (accellabel3, "button_press_event", accel_group,
#                              GDK_L, GDK_MOD1_MASK,
#                              GTK_ACCEL_VISIBLE);
#    $class->add_to_UI( $depth, "${current_form}\{'$parentname'}->add_accelerator(".
#        "'$signal', ${current_form}\{'accelgroup'}, '$key', $mods, $accel_flags);");

    if ($gnome_frig) {
        $class->add_to_UI( $depth, 
            "${current_window}\->set_accelerator(".
                "$gnome_frig, $key, $mods);");
    
    } elsif (eval "${current_form}\{'$parentname'}->can('$signal')") {
        $class->add_to_UI( $depth, "${current_form}\{'accelgroup'}->add(".
            "$key, $mods, $accel_flags, ".
            "${current_form}\{'$parentname'}, '$signal');");
    } else {
        $class->diag_print (1, "error Widget '%s' can't emit signal ".
            "'%s' as requested - what's wrong?",
            $parentname, $signal);
    }
}

sub new_style {
    my ($class, $parentname, $proto, $depth) = @_;
    my $me = "$class->new_style";
#    $class->diag_print(2, $proto);
    my ($state, $color, $value, $element, $lc_state);
    my ($red, $green, $blue);
    $class->add_to_UI( $depth, "$current_form\{'$parentname-style'} = ".
        "new Gtk::Style;");
#    $class->add_to_UI( $depth, "$current_form\{'$parentname-style'} = ".
#       "$current_form\{'$parentname'}->style;");
    my $style_font = $class->use_par($proto, 'style_font', $DEFAULT, '');
    if ($style_font) {
        $class->add_to_UI( $depth, "$current_form\{'$parentname-style'}".
            "->font(Gtk::Gdk::Font->load('$style_font'));");
    }
    foreach $state ("NORMAL", "ACTIVE", "PRELIGHT", "SELECTED", "INSENSITIVE") {
        $lc_state = lc($state);
        foreach $color ('fg', 'bg', 'text', 'base') {
            $element = "$color-$state";
            if ($proto->{$element}) {
                $value = $class->use_par($proto, $element, $DEFAULT, '');
                $class->diag_print(6, "%s- We have a style element ".
                    "'%s' which is '%s'", $indent, $element, $value);
                ($red, $green, $blue) = split(',', $value);
                # Yes I really mean multiply by 257 (0x101)
                # We scale these so that 0x00 -> 0x0000
                #                        0x0c -> 0x0c0c
                #                        0xff -> 0xffff
                # This spreads the values 0x00 - 0xff throughout the possible 
                # Gdk values of 0x0000 - 0xffff rather than 0x00 - 0xff00
                $red   *= 257;
                $green *= 257;
                $blue  *= 257;
                $class->add_to_UI( $depth, "$current_form\{'$parentname-$color-$lc_state'} ".
                    "= $current_form\{'$parentname-style'}->$color('$lc_state');");
                $class->add_to_UI( $depth, "$current_form\{'$parentname-$color-$lc_state'}".
                    "->red($red);");
                $class->add_to_UI( $depth, "$current_form\{'$parentname-$color-$lc_state'}".
                    "->green($green);");                
                $class->add_to_UI( $depth, "$current_form\{'$parentname-$color-$lc_state'}".
                    "->blue($blue);");                
                $class->add_to_UI( $depth, "$current_form\{'$parentname-style'}".
                    "->$color('$lc_state', $current_form\{'$parentname-$color-$lc_state'});");
            }
        }
        $element = "bg_pixmap-${state}";
        if ($proto->{$element}) {
        	$class->add_to_UI( $depth, "($current_form\{'$parentname-bg_pixmap-$lc_state'}, ".
                "$current_form\{'$parentname-bg_mask-$lc_state'}) = ".
                    "Gtk::Gdk::Pixmap->create_from_xpm($current_window->get_toplevel->window, ".
                        "$current_form\{'$parentname-style'}, '$proto->{$element}' );");
            $class->add_to_UI( $depth, "$current_form\{'$parentname-style'}".
                "->bg_pixmap('$lc_state', $current_form\{'$parentname-bg_pixmap-$lc_state'});");
        }
    }
    if (eval "$current_form\{'$parentname'}->can('child')") {
        $class->add_to_UI( $depth, "$current_form\{'$parentname'}->child->set_style(".
            "$current_form\{'$parentname-style'});");
    }
    $class->add_to_UI( $depth, "$current_form\{'$parentname'}->set_style(".
            "$current_form\{'$parentname-style'});");
}

sub new_from_child_name {
    my ($class, $parent, $name, $proto, $depth) = @_;
    return undef unless $proto->{'child_name'};

    my $type = $class->use_par($proto, 'child_name' );
    if ($type eq 'GnomeEntry:entry') {
        $type = 'gtk_entry';
#        $type =~ s/.*:(.*)/gtk_$1/;

    } elsif ($type eq 'GnomePixmapEntry:file-entry') {
        $type = 'gnome_file_entry';

    } elsif (' Toolbar:button GnomeDock:contents GnomeDruidPageStandard:vbox Dialog:action_area Dialog:vbox ' =~ m/ $type /) {
        # Keep the full child_name for later use

    } else {
        # Just use the bit after the colon
        $type =~ s/.*:(.*)/$1/;

    }
#---------------------------------------
    if ($type eq 'action_area') {
        # Gtk|Gnome::Dialog have widget tree that is not reflected by
        # the methods that access them. $dialog->action_area() points to
        # a child of $dialog->vbox() and not of $dialog. 
        # In any case, they cannot be used/accessed until something is 
        # added to them by the automagic ->new('title', 'Button_Ok',...).
        #
        # For Gnome::Dialog and derivatives we can use ->append_button() 
        # (which calls gnome_dialog_init_action_area)
        if (!$class->my_perl_gtk_can_do('gnome_dialog_append_button')) {
            # Force HButtonbox to construct its widget and add it to the VBox 
            # This will look wrong (above the separator)
            return undef;
        
        } else {
            # Append the buttons by name
#                            $childname = $class->Widget_from_Proto( $proto->{name}, 
#                                $proto->{$key}, $depth + 1, 
#                                $widget_hierarchy, $class_hierarchy );
            my $number_of_buttons = 
                $class->frig_Gnome_Dialog_buttons($parent, $proto, $depth);
            # Return the action_area now it exists
            $class->add_to_UI( $depth, 
                "\$widgets->{'$name'} = ${current_window}->$type;" );
        }
        
#---------------------------------------
    } elsif (' Dialog:action_area Dialog:vbox ' =~ / $type /) {
        $type =~ s/.*:(.*)/$1/;
        # Return the action_area now it exists
        $class->add_to_UI( $depth, 
            "\$widgets->{'$name'} = ${current_window}->$type;" );

#---------------------------------------
    } elsif ($type eq 'Toolbar:button') {
        my $pixmap_widget_name = 'undef';
        my ($group, $rb_group, $use_group);
        my $label   = $class->use_par($proto, 'label', $DEFAULT, '');
        my $icon    = $class->use_par($proto, 'icon',  $DEFAULT, '' );
#        my $stock_button = $class->use_par($proto, 'stock_button',  $LOOKUP, '' );

        my $tooltip = $class->use_par($proto, 'tooltip',       $DEFAULT, '' );
        if (eval "$current_form\{'$parent'}{'tooltips'}" && !$tooltip) {
            $class->diag_print (1, "warn  Toolbar '%s' is expecting ".
                "a tooltip but you have not set one for %s '%s'",
                $parent, $proto->{'class'}, $name);
        }            

        my $new_group = $class->use_par($proto->{'child'}, 'new_group', $BOOL, 0 );
        if ($new_group) {
            $class->add_to_UI( $depth, 
                "${current_form}\{'$parent'}->append_space;" );
        }

        if ($icon) {
            $pixmap_widget_name = "${current_form}\{'${name}-pixmap'}";
#            $icon = $class->full_Path( 
#                $icon, $Glade_Perl->pixmaps_directory );
            $class->add_to_UI( $depth, 
                "$pixmap_widget_name = \$class->create_pixmap(".
                    "${current_window}, \"\$Glade::PerlRun::pixmaps_directory/$icon\" );" ); 

        } elsif ($proto->{'stock_pixmap'}) {
            my $stock_pixmap = $class->use_par($proto, 'stock_pixmap',  $LOOKUP, '' );
            if ($Glade_Perl->{'options'}->allow_gnome) {
                $pixmap_widget_name = "${current_form}\{'${name}-pixmap'}";
                if ($class->my_perl_gtk_can_do('gnome_stock_pixmap_widget')) {
                    $class->add_to_UI( $depth, 
                        "$pixmap_widget_name = Gnome::Stock->pixmap_widget(".
                            "$current_window, '$stock_pixmap');" ); 
                } else {
                    $class->add_to_UI( $depth, 
                        "$pixmap_widget_name = Gnome::Stock->new_with_icon(".
                            "'$stock_pixmap');" ); 
                }

            } else {
                $class->diag_print(1, "error You have specified a Gnome stock ".
                    "pixmap but this is not a Gnome project - stock pixmap omitted");
                $pixmap_widget_name = "undef";
            }

        } else {
            $pixmap_widget_name = "undef";
        }

        # We have label and so on to add
        if ($proto->{'class'} eq 'GtkToggleButton') {
            $type = 'togglebutton';

        } elsif ($proto->{'class'} eq 'GtkRadioButton') {
            $type = 'radiobutton';
            $group  = $class->use_par($proto, 'group', $DEFAULT, '' );
            $rb_group = "$current_form\{'rb-group-$group'}";
            if ($rb_group && eval "defined $rb_group") {
                $use_group = $rb_group;
            }

        } else {
            $type =~ s/.*:(.*)/$1/;
        }

        $use_group ||= 'undef';
        $class->add_to_UI( $depth, 
            "\$widgets->{'$name'} = ".
                "${current_form}\{'$parent'}->append_element(".
                    "'$type', $use_group, _('$label'), ".
                    "_('$tooltip'), '', $pixmap_widget_name );" );

        unless (!$rb_group || eval "defined $rb_group") {
            $class->add_to_UI( $depth,  
                "$rb_group = \$widgets->{'$name'};" );
        }
            
#---------------------------------------
    } elsif (' GnomeDock:contents ' =~ / $type /) {
        return undef;
        # FIXME This doesn't make sense to me, get_client_area wants a DockItem
#            $class->add_to_UI( $depth, 
#                "\$widgets->{'$name'} = ".
#                    "${current_form}\{'$parent'}->get_client_area;" );
#            $class->add_to_UI( $depth, 
#                "\$widgets->{'$name'} = ".
#                    "${current_form}\{'$parent'}->get_client_area;" );

#---------------------------------------
    } elsif (' GnomeDruidPageStandard:vbox ' =~ / $type /) {
        if ($class->my_perl_gtk_can_do('GnomeDruidPageStandard::vbox')) {
            $class->add_to_UI( $depth, 
                "\$widgets->{'$name'} = ".
                    "${current_form}\{'$parent'}->vbox;" );
        } else {
            return undef;
        }

#---------------------------------------
    } elsif (eval "${current_form}\{'$parent'}->can('$type')") {
        my $label   = $class->use_par($proto, 'label', $DEFAULT, '');
        $class->add_to_UI( $depth, 
            "\$widgets->{'$name'} = ".
                "${current_form}\{'$parent'}->$type;" );

        if ($label) {
            if ($widgets->{$name}->can('child')) {
                my $childref = ref $widgets->{$name}->child;
                if ($childref eq 'Gtk::Label') {
                    $class->add_to_UI( $depth, 
                        "\$widgets->{'$name'}->child->set_text(_('$label'));", 
                        'TO_FILE_ONLY' );
                } else {
                    $class->diag_print (1, "error We have a label ".
                        "('%s') to set but the child of %s ".
                        "isn't a label (actually it's a %s)",
                        $label, "${current_form}\{'$name'}", $childref);
                }
            } else {
                $class->diag_print (1, "error We have a label ('%s') to ".
                    "set but %s doesn't have a ->child() accessor",
                    $label, "${current_form}\{'${name}'}");
            }
        }

#---------------------------------------
    } else {
        $class->diag_print (1, "error Don't know how to get a ref to %s ".
            "(type '%s')",
            "${current_form}\{'${name}'}{'child_name'}", $type);
        return undef;
    }

    $class->add_to_UI( $depth, "\$widgets->{'$name'}->show;" );
# FINDME This is to remove
    $class->add_to_UI( $depth, 
        "${current_form}\{'$name'} = \$widgets->{'$name'};" );
    # Delete the $widget to show that it has been packed
    delete $widgets->{$name};

    # Deal with all the other widget properties that might be set
    $class->set_widget_properties($parent, $name, $proto, $depth);
    $class->set_container_properties($parent, $name, $proto, $depth);
    $class->set_tooltip($name, $proto, $depth );

    # we have constructed the widget so caller doesn't need to
    return 1;
}

sub new_signal {
    my ($class, $parentname, $proto, $depth) = @_;
    my $me = "$class->new_signal";
    my $signal  = $proto->{name};
    my ($call, $expr);
# FIXME to do signals properly
    if ($proto->{'handler'}) {
        my $ignore = $class->use_par($proto, 'last_modification_time');
        my $handler = $class->use_par($proto, 'handler');
        my $object  = $class->use_par($proto, 'object', $DEFAULT, '');
        my $data    = $class->use_par($proto, 'data', $DEFAULT, '');
        my $after   = $class->use_par($proto, 'after', $BOOL, 'False');
        unless ($object) {$object = $parentname}
        if ($after)  {
            $call .= 'signal_connect_after'
        } else {
            $call .= 'signal_connect'
        }
        # We can check dynamically below
        # Flag that we are done
        delete $need_handlers->{$parentname}{$signal};
        # We must log the sub name for dynamic stub handlers
        unless ( ($Glade::PerlSource::subs =~ m/ $handler /) or    
            (defined $handlers->{$handler}) or 
            ($class->Building_UI_only) ) {
            $subs .= "$handler\n$indent".(' ' x 19 );
            eval "$current_form\{_HANDLERS}{'$handler'} = 'signal'";
        }
        if ($class->can($handler) || 
            eval "$current_name->can('$handler')"
            # || 
            #    (
            #        #($Glade_Perl->{'options'}->style || 'AUTOLOAD') eq 'Libglade' &&
            #        defined $use_modules[0] && 
            #        print "$use_modules[0]\->can('$handler')\n" &&
            #        eval "$use_modules[0]\->can('$handler')"
            #    )
            ) {
            # All is hunky-dory - no need to generate a stub
            eval "delete $current_form\{_HANDLERS}{'$handler'}";
            # First connect the signal handler as best we can
            unless ($class->Writing_Source_only) {
                $expr = "push \@{${current_form}\{'Signal_Strings'}}, ".
                    "\"\\${current_form}\{'$object'}->$call( ".
#                    "'$signal', \\\\\\\"$handler\\\\\\\", '$data', '$object', ".
                    "'$signal', \\\"\$class\\\::$handler\\\", '$data', '$object', ".
                    "'name of form instance' )\"";
                eval $expr
            }
            # Now write a signal_connect for generated code
            # All these back-slashes are really necessary as these strings
            # are passed through so many others (evals and so on)
            $expr = "push \@{${current_form}\{'Signal_Strings'}}, ".
                "\"$class->add_to_UI( 1, ".
                "\\\"\\\\\\${current_form}\{'$object'}->$call( ".
                "'$signal', \\\\\\\"\\\\\\\$class\\\\\\\\\::$handler\\\\\\\", '$data', '$object', ".
                "\\\\\\\"$current_form_name\\\\\\\" );\\\", 'TO_FILE_ONLY' );\"";
                eval $expr
            
        } else {
            # First we'll connect a default handler to hijack the signal 
            # for us to use during the Build run
            $class->diag_print (4, "warn  Missing signal handler '%s' ".
                "connected to widget '%s' needs to be written",
                $handler, $object);
            unless ($class->Writing_Source_only) {
            $expr = "push \@{${current_form}\{'Signal_Strings'}}, ".
                "\"\\${current_form}\{'$object'}->$call(".
                "'$signal', \\\"\$class\\\::missing_handler\\\", ".
                "'$parentname', '$signal', '$handler', '".
                $Glade_Perl->{'options'}{'logo_filename'}."' )\"";
                eval $expr
            }
            # Now write a signal_connect for generated code
            # All these back-slashes are really necessary as these strings
            # are passed through so many others (evals and so on)
            $expr = "push \@{${current_form}\{'Signal_Strings'}}, ".
                "\"$class->add_to_UI( 1, ".
                "\\\"\\\\\\${current_form}\{'$object'}->$call( ".
                "'$signal', \\\\\\\"\\\\\\\$class\\\\\\\\\::$handler\\\\\\\", '$data', '$object', ".
                "\\\\\\\"$current_form_name\\\\\\\" );\\\", 'TO_FILE_ONLY' );\"";
            eval $expr
        }

    } else {
        # This is a signal that we will cause
#        $class->diag_print(4, $proto);
    }
}

1;

__END__

