1 # git-gui spellchecking support through ispell/aspell
2 # Copyright (C) 2008 Shawn Pearce
6 field s_fd
{} ; # pipe to ispell/aspell
7 field s_version
{} ; # ispell/aspell version string
8 field s_lang
{} ; # current language code
9 field s_prog aspell
; # are we actually old ispell?
10 field s_failed
0 ; # is $s_prog bogus and not working?
12 field w_text
; # text widget we are spelling
13 field w_menu
; # context menu for the widget
14 field s_menuidx
0 ; # last index of insertion into $w_menu
16 field s_i
{} ; # timer registration for _run callbacks
17 field s_clear
0 ; # did we erase mispelled tags yet?
18 field s_seen
[list] ; # lines last seen from $w_text in _run
19 field s_checked
[list] ; # lines already checked
20 field s_pending
[list] ; # [$line $data] sent to ispell/aspell
21 field s_suggest
; # array, list of suggestions, keyed by misspelling
23 constructor init
{pipe_fd ui_text ui_menu
} {
28 bind_button3
$w_text [cb _popup_suggest
%X
%Y
@%x
,%y
]
29 _connect
$this $pipe_fd
33 method _connect
{pipe_fd
} {
39 if {[gets $pipe_fd s_version
] <= 0} {
40 if {[catch {close $pipe_fd} err
]} {
42 # Eh? Is this actually ispell choking on aspell options?
44 if {$s_prog eq
{aspell
}
45 && [regexp -nocase {^Usage
: } $err]
47 set pipe_fd
[open [list |
$s_prog -v] r
]
48 gets $pipe_fd s_version
51 && $s_version ne
{}} {
52 if {{@(#) } eq [string range $s_version 0 4]} {
53 set s_version
[string range
$s_version 5 end
]
57 [mc
"Unsupported spell checker"] \
63 regsub -nocase {^Error
: } $err {} err
65 error_popup
[strcat
[mc
"Spell checking is unavailable"] ":\n\n$err"]
68 [mc
"Invalid spell checking configuration"] \
70 [mc
"Reverting dictionary to %s." $s_lang]]
73 error_popup
[mc
"Spell checker sliently failed on startup"]
77 if {{@(#) } ne [string range $s_version 0 4]} {
78 catch {close $pipe_fd}
79 error_popup
[strcat
[mc
"Unrecognized spell checker"] ":\n\n$s_version"]
82 set s_version
[string range
$s_version 5 end
]
84 puts $pipe_fd ! ; # enable terse mode
85 puts $pipe_fd {$$cr master
} ; # fetch the language
89 regexp {[/\\]([^
/\\]+)\.
[^
\.
]+$} $s_lang _ s_lang
91 if {$::default_config(gui.spellingdictionary
) eq
{}
92 && [get_config gui.spellingdictionary
] eq
{}} {
93 set ::default_config(gui.spellingdictionary
) $s_lang
101 fconfigure $s_fd -blocking 0
102 fileevent $s_fd readable
[cb _read
]
104 $w_text tag conf misspelled
\
108 array unset s_suggest
115 method lang
{{n
{}}} {
116 if {$n ne
{} && $s_lang ne
$n && !$s_failed} {
117 set spell_cmd
[list |
]
118 lappend spell_cmd aspell
119 lappend spell_cmd
--master=$n
120 lappend spell_cmd
--mode=none
121 lappend spell_cmd
--encoding=UTF-8
122 lappend spell_cmd pipe
123 _connect
$this [open $spell_cmd r
+]
129 if {$s_version ne
{}} {
130 return "$s_version, $s_lang"
136 while {$s_menuidx > 0} {
140 $w_text tag delete misspelled
143 catch {after cancel
$s_i}
149 method _popup_suggest
{X Y pos
} {
150 while {$s_menuidx > 0} {
155 set b_loc
[$w_text index
"$pos wordstart"]
156 set e_loc
[_wordend
$this $b_loc]
157 set orig
[$w_text get
$b_loc $e_loc]
158 set tags
[$w_text tag names
$b_loc]
160 if {[lsearch -exact $tags misspelled
] >= 0} {
161 if {[info exists s_suggest
($orig)]} {
163 foreach s
$s_suggest($orig) {
165 $w_menu insert
$s_menuidx command
\
167 -command [cb _replace
$b_loc $e_loc $s]
175 $w_menu insert
$s_menuidx command
\
176 -label [mc
"No Suggestions"] \
180 $w_menu insert
$s_menuidx separator
184 $w_text mark
set saved-insert insert
185 tk_popup $w_menu $X $Y
188 method _replace
{b_loc e_loc word
} {
189 $w_text configure
-autoseparators 0
190 $w_text edit separator
192 $w_text delete
$b_loc $e_loc
193 $w_text insert
$b_loc $word
195 $w_text edit separator
196 $w_text configure
-autoseparators 1
197 $w_text mark
set insert saved-insert
200 method _restart_timer
{} {
201 set s_i
[after 300 [cb _run
]]
204 proc _match_length
{max_line arr_name
} {
207 if {[llength $a] > $max_line} {
208 set a
[lrange $a 0 $max_line]
210 while {[llength $a] <= $max_line} {
215 method _wordend
{pos
} {
216 set pos
[$w_text index
"$pos wordend"]
217 set tags
[$w_text tag names
$pos]
218 while {[lsearch -exact $tags misspelled
] >= 0} {
219 set pos
[$w_text index
"$pos +1c"]
220 set tags
[$w_text tag names
$pos]
226 set cur_pos
[$w_text index
{insert
-1c}]
227 set cur_line
[lindex [split $cur_pos .
] 0]
228 set max_line
[lindex [split [$w_text index end
] .
] 0]
229 _match_length
$max_line s_seen
230 _match_length
$max_line s_checked
232 # Nothing in the message buffer? Nothing to spellcheck.
236 && [$w_text get
1.0 end
] eq
"\n"} {
237 array unset s_suggest
243 for {set n
1} {$n <= $max_line} {incr n
} {
244 set s
[$w_text get
"$n.0" "$n.end"]
246 # Don't spellcheck the current line unless we are at
247 # a word boundary. The user might be typing on it.
250 && ![regexp {^
\W
$} [$w_text get
$cur_pos insert
]]} {
252 # If the current word is mispelled remove the tag
253 # but force a spellcheck later.
255 set tags
[$w_text tag names
$cur_pos]
256 if {[lsearch -exact $tags misspelled
] >= 0} {
257 $w_text tag remove misspelled
\
258 "$cur_pos wordstart" \
259 [_wordend
$this $cur_pos]
267 if {[lindex $s_seen $n] eq
$s
268 && [lindex $s_checked $n] ne
$s} {
269 # Don't send empty lines to Aspell it doesn't check them.
276 # Don't send typical s-b-o lines as the emails are
277 # almost always misspelled according to Aspell.
279 if {[regexp -nocase {^
[a-z-
]+-by:.
*<.
*@.
*>$} $s]} {
280 $w_text tag remove misspelled
"$n.0" "$n.end"
286 lappend s_pending
[list $n $s]
289 # Delay until another idle loop to make sure we don't
290 # spellcheck lines the user is actively changing.
305 while {[gets $s_fd line
] >= 0} {
306 set lineno
[lindex $s_pending 0 0]
309 $w_text tag remove misspelled
"$lineno.0" "$lineno.end"
314 lset s_checked
$lineno [lindex $s_pending 0 1]
315 set s_pending
[lrange $s_pending 1 end
]
321 switch -- [string range
$line 0 1] {
323 set line
[split [string range
$line 2 end
] :]
324 set info [split [lindex $line 0] { }]
325 set orig
[lindex $info 0]
326 set offs
[lindex $info 2]
327 foreach s
[split [lindex $line 1] ,] {
328 lappend sugg
[string range
$s 1 end
]
332 set info [split [string range
$line 2 end
] { }]
333 set orig
[lindex $info 0]
334 set offs
[lindex $info 1]
337 puts stderr
"<spell> $line"
343 set b_loc
"$lineno.$offs"
344 set e_loc
[$w_text index
"$lineno.$offs wordend"]
345 set curr
[$w_text get
$b_loc $e_loc]
347 # At least for English curr = "bob", orig = "bob's"
348 # so Tk didn't include the 's but Aspell did. We
349 # try to round out the word.
351 while {$curr ne
$orig
352 && [string equal
-length [string length
$curr] $curr $orig]} {
353 set n_loc
[$w_text index
"$e_loc +1c"]
354 set n_curr
[$w_text get
$b_loc $n_loc]
355 if {$n_curr eq
$curr} {
362 if {$curr eq
$orig} {
363 $w_text tag add misspelled
$b_loc $e_loc
364 if {[llength $sugg] > 0} {
365 set s_suggest
($orig) $sugg
367 unset -nocomplain s_suggest
($orig)
370 unset -nocomplain s_suggest
($orig)
374 fconfigure $s_fd -block 1
376 if {![catch {close $s_fd} err
]} {
377 set err
[mc
"Unexpected EOF from spell checker"]
379 catch {after cancel
$s_i}
380 $w_text tag remove misspelled
1.0 end
381 error_popup
[strcat
[mc
"Spell Checker Failed"] "\n\n" $err]
384 fconfigure $s_fd -block 0
386 if {[llength $s_pending] == 0} {
391 proc available_langs
{} {
394 set fd
[open [list | aspell dump dicts
] r
]
395 while {[gets $fd line
] >= 0} {
396 if {$line eq
{}} continue