break out char_start_define_text into a proc

[ypp-sc-tools.db-test.git] / pctb / dictionary-manager

diff --git a/pctb/dictionary-manager b/pctb/dictionary-manager
index 10c87a83c0ac7810f4700190d71a9d8f71e01fc0..105490d5817eb9549bca6ebf2a7644618a75923d 100755 (executable)
--- a/pctb/dictionary-manager
+++ b/pctb/dictionary-manager
@@ -269,7 +269,7 @@ proc required/char {} {
     }
     foreach ctx $unk_contexts { set all_contexts($ctx) 1 }
 
-    destroy [winfo children .d.selctx]
+    eval destroy [winfo children .d.selctx]
     label .d.selctx.title -text \
        {Select match context for altering dictionary:}
     pack .d.selctx.title -side left
@@ -372,11 +372,13 @@ proc pixmap_maybe_ok {} {
 }
 proc pixmap_ok {} {
     global database ppm pixmap_selcol pixmap_selrow mainkind alloptions
+
+    return_result_start
     foreach_pixmap_col col {
        .d.pe.grid.l$col configure -state disabled
     }
     .d.pe.ok configure -state disabled
-    helptext {{{ Processing }}}
+
     manyset [lrange $alloptions [expr {$pixmap_selcol*3}] end] \
        colname coldesc rows
     manyset [lrange $rows [expr {$pixmap_selrow*2}] end] \
@@ -385,7 +387,8 @@ proc pixmap_ok {} {
     debug "UPDATE PIXMAP AS >$result<"
 
     do_database_update $ppm $result
-    done/$mainkind
+
+    return_result_finish
 }
 
 proc required/pixmap {} {
@@ -751,11 +754,7 @@ proc recursor//01 {z1} {
        bind_key BackSpace {}
     }
     bind_key Return {
-       if {$cur_0 != $cur_1} {
-           .d.csr.csr.e delete 0 end
-           set cur_mode text
-           recursor
-       }
+       char_start_define_text
     }
     helptext {
        {{<- ->}   {move cursor, adjusting area to define}}
@@ -771,6 +770,14 @@ proc othercursor {} {
     recursor
 }
 
+proc char_start_define_text {} {
+    global cur_0 cur_1 cur_mode
+    if {$cur_0 == $cur_1} return
+    .d.csr.csr.e delete 0 end
+    set cur_mode text
+    recursor
+}
+
 proc recursor/text {} {
     global all_contexts
     
@@ -802,7 +809,7 @@ proc recursor/already {} {
     global cur_already mul
     global glyphsdone cur_already mul
 
-    char_exactly_selctxts [lindex $glyphsdone [expr {$cur_already*5+3}]]
+    char_exactly_selctxts [lindex $glyphsdone [expr {$cur_already*5+2}]]
 
     .d.csr.csr.l configure -text {correct}
     set rmax [lindex $glyphsdone [expr {$cur_already*5}]]
@@ -920,36 +927,41 @@ proc char_get_definition_info {c0 c1} {
 }
 
 proc update_database/DEFINE {c0 c1 strq} {
+    global new_context
     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
+    debug "DEFINE $c0 $c1 $new_context {$ncontexts}"
+    if {[llength $ncontexts]==1} {
+       set c [lindex $ncontexts 0]
+    } elseif {[lsearch -exact $new_context $ncontexts]>=0} {
+       set c $new_context
+    } else {
+       puts stderr "Selected context is not one of the many possibilities."
+       return;
     }
+    set bm [dbkey $c $c0 $c1]
+    do_database_update $bm $strq
 }
 
 proc update_database/DELETE {l r ctxs} {
     global database
+    if {[llength $ctxs]!=1} { error "$ctxs ?" }
     foreach ctx $ctxs {
        set bm [dbkey $ctx $l $r]
        catch { unset database($bm) }
     }
     write_database
 }
-    
+
 proc RETURN_RESULT {how what} {
-    global mainkind
+    return_result_start
+
     place forget .d.csr.csr
     pack forget .d.csr.csr.e
-    helptext {{{ Processing }}}
-    unbind_all_keys
-    update idletasks
+
     debug "$how $what"
     eval update_database/$how $what
-    done/$mainkind
+
+    return_result_finish
 }
 
 #========== server for approving updates ==========
@@ -1274,6 +1286,16 @@ proc approve_show_page {delta} {
 
 #========== main program ==========
 
+proc return_result_start {} {
+    helptext {{{ Processing }}}
+    unbind_all_keys
+    update idletasks
+}
+proc return_result_finish {} {
+    global mainkind
+    done/$mainkind
+}
+
 proc main/default {} {
     puts stderr "Do not run this program directly."
     exit 12