217 lines
8.0 KiB
Tcl
217 lines
8.0 KiB
Tcl
|
#########################################################
|
|||
|
|
# 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} {
|
|||
|
|
# <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> .spell.word <20><><EFBFBD> .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
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|