Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
This gets to be pretty tricky from what I remember from past attempts at it. It's a groggy Monday morning for me to be too inspired. I have some pointers though:

You might want to look at the "editModified" flag of the text box. See Using Tk::Text and '<<Modified>>' or Tk::Text with Vi; Silly or not?

The problem with the <<Modified>> tag, is that it will only report the first letter, and can cause deep recursion errors, as shown here.

#!/usr/bin/perl use warnings; use strict; use Tk; use Tk::Text; my $MW = MainWindow->new( -title => "Tk::Text test", -width => 200, -height => 200 ); my $text = $MW->Text( -height => 10, -width => 40, -wrap => 'word' ); $text->pack( -side => 'top', -fill => 'both' ); $text->bind( '<<Modified>>' => sub { getText( $text, @_ ); } ); $MW->Button(-text=>'Clear Modified Flag', -command => sub{ $text->editModified(0) } )->pack(); MainLoop; sub getText { my ( $t, @args ) = @_; my $text = $t->get( '0.0', 'end' ); # will cause deep recursion error # $t->editModified(0); print "Got: $text\n"; return if ( !$text ); return 1; }
Or look at this, to circumvent the deep recursion problem.

#!/usr/bin/perl use strict; use warnings; use Tk; use Tk::TextUndo; my $top = MainWindow->new; my $text = $top->TextUndo->pack( -expand => 'yes', -fill => 'both' ); $text->bindtags( [ $text, ref($text), $text->toplevel, 'all' ] ); $text->bind( '<KeyPress>', [ \&callback, Ev('K') ] ); MainLoop; sub callback { my ( $widget, $keysym ) = @_; print "\n$keysym key pressed"; return if ( ( length($keysym) > 1 and $keysym =~ /\p{Upper}/ and $keysym !~ /Delete|BackSpace|Return|Tab/ ) or ( $keysym eq 'Delete' and $widget->index('insert') eq $widget->index('end -1c') +) or ( $keysym eq 'BackSpace' and $widget->index('insert') eq '1.0' ) ); print ' - text is edited.'; }

and a way to get current tags positions

#!/usr/bin/perl use warnings; use strict; use Tk; #subs borrowed from widget demo my $usage = "USAGE: $0 filename searchstring (regexp|exact)\n"; my $mw = MainWindow->new( -bg => 'black' ); $mw->geometry('100x30+100+15'); my ($file_name, $search_string, $kind) = @ARGV; if(! -e $file_name){print $usage; die "No file found $!\n"} if($search_string eq ''){print $usage; die "Need a search string";} my $file; open (FH,"< $file_name"); read( FH, $file, -s FH ); close FH; $kind ||= 'exact'; my $text = $mw->Scrolled(qw/Text -setgrid true -scrollbars e/); $text->tagConfigure( 'search', -foreground => 'red',-background => ' +white' ); $text->insert('0.0', $file); $text->mark(qw/set insert 0.0/); $text->pack(qw/-expand yes -fill both/); &search_text($text,\$search_string,'search',$kind); MainLoop; ###################################################################### +#3 sub search_text { # The utility procedure below searches for all instances of a give +n # string in a text widget and applies a given tag to each instance + found. # Arguments: # # w - The window in which to search. Must be a text widget. # string - Reference to the string to search for. The search i +s done # using exact matching only; no special characters. # tag - Tag to apply to each instance of a matching string. my ( $w, $string, $tag, $kind ) = @_; #print "@_\n"; return unless ref($string) && length($$string); $w->tagRemove( $tag, qw/0.0 end/ ); my ( $current, $length ) = ( '1.0', 0 ); my ($current_last, $length_last); while (1) { $current = $w->search( -count => \$length, "-$kind", $$string, $current +, 'end' ); last if not $current; warn "Posn=$current count=$length\n", $w->tagAdd( $tag, $current, "$current + $length char" ); $current = $w->index("$current + $length char"); } } # end search_text

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

In reply to Re: Tk::Entry selection problem by zentara
in thread Tk::Entry selection problem by grizzley

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



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2024-03-28 21:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found