Merge git://repo.or.cz/git-gui
[git/git.git] / git-gui / lib / spellcheck.tcl
1 # git-gui spellchecking support through aspell
2 # Copyright (C) 2008 Shawn Pearce
3
4 class spellcheck {
5
6 field s_fd {} ; # pipe to aspell
7 field s_version ; # aspell version string
8 field s_lang ; # current language code
9
10 field w_text ; # text widget we are spelling
11 field w_menu ; # context menu for the widget
12 field s_menuidx 0 ; # last index of insertion into $w_menu
13
14 field s_i ; # timer registration for _run callbacks
15 field s_clear 0 ; # did we erase mispelled tags yet?
16 field s_seen [list] ; # lines last seen from $w_text in _run
17 field s_checked [list] ; # lines already checked
18 field s_pending [list] ; # [$line $data] sent to aspell
19 field s_suggest ; # array, list of suggestions, keyed by misspelling
20
21 constructor init {pipe_fd ui_text ui_menu} {
22 set w_text $ui_text
23 set w_menu $ui_menu
24
25 _connect $this $pipe_fd
26 return $this
27 }
28
29 method _connect {pipe_fd} {
30 fconfigure $pipe_fd \
31 -encoding utf-8 \
32 -eofchar {} \
33 -translation lf
34
35 if {[gets $pipe_fd s_version] <= 0} {
36 close $pipe_fd
37 error [mc "Not connected to aspell"]
38 }
39 if {{@(#) } ne [string range $s_version 0 4]} {
40 close $pipe_fd
41 error [strcat [mc "Unrecognized aspell version"] ": $s_version"]
42 }
43 set s_version [string range $s_version 5 end]
44
45 puts $pipe_fd ! ; # enable terse mode
46 puts $pipe_fd {$$cr master} ; # fetch the language
47 flush $pipe_fd
48
49 gets $pipe_fd s_lang
50 regexp {[/\\]([^/\\]+)\.[^\.]+$} $s_lang _ s_lang
51
52 if {$::default_config(gui.spellingdictionary) eq {}
53 && [get_config gui.spellingdictionary] eq {}} {
54 set ::default_config(gui.spellingdictionary) $s_lang
55 }
56
57 if {$s_fd ne {}} {
58 catch {close $s_fd}
59 }
60 set s_fd $pipe_fd
61
62 fconfigure $s_fd -blocking 0
63 fileevent $s_fd readable [cb _read]
64
65 $w_text tag conf misspelled \
66 -foreground red \
67 -underline 1
68 bind_button3 $w_text [cb _popup_suggest %X %Y @%x,%y]
69
70 array unset s_suggest
71 set s_seen [list]
72 set s_checked [list]
73 set s_pending [list]
74 _run $this
75 }
76
77 method lang {{n {}}} {
78 if {$n ne {} && $s_lang ne $n} {
79 set spell_cmd [list |]
80 lappend spell_cmd aspell
81 lappend spell_cmd --master=$n
82 lappend spell_cmd --mode=none
83 lappend spell_cmd --encoding=UTF-8
84 lappend spell_cmd pipe
85 _connect $this [open $spell_cmd r+]
86 }
87 return $s_lang
88 }
89
90 method version {} {
91 return "$s_version, $s_lang"
92 }
93
94 method stop {} {
95 while {$s_menuidx > 0} {
96 $w_menu delete 0
97 incr s_menuidx -1
98 }
99 $w_text tag delete misspelled
100
101 catch {close $s_fd}
102 catch {after cancel $s_i}
103 set s_fd {}
104 set s_i {}
105 set s_lang {}
106 }
107
108 method _popup_suggest {X Y pos} {
109 while {$s_menuidx > 0} {
110 $w_menu delete 0
111 incr s_menuidx -1
112 }
113
114 set b_loc [$w_text index "$pos wordstart"]
115 set e_loc [_wordend $this $b_loc]
116 set orig [$w_text get $b_loc $e_loc]
117 set tags [$w_text tag names $b_loc]
118
119 if {[lsearch -exact $tags misspelled] >= 0} {
120 if {[info exists s_suggest($orig)]} {
121 set cnt 0
122 foreach s $s_suggest($orig) {
123 if {$cnt < 5} {
124 $w_menu insert $s_menuidx command \
125 -label $s \
126 -command [cb _replace $b_loc $e_loc $s]
127 incr s_menuidx
128 incr cnt
129 } else {
130 break
131 }
132 }
133 } else {
134 $w_menu insert $s_menuidx command \
135 -label [mc "No Suggestions"] \
136 -state disabled
137 incr s_menuidx
138 }
139 $w_menu insert $s_menuidx separator
140 incr s_menuidx
141 }
142
143 $w_text mark set saved-insert insert
144 tk_popup $w_menu $X $Y
145 }
146
147 method _replace {b_loc e_loc word} {
148 $w_text configure -autoseparators 0
149 $w_text edit separator
150
151 $w_text delete $b_loc $e_loc
152 $w_text insert $b_loc $word
153
154 $w_text edit separator
155 $w_text configure -autoseparators 1
156 $w_text mark set insert saved-insert
157 }
158
159 method _restart_timer {} {
160 set s_i [after 300 [cb _run]]
161 }
162
163 proc _match_length {max_line arr_name} {
164 upvar $arr_name a
165
166 if {[llength $a] > $max_line} {
167 set a [lrange $a 0 $max_line]
168 }
169 while {[llength $a] <= $max_line} {
170 lappend a {}
171 }
172 }
173
174 method _wordend {pos} {
175 set pos [$w_text index "$pos wordend"]
176 set tags [$w_text tag names $pos]
177 while {[lsearch -exact $tags misspelled] >= 0} {
178 set pos [$w_text index "$pos +1c"]
179 set tags [$w_text tag names $pos]
180 }
181 return $pos
182 }
183
184 method _run {} {
185 set cur_pos [$w_text index {insert -1c}]
186 set cur_line [lindex [split $cur_pos .] 0]
187 set max_line [lindex [split [$w_text index end] .] 0]
188 _match_length $max_line s_seen
189 _match_length $max_line s_checked
190
191 # Nothing in the message buffer? Nothing to spellcheck.
192 #
193 if {$cur_line == 1
194 && $max_line == 2
195 && [$w_text get 1.0 end] eq "\n"} {
196 array unset s_suggest
197 _restart_timer $this
198 return
199 }
200
201 set active 0
202 for {set n 1} {$n <= $max_line} {incr n} {
203 set s [$w_text get "$n.0" "$n.end"]
204
205 # Don't spellcheck the current line unless we are at
206 # a word boundary. The user might be typing on it.
207 #
208 if {$n == $cur_line
209 && ![regexp {^\W$} [$w_text get $cur_pos insert]]} {
210
211 # If the current word is mispelled remove the tag
212 # but force a spellcheck later.
213 #
214 set tags [$w_text tag names $cur_pos]
215 if {[lsearch -exact $tags misspelled] >= 0} {
216 $w_text tag remove misspelled \
217 "$cur_pos wordstart" \
218 [_wordend $this $cur_pos]
219 lset s_seen $n $s
220 lset s_checked $n {}
221 }
222
223 continue
224 }
225
226 if {[lindex $s_seen $n] eq $s
227 && [lindex $s_checked $n] ne $s} {
228 # Don't send empty lines to Aspell it doesn't check them.
229 #
230 if {$s eq {}} {
231 lset s_checked $n $s
232 continue
233 }
234
235 # Don't send typical s-b-o lines as the emails are
236 # almost always misspelled according to Aspell.
237 #
238 if {[regexp -nocase {^[a-z-]+-by:.*<.*@.*>$} $s]} {
239 $w_text tag remove misspelled "$n.0" "$n.end"
240 lset s_checked $n $s
241 continue
242 }
243
244 puts $s_fd ^$s
245 lappend s_pending [list $n $s]
246 set active 1
247 } else {
248 # Delay until another idle loop to make sure we don't
249 # spellcheck lines the user is actively changing.
250 #
251 lset s_seen $n $s
252 }
253 }
254
255 if {$active} {
256 set s_clear 1
257 flush $s_fd
258 } else {
259 _restart_timer $this
260 }
261 }
262
263 method _read {} {
264 while {[gets $s_fd line] >= 0} {
265 set lineno [lindex $s_pending 0 0]
266
267 if {$s_clear} {
268 $w_text tag remove misspelled "$lineno.0" "$lineno.end"
269 set s_clear 0
270 }
271
272 if {$line eq {}} {
273 lset s_checked $lineno [lindex $s_pending 0 1]
274 set s_pending [lrange $s_pending 1 end]
275 set s_clear 1
276 continue
277 }
278
279 set sugg [list]
280 switch -- [string range $line 0 1] {
281 {& } {
282 set line [split [string range $line 2 end] :]
283 set info [split [lindex $line 0] { }]
284 set orig [lindex $info 0]
285 set offs [lindex $info 2]
286 foreach s [split [lindex $line 1] ,] {
287 lappend sugg [string range $s 1 end]
288 }
289 }
290 {# } {
291 set info [split [string range $line 2 end] { }]
292 set orig [lindex $info 0]
293 set offs [lindex $info 1]
294 }
295 default {
296 puts stderr "<spell> $line"
297 continue
298 }
299 }
300
301 incr offs -1
302 set b_loc "$lineno.$offs"
303 set e_loc [$w_text index "$lineno.$offs wordend"]
304 set curr [$w_text get $b_loc $e_loc]
305
306 # At least for English curr = "bob", orig = "bob's"
307 # so Tk didn't include the 's but Aspell did. We
308 # try to round out the word.
309 #
310 while {$curr ne $orig
311 && [string equal -length [string length $curr] $curr $orig]} {
312 set n_loc [$w_text index "$e_loc +1c"]
313 set n_curr [$w_text get $b_loc $n_loc]
314 if {$n_curr eq $curr} {
315 break
316 }
317 set curr $n_curr
318 set e_loc $n_loc
319 }
320
321 if {$curr eq $orig} {
322 $w_text tag add misspelled $b_loc $e_loc
323 if {[llength $sugg] > 0} {
324 set s_suggest($orig) $sugg
325 } else {
326 unset -nocomplain s_suggest($orig)
327 }
328 } else {
329 unset -nocomplain s_suggest($orig)
330 }
331 }
332
333 fconfigure $s_fd -block 1
334 if {[eof $s_fd]} {
335 if {![catch {close $s_fd} err]} {
336 set err [mc "unexpected eof from aspell"]
337 }
338 catch {after cancel $s_i}
339 $w_text tag remove misspelled 1.0 end
340 error_popup [strcat "Spell Checker Failed" "\n\n" $err]
341 return
342 }
343 fconfigure $s_fd -block 0
344
345 if {[llength $s_pending] == 0} {
346 _restart_timer $this
347 }
348 }
349
350 proc available_langs {} {
351 set langs [list]
352 catch {
353 set fd [open [list | aspell dump dicts] r]
354 while {[gets $fd line] >= 0} {
355 if {$line eq {}} continue
356 lappend langs $line
357 }
358 close $fd
359 }
360 return $langs
361 }
362
363 }