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