X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=pctb%2Fshow-thing.tcl;h=0d2ec0c94ba202998858e3e539dc3673c3020bbf;hp=142ab42a712555be20539c2ddf014cd1c1d268cc;hb=1ae1abc15aae822e996b23e2dc73612b4d401044;hpb=7198105eceff39cb71cd432312e0e9c82139d7b1

diff --git a/pctb/show-thing.tcl b/pctb/show-thing.tcl
index 142ab42..0d2ec0c 100755
--- a/pctb/show-thing.tcl
+++ b/pctb/show-thing.tcl
@@ -245,7 +245,7 @@ proc recursor/text {} {
     pack .d.csr.csr.e -side left
     focus .d.csr.csr.e
     bind_key Return {
-	binary scan [.d.csr.csr.e get] h* hex
+	binary scan [.d.csr.csr.e get] H* hex
 	if {[string length $hex]} {
 	    RETURN_RESULT DEFINE "$cur_0 $cur_1 $hex"
 	}
@@ -348,7 +348,7 @@ proc write_database {} {
     set ol {}
     foreach bm [array names database] {
 	set strh $database($bm)
-	set strs [binary format h* $strh]
+	set strs [binary format H* $strh]
 	set strdo [format "%d %s" [expr {[string length $strh]/2}] $strh]
 	set o "[lindex $bm 0] $strdo\n"
 	append o [format "%d\n" [expr {[llength $bm]-1}]]
@@ -401,20 +401,20 @@ proc update_database/DELETE {l r ctx} {
     
 
 proc RETURN_RESULT {how what} {
+    global mainkind
     place forget .d.csr.csr
     pack forget .d.csr.csr.e
     helptext {{{ Processing }}}
     unbind_all_keys
     update idletasks
-    puts "$how $what"
+    puts stderr "$how $what"
     eval update_database/$how $what
-    exec kill -STOP [pid]
-    fileevent stdin readable required
+    done/$mainkind
 }
 
 #---------- main progrm ----------
 
-proc test_main {} {
+proc main/test {} {
     global glyphsdone unk_l unk_r unk_context
 
     set glyphsdone {
@@ -433,6 +433,8 @@ proc test_main {} {
     draw_glyphsdone
     startup_cursor
 }
+proc done/test {} {
+}
 
 proc required {} {
     global glyphsdone unk_l unk_r unk_context
@@ -444,7 +446,7 @@ proc required {} {
     init_widgets
     manyset [lrange $l 0 3] unk_l unk_r unk_context
     set glyphsdone [lrange $l 3 end]
-    puts "SHOW-THING GOT $l"
+    puts stderr "SHOW-THING GOT $l"
 
     fileevent stdin readable {}
 
@@ -453,6 +455,21 @@ proc required {} {
     startup_cursor
 }
 
+proc main/automatic {} {
+    fconfigure stdin -blocking no
+    fileevent stdin readable required
+}
+proc done/automatic {} {
+    exec sh -c {printf \\0 >&4}
+    fileevent stdin readable required
+}
+
+switch -exact -- $argv {
+    {}               { set mainkind test }
+    {--automatic 1}  { set mainkind automatic }
+    {--automatic*}   { error "incompatible versions - install problem" }
+    default          { error "huh $argv ?" }
+}
+
 read_database
-fconfigure stdin -blocking no
-fileevent stdin readable required
+main/$mainkind