view release on metacpan or  search on metacpan

Glade/PerlUIExtra.pm  view on Meta::CPAN

    return $widgets->{$name};
}


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

    $class->add_to_UI( $depth,  "\$widgets->{'$name'} = new Gnome::Spell;");

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

sub new_GtkClock {
    my ($class, $parent, $proto, $depth) = @_;
    my $me = "$class->new_GtkClock";
    my $name = $proto->{name};
    my $type     = $class->use_par($proto, 'type',     $LOOKUP,  'realtime' );
    my $format   = $class->use_par($proto, 'format',   $DEFAULT, '%H:%M' );
    my $seconds  = $class->use_par($proto, 'seconds',  $DEFAULT, 0 );
    my $interval = $class->use_par($proto, 'interval', $DEFAULT, 60 );

    $class->add_to_UI( $depth, "\$widgets->{'$name'} = new Gtk::Clock('$type');" );
    $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_format(_('$format' ));" );
    $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_seconds($seconds );" );
    $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_update_interval($interval );" );
    $class->add_to_UI( $depth, "\$widgets->{'$name'}->start();" );

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

sub new_GtkDial {
    my ($class, $parent, $proto, $depth) = @_;
    my $me = "$class->new_GtkDial";
    my $name = $proto->{name};
    my $view_only    = $class->use_par($proto, 'view_only',    $BOOL, 'False' );
    my $update_policy= $class->use_par($proto, 'update_policy',$LOOKUP, 'continuous' );
    my $value        = $class->use_par($proto, 'value',        $DEFAULT, 0 );
    my $lower        = $class->use_par($proto, 'lower',        $DEFAULT, 0 );
    my $upper        = $class->use_par($proto, 'upper',        $DEFAULT, 100 );
    my $step         = $class->use_par($proto, 'step',         $DEFAULT, 0 );
    my $page         = $class->use_par($proto, 'page',         $DEFAULT, 0 );
    my $page_size    = $class->use_par($proto, 'page_size',    $DEFAULT, 0 );

    $class->add_to_UI( $depth,  "\$work->{'$name-adj'} = new Gtk::Adjustment(".
        "$value, $lower, $upper, $step, $page, $page_size );" );

    $class->add_to_UI( $depth,  "\$widgets->{'$name'} = new Gtk::Dial(".
        "\$work->{'$name-adj'});" );
    $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_view_only($view_only );" );
    $class->add_to_UI( $depth, "\$widgets->{'$name'}->set_update_policy('$update_policy' );" );

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

    return $widgets->{$name};
}

sub new_GtkPixmapMenuItem {
    my ($class, $parent, $proto, $depth) = @_;
    my $me = "$class->new_GtkPixmapMenuItem";
    my $name = $proto->{name};
    my ($work, $mod);
    my $icon = $class->use_par($proto, 'icon', $DEFAULT, '' );
    my $stock_item = uc($class->use_par($proto, 'stock_item', $DEFAULT, '' ));
    my $stock_icon = $class->use_par($proto, 'stock_icon', $LOOKUP, '' );
    my $label = $class->use_par($proto, 'label', $DEFAULT, '' );
    my $right_justify = $class->use_par($proto, 'right_justify', $BOOL, 'False' );
# FIXME possibly make this add to a Gnome::UIInfo structure for later use by 
#   Gnome->create_menus() - see also toolbars
    if ($stock_item) {
        $stock_item =~ s/GNOMEUIINFO_MENU_(.*)_ITEM/$1/;
        $label = __PACKAGE__->lookup("GNOME_MENU_$stock_item\_STRING") 
            unless $label;
        # If we still don't have a label synthesise one from stock_item
        $label = ucfirst(lc($stock_item)) unless $label;
        $stock_icon = __PACKAGE__->lookup("GNOME_STOCK_PIXMAP_$stock_item");
        $stock_item =~ s/^PROPERTIES$/PROP/;    # What is this shit?
        $stock_item =~ s/^PREFERENCES$/PREF/;   # What is this shit?
        $work->{'sim'} = __PACKAGE__->lookup("GNOME_STOCK_MENU_$stock_item");
    }

    if ($work->{'sim'}) {
        if ($work->{'sim'}) {
            my ( @ac_mods);
            my $accel_flags = "['visible', 'locked']";
            $work->{'ak'}  = __PACKAGE__->lookup("GNOME_KEY_NAME_$stock_item");
            $work->{'am'}  = __PACKAGE__->lookup("GNOME_KEY_MOD_$stock_item");

            $class->add_to_UI( $depth, "\$widgets->{'$name'} = ".
                "Gnome::Stock->menu_item('$work->{'sim'}', _('$label'));" );
            $work->{'ak'} =~ s/GDK_//;
#            $work->{'ak'} = $Gtk::Keysyms{$work->{'ak'}} if $work->{'ak'};

            my $ac_mods = $class->use_par($proto, 'ac_mods', $DEFAULT, '0' ) ||
                $work->{'am'};
            foreach $mod (split(/\|/, $ac_mods)) {
                push @ac_mods, Glade::PerlUIGtk->lookup($mod);
            }
            $ac_mods = $#ac_mods >= 0 ? join("', '", @ac_mods) : '';

            if ($work->{'ak'} || $ac_mods) {
#            if ($work->{'ak'} && $ac_mods) {
                $class->add_to_UI( $depth, "${current_form}\{accelgroup}->add(".
                    "\$Gtk::Keysyms{'$work->{'ak'}'} || ".
                    "Gtk::Gdk->keyval_from_name('$work->{'ak'}') || ".
                    $Gtk::Keysyms{$work->{'ak'}}.
#                    ($work->{'ak'} || "''").
                    ", \['$ac_mods'\], $accel_flags, ".
                    "\$widgets->{'$name'}, 'activate');");
            }
            if (_($label) =~ /_/) {
                $class->add_to_UI( $depth,
                    "\$widgets->{'$name-key'} = ".
                        "(\$widgets->{'$name'}->child->children)[1]->widget->parse_uline(_('$label') );");
                $class->add_to_UI( $depth,
                    "\$widgets->{'$name'}->add_accelerator(".
                        "'activate_item', $current_form\{'accelgroup'}, ". 
                        "\$widgets->{'$name-key'}, 'mod1_mask', ".
                        "['visible', 'locked'] );");
                undef $widgets->{"$name-key"};
            }
        
        }

    } elsif ($stock_icon) {
        $class->add_to_UI( $depth, "\$widgets->{'$name'} = ".
            "Gnome::Stock->menu_item('$stock_icon', _('$label'));" );
        if (_($label) =~ /_/) {
            $class->add_to_UI( $depth,
                "\$widgets->{'$name-key'} = ".
                    "(\$widgets->{'$name'}->child->children)[1]->widget->parse_uline(_('$label') );");
            $class->add_to_UI( $depth,
                "\$widgets->{'$name'}->add_accelerator(".
                    "'activate_item', $current_form\{'accelgroup'}, ". 
                    "\$widgets->{'$name-key'}, 'mod1_mask', ".
                    "['visible', 'locked'] );");
            undef $widgets->{"$name-key"};
        }
        
    } elsif ($label) {
        if ($class->my_gtk_perl_can_do('gtk_pixmap_menu_item')) {
            # We can use all the PixmapMenuItem methods
            $class->add_to_UI( $depth, "\$widgets->{'$name'} = ".
                "new Gtk::PixmapMenuItem;" );
            $class->add_to_UI( $depth, "\$widgets->{'$name-label'} = ".
                "new Gtk::AccelLabel(_('$label'));" );
            $class->add_to_UI( $depth, "\$widgets->{'$name'}->add(".
                "\$widgets->{'$name-label'});" );
            $class->add_to_UI( $depth, "\$widgets->{'$name-label'}->".
                "set_alignment(0.0, 0.5);" );
            $class->add_to_UI( $depth, "\$widgets->{'$name-label'}->show;" );

            if (_($label) =~ /_/) {
                $class->add_to_UI( $depth,
                    "\$widgets->{'$name-key'} = ".
                        "\$widgets->{'$name-label'}->parse_uline(_('$label') );");
                $class->add_to_UI( $depth,
                    "\$widgets->{'$name'}->add_accelerator(".
                        "'activate', $current_form\{'accelgroup'}, ". 
                        "\$widgets->{'$name-key'}, 'mod1_mask', ".
                        "['visible', 'locked'] );");
                undef $widgets->{"$name-key"};
            }
            undef $widgets->{"$name-label"};

        } else {
            # Use old methods (from Gtk::MenuItem)
            $class->add_to_UI( $depth, "\$widgets->{'$name'} = ".
                "new Gtk::MenuItem(_('$label') );" );
            if (_($label) =~ /_/) {
                $class->add_to_UI( $depth,
                    "\$widgets->{'$name-key'} = ".
                        "\$widgets->{'$name'}->child->parse_uline(_('$label') );");
                $class->add_to_UI( $depth,
                    "\$widgets->{'$name'}->add_accelerator(".
                        "'activate', $current_form\{'accelgroup'}, ". 
                        "\$widgets->{'$name-key'}, 'mod1_mask', ".
                        "['visible', 'locked'] );");
                undef $widgets->{"$name-key"};
            }
        }
    } else {
        # There is no label
        $class->add_to_UI($depth, "\$widgets->{'$name'} = ".
            "new Gtk::PixmapMenuItem;" );
    }
    if ($right_justify) { 
        $class->add_to_UI( $depth, "\$widgets->{'$name'}->right_justify;" );
    }

    $class->pack_widget($parent, $name, $proto, $depth );
    if ($icon) {
        if ($class->my_gtk_perl_can_do('gtk_pixmap_menu_item')) {
            $class->add_to_UI( $depth,
                "$current_form\{'$name-pixmap'} = \$class->create_pixmap(".
                    "$current_window, '$icon');");
            $class->add_to_UI( $depth, "$current_form\{'$name-pixmap'}->show;");
# FIXME find out how to show the accelerators - they are set but not shown :(
            $class->add_to_UI( $depth,
                "$current_form\{'$name'}->set_pixmap(".
                    "$current_form\{'$name-pixmap'});");
            undef $widgets->{"$name-pixmap"};
        }
    }
    return $widgets->{$name};
}

1;

__END__