X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=pctb%2Fshow-thing.tcl;fp=pctb%2Fshow-thing.tcl;h=1c55fcdcb8c0d75a441994c91abc998c63fb9b80;hb=7715bdc10f8ea8a0b26715bddb3fb5b973f0d404;hp=4537e6af63b8242cd7afca15aebd1cad341f4e69;hpb=54f10d7fe3898d21ea03d544c9c3d3f1c0561969;p=ypp-sc-tools.db-test.git diff --git a/pctb/show-thing.tcl b/pctb/show-thing.tcl index 4537e6a..1c55fcd 100755 --- a/pctb/show-thing.tcl +++ b/pctb/show-thing.tcl @@ -1,4 +1,10 @@ -#!/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 proc manyset {list args} { foreach val $list var $args { @@ -287,11 +293,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 @@ -300,6 +305,7 @@ proc read_database {} { } set database($bm) $strh } + close $f } proc write_database {} { @@ -314,9 +320,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} {