lib/spellcheck.tcl

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