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.
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.