#!/usr/local/bin/wish8.1
#
# ----------------------------------------------------------------------
#   AUTHOR:  Lindsay Marshall <lindsay.marshall@newcastle.ac.uk>
# ----------------------------------------------------------------------
# Copyright 1999 The University of Newcastle upon Tyne (see COPYRIGHT)
# ======================================================================
#
set ispell ispell
set version 1.0
set ncount 0
#
proc pop {x y win tag opts} {
    set mn [menu $win$tag -tearoff 0]
    foreach wrd $opts {$mn insert end command -label $wrd -command "correct $win $tag $wrd"}
    tk_popup $mn $x $y 0
}
#
proc cbpop {x y win tag opts} {
    global cbp
    set cbp($win) {}
    set w [toplevel $win$tag]
    wm geometry $w +$x+$y
    wm title $w Change
    set i 0
    foreach a $opts {
        radiobutton $w.$i -text $a -variable cbp($win) -value $a
	incr i
    }
    set row 0
    set col 0
    for {set j 0} {$j <$i} {incr j} {
        grid $w.$j -row $row -column $col -sticky w
	if {[incr col] == 4} {
	    incr row
	    set col 0
	}
    }
    grid [entry $w.val -textvariable cbp($win)] - - - -sticky ew
    grid [frame $w.btn] - - - -sticky ew
    grid [button $w.btn.cancel -text Cancel -width 8 -command "destroy $win$tag"] \
      [button $w.btn.ok -text OK -width 8 -command "ok $win $tag"]
}
#
proc ok {w tag} {
    global cbp
    destroy $w$tag
    correct $w $tag $cbp($w)
}
#
proc upop {x y win ntag tag orig} {
    set mn [menu $win$ntag -tearoff 0]
    $mn insert end command -label Undo! -command "undo $win $ntag $tag $orig"
    tk_popup $mn $x $y 0
}
#
proc change {win tag} {
    destroy $win$tag
    set w [toplevel $win$tag
}
#
proc undo {w ntag tag orig} {
    global ccount
    if {[incr ccount($w) -1] <= 0} {
        $w.btn.save configure -state disabled
    }
    destroy $w$ntag
    foreach {a b} [$w.txt tag ranges $ntag] break
    $w.txt delete $a $b
    $w.txt insert $a $orig "$tag bad"
}
#
proc correct {win tag wrd} {
    global ccount
    incr ccount($win)
    $win.btn.save configure -state normal
    destroy $win$tag
    foreach {a b} [$win.txt tag ranges $tag] break
    set ntag [getname undo]
    set orig [$win.txt get $a $b]
    $win.txt delete $a $b
    $win.txt insert $a $wrd "changed $ntag"
    $win.txt tag bind $ntag <ButtonPress-1> "upop %X %Y $win $ntag $tag $orig"
}
#
proc getname {txt} {
    global ncount
    return $txt[incr ncount]
}
#
wm withdraw .
#
proc save {win file} {
    file rename -force $file $file.bak
    set fd [open $file w]
    puts $fd [$win.txt get 1.0 end]
    close $fd
}
#
proc quit {w} {
    destroy $w
    switch {} [winfo children .] { exit }
}
#
proc getanswer {fd} {
    while {1} {
        set answer [gets $fd]	
	switch -glob -- $answer {
	    {} -
	    @* {}
	    default { return $answer }
	}
    }
}    
#
proc mkSpell {file} {
    global ispell ccount
    set w [toplevel [getname .w]]
    set ccount($w) 0
    wm title $w $file
    wm resizable $w 1 1
    grid rowconfigure $w 0 -weight 1
    grid columnconfigure $w 0 -weight 1
#
    scrollbar $w.vs -command "$w.txt yview"
    scrollbar $w.hs -command "$w.txt xview" -orient horizontal
    text $w.txt -yscrollcommand "$w.vs set" -xscrollcommand "$w.hs set" \
      -wrap none
    $w.txt tag configure bad -foreground red
    $w.txt tag configure changed -foreground blue
    grid [label $w.lab -text "Processing $file" -cursor watch] -padx 20 -pady 20
    update
    set fd [open $file]
    set buffer [read $fd]
    close $fd
    regsub -all "\{" $buffer "\\&lbrace;" buffer
    regsub -all "\}" $buffer "\\&rbrace;" buffer
    regsub -all {<[^>]*>} $buffer "\} {&} \{" buffer
    regsub -all {&[a-zA-Z]+;} $buffer "\} {&} \{" buffer
    set ifd [open "|$ispell -a" r+]
    fconfigure $ifd -buffering line
    foreach x "{$buffer}" {
        switch -glob -- $x {
	    {} continue
	    &* -
	    <* {$w.txt insert end $x}
	    default {
	        regsub -all {[^a-zA-Z]+} $x "\} {&} \{" x
		foreach word "{$x}" {
		    switch -glob -- $word {
		        {[a-zA-Z]*} {
			    puts $ifd ^$word
			    set answer [getanswer $ifd]
			    switch -glob -- $answer {
			        @* { }
				&lbrace; { $w.txt insert end "\{" }
				&rbrace; { $w.txt insert end "\}" }
				&* {
				    set tag [getname bad]
				    set opts [lrange $answer 4 end]
				    regsub -all , $opts {} opts
				    $w.txt tag bind $tag <ButtonPress-1> "pop %X %Y $w $tag [list $opts]"
				    $w.txt tag bind $tag <2> "cbpop %X %Y $w $tag [list $opts]"
				    $w.txt insert end $word "bad $tag"
				    continue
				}
			    }
			}
		    }
		    $w.txt insert end $word
		}
	    }
	}
    }
    catch {close $ifd}
    destroy $w.lab
#
    frame $w.btn
    button $w.btn.save -text Save -command "save $w $file" -width 8 -state disabled
    button $w.btn.quit -text Quit -command "quit $w" -width 8
    grid $w.btn.save $w.btn.quit
    grid $w.txt -sticky nsew -row 0 -column 0
    grid $w.vs -row 0 -column 1 -sticky ns
    grid $w.hs -sticky ew -row 1 -column 0
    grid $w.btn - -sticky ew -row 2 -column 0
}
#
foreach x $argv { mkSpell $x }
