Color Coding Text in a Tk::Text Widget 
Author Message
 Color Coding Text in a Tk::Text Widget

Has anybody written a function that will search through a Text Widget
and change the color for certain words?  Say, I wanted to make an
editor for perl and I wanted to color code function names, variables,
comments and such.  Is there something that does this already?

Thanks,
Cristov



Tue, 19 Jul 2005 10:19:57 GMT  
 Color Coding Text in a Tk::Text Widget
Have you tried working "tagConfigure" into a search loop?

$textWidget->tagConfigure("Blue", -foreground=> "#0000FF");


Quote:
> Has anybody written a function that will search through a Text Widget
> and change the color for certain words?  Say, I wanted to make an
> editor for perl and I wanted to color code function names, variables,
> comments and such.  Is there something that does this already?

> Thanks,
> Cristov



Tue, 19 Jul 2005 19:02:00 GMT  
 Color Coding Text in a Tk::Text Widget

Quote:

> Has anybody written a function that will search through a Text Widget
> and change the color for certain words?  Say, I wanted to make an
> editor for perl and I wanted to color code function names, variables,
> comments and such.  Is there something that does this already?

There's a widget demo that does that.

Quote:
> Thanks,
> Cristov

--

'other perl hacker';$z='createText';$c=$m->Canvas(-wi,$_[1],-he,25)->grid;$c->$
En'.
'ter>',sub{$y=int(rand($m->screenheight));$m->geometry("+$y+$y")});MainLoop;


Tue, 19 Jul 2005 22:44:37 GMT  
 Color Coding Text in a Tk::Text Widget

Quote:

> Has anybody written a function that will search through a Text Widget
> and change the color for certain words?  Say, I wanted to make an
> editor for perl and I wanted to color code function names, variables,
> comments and such.  Is there something that does this already?

> Thanks,
> Cristov

I wrote a module as a compound widget that does what you want for both a
text widget and for a notebook full of text widgets.  It was written
before I fully understood how to go about writing compound widgets
because "Learning Perl/Tk" (without a doubt the *worst* book ever from
O'Reilly) kept telling me to "look at it sideways" and my eyes only got
all slanty and {*filter*}shot when I did that.

This module uses HistEntry but if you change this back to a regular
entry and uncomment the code which makes a normal entry a histentry, you
will not need the HistEntry.  The module contains its own pod and a
sample demo is included in the pod.  Of course, your mileage may vary.
One of these days I'll get around to making it more like the other
composite widgets in CPAN and submit it to the library.  One of these
days.

package Tk::NoteBookSearch;

#use strict;

require Tk;
require Tk::Toplevel;
require Tk::Frame;
require Tk::DialogBox;
require HistEntry;


use base qw(Tk::Frame);
use Carp;

Construct Tk::Widget 'NoteBookSearch';

my $Sentry;
# search frame

sub Populate {

# Unlike the author of Learning Perl/Tk, I would not recommend
# that you look at this "sideways".


    $cw->{-search_direction}=exists($args->{-search_direction})?
        delete($args->{-search_direction}):'forward';
    $cw->{-search_type}=exists($args->{-search_type})?
        delete($args->{-search_type}):'exact';
    $cw->{-search_next}=exists($args->{-search_next})?
        delete($args->{-search_next}):'Next';
    $cw->{-search_case}=exists($args->{-search_case})?
        delete($args->{-search_case}):'';
    my($search_tags_ref)=exists($args->{-search_tags})?
        delete($args->{-search_tags}):[qw(red3 green4 blue3)];

    $cw->{-search_tag_color}=exists($args->{-search_tag_color})?
        delete($args->{-search_tag_color}):$search_tags_ref->[0];

    $cw->SUPER::Populate($args);
#    $cw->{'srch_list_lifo'}=[];
#    $cw->{'srch_list_lifo_pointer'}=0;
    $cw->{'search_string'}='';

#    my $f1_S=$cw->
#       Frame(-relief=>'groove',-borderwidth=>2)->
#    pack(-side=>"right", -anchor=>"e",-anchor=>"ne");
#    my($f1_S)=$cw;

# a grid packed frame with search type options
# grid packer does not work like I thought it did, so this is a hack
# to get it to look right.  I'm SURE there is a better way to do this.
# I'll get to it SOMEDAY... trust me...

    my $f1_1_L=$cw->Frame()->pack(-side=>'left');

    my($Direction_check,$Type_check,$FindWhat_check,$Case_check);

    $f1_1_L->
        Label(-textvariable=>\$cw->{-search_direction},-width=>8)->
            grid($Direction_check=$f1_1_L->
                 Checkbutton(-text=>'Direction',
                             -variable=>\$cw->{-search_direction},
                             -width=>10,
                             -onvalue=>'forward',
                             -offvalue=>'backward'),

                 $f1_1_L->
                 Label(-textvariable=>\$cw->{-search_type},-width=>8),
                 $Type_check=$f1_1_L->
                 Checkbutton(-text=>'Type',
                             -variable=>\$cw->{-search_type},
                             -width=>6,
                             -onvalue=>'exact',
                             -offvalue=>'regexp'));

    $f1_1_L->
        Label(-textvariable=>\$cw->{-search_next},
              -width=>8)->
                  grid($FindWhat_check=$f1_1_L->
                       Checkbutton(-text=>'Find What',
                                   -variable=>\$cw->{-search_next},
                                   -width=>10,
                                   -onvalue=>'All',
                                   -offvalue=>'Next'),

                       $f1_1_L->
                       Label(-textvariable=>\$cw->{-search_case},-width=>8),
                       $Case_check=$f1_1_L->
                       Checkbutton(-text=>'Case',
                                   -variable=>\$cw->{-search_case},
                                   -width=>6,
                                   -onvalue=>'',
                                   -offvalue=>'nocase'));

# search string entry box

#    my $Sentry=$cw->
#       Entry(-textvariable=>\$cw->{'search_string'},-width=>40)->
#           pack(-side=>'left',-expand=>1,-fill=>'x');
#    $Sentry->bind('<Return>',\&SearchActiveWindow);
#
#    $Sentry->bind('<Prior>',\&PriorSearchEntry);
#    $Sentry->bind('<Up>',\&PriorSearchEntry);
#    
#    $Sentry->bind('<Next>',\&NextSearchEntry);    
#    $Sentry->bind('<Down>',\&NextSearchEntry);
    $Sentry=$cw->
        SimpleHistEntry(-dup=>0,-textvariable=>\$cw->{'search_string'},
                        -width=>40,
                        -command=>\&SearchActiveWindow)->
            pack(-side=>'left',-expand=>1,-fill=>'x');
    $cw->Advertise('SimpleHistEntry'=>$Sentry);

# SEARCH command button

    my $Sbutton=$cw->
        Button(-text=>"Search")->
            pack(-side=>"left");
    $Sbutton->configure(-command=>[\&SearchActiveWindow,$Sbutton]);
    $Sbutton->
        bind("<Button-2>",\&SinkButton);
    $Sbutton->
        bind("<Button-3>",sub{undef($cw->{'search_string'});
                              SearchActiveWindow($Sbutton)});
    $Sbutton->
        bind("<ButtonRelease-2>",[\&GetSearchCount,$Sbutton]);

# RESET command button
# left mouse resets this color tag

    my $Resetbutton=$cw->
        Button(-text=>"Reset")->
            pack(-side=>"left");
    $Resetbutton->configure(-command=>[\&LeftResetButton,$Resetbutton]);
    $Resetbutton->
        bind("<Button-2>",\&SinkButton);
    $Resetbutton->
        bind("<ButtonRelease-2>",\&MiddleResetButton);

# middle mouse resets all color tags in all windows
# need to bind to a routine to depress button because its not a normal
binding

    $Resetbutton->
        bind("<Button-3>",\&SinkButton);
    $Resetbutton->
        bind("<ButtonRelease-3>",\&RightResetButton);

# RGB tag colors


        my($color,$tag)=split(/:/);
        $tag=uc(substr($color,0,1)) unless($tag ne '');
        $cw->
            Radiobutton(-text=>$tag,
                        -value=>$color,
                        -variable=>\$cw->{-search_tag_color},
                        -foreground=>$color,
                        -selectcolor=>$color)->
                            pack(-side=>"left");
    }
    $cw->ConfigSpecs(-notebook=>[qw(METHOD notebook Notebook),undef],
                     -foreground=>[q(SELF)]);

Quote:
}

##########

sub notebook {

# I have absolutely no friggin clue why this was needed, I just know
# it did not work until I did it this way.

    my($self)=shift;
    $self->{-notebook}=shift;
    confess("-notebook parameter is not a notebook or text widget!
'$self->{-notebook}'") unless ((ref($self->{-notebook})=~/NoteBook/) ||
(ref($self->{-notebook})=~/Text/));
#    print STDERR "set -notebook to $self->{-notebook}\n";

Quote:
}

##########
# all of the next routines are bound to widgets so they are called with
# the widget as the first argument.
##########

#sub PriorSearchEntry {
#
#    my($self)=shift->parent;
#
#    if ($self->{'srch_list_lifo_pointer'} >=
#       $#{$self->{'srch_list_lifo'}}) {
#       $self->{'srch_list_lifo_pointer'}=$#{$self->{'srch_list_lifo'}};
#       $self->bell();
#    } else {
#
$self->{'search_string'}=$self->{'srch_list_lifo'}->[++$self->{'srch_list_lifo_pointer'}];
#    }
#}

##########

#sub NextSearchEntry {
#
#    my($self)=shift->parent;
#
#    if ($self->{'srch_list_lifo_pointer'}< 1) {
#       $self->{'srch_list_lifo_pointer'}=0;
#       $self->bell();
#    } else {
#
$self->{'search_string'}=$self->{'srch_list_lifo'}->[--$self->{'srch_list_lifo_pointer'}];
#    }
#}

##########

sub SinkButton {

# make the reset and search buttons behave correctly for middle and
right mouse

    shift->configure(-relief=>'sunken');

Quote:
}

##########

sub LeftResetButton {
    my($self)=shift->parent;
    ResetSearchActiveWindow($self);

Quote:
}

##########

sub MiddleResetButton {

    my($self)=shift;
    $self->configure(-relief=>'raised');
    $self=$self->parent;
    ResetAllActiveWindow($self);

Quote:
}

##########

sub RightResetButton {

    my($self)=shift;
    $self->configure(-relief=>'raised');
    $self=$self->parent;
    $self->{'search_string'}='';
    ResetAllWindows($self);

Quote:
}

##########

sub GetSearchCount{

    my($self)=shift;
    $self=$self->parent;

    my($button,$done);
    $_[0]->configure(-relief=>'raised');
    unless (defined($count_dialog)) {
# count dialog box does not yet exist, create it
        $count_dialog=$self->
            DialogBox(-title=>"Count",-buttons=>["OK","Cancel"]);
        $count_dialog->add('Label',-text=>"Enter search count")->pack;

$count_dialog->add('Entry',-textvariable=>\$self->{'search_string_count'},-width=>4)->pack;
    }
    do {
# show it until you get a positive number or cancel

        $self->{'search_string_count'}=1;
        $button=$count_dialog->Show;
        $done=($self->{'search_string_count'}=~/^\d+$/);
        $mw->bell() if (!$done);
    } until ($done);
    if ($button eq 'Cancel') {
        $self->{'search_string_count'}=undef;
        return;
    }
    print STDERR "button $button, count is
$self->{'search_string_count'}\n" if ($main::debug);
    SearchActiveWindow($self);

Quote:
}

##########
# these next routines are all called with a NoteBookSearch object
##########

sub ResetSearchActiveWindow {

    my $self=shift;
    my $text_widget=shift;
    my $tag=shift;

# reset a particular search tag in this window

    $text_widget=FindActiveWindow($self) unless (ref($text_widget));
    $tag="search_$self->{-search_tag_color}" if ($tag eq '');
    $text_widget->tagRemove($tag,'0.0','end');
    $text_widget->markSet('insert','1.0');

Quote:
}

##########

sub ResetAllActiveWindow {

    my $self=shift;
    my $text_widget=shift;

# reset all standard search tags in this window

    $text_widget=FindActiveWindow($self) unless (ref($text_widget));

        ResetSearchActiveWindow($self,$text_widget,"search_$_");
    }

Quote:
}

##########

sub ResetAllWindows {

    my $self=shift;
    my $notebook=$self->{-notebook};

#reset all standard search tags in all windows

    foreach (TraverseNotebook($notebook)) {
        ResetAllActiveWindow($self,$_);
    }

Quote:
}

##########

sub TraverseNotebook {

    my $thing=shift;
    my $bool=shift;

    foreach ($thing->children) {
        if ((ref($_)=~/Tk::Text/) || (ref($_)=~/Tk::ROText/)) {

        } elsif (ref($_) eq 'Tk::Frame') {

...

read more »



Sun, 24 Jul 2005 05:36:16 GMT  
 Color Coding Text in a Tk::Text Widget

Quote:

> stuff

I notice that when I checked, my news poster mangled the text by
wrapping the lines.  Be sure you double check all quoted strings to make
sure they do not contain extra newlines.


Sun, 24 Jul 2005 05:40:53 GMT  
 
 [ 5 post ] 

 Relevant Pages 

1. Q: Changing Text-Color in Text-Widget?

2. Colors in Text widget and select colors

3. ANSI color codes in Tk::Text

4. Color Changes in Text widget

5. color in the text widget

6. Coloring tags in text widget

7. color of insertion cursor in text widgets

8. Text color in my scrolled->Listbox widget

9. Text widget - change background color at insertcursor

10. how to use different colors in same line in text widget

11. Text widget and colors

12. Newby to Tk having problems getting colored text in a

 

 
Powered by phpBB® Forum Software