1 | # search.tcl -- |
---|
2 | # |
---|
3 | # This demonstration script creates a collection of widgets that |
---|
4 | # allow you to load a file into a text widget, then perform searches |
---|
5 | # on that file. |
---|
6 | # |
---|
7 | # RCS: @(#) $Id: search.tcl,v 1.2 1998/09/14 18:23:30 stanton Exp $ |
---|
8 | |
---|
9 | if {![info exists widgetDemo]} { |
---|
10 | error "This script should be run from the \"widget\" demo." |
---|
11 | } |
---|
12 | |
---|
13 | # textLoadFile -- |
---|
14 | # This procedure below loads a file into a text widget, discarding |
---|
15 | # the previous contents of the widget. Tags for the old widget are |
---|
16 | # not affected, however. |
---|
17 | # |
---|
18 | # Arguments: |
---|
19 | # w - The window into which to load the file. Must be a |
---|
20 | # text widget. |
---|
21 | # file - The name of the file to load. Must be readable. |
---|
22 | |
---|
23 | proc textLoadFile {w file} { |
---|
24 | set f [open $file] |
---|
25 | $w delete 1.0 end |
---|
26 | while {![eof $f]} { |
---|
27 | $w insert end [read $f 10000] |
---|
28 | } |
---|
29 | close $f |
---|
30 | } |
---|
31 | |
---|
32 | # textSearch -- |
---|
33 | # Search for all instances of a given string in a text widget and |
---|
34 | # apply a given tag to each instance found. |
---|
35 | # |
---|
36 | # Arguments: |
---|
37 | # w - The window in which to search. Must be a text widget. |
---|
38 | # string - The string to search for. The search is done using |
---|
39 | # exact matching only; no special characters. |
---|
40 | # tag - Tag to apply to each instance of a matching string. |
---|
41 | |
---|
42 | proc textSearch {w string tag} { |
---|
43 | $w tag remove search 0.0 end |
---|
44 | if {$string == ""} { |
---|
45 | return |
---|
46 | } |
---|
47 | set cur 1.0 |
---|
48 | while 1 { |
---|
49 | set cur [$w search -count length $string $cur end] |
---|
50 | if {$cur == ""} { |
---|
51 | break |
---|
52 | } |
---|
53 | $w tag add $tag $cur "$cur + $length char" |
---|
54 | set cur [$w index "$cur + $length char"] |
---|
55 | } |
---|
56 | } |
---|
57 | |
---|
58 | # textToggle -- |
---|
59 | # This procedure is invoked repeatedly to invoke two commands at |
---|
60 | # periodic intervals. It normally reschedules itself after each |
---|
61 | # execution but if an error occurs (e.g. because the window was |
---|
62 | # deleted) then it doesn't reschedule itself. |
---|
63 | # |
---|
64 | # Arguments: |
---|
65 | # cmd1 - Command to execute when procedure is called. |
---|
66 | # sleep1 - Ms to sleep after executing cmd1 before executing cmd2. |
---|
67 | # cmd2 - Command to execute in the *next* invocation of this |
---|
68 | # procedure. |
---|
69 | # sleep2 - Ms to sleep after executing cmd2 before executing cmd1 again. |
---|
70 | |
---|
71 | proc textToggle {cmd1 sleep1 cmd2 sleep2} { |
---|
72 | catch { |
---|
73 | eval $cmd1 |
---|
74 | after $sleep1 [list textToggle $cmd2 $sleep2 $cmd1 $sleep1] |
---|
75 | } |
---|
76 | } |
---|
77 | |
---|
78 | set w .search |
---|
79 | catch {destroy $w} |
---|
80 | toplevel $w |
---|
81 | wm title $w "Text Demonstration - Search and Highlight" |
---|
82 | wm iconname $w "search" |
---|
83 | positionWindow $w |
---|
84 | |
---|
85 | frame $w.buttons |
---|
86 | pack $w.buttons -side bottom -fill x -pady 2m |
---|
87 | button $w.buttons.dismiss -text Dismiss -command "destroy $w" |
---|
88 | button $w.buttons.code -text "See Code" -command "showCode $w" |
---|
89 | pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 |
---|
90 | |
---|
91 | frame $w.file |
---|
92 | label $w.file.label -text "File name:" -width 13 -anchor w |
---|
93 | entry $w.file.entry -width 40 -textvariable fileName |
---|
94 | button $w.file.button -text "Load File" \ |
---|
95 | -command "textLoadFile $w.text \$fileName" |
---|
96 | pack $w.file.label $w.file.entry -side left |
---|
97 | pack $w.file.button -side left -pady 5 -padx 10 |
---|
98 | bind $w.file.entry <Return> " |
---|
99 | textLoadFile $w.text \$fileName |
---|
100 | focus $w.string.entry |
---|
101 | " |
---|
102 | focus $w.file.entry |
---|
103 | |
---|
104 | frame $w.string |
---|
105 | label $w.string.label -text "Search string:" -width 13 -anchor w |
---|
106 | entry $w.string.entry -width 40 -textvariable searchString |
---|
107 | button $w.string.button -text "Highlight" \ |
---|
108 | -command "textSearch $w.text \$searchString search" |
---|
109 | pack $w.string.label $w.string.entry -side left |
---|
110 | pack $w.string.button -side left -pady 5 -padx 10 |
---|
111 | bind $w.string.entry <Return> "textSearch $w.text \$searchString search" |
---|
112 | |
---|
113 | text $w.text -yscrollcommand "$w.scroll set" -setgrid true |
---|
114 | scrollbar $w.scroll -command "$w.text yview" |
---|
115 | pack $w.file $w.string -side top -fill x |
---|
116 | pack $w.scroll -side right -fill y |
---|
117 | pack $w.text -expand yes -fill both |
---|
118 | |
---|
119 | # Set up display styles for text highlighting. |
---|
120 | |
---|
121 | if {[winfo depth $w] > 1} { |
---|
122 | textToggle "$w.text tag configure search -background \ |
---|
123 | #ce5555 -foreground white" 800 "$w.text tag configure \ |
---|
124 | search -background {} -foreground {}" 200 |
---|
125 | } else { |
---|
126 | textToggle "$w.text tag configure search -background \ |
---|
127 | black -foreground white" 800 "$w.text tag configure \ |
---|
128 | search -background {} -foreground {}" 200 |
---|
129 | } |
---|
130 | $w.text insert 1.0 \ |
---|
131 | {This window demonstrates how to use the tagging facilities in text |
---|
132 | widgets to implement a searching mechanism. First, type a file name |
---|
133 | in the top entry, then type <Return> or click on "Load File". Then |
---|
134 | type a string in the lower entry and type <Return> or click on |
---|
135 | "Load File". This will cause all of the instances of the string to |
---|
136 | be tagged with the tag "search", and it will arrange for the tag's |
---|
137 | display attributes to change to make all of the strings blink.} |
---|
138 | $w.text mark set insert 0.0 |
---|
139 | |
---|
140 | set fileName "" |
---|
141 | set searchString "" |
---|