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