-#!/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 {
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} {
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
}
set database($bm) $strh
}
+ close $f
}
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} {