Commit | Line | Data |
---|---|---|
86530b38 AT |
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 "" |