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 [llength $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
+}