Tcl-pTk

 view release on metacpan or  search on metacpan

lib/Tcl/pTk/Facelift.pm  view on Meta::CPAN

    $cw->SUPER::Populate( $args );

    # Create LabEntry subwidget (won't be visible/packed)
    my $be = $cw->LabEntry();
    $cw->Advertise('entry' => $be);
    
    my %ignoreConfigSpecs = ();
    $cw->ConfigSpecs(
        %ignoreConfigSpecs,
        'DEFAULT' => ['combobox']
    );



}

# Alias the entire BrowseEntry namespace to ttkBrowseEntry, so Browse-Entry subclasses widgets
#   work correctly
*Tcl::pTk::BrowseEntry:: = *Tcl::pTk::ttkBrowseEntry::;

lib/Tcl/pTk/Tile.pm  view on Meta::CPAN

        
        where $interp is the Tcl interp object

=cut

sub _declareTileWidgets {
	my $interp = shift;

	my @ttkwidgets = (
		qw/
		  button checkbutton combobox entry frame image label
		  label labelframe menubutton notebook panedwindow
		  progressbar radiobutton scale scrollbar separator
		  sizegrip treeview /
	);

	foreach my $ttkwidget (@ttkwidgets) {

		#print STDERR "delcareing "."ttk".ucfirst($ttkwidget).
		#                 "  ttk::$ttkwidget\n";
		$interp->Declare(

lib/Tcl/pTk/demos/widget_lib/combo.pl  view on Meta::CPAN

        my $labelFrame1 = $TOP->ttkLabelframe(-text => 'Fully Editable');
        my $cb1 = $labelFrame1->ttkCombobox(-textvariable => \$firstvalue);
        
        my $labelFrame2 = $TOP->ttkLabelframe(-text => 'Disabled');
        my $cb2 = $labelFrame2->ttkCombobox(-textvariable => \$secondvalue, -state => 'disabled');
        
        my $labelFrame3 = $TOP->ttkLabelframe(-text => 'Defined List Only');
        my $cb3 = $labelFrame3->ttkCombobox(-textvariable => \$ozCity, -state => 'readonly', 
                -values => \@australianCities);
        
        # Any new value get added to the list for combobox 1
        $cb1->bind('<Return>', sub{ 
                       my $W = shift;
                       my $val = $W->get();
                       unless( grep $_ eq $val, $W->cget('-values') ){
                               my @values = $W->cget('-values');
                               $W->configure('-values' => [@values, $val]);
                       }
        });
                       
        # Pack all the labframes
        foreach my $lb ($labelFrame1, $labelFrame2, $labelFrame3){
                $lb->pack( -side => 'top', -pady => 5, -padx => 10);
        }
        
        # Pack all the comboboxes
        foreach my $cb ($cb1, $cb2, $cb3){
                $cb->pack( -pady => 5, -padx => 10);
        }
        
        
}
 

lib/Tcl/pTk/ttkBrowseEntry.pm  view on Meta::CPAN

=item B<delete(>I<index1>, I<index2>B<)>

Deletes items from I<index1> to I<index2>.

=item B<get(>I<index1>, I<index2>B<)>

gets items from I<index1> to I<index2>. This is there for compatibility with BrowseEntry.
 
=item B<choiceget>

Get the current selected choice. This directly maps to the I<get> method of the combobox

        
=back


=cut



use Tcl::pTk qw(Ev);

lib/Tcl/pTk/ttkBrowseEntry.pm  view on Meta::CPAN

sub Populate {
    my ($cw, $args) = @_;
     
    # Set foreground and background options to undef, unless defined during widget creation
    #   This keeps Tcl::pTk::Derived from setting these options from the options database, which is
    #    not needed for ttk widgets, and also makes -state => 'disabled' not look right
    foreach my $option( qw/ -foreground -background /){
            $args->{$option} = undef unless( defined($args->{$option} ));
    }
    
    # combobox widget
    my $lpack = delete $args->{-labelPack};
    if (not defined $lpack) {
	$lpack = [-side => 'left', -anchor => 'e'];
    }

    $cw->SUPER::Populate($args);


    my $label;
    if (exists $args->{-label}) {

lib/Tcl/pTk/ttkBrowseEntry.pm  view on Meta::CPAN

    -label -labelActivebackground -labelActiveforeground -labelAnchor -labelBackground
    -labelBitmap -labelBorderwidth -labelCompound -labelCursor -labelDisabledforeground
    -labelFont -labelForeground -labelHeight -labelHighlightbackground -labelHighlightcolor 
    -labelHighlightthickness -labelImage -labelJustify -labelPack -labelPadx -labelPady 
    -labelRelief -labelState -labelTakefocus -labelUnderline -labelVariable -labelWidth -labelWraplength 
    /);
    my %ignoreConfigSpecs = map( ($_ => [ "PASSIVE", $_, $_, undef ]), @ignoreOptions);

    my $cb = $cw->ttkCombobox();
    $cb->pack( -side => 'right', -fill => 'x', -expand => 1); 
    $cw->Advertise('combobox' => $cb);

    $cw->Delegates(DEFAULT => $cb); # methods are handled by the combobox
    $cw->ConfigSpecs( 
		      DEFAULT => [ 'combobox' ],  # Default options go to ttkCombobox
                      -arrowimage      => ['PASSIVE', 'arrowimage', 'arrowimage', undef], # ignored for compatibility with BrowseEntry
                      -autolimitheight => ['PASSIVE', 'autolimitheight', 'autolimitheight', undef], # ignored for compatibility with BrowseEntry
                      -autolistwidth  => ['PASSIVE', 'autolimitwidth', 'autolimitwidth', undef],    # ignored for compatibility with BrowseEntry
                      -browsecmd       => ['CALLBACK', 'browsecmd',  'browsecmd',  undef], 
                      -browse2cmd      => ['CALLBACK', 'browse2cmd', 'browse2cmd', undef], 
                      -buttontakefocus => [ {-takefocus => $cb}, qw/takefocus takefocus/, undef],
                      -choices         => [ {-values => $cb}, qw/choices choices/, undef],
                      -colorstate      => ['PASSIVE', 'colorstate', 'colorstate', undef], # ignored for compatibility with BrowseEntry
                      -listcmd         => ['CALLBACK', 'listcmd',  'listcmd',  undef], 
                      -listheight      => [ {-height => $cb}, qw/listheight listheight/, undef],
                      -listwidth       => ['PASSIVE', 'listwidth', 'listwidth', undef], # ignored for compatibility with BrowseEntry 
                                                                                        # (combobox listbox is always the same as -width, 
                                                                                        #   so not needed)
                      -variable        => [ {-textvariable => $cb}, qw/textvariable textvariable/, undef],
                      
                      -command     => '-browsecmd',
                      -options     => '-choices',
		      %ignoreConfigSpecs, 
                      
    );
    
    # Create callback to emulate -browsecmd and -browsecmd2 options

lib/Tcl/pTk/ttkBrowseEntry.pm  view on Meta::CPAN

    foreach my $entry($start, $stop){
            $entry = $#choices if($entry eq 'end');
    }
    
    my $count = $stop - $start + 1;
    
    return @choices[$start..$stop];

}

# Wrapper for choiceget. This calls 'get' on the combobox subwidget, which just gets the
# currently selected value
sub choiceget{
        my $w = shift;
        my $sb = $w->Subwidget('combobox');
        $sb->get(@_);
}

# Wrapper for labelpack. This is provided for compatibility with perl/tk, but doesn't nothing
#
sub labelPack{
        my $w = shift;

}

lib/Tcl/pTk/ttkTixNoteBook.pm  view on Meta::CPAN

    /);
    my %ignoreConfigSpecs = map( ($_ => [ "PASSIVE", $_, $_, undef ]), @ignoreOptions);

    my $nb = $cw->ttkNotebook();
    $nb->pack( -side => 'right', -fill => 'both', -expand => 1); 
    $cw->Advertise('ttkNotebook' => $nb);

    # Create lookup of widget to tab name
    $cw->{widgetLookup} = {};
    
    $cw->Delegates(DEFAULT => $nb); # methods are handled by the combobox
    $cw->ConfigSpecs( 
		      DEFAULT => [ 'ttkNotebook' ],  # Default options go to ttkCombobox
		      -ipadx      => [ qw/METHOD ipadx     ipadx/,            undef ],
		      -ipady      => [ qw/METHOD ipady     ipady/,            undef ],
		      %ignoreConfigSpecs, 
    );
    
  
      
}

t/ttkBrowseEntry.t  view on Meta::CPAN

                        #print "browsecmd args ".join(", ", @_)."\n";
                        $selection = $value;
                        
                        ok($extraArg, 'extraArg', "browsecmd arg order check");
                        
                }, 'extraArg']
                );
        
        $cb->set(3); # Make a selection
        # generate event that would happen if we actually made the selection in the GUI
        $cb->Subwidget('combobox')->eventGenerate('<<ComboboxSelected>>');

        # check for browsecmd being called
        ok($selection, 3, "browsecmd check");

        $selection = undef;
        
        # Now check browse2cmd
        $cb->configure(-browsecmd => undef);
        

        $cb->configure(-browse2cmd => 
                sub{ 
                        my ($w, $value) = @_;
                        #print STDERR "browse2cmd args ".join(", ", @_)."\n";
                        $selection = $value;
                        
                });
                
        $cb->set(21); # Make a selection
        # generate event that would happen if we actually made the selection in the GUI
        $cb->Subwidget('combobox')->eventGenerate('<<ComboboxSelected>>');

        ok($selection, 20, "browse2cmd check");
        });



$top->after(2000, sub{ $top->destroy() }) unless (@ARGV); # for debugging, don't go away if something on the command line
MainLoop;

#print "options = $ttkoption\n";