Check-in [44e0b4f94c]
Overview
Comment:Added preliminary support for using a Tcl-based metakit reader (mk4tcl.tcl, based off ReadKit) if Mk4tcl support not found

Updated mk4tcl to cleanup if build fails, to prevent false detection

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:44e0b4f94c1c4e9e6bcfdbcf01df19eacf08112e
User & Date: rkeene on 2010-09-26 04:40:56
Other Links: manifest | tags
Context
2010-09-26
04:41
Updated to be less verbose on missing directories check-in: ea9a5ecf91 user: rkeene tags: trunk
04:40
Added preliminary support for using a Tcl-based metakit reader (mk4tcl.tcl, based off ReadKit) if Mk4tcl support not found

Updated mk4tcl to cleanup if build fails, to prevent false detection check-in: 44e0b4f94c user: rkeene tags: trunk

04:40
KitCreator 0.1.0.x check-in: c48a3eddef user: rkeene tags: trunk, 0.1.0
Changes

Modified build/pre.sh from [f422eb34cc] to [e1071070fa].

     9      9   	cd "${KITSHROOTDIR}" || exit 1
    10     10   
    11     11   	autoconf; autoheader
    12     12   	rm -rf autom4te.cache
    13     13   	rm -f *~
    14     14   
    15     15   	./configure || exit 1
           16  +	make mk4tcl.tcl.h
    16     17   
    17     18   	make distclean
    18     19   ) || exit 1

Modified kitsh/buildsrc/kitsh-0.0/Makefile.in from [81946681c5] to [ec9cb72516].

     7      7   OBJS = kitInit.o main.o pwb.o rechan.o zlib.o winMain.o
     8      8   
     9      9   all: kit
    10     10   
    11     11   kit: $(OBJS) $(ARCHS)
    12     12   	$(CC) $(CPPFLAGS) $(CFLAGS) -o kit $(OBJS) $(ARCHS) $(LDFLAGS) $(LIBS)
    13     13   
           14  +mk4tcl.tcl.h: mk4tcl.tcl
           15  +	./stringify.tcl mk4tcl.tcl > mk4tcl.tcl.h
           16  +
    14     17   clean:
    15     18   	rm -f kit $(OBJS)
    16     19   
    17     20   distclean: clean
    18     21   	rm -f config.h Makefile config.log config.status
    19     22   	rm -rf autom4te.cache
    20     23   
    21     24   mrproper: distclean
    22         -	rm -f configure config.h
           25  +	rm -f configure config.h mk4tcl.tcl.h
    23     26   
    24     27   .PHONY: all clean distclean

Modified kitsh/buildsrc/kitsh-0.0/kitInit.c from [943ad6fb25] to [14eb71a613].

    74     74       "info script $old\n"
    75     75       "if {$code == 2} { set code 0 }\n"
    76     76       "return -code $code $res\n"
    77     77   "}\n"
    78     78   #endif
    79     79   "proc tclKitInit {} {\n"
    80     80       "rename tclKitInit {}\n"
           81  +#ifdef KIT_INCLUDES_MK4TCL
    81     82       "catch { load {} Mk4tcl }\n"
           83  +#else
           84  +#include "mk4tcl.tcl.h"
           85  +#endif
    82     86       "mk::file open exe [info nameofexecutable] -readonly\n"
    83     87       "set n [mk::select exe.dirs!0.files name boot.tcl]\n"
    84     88       "if {$n != \"\"} {\n"
    85     89           "set s [mk::get exe.dirs!0.files!$n contents]\n"
    86     90   	"if {![string length $s]} { error \"empty boot.tcl\" }\n"
    87     91           "catch {load {} zlib}\n"
    88     92           "if {[mk::get exe.dirs!0.files!$n size] != [string length $s]} {\n"

Added kitsh/buildsrc/kitsh-0.0/mk4tcl.tcl version [77305dd8a0].

            1  +#! /usr/bin/env tclsh
            2  +# ReadKit, a viewer/extractor/converter for starkits which does not
            3  +# require TclKit or MetaKit.  This file was generated by "rkgen.tcl".
            4  +#
            5  +# June 2002, Jean-Claude Wippler <jcw@equi4.com>
            6  +
            7  +# this is needed so often that I just drop copies of it all over the place
            8  +if {![info exists auto_index(lassign)] && [info commands lassign] == ""} {
            9  +    set auto_index(lassign) {
           10  +    proc lassign {l args} {
           11  +      foreach v $l a $args { uplevel 1 [list set $a $v] }
           12  +    }
           13  +  }
           14  +}
           15  +
           16  +catch {
           17  +	load {} zlib
           18  +	package require zlib
           19  +}
           20  +
           21  +if {[info comm mmap] == ""} {
           22  +    # mmap and mvec primitives in pure Tcl (a C version is present in critlib)
           23  +
           24  +    namespace export mmap mvec
           25  +
           26  +    namespace eval v {
           27  +	array set mmap_data {}
           28  +	array set mvec_shifts {
           29  +    - -1    0 -1
           30  +    1  0    2  1    4  2    8   3
           31  +    16 4   16r 4
           32  +    32 5   32r 5   32f 5   32fr 5
           33  +    64 6   64r 6   64f 6   64fr 6 }
           34  +    }
           35  +
           36  +    proc mmap {fd args} {
           37  +	upvar #0 v::mmap_data($fd) data
           38  +	# special case if fd is the name of a variable (qualified or global)
           39  +	if {[uplevel #0 [list info exists $fd]]} {
           40  +	    upvar #0 $fd var
           41  +	    set data $var
           42  +	}
           43  +	# cache a full copy of the file to simulate memory mapping
           44  +	if {![info exists data]} {
           45  +	    set pos [tell $fd]
           46  +	    seek $fd 0 end
           47  +	    set end [tell $fd]
           48  +	    seek $fd 0
           49  +	    set trans [fconfigure $fd -translation]
           50  +	    fconfigure $fd -translation binary
           51  +	    set data [read $fd $end]
           52  +	    fconfigure $fd -translation $trans
           53  +	    seek $fd $pos
           54  +	}
           55  +	set total [string length $data]
           56  +	if {[llength $args] == 0} {
           57  +	    return $total
           58  +	}
           59  +	foreach {off len} $args break
           60  +	if {$len < 0} {
           61  +	    set len $total
           62  +	}
           63  +	if {$len < 0 || $len > $total - $off} {
           64  +	    set len [expr {$total - $off}]
           65  +	}
           66  +	binary scan $data @${off}a$len s
           67  +	return $s
           68  +    }
           69  +
           70  +    proc mvec {v args} {
           71  +	foreach {mode data off len} $v break
           72  +	if {[info exists v::mvec_shifts($mode)]} {
           73  +	    # use _mvec_get to access elements
           74  +	    set shift $v::mvec_shifts($mode)
           75  +	    if {[llength $v] < 4} {
           76  +		set len $off
           77  +	    }
           78  +	    set get [list _mvec_get $shift $v *]
           79  +	} else {
           80  +	    # virtual mode, set to evaluate script
           81  +	    set shift ""
           82  +	    set len [lindex $v end]
           83  +	    set get $v
           84  +	}
           85  +	# try to derive vector length from data length if not specified
           86  +	if {$len == "" || $len < 0} {
           87  +	    set len 0
           88  +	    if {$shift >= 0} {
           89  +		if {[llength $v] < 4} {
           90  +		    set n [string length $data]
           91  +		} else {
           92  +		    set n [mmap $data]
           93  +		}
           94  +		set len [expr {($n << 3) >> $shift}]
           95  +	    }
           96  +	}
           97  +	set nargs [llength $args]
           98  +	# with just a varname as arg, return info about this vector
           99  +	if {$nargs == 0} {
          100  +	    if {$shift == ""} {
          101  +		return [list $len {} $v]
          102  +	    }
          103  +	    return [list $len $mode $shift]
          104  +	}
          105  +	foreach {pos count pred cond} $args break
          106  +	# with an index as second arg, do a single access and return element
          107  +	if {$nargs == 1} {
          108  +	    return [uplevel 1 [lreplace $get end end $pos]]
          109  +	}
          110  +	if {$count < 0} {
          111  +	    set count $len
          112  +	}
          113  +	if {$count > $len - $pos && $shift != -1} {
          114  +	    set count [expr {$len - $pos}]
          115  +	}
          116  +	if {$nargs == 4} {
          117  +	    upvar $pred x
          118  +	}
          119  +	set r {}
          120  +	incr count $pos
          121  +	# loop through specified range to build result vector
          122  +	# with four args, used that as predicate function to filter
          123  +	# with five args, use fourth as loop var and apply fifth as condition
          124  +	for {set x $pos} {$x < $count} {incr x} {
          125  +	    set y [uplevel 1 [lreplace $get end end $x]]
          126  +	    switch $nargs {
          127  +		3 {
          128  +			if {![uplevel 1 [list $pred $v $x $y]]} continue
          129  +		    }
          130  +		4 {
          131  +			if {![uplevel 1 [list expr $cond]]} continue
          132  +		    }
          133  +	    }
          134  +	    lappend r $y
          135  +	}
          136  +	return $r
          137  +    }
          138  +
          139  +    proc _mvec_get {shift desc index} {
          140  +	foreach {mode data off len} $desc break
          141  +	switch -- $mode {
          142  +	    - {
          143  +		    return $index
          144  +		}
          145  +	    0 {
          146  +		    return $data
          147  +		}
          148  +	}
          149  +	if {[llength $desc] < 4} {
          150  +	    set off [expr {($index << $shift) >> 3}]
          151  +	} else {
          152  +	    # don't load more than 8 bytes from the proper offset
          153  +	    incr off [expr {($index << $shift) >> 3}]
          154  +	    set data [mmap $data $off 8]
          155  +	    set off 0
          156  +	}
          157  +	switch -- $mode {
          158  +	    1 {
          159  +		    binary scan $data @${off}c value
          160  +		    return [expr {($value>>($index&7)) &1}]
          161  +		}
          162  +	    2 {
          163  +		    binary scan $data @${off}c value
          164  +		    return [expr {($value>>(($index&3) <<1)) &3}]
          165  +		}
          166  +	    4 {
          167  +		    binary scan $data @${off}c value
          168  +		    return [expr {($value>>(($index&1) <<2)) &15}]
          169  +		}
          170  +	    8 {
          171  +		    set w 1
          172  +		    set f c
          173  +		}
          174  +	    16 {
          175  +		    set w 2
          176  +		    set f s
          177  +		}
          178  +	    16r {
          179  +		    set w 2
          180  +		    set f S
          181  +		}
          182  +	    32 {
          183  +		    set w 4
          184  +		    set f i
          185  +		}
          186  +	    32r {
          187  +		    set w 4
          188  +		    set f I
          189  +		}
          190  +	    32fr -
          191  +	    32f {
          192  +		    set w 4
          193  +		    set f f
          194  +		}
          195  +	    64 -
          196  +	    64r {
          197  +		    set w 8
          198  +		    set f i2
          199  +		}
          200  +	    64fr -
          201  +	    64f {
          202  +		    set w 8
          203  +		    set f d
          204  +		}
          205  +	}
          206  +
          207  +	binary scan $data @$off$f value
          208  +	return $value
          209  +    }
          210  +
          211  +    # vim: ft=tcl
          212  +
          213  +}
          214  +
          215  +if {[info comm dbopen] == ""} {
          216  +    # Decoder for MetaKit datafiles in Tcl
          217  +
          218  +    # requires mmap/mvec primitives:
          219  +    #source [file join [info dirname [info script]] mvprim.tcl]
          220  +
          221  +    namespace export dbopen dbclose dbtree access vnames vlen
          222  +
          223  +    namespace eval v {
          224  +	variable widths {
          225  +    {8 16  1 32  2  4}
          226  +    {4  8  1 16  2  0}
          227  +    {2  4  8  1  0 16}
          228  +    {2  4  0  8  1  0}
          229  +    {1  2  4  0  8  0}
          230  +    {1  2  4  0  0  8}
          231  +    {1  2  0  4  0  0} }
          232  +    }
          233  +
          234  +    proc fetch {file} {
          235  +	if {$file == ""} {
          236  +	    error "temp storages not supported"
          237  +	}
          238  +	set v::data [open $file]
          239  +	set v::seqn 0
          240  +    }
          241  +
          242  +    proc byte_seg {off len} {
          243  +	incr off $v::zero
          244  +	return [mmap $v::data $off $len]
          245  +    }
          246  +
          247  +    proc int_seg {off cnt} {
          248  +	set vec [list 32r [byte_seg $off [expr {4*$cnt}]]]
          249  +	return [mvec $vec 0 $cnt]
          250  +    }
          251  +
          252  +    proc get_s {len} {
          253  +	set s [byte_seg $v::curr $len]
          254  +	incr v::curr $len
          255  +	return $s
          256  +    }
          257  +
          258  +    proc get_v {} {
          259  +	set v 0
          260  +	while 1 {
          261  +	    set char [mvec $v::byte $v::curr]
          262  +	    incr v::curr
          263  +	    set v [expr {$v*128+($char&0xff)}]
          264  +	    if {$char < 0} {
          265  +		return [incr v -128]
          266  +	    }
          267  +	}
          268  +    }
          269  +
          270  +    proc get_p {rows vs vo} {
          271  +	upvar $vs size $vo off
          272  +	set off 0
          273  +	if {$rows == 0} {
          274  +	    set size 0
          275  +	} else {
          276  +	    set size [get_v]
          277  +	    if {$size > 0} {
          278  +		set off [get_v]
          279  +	    }
          280  +	}
          281  +    }
          282  +
          283  +    proc header {{end ""}} {
          284  +	set v::zero 0
          285  +	if {$end == ""} {
          286  +	    set end [mmap $v::data]
          287  +	}
          288  +	set v::byte [list 8 $v::data $v::zero $end]
          289  +	lassign [int_seg [expr {$end-16}] 4] t1 t2 t3 t4
          290  +	set v::zero [expr {$end-$t2-16}]
          291  +	incr end -$v::zero
          292  +	set v::byte [list 8 $v::data $v::zero $end]
          293  +	lassign [int_seg 0 2] h1 h2
          294  +	lassign [int_seg [expr {$h2-8}] 2] e1 e2
          295  +	set v::info(mkend) $h2
          296  +	set v::info(mktoc) $e2
          297  +	set v::info(mklen) [expr {$e1 & 0xffffff}]
          298  +	set v::curr $e2
          299  +    }
          300  +
          301  +    proc layout {fmt} {
          302  +	regsub -all { } $fmt "" fmt
          303  +	regsub -all {(\w+)\[} $fmt "{\\1 {" fmt
          304  +	regsub -all {\]} $fmt "}}" fmt
          305  +	regsub -all {,} $fmt " " fmt
          306  +	return $fmt
          307  +    }
          308  +
          309  +    proc descparse {desc} {
          310  +	set names {}
          311  +	set types {}
          312  +	foreach x $desc {
          313  +	    if {[llength $x] == 1} {
          314  +		lassign [split $x :] name type
          315  +		if {$type == ""} {
          316  +		    set type S
          317  +		}
          318  +	    } else {
          319  +		lassign $x name type
          320  +	    }
          321  +	    lappend names $name
          322  +	    lappend types $type
          323  +	}
          324  +	return [list $names $types]
          325  +    }
          326  +
          327  +    proc numvec {rows type} {
          328  +	get_p $rows size off
          329  +	if {$size == 0} {
          330  +	    return {0 0}
          331  +	}
          332  +	set w [expr {int(($size<<3) /$rows)}]
          333  +	if {$rows <= 7 && 0 < $size && $size <= 6} {
          334  +	    set w [lindex [lindex $v::widths [expr {$rows-1}]] [expr {$size-1}]]
          335  +	}
          336  +	if {$w == 0} {
          337  +	    error "numvec?"
          338  +	}
          339  +	switch $type\
          340  +	      F {
          341  +		    set w 32f
          342  +		}\
          343  +	      D {
          344  +		    set w 64f
          345  +		}
          346  +	incr off $v::zero
          347  +	return [list $w $v::data $off $rows]
          348  +    }
          349  +
          350  +    proc lazy_str {self rows type pos sizes msize moff index} {
          351  +	set soff {}
          352  +	for {set i 0} {$i < $rows} {incr i} {
          353  +	    set n [mvec $sizes $i]
          354  +	    lappend soff $pos
          355  +	    incr pos $n
          356  +	}
          357  +	if {$msize > 0} {
          358  +	    set slen [mvec $sizes 0 $rows]
          359  +	    set v::curr $moff
          360  +	    set limit [expr {$moff+$msize}]
          361  +	    for {set row 0} {$v::curr < $limit} {incr row} {
          362  +		incr row [get_v]
          363  +		get_p 1 ms mo
          364  +		set soff [lreplace $soff $row $row $mo]
          365  +		set slen [lreplace $slen $row $row $ms]
          366  +	    }
          367  +	    set sizes [list lindex $slen $rows]
          368  +	}
          369  +	if {$type == "S"} {
          370  +	    set adj -1
          371  +	} else {
          372  +	    set adj 0
          373  +	}
          374  +	set v::node($self) [list get_str $soff $sizes $adj $rows]
          375  +	return [mvec $v::node($self) $index]
          376  +    }
          377  +
          378  +    proc get_str {soff sizes adj index} {
          379  +	set n [mvec $sizes $index]
          380  +	return [byte_seg [lindex $soff $index] [incr n $adj]]
          381  +    }
          382  +
          383  +    proc lazy_sub {self desc size off rows index} {
          384  +	set v::curr $off
          385  +	lassign [descparse $desc] names types
          386  +	set subs {}
          387  +	for {set i 0} {$i < $rows} {incr i} {
          388  +	    if {[get_v] != 0} {
          389  +		error "lazy_sub?"
          390  +	    }
          391  +	    lappend subs [prepare $types]
          392  +	}
          393  +	set v::node($self) [list get_sub $names $subs $rows]
          394  +	return [mvec $v::node($self) $index]
          395  +    }
          396  +
          397  +#proc backtrace {{level_adj 0}} {
          398  +#                        set ret [list]          
          399  +#
          400  +#                        set level [expr 0 - $level_adj]
          401  +#                        for {set i [expr [info level] - $level_adj]} {$i > 1} {incr i -1} {
          402  +#                                incr level -1
          403  +#                                set ret [linsert $ret 0 [lindex [info level $level] 0]]
          404  +#                        }
          405  +#                        set ret [linsert $ret 0 GLOBAL]
          406  +#        
          407  +#                        return $ret
          408  +#}
          409  +
          410  +    proc get_sub {names subs index} {
          411  +#puts stderr "DEBUG: get_sub: [list $names $subs $index]"
          412  +#puts "backtrace: [backtrace]"
          413  +	lassign [lindex $subs $index] rows handlers
          414  +	return [list get_view $names $rows $handlers $rows]
          415  +    }
          416  +
          417  +    proc prepare {types} {
          418  +	set r [get_v]
          419  +	set handlers {}
          420  +	foreach x $types {
          421  +	    set n [incr v::seqn]
          422  +	    lappend handlers $n
          423  +	    switch $x {
          424  +		I -
          425  +		L -
          426  +		F -
          427  +		D {
          428  +			set v::node($n) [numvec $r $x]
          429  +		    }
          430  +		B -
          431  +		S {
          432  +			get_p $r size off
          433  +			set sizes {0 0}
          434  +			if {$size > 0} {
          435  +			    set sizes [numvec $r I]
          436  +			}
          437  +			get_p $r msize moff
          438  +			set v::node($n) [list lazy_str $n $r $x $off $sizes\
          439  +			  $msize $moff $r]
          440  +		    }
          441  +		default {
          442  +			get_p $r size off
          443  +			set v::node($n) [list lazy_sub $n $x $size $off $r $r]
          444  +		    }
          445  +	    }
          446  +	}
          447  +	return [list $r $handlers]
          448  +    }
          449  +
          450  +    proc get_view {names rows handlers index} {
          451  +	return [list get_prop $names $rows $handlers $index [llength $names]]
          452  +    }
          453  +
          454  +    proc get_prop {names rows handlers index ident} {
          455  +	set col [lsearch -exact $names $ident]
          456  +	if {$col < 0} {
          457  +	    error "unknown property: $ident"
          458  +	}
          459  +	set h [lindex $handlers $col]
          460  +	set ret [mvec $v::node($h) $index]
          461  +
          462  +	return $ret
          463  +    }
          464  +
          465  +    proc dbopen {db file} {
          466  +	# open datafile, stores datafile descriptors and starts building tree
          467  +	if {$db == ""} {
          468  +	    set r {}
          469  +	    foreach {k v} [array get v::dbs] {
          470  +		lappend r $k [lindex $v 0]
          471  +	    }
          472  +	    return $r
          473  +	}
          474  +	fetch $file
          475  +	header
          476  +	if {[get_v] != 0} {
          477  +	    error "dbopen?"
          478  +	}
          479  +	set desc [layout [get_s [get_v]]]
          480  +	lassign [descparse $desc] names types
          481  +	set root [get_sub $names [list [prepare $types]] 0]
          482  +	set v::dbs($db) [list $file $v::data $desc [mvec $root 0]]
          483  +	return $db
          484  +    }
          485  +
          486  +    proc dbclose {db} {
          487  +	# close datafile, get rid of stored info
          488  +	unset v::dbs($db)
          489  +	set v::data "" ;# it may be big 
          490  +    }
          491  +
          492  +    proc dbtree {db} {
          493  +	# datafile selection, first step in access navigation loop
          494  +	return [lindex $v::dbs($db) 3]
          495  +    }
          496  +
          497  +    proc access {spec} {
          498  +	# this is the main access navigation loop
          499  +	set s [split $spec ".!"]
          500  +	set x [list dbtree [array size v::dbs]]
          501  +	foreach y $s {
          502  +	    set x [mvec $x $y]
          503  +	}
          504  +	return $x
          505  +    }
          506  +
          507  +    proc vnames {view} {
          508  +	# return a list of property names
          509  +	if {[lindex $view 0] != "get_view"} {
          510  +	    error "vnames?"
          511  +	}
          512  +	return [lindex $view 1]
          513  +    }
          514  +
          515  +    proc vlen {view} {
          516  +	# return the number of rows in this view
          517  +	if {[lindex $view 0] != "get_view"} {
          518  +	    error "vlen?"
          519  +	}
          520  +	return [lindex $view 2]
          521  +    }
          522  +
          523  +    # vim: ft=tcl
          524  +
          525  +}
          526  +
          527  +if {[info comm mk_file] == ""} {
          528  +    # Compatibility layer for MetaKit
          529  +
          530  +    # requires dbopen/dbclose/dbtree/access/vnames/vlen/mvec primitives
          531  +    #source [file join [info dirname [info script]] decode.tcl]
          532  +
          533  +    namespace export mk_*
          534  +
          535  +    proc mk_file {cmd args} {
          536  +#set indent [string repeat "    " [info level]]
          537  +#puts stderr "${indent}DEBUG: mk::file $cmd $args"
          538  +	lassign $args db file
          539  +	switch $cmd {
          540  +	    open {
          541  +		    return [dbopen $db $file]
          542  +		}
          543  +	    close {
          544  +		    dbclose $db
          545  +		}
          546  +	    views {
          547  +		    return [vnames [dbtree $db]]
          548  +		}
          549  +	    commit {
          550  +
          551  +		}
          552  +	    default {
          553  +		    error "mk_file $cmd?"
          554  +		}
          555  +	}
          556  +    }
          557  +
          558  +    proc mk_view {cmd path args} {
          559  +#set indent [string repeat "    " [info level]]
          560  +#puts stderr "${indent}DEBUG: mk::view $cmd $path $args"
          561  +	lassign $args a1
          562  +	switch $cmd {
          563  +	    info {
          564  +		    return [vnames [access $path]]
          565  +		}
          566  +	    layout {
          567  +		    set layout "NOTYET"
          568  +		    if {[llength $args] > 0 && $layout != $a1} {
          569  +			#error "view restructuring not supported"
          570  +		    }
          571  +		    return $layout
          572  +		}
          573  +	    size {
          574  +		    set len [vlen [access $path]]
          575  +		    if {[llength $args] > 0 && $len != $a1} {
          576  +			error "view resizing not supported"
          577  +		    }
          578  +		    return [vlen [access $path]]
          579  +		}
          580  +	    default {
          581  +		    error "mk_view $cmd?"
          582  +		}
          583  +	}
          584  +    }
          585  +
          586  +    proc mk_cursor {cmd cursor args} {
          587  +#set indent [string repeat "    " [info level]]
          588  +#puts stderr "${indent}DEBUG: mk::cursor $cmd $cursor $args"
          589  +	upvar $cursor v
          590  +	switch $cmd {
          591  +	    create {
          592  +		    NOTYET
          593  +		}
          594  +	    incr {
          595  +		    NOTYET
          596  +		}
          597  +	    pos -
          598  +	    position {
          599  +		    if {$args != ""} {
          600  +			regsub {!-?\d+$} $v {} v
          601  +			append v !$args
          602  +			return $args
          603  +		    }
          604  +		    if {![regexp {\d+$} $v n]} {
          605  +			set n -1
          606  +		    }
          607  +		    return $n
          608  +		}
          609  +	    default {
          610  +		    error "mk_cursor $cmd?"
          611  +		}
          612  +	}
          613  +    }
          614  +
          615  +    proc mk_get {path args} {
          616  +#set indent [string repeat "    " [info level]]
          617  +#puts stderr "${indent}DEBUG: mk::get $path $args"
          618  +	set rowref [access $path]
          619  +	set sized 0
          620  +	if {[lindex $args 0] == "-size"} {
          621  +	    set sized 1
          622  +	    set args [lrange $args 1 end]
          623  +	}
          624  +	set ids 0
          625  +	if {[llength $args] == 0} {
          626  +	    set args [vnames $rowref]
          627  +	    set ids 1
          628  +	}
          629  +	set r {}
          630  +	foreach x $args {
          631  +	    if {$ids} {
          632  +		lappend r $x
          633  +	    }
          634  +	    set v [mvec $rowref $x]
          635  +if {[string range $v 0 8] == "get_view "} {
          636  +# XXX: ?!?!?: TODO: FIX
          637  +set v 1
          638  +}
          639  +	    catch {
          640  +		set v [zlib decompress $v]
          641  +	    }
          642  +	    if {$sized} {
          643  +		lappend r [string length $v]
          644  +	    } else {
          645  +		lappend r $v
          646  +	    }
          647  +	}
          648  +	if {[llength $args] == 1} {
          649  +	    set r [lindex $r 0]
          650  +	}
          651  +
          652  +	return $r
          653  +    }
          654  +
          655  +    proc mk_loop {cursor path args} {
          656  +#set indent [string repeat "    " [info level]]
          657  +#puts stderr "${indent}DEBUG: mk::loop $cursor $path ..."
          658  +	upvar $cursor v
          659  +	if {[llength $args] == 0} {
          660  +	    set args [list $path]
          661  +	    set path $v
          662  +	    regsub {!-?\d+$} $path {} path
          663  +	}
          664  +	lassign $args a1 a2 a3 a4
          665  +	set rowref [access $path]
          666  +	set first 0
          667  +	set limit [vlen $rowref]
          668  +	set step 1
          669  +	switch [llength $args] {
          670  +	    1 {
          671  +		    set body $a1
          672  +		}
          673  +	    2 {
          674  +		    set first $a1
          675  +		    set body $a2
          676  +		}
          677  +	    3 {
          678  +		    set first $a1
          679  +		    set limit $a2
          680  +		    set body $a3
          681  +		}
          682  +	    4 {
          683  +		    set first $a1
          684  +		    set limit $a2
          685  +		    set step $a3
          686  +		    set body $a4
          687  +		}
          688  +	    default {
          689  +		    error "mk_loop arg count?"
          690  +		}
          691  +	}
          692  +	set code 0
          693  +	for {set i $first} {$i < $limit} {incr i $step} {
          694  +	    set v $path!$i
          695  +	    set code [catch [list uplevel 1 $body] err]
          696  +	    switch $code {
          697  +		1 -
          698  +		2 {
          699  +			return -code $code $err
          700  +		    }
          701  +		3 {
          702  +			break
          703  +		    }
          704  +	    }
          705  +	}
          706  +    }
          707  +
          708  +    proc mk_select {path args} {
          709  +#set indent [string repeat "    " [info level]]
          710  +#puts stderr "${indent}DEBUG: mk::select $path $args"
          711  +	# only handle the simplest case: exact matches
          712  +	if {[lindex $args 0] == "-count"} {
          713  +		set maxitems [lindex $args 1]
          714  +		set args [lrange $args 2 end]
          715  +	}
          716  +
          717  +	set currmatchmode "caseinsensitive"
          718  +
          719  +	set keys {}
          720  +	set value {}
          721  +	set matchmodes {}
          722  +	for {set idx 0} {$idx < [llength $args]} {incr idx 2} {
          723  +		switch -glob -- [lindex $args $idx] {
          724  +			"-glob" {
          725  +				set currmatchmode "glob"
          726  +				incr idx -1
          727  +				continue
          728  +			}
          729  +			"-*" {
          730  +				error "Unhandled option: [lindex $args $idx]"
          731  +			}
          732  +		}
          733  +
          734  +		set k [lindex $args $idx]
          735  +		set v [lindex $args [expr {$idx+1}]]
          736  +
          737  +		lappend keys $k
          738  +		lappend values $v
          739  +		lappend matchmodes $currmatchmode
          740  +	}
          741  +	set r {}
          742  +	mk_loop c $path {
          743  +		set x [eval mk_get $c $keys]
          744  +		set matchCnt 0
          745  +		for {set idx 0} {$idx < [llength $x]} {incr idx} {
          746  +			set val [lindex $values $idx]
          747  +			set chkval [lindex $x $idx]
          748  +			set matchmode [lindex $matchmodes $idx]
          749  +
          750  +			switch -- $matchmode {
          751  +				"caseinsensitive" {
          752  +					if {$val == $chkval} {
          753  +						incr matchCnt
          754  +					}
          755  +				}
          756  +				"glob" {
          757  +					if {[string match $val $chkval]} {
          758  +						incr matchCnt
          759  +					}
          760  +				}
          761  +			}
          762  +
          763  +		}
          764  +		if {$matchCnt == [llength $keys]} {
          765  +			lappend r [mk_cursor position c]
          766  +		}
          767  +	}
          768  +
          769  +	if {[info exists maxitems]} {
          770  +		set r [lrange $r 0 [expr $maxitems - 1]]
          771  +	}
          772  +
          773  +	return $r
          774  +    }
          775  +
          776  +    proc mk__rechan {path prop cmd chan args} {
          777  +#set indent [string repeat "    " [info level]]
          778  +#puts stderr "${indent}DEBUG: mk::_rechan $path $prop $cmd $chan $args"
          779  +
          780  +        set key [list $path $prop]
          781  +        if {![info exists ::mk__cache($key)]} {
          782  +          set ::mk__cache($key) [mk::get $path $prop]
          783  +        }
          784  +        if {![info exists ::mk__offset($key)]} {
          785  +          set ::mk__offset($key) 0
          786  +        }
          787  +        set data $::mk__cache($key)
          788  +        set offset $::mk__offset($key)
          789  +
          790  +        switch -- $cmd {
          791  +            "read" {
          792  +                set count [lindex $args 0]
          793  +                set retval [string range $data $offset [expr {$offset + $count - 1}]]
          794  +
          795  +                set readbytes [string length $retval]
          796  +
          797  +                incr offset $readbytes
          798  +            }
          799  +            "close" {
          800  +                unset -nocomplain ::mk__cache($key)
          801  +                unset -nocomplain ::mk__offset($key)
          802  +                return
          803  +            }
          804  +            default {
          805  +#puts stderr "${indent}DEBUG: mk::_rechan: Called for cmd $cmd"
          806  +                return -code error "Not implemented: cmd = $cmd"
          807  +            }
          808  +        }
          809  +
          810  +        set ::mk__offset($key) $offset
          811  +
          812  +	return $retval
          813  +    }
          814  +
          815  +    proc mk_channel {path prop {mode "r"}} {
          816  +#set indent [string repeat "    " [info level]]
          817  +#puts stderr "${indent}DEBUG: mk::channel $path $prop $mode"
          818  +	set fd [rechan [list mk__rechan $path $prop] 2]
          819  +
          820  +	return $fd
          821  +    }
          822  +    # vim: ft=tcl
          823  +
          824  +}
          825  +
          826  +# set up the MetaKit compatibility definitions
          827  +foreach x {file view cursor get loop select channel} {
          828  +    interp alias {} ::mk::$x {} ::mk_$x
          829  +}
          830  +
          831  +package provide Mk4tcl 2.4.0.1

Added kitsh/buildsrc/kitsh-0.0/stringify.tcl version [100818685a].

            1  +#! /usr/bin/env tclsh
            2  +
            3  +proc stringifyfile {filename {key 0}} {
            4  +	catch {
            5  +		set fd [open $filename r]
            6  +	}
            7  +
            8  +	if {![info exists fd]} {
            9  +		return ""
           10  +	}
           11  +
           12  +	set data [read -nonewline $fd]
           13  +	close $fd
           14  +
           15  +	foreach line [split $data \n] {
           16  +		set line [string map [list "\\" "\\\\" "\"" "\\\""] $line]
           17  +		append ret "	\"$line\\n\"\n"
           18  +	}
           19  +
           20  +	return $ret
           21  +}
           22  +
           23  +foreach file $argv {
           24  +	puts [stringifyfile $file]
           25  +}
           26  +
           27  +exit 0

Modified mk4tcl/build.sh from [354ba5de6f] to [d269657dc4].

    66     66   	if [ "${BUILDTYPE}" = "win" ]; then
    67     67   		CPPFLAGS="${CPPFLAGS} -DBUILD_tcl=1"
    68     68   		export CPPFLAGS
    69     69   	fi
    70     70   
    71     71   	# Build static libraries for linking against Tclkit
    72     72   	./configure --disable-shared --prefix="${INSTDIR}" --exec-prefix="${INSTDIR}" --with-tcl="${TCLCONFIGDIR}/../generic" ${CONFIGUREEXTRA}
    73         -	${MAKE:-make} tcllibdir="${INSTDIR}/lib" AR="${AR:-ar}" RANLIB="${RANLIB:-ranlib}" || exit 1
    74         -	${MAKE:-make} tcllibdir="${INSTDIR}/lib" AR="${AR:-ar}" RANLIB="${RANLIB:-ranlib}" install
           73  +	${MAKE:-make} tcllibdir="${INSTDIR}/lib" AR="${AR:-ar}" RANLIB="${RANLIB:-ranlib}" && \
           74  +	${MAKE:-make} tcllibdir="${INSTDIR}/lib" AR="${AR:-ar}" RANLIB="${RANLIB:-ranlib}" install || (
           75  +		rm -rf "${INSTDIR}"
           76  +		mkdir "${INSTDIR}"
           77  +
           78  +		exit 1
           79  +	) || exit 1
    75     80   
    76     81   	exit 0
    77     82   ) || exit 1
    78     83   
    79     84   exit 0