view release on metacpan or  search on metacpan

buildTkFacelift  view on Meta::CPAN

                $specialCode = $specialCode{$oldWidgetName};
        }
        $templateText =~ s/__SPECIALCODE__/$specialCode/g;
                
        print $templateText;

}

exit();

# Sub to get the options in the old widget that aren't in the tile widget
sub getIgnoreOptions{
        my $oldWidget          = shift;
        my $ttkWidget          = shift;
        my %oldWidgetConfig = configSpecs($oldWidget);
        my %ttkWidgetConfig = configSpecs($ttkWidget);

        # Find options in old widget that aren't in ttk widget
        my @ignoreOptions;
        foreach my $oldOption ( keys %oldWidgetConfig ) {
                push @ignoreOptions, $oldOption if !defined( $ttkWidgetConfig{$oldOption} );
        }

        return @ignoreOptions;
}



# build configspecs from a widget
sub configSpecs{
        my $cw = shift;

        # Get native options first and turn into data to feed configSpaces
        my @nativeOptions = $cw->Tcl::Tk::Widget::configure();
        my %configSpecs;
        foreach my $optElement (@nativeOptions) {
                my $name = $optElement->[0];
                my @optData = ( 'SELF', @$optElement[ 1 .. 3 ] );
                next if ( $name eq '-class' );

                # Change any '{}' that shows up for scrollcommands to undefs
                #   Without this, configure is called with something like "-yscrollcommand => '{}'", which
                #    causes problems
                $optData[3] = undef if ( defined( $optData[3] ) && $optData[3] eq '{}' );
                $configSpecs{$name} = [@optData];
        }
        return %configSpecs;
}

######################## Template Subs ##########################################

# Sub to return the template for a substitution widget
sub subsWidget{
        
        return <<'EOD';
############# Substitution Package for oldwidget "__OLDWIDGET__" to tile widget "__TILEWIDGET__" ####################

package Tcl::Tk::Widget::__PACKAGENAME__;


@Tcl::Tk::Widget::__PACKAGENAME__::ISA = (qw / Tcl::Tk::Derived Tcl::Tk::Widget__ISA__/);


Construct Tcl::Tk::Widget '__OLDWIDGET__';


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

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


    #### Setup options ###
    
    
    # Setup options that will be ignored  (setup to just be passive), because they don't
    #  exists in the substituted tile widget
    my @ignoreOptions = (
__IGNOREOPTIONS__
    );
    
    my %ignoreConfigSpecs = map( ($_ => [ "PASSIVE", $_, $_, undef ]), @ignoreOptions);
    #  gridded and sticky are here to emulate the original Tk::Pane version
    #  They don't do anything in this widget
    $cw->ConfigSpecs(
        %ignoreConfigSpecs,
        'DEFAULT' => ['SELF']
    );



}



sub containerName{
        return '__TILEWIDGET__';
}

__SPECIALCODE__

1;

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


EOD
}

# Sub to return the header text
sub getHeader{
        return <<'EOD'
use Tcl::Tk;

EOD
}