X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=pctb%2Fshow-thing.tcl;h=5356c3292c7c58a276944752d6b16c325b1f5090;hb=75979fe69d99518d9f79d45fb52eb76e05f58053;hp=980a8a48c88763ad41e8bc6ed7bfa1e33a1e8f12;hpb=8b3b006869bfdc6c2ddbf58d6709a73433abe2f9;p=ypp-sc-tools.main.git

diff --git a/pctb/show-thing.tcl b/pctb/show-thing.tcl
index 980a8a4..5356c32 100755
--- a/pctb/show-thing.tcl
+++ b/pctb/show-thing.tcl
@@ -134,7 +134,7 @@ proc read_xpm {f} {
 
 	    set realcols $cols
 	    set cols [expr {$cols - $chop_l - $chop_r}]
-	    puts stderr "NOW cols=$cols chop_l,r=$chop_l,$chop_r rows=$rows\
+	    debug "NOW cols=$cols chop_l,r=$chop_l,$chop_r rows=$rows\
                 $unk_l $unk_r $ngd"
 	    
 	    set mulcols [expr {$cols*$mul+$inter}]
@@ -269,6 +269,7 @@ proc recursor//01 {z1} {
     }
     bind_key Return {
 	if {$cur_0 != $cur_1} {
+	    .d.csr.csr.e delete 0 end
 	    set cur_mode text
 	    recursor
 	}
@@ -298,7 +299,6 @@ proc recursor/text {} {
     bind_key Return {
 	set strq [.d.csr.csr.e get]
 	if {[regexp {^(?:[!-[]|[]-~]|\\\\|\\x[0-9a-f]{2})+} $strq]} {
-	    .d.csr.csr.e delete 0 end
 	    RETURN_RESULT DEFINE "$cur_0 $cur_1 $strq"
 	}
     }
@@ -477,7 +477,7 @@ proc RETURN_RESULT {how what} {
     helptext {{{ Processing }}}
     unbind_all_keys
     update idletasks
-    puts stderr "$how $what"
+    debug "$how $what"
     eval update_database/$how $what
     done/$mainkind
 }
@@ -518,9 +518,10 @@ proc required {} {
     init_widgets
     manyset [lrange $l 0 3] unk_l unk_r unk_contexts
     set glyphsdone [lrange $l 3 end]
-    puts stderr "SHOW-THING GOT $l"
+    debug "GOT $l"
 
     fileevent stdin readable {}
+    fconfigure stdin -blocking yes
 
     read_xpm stdin
     resize_widgets
@@ -535,14 +536,20 @@ proc main/automatic {} {
 }
 proc done/automatic {} {
     exec sh -c {printf \\0 >&4}
-    fileevent stdin readable required
+    main/automatic
 }
 
-switch -exact -- $argv {
-    {}               { set mainkind test }
-    {--automatic 1}  { set mainkind automatic }
-    {--automatic*}   { error "incompatible versions - install problem" }
-    default          { error "huh $argv ?" }
+proc debug {m} { }
+
+set mainkind test
+foreach arg $argv {
+    switch -exact -- $arg {
+	{--debug}        { proc debug {m} { puts stderr "SHOW-THING $m" } }
+	{--noop-arg}     { }
+	{--automatic-1}  { set mainkind automatic }
+	{--automatic*}   { error "incompatible versions - install problem" }
+	default          { error "huh $argv ?" }
+    }
 }
 
 main/$mainkind