I'm not sure I know what you are trying to do, but I think you might want to read ConfigSpecs.html

If you are trying to add custom attributes to your widget, you might want to copy the way I did it in Tk::CanvasDirTree

I found it somewhere, maybe in Mastering Perl/Tk or in a net tutorial, but you need to delete it all before filling it in again. See the Populate sub. 

package Tk::CanvasDirTree;

our $VERSION = '0.05';
use warnings;
use strict;

use Tk::widgets qw/Canvas/;
use base  qw/Tk::Derived Tk::Canvas/;
use File::Spec;
use Tk::JPEG;
use Tk::PNG;

Construct Tk::Widget 'CanvasDirTree';

sub ClassInit
{
    my ($class, $mw) = @_;
    $class->SUPER::ClassInit($mw);
    $mw->bind($class, "<1>" =>'pick_one' );
    return $class; 
}

sub bind{
   my $self = shift;
   $self->CanvasBind(@_);
}

sub ConfigChanged {
  my ($self,$args)= @_;
  
   foreach my $opt (keys %{$args} ){
 
          if( $opt eq '-indfilla' ){ 
                    $self->{'indfilla'} = $args->{$opt};       

            my @items = $self->find('withtag','open');
             foreach my $item (@items){
                 $self->itemconfigure($item, -fill => $args->{$opt});
                      }
         };

          if( $opt eq '-indfilln' ){ 
                $self->{'indfilln'} = $args->{$opt};       
                    
            my @items = $self->find('withtag','ind');
             foreach my $item (@items){
                my @tags = $self->gettags($item);
                if( grep {$_ eq 'open'} @tags ){next} 
                $self->itemconfigure($item, -fill => $args->{$opt});
                      }
                  };  
       #---------------------------------------------
    
       #----------- fontcolor updates--------------
          if( $opt eq '-fontcolora' ){ 
                    $self->{'fontcolora'} = $args->{$opt};       
            $self->itemconfigure('list', -activefill => $args->{$opt})
+;
                 };
        
          if( $opt eq '-fontcolorn' ){ 
                $self->{'fontcolorn'} = $args->{$opt};       
                    $self->itemconfigure('list', -fill => $args->{$opt
+});
                  };  
        #---------------------------------------------

       #----------- background image updates--------------
          if(( $opt eq '-backimage' ) or ( $opt eq '-imx' ) or ( $opt 
+eq '-imy' )){ 
                   my $chipped = $opt;
               substr $chipped, 0, 1, '' ;  #chip off - off of $opt
               $self->{ $chipped } = $args->{$opt};       
            $self->set_background( 
                      $self->{'backimage'} ,$self->{'imx'}, $self->{'i
+my'}
                 );  
         };
       #---------------------------------------------
   }
  
$self->idletasks;

} #end config changed   
    
#################################################################

sub Populate {
   my ($self, $args) = @_;
  #-------------------------------------------------------------------
   #take care of args which don't belong to the SUPER, see Tk::Derived
   foreach my $extra ('backimage','imx','imy','font','indfilla',
                      'indfilln','fontcolorn','fontcolora','floatback'
+) {
       my $xtra_arg = delete $args->{ "-$extra" };  #delete and read s
+ame time 
     if( defined $xtra_arg ) { $self->{$extra} = $xtra_arg }
   }
   #-----------------------------------------------------------------

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

    $self->ConfigSpecs(
     -indfilla => [ 'PASSIVE', undef, undef , undef],  # need to set d
+efaults
     -indfilln => [ 'PASSIVE', undef, undef, undef],   # below for unk
+nown
     -fontcolora => [ 'PASSIVE', undef, undef, undef], # reason ??
     -fontcolorn => [ 'PASSIVE', undef, undef, undef], #
     -backimage => [ 'PASSIVE', undef, undef, undef],
     -imx => [ 'PASSIVE', undef, undef, undef],
     -imy => [ 'PASSIVE', undef, undef, undef],
     -font => [ 'PASSIVE', undef, undef, undef],
     -floatback => [ 'PASSIVE', undef, undef, undef],
    ); 
    
     #set some defaults
     $self->{'indfilla'} ||= 'red';        
     $self->{'indfilln'} ||= 'blue'; 
     $self->{'fontcolorn'} ||= 'black';
     $self->{'fontcolora'} ||= 'red';
     $self->{'backimage'} ||= '';        
     $self->{'imx'} ||= 0; 
     $self->{'imy'} ||= 0;
     $self->{'font'} ||= 'system';
     $self->{'floatback'} ||= 0;
       
#---determine font spacing by making a capital W---
   my $fonttest =  $self->createText(0,0,
              -fill    => 'black',
              -text    => 'W',            
              -font => $self->{'font'},
              );
   
    my ($bx,$by,$bx1,$by1) = $self->bbox($fonttest);
    $self->{'f_width'} = $bx1 - $bx;
    $self->{'f_height'} = $by1 - $by;
    $self->delete($fonttest);
#--------------------------------------------------
   $self->make_trunk('.', 0); 

   $self->after(1,sub{ $self->_set_bars() });

} # end Populate

.....snip......

[download]
I'm not really a human, but I play one on earth. Cogito ergo sum a bum

In reply to Re: How do you create a new attribute for a Tk::Widget? by zentara
in thread How do you create a new attribute for a Tk::Widget? by rzer10

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.