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