view release on metacpan or  search on metacpan

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

        #
        -compound => ['SELF', 'compound', 'Compound', 'none'],
    );



}



sub containerName{
        return 'ttkLabel';
}


# Wrapper sub so mega-widgets still work with the facelift
sub Tcl::pTk::Label{
        my $self = shift;
        my $obj = $self->Tcl::pTk::ttkLabel(@_);
        bless $obj, "Tcl::pTk::LabelttkSubs";
        return $obj;
}


1;

############################################################

############# Substitution Package for oldwidget "BrowseEntry" to tile widget "ttkBrowseEntry" ####################

package Tcl::pTk::BrowseEntryttkSubs;


@Tcl::pTk::BrowseEntryttkSubs::ISA = (qw / Tcl::pTk::Derived Tcl::pTk::ttkBrowseEntry/);

{
        local $^W = 0; # To avoid subroutine redefined warning messages
        Construct Tcl::pTk::Widget 'BrowseEntry';
}


# If we are being used in conjunction with TkHijack, we don't need a mapping for Tk::BrowseEntry
if( defined $Tcl::pTk::TkHijack::translateList){
        #print STDERR "undoing translatelist\n";
        $Tcl::pTk::TkHijack::translateList->{'Tk/BrowseEntry.pm'}    =  '';
}


sub Populate {
    my( $cw, $args ) = @_;

    $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::;

# Redefine the BrowseEntry Mapping if TkHijack loaded, so BrowseEntry subclasses will still work
*Tk::BrowseEntry:: = *Tcl::pTk::BrowseEntry:: if( defined $Tcl::pTk::TkHijack::packageAliases );


# Wrapper sub so mega-widgets still work with the facelift
sub Tcl::pTk::BrowseEntry{
        my $self = shift;
        my $obj = $self->Tcl::pTk::ttkBrowseEntry(@_);
        bless $obj, "Tcl::pTk::BrowseEntryttkSubs";
        return $obj;
}

############# Substitution Package for oldwidget "NoteBook" to tile widget "ttkTixNoteBook" ####################

package Tcl::pTk::NoteBookttkSubs;


@Tcl::pTk::NoteBookttkSubs::ISA = (qw / Tcl::pTk::Derived Tcl::pTk::ttkTixNoteBook/);

{
        local $^W = 0; # To avoid subroutine redefined warning messages
        Construct Tcl::pTk::Widget 'NoteBook';
}


# If we are being used in conjunction with TkHijack, we don't need a mapping for Tk::NoteBook
if( defined $Tcl::pTk::TkHijack::translateList){
        #print STDERR "undoing translatelist\n";
        $Tcl::pTk::TkHijack::translateList->{'Tk/NoteBook.pm'}    =  '';
}



# Alias the entire NoteBook namespace to ttkTixNoteBook, so NoteBook subclasses widgets
#   work correctly
*Tcl::pTk::NoteBook:: = *Tcl::pTk::ttkTixNoteBook::;

# Redefine the NoteBook Mapping if TkHijack loaded, so NoteBook subclasses will still work
*Tk::NoteBook:: = *Tcl::pTk::NoteBook:: if( defined $Tcl::pTk::TkHijack::packageAliases );


# Wrapper sub so mega-widgets still work with the facelift
sub Tcl::pTk::NoteBook{
        my $self = shift;
        my $obj = $self->Tcl::pTk::ttkTixNoteBook(@_);
        bless $obj, "Tcl::pTk::NoteBookttkSubs";
        return $obj;
}

################ New Tcl::pTk::Widget::Contruct Method used for Facelift #########