summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/search.pl
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 15:05:13 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 15:05:13 +0000
commit9fc19ef8e2dcd8bcf6a1d034b95c1de2b88e485c (patch)
treeee28de37fe0de6137d535fee2e64ecafaffefb91 /Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/search.pl
parent73b942cfb4ccf168f9c2b7f20a289b06f1f54a4b (diff)
New tlperl part II
git-svn-id: svn://tug.org/texlive/trunk@21424 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/search.pl')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/search.pl177
1 files changed, 177 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/search.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/search.pl
new file mode 100644
index 00000000000..ddc42213a0f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/search.pl
@@ -0,0 +1,177 @@
+# search.pl
+
+use Tk::LabEntry;
+use subs qw/search_flash_matches search_load_file search_text/;
+use vars qw/$TOP/;
+
+sub search {
+
+ # Create a top-level window with a text widget that allows you to load a
+ # file and highlight all instances of a given string. A LabEntry widget
+ # is used to collect the file name and search string.
+
+ my($demo) = @_;
+ $TOP = $MW->WidgetDemo(
+ -name => $demo,
+ -text =>'',
+ -title => 'Text Demonstration - Search and Highlight',
+ -iconname => 'search',
+ );
+
+ my $file_name = '';
+ my $file = $TOP->Frame;
+ my $fn = $file->LabEntry(-label => 'File Name: ', -width => 40,
+ -labelPack => [qw/-side left -anchor w/],
+ -textvariable => \$file_name)->pack(qw/-side left/);
+ $fn->Subwidget('entry')->focus;
+ my $fn_button = $file->Button(-text => 'Load File');
+ $fn_button->pack(qw/-side left -pady 5 -padx 10/);
+
+ my $search_string = '';
+ my $kind = 'exact';
+ my $string = $TOP->Frame;
+ my $ss = $string->LabEntry(-label => 'Search string:', -width => 40,
+ -labelPack => [qw/-side left -anchor w/],
+ -textvariable => \$search_string)->pack(qw/-side left/);
+ my $ss_button = $string->Button(-text => 'Highlight');
+ $ss_button->pack(qw/-side left -pady 5 -padx 10/);
+
+ my $text = $TOP->Scrolled(qw/Text -setgrid true -scrollbars e/);
+
+ my $subframe = $TOP->Frame;
+ my $exact = $subframe->Radiobutton(-text => 'Exact match',
+ -variable => \$kind,
+ -value => 'exact');
+ my $regexp = $subframe->Radiobutton(-text => 'Regular expression',
+ -variable => \$kind,
+ -value => 'regexp');
+ $exact->pack(qw/-side left/, -fill => 'x');
+ $regexp->pack(qw/-side right/, -fill => 'x');
+
+ $file->pack(qw/-side top -fill x/);
+ $string->pack(qw/-side top -fill x/);
+ $subframe->pack(qw/-side top -fill x/);
+ $text->pack(qw/-expand yes -fill both/);
+
+ my $command = sub {search_load_file $text, \$file_name, $ss};
+ $fn_button->configure(-command => $command);
+ $fn->bind('<Return>' => $command);
+
+ $command = sub {search_text $text, \$search_string, 'search', $kind};
+ $ss_button->configure(-command => $command);
+ $ss->bind('<Return>' => $command);
+
+ # Set up display styles for text highlighting.
+
+ if ($TOP->depth > 1) {
+ search_flash_matches $text,
+ ['configure', 'search',
+ -background => '#ce5555', -foreground => 'white'], 800,
+ ['configure', 'search',
+ -background => undef, -foreground => undef], 200;
+ } else {
+ search_flash_matches $text,
+ ['configure', 'search',
+ -background => 'black', -foreground => 'white'], 800,
+ ['configure', 'search',
+ -background => undef, -foreground => undef], 200;
+ }
+
+ $text->insert('0.0', 'This window demonstrates how to use the tagging facilities in text
+widgets to implement a searching mechanism. First, type a file name
+in the top entry, then type <Return> or click on "Load File". Then
+type a string in the lower entry and type <Return> or click on
+"Highlight". This will cause all of the instances of the string to
+be tagged with the tag "search", and it will arrange for the tag\'s
+display attributes to change to make all of the strings blink.');
+
+ $text->mark(qw/set insert 0.0/);
+
+} # end search
+
+sub search_flash_matches {
+
+ # The procedure below is invoked repeatedly to invoke two commands at
+ # periodic intervals. It normally reschedules itself after each execution
+ # but if an error occurs (e.g. because the window was deleted) then it
+ # doesn't reschedule itself.
+ # Arguments:
+ #
+ # w - Text widget reference.
+ # cmd1 - Reference to a list of tag options.
+ # sleep1 - Ms to sleep after executing cmd1 before executing cmd2.
+ # cmd2 - Reference to a list of tag options.
+ # sleep2 - Ms to sleep after executing cmd2 before executing cmd1 again.
+
+ my($w, $cmd1, $sleep1, $cmd2, $sleep2) = @_;
+
+ $w->tag(@{$cmd1});
+ $w->after($sleep1,
+ [\&search_flash_matches, $w, $cmd2, $sleep2, $cmd1, $sleep1]);
+
+} # end search_flash_matches
+
+sub search_load_file {
+
+ # The utility procedure below loads a file into a text widget, discarding
+ # the previous contents of the widget. Tags for the old widget are not
+ # affected, however.
+ # Arguments:
+ #
+ # w - The window into which to load the file. Must be a text widget.
+ # file - Reference to the name of the file to load. Must be readable.
+ # e - Entry widget to get next focus.
+
+ my ($w, $file, $e) = @_;
+
+ my ($buf, $bytes) = ('', 0);
+
+ if (not open(F, "<$$file")) {
+ $MW->Dialog(
+ -title => 'File Not Found',
+ -text => "$!: '$$file'",
+ -bitmap => 'error',
+ )->Show;
+ return;
+ }
+ $w->delete(qw/1.0 end/);
+ $bytes = read F, $buf, 10_000; # after all, it IS just an example
+ $w->insert('end', $buf);
+ if ($bytes == 10000) {
+ $w->insert('end', "\n\n**************** File truncated at 10,000 bytes! ****************\n");
+ }
+ close F;
+
+ $e->Subwidget('entry')->focus;
+
+} # end search_load_file
+
+sub search_text {
+
+ # The utility procedure below searches for all instances of a given
+ # 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 is done
+ # using exact matching only; no special characters.
+ # tag - Tag to apply to each instance of a matching string.
+
+ my($w, $string, $tag, $kind) = @_;
+
+ return unless ref($string) && length($$string);
+
+ $w->tagRemove($tag, qw/0.0 end/);
+ my($current, $length) = ('1.0', 0);
+
+ 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
+
+1;