chiark / gitweb /
break out char_start_define_text into a proc
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Wed, 1 Jul 2009 20:05:37 +0000 (21:05 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Wed, 1 Jul 2009 20:05:37 +0000 (21:05 +0100)
pctb/dictionary-manager

index 5904b4d..105490d 100755 (executable)
@@ -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
@@ -388,7 +388,7 @@ proc pixmap_ok {} {
 
     do_database_update $ppm $result
 
-    return_result_done
+    return_result_finish
 }
 
 proc required/pixmap {} {
@@ -754,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}}
@@ -774,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
     
@@ -805,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}]]
@@ -923,19 +927,24 @@ 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) }
@@ -952,7 +961,7 @@ proc RETURN_RESULT {how what} {
     debug "$how $what"
     eval update_database/$how $what
 
-    return_result_done
+    return_result_finish
 }
 
 #========== server for approving updates ==========