1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
# DSearch Package for tkTextEnhanced --
#
#
# Copyright 1995 by Paul Raines (raines@slac.stanford.edu)
#
# Permission to use, copy, modify, and distribute this software and
# its documentation for any purpose and without fee is hereby
# granted, provided that the above copyright notice appear in all
# copies. The University of Pennsylvania, Stanford University, and
# Stanford Linear Accelerator Center makes no representations
# about the suitability of this software for any purpose. It is
# provided "as is" without express or implied warranty.
global tkText tkBind
if {![info exists tkBind(dsearch,bind)] || $tkBind(dsearch,bind)} {
bind Text <Control-s> {
tkTextDSearchStart %W -forwards -exact
}
bind Text <Control-r> {
tkTextDSearchStart %W -backwards -exact
}
}
proc tkTextDSearchStart {w dir mode} {
global tkText tkBind
set tkText($w,markActive) 0
set tkText($w,arg) {}
$w tag remove sel 0.0 end
if {![info exists tkText($w,dsearchMode)]} {
lappend tkText($w,destroyHooks) tkTextDSearchClean
}
set tkText($w,dsearchDir) $dir
set tkText($w,dsearchMode) $mode
if $tkBind(noCase) {
set tkText($w,dsearchCase) "-nocase"
} else { set tkText($w,dsearchCase) {} }
set tkText($w,dsearchHome) [$w index insert]
set tkText($w,dsearchLast) {}
tkBindSetMesg $w {}
if {![info exists tkText($w,dsearchDlg)] ||
![winfo exists $tkText($w,dsearchDlg)]} {
for {set cnt 0} {[winfo exists .dsearch$cnt]} {incr cnt} {}
set dlg .dsearch$cnt
toplevel $dlg -class TextSearch
set tkText($w,dsearchDlg) $dlg
wm title $dlg "Text Search Dialog"
wm minsize $dlg 220 80
wm protocol $dlg WM_DELETE_WINDOW "tkTextDSearchStop $w"
frame $dlg.str
label $dlg.str.lbl -text "Search for:" -width 15 -anchor e
entry $dlg.str.ent -relief sunken
pack $dlg.str.lbl -side left -pady 10
pack $dlg.str.ent -side left -expand true -fill x -padx 10 -pady 10
bind $dlg.str.ent <Return> "$dlg.bb.search invoke; focus %W"
frame $dlg.repl
label $dlg.repl.lbl -text "Replace with:" -width 15 -anchor e
entry $dlg.repl.ent -relief sunken
pack $dlg.repl.lbl -side left -pady 10
pack $dlg.repl.ent -side left -expand true -fill x -padx 10 -pady 10
bind $dlg.repl.ent <Return> "$dlg.bb.replace invoke; focus %W"
frame $dlg.mod
checkbutton $dlg.mod.case -text "Case insensitive" \
-variable tkText($w,dsearchCase) -width 20 -relief flat \
-offvalue {} -onvalue {-nocase}
checkbutton $dlg.mod.regexp -text "Regular expression" \
-variable tkText($w,dsearchMode) -width 20 -relief flat \
-offvalue {-exact} -onvalue {-regexp}
checkbutton $dlg.mod.back -text "Backward" \
-variable tkText($w,dsearchDir) -width 20 -relief flat \
-offvalue {-forwards} -onvalue {-backwards}
pack $dlg.mod.case $dlg.mod.regexp $dlg.mod.back \
-side left -pady 10 -padx 10 -fill x -expand true
frame $dlg.bb
button $dlg.bb.search -text "Search" -width 10 \
-command "tkTextDSearchNext $w \[$dlg.str.ent get\] insert"
button $dlg.bb.replace -text "Replace" -width 10 \
-command "tkTextDSearchReplace $w"
button $dlg.bb.repl_all -text "Replace All" -width 10 \
-command "while {\[tkTextDSearchReplace $w\]} { }"
button $dlg.bb.home -text "Home" -width 10 \
-command "tkTextDSearchHome $w"
button $dlg.bb.dismiss -text "Dismiss" -width 10 \
-command "tkTextDSearchStop $w"
pack $dlg.bb.search $dlg.bb.replace $dlg.bb.repl_all \
$dlg.bb.home $dlg.bb.dismiss -side left -padx 10 -pady 10
pack $dlg.str $dlg.repl $dlg.mod $dlg.bb -side top -expand true -fill x
} else {
set dlg $tkText($w,dsearchDlg)
wm deiconify $dlg
}
$dlg.repl.ent configure -state [$w cget -state]
$dlg.bb.replace configure -state [$w cget -state]
$dlg.bb.repl_all configure -state [$w cget -state]
raise $dlg
focus $dlg.str.ent
return $dlg
}
proc tkTextDSearchStop {w {setmark 1}} {
global tkText tkBind
wm withdraw $tkText($w,dsearchDlg)
if {[winfo exists $w]} {
if $setmark {
tkTextSetMark $w $tkText($w,dsearchHome)
set tkText($w,markActive) 0
}
focus $w
}
}
proc tkTextDSearchClean w {
global tkText tkBind
if {![info exists tkText($w,dsearchDlg)]} return
if {[winfo exists $tkText($w,dsearchDlg)]} {
catch "destroy $tkText($w,dsearchDlg)"
}
foreach elem [list dsearchDir dsearchMode dsearchCase dsearchHome \
dsearchDlg dsearchLast] {
unset tkText($w,$elem)
}
}
proc tkTextDSearchAgain {w} {
global tkText
if {![info exists tkText($w,dsearchDlg)]} {
error "No previous search for this widget"
}
return [tkTextDSearchNext $w [$tkText($w,dsearchDlg).str.ent get] insert]
}
proc tkTextDSearchNext {w str start} {
global tkText tkBind
set tkText($w,markActive) 0
set tkText($w,arg) {}
set tkText($w,prevCmd) DSearch
catch "$w tag remove sel 0.0 end"
set start [$w index $start]
if {$tkText($w,dsearchDir) == "-forwards"} {
set stop end } else { set stop 1.0 }
set ndx [$w search $tkText($w,dsearchDir) $tkText($w,dsearchMode) \
$tkText($w,dsearchCase) -count ccnt -- $str $start $stop]
if [string length $ndx] {
if {$tkText($w,dsearchDir) == "-forwards"} {
$w mark set insert [$w index "$ndx + $ccnt c" ]
} else {
$w mark set insert $ndx
}
$w tag add sel $ndx "$ndx + $ccnt c"
$w see insert
set tkText($w,dsearchLast) [list $ndx [$w index sel.last]]
return 1
} else {
eval $tkBind(bell)
return 0
}
}
proc tkTextDSearchHome w {
global tkText tkBind
set tkText($w,markActive) 0
set tkText($w,arg) {}
set tkText($w,prevCmd) DSearchHome
$w tag remove sel 0.0 end
$w mark set insert $tkText($w,dsearchHome)
$w see insert
}
proc tkTextDSearchReplace w {
global tkText tkBind
set dlg $tkText($w,dsearchDlg)
if {![catch "$w index sel.first"]} {
set cur [list [$w index sel.first] [$w index sel.last]]
if {$tkText($w,dsearchLast) == $cur} {
tkTextReplace $w sel.first sel.last [$dlg.repl.ent get]
}
}
return [tkTextDSearchNext $w [$dlg.str.ent get] insert]
}
|
