Spellcheck Widget using Aspell

MG Apr 25th 2010 - After putting it off for a while, I've finally had to give in and add a spellchecker to one of my apps. Being too lazy to actually write the spellchecking code myself, it uses Aspell for it (path near the top; you could use something else that returned data in the same format, like ispell). Here's the code, for a slightly MS-Wordish looking spellcheck widget (using ttk themed windows, and pretty much my first mildly complex use of grid instead of pack, which seems to have worked OK). Screenshot taken on Win XP.

https://wiki.tcl-lang.org/_repo/images/spellcheck.jpg

DDG Hunspell can be used as well, just replace aspell -a with hunspell -a. Further package require Tk added to avoid errors if using tclsh on Linux. Still problems of lcoing the pipe after finishing the apllication.

The command

  spellcheck::spellcheck $string

launches the widget and spellchecks the given string, and returns a new string with any replacements/fixes made when the Done button is clicked (or the original string, if Cancel is clicked). If the options(grab) variable is set true, a local grab is performed when the spellcheck widget is up, stopping button/keypresses in other windows.


package require Tk

namespace eval ::spellcheck {
  variable options;
  variable spellcheck;
  # DDG - check for spell checker
  if {[auto_execok "aspell"] eq "" && [auto_execok "hunspell"] eq ""} {
      error "Either aspell or hunspell  must be installed and the binaries must be in the path!"
  }
  if {[auto_execok "aspell"] ne ""} {
      set options(aspell) "aspell -a"
  } else {
      set options(aspell) "hunspell -a"
  }
  # on Windows you might manually set the path
  #set options(aspell) "e:/progra~1/aspell/bin/aspell.exe -a"
  # set options(hunspell) "e:/hunspell/hunspell.exe -a" # should work as well
  set options(grab) 0
}

proc ::spellcheck::spellcheck {string} {
  variable spellcheck;
  variable options;

  array unset spellcheck;

  set win .spellcheck
  if { [winfo exists $win] } {
       raise $win
       bell -displayof $win;
       return;
     }

  set spellcheck(win) $win
  set spellcheck(string) $string

  toplevel $win
  wm title $win "Spellchecker"
  pack [set frame [::ttk::frame $win.frame]] -side left -anchor nw -expand 1 -fill both -pady 8
  if { $options(grab) } {
       grab set $win
       bind $frame <Destroy> [list grab release $win];# don't think this is necessary, but better safe than sorry
     }

  # DDG: can't pack and then grid, so removed pack
  ::ttk::label $frame.top_label -text "Words:"

  set left [::ttk::frame $frame.left]
  pack [set top [::ttk::frame $left.top]] -expand 1 -fill both
  pack [set input [text $top.txt -width 50 -height 7 -wrap word -yscrollcommand "$top.sb set"]] -side left -expand 1 -fill both
  pack [::ttk::scrollbar $top.sb -command "$input yview"] -side left -fill y

  ::ttk::label $frame.bottom_label -text "Suggestions:"
  # DDG: fix, can't first pack and then grid with modern Tk
  set bottom [::ttk::frame $frame.bottom]
  pack [set tree [::ttk::treeview $bottom.tree -style "Spell.Treeview" -columns Suggestion -show {} -yscrollcommand "$bottom.sb set" -height 6 -selectmode browse]] -side left -anchor nw -expand 1 -fill both
  $tree column Suggestion -width 50
  pack [::ttk::scrollbar $bottom.sb -command "$tree yview"] -side left -fill y


  set right [::ttk::frame $frame.right]
  foreach {btn letter} [list "Done" d "Cancel" c "Replace" r "Ignore" i] {
    grid [::ttk::frame $right.frame$btn] -sticky ew -padx 2 -pady 8
    pack [::ttk::frame $right.frame$btn.sub] -side left -anchor center
    pack [::ttk::button $right.frame$btn.sub.b -text $btn -underline 0] -anchor center
    bind $win <KeyPress-$letter> [list $right.frame$btn.sub.b invoke]
  }
  $right.frameDone.sub.b configure -command [list ::spellcheck::finish 1]
  $right.frameCancel.sub.b configure -command [list ::spellcheck::finish 0]
  $right.frameReplace.sub.b configure -command [list ::spellcheck::replaceWord 1]
  $right.frameIgnore.sub.b configure -command [list ::spellcheck::replaceWord 0]

  $right.frameReplace.sub.b state disabled
  $right.frameIgnore.sub.b state disabled

  grid $frame.top_label -sticky w -padx 6
  grid $left $right -sticky nsew -pady 4 -padx 6
  grid $frame.bottom_label -sticky w -padx 6
  grid $bottom -sticky nsew -pady 4 -padx 6
  grid rowconfigure $frame $left -weight 1
  grid rowconfigure $frame $bottom -weight 1
  grid columnconfigure $frame 0 -weight 1

  set spellcheck(replace) $right.frameReplace.sub.b
  set spellcheck(ignore) $right.frameIgnore.sub.b
  set spellcheck(tree) $tree
  set spellcheck(input) $input

  $tree tag configure wrong -font [list {*}[font actual [ttk::style lookup Treeview -font]] -slant italic]
  $tree state disabled

  $input tag configure checking -background darkblue
  $input tag configure wrong -underline 1 -foreground red
  $input insert end $string
  $tree insert {} end -values [list "Please wait. Checking spelling..."] -tags wrong
  bind $tree <ButtonPress-3> {if {[%W instate !disabled]} {::spellcheck::rightClickTree %X %Y %x %y}}
  bind $tree <Double-1> {if {[%W instate !disabled]} {::spellcheck::doubleClickTree %x %y}}

  wm minsize $win [winfo reqwidth $win] [winfo reqheight $win]

  set lineNum 1
  set total 0
  set wroung 0
  foreach line [split $string "\n"] {
    set corrections [checkSpelling $line]
    foreach {count corrections} $corrections {break;}
    if { $count == 0 } {
         $tree delete [$tree children {}]
         $tree insert {} end -values [list "Unable to spell-check text: $spellcheck(error)"] -tags wrong
         set total -1
         $right.frameDone.sub.b state disabled
         break;
       } else {
         foreach x $corrections {
           incr total
           foreach {start word suggestions} $x {break;}
           incr start -1
           $input tag add wrong "$lineNum.0 + $start chars" "$lineNum.0 + [expr {$start + [string length $word]}] chars"
           set spellcheck(suggestions,$word) $suggestions
       }
    }
    incr lineNum
  }
  $input configure -state disabled
  if { $total == 0 } {
       tk_messageBox -icon info -parent $top -message "All words are spelled correctly."
       destroy $win;
       return $spellcheck(string);
     } elseif { $total > 0 } {
       $tree delete [$tree children {}]
       $tree insert {} end -values [list "Click a misspelled word to begin"] -tags wrong
       $input tag bind wrong <Button-1> [list ::spellcheck::suggest]
       $input tag bind wrong <Enter> [list $input configure -cursor hand2]
       $input tag bind wrong <Leave> [list $input configure -cursor xterm]
     }

  vwait ::spellcheck::spellcheck(string)

  destroy $win;

  return $spellcheck(string);

};# ::spellcheck::spellcheck

proc ::spellcheck::doubleClickTree {x y} {
  variable spellcheck;

  set what [lindex [$spellcheck(tree) identify $x $y] 0]
  if { $what eq "cell" } {
       ::spellcheck::replaceWord 1
     }

};# ::spellcheck::doubleClickTree

proc ::spellcheck::rightClickTree {X Y x y} {
  variable spellcheck;

  event generate $spellcheck(tree) <ButtonPress-1> -rootx $X -rooty $Y -x $x -y $y
  set m .m
  catch {destroy $m}
  menu $m -tearoff 0
  $m add command -label "Use this word" -command [list ::spellcheck::replaceWord 1]
  $m add command -label "Copy word to Clipboard" -command [list ::spellcheck::copyTreeWord]

  tk_popup $m $X $Y

};# ::spellcheck::rightClickTree

proc ::spellcheck::copyTreeWord {} {
  variable spellcheck;

  set word [lindex [$spellcheck(tree) item [$spellcheck(tree) selection] -value] 0]
  clipboard clear -displayof $spellcheck(tree)
  clipboard append -displayof $spellcheck(tree) $word

};# ::spellcheck::copyTreeWord

proc ::spellcheck::suggest {{index "current"}} {
  variable spellcheck;

  $spellcheck(input) tag remove checking 1.0 end

  # Get word
  set range [$spellcheck(input) tag prevrange "wrong" "$index + 1 char"]
  $spellcheck(input) tag add "checking" {*}$range
  set word [$spellcheck(input) get checking.first checking.last]

  $spellcheck(tree) delete [$spellcheck(tree) children {}]

  if { ![info exists spellcheck(suggestions,$word)] || ![llength $spellcheck(suggestions,$word)] } {
       $spellcheck(tree) insert {} end -values [list "None"] -tags wrong
       $spellcheck(tree) state disabled
       $spellcheck(replace) state disabled       
     } else {
       $spellcheck(tree) state !disabled
       foreach x $spellcheck(suggestions,$word) {
         $spellcheck(tree) insert {} end -values [list "$x"]
       }
       set first [lindex [$spellcheck(tree) children {}] 0]
       $spellcheck(tree) see $first
       $spellcheck(tree) selection set $first
       $spellcheck(tree) focus $first
       $spellcheck(replace) state !disabled
     }
  $spellcheck(ignore) state !disabled

  return;        

};# ::spellcheck::suggest

proc ::spellcheck::replaceWord {replace} {
  variable spellcheck;

  $spellcheck(input) configure -state normal
  set index [$spellcheck(input) index checking.first]
  if { $replace } {
       set orig [$spellcheck(input) get checking.first checking.last]
       set new [lindex [$spellcheck(tree) item [$spellcheck(tree) selection] -values] 0]
       $spellcheck(input) delete checking.first checking.last
       $spellcheck(input) insert $index $new
     } else {
       $spellcheck(input) tag remove wrong checking.first checking.last
       $spellcheck(input) tag remove checking checking.first checking.last
     }
  $spellcheck(input) configure -state disabled
  $spellcheck(replace) state disabled
  $spellcheck(ignore) state disabled
  if { ![llength [set next [$spellcheck(input) tag nextrange wrong $index end]]] && ![llength [set next [$spellcheck(input) tag nextrange wrong 1.0 $index]]] } {
       # All words now spelled correctly
       set ans [tk_messageBox -parent $spellcheck(win) -icon info -title "Spellcheck" -type yesno \
                     -message "All words are now spelled correctly. Finished?"]
       if { $ans eq "yes" } {
            ::spellcheck::finish 1
          }
       return;
     } else {
       $spellcheck(tree) delete [$spellcheck(tree) children {}]
       $spellcheck(tree) insert {} end -values [list "Click a misspelled word to begin"] -tags wrong
       suggest [lindex $next 0]
     }

  return;

};# ::spellcheck::replaceWord

proc ::spellcheck::finish {use} {
  variable spellcheck;

  if { $use } {
       set spellcheck(string) [$spellcheck(input) get 1.0 end-1c]
     } else {
       set spellcheck(string) $spellcheck(string);# no change, but set to itself to trigger vwait
     }

  return;

};# ::spellcheck::finish

proc ::spellcheck::checkSpelling {string} {
  variable options;
  variable spellcheck;

  if { [catch {open "|$options(aspell)" r+} pipe] } {
       set spellcheck(error) $pipe
       return [list 0 [list]];
     }
  set spellcheck(error) ""
  fconfigure $pipe -buffering line
  gets $pipe ;# skip version line
  fconfigure $pipe -blocking 0

  set return [list]
  
  puts $pipe "^$string"

  after 500 [list ::spellcheck::checkSpellingSub $pipe]
  vwait ::spellcheck::spellcheck(result)

  return $::spellcheck::spellcheck(result);
};# ::spellcheck::checkSpelling

proc ::spellcheck::checkSpellingSub {pipe} {

  set i 0
  while { [set count [gets $pipe line]] >= 0 } {
    incr i
    if { $count == 0 || $line eq "*" } {
         continue; # nothing of interest
       }
    set list [split $line " "]
    if { [lindex $list 0] eq "#" } {
         # No suggestions
         lappend return [list [lindex $list 2] [lindex $list 1]]
       } else {
         lappend return [list [string range [lindex $list 3] 0 end-1] [lindex $list 1] [split [string map [list "," ""] [join [lrange $list 4 end] " "]] " "]]
       }
  }
  close $pipe

  set ::spellcheck::spellcheck(result) [list $i $return];
  return;

};# ::spellcheck::checkSpellingSub

  

# Stop disabled treeview widgets responding to input  
foreach x [list Control-Button-1 Shift-Button-1 Key-space Key-Return Key-Left Key-Right \
                Key-Down Key-Up B1-Motion Double-Button-1 ButtonRelease-1 Button-1] {
   bind Treeview <$x> [format {if { ![%%W instate disabled] } { %s }} [bind Treeview <$x>]]
}

# Handy debugging proc
proc winover {} {
  return [winfo containing {*}[winfo pointerxy .]];
}
catch {
  console eval {.console configure -font [list "Courier New" 10]}
  console show
}



# Run it
set myTestString "The quik brown fox jumps over the layzee dog\nJackdaws lov my big sphincks of quortz\nFoo bar baz boing sprocket kablooey."
puts "Input:  $myTestString"
puts "\nOutput: [::spellcheck::spellcheck $myTestString]"

Discussion

The code for actually passing the words to aspell and reading them is slightly modified from an example on open, which did the same with ispell. Any comments/suggestions appreciated.

DDG - 2022-01-19 - modern Tcl/Tk 8.6/8.7 complains about pack and then grid the same widget, I as well used automatic setting for the spell checker. BTW: It is not a real widget which you could embed into your application, but the could here could be used as the base to crate one.