~ubuntu-branches/ubuntu/natty/perl-tk/natty

« back to all changes in this revision

Viewing changes to demos/demos/widget_lib/mkTxtSearch.pl

  • Committer: Bazaar Package Importer
  • Author(s): Stephen Zander
  • Date: 2004-03-14 13:54:44 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040314135444-prc09u2or4dbr3to
Tags: 1:800.025-2
Add xlibs-dev to Build-Depends:,
Closes: #237942

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
 
2
 
sub text_load_file {
3
 
 
4
 
    # The utility procedure below loads a file into a text widget, discarding the previous contents of the widget. Tags for the
5
 
    # old widget are not affected, however.
6
 
    # Arguments:
7
 
    #
8
 
    # w -       The window into which to load the file.  Must be a text widget.
9
 
    # file -    The name of the file to load.  Must be readable.
10
 
 
11
 
    my ($w, $file) = @_;
12
 
 
13
 
    my ($buf, $bytes) = ('', 0);
14
 
 
15
 
    if (not open(F, "<$file")) {
16
 
        $top->Dialog('File Not Found', $!, 'error', 'OK', 'OK')->Show('-global');
17
 
        return;
18
 
    }
19
 
    $w->delete('1.0', 'end');
20
 
    $bytes = read F, $buf, 10000;       # after all, it IS just an example
21
 
    $w->insert('end', $buf);
22
 
    if ($bytes == 10000) {
23
 
        $w->insert('end', "\n\n**************** File truncated at 10,000 bytes! ****************\n");
24
 
    }
25
 
    close F;
26
 
 
27
 
} # end text_load_file
28
 
 
29
 
 
30
 
sub text_search {
31
 
 
32
 
    # The utility procedure below searches for all instances of a given string in a text widget and applies a given tag
33
 
    # to each instance found.
34
 
    # Arguments:
35
 
    #
36
 
    # w -       The window in which to search.  Must be a text widget.
37
 
    # string -  The string to search for.  The search is done using exact matching only;  no special characters.
38
 
    # tag -     Tag to apply to each instance of a matching string.
39
 
 
40
 
    my($w, $string, $tag) = @_;
41
 
 
42
 
    $w->tag('remove',  $tag, '0.0', 'end');
43
 
    (my $num_lines) = $w->index('end') =~ /(\d*)\.\d*/;
44
 
    my($l, $i) = length $string;
45
 
 
46
 
    for($i = 1; $i <=$num_lines; $i++) {
47
 
        my $line = $w->get("${i}.0", "${i}.1000");
48
 
        next if not defined $line or $line !~ /$string/;
49
 
        my $offset = 0;
50
 
        while (1) {
51
 
            my $index = index $line, $string, $offset;
52
 
            last if $index == -1;
53
 
            $offset += $index;
54
 
            $w->tag('add', $tag, sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$l));
55
 
            $offset += $l;
56
 
            $line = substr $line, $index+$l;
57
 
        } # whilend
58
 
    } # forend
59
 
 
60
 
} # end text_search
61
 
 
62
 
 
63
 
sub text_toggle {
64
 
 
65
 
    # The procedure below is invoked repeatedly to invoke two commands at periodic intervals.  It normally reschedules itself
66
 
    # after each execution but if an error occurs (e.g. because the window was deleted) then it doesn't reschedule itself.
67
 
    # Arguments:
68
 
    #
69
 
    # w -       Text widget reference.
70
 
    # cmd1 -    Reference to a list of tag options.
71
 
    # sleep1 -  Ms to sleep after executing cmd1 before executing cmd2.
72
 
    # cmd2 -    Reference to a list of tag options.
73
 
    # sleep2 -  Ms to sleep after executing cmd2 before executing cmd1 again.
74
 
 
75
 
    my($w, $cmd1, $sleep1, $cmd2, $sleep2) = @_;
76
 
 
77
 
    # return if not Exists $w;
78
 
    $w->tag(@{$cmd1});
79
 
    $w->after($sleep1, [sub {text_toggle(@_)}, $w, $cmd2, $sleep2, $cmd1, $sleep1]);
80
 
 
81
 
} # end text_toggle
82
 
 
83
 
sub mkTxtSearch {
84
 
 
85
 
    # Create a top-level window with a text widget that allows you to load a file and highlight all instances of a given string.
86
 
 
87
 
    $mkTxtSearch->destroy if Exists($mkTxtSearch);
88
 
    $mkTxtSearch = $top->Toplevel();
89
 
    my $w = $mkTxtSearch;
90
 
    dpos $w;
91
 
    $w->title('Text Demonstration - Search and Highlight');
92
 
    $w->iconname('Text Search');
93
 
 
94
 
    $file_name = '';
95
 
    my $w_file = $w->Frame();
96
 
    my $w_file_label = $w_file->Label(-text => 'File name:', -width => 13, -anchor => 'w');
97
 
    my $w_file_entry = $w_file->Entry(-width => 40, -textvariable => \$file_name);
98
 
    my $w_file_button = $w_file->Button(-text => 'Load File');
99
 
    $w_file_label->pack(-side => 'left');
100
 
    $w_file_entry->pack(-side => 'left');
101
 
    $w_file_button->pack(-side => 'left', -pady => 5, -padx => 10);
102
 
 
103
 
    $search_string = '';
104
 
    my $w_string = $w->Frame();
105
 
    my $w_string_label = $w_string->Label(-text => 'Search string:', -width => 13, -anchor => 'w');
106
 
    my $w_string_entry = $w_string->Entry(-width => 40, -textvariable => \$search_string);
107
 
    my $w_string_button = $w_string->Button(-text => 'Highlight');
108
 
    $w_string_label->pack(-side => 'left');
109
 
    $w_string_entry->pack(-side => 'left');
110
 
    $w_string_button->pack(-side => 'left', -pady => 5, -padx => 10);
111
 
 
112
 
    my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]);
113
 
    my $w_t = $w->Text(-setgrid => 'true');
114
 
    my $w_s = $w->Scrollbar(-command => ['yview', $w_t]);
115
 
    $w_t->configure(-yscrollcommand => ['set', $w_s]);
116
 
    $w_file->pack(-side => 'top', -fill => 'x');
117
 
    $w_string->pack(-side => 'top', -fill => 'x');
118
 
    $w_ok->pack(-side => 'bottom');
119
 
    $w_s->pack(-side => 'right', -fill => 'y');
120
 
    $w_t->pack(-expand => 'yes', -fill => 'both');
121
 
 
122
 
    $w_file_button->configure(-command => [sub {text_load_file($_[0], $file_name)}, $w_t]);
123
 
    $w_file_entry->bind('<Return>' =>
124
 
                        [sub {shift; text_load_file($_[0], $file_name); $_[1]->focus}, $w_t, $w_string_entry]);
125
 
    $w_string_button->configure(-command => [sub {text_search($_[0], $search_string, 'search')}, $w_t]);
126
 
    $w_string_entry->bind('<Return>' => [sub {shift; text_search($_[0], $search_string, 'search')}, $w_t]);
127
 
 
128
 
    # Set up display styles for text highlighting.
129
 
 
130
 
    if ($mkTxtSearch->depth > 1) {
131
 
        text_toggle($w_t, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,
132
 
                          ['configure', 'search', -background => undef,       -foreground => undef],   200);
133
 
      } else {
134
 
        text_toggle($w_t, ['configure', 'search', -background => 'black',     -foreground => 'white'], 800,
135
 
                          ['configure', 'search', -background => undef,       -foreground => undef],   200);
136
 
      }
137
 
 
138
 
    $w_t->insert('0.0', 'This window demonstrates how to use the tagging facilities in text
139
 
widgets to implement a searching mechanism.  First, type a file name
140
 
in the top entry, then type <Return> or click on "Load File".  Then
141
 
type a string in the lower entry and type <Return> or click on
142
 
"Load File".  This will cause all of the instances of the string to
143
 
be tagged with the tag "search", and it will arrange for the tag\'s
144
 
display attributes to change to make all of the strings blink.');
145
 
 
146
 
    $w_t->mark('set', 'insert', '0.0');
147
 
 
148
 
    $w->bind('<Any-Enter>' => [sub {shift; shift->focus}, $w_file_entry]);
149
 
 
150
 
} # end mkTxtSearch
151
 
 
152
 
 
153
 
1;