}
proc required/char {} {
- global mulrows glyphsdone unk_l unk_r unk_contexts rows unk_context
+ global mulrows glyphsdone unk_l unk_r unk_contexts rows new_context
+ global all_contexts
must_gets stdin l
char_read_xpm stdin
+ catch { unset all_contexts }
+
resize_widgets_core
foreach w {0 1} {
.d.mi.csr_$w configure -height $mulrows
set maxh 0
foreach {min max contexts got} $glyphsdone {
show_context maxh $min $contexts
+ foreach ctx $contexts { set all_contexts($ctx) 1 }
}
+ foreach ctx $unk_contexts { set all_contexts($ctx) 1 }
destroy [winfo children .d.selctx]
label .d.selctx.title -text \
- {Select match context for new dictionary entry:}
+ {Select match context for altering dictionary:}
pack .d.selctx.title -side left
- set unk_context [lindex $unk_contexts 0]
- set ci 0; foreach ctx $unk_contexts {
- radiobutton .d.selctx.c$ci -variable unk_context \
- -value $ctx -text $ctx
- pack .d.selctx.c$ci -side left
+ set new_context [lindex $unk_contexts 0]
+
+ set ci 0; foreach ctx [lsort [array names all_contexts]] {
+ set all_contexts($ctx) $ci
+ set selw .d.selctx.c$ci
+ set seltxt $ctx
+ radiobutton $selw -variable new_context -value $ctx -text $seltxt
+ pack $selw -side left
incr ci
}
- set ci [expr {[llength $unk_contexts]-1}]
- .d.selctx.c$ci configure -text [lindex $unk_contexts $ci].
- if {[llength $unk_contexts]==1} {
- foreach w [winfo children .d.selctx] { $w configure -state disabled }
- }
+ $selw configure -text "$seltxt."
label .d.selctx.warning -text {See README.charset.}
pack .d.selctx.warning -side left
#---------- character set runtime display and keystroke handling ----------
+proc char_exactly_selctxts {contexts} {
+ global all_contexts
+ foreach ctx [array names all_contexts] {
+ set ci $all_contexts($ctx)
+ set selw .d.selctx.c$ci
+ if {[lsearch -exact $contexts $ctx]>=0} {
+ set state normal
+ } else {
+ set state disabled
+ }
+ $selw configure -state $state
+ }
+}
+
proc recursor/0 {} { recursor//01 0 }
proc recursor/1 {} { recursor//01 1 }
proc recursor//01 {z1} {
- global mul rhsmost_max cols glyphsdone
+ global mul rhsmost_max cols glyphsdone cur_0 cur_1
upvar #0 cur_$z1 cur
.d.csr.csr.l configure -text {adjust}
place .d.csr.csr -x [expr {$cur*$mul - 7}]
+
+ manyset [char_get_definition_info $cur_0 $cur_1] contexts
+ char_exactly_selctxts $contexts
+
bind_key space { othercursor }
bind_leftright_q cur_$z1 0 [expr {$cols-1}]
if {[llength $glyphsdone]} {
}
proc recursor/text {} {
+ global all_contexts
+
helptext {
{Return {confirm entry of new glyph}}
{Escape {abandon entry}}
global glyphsdone
global cur_already mul
global glyphsdone cur_already mul
+
+ char_exactly_selctxts [lindex $glyphsdone [expr {$cur_already*4+2}]]
+
.d.csr.csr.l configure -text {correct}
set rmax [lindex $glyphsdone [expr {$cur_already*4}]]
place .d.csr.csr -x [expr {$rmax*$mul-3}]
return $bm
}
-proc update_database/DEFINE {c0 c1 strq} {
+proc char_get_definition_info {c0 c1} {
+ # => ncontexts cl cr
global glyphsdone unk_l unk_contexts wordmap database
+
if {$c0 > $c1} { manyset [list $c0 $c1] c1 c0 }
+
if {$c0 == $unk_l} {
set ncontexts $unk_contexts
} else {
if {$l==$c0} { set ncontexts $contexts; break }
}
if {![info exists ncontexts]} {
- puts stderr "must start at letter LHS!"
- return
+ set ncontexts {}
}
}
incr c1 -1
+ set r [list $ncontexts $c0 $c1]
+ debug "CDGI $r"
+ return $r
+}
+
+proc update_database/DEFINE {c0 c1 strq} {
+ manyset [char_get_definition_info $c0 $c1] ncontexts c0 c1
+ if {![llength $ncontexts]} {
+ puts stderr "must start at letter LHS!"
+ return
+ }
foreach c $ncontexts {
set bm [dbkey $c $c0 $c1]
do_database_update $bm $strq