Re: Using Perl/Tk text tags

[BlueBlazerRegular]

In the interests of TIMTOWTDI, here is another example. This one will display the line or the word associated with the click on tag, depending upon which how the tags were set. In your case, since you've mentioned that you are setting the tags to various words, I would use the word logic, but I included the code for selecting entire lines as well as it is odd enough to be worth mentioning.

Without further ado, here is the code:

#!/usr/bin/perl -w

use strict;

use Tk;

#
# Create the main window and stick the widgets in it...
#
my $mw = MainWindow->new();
$mw->geometry("600x300");

my $one_F = $mw->Frame(
                      )->pack(-side => 'top',
                              -fill => 'x',
                              -expand => 1,
                              -padx => 3,
                              -pady => 3,
                             );

my $two_F = $mw->Frame(
                      )->pack(-side => 'top',
                              -fill => 'x',
                              -expand => 1,
                              -padx => 3,
                              -pady => 3,
                             );

$mw->Label(-text => "Selected Text ->",
          )->pack(-side => 'left',
                 -in => $one_F,
                );

my $selected = "";
$mw->Entry(-textvariable => \$selected,
          )->pack(-side => 'left',
                  -in => $one_F,
                 );

my $tb = $mw->Scrolled("Text",
                       -wrap => 'none',
                      )->pack(-side => 'left',
                              -in => $two_F,
                              -expand => 1,
                              -fill => 'both',
                             );

#
# Define the 'red' tag
#
$tb->tagConfigure('hl',
                  -foreground => "red",
                 );

$tb->tagBind('hl',
             "<Button-1>", sub{ ( $selected ) = &Select_Text( $tb,
                                                              'hl',
                                                              'line' )
+;
                              },
            );

#
# Define the underline tag
#
$tb->tagConfigure('ul',
                  -underline => 1,
                 );

$tb->tagBind('ul',
             "<Button-1>", sub{ ( $selected ) = &Select_Text( $tb,
                                                              'ul',
                                                              'word' )
+;
                              },
            );


#
# Add a bunch of repetitive lines to the text box, assigning some to 
#    tags...
#
for ( 1 ..100 )
{
   $tb->insert("$_.0", "This is line # $_\n" );

   if ( $_ % 5 == 0 )
   {
      $tb->tagAdd('hl', "$_.0 linestart", "$_.0 lineend" );
   }
   if ( $_ % 3 == 0 )
   {
      $tb->tagAdd('ul', "$_.8", "$_.12" );
   }
}


MainLoop();

exit 0;


#
# Get the text that is assigned to the tag.
#
sub Select_Text
{
   my( $tb,
       $tag,
       $type ) = @_;

   my $selected = "";

   if ( $type eq "line" )
   {
      chomp( $selected = $tb->get( $tb->tagNextrange("$tag",
                                                     "current -1 lines
+" ) ) );
   }
   elsif ( $type eq "word" )
   {
      chomp( $selected = $tb->get( $tb->tagNextrange("$tag",
                                                     "current wordstar
+t" ) ) );
   }

   return( $selected );

}

This was run on Win NT, using ActiveState Perl 5.6.1. This code will handle you having multiple words assigned to the same tag - it probably won't handle you assigning half a word to one tag and the other half to another tag.

Hopefully this helps. Even if you don't use it, I still enjoyed the challenge...

Pat