X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=blobdiff_plain;f=pctb%2Fshow-thing.tcl;fp=pctb%2Fstuff%2Fshow-thing.tcl;h=f2055f44aca83b55c64aefafd1906aa493e90e5a;hp=c1e8cb94aa94cd0346d33cd9e4b531a869c12f31;hb=24222363faec9b4e3d7074af2df5f39933613c7f;hpb=1971b4961a061d32a86a5e08a64f1b960f666802

diff --git a/pctb/stuff/show-thing.tcl b/pctb/show-thing.tcl
similarity index 93%
rename from pctb/stuff/show-thing.tcl
rename to pctb/show-thing.tcl
index c1e8cb9..f2055f4 100755
--- a/pctb/stuff/show-thing.tcl
+++ b/pctb/show-thing.tcl
@@ -1,4 +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 {
@@ -14,9 +22,11 @@ set rhsmost_max -1
 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} {
@@ -278,11 +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 +300,7 @@ proc read_database {} {
 	}
 	set database($bm) $strh
     }
+    close $f
 }
 
 proc write_database {} {
@@ -305,9 +315,12 @@ proc write_database {} {
 	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} {