merge changes made accidentally to wrong copy

diff --combined pctb/show-thing.tcl
index c1e8cb94aa94cd0346d33cd9e4b531a869c12f31,9a5b1d253c91a0d43093551ad4889df95b30f02c..f2055f44aca83b55c64aefafd1906aa493e90e5a
--- 1/pctb/stuff/show-thing.tcl
--- 2/pctb/show-thing.tcl
+++ b/pctb/show-thing.tcl
@@@ -1,4 -1,12 +1,12 @@@
- #!/usr/bin/tk
+ #!/usr/bin/wish
+ 
+ # usage:
+ #  run show-thing without args
+ #  then on stdin write
+ #     one line which is a Tcl list for foolist
+ #     the xpm in the format expected
+ #  then expect child to raise SIGSTOP or exit 0 or exit nonzero
+ #  if child raised SIGSTOP, check database was updated
  
  proc manyset {list args} {
      foreach val $list var $args {
@@@ -7,28 -15,41 +15,30 @@@
      }
  }
  
 -set foolist {
 -    7 11 1 M
 -    13 17 0 a
 -    19 23 0 n
 -}
 -set unk_l 25
 -set unk_r 29
 -set unk_context 0
 -
 -
 -
  set mul 6
  set inter 1
  set rhsmost_max -1
  
 -set f [open text.xpm]
 -set o {}
 -set y -3
 -while 1 {
 -    if {[gets $f l] < 0} { error "huh? "}
 -    if {![regexp {^"(.*)",$} $l dummy l]} {
 -      append o "$l\n"
 -      if {[regexp {^\}\;$} $l]} break
 -      continue
 -    }
 -    if {$y==-3} {
 -      manyset $l cols rows colours cpp
 -      #assert {$colours==2}
 -      #assert {$cpp==1}
 -      set mulcols [expr {$cols*$mul+$inter}]
 -      set mulrows [expr {$rows*$mul+$inter}]
 -      append o "\"$mulcols $mulrows 9 1\",\n"
 -      for {set x 0} {$x<$cols} {incr x} { set wordmap($x) 0 }
 -    } elseif {$y==-2} { # first pixel
 -      append o \
 +proc read_xpm {f} {
 +    set o {}
 +    set y -3
-     while {[gets $f l] >= 0} {
++    while 1 {
++      if {[gets $f l] < 0} { error "huh? "}
 +      if {![regexp {^"(.*)",$} $l dummy l]} {
 +          append o "$l\n"
++          if {[regexp {^\}\;$} $l]} break
 +          continue
 +      }
 +      if {$y==-3} {
 +          manyset $l cols rows colours cpp
 +          #assert {$colours==2}
 +          #assert {$cpp==1}
 +          set mulcols [expr {$cols*$mul+$inter}]
 +          set mulrows [expr {$rows*$mul+$inter}]
 +          append o "\"$mulcols $mulrows 9 1\",\n"
 +          for {set x 0} {$x<$cols} {incr x} { set wordmap($x) 0 }
 +      } elseif {$y==-2} { # first pixel
 +          append o \
  "\"+ c #111\",
  \"a c #800\",
  \"A c #fcc\",
@@@ -38,63 -59,61 +48,63 @@@
  \"U c #ff0\",
  \"q c #000\",
  \"Q c #ff0\",\n"
 -    } elseif {$y==-1} { # 2nd pixel but we've already printed ours
 -    } else {
 -      set ybit [expr {1<<$y}]
 -      set x 0
 -        set ol "\"+"
 -        set olh $ol
 -      foreach c [split $l ""] {
 -          set how "u"
 -          if {$x >= $unk_l && $x <= $unk_r} {
 -              set how q
 -          } else {
 -              set ab 0
 -              foreach {min max context got} $foolist {
 -                  set rhsmost_max $max
 -                  if {$x >= $min && $x <= $max} {
 -                      set how [lindex {a b} $ab]
 -                      break
 +      } elseif {$y==-1} { # 2nd pixel but we've already printed ours
 +      } else {
 +          set ybit [expr {1<<$y}]
 +          set x 0
 +          set ol "\"+"
 +          set olh $ol
 +          foreach c [split $l ""] {
 +              set how "u"
 +              if {$x >= $unk_l && $x <= $unk_r} {
 +                  set how q
 +              } else {
 +                  set ab 0
 +                  foreach {min max context got} $foolist {
 +                      set rhsmost_max $max
 +                      if {$x >= $min && $x <= $max} {
 +                          set how [lindex {a b} $ab]
 +                          break
 +                      }
 +                      set ab [expr {!$ab}]
                    }
 -                  set ab [expr {!$ab}]
                }
 -          }
 -          switch -exact $c {
 -              " " { set p $how }
 -              "o" {
 -                  set p [string toupper $how]
 -                  incr wordmap($x) $ybit
 +              switch -exact $c {
 +                  " " { set p $how }
 +                  "o" {
 +                      set p [string toupper $how]
 +                      incr wordmap($x) $ybit
 +                  }
 +                  default { error "$c ?" }
                }
 -              default { error "$c ?" }
 -          }
 -          append ol "[string repeat $p [expr {$mul-$inter}]][
 +              append ol "[string repeat $p [expr {$mul-$inter}]][
                           string repeat + $inter]"
 -          append olh [string repeat + $mul]
 -          incr x
 +              append olh [string repeat + $mul]
 +              incr x
 +          }
 +          set ole "\",\n"
 +          append ol $ole
 +          append olh $ole
 +          set olhn [string repeat $olh $inter]
 +          if {!$y} { append o $olhn }
 +          append o [string repeat $ol [expr {$mul-1}]]
 +          append o $olhn
        }
 -        set ole "\",\n"
 -      append ol $ole
 -      append olh $ole
 -      set olhn [string repeat $olh $inter]
 -        if {!$y} { append o $olhn }
 -        append o [string repeat $ol [expr {$mul-1}]]
 -      append o $olhn
 +      incr y
      }
 -    incr y
 +    set data [exec xpmtoppm << $o]
 +    image create photo main_image -data $xpm
  }
  
  #puts $o
  
 -set xpm [exec xpmtoppm << $o]
 -
  set gotsh 20
  set csrh 20
  
  frame .d -width $mulcols -height [expr {$csrh+$mulrows+$gotsh}]
  
 -set mi [image create photo -data $xpm]
 +set mi main_image
 +image create bitmap main_image
  label .d.mi -image $mi -borderwidth 0
  
  frame .d.csr -bg black -width $mulcols -height $csrh
@@@ -278,11 -297,10 +288,10 @@@ proc read_database {} 
      global database
      set f [open database r]
      while {[gets $f l] >= 0} {
-       if {![regexp {^(\w+) (\d+) ([0-9a-f]{2}+)$} $l \
+       if {![regexp {^(\w+) (\d+) ((?:[0-9a-f]{2})+)$} $l \
                  dummy context strl strh]} {
            error "bad syntax"
        }
-         binary scan $strw h* strh
        if {[string length $strh] != $strl*2} { error "$strh $strl" }
        gets $f l; set width [format %d $l]
        set bm $context
@@@ -291,6 -309,7 +300,7 @@@
        }
        set database($bm) $strh
      }
+     close $f
  }
  
  proc write_database {} {
@@@ -305,9 -324,12 +315,12 @@@
        foreach x [lrange $bm 1 end] { append o "$x\n" }
        lappend ol $o
      }
+     set f [open database.new w]
      foreach o [lsort $ol] {
-       puts -nonewline $o
+       puts -nonewline $f $o
      }
+     close $f
+     file rename -force database.new database
  }
  
  proc update_database/DEFINE {c0 c1 strh} {
@@@ -345,22 -367,5 +358,22 @@@ proc RETURN_RESULT {how what} 
  
  #    bind . <Key-space> {}
  
 -read_database
 -recursor
 +proc test_main {} {
 +    global foolist
 +    
 +    set foolist {
 +      7 11 1 M
 +      13 17 0 a
 +      19 23 0 n
 +    }
 +    set unk_l 25
 +    set unk_r 29
 +    set unk_context 0
 +
 +    set f [open text.xpm]
 +    read_xpm $f
 +    close $f
 +
 +    read_database
 +    recursor
 +}