[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 http://aspell.net%|%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.

[http://wiki.tcl.tk/_repo/images/spellcheck.jpg]


======
namespace eval ::spellcheck {
  variable options;
  variable spellcheck;

  set options(aspell) "c:/progra~1/aspell/bin/aspell.exe -a"
  set options(grab) 0
}

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

  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

  pack [::ttk::label $frame.top_label -text "Words:"] -side top -anchor nw

  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:"
  pack [set bottom [::ttk::frame $frame.bottom]] -side top -expand 1 -fill both
  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 inset {} end -values [list "Unable to spell-check text"] -tags wrong
         return;
       }
    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);
     } else {
       $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;

  if { [catch {open "|$options(aspell)" r+} pipe] } {
       return [list 0 [list]];
     }
  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>]]
}



# Run it
catch {console show}

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]"

======

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.

<<categories>>Enter Category Here