summaryrefslogtreecommitdiff
path: root/support/dinbrief-gui/dinbrief.vfs/searchText.tcl
blob: f5c0459414938e87ebe1982b00b43c847b15061e (plain)
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
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
comment {
    Inkrementelle Suche, nur Vorwärts, kein Ersetzen.
    Das widget wird bei Betreten des Suchmodus
    an das Ereignistag searchMode gebunden.
    Bei Verlassen erhält es die vorigen Ereignistags zurück
    (zwischengespeichert in bindTags($win)).
}

namespace eval searchText {
    # bindtags: array intended to store original binding tags of widgets
    variable bindTags
    array set bindTags {}
    variable searchModeOf
    array set searchModeOf {}
    # searchHistory contains history of incremental search
    variable searchHistory {}
    variable searchString ""
    # escapeCharMap intended to translate spec chars to escaped ones
    variable escapeCharMap [[lambda {} {
	set result {}
	lappend result\
	    \{ \\\{ \} \\\} ( \\( ) \\) \[ \\\[ \] \\\]\
	    * \\* + \\+ ? \\? \\ \\\\ . \\. \$ \\\$\
	    " " \\s \t \\s
	set quotePat \[
	append quotePat \u201e \u201c \u201d \u00bb \u00ab \]
	lappend result \" $quotePat
	set apostrophePat \[
	append apostrophePat \u201a \u2018 \u2019 \u203a \u2039 \]
	lappend result ' $apostrophePat
	set dashPat \[
	append dashPat \u2013 \u2014 - \]
	lappend result - $dashPat
    }]]
    # asciifiedCharMap intended to translate typgraphical chars to ASCII
    variable asciifiedCharMap\
	[list \t " " \u2013 - \u2014 -\
	     \u201e \" \u201c \" \u201d \" \u00bb \" \u00ab \"\
	     \u201a ' \u2018 ' \u2019 ' \u203a ' \u2039 ']
}

#
# ::searchText::getSearchModeOf win
# return true if $win is in search mode
#
proc ::searchText::getSearchModeOf {win} {
    variable searchModeOf
    switch [winfo class $win] {
	Scrolledtext - Scrolledrichtext {
	    getSearchModeOf $win.text
	}
	default {
	    expr {[info exists searchModeOf($win)] && $searchModeOf($win)} 
	}
    }
}

proc ::searchText::setSearchModeOf {win val} {
    variable searchModeOf
    switch [winfo class $win] {
	Scrolledtext - Scrolledrichtext {
	    setSearchModeOf $win.text $val
	}
	default {
	   set searchModeOf($win) $val
	}
    }
}

#
# ::searchText::asciifiedSelection win
# returns contents of current selection of $win
#
proc ::searchText::asciifiedSelection {win} {
    if {[$win tag ranges sel] ne {}} {
	variable asciifiedCharMap
	string map $asciifiedCharMap [$win get sel.first sel.last]
    }
}

#
# ::searchText::searchWinEsc win str index dir
# searches $str in $win such that " finds national quotes etc.
#
proc ::searchText::searchWinEsc {win str {index insert} {dir -forward}} {
    variable escapeCharMap
    set str1 [string map $escapeCharMap $str]
    switch -- $dir {
	-backward {
	    $win search -regexp -nocase -backward -- $str1 $index 1.0
	}
	default {
	    $win search -regexp -nocase -- $str1 $index end
	}
    }
}

proc ::searchText::toggleSearchMode {win} {
    searchMode $win [expr {![expr {[getSearchModeOf $win]}]}]
}

#
# ::searchText::searchMode .maintext no
# switches searchimg mode for .maintext off
#
# ::searchText::searchMode .maintext ye
# switches searchimg mode for .maintext on
# if some text is selected, search it first
#
proc ::searchText::searchMode {win {mode yes}} {
    switch [winfo class $win] {
	Scrolledtext - Scrolledrichtext {
	    return [searchMode $win.text $mode]
	}
    }
    variable bindTags
    variable searchString
    variable searchHistory
    variable searchModeOf
    if {$mode} {
	if {[getSearchModeOf $win]} {
	    return
	}
	set searchModeOf($win) 1
	$win tag configure found -background yellow
	$win tag raise sel
	set bindTags($win) [bindtags $win]
	bindtags $win searchMode
	grid .searchStringLabel .searchString - - -sticky ne
	grid configure .searchString -sticky nw
	.searchStringLabel configure -foreground black
	if {[$win tag ranges sel] eq {}} {
	    set searchString ""
	} else {
	    let {from to} [$win tag ranges sel]
	    set searchString [asciifiedSelection $win]
	    searchWinText $win $searchString [$win index sel.first]
	}
	set searchHistory {}
    } else {
	if {![getSearchModeOf $win]} {
	    return
	}
	set searchModeOf($win) 0
	bindtags $win $bindTags($win)
	$win tag remove found 1.0 end
	grid forget .searchStringLabel .searchString
	if {$searchString ne ""} {
	    globalSetting lastSearchString $searchString
	}
    }
}

#
# ::searchText::markWinOccurrences win str
# marks all occurrences of $str in $win with tag found
# (currently yellow background)
#
proc ::searchText::markWinOccurrences {win string} {
    $win tag remove found 1.0 end
    if {$string eq ""} {
	return
    }
    set i 1.0
    # [set i [$win search -regexp -nocase -- $str1 $i end]]
    while {[set i [searchWinEsc $win $string $i]] ne {}} {
	set i1 [$win index $i+[string length $string]chars]
	$win tag add found $i $i1
	set i $i1
    }
}

#
# ::searchText::searchWinNextChar win char
# appends $char to $searchString, calls searchWinText
# (this proc realizes incremental search)
#
proc ::searchText::searchWinNextChar {win char} {
    variable searchString
    set sel [$win tag ranges sel]
    if {$sel ne {}} {
	let {from to} $sel
    } else {
	set from [$win index insert]
    }
    searchWinText $win $searchString$char $from
}

#
# ::searchText::searchWinText win str index
# searches $str in $win starting at $index
# appends $str, sel.first, sel.last, ranges of tag found to searchHistory
#
proc ::searchText::searchWinText {win string {mark insert}} {
    variable searchString
    variable searchHistory
    #
    push $searchString searchHistory
    if {[$win tag ranges sel] ne {}} {
	push [$win index sel.first] searchHistory
	push [$win index sel.last] searchHistory
    } else {
	push [$win index insert] searchHistory
	push [$win index insert] searchHistory
    }
    push [$win tag ranges found] searchHistory
    #
    set searchString $string
    $win tag remove sel 1.0 end
    set index [searchWinEsc $win $searchString $mark]
    set foundLength [string length $searchString]
    if {$index ne {}} {
	set index1 [$win index "$index + $foundLength chars"]
	$win tag add sel $index $index1
	$win mark set insert $index1
	$win see insert
	.searchStringLabel configure -foreground black
    } else {
	.searchStringLabel configure -foreground red
    }
    markWinOccurrences $win $string
}

#
# ::searchText::searchHistoryBack win
# if searchHistory is not empty, 
# then restore searchString, selection, ranges of tag found
# else shorten searchString by last char and search
# this proc realizes backward incremental search
#
proc ::searchText::searchHistoryBack {win} {
    variable searchHistory
    variable searchString
    if {$searchHistory ne {}} {
	$win tag remove sel 1.0 end
	$win tag remove found 1.0 end
	set foundRanges [pop searchHistory]
	if {$foundRanges ne {}} {
	    eval $win tag add found $foundRanges
	}
	$win mark set insert [pop searchHistory]
	$win tag add sel [pop searchHistory] insert
	set searchString [pop searchHistory]
	$win see insert
    } elseif {$searchString eq {}} {
	searchMode $win 0
    } else {
	if {[catch {set i0 [$win index sel.first]}]} {
	    set i0 [$win index insert]
	}
	set searchString [string range $searchString 0 end-1]
	searchWinText $win $searchString $i0
	$win mark set insert $i0
	$win see insert
	set searchHistory {}
    }
}

# debug
# upvar \#0 searchText::searchHistory searchHistory
# upvar \#0 searchText::searchString searchString
# end of debug

namespace eval searchText {
    namespace export *
    bind searchMode <Key> [namespace code [list [lambda {win key sym} {
	upvar searchString searchString
	upvar searchHistory searchHistory
	switch -glob -- $sym Control* - Alt* - *Shift* {
	} F3 {
	    if {$searchString eq ""} {
		searchWinText $win [globalSetting lastSearchString]
		set searchHistory {}
	    } else {
		searchWinText $win $searchString
	    }
	} Escape - Left - Right - Up - Down - Home -\
	    End - Prior - Next - Insert - Delete - F* {
	    searchMode $win 0
	} default {
	    switch -regexp -- $key {[[:graph:][:space:]]} {
		searchWinNextChar $win $key
	    } \b {
		# searchWinPrevChar $win
		searchHistoryBack $win
	    } default {
		echo exit: key $key
		searchMode $win 0
	    }
	}
    }] %W %A %K]]
    bind searchMode <Button-1> {searchMode %W 0}
}

bind searchMode <FocusOut> {
    searchMode %W 0
}

namespace import -force {::searchText::*}