#########################################################
#                  Tk LaTeX Editor
#        Distributed under GNU Public License
# Author: Sergey Kalinin (BanZaj) banzaj@lrn.ru
# Copyright (c) "CONERO lab", 2002, http://conero.lrn.ru
#########################################################
#              Spell Checking procedure
#              required Ispell, Msgcat
# Author: Victor Wagner (Vitus) http://www.ice.ru/~vitus
#
# Usage: "SpellCheck text_widget"
#########################################################


proc SpellCheck {text} {
    global ispell_lib ispell_language ispell_startindex nb color font
    set node [$nb raise]
    if {[winfo exists .spell]} {
        return
    }
    
    if {$node == "newproj" || $node == "settings" || $node == "about" || $node == ""} {
        return
    }
    # Build dictionary list
    foreach dict [glob [file join $ispell_lib *.hash]] {
        file stat $dict foo
        set lang [file rootname [file tail $dict]]
        if {$lang == "default"} {
            set default_inode $foo(ino)
        } else {
            lappend langs $lang
            set lang_nodes($foo(ino)) $lang;
        }  
    }  
    if {![info exists ispell_language]} {
        if {[info exists default_inode ]&&[info exists lang_nodes($default_inode)]} {
            set ispell_language $lang_nodes($default_inode)
        } else {
            set ispell_language [lindex $langs 0]
        }
    }
    toplevel .spell -class Notepad
    wm title .spell [::msgcat::mc "Spell check"]
    wm transient .spell .
    wm resizable .spell 0 0
    
    frame .spell.lang -relief raised -borderwidth 1 -background $color(bg)
    label .spell.lang.l -text [::msgcat::mc "Language"] -background $color(bg) -font $font(normal)
    eval tk_optionMenu .spell.lang.m ispell_language $langs -background $color(bg) -font $font(normal)
    pack .spell.lang.l .spell.lang.m -side left -padx 5 
    pack .spell.lang.m -side left -padx 5 -fill x -expand 1
    frame .spell.start -relief raised -borderwidth 1 -background $color(bg)
    radiobutton .spell.start.all -text [::msgcat::mc "Entire file"] -background $color(bg)\
    -variable ispell_startindex -value "1.0" -anchor w -font $font(normal)
    radiobutton .spell.start.ins -text [::msgcat::mc "From cursor"] -background $color(bg)\
    -variable ispell_startindex -value insert -anchor w -font $font(normal)
    pack .spell.start.all .spell.start.ins -side top -pady 1 -expand y -fill x        
    frame .spell.b -relief raised -borderwidth 1 -background $color(bg)
    button .spell.b.ok -text [::msgcat::mc "Start"] -relief groove -background $color(bg)\
    -command "DoSpellCheck $text"  -font $font(normal)
    button .spell.b.cancel -text [::msgcat::mc "Cancel"] -relief groove -background $color(bg)\
    -command "destroy .spell" -font $font(normal)
    pack .spell.b.ok .spell.b.cancel -side left -padx 10
    pack .spell.lang -side top -fill x
    pack .spell.start -side top -fill both -expand 1
    pack .spell.b -side top -fill x
    bind .spell <Escape> "destroy .spell"
}

proc DoSpellCheck {text} {
    global ispell_file ispell_startindex ispell_language spellAddWords color font
    eval destroy [winfo children .spell]
    wm transient .spell .
    entry .spell.word -exportselection false
    listbox .spell.misses -yscrollcommand ".spell.y set" -exportselection false -background $color(bg)
    scrollbar .spell.y -command ".spell.misses yview" -background $color(bg)
    button .spell.ok -text [::msgcat::mc "Accept"] -command "SpellOk $text" -background $color(bg) \
    -font $font(normal)
    button .spell.accept -text [::msgcat::mc "Next"] -command "SpellAccept @" -background $color(bg) \
    -font $font(normal)
    button .spell.adddict -text [::msgcat::mc "Add to dict"] -command "SpellAccept *" -background $color(bg) \
    -font $font(normal)
    button .spell.adddict2 -text [::msgcat::mc "Add lowercase"] -command "SpellAccept &" -background $color(bg) \
    -font $font(normal)
    button .spell.stop -text [::msgcat::mc "Stop checking"] -command "SpellStop $text" -background $color(bg) \
    -font $font(normal)
    grid .spell.word - - -sticky news -padx 5 -pady 5
    grid .spell.misses .spell.y .spell.ok -sticky news  
    grid x x .spell.accept  -sticky news 
    grid x x .spell.adddict -sticky news
    grid x x .spell.adddict2 -sticky news
    grid x x .spell.stop -sticky news
    grid configure .spell.ok .spell.accept .spell.adddict .spell.adddict2 .spell.stop -padx 5 -pady 3
    grid configure .spell.misses .spell.y -rowspan 5 
    focus .spell.word
    wm protocol .spell WM_DELETE_WINDOW "SpellStop $text"
    
    set ispell_file [open "|ispell -a -d $ispell_language" w+]
    fconfigure $ispell_file -buffering none -blocking yes
    gets $ispell_file
    puts $ispell_file "!"
    set spellAddWords {}
    
    $text mark set insert $ispell_startindex 
    while {[SpellNextLine $text]} {
        while {[gets $ispell_file responce]>0} {
            switch -exact -- [string range $responce 0 0] {
                "*" -
                "+" -
                "-" {continue}
                "&" -
                "?" {regexp {^. +([^ ]+) +[0-9]+ +([0-9]+):(.*)$} $responce foo \
                orig offset guesses
                SpellInteract $orig $offset $guesses $text
            }
            "#" {regexp {^. +([^ ]+) +([0-9]+)} $responce foo orig offset
            SpellInteract $orig $offset {} $text
        }
    }
}
$text mark set insert "spellstart linestart + 1 lines"
}
close $ispell_file
eval destroy  [winfo children .spell]
label .spell.l -text [::msgcat::mc "Checking complete"] -background $color(bg)
button .spell.ok -text [::msgcat::mc "Ok"] -command {destroy .spell} -background $color(bg)
wm protocol .spell WM_DELETE_WINDOW {destroy .spell}
pack .spell.l .spell.ok -side top -padx 5 -pady 10
}


proc SpellNextLine {text} {
    global spellOffset ispell_file spellAddWords
    set spellOffset -1 
    $text see insert
    $text mark set spellstart insert
    set line [$text get insert "insert lineend"]
    if [$text compare insert >= "end-1char"] {
        return 0 
    }
    foreach word $spellAddWords {
        puts "Adding to dictionary $word"
        puts $ispell_file $word
    }   
    set spellAddWords {}
    puts $ispell_file "^$line"
    return 1
}

proc SpellInteract {word offset guesses text} {
    .spell.word delete 0 end
    .spell.word insert 0 $word
    $text tag remove sel 0.0 end
    global spellOffset
    incr offset $spellOffset
    $text tag add sel "spellstart+$offset chars" "spellstart+[expr $offset+\
    [string length $word]] chars"
    global spellHighlight
    set spellHighlight [$text tag ranges sel]
    $text see sel.first
    $text mark set insert sel.first
    .spell.misses delete 0 end
    if [string length $guesses] {
        foreach miss [split $guesses ","] {
            .spell.misses insert end [string trim $miss]
        }
    }
    global spellInteractResult
    vwait spellInteractResult
    return -code $spellInteractResult
}

proc SpellOk {text} {
    # заменить на содержимое .spell.word или .spell.misses
    global spellInteractResult spellHighlight
    if [llength [.spell.misses curselection]] {
        set word [.spell.misses get [.spell.misses curselection]]
    } else {
        set word [.spell.word get]
    }
    if {![llength [$text tag ranges sel]]} {
        global spellHighilight
        eval $text tag add sel $spellHighlight
    }  
    set oldword [$text get sel.first sel.last]
    if {[string compare $oldword $word]} {
        $text delete sel.first sel.last
        $text insert insert $word sel
        global changed spellOffset
        set changed 1
        incr spellOffset [expr [string length $word]-[string length $oldword]]
    }    
    set spellInteractResult ok
}

proc SpellAccept {cmd} {
    global spellAddWords spellInteractResult
    lappend  spellAddWords "$cmd[.spell.word get]"
    set spellInteractResult ok
}

proc SpellStop {text} {
    global ispell_file
    $text mark unset spellstart
    catch {close $ispell_file}
    destroy .spell
    set spellInteractResult return
}