Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # search.pl |
2 | ||
3 | use Tk::LabEntry; | |
4 | use subs qw/search_flash_matches search_load_file search_text/; | |
5 | use vars qw/$TOP/; | |
6 | ||
7 | sub search { | |
8 | ||
9 | # Create a top-level window with a text widget that allows you to load a | |
10 | # file and highlight all instances of a given string. A LabEntry widget | |
11 | # is used to collect the file name and search string. | |
12 | ||
13 | my($demo) = @_; | |
14 | $TOP = $MW->WidgetDemo( | |
15 | -name => $demo, | |
16 | -text =>'', | |
17 | -title => 'Text Demonstration - Search and Highlight', | |
18 | -iconname => 'search', | |
19 | ); | |
20 | ||
21 | my $file_name = ''; | |
22 | my $file = $TOP->Frame; | |
23 | my $fn = $file->LabEntry(-label => 'File Name: ', -width => 40, | |
24 | -labelPack => [qw/-side left -anchor w/], | |
25 | -textvariable => \$file_name)->pack(qw/-side left/); | |
26 | $fn->Subwidget('entry')->focus; | |
27 | my $fn_button = $file->Button(-text => 'Load File'); | |
28 | $fn_button->pack(qw/-side left -pady 5 -padx 10/); | |
29 | ||
30 | my $search_string = ''; | |
31 | my $string = $TOP->Frame; | |
32 | my $ss = $string->LabEntry(-label => 'Search string:', -width => 40, | |
33 | -labelPack => [qw/-side left -anchor w/], | |
34 | -textvariable => \$search_string)->pack(qw/-side left/); | |
35 | my $ss_button = $string->Button(-text => 'Highlight'); | |
36 | $ss_button->pack(qw/-side left -pady 5 -padx 10/); | |
37 | ||
38 | my $text = $TOP->Scrolled(qw/Text -setgrid true -scrollbars e/); | |
39 | ||
40 | $file->pack(qw/-side top -fill x/); | |
41 | $string->pack(qw/-side top -fill x/); | |
42 | $text->pack(qw/-expand yes -fill both/); | |
43 | ||
44 | my $command = sub {search_load_file $text, \$file_name, $ss}; | |
45 | $fn_button->configure(-command => $command); | |
46 | $fn->bind('<Return>' => $command); | |
47 | ||
48 | $command = sub {search_text $text, \$search_string, 'search'}; | |
49 | $ss_button->configure(-command => $command); | |
50 | $ss->bind('<Return>' => $command); | |
51 | ||
52 | # Set up display styles for text highlighting. | |
53 | ||
54 | if ($TOP->depth > 1) { | |
55 | search_flash_matches $text, | |
56 | ['configure', 'search', | |
57 | -background => '#ce5555', -foreground => 'white'], 800, | |
58 | ['configure', 'search', | |
59 | -background => undef, -foreground => undef], 200; | |
60 | } else { | |
61 | search_flash_matches $text, | |
62 | ['configure', 'search', | |
63 | -background => 'black', -foreground => 'white'], 800, | |
64 | ['configure', 'search', | |
65 | -background => undef, -foreground => undef], 200; | |
66 | } | |
67 | ||
68 | $text->insert('0.0', 'This window demonstrates how to use the tagging facilities in text | |
69 | widgets to implement a searching mechanism. First, type a file name | |
70 | in the top entry, then type <Return> or click on "Load File". Then | |
71 | type a string in the lower entry and type <Return> or click on | |
72 | "Highlight". This will cause all of the instances of the string to | |
73 | be tagged with the tag "search", and it will arrange for the tag\'s | |
74 | display attributes to change to make all of the strings blink.'); | |
75 | ||
76 | $text->mark(qw/set insert 0.0/); | |
77 | ||
78 | } # end search | |
79 | ||
80 | sub search_flash_matches { | |
81 | ||
82 | # The procedure below is invoked repeatedly to invoke two commands at | |
83 | # periodic intervals. It normally reschedules itself after each execution | |
84 | # but if an error occurs (e.g. because the window was deleted) then it | |
85 | # doesn't reschedule itself. | |
86 | # Arguments: | |
87 | # | |
88 | # w - Text widget reference. | |
89 | # cmd1 - Reference to a list of tag options. | |
90 | # sleep1 - Ms to sleep after executing cmd1 before executing cmd2. | |
91 | # cmd2 - Reference to a list of tag options. | |
92 | # sleep2 - Ms to sleep after executing cmd2 before executing cmd1 again. | |
93 | ||
94 | my($w, $cmd1, $sleep1, $cmd2, $sleep2) = @_; | |
95 | ||
96 | $w->tag(@{$cmd1}); | |
97 | $w->after($sleep1, | |
98 | [\&search_flash_matches, $w, $cmd2, $sleep2, $cmd1, $sleep1]); | |
99 | ||
100 | } # end search_flash_matches | |
101 | ||
102 | sub search_load_file { | |
103 | ||
104 | # The utility procedure below loads a file into a text widget, discarding | |
105 | # the previous contents of the widget. Tags for the old widget are not | |
106 | # affected, however. | |
107 | # Arguments: | |
108 | # | |
109 | # w - The window into which to load the file. Must be a text widget. | |
110 | # file - Reference to the name of the file to load. Must be readable. | |
111 | # e - Entry widget to get next focus. | |
112 | ||
113 | my ($w, $file, $e) = @_; | |
114 | ||
115 | my ($buf, $bytes) = ('', 0); | |
116 | ||
117 | if (not open(F, "<$$file")) { | |
118 | $MW->Dialog( | |
119 | -title => 'File Not Found', | |
120 | -text => $OS_ERROR, | |
121 | -bitmap => 'error', | |
122 | )->Show; | |
123 | return; | |
124 | } | |
125 | $w->delete(qw/1.0 end/); | |
126 | $bytes = read F, $buf, 10000; # after all, it IS just an example | |
127 | $w->insert('end', $buf); | |
128 | if ($bytes == 10000) { | |
129 | $w->insert('end', "\n\n**************** File truncated at 10,000 bytes! ****************\n"); | |
130 | } | |
131 | close F; | |
132 | ||
133 | $e->Subwidget('entry')->focus; | |
134 | ||
135 | } # end search_load_file | |
136 | ||
137 | sub search_text { | |
138 | ||
139 | # The utility procedure below searches for all instances of a given | |
140 | # string in a text widget and applies a given tag to each instance found. | |
141 | # Arguments: | |
142 | # | |
143 | # w - The window in which to search. Must be a text widget. | |
144 | # string - Reference to the string to search for. The search is done | |
145 | # using exact matching only; no special characters. | |
146 | # tag - Tag to apply to each instance of a matching string. | |
147 | ||
148 | my($w, $string, $tag) = @_; | |
149 | ||
150 | return unless ref($string) && length($$string); | |
151 | ||
152 | $w->tag('remove', $tag, qw/0.0 end/); | |
153 | my($current, $length) = ('1.0', 0); | |
154 | ||
155 | while (1) { | |
156 | $current = $w->search(-count => \$length, $$string, $current, 'end'); | |
157 | last if not $current; | |
158 | $w->tag('add', $tag, $current, "$current + $length char"); | |
159 | $current = $w->index("$current + $length char"); | |
160 | } | |
161 | ||
162 | } # end search_text | |
163 | ||
164 | 1; |